mytimerimpl1.~pas

delphi 编写的高精度定时器控件

unit MyTimerImpl1;

{$WARN SYMBOL_PLATFORM OFF}

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  ActiveX, AxCtrls, MyTimerPrj_TLB, StdVcl, HiResTim, ExtCtrls;

type
  TMyTimer = class(TActiveForm, IMyTimer)
    HiResTimer1: THiResTimer;
    Image1: TImage;
  private
    { Private declarations }
    FEvents: IMyTimerEvents;
     procedure TimerEvent(Sender: TObject);
  protected
    { Protected declarations }

    FInterval:integer;
    FResolution:integer;
    FEnabled:boolean;
    procedure StoreProperty(Writer:TWriter);
    procedure LoadProperty(Reader:TReader);
    procedure DefineProperties(Filer: TFiler); override;
    constructor Create(AOwner: TComponent); override;
    

    procedure DefinePropertyPages(DefinePropertyPage: TDefinePropertyPage); override;
    procedure EventSinkChanged(const EventSink: IUnknown); override;
    function Get_Enabled: WordBool; safecall;

    procedure Set_Enabled(Value: WordBool); safecall;
    function Get_Interval: Integer; safecall;
    function Get_Resolution: Integer; safecall;
    procedure Set_Interval(Value: Integer); safecall;
    procedure Set_Resolution(Value: Integer); safecall;
    procedure AboutBox; safecall;
  public
    { Public declarations }
    procedure Initialize; override;
  end;

implementation

uses ComObj, ComServ, About1;

{$R *.DFM}

{ TMyTimer }

procedure TMyTimer.DefinePropertyPages(DefinePropertyPage: TDefinePropertyPage);
begin
  { Define property pages here.  Property pages are defined by calling
    DefinePropertyPage with the class id of the page.  For example,
      DefinePropertyPage(Class_MyTimerPage); }
end;

procedure TMyTimer.EventSinkChanged(const EventSink: IUnknown);
begin
  FEvents := EventSink as IMyTimerEvents;
  inherited EventSinkChanged(EventSink);
end;

procedure TMyTimer.Initialize;
begin
  inherited Initialize;
   HiResTimer1.OnTimer:=TimerEvent;
end;



function TMyTimer.Get_Enabled: WordBool;
begin
  Result := FEnabled;
end;






procedure TMyTimer.Set_Enabled(Value: WordBool);
begin
  FEnabled := Value;
  hirestimer1.Enabled :=FEnabled;
  
end;


function TMyTimer.Get_Interval: Integer;
begin
  result:=Finterval;
end;

function TMyTimer.Get_Resolution: Integer;
begin
  result:=Fresolution;
end;

procedure TMyTimer.Set_Interval(Value: Integer);
begin
  Finterval:=value;
  hirestimer1.Interval:=Finterval;

end;

procedure TMyTimer.Set_Resolution(Value: Integer);
begin
  Fresolution:=value;
  hirestimer1.Resolution:=Fresolution; 
end;



procedure TMyTimer.StoreProperty(Writer:TWriter);
begin
 writer.WriteInteger(FInterval);
 writer.WriteInteger(FResolution);
 writer.WriteBoolean(FEnabled);




end;

procedure TMyTimer.LoadProperty(Reader:TReader);
begin
 FInterval:=reader.ReadInteger;
 hirestimer1.Interval:=FInterval;
 FResolution:=reader.ReadInteger;
 hirestimer1.Resolution:=FResolution;
 Fenabled:=reader.ReadBoolean;
 hirestimer1.Enabled:=FEnabled;

end;

procedure TMyTimer.DefineProperties(Filer: TFiler);
begin
inherited;
filer.DefineProperty('MyProperty',LoadProperty,StoreProperty,true);

end;

procedure TMyTimer.TimerEvent(Sender: TObject);
begin
  if FEvents <> nil then FEvents.OnTimer;
end;
constructor TMyTimer.Create(AOwner: TComponent);
begin
  
  self.AutoSize:=true;
  inherited create(aowner);
  self.width:=32;
  self.height:=32;
  self.Constraints.MaxHeight:=32;
  self.Constraints.MaxWidth:=32;
  self.Constraints.MinHeight:=32;
  self.Constraints.MinWidth:=32;


end;
procedure TMyTimer.AboutBox;
begin
  ShowMyTimerAbout;
end;

initialization
  TActiveFormFactory.Create(
    ComServer,
    TActiveFormControl,
    TMyTimer,
    Class_MyTimer,
    1,
    '{197B151A-9D6F-4DCC-BAA8-E4B51D2DD68B}',
    OLEMISC_INVISIBLEATRUNTIME,
    //OLEMISC_SIMPLEFRAME or OLEMISC_ACTSLIKELABEL,
    tmApartment);
end.