Software of the Month Club 1995 December/SOFM_Dec1995.bin/pc/os2/vpascal/examples/clock/clock.pas

Pascal/Delphi Source File | 1995-10-31 | 7.3 KB | 254 lines

{█▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀█}
{█                                                       █}
{█      Virtual Pascal Examples. Version 1.0.            █}
{█      Presentation Manager analog clock example        █}
{█      ─────────────────────────────────────────────────█}
{█      Written by Vitaly Miryanov                       █}
{█      ─────────────────────────────────────────────────█}
{█      Copyright (C) 1995 B&M&T Corporation             █}
{█                                                       █}
{▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀}

program Clock;

uses Os2Def, Os2Base, Os2PmApi, PmObj, Use32;

{$IFDEF DYNAMIC_VERSION}
  {$Dynamic System }
  {$L VPRTL.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_Darkgray);
        DrawHand(Hour, DT.hours);
        DrawHand(Minute, DT.minutes);
        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_Darkgray);
        DrawHand(Hour, DTPrev.hours);
        DrawHand(Minute, DTPrev.minutes);
        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);
const
  SinTable: array [0..59] of SmallInt =
    (   0,  105,  208,  309,  407,  500,  588,  669,  743,  809,
      866,  914,  951,  978,  995, 1000,  995,  978,  951,  914,
      866,  809,  743,  669,  588,  500,  407,  309,  208,  105,
        0, -104, -207, -308, -406, -499, -587, -668, -742, -808,
     -865, -913, -950, -977, -994, -999, -994, -977, -950, -913,
     -865, -808, -742, -668, -587, -499, -406, -308, -207, -104
    );
var
  P: PointL;
  I: Integer;
begin
  for I := 0 to High(AP) do
  with AP[I] do
    begin
      P.X := (X * SinTable[(Angle + 15) mod 60] +
              Y * SinTable[Angle]) div 1000;
      P.Y := (Y * SinTable[(Angle + 15) mod 60] -
              X * SinTable[Angle]) div 1000;
      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.