uloading.pas

一般的数据库管理系统 uses Classes, SConnectEx, TltConst, ExtCtrls, MMSystem, Types, windows, TltLogic , Sy

unit ULoading;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls;

type
  TLoadingForm = class(TForm)
    Label1: TLabel;
  private
  protected
    procedure CreateParams(var Params: TCreateParams); override;
    { Private declarations }

  public
    { Public declarations }

  end;

  procedure ShowLoading(Msg : String);
  procedure HideLoading;
implementation
const
  WM_LabelChanged = WM_USER + 1;
  WM_Free = WM_User + 2;
var
  LoadingForm: TLoadingForm;
  LoadingHintThread: THandle;
  Lable1 : DWord;
  MsgStr : string;
  Visible : boolean;

function WindowProc(hWnd, uMsg,	wParam,	lParam: Integer): Integer; stdcall;
begin

  Result := DefWindowProc(hWnd, uMsg, wParam, lParam);
  if uMsg = WM_NCHITTEST then Result := HTCAPTION;
{  if WM_Free =  uMsg then
  begin
   //SendMessage(hWnd,WM_QUIT,0,0);
    PostQuitMessage(0);
    Result := 100;
  end;}

  { Checks for messages }
//  if uMsg = WM_DESTROY then
//    Halt;
end;

var
  P: TPoint;
  Handle, ThreadID : DWord;
  Msg : TMsg;

  WinClass: TWndClassA;
  Inst, Button1, Label1, Edit1, Edit2: Integer;
  hFont : DWord;

procedure LoadingHintThreadFunc(Param: Integer); stdcall;
var
  Timer : DWord;
begin
  ThreadID := GetCurrentThreadID;
  Inst := hInstance;
  with WinClass do
  begin
    style              := CS_CLASSDC or CS_PARENTDC;
    lpfnWndProc        := @WindowProc;
    hInstance          := Inst;
    hbrBackground      := color_btnface + 1 ;
    lpszClassname      := 'LoadingMsgWindow';
    hCursor            := LoadCursor(0, IDC_ARROW);
  end;
  windows.RegisterClass(WinClass);
  Handle := CreateWindowEx( WS_EX_WINDOWEDGE or WS_EX_TOOLWINDOW
                             ,
                     'LoadingMsgWindow', '',
                          WS_VISIBLE or WS_DISABLED
                          or WS_THICKFRAME or WS_POPUP or WS_BORDER,
                           Screen.Width div 2-100, Screen.Height div 2 -25, 200, 50, 0, 0, Inst, nil);
//}
//  Handle := createdio
  Label1 := CreateWindow('Static', '', WS_VISIBLE or WS_CHILD or SS_CENTER,
                8, 17, 184, 13, Handle, 0, Inst, nil);
  if hFont =0 then
  hFont := CreateFont(-11, 0, 0, 0, 400, 0, 0, 0, DEFAULT_CHARSET,
                        OUT_DEFAULT_PRECIS, CLIP_DEFAULT_PRECIS, DEFAULT_QUALITY,
                        DEFAULT_PITCH or FF_DONTCARE, 'MS Sans Serif');
  if hFont <>0 then
  begin
    SendMessage(Label1, WM_SETFONT, hFont, 0);
  end;
  SetWindowText(Label1, Pchar(MsgStr));
  UpdateWindow(Handle);
//}
//   LoadingForm.Show;
//  SetWindowLong(LoadingForm.Handle,GWL_WNDPROC,Integer(@WindowProc));

//  ShowWindow(LoadingForm.Handle,SW_SHOW);
//   ShowWindow(Handle, SW_SHOW);
//  LoadingForm.Show;

  {message loop}
  Timer := SetTimer(0,500,500,0);
  while(GetMessage(Msg,0,0,0))do
  begin
    if not Visible then begin
      PostQuitMessage(0);
      Break;
    end;
    if Msg.message = WM_LabelChanged then
      SetWindowText(Label1, Pchar(MsgStr))
    else
    begin
      TranslateMessage(Msg);
      DispatchMessage(Msg);
    end;
  end;
  if Timer<>0 then KillTimer(Timer,500);
  windows.DestroyWindow(Label1);
  windows.DestroyWindow(Handle);
  windows.DeleteObject(hFont);
  Label1 :=0;
  Handle :=0;
  hFont :=0;
//  FreeAndNil(LoadingForm);
end;

procedure ShowLoading(Msg : String);
var
  Handle : DWord;
begin
  MsgStr := Msg;
  Visible := true;
  if LoadingHintThread = 0 then
    Handle := CreateThread(nil, 1000, @LoadingHintThreadFunc, nil, 0,LoadingHintThread ) 
  else
    while not PostThreadMessage(LoadingHintThread, WM_LabelChanged ,0 ,0) do sleep(100);
end;

procedure HideLoading;
begin
  if LoadingHintThread <> 0 then
  begin
    Visible := false;
    PostThreadMessage(LoadingHintThread,WM_Quit,0,0);
  end;
  LoadingHintThread := 0;

//  FreeAndNil(LoadingForm);
end;

{$R *.dfm}
{ TLoadingForm }


{ TLoadingForm }

procedure TLoadingForm.CreateParams(var Params: TCreateParams);
begin
  inherited;
  Params.WndParent := 0;
end;

end.