[TROY Diamond]

Serega

Вы как-то делали "фейковый" индикатор процесса, по типу IE. Есть ли сейчас какие-нибудь варианты и наработки?
Нужна индикация процесса во время установки дополнительного ПО - установка долгая минут 15...
Можете ли Вы "доработать" Ваш индикатор, "под секцию Code", а не "под Run"?

читать дальше »

Код:

function SetWindowLong(hWnd: HWND; nIndex: Integer; dwNewLong: Longint): Longint; external 'SetWindowLongA@user32.dll stdcall';
function GetWindowLong(hWnd: HWND; nIndex: Integer): Longint; external 'GetWindowLongA@user32.dll stdcall';

const
  PBM_SETMARQUEE = $040A;
  GWL_STYLE      = -16;
  PBS_MARQUEE    = $08;

var
  AnimatePb: TNewProgressBar;

procedure CreateAnimatePb;
begin
  AnimatePb := TNewProgressBar.Create(WizardForm);
  with AnimatePb do
    begin
      Parent := WizardForm.InstallingPage;
      SetBounds(WizardForm.ProgressGauge.Left, WizardForm.ProgressGauge.Top + WizardForm.ProgressGauge.Height + ScaleY(-21),
                WizardForm.ProgressGauge.Width, WizardForm.ProgressGauge.Height);
      SetWindowLong (AnimatePb.Handle, GWL_STYLE, (GetWindowLong (AnimatePb.Handle, GWL_STYLE) or PBS_MARQUEE));
      SendMessage(AnimatePb.Handle, PBM_SETMARQUEE, 1, 20);
    end;
end;

procedure AnimatePbMsg(const msg: string);
begin
  if AnimatePb = nil then
    CreateAnimatePb;
  WizardForm.FilenameLabel.Caption := msg;
end;

procedure AnimatePbFree;
begin
  if AnimatePb <> nil then
    begin
      AnimatePb.Free;
      AnimatePb := nil;
    end;
end;

И действительно он НЕ работает на некоторых темах (скорее всего из-за того что они не подписанные/не официальные)... Работает на "стандартной" во всех ОС и на "Классической" - но бегунок двигается намного медленнее...