Power-Programmierung/CD1.mdf/magazine/pctchnqs/1991/number6/pie/pietest.pas

Pascal/Delphi Source File | 1991-12-10 | 5KB | 203 lines

{ pietest.pas -- Test Pie Control by Tom Swan }

program PieTest;

{$R pietest.res }

uses WinTypes, WinProcs, WObjects;

const
  PieCtrlDLL = 'piectrl.dll';  { Name of custom control DLL }
  em_DLLNotFound = 1;          { DLL not found error code }
  cm_Test = 101;               { Menu Test command ID }
  id_Menu = 100;               { Menu resource ID }
  id_Dialog = 100;             { Dialog resource ID }
  id_PieCtrl = 1;              { Pie control resource ID }
  endTime = 15;                { Max time for test dialog }

{$I piectrl.inc }  { Include message identifiers }

type
  TPieApp = object(TApplication)
    LibHandle: THandle;
    constructor Init(AName: PChar);
    destructor Done; virtual;
    procedure Error(ErrorCode: Integer); virtual;
    procedure InitMainWindow; virtual;
  end;

  PPieWin = ^TPieWin;
  TPieWin = object(TWindow)
    Testing: Boolean;
    constructor Init(AParent: PWindowsObject; ATitle: PChar);
    function CanClose: Boolean; virtual;
    procedure CMTest(var Msg: TMessage);
      virtual cm_First + cm_Test;
  end;

  PPieDlg = ^TPieDlg;
  TPieDlg = object(TDialog)
    ContinueFlag: Boolean;
    BackBrush, ForeBrush: HBrush;
    constructor Init(AParent: PWindowsObject; ResourceID: Word);
    destructor Done; virtual;
    procedure Start(EndTime: Word);
    procedure Update(Time: Word);
    procedure Ok(var Msg: TMessage);
      virtual id_First + id_Ok;
    procedure Cancel(var Msg: TMessage);
      virtual id_First + id_Cancel;
    procedure WMCtlColor(var Msg: TMessage);
      virtual wm_First + wm_CtlColor;
  end;

procedure Delay(MSecs: LongInt);
var
  Mark: LongInt;
begin
  Mark := GetTickCount + MSecs;
  repeat { Wait } until GetTickCount >= Mark;
end;

{ TPieApp }

constructor TPieApp.Init(AName: PChar);
begin
  LibHandle := LoadLibrary(PieCtrlDLL);
  if LibHandle < 32 then
    Status := em_DLLNotFound
  else
    TApplication.Init(AName);
end;

destructor TPieApp.Done;
begin
  if LibHandle >= 32 then
    FreeLibrary(LibHandle);
  TApplication.Done;
end;

procedure TPieApp.Error(ErrorCode: Integer);
begin
  case ErrorCode of
    em_DLLNotFound:
      Halt(ErrorCode);
  else
    TApplication.Error(ErrorCode);
  end;
end;

procedure TPieApp.InitMainWindow;
begin
  MainWindow := New(PPieWin, Init(nil, 'PieTest'))
end;

{ TPieWin }

constructor TPieWin.Init(AParent: PWindowsObject; ATitle: PChar);
begin
  TWindow.Init(AParent, ATitle);
  Attr.Menu := LoadMenu(HInstance, PChar(id_Menu));
  Testing := false;
end;

function TPieWin.CanClose: Boolean;
begin
  CanClose := not Testing;
end;

procedure TPieWin.CMTest(var Msg: TMessage);
var
  D: PPieDlg;         { Pointer to modeless dialog }
  Time: Word;         { Local time unit counter }
  Finished: Boolean;  { "Operation completed" flag }
begin
  Testing := true;    { Prevent app from ending }
  D := PPieDlg(       { Create the dialog instance }
    Application^.MakeWindow(New(PPieDlg,
    Init(@Self, id_Dialog))));
  D^.Start(endTime);  { Initialize custom control }
  Time := 0;          { Initialize local time unit }
  Finished := false;  { Initialize "operation completed" flag }
  while (not Finished) and (D^.ContinueFlag) do
  begin
    D^.Update(Time);  { Update custom control position }
    Delay(500);       { Insert operation to perform }
    MessageBeep(0);   { Optional audible feedback }
    Inc(Time);        { Count time units passed }
    Finished := (Time > endTime);  { Ensures display of "100%" }
  end;
  if IsWindow(D^.HWindow) then
    D^.CloseWindow;   { Close and dispose dialog }
  Testing := false;   { Permit app to end }
end;

{ TPieDlg }

constructor TPieDlg.Init(AParent:PWindowsObject;ResourceID:Word);
begin
  TDialog.Init(AParent, PChar(ResourceID));
  EnableKBHandler;
  ContinueFlag := true;
  BackBrush := CreateSolidBrush(RGB(16, 0, 16));
  ForeBrush := CreateSolidBrush(RGB(255, 0, 0));
end;

destructor TPieDlg.Done;
begin
  DeleteObject(BackBrush);
  DeleteObject(ForeBrush);
  TDialog.Done;
end;

procedure TPieDlg.Start(EndTime: Word);
begin
  SendDlgItemMessage(HWindow, id_PieCtrl,pie_SetLimit,EndTime,0);
  SendDlgItemMessage(HWindow, id_PieCtrl,pie_SetIndex,0,0);
  Show(sw_ShowNormal);
  SetFocus(HWindow);
  ContinueFlag := true;
end;

procedure TPieDlg.Update(Time: Word);
var
  Msg: TMsg;
begin
  SendDlgItemMessage(HWindow, id_PieCtrl, pie_SetIndex, Time, 0);
  while PeekMessage(Msg, 0, 0, 0, pm_Remove) do
  if not IsDialogMessage(HWindow, Msg) then
  begin
    TranslateMessage(Msg);
    DispatchMessage(Msg);
  end;
end;

procedure TPieDlg.Ok(var Msg: TMessage);
begin
end;

procedure TPieDlg.Cancel(var Msg: TMessage);
begin
  ContinueFlag := false;
end;

procedure TPieDlg.WMCtlColor(var Msg: TMessage);
begin
  case Msg.LParamHi of
    pie_BackColor:
      Msg.Result := BackBrush;
    pie_ForeColor:
      Msg.Result := ForeBrush;
  else
    DefWndProc(Msg);
  end;
end;

var
  PieApp: TPieApp;
begin
  PieApp.Init('PieTest');
  PieApp.Run;
  PieApp.Done
end.