home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
DP Tool Club 26
/
CD_ASCQ_26_1295.iso
/
vrac
/
picdll.zip
/
SQUARES.PAS
< prev
next >
Wrap
Pascal/Delphi Source File
|
1995-06-16
|
5KB
|
204 lines
unit Squares;
{ Program copyright (c) 1995 by Charles Calvert }
{ Project Name: RUNDLL }
interface
uses
SysUtils, WinTypes, WinProcs,
Messages, Classes, Graphics,
Controls, Forms, Dialogs,
StdCtrls, ExtCtrls;
const
BoxCount = 25;
type
TDrawSqr = class(TForm)
Timer1: TTimer;
procedure Timer1Timer(Sender: TObject);
procedure FormCreate(Sender: TObject);
private
{ Private declarations }
Colors: array [1..BoxCount] of TColor;
procedure DrawSquare(Scale: Double; Theta: Integer);
public
{ Public declarations }
end;
var
DrawSqr: TDrawSqr;
procedure ShowSquares(Handle: THandle); export;
implementation
{$R *.DFM}
type
TSquarePoints = array [0..4] of TPoint;
const
Square : TSquarePoints =
((x: -100; y: -100),(x: 100; y: -100),(x: 100; y: 100),
(x: -100; y: 100),(x: -100; y: -100));
procedure ShowSquares(Handle: THandle);
begin
Application.Handle := Handle;
DrawSqr := TDrawSqr.Create(Application);
try
DrawSqr.ShowModal;
finally
DrawSqr.Free;
end;
end;
procedure TDrawSqr.DrawSquare(Scale: Double; Theta: Integer);
var
i: Integer;
CosTheta, SinTheta: Double;
Path: TSquarePoints;
begin
CosTheta := Scale * cos(Theta * PI / 180); { precalculate rotation and scaling }
SinTheta := Scale * sin(Theta * PI / 180);
for i := 0 to 4 do
begin
Path[i].X := Round(Square[i].X * CosTheta + Square[i].Y * SinTheta);
Path[i].Y := Round(Square[i].Y * CosTheta - Square[i].X * SinTheta);
end;
Canvas.Polyline(Path);
end;
procedure TDrawSqr.Timer1Timer(Sender: TObject);
var
i: Integer;
Scale: Double;
Theta: Integer;
begin
Scale := 1.0;
Theta := 0;
SetViewPortOrg(Canvas.Handle, ClientWidth div 2, ClientHeight div 2);
Canvas.Pen.Color := clWhite;
for i := 1 to BoxCount do
begin
DrawSquare(Scale, Theta);
Theta := Theta + 10;
Scale := Scale * 0.85;
Canvas.Pen.Color := Colors[i];
end;
{ Shift all colors down one for special spinning effects }
Move(Colors[1], Colors[2], sizeof(Colors) - Sizeof(TColor));
Colors[1] := Colors[1] + RGB(Random(64), Random(64), Random(64));
end;
procedure TDrawSqr.FormCreate(Sender: TObject);
var
X: Integer;
begin
Randomize;
Colors[1] := RGB(Random(255), Random(255), Random(255));
for X := 2 to BoxCount do
Colors[X] := Colors[X-1] + RGB(Random(64), Random(64), Random(64));
end;
end.
===============================================================
type
TDrawSqr = class(TForm)
Timer1: TTimer;
procedure Timer1Timer(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
DrawSqr: TDrawSqr;
procedure ShowSquares; export;
implementation
{$R *.DFM}
procedure ShowSquares;
begin
DrawSqr := TDrawSqr.Create(Application);
DrawSqr.ShowModal;
DrawSqr.Free;
end;
procedure DrawSquare(PaintDC: HDC; Scale: Double; Theta: Integer);
type
TCDS = array[0..5] of TPoint;
var
X1, Y1: Integer;
XT, YT: Integer;
i, j: Integer;
Pens: array[0..4] of HPen;
OldPen: HPen;
CDS: TCDS;
begin
j := Random(25);
Pens[0] := CreatePen(PS_SOLID, 1, RGB(255, 255, 255));
Pens[1] := CreatePen(PS_SOLID, 1, RGB(Random(255), 0, 0));
Pens[2] := CreatePen(PS_SOLID, 1, RGB(0, Random(255), 0));
Pens[3] := CreatePen(PS_SOLID, 1, RGB(0, 0, Random(255)));
Pens[4] := CreatePen(PS_SOLID, 1, RGB(Random(255), 0, Random(255)));
CDS[0].X := -100;
CDS[0].Y := -100;
CDS[1].X := 100;
CDS[1].Y := -100;
CDS[2].X := 100;
CDS[2].Y := 100;
CDS[3].X := -100;
CDS[3].Y := 100;
CDS[4].X := -100;
CDS[4].Y := -100;
for i := 0 to 4 do begin
x1 := CDS[i].X;
y1 := CDS[i].Y;
xt := Round(Scale * (x1 * cos(Theta * PI / 180) + y1 * sin(Theta * PI/180)));
yt := Round(Scale * (y1 * cos(Theta * PI / 180) - x1 * sin(Theta * PI/180)));
if (i = 0) then
MoveTo(PaintDC, xt, yt)
else begin
if Scale = 1.0 then
OldPen := SelectObject(PaintDC, Pens[0])
else
OldPen := SelectObject(PaintDC, Pens[i]);
LineTo(PaintDC, xt, yt);
SelectObject(PaintDC, OldPen);
end;
end;
for I := 0 to 4 do
DeleteObject(Pens[i]);
end;
procedure TDrawSqr.Timer1Timer(Sender: TObject);
var
i: Integer;
Scale: Double;
Theta: Integer;
PaintDC: HDC;
R: TRect;
begin
Scale := 1.0;
Theta := 0;
PaintDC := GetDC(Handle);
R := GetClientRect;
SetViewPortOrg(PaintDC, R.Right div 2, R.Bottom div 2);
for i := 1 to 25 do begin
DrawSquare(PaintDC, Scale, Theta);
Theta := Theta + 10;
Scale := Scale * 0.85;
end;
ReleaseDC(Handle, PaintDC);
end;
end.