www.pudn.com > Roulette.rar > ULoading.pas

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.