SYSDBA в 15:10, 23 мая 2008

2008-05-23T15:10:27Z

SYSDBA в 14:43, 23 мая 2008

2008-05-23T14:43:18Z

Новая страница

unit IBSQL_WaitWindow;

interface

uses
Classes, Windows, Messages;

type
TIBSQL_WaitWindowThread = class(TThread)
private
FWnd, FLabel: hWnd;
FStartTime: DWORD;
FShow: Boolean;
FScreenWidth, FScreenHeight: Integer;

procedure CreateWinAPIForm;
procedure RegisterWindowClass;
procedure UnRegisterWindowClass;

protected
procedure Execute; override;

public
procedure StartSQL;
procedure FinishSQL;
end;

var
IBSQL_WaitWindowThread: TIBSQL_WaitWindowThread;

implementation

uses
SysUtils, Forms;

const
WindowClassName = 'IBSQL_WaitWindowClass';
idLabel = 1;
idTimer = 2;
InitialDelay = 2000;
RefreshRate = 1000;

function WindowProc(Wnd: HWnd; Msg: Integer; WParam: WParam; LParam: LParam): LResult; stdcall;
begin
Result := DefWindowProc(Wnd, Msg, WParam, LParam);
end;

{ TIBSQL_WaitWindowThread }

procedure TIBSQL_WaitWindowThread.CreateWinApiForm;
const
WindowHeight = 80;
WindowWidth = 232;
begin
FWnd := CreateWindowEx(
WS_EX_DLGMODALFRAME or WS_EX_TOPMOST,
WindowClassName,
'Идет выполнение SQL запроса...',
WS_DLGFRAME or WS_VISIBLE,
(FScreenWidth - WindowWidth) div 2,
(FScreenHeight - WindowHeight) div 2,
WindowWidth,
WindowHeight,
0, 0,
hInstance,
nil);

FLabel := CreateWindow(
'static',
'',
WS_VISIBLE or WS_CHILD or BS_TEXT,
12, 18,
WindowWidth - 20, 20,
FWnd,
idLabel,
hInstance,
nil);

SetTimer(FWnd, idTimer, RefreshRate, nil);

ShowWindow(FWnd, SW_SHOW);
end;

procedure TIBSQL_WaitWindowThread.Execute;
var
Msg: TMsg;
T: DWORD;
begin
RegisterWindowClass;
try
while not Terminated do
begin
if not FShow then
Suspend
else begin
T := 0;
FStartTime := GetTickCount;
Sleep(InitialDelay);
if not FShow then
continue;
CreateWinApiForm;
try
while (not Terminated) and FShow
and GetMessage(Msg, 0, 0, 0) do
begin
TranslateMessage(Msg);
DispatchMessage(Msg);
if GetTickCount - T >= RefreshRate then
begin
T := GetTickCount;
SetWindowText(FLabel,
PChar('Время выполнения: ' + IntToStr((GetTickCount - FStartTime) div 1000) + ' сек.'));
end;
end;
finally
KillTimer(FWnd, idTimer);
DestroyWindow(FWnd);
end;
end;
end;
finally
UnRegisterWindowClass;
end;
end;

procedure TIBSQL_WaitWindowThread.FinishSQL;
begin
FShow := False;
end;

procedure TIBSQL_WaitWindowThread.RegisterWindowClass;
var
WC: TWndClassEx;
begin
WC.cbsize := SizeOf(WC);
WC.style := cs_bytealignwindow or cs_hredraw or cs_vredraw or cs_noclose or cs_savebits;
WC.lpfnwndproc := @WindowProc;
WC.cbclsextra := 0;
WC.cbwndextra := 0;
WC.hInstance := hInstance;
WC.hIcon := LoadIcon(0, idi_application);
WC.hCursor := LoadCursor(0, idc_arrow);
WC.hbrBackground := 1;
WC.lpszMenuName := nil;
WC.lpszClassName := WindowClassName;
WC.hIconSm := 0;
Assert(Windows.RegisterClassEx(WC) <> 0, IntToStr(GetLastError));
end;

procedure TIBSQL_WaitWindowThread.StartSQL;
begin
if Suspended and (not FShow) then
begin
FScreenWidth := Screen.Width;
FScreenHeight := Screen.Height;
FShow := True;
Resume;
end;
end;

procedure TIBSQL_WaitWindowThread.UnRegisterWindowClass;
begin
Windows.UnregisterClass(WindowClassName, hInstance);
end;

initialization
IBSQL_WaitWindowThread := TIBSQL_WaitWindowThread.Create(True);
IBSQL_WaitWindowThread.Priority := tpLowest;
IBSQL_WaitWindowThread.FreeOnTerminate := False;

finalization
FreeAndNil(IBSQL_WaitWindowThread);
end.

@@ Строка 1: / Строка 1: @@
    unit IBSQL_WaitWindow;
@@ Строка 146: / Строка 145: @@
      WC.lpszClassName := WindowClassName;
      WC.hIconSm := 0;
-     Assert(Windows.RegisterClassEx(WC) <> 0, IntToStr(GetLastError));
+     Windows.RegisterClassEx(WC);
    end;

IBSQL WaitWindow.pas - История изменений

SYSDBA в 15:10, 23 мая 2008

SYSDBA в 14:43, 23 мая 2008