{█▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀█}
{█ █}
{█ Virtual Pascal Examples. Version 1.10 █}
{█ Presentation Manager analog clock example █}
{█ ─────────────────────────────────────────────────█}
{█ Copyright (C) 1995-96 fPrint UK Ltd █}
{█ █}
{▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀}
program Clock;
uses Os2Def, Os2Base, Os2PmApi, PmObj, Use32;
{&PMTYPE PM}
{$IFDEF VPDEMO}
{&Dynamic VP11Demo.Lib}
{$ENDIF}
const
idTimer = 1; { PM timer id }
const
ClockFlags = fcf_TitleBar + fcf_SysMenu + fcf_SizeBorder + fcf_MinMax +
fcf_TaskList + fcf_NoByteAlign;
type
PClockWindow = ^TClockWindow;
TClockWindow = object(PMWindow)
PS: HPS;
PixelDiam: PointL;
ClientSize: PointL;
PixelsPerMeter: PointL;
DTPrev: DateTime;
procedure DrawHand(AP: array of PointL; Angle: Integer);
function HandleMessage(Window: HWnd; Msg: ULong; Mp1,Mp2 : MParam): MResult; virtual;
procedure RotateFigure(var AP: array of PointL; Angle: Integer);
procedure ScaleFigure(var AP: array of PointL);
procedure StartupAction; virtual;
procedure CenterFigure(var AP: array of PointL);
end;
ClockApplication = object(PMApplication)
MainWindow: PClockWindow;
constructor Init;
destructor Done; virtual;
end;
{ Return the smaller of two integer values }
function Min(X, Y: Integer): Integer;
begin
if X < Y then Min := X else Min := Y;
end;
{ ClockApplication }
constructor ClockApplication.Init;
begin
inherited Init;
MainWindow := New(PClockWindow, Init('VP Clock', 'Clock', ClockFlags));
end;
destructor ClockApplication.Done;
begin
Dispose(MainWindow, Done);
inherited Done;
end;
{ TClockWindow }
procedure TClockWindow.StartupAction;
var
Size: Integer;
begin
WinStartTimer(Anchor, ClientWindow, idTimer, 1000);
Size := Min(DesktopSize.X div 3, DesktopSize.Y div 3);
WinSetWindowPos(FrameWindow, 0, DesktopSize.X - Size, DesktopSize.Y - Size,
Size, Size, swp_Move + swp_Size + swp_Activate + swp_Show);
end;
{ Handles PM messages }
function TClockWindow.HandleMessage(Window: HWnd; Msg: ULong; Mp1,Mp2: MParam): MResult;
var
DC: HDC;
DiamMM, Angle, I: Integer;
AP: array [0..2] of PointL;
DT: DateTime;
const
Hour: array [0..4] of PointL = ((X:0; Y:-15), (X:7; Y:0 ), (X:0; Y:60), (X:-7; Y:0), (X:0;Y:-15));
Minute: array [0..4] of PointL = ((X:0; Y:-20), (X:5 ; Y:0), (X:0; Y:80), (X:-5; Y:0), (X:0;Y:-20));
Second: array [0..1] of PointL = ((X:0; Y:0 ), (X:0; Y:80));
BigCycle: array [0..1] of Integer = (10, 8);
begin
HandleMessage := 0;
case Msg of
wm_Create:
begin
DC := WinOpenWindowDC(Window);
DevQueryCaps(DC, caps_Vertical_Resolution, 1, PixelsPerMeter.Y);
DevQueryCaps(DC, caps_Horizontal_Resolution, 1, PixelsPerMeter.X);
DosGetDateTime(DTPrev) ;
DTPrev.hours := (DTPrev.hours * 5) mod 60 + DTPrev.minutes div 12;
end;
wm_Size:
begin
ClientSize.X := LongRec(Mp2).Lo;
ClientSize.Y := LongRec(Mp2).Hi;
DiamMM := Min(ClientSize.X * 1000 div PixelsPerMeter.X,
ClientSize.Y * 1000 div PixelsPerMeter.Y);
PixelDiam.X := PixelsPerMeter.X * DiamMM div 1000;
PixelDiam.Y := PixelsPerMeter.Y * DiamMM div 1000;
end;
wm_Timer:
begin
DosGetDateTime(DT);
DT.hours := (DT.hours * 5) mod 60 + DT.minutes div 12;
PS := WinGetPS(Window);
GpiSetColor(PS, clr_Background);
DrawHand(Second, DTPrev.seconds);
if (DT.hours <> DTPrev.hours) or (DT.minutes <> DTPrev.minutes) then
begin
DrawHand(Hour, DTPrev.hours);
DrawHand(Minute, DTPrev.minutes);
end;
GpiSetColor(PS, clr_Black);
DrawHand(Hour, DT.hours);
GpiSetColor(PS, clr_Darkgray);
DrawHand(Minute, DT.minutes);
GpiSetColor(PS, clr_Red);
DrawHand(Second, DT.seconds);
WinReleasePS(PS);
DTPrev := DT;
end;
wm_Paint:
begin
PS := WinBeginPaint(Window, 0, nil);
GpiErase(PS);
for Angle := 0 to 59 do
begin
I := 0;
repeat
if I = 1 then GpiSetColor(PS, clr_Darkcyan) else GpiSetColor(PS, clr_Black);
AP[0].X := 0;
AP[0].Y := 90;
RotateFigure(AP[0], Angle);
ScaleFigure(AP[0]);
CenterFigure(AP[0]);
if (Angle mod 5) <> 0 then AP[2].X := 2 else AP[2].X := BigCycle[I];
AP[2].Y := AP[2].X;
ScaleFigure(AP[2]);
Dec(AP[0].X, AP[2].X div 2);
Dec(AP[0].Y, AP[2].Y div 2);
AP[1].X := AP[0].X + AP[2].X;
AP[1].Y := AP[0].Y + AP[2].Y;
GpiMove(PS, AP[0]);
GpiBox(PS, dro_OutlineFill, AP[1], AP[2].X, AP[2].Y);
Inc(I);
until ((Angle mod 5) <> 0) or (I = 2);
end;
GpiSetColor(PS, clr_Black);
DrawHand(Hour, DTPrev.hours);
GpiSetColor(PS, clr_Darkgray);
DrawHand(Minute, DTPrev.minutes);
GpiSetColor(PS, clr_Red);
DrawHand(Second, DTPrev.seconds);
WinEndPaint(PS);
end;
else HandleMessage := WinDefWindowProc(Window, Msg, Mp1, Mp2);
end;
end;
{ Rotates figure }
procedure TClockWindow.RotateFigure(var AP: array of PointL; Angle: Integer);
var
P: PointL;
I: Integer;
const
Factor: Single = 6 * PI / 180;
begin
for I := 0 to High(AP) do
with AP[I] do
begin
P.X := Round(X * Sin(((Angle + 15) mod 60) * Factor) +
Y * Sin(Angle * Factor));
P.Y := Round(Y * Sin(((Angle + 15) mod 60) * Factor) -
X * Sin(Angle * Factor));
AP[I] := P;
end;
end;
{ Scales figure }
procedure TClockWindow.ScaleFigure(var AP: array of PointL);
var
I: Integer;
begin
for I := 0 to High(AP) do
with AP[I] do
begin
X := X * PixelDiam.X div 200;
Y := Y * PixelDiam.Y div 200;
end;
end;
{ Centers figure on the client window }
procedure TClockWindow.CenterFigure(var AP: array of PointL);
var
I: Integer;
begin
for I := 0 to High(AP) do
with AP[I] do
begin
Inc(X, ClientSize.X div 2);
Inc(Y, ClientSize.Y div 2);
end;
end;
{ Draws watch hand }
procedure TClockWindow.DrawHand(AP: array of PointL; Angle: Integer);
var
I: Integer;
begin
RotateFigure(AP, Angle);
ScaleFigure(AP);
CenterFigure(AP);
GpiBeginPath(PS, 1);
GpiMove(PS, AP[0]);
GpiPolyLine(PS, High(AP), AP[1]);
GpiEndPath(PS);
GpiFillPath(PS, 1, fpath_Alternate);
end;
var
AnalogClock: ClockApplication;
begin
AnalogClock.Init;
AnalogClock.Run;
AnalogClock.Done;
end.
