Enter your email address:

Delivered by

Uploud File di Ziddu dan dapat uang broo
Uploud File di Deposit Files

Kelompok 1 Open GL

Label:

OPEN GL


unit Unit1;

interface

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, ExtCtrls, ComCtrls;

type
TForm1 = class(TForm)
TrackBar1: TTrackBar;
gmb: TImage;
procedure TrackBar1Change(Sender: TObject);
procedure FormActivate(Sender: TObject);
procedure FormResize(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;

var
Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.TrackBar1Change(Sender: TObject);
var
r,y,x,x1,y1,x2,y2,x3,y3,x4,y4:integer;
xc,yc:integer;
pos1,pos2,pos3,pos4,pos5:Tpoint;
begin

with gmb.Canvas do

begin
rectangle (0,0,width,height);
end;
xc:=gmb.width div 2; yc:=gmb.Height div 2;
gmb.Canvas.MoveTo(xc,yc+50);

r:=50;

y:=round(r*sin(Trackbar1.position*pi/1...
x:=round(r*cos(Trackbar1.position*pi/1...
y1:=round(r*sin((Trackbar1.Position+72...
x1:=round(r*cos((Trackbar1.Position+72...
y2:=round(r*sin((Trackbar1.Position+14...
x2:=round(r*cos((Trackbar1.Position+14...
y3:=round(r*sin((Trackbar1.Position+21...
x3:=round(r*cos((Trackbar1.Position+21...
y4:=round(r*sin((Trackbar1.Position+28...
x4:=round(r*cos((Trackbar1.Position+28...

pos1.X:=xc+x; pos1.Y:=(yc+50)-y;
pos2.X:=xc+x1; pos2.Y:=(yc+50)-y1;
pos3.X:=xc+x2; pos3.Y:=(yc+50)-y2;
pos4.X:=xc+x3; pos4.Y:=(yc+50)-y3;
pos5.X:=xc+x4; pos5.Y:=(yc+50)-y4;

gmb.Canvas.pen.Color:=clred;
gmb.Canvas.Pen.style:=pssolid;
gmb.Canvas.polygon ([pos1,pos2,pos3,pos4,pos5,pos1]);

gmb.Canvas.Pen.color:=clred;

gmb.Canvas.MoveTo(xc,yc-50);
gmb.canvas.lineto(pos1.X,pos1.y);
gmb.Canvas.MoveTo(xc,yc-50);
gmb.canvas.lineto(pos2.X,pos2.y);
gmb.Canvas.MoveTo(xc,yc-50);
gmb.canvas.lineto(pos3.X,pos3.y);
gmb.Canvas.MoveTo(xc,yc-50);
gmb.canvas.lineto(pos4.X,pos4.y);
gmb.Canvas.MoveTo(xC,yc-50);
gmb.canvas.lineto(pos5.X,pos5.y);





gmb.Canvas.textout(pos1.X+2,pos1.Y+2,'('...
gmb.Canvas.textout(pos2.X+2,pos2.Y+2,'('...
gmb.Canvas.textout(pos3.X+2,pos3.Y+2,'('...
gmb.Canvas.textout(pos4.X+2,pos4.Y+2,'('...
gmb.Canvas.textout(pos5.X+2,pos5.Y+2,'('...

gmb.Canvas.Pen.Color:=claqua;
gmb.canvas.moveto(xc,0);gmb.Canvas.lin...
gmb.canvas.moveto(0,yc);gmb.Canvas.lin...
application.processmessages;
end;

procedure TForm1.FormActivate(Sender: TObject);
begin
gmb.Picture.Bitmap:=Tbitmap.Create;
doublebuffered:=true;
//windouwstate:=WSmaximized;

end;

procedure TForm1.FormResize(Sender: TObject);
begin
with gmb.Picture.Bitmap do
begin
width:=gmb.width;
height:=gmb.Height;

end;
end;
end.



0 komentar:

Posting Komentar


ShoutMix chat widget