Re[9]: При долгой загрузке данных показать форму с програссб
От: Danchik Украина  
Дата: 27.04.05 09:47
Оценка: 5 (2)
Здравствуйте, linker, Вы писали:

L>Здравствуйте, kavlad, Вы писали:


K>>Здравствуйте, linker, Вы писали:


L>>>но пока проблема никак не решилась.


K>>Я же тебе код написал, который решит твою проблему

K>>Посмотри повнимательнее.

L>Все равно в начале Open потом пауза, а потом progress заполняется очень быстро(почти сразу).

Так оно и будет...

Ты бы сначала сказал какой датасет используеш? BDE, ADO, что то другое.

Я для этой цели использовал поток который сорздавал форму и имел свой обработчик событий. Тогда подвисает только приложение, а ProgressWindow висит себе как нивчем небывало, кручу себе там прогрессик или говорю "Подождите пожалуйста". Сразу предупрежу если захочеш такое реализовать не используй TForm — ничего не выйдет. TForm синхронизируется с главным окном приложения через SendMessage (висит короче все).

Да и не приводите контр выпады с Application.ProcessMessage — это полный Unsafe и в некоторых случаях совсем неприменим.

Привожу базовые классы, если интересно, конечно. На идеальность не претендует но идею подхватить можна...

type
  TWindowThread = class(TThread)
  private
    function ProcessMessage(var Msg: TMsg): Boolean;
  protected
    procedure Execute; override;
    procedure CreateWindow; virtual; abstract;
    procedure DestroyWindow; virtual; abstract;
    procedure Idle; virtual;
  public
    procedure ProcessMessages;
  end;

  TThreadForm = class(TWinControl)
  private
    FIcon: TIcon;
    procedure SetIcon(Value: TIcon);
    function IsIconStored: Boolean;
    function GetIconHandle: HICON;
    procedure WMPaint(var Message: TWMPaint); message WM_PAINT;
  protected
    procedure CreateParams(var Params: TCreateParams); override;
  public
    constructor Create(AOwner : TComponent); override;
    destructor Destroy; override;
    procedure CreateWnd; override;
    property Icon: TIcon read FIcon write SetIcon stored IsIconStored;
  end;

implementation

procedure TWindowThread.Execute;
begin
  CreateWindow;
  try
    repeat
      ProcessMessages;
    until Terminated;
  finally
    DestroyWindow;
  end;
end;

function TWindowThread.ProcessMessage(var Msg: TMsg): Boolean;
begin
  Result := False;

  if PeekMessage(Msg, 0, 0, 0, PM_NOREMOVE) then
  begin
    if GetMessage (Msg, 0, 0, 0) then begin
      Result := True;
      if Msg.Message <> WM_QUIT then begin
        TranslateMessage(Msg);
        DispatchMessage(Msg);
      end else
        Terminate;
    end;
  end else
    WaitMessage;

  Idle;

end;

procedure TWindowThread.Idle; 
begin
  { что то себе делай }
end;

procedure TWindowThread.ProcessMessages;
var
  Msg: TMsg;
begin
  while not Terminated and ProcessMessage (Msg) do {loop};
end;

constructor TThreadForm.Create(AOwner: TComponent);
begin
  inherited;
  FIcon        := TIcon.Create;
  FIcon.Width  := GetSystemMetrics(SM_CXSMICON);
  FIcon.Height := GetSystemMetrics(SM_CYSMICON);
end;

destructor TThreadForm.Destroy;
begin
  FIcon.Free;
  inherited;
end;

procedure TThreadForm.CreateParams(var Params: TCreateParams);
begin
  inherited;
  with Params.WindowClass do
    Style := Style and not (CS_HREDRAW or CS_VREDRAW);
  Params.WndParent := 0;
  Params.Style := Params.Style and not (WS_CHILD or WS_GROUP or WS_TABSTOP);
  Params.Style := Params.Style or (WS_CAPTION or WS_BORDER);
  Params.WindowClass.lpfnWndProc := @DefWindowProc;
  with Params do
    Style := Style or WS_SYSMENU;
  Params.WindowClass.hIcon := GetIconHandle; 
end;

procedure TThreadForm.CreateWnd;
begin
  inherited CreateWnd;
  SendMessage(Handle, WM_SETICON, 1, GetIconHandle);
end;

function TThreadForm.GetIconHandle: HICON;
begin
  Result := FIcon.Handle;
  if Result = 0 then Result := Application.Icon.Handle;
end;

function TThreadForm.IsIconStored: Boolean;
begin
  Result := Icon.Handle <> 0;
end;

procedure TThreadForm.SetIcon(Value: TIcon);
begin
  FIcon.Assign(Value);
end;

procedure TThreadForm.WMPaint(var Message: TWMPaint);
var
  DC: HDC;
  PS: TPaintStruct;
begin
  inherited;
  if not IsIconic(Handle) then
  begin
    ControlState := ControlState + [csCustomPaint];
    inherited;
    ControlState := ControlState - [csCustomPaint];
  end
  else
  begin
    DC := BeginPaint(Handle, PS);
    DrawIcon(DC, 0, 0, GetIconHandle);
    EndPaint(Handle, PS);
  end;
end;
 
Подождите ...
Wait...
Пока на собственное сообщение не было ответов, его можно удалить.