Вопрос Progress Loop will freeze setup

InstallationWay

Новичок
Here is an example which will fill the progress bar 5 times using a for loop.
But during looping, the full UI will freeze.

How can I avoid such UI freezing?
 

Вложения

Shegorat

Lord of Madness
Администратор
Код:
function PeekMessage(var lpMsg: TMsg; hWnd: HWND; wMsgFilterMin, wMsgFilterMax, wRemoveMsg: UINT): BOOL; external 'PeekMessageA@user32.dll stdcall';
function TranslateMessage(const lpMsg: TMsg): BOOL; external 'TranslateMessage@user32.dll stdcall';
function DispatchMessage(const lpMsg: TMsg): Longint; external 'DispatchMessageA@user32.dll stdcall';

procedure AppProcessMessage();
var
  Msg: TMsg;
begin
  if (not PeekMessage(Msg, 0, 0, 0, 1)) then
    Exit;

  TranslateMessage(Msg);
  DispatchMessage(Msg);
end;

procedure brClick(Sender:TObject);
var
 i,j: Integer;
begin
    for i := 1 to 5 do begin
      for j := 1 to 100 do begin
        ImgPBSetPosition2(PB2,j);
        ImgApplyChanges(WizardForm.Handle);
        AppProcessMessage();
      end;
    end;
    ImgPBSetPosition2(PB2,0);
    ImgApplyChanges(WizardForm.Handle);
end;

Позволяет избежать фризов окна инсталлятора, но некоторые вещи всё равно работать не будут
 

InstallationWay

Новичок
Код:
function PeekMessage (var lpMsg: TMsg; hWnd: HWND; wMsgFilterMin, wMsgFilterMax, wRemoveMsg: UINT): BOOL; external'PeekMessageA@user32.dll stdcall ';
function TranslateMessage (const lpMsg: TMsg): BOOL; external'TranslateMessage@user32.dll stdcall ';
function DispatchMessage (const lpMsg: TMsg): Longint; external'DispatchMessageA@user32.dll stdcall ';

procedure AppProcessMessage ();
var
  Msg: TMsg;
begin
  if (not PeekMessage (Msg, 0, 0, 0, 1)) then
    Exit;

  TranslateMessage (Msg);
  DispatchMessage (Msg);
end;

procedure brClick (Sender: TObject);
var
i, j: Integer;
begin
    for i: = 1 to 5 do begin
      for j: = 1 to 100 do begin
        ImgPBSetPosition2 (PB2, j);
        ImgApplyChanges (WizardForm.Handle);
        AppProcessMessage ();
      end;
    end;
    ImgPBSetPosition2 (PB2,0);
    ImgApplyChanges (WizardForm.Handle);
end;

Allows you to avoid freezes of the installer window, but some things will still not work
Exiting setup will not work. (Pressing on Cancel or X during the loop will show a prompt message, But clicking on Yes will not exit the setup). Any way to fix?
 

DiCaPrIo

Новичок
Код:
var
  PB2 : TImgPB2;
  br   : TButton;
  IsClosed:Boolean;

procedure brClick(Sender:TObject);
var
i,j: Integer;
begin
    for i := 1 to 5 do begin
      for j := 1 to 100 do begin
        ImgPBSetPosition2(PB2,j);
        ImgApplyChanges(WizardForm.Handle);
        Application.ProcessMessages;
        if IsClosed then
        break;
      end;
    end;
    ImgPBSetPosition2(PB2,0);
    ImgApplyChanges(WizardForm.Handle);
end;

function NextButtonClick(CurPageID: Integer): Boolean;
begin
  ImgPBDelete2(PB2);
  ImgApplyChanges(WizardForm.Handle);
end;

function InitializeSetup:boolean;
begin
  if not FileExists(ExpandConstant('{tmp}\botva2.dll')) then ExtractTemporaryFile('botva2.dll');
  Result:=True;
end;

procedure InitializeWizard;
begin
  IsClosed:=False;
  with WizardForm do begin
    InnerNotebook.Hide;
    OuterNotebook.Hide;
    Bevel.Hide;
  end;

  ImgLoad(WizardForm.Handle,'nfs.jpg',0,0,WizardForm.ClientWidth,WizardForm.ClientHeight,True,True);
  PB2:=ImgPBCreate2(WizardForm.Handle,'{#pbbkg}','{#pb}',10,200,WizardForm.ClientWidth-20,22,8,8,4);
  ImgApplyChanges(WizardForm.Handle);

  br:=TButton.Create(WizardForm);
  with br do begin
    Parent:=WizardForm;
    SetBounds(10,170,100,21);
    Caption:='Loop';
    OnClick:=@brClick;
  end;

end;

procedure CancelButtonClick(CurPageID: Integer; var Cancel, Confirm: Boolean);
begin
  Confirm := False;
  Cancel := ExitSetupMsgBox;
  if Cancel then
    IsClosed:=True;
end;

procedure DeinitializeSetup;
begin
   gdipShutdown;
end;
 
Сверху