Здравствуйте, 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;