////////////////////////////////////////////////// // DB Access Components // Copyright © 1998-2007 Core Lab. All right reserved. // SQLMonitor supports // Created: 17.11.99 ////////////////////////////////////////////////// {$IFNDEF CLR} {$I Dac.inc} unit Win32Timer; {$ENDIF} interface uses {$IFDEF LINUX} QExtCtrls; {$ENDIF} {$IFDEF CLR} ExtCtrls; {$ENDIF} {$IFDEF WIN32} Classes, Windows, Messages, MemData, DAConsts; {$ENDIF} type {$IFDEF WIN32} TWin32Timer = class(TComponent) private FInterval: Cardinal; FWindowHandle: HWND; FOnTimer: TNotifyEvent; FEnabled: Boolean; procedure UpdateTimer; procedure SetEnabled(Value: Boolean); procedure SetInterval(Value: Cardinal); procedure SetOnTimer(Value: TNotifyEvent); protected procedure Timer; dynamic; public constructor Create(AOwner: TComponent); override; destructor Destroy; override; published property Enabled: Boolean read FEnabled write SetEnabled default True; property Interval: Cardinal read FInterval write SetInterval default 1000; property OnTimer: TNotifyEvent read FOnTimer write SetOnTimer; end; {$ELSE} TWin32Timer = TTimer; {$ENDIF} implementation {$IFDEF WIN32} function TimerWndProc(Window: HWND; Message, WParam: Longint; LParam: Longint): Longint; stdcall; var Timer: TWin32Timer; begin Result := 1; Timer := TWin32Timer(GetWindowLong(Window, GWL_USERDATA)); if Message = WM_TIMER then try Timer.Timer; except ApplicationHandleException(Timer); end else Result := DefWindowProc(Window, Message, WParam, LParam); end; var AlerterWindowClass: TWndClass = ( style: 0; lpfnWndProc: @TimerWndProc; cbClsExtra: 0; cbWndExtra: 0; hInstance: 0; hIcon: 0; hCursor: 0; hbrBackground: 0; lpszMenuName: nil; lpszClassName: 'TOraAlerterWindow'); { TWin32Timer } constructor TWin32Timer.Create(AOwner: TComponent); var TempClass: TWndClass; ClassRegistered: Boolean; begin inherited Create(AOwner); FEnabled := True; FInterval := 1000; // allocate timer window AlerterWindowClass.hInstance := HInstance; ClassRegistered := GetClassInfo(HInstance, AlerterWindowClass.lpszClassName, TempClass); if not ClassRegistered or (TempClass.lpfnWndProc <> @TimerWndProc) then begin if ClassRegistered then Windows.UnregisterClass(AlerterWindowClass.lpszClassName, HInstance); Windows.RegisterClass(AlerterWindowClass); end; FWindowHandle := CreateWindowEx(WS_EX_TOOLWINDOW, AlerterWindowClass.lpszClassName, '', WS_POPUP {!0}, 0, 0, 0, 0, 0, 0, HInstance, nil); // pass Self to window SetWindowLong(FWindowHandle, GWL_USERDATA, Longint(Self)); end; destructor TWin32Timer.Destroy; begin FEnabled := False; UpdateTimer; DestroyWindow(FWindowHandle); inherited Destroy; end; procedure TWin32Timer.UpdateTimer; begin KillTimer(FWindowHandle, 1); if (FInterval <> 0) and FEnabled and Assigned(FOnTimer) then if SetTimer(FWindowHandle, 1, FInterval, nil) = 0 then raise EOutOfResources.Create(SNoTimers); end; procedure TWin32Timer.SetEnabled(Value: Boolean); begin if Value <> FEnabled then begin FEnabled := Value; UpdateTimer; end; end; procedure TWin32Timer.SetInterval(Value: Cardinal); begin if Value <> FInterval then begin FInterval := Value; UpdateTimer; end; end; procedure TWin32Timer.SetOnTimer(Value: TNotifyEvent); begin FOnTimer := Value; UpdateTimer; end; procedure TWin32Timer.Timer; begin if Assigned(FOnTimer) then FOnTimer(Self); end; {$ENDIF} end.