Mega Code Archive
Visual OS threads
<![CDATA[
Title: Visual OS threads.
Question: Do you want to learn about threads? If yes, this not the right article, but it will show you one funny use of Win32 threads.
Answer:
This not a game nor a useful program but one way to play with threads.
Notes:
Each ball represents a thread. You can
increase/decrease the number of balls
(Threads) by increasing/decreasing the value
of the text Edit box. You can also change
the size of the balls and movement speed.
When any ball hits any side of the screen, it
changes the color. The colors and initial
positions of the balls are generated randomly.
{******************************************************************************}
unit BallsThreads;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, ComCtrls, StdCtrls, ExtCtrls, Buttons;
type
TfrmBalls = class(TForm)
Panel1: TPanel;
txtNoOfBalls: TEdit;
UpDown1: TUpDown;
Label1: TLabel;
Label2: TLabel;
Label3: TLabel;
btnExit: TBitBtn;
cbSolidBalls: TCheckBox;
txtDelay: TEdit;
UpDown2: TUpDown;
txtSize: TEdit;
UpDown3: TUpDown;
cbShowBallsNo: TCheckBox;
btnAbout: TBitBtn;
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure FormCreate(Sender: TObject);
procedure cbSolidBallsClick(Sender: TObject);
procedure txtNoOfBallsChange(Sender: TObject);
procedure txtDelayChange(Sender: TObject);
procedure txtSizeChange(Sender: TObject);
procedure btnAboutClick(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
{***************************************************************************}
TBalls = class(TThread)
procedure DrawBall;
procedure ClearBall;
private
{ Private declarations }
x1,x2 : Integer;
y1,y2 : Integer;
sBallNo : string;
iColor : TColor;
protected
procedure Execute; override;
end;
var
frmBalls: TfrmBalls;
iSleep : Integer;
iWidth : Integer = 100;
iFormColor : TColor;
aThreadsHandles : array of TBalls;
implementation
{$R *.dfm}
procedure TfrmBalls.FormCreate(Sender: TObject);
begin
Randomize;
SetLength(aThreadsHandles, 0);
iFormColor := frmBalls.Color;
self.WindowState := wsMaximized;
end;
procedure TfrmBalls.FormClose(Sender: TObject; var Action: TCloseAction);
var
i : Integer;
begin
for i:=0 to Length(aThreadsHandles)-1 do
aThreadsHandles[i].Terminate;
end;
procedure TfrmBalls.txtNoOfBallsChange(Sender: TObject);
begin
if StrToInt(txtNoOfBalls.Text) Length(aThreadsHandles) then begin
SetLength(aThreadsHandles, Length(aThreadsHandles)+1);
aThreadsHandles[Length(aThreadsHandles)-1] := TBalls.Create(False);
aThreadsHandles[Length(aThreadsHandles)-1].Priority := tpNormal;
end;
if StrToInt(txtNoOfBalls.Text) aThreadsHandles[Length(aThreadsHandles)-1].Terminate;
SetLength(aThreadsHandles, Length(aThreadsHandles)-1);
end;
txtNoOfBalls.Text := IntToStr(Length(aThreadsHandles));
end;
procedure TfrmBalls.txtDelayChange(Sender: TObject);
begin
iSleep := StrToInt(txtDelay.Text);
end;
procedure TfrmBalls.txtSizeChange(Sender: TObject);
begin
iWidth := StrToInt(txtSize.Text);
end;
procedure TfrmBalls.cbSolidBallsClick(Sender: TObject);
begin
frmBalls.Invalidate;
end;
procedure TBalls.Execute;
const
aColors : array[0..20] of TColor = (clSkyBlue,clMaroon,clGreen,clOlive,clNavy,clPurple,clTeal,clGray,clSilver,clRed,clLime,clYellow,clBlue,clFuchsia,clAqua,clLtGray,clDkGray,clWhite,clMoneyGreen,clCream,clMedGray);
var
iXFactor : Integer;
iYFactor : Integer;
begin
x1 := Random(Screen.Width-iWidth);
y1 := Random(Screen.Height-iWidth-frmBalls.Panel1.Height);
iXFactor := 2;
iYFactor := 2;
iColor := aColors[Random(Length(aColors)-1)];
sBallNo := IntToStr(Length(aThreadsHandles));
FreeOnTerminate := True;
while NOT Terminated do begin
if (x1 = (Screen.Width-iWidth)) then begin
iXFactor := iXFactor * (-1);
iColor := aColors[Random(Length(aColors)-1)];
end;
if (y1 = (Screen.Height-iWidth-frmBalls.Panel1.Height)) then begin
iYFactor := iYFactor * (-1);
iColor := aColors[Random(Length(aColors)-1)];
end;
Inc(x1, iXFactor);
Inc(y1, iYFactor);
x2 := x1 + iWidth;
y2 := y1 + iWidth;
Synchronize(DrawBall);
Sleep(iSleep);
if (NOT Terminated) and (frmBalls.cbSolidBalls.Checked) then
Synchronize(ClearBall);
end;
Synchronize(ClearBall);
end;
procedure TBalls.DrawBall;
var
i : Integer;
begin
i := ((iWidth * 42) div 100);
frmBalls.Canvas.Brush.Color := iColor;
frmBalls.Canvas.Ellipse(x1,y1,x2,y2);
if frmBalls.cbShowBallsNo.Checked then
frmBalls.Canvas.TextOut(x1+i,y1+i,sBallNo);
end;
procedure TBalls.ClearBall;
begin
frmBalls.Canvas.Brush.Color := iFormColor;
frmBalls.Canvas.Ellipse(x1,y1,x2,y2);
// frmBalls.Invalidate;
end;
end.
{******************************************************************************}
Have fun with Delphi.
Abdulaziz Jasser
]]>