home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 10 Tools / 10-Tools.zip / vp21beta.zip / OEXMPSRC.RAR / CLOCK / CLOCK.PAS
Pascal/Delphi Source File  |  2000-08-15  |  7KB  |  248 lines
  1. {█▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀█}
  2. {█                                                       █}
  3. {█      Virtual Pascal Examples. Version 2.1             █}
  4. {█      Presentation Manager analog clock example        █}
  5. {█      ─────────────────────────────────────────────────█}
  6. {█      Copyright (C) 1995-2000 vpascal.com              █}
  7. {█                                                       █}
  8. {▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀}
  9.  
  10. program Clock;
  11.  
  12. {&PMTYPE PM}
  13. {&Use32+}
  14.  
  15. uses
  16.   Os2Def, Os2Base, Os2PmApi, PmObj;
  17.  
  18. const
  19.   idTimer       = 1;            { PM timer id }
  20.  
  21. const
  22.   ClockFlags = fcf_TitleBar + fcf_SysMenu + fcf_SizeBorder + fcf_MinMax +
  23.                fcf_TaskList + fcf_NoByteAlign;
  24.  
  25. type
  26.   PClockWindow = ^TClockWindow;
  27.   TClockWindow = object(PMWindow)
  28.     PS: HPS;
  29.     PixelDiam: PointL;
  30.     ClientSize: PointL;
  31.     PixelsPerMeter: PointL;
  32.     DTPrev: DateTime;
  33.     procedure DrawHand(AP: array of PointL; Angle: Integer);
  34.     function HandleMessage(Window: HWnd; Msg: ULong; Mp1,Mp2 : MParam): MResult; virtual;
  35.     procedure RotateFigure(var AP: array of PointL; Angle: Integer);
  36.     procedure ScaleFigure(var AP: array of PointL);
  37.     procedure StartupAction; virtual;
  38.     procedure CenterFigure(var AP: array of PointL);
  39.   end;
  40.  
  41.   ClockApplication = object(PMApplication)
  42.     MainWindow: PClockWindow;
  43.     constructor Init;
  44.     destructor Done; virtual;
  45.   end;
  46.  
  47. { Return the smaller of two integer values }
  48.  
  49. function Min(X, Y: Integer): Integer;
  50. begin
  51.   if X < Y then Min := X else Min := Y;
  52. end;
  53.  
  54. { ClockApplication }
  55.  
  56. constructor ClockApplication.Init;
  57. begin
  58.   inherited Init;
  59.   MainWindow := New(PClockWindow, Init('VP Clock', 'Clock', ClockFlags));
  60. end;
  61.  
  62. destructor ClockApplication.Done;
  63. begin
  64.   Dispose(MainWindow, Done);
  65.   inherited Done;
  66. end;
  67.  
  68. { TClockWindow }
  69.  
  70. procedure TClockWindow.StartupAction;
  71. var
  72.   Size: Integer;
  73. begin
  74.   WinStartTimer(Anchor, ClientWindow, idTimer, 1000);
  75.   Size := Min(DesktopSize.X div 3, DesktopSize.Y div 3);
  76.   WinSetWindowPos(FrameWindow, 0, DesktopSize.X - Size, DesktopSize.Y - Size,
  77.     Size, Size, swp_Move + swp_Size + swp_Activate + swp_Show);
  78. end;
  79.  
  80. { Handles PM messages }
  81.  
  82. function TClockWindow.HandleMessage(Window: HWnd; Msg: ULong; Mp1,Mp2: MParam): MResult;
  83. var
  84.   DC: HDC;
  85.   DiamMM, Angle, I: Integer;
  86.   AP: array [0..2] of PointL;
  87.   DT: DateTime;
  88. const
  89.   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));
  90.   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));
  91.   Second: array [0..1] of PointL = ((X:0; Y:0  ), (X:0; Y:80));
  92.   BigCycle: array [0..1] of Integer = (10, 8);
  93. begin
  94.   HandleMessage := 0;
  95.   case Msg of
  96.     wm_Create:
  97.       begin
  98.         DC := WinOpenWindowDC(Window);
  99.         DevQueryCaps(DC, caps_Vertical_Resolution,   1, PixelsPerMeter.Y);
  100.         DevQueryCaps(DC, caps_Horizontal_Resolution, 1, PixelsPerMeter.X);
  101.         DosGetDateTime(DTPrev) ;
  102.         DTPrev.hours := (DTPrev.hours * 5) mod 60 + DTPrev.minutes div 12;
  103.       end;
  104.  
  105.     wm_Size:
  106.       begin
  107.         ClientSize.X := LongRec(Mp2).Lo;
  108.         ClientSize.Y := LongRec(Mp2).Hi;
  109.         DiamMM := Min(ClientSize.X * 1000 div PixelsPerMeter.X,
  110.                       ClientSize.Y * 1000 div PixelsPerMeter.Y);
  111.         PixelDiam.X := PixelsPerMeter.X * DiamMM div 1000;
  112.         PixelDiam.Y := PixelsPerMeter.Y * DiamMM div 1000;
  113.       end;
  114.  
  115.     wm_Timer:
  116.       begin
  117.         DosGetDateTime(DT);
  118.         DT.hours := (DT.hours * 5) mod 60 + DT.minutes div 12;
  119.         PS := WinGetPS(Window);
  120.         GpiSetColor(PS, clr_Background);
  121.         DrawHand(Second, DTPrev.seconds);
  122.         if (DT.hours <> DTPrev.hours) or (DT.minutes <> DTPrev.minutes) then
  123.         begin
  124.           DrawHand(Hour, DTPrev.hours);
  125.           DrawHand(Minute, DTPrev.minutes);
  126.         end;
  127.         GpiSetColor(PS, clr_Black);
  128.         DrawHand(Hour, DT.hours);
  129.         GpiSetColor(PS, clr_Darkgray);
  130.         DrawHand(Minute, DT.minutes);
  131.         GpiSetColor(PS, clr_Red);
  132.         DrawHand(Second, DT.seconds);
  133.         WinReleasePS(PS);
  134.         DTPrev := DT;
  135.       end;
  136.  
  137.     wm_Paint:
  138.       begin
  139.         PS := WinBeginPaint(Window, 0, nil);
  140.         GpiErase(PS);
  141.         for Angle := 0 to 59 do
  142.         begin
  143.           I := 0;
  144.           repeat
  145.             if I = 1 then GpiSetColor(PS, clr_Darkcyan) else GpiSetColor(PS, clr_Black);
  146.             AP[0].X := 0;
  147.             AP[0].Y := 90;
  148.             RotateFigure(AP[0], Angle);
  149.             ScaleFigure(AP[0]);
  150.             CenterFigure(AP[0]);
  151.             if (Angle mod 5) <> 0 then AP[2].X := 2 else AP[2].X := BigCycle[I];
  152.             AP[2].Y := AP[2].X;
  153.             ScaleFigure(AP[2]);
  154.             Dec(AP[0].X, AP[2].X div 2);
  155.             Dec(AP[0].Y, AP[2].Y div 2);
  156.             AP[1].X := AP[0].X + AP[2].X;
  157.             AP[1].Y := AP[0].Y + AP[2].Y;
  158.             GpiMove(PS, AP[0]);
  159.             GpiBox(PS, dro_OutlineFill, AP[1], AP[2].X, AP[2].Y);
  160.             Inc(I);
  161.           until ((Angle mod 5) <> 0) or (I = 2);
  162.         end;
  163.         GpiSetColor(PS, clr_Black);
  164.         DrawHand(Hour, DTPrev.hours);
  165.         GpiSetColor(PS, clr_Darkgray);
  166.         DrawHand(Minute, DTPrev.minutes);
  167.         GpiSetColor(PS, clr_Red);
  168.         DrawHand(Second, DTPrev.seconds);
  169.         WinEndPaint(PS);
  170.       end;
  171.  
  172.      else HandleMessage := WinDefWindowProc(Window, Msg, Mp1, Mp2);
  173.    end;
  174. end;
  175.  
  176. { Rotates figure }
  177.  
  178. procedure TClockWindow.RotateFigure(var AP: array of PointL; Angle: Integer);
  179. var
  180.   P: PointL;
  181.   I: Integer;
  182. const
  183.   Factor: Single = 6 * PI / 180;
  184. begin
  185.   for I := 0 to High(AP) do
  186.   with AP[I] do
  187.     begin
  188.       P.X := Round(X * Sin(((Angle + 15) mod 60) * Factor) +
  189.         Y * Sin(Angle * Factor));
  190.       P.Y := Round(Y * Sin(((Angle + 15) mod 60) * Factor) -
  191.         X * Sin(Angle * Factor));
  192.       AP[I] := P;
  193.     end;
  194. end;
  195.  
  196. { Scales figure }
  197.  
  198. procedure TClockWindow.ScaleFigure(var AP: array of PointL);
  199. var
  200.   I: Integer;
  201. begin
  202.   for I := 0 to High(AP) do
  203.     with AP[I] do
  204.     begin
  205.       X := X * PixelDiam.X div 200;
  206.       Y := Y * PixelDiam.Y div 200;
  207.     end;
  208. end;
  209.  
  210. { Centers figure on the client window }
  211.  
  212. procedure TClockWindow.CenterFigure(var AP: array of PointL);
  213. var
  214.   I: Integer;
  215. begin
  216.   for I := 0 to High(AP) do
  217.   with AP[I] do
  218.     begin
  219.       Inc(X, ClientSize.X div 2);
  220.       Inc(Y, ClientSize.Y div 2);
  221.     end;
  222. end;
  223.  
  224. { Draws watch hand }
  225.  
  226. procedure TClockWindow.DrawHand(AP: array of PointL; Angle: Integer);
  227. var
  228.   I: Integer;
  229. begin
  230.   RotateFigure(AP, Angle);
  231.   ScaleFigure(AP);
  232.   CenterFigure(AP);
  233.   GpiBeginPath(PS, 1);
  234.   GpiMove(PS, AP[0]);
  235.   GpiPolyLine(PS, High(AP), AP[1]);
  236.   GpiEndPath(PS);
  237.   GpiFillPath(PS, 1, fpath_Alternate);
  238. end;
  239.  
  240. var
  241.   AnalogClock: ClockApplication;
  242.  
  243. begin
  244.   AnalogClock.Init;
  245.   AnalogClock.Run;
  246.   AnalogClock.Done;
  247. end.
  248.