ithreadtimers.pas

iocopm3.04源码,一套很好的工控开发工具

    procedure DestroyTimer(var ATimer: TiTimerThread);
    function  CreateTimer(Interval: Integer; AOnTimer: TNotifyEvent): TiTimerThread;
  public
    constructor Create(AOwner: TComponent);                       override;
    destructor  Destroy;                                          override;
    procedure   SetBounds(ALeft, ATop, AWidth, AHeight: Integer); override;
    property    OnDblClick;
  published
    property Enabled1        : Boolean         read FEnabled1          write SetEnabled1       default False;
    property Enabled2        : Boolean         read FEnabled2          write SetEnabled2       default False;
    property Enabled3        : Boolean         read FEnabled3          write SetEnabled3       default False;
    property Enabled4        : Boolean         read FEnabled4          write SetEnabled4       default False;
    property Enabled5        : Boolean         read FEnabled5          write SetEnabled5       default False;
    property Enabled6        : Boolean         read FEnabled6          write SetEnabled6       default False;
    property Enabled7        : Boolean         read FEnabled7          write SetEnabled7       default False;
    property Enabled8        : Boolean         read FEnabled8          write SetEnabled8       default False;
    property Enabled9        : Boolean         read FEnabled9          write SetEnabled9       default False;

    property Interval1       : Integer         read GetInterval1       write SetInterval1       default 1000;
    property Interval2       : Integer         read GetInterval2       write SetInterval2       default 1000;
    property Interval3       : Integer         read GetInterval3       write SetInterval3       default 1000;
    property Interval4       : Integer         read GetInterval4       write SetInterval4       default 1000;
    property Interval5       : Integer         read GetInterval5       write SetInterval5       default 1000;
    property Interval6       : Integer         read GetInterval6       write SetInterval6       default 1000;
    property Interval7       : Integer         read GetInterval7       write SetInterval7       default 1000;
    property Interval8       : Integer         read GetInterval8       write SetInterval8       default 1000;
    property Interval9       : Integer         read GetInterval9       write SetInterval9       default 1000;

    {$ifdef iVCL}
    property ThreadPriority1 : TThreadPriority read GetThreadPriority1 write SetThreadPriority1 default tpNormal;
    property ThreadPriority2 : TThreadPriority read GetThreadPriority2 write SetThreadPriority2 default tpNormal;
    property ThreadPriority3 : TThreadPriority read GetThreadPriority3 write SetThreadPriority3 default tpNormal;
    property ThreadPriority4 : TThreadPriority read GetThreadPriority4 write SetThreadPriority4 default tpNormal;
    property ThreadPriority5 : TThreadPriority read GetThreadPriority5 write SetThreadPriority5 default tpNormal;
    property ThreadPriority6 : TThreadPriority read GetThreadPriority6 write SetThreadPriority6 default tpNormal;
    property ThreadPriority7 : TThreadPriority read GetThreadPriority7 write SetThreadPriority7 default tpNormal;
    property ThreadPriority8 : TThreadPriority read GetThreadPriority8 write SetThreadPriority8 default tpNormal;
    property ThreadPriority9 : TThreadPriority read GetThreadPriority9 write SetThreadPriority9 default tpNormal;
    {$endif}

    {$ifdef iCLX}
    property ThreadPriorityWindows1 : TiThreadPriority read GetThreadPriorityWindows1 write SetThreadPriorityWindows1;
    property ThreadPriorityWindows2 : TiThreadPriority read GetThreadPriorityWindows2 write SetThreadPriorityWindows2;
    property ThreadPriorityWindows3 : TiThreadPriority read GetThreadPriorityWindows3 write SetThreadPriorityWindows3;
    property ThreadPriorityWindows4 : TiThreadPriority read GetThreadPriorityWindows4 write SetThreadPriorityWindows4;
    property ThreadPriorityWindows5 : TiThreadPriority read GetThreadPriorityWindows5 write SetThreadPriorityWindows5;
    property ThreadPriorityWindows6 : TiThreadPriority read GetThreadPriorityWindows6 write SetThreadPriorityWindows6;
    property ThreadPriorityWindows7 : TiThreadPriority read GetThreadPriorityWindows7 write SetThreadPriorityWindows7;
    property ThreadPriorityWindows8 : TiThreadPriority read GetThreadPriorityWindows8 write SetThreadPriorityWindows8;
    property ThreadPriorityWindows9 : TiThreadPriority read GetThreadPriorityWindows9 write SetThreadPriorityWindows9;

    property ThreadPriorityLinux1   : Integer          read GetThreadPriorityLinux1   write SetThreadPriorityLinux1;
    property ThreadPriorityLinux2   : Integer          read GetThreadPriorityLinux2   write SetThreadPriorityLinux2;
    property ThreadPriorityLinux3   : Integer          read GetThreadPriorityLinux3   write SetThreadPriorityLinux3;
    property ThreadPriorityLinux4   : Integer          read GetThreadPriorityLinux4   write SetThreadPriorityLinux4;
    property ThreadPriorityLinux5   : Integer          read GetThreadPriorityLinux5   write SetThreadPriorityLinux5;
    property ThreadPriorityLinux6   : Integer          read GetThreadPriorityLinux6   write SetThreadPriorityLinux6;
    property ThreadPriorityLinux7   : Integer          read GetThreadPriorityLinux7   write SetThreadPriorityLinux7;
    property ThreadPriorityLinux8   : Integer          read GetThreadPriorityLinux8   write SetThreadPriorityLinux8;
    property ThreadPriorityLinux9   : Integer          read GetThreadPriorityLinux9   write SetThreadPriorityLinux9;

    property ThreadPolicyLinux1     : TiThreadPolicy   read GetThreadPolicyLinux1     write SetThreadPolicyLinux1 default itpSCHED_OTHER;
    property ThreadPolicyLinux2     : TiThreadPolicy   read GetThreadPolicyLinux2     write SetThreadPolicyLinux2 default itpSCHED_OTHER;
    property ThreadPolicyLinux3     : TiThreadPolicy   read GetThreadPolicyLinux3     write SetThreadPolicyLinux3 default itpSCHED_OTHER;
    property ThreadPolicyLinux4     : TiThreadPolicy   read GetThreadPolicyLinux4     write SetThreadPolicyLinux4 default itpSCHED_OTHER;
    property ThreadPolicyLinux5     : TiThreadPolicy   read GetThreadPolicyLinux5     write SetThreadPolicyLinux5 default itpSCHED_OTHER;
    property ThreadPolicyLinux6     : TiThreadPolicy   read GetThreadPolicyLinux6     write SetThreadPolicyLinux6 default itpSCHED_OTHER;
    property ThreadPolicyLinux7     : TiThreadPolicy   read GetThreadPolicyLinux7     write SetThreadPolicyLinux7 default itpSCHED_OTHER;
    property ThreadPolicyLinux8     : TiThreadPolicy   read GetThreadPolicyLinux8     write SetThreadPolicyLinux8 default itpSCHED_OTHER;
    property ThreadPolicyLinux9     : TiThreadPolicy   read GetThreadPolicyLinux9     write SetThreadPolicyLinux9 default itpSCHED_OTHER;
    {$endif}

    property OnTimer1        : TNotifyEvent    read GetOnTimer1        write SetOnTimer1;
    property OnTimer2        : TNotifyEvent    read GetOnTimer2        write SetOnTimer2;
    property OnTimer3        : TNotifyEvent    read GetOnTimer3        write SetOnTimer3;
    property OnTimer4        : TNotifyEvent    read GetOnTimer4        write SetOnTimer4;
    property OnTimer5        : TNotifyEvent    read GetOnTimer5        write SetOnTimer5;
    property OnTimer6        : TNotifyEvent    read GetOnTimer6        write SetOnTimer6;
    property OnTimer7        : TNotifyEvent    read GetOnTimer7        write SetOnTimer7;
    property OnTimer8        : TNotifyEvent    read GetOnTimer8        write SetOnTimer8;
    property OnTimer9        : TNotifyEvent    read GetOnTimer9        write SetOnTimer9;

    property Visible          default False;
    property Width            default 28;
    property Height           default 28;
    property PopupMenu;
  end;

