home *** CD-ROM | disk | FTP | other *** search
/ Delphi Programming Unleashed / Delphi_Programming_Unleashed_SAMS_Publishing_1995.iso / units / clock.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1995-03-21  |  3.0 KB  |  153 lines
  1. unit Clock;
  2.  
  3. { Program copyright (c) 1995 by Charles Calvert }
  4. { Project Name: CLOCK3 }
  5.  
  6. interface
  7.  
  8. uses
  9.   SysUtils, WinTypes, WinProcs,
  10.   Messages, Classes, Graphics,
  11.   Controls, Forms, StdCtrls,
  12.   DsgnIntf, Dialogs;
  13.  
  14. type
  15.   TClock = class(TCustomControl)
  16.   private
  17.     FTimer: Integer;
  18.     FRunning: Boolean;
  19.     procedure SetRunning(Run: Boolean);
  20.   protected
  21.     procedure Paint; override;
  22.     procedure WMTimer(var Message: TMessage); message WM_Timer;
  23.     procedure WMDestroy(var Message: TMessage); message wm_Destroy;
  24.   public
  25.     constructor Create(AOwner: TComponent); override;
  26.   published
  27.     property Running: Boolean read FRunning write SetRunning;
  28.   end;
  29.  
  30.   TClockEditor = class(TComponentEditor)
  31.     procedure Edit; override;
  32.   end;
  33.  
  34.   TColorClock = class(TClock)
  35.   private
  36.     FColor: TColor;
  37.     procedure SetColor(Color: TColor);
  38.   protected
  39.     procedure Paint; override;
  40.   public
  41.     constructor Create(AOwner: TComponent); override;
  42.   published
  43.     property Color: TColor read FColor write SetColor;
  44.   end;
  45.  
  46.   TColorNameProperty = class(TColorProperty)
  47.   public
  48.     function GetAttributes: TPropertyAttributes; override;
  49.     procedure Edit; override;
  50.   end;
  51.  
  52.  
  53. procedure Register;
  54.  
  55. implementation
  56.  
  57. uses
  58.   StrBox;
  59.  
  60. procedure Register;
  61. begin
  62.   RegisterComponents('Unleash', [TClock, TColorClock]);
  63.   RegisterComponentEditor(TClock, TClockEditor);
  64.   RegisterPropertyEditor(TypeInfo(TColor),
  65.                  TClock, 'Color',
  66.                  TColorNameProperty);
  67. end;
  68.  
  69. { --- TClock --- }
  70.  
  71. constructor TClock.Create(AOwner: TComponent);
  72. begin
  73.   inherited Create(AOwner);
  74.   Width := 100;
  75.   height := 100;
  76.   FTimer := 1;
  77. end;
  78.  
  79. procedure TClock.wmDestroy(var Message: TMessage);
  80. begin
  81.   KillTimer(Handle, FTimer);
  82.   FTimer := 0;
  83.   inherited;
  84. end;
  85.  
  86. procedure TClock.Paint;
  87. begin
  88.   Canvas.Ellipse(0, 0, 100, 100);
  89. end;
  90.  
  91. procedure TClock.SetRunning(Run: Boolean);
  92. begin
  93.   if Run then begin
  94.     SetTimer(Handle, FTimer, 50, nil);
  95.     FRunning := True;
  96.   end else begin
  97.     KillTimer(Handle, FTimer);
  98.     FRunning := False;
  99.   end;
  100. end;
  101.  
  102. procedure TClock.WMTimer(var Message: TMessage);
  103. begin
  104.   Canvas.TextOut(10, 40, GetTimeString);
  105. end;
  106.  
  107. { --- TColorClock --- }
  108.  
  109. constructor TColorClock.Create(AOwner: TComponent);
  110. begin
  111.   inherited Create(AOwner);
  112.   FColor := clGreen;
  113. end;
  114.  
  115.  
  116. procedure TColorClock.Paint;
  117. begin
  118.   Canvas.Brush.Color := FColor;
  119.   inherited Paint;
  120. end;
  121.  
  122. procedure TColorClock.SetColor(Color: TColor);
  123. begin
  124.   FColor := Color;
  125.   InvalidateRect(Handle, nil, True);
  126. end;
  127.  
  128. { --- TClockEditor --- }
  129.  
  130. procedure TClockEditor.Edit;
  131. begin
  132.   MessageDlg('Clock copyright (c) 1995 Charlie Calvert',
  133.               mtInformation, [mbOK],0);
  134. end;
  135.  
  136. { --- TColorNameProperty --- }
  137.  
  138. function TColorNameProperty.GetAttributes;
  139. begin
  140.   Result := [paMultiSelect, paValueList, paDialog];
  141. end;
  142.  
  143. procedure TColorNameProperty.Edit;
  144. var
  145.   S: String;
  146. begin
  147.   S := '';
  148.   InputQuery('New Color', 'Enter Color', S);
  149.   SetValue(S);
  150. end;
  151.  
  152. end.
  153.