implementation
//****************************************************************************************************************************************************
procedure TiTimerThread.AfterConstruction;
begin
  inherited;
  {$ifdef iVCL}WindowHandle := AllocateHWnd(MessageMethod);{$endif}
end;
//****************************************************************************************************************************************************
destructor TiTimerThread.Destroy;
begin
  {$ifdef iVCL}DeallocateHWnd(WindowHandle);{$endif}
  inherited;
end;
//****************************************************************************************************************************************************
procedure TiTimerThread.DoEvent;
begin
  if Terminated then Exit;
  if Assigned(OnTimer) then OnTimer(Owner);
end;
//****************************************************************************************************************************************************
{$ifdef iVCL}
procedure TiTimerThread.MessageMethod(var Message: TMessage);
begin
  if Message.Msg <> WM_ITHREADTIMERMSG then EXIT;
  if Terminated then Exit;
  if Assigned(OnTimer) then OnTimer(Owner);
end;
{$endif}
//****************************************************************************************************************************************************
procedure TiTimerThread.Execute;
begin
  while (not Terminated) do
    begin                 
      Sleep(Interval);
      {$ifdef iVCL}if not Terminated then SendNotifyMessage(WindowHandle, WM_ITHREADTIMERMSG, 0, 0);{$endif}
      {$ifdef iCLX}if not Terminated then Synchronize(DoEvent);                                     {$endif}
    end;
end;
//****************************************************************************************************************************************************
{$ifdef iCLX}
procedure TiTimerThread.SetPriorityWindows(const Value: TiThreadPriority);
begin
  {$ifdef MSWINDOWS}Priority         := TThreadPriority(Value);{$endif}
  {$ifdef LINUX}    FPriorityWindows := Value;                 {$endif}
end;
//****************************************************************************************************************************************************
procedure TiTimerThread.SetPriorityLinux(const Value: Integer);
begin
  {$ifdef MSWINDOWS}FPriorityLinux := Value;{$endif}
  {$ifdef LINUX}    Priority       := Value;{$endif}
end;
//****************************************************************************************************************************************************
procedure TiTimerThread.SetPolicyLinux(const Value: TiThreadPolicy);
begin
  {$ifdef MSWINDOWS}FPolicyLinux := Value;     {$endif}
  {$ifdef LINUX}    Policy       := ord(Value);{$endif}
end;
//****************************************************************************************************************************************************
function TiTimerThread.GetPriorityWindows: TiThreadPriority;
begin
  {$ifdef MSWINDOWS}Result := TiThreadPriority(Priority);{$endif}
  {$ifdef LINUX}    Result := FPriorityWindows;          {$endif}
end;
//****************************************************************************************************************************************************
function TiTimerThread.GetPriorityLinux: Integer;
begin
  {$ifdef MSWINDOWS}Result := FPriorityLinux;{$endif}
  {$ifdef LINUX}    Result := Priority;      {$endif}
end;
//****************************************************************************************************************************************************
function TiTimerThread.GetPolicyLinux: TiThreadPolicy;
begin
  {$ifdef MSWINDOWS}Result := FPolicyLinux;          {$endif}
  {$ifdef LINUX}    Result := TiThreadPolicy(Policy);{$endif}
end;
{$endif}
//****************************************************************************************************************************************************
//****************************************************************************************************************************************************
//****************************************************************************************************************************************************
constructor TiThreadTimers.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);

  Width   := 28;                                 
  Height  := 28;

  Visible := False;

  FTimer1 := CreateTimer(1000, nil);
  FTimer2 := CreateTimer(1000, nil);
  FTimer3 := CreateTimer(1000, nil);
  FTimer4 := CreateTimer(1000, nil);
  FTimer5 := CreateTimer(1000, nil);
  FTimer6 := CreateTimer(1000, nil);
  FTimer7 := CreateTimer(1000, nil);
  FTimer8 := CreateTimer(1000, nil);
  FTimer9 := CreateTimer(1000, nil);

  {$ifdef iCLX}
  SetThreadPolicyLinux1(itpSCHED_OTHER);
  SetThreadPolicyLinux2(itpSCHED_OTHER);
  SetThreadPolicyLinux3(itpSCHED_OTHER);
  SetThreadPolicyLinux4(itpSCHED_OTHER);
  SetThreadPolicyLinux5(itpSCHED_OTHER);
  SetThreadPolicyLinux6(itpSCHED_OTHER);
  SetThreadPolicyLinux7(itpSCHED_OTHER);
  SetThreadPolicyLinux8(itpSCHED_OTHER);
  SetThreadPolicyLinux9(itpSCHED_OTHER);
  {$endif}
end;
//****************************************************************************************************************************************************
destructor TiThreadTimers.Destroy;
begin
  if Assigned(FTimer1) then DestroyTimer(FTimer1);
  if Assigned(FTimer2) then DestroyTimer(FTimer2);
  if Assigned(FTimer3) then DestroyTimer(FTimer3);
  if Assigned(FTimer4) then DestroyTimer(FTimer4);
  if Assigned(FTimer5) then DestroyTimer(FTimer5);
  if Assigned(FTimer6) then DestroyTimer(FTimer6);
  if Assigned(FTimer7) then DestroyTimer(FTimer7);
  if Assigned(FTimer8) then DestroyTimer(FTimer8);
  if Assigned(FTimer9) then DestroyTimer(FTimer9);
  inherited;
end;
//****************************************************************************************************************************************************
procedure TiThreadTimers.SetBounds(ALeft, ATop, AWidth, AHeight: Integer);
begin
  AWidth  := 28;
  AHeight := 28;
  inherited;