Вопрос Сообщение с автозакрытием (MsgBox) - (Решено)

Хамик

Хамик

Старожил
Подскажите, пожалуйста, есть варианты как создать MsgBox с таймером на кнопке ОК и c последующим автозакрытием msgbox'a в inno setup?
Инка расширенная китайская.
Может это подойдет SendMessageTimeout, только не знаю как её использовать в inno setup.
 
Krinkels

Krinkels

Он где то тут
Администратор
code_language.pascal: 
[Code]
#ifdef UNICODE
  #define AW "W"
#else
  #define AW "A"
#endif
const
  MB_TIMEDOUT = 32000;
  MB_ICONERROR = $10;
  MB_ICONQUESTION = $20;
  MB_ICONWARNING = $30;
  MB_ICONINFORMATION = $40;

function MessageBoxTimeout(hWnd: HWND; lpText: string; lpCaption: string;
  uType: UINT; wLanguageId: Word; dwMilliseconds: DWORD): Integer;
  external 'MessageBoxTimeout{#AW}@user32.dll stdcall';

procedure InitializeWizard;
begin
  MessageBoxTimeout(WizardForm.Handle, 'This message will be automatically ' +
    'closed in 5 seconds!', 'Caption...', MB_OK or MB_ICONINFORMATION, 0, 5000);
end;
 
Хамик

Хамик

Старожил
@Krinkels, Спасибо! Как вариант без альтернативы сойдет, но все же больше интересует вариант с обратным отсчетом на кнопке.
 
Krinkels

Krinkels

Он где то тут
Администратор
Ну, возможно придётся извращаться. Пара вариантов на ум приходит:
1. Вызвать MessageBox и самому в нём менять текст кнопки, с последующим закрытием
2. Сделать свою форму, в которой реализовать нечто подобное, описанное в п.1

Пока приходит на ум только такое
 
Хамик

Хамик

Старожил
@Krinkels, п.1 тоже о таком думал, но не могу сообразить как реализовать функцию (таймер), которая бы работала параллельно работе msgbox'a?
 
Krinkels

Krinkels

Он где то тут
Администратор
Ну, устанавливаешь таймер, в функции таймера, через FindWindow, по заголовку, ищешь нужный MessageBox. Нашёл? Отлично. Через SetWindowText меняешь текст на кнопке, а так же в конце отсчёта её "нажимаешь"
 
Хамик

Хамик

Старожил
То есть при показе msgbox'a работа таймера не приостанавливается?
 
Andreo Fadio

Andreo Fadio

Ветеран
Хамик написал(а):
То есть при показе msgbox'a работа таймера не приостанавливается?
Нажмите для раскрытия...
Inno'вский MsgBox тормозит вообще всю обработку, его на таймер не повесишь.
Или таймер и системный вызывать, но отображаться отсчет не будет, или своя форма с таймером и вешать прожатие кнопки, или писать свою dll с таким функционалом и вызывать действие такое оттуда.
 
sergey3695

sergey3695

Ветеран
Модератор
@Хамик,
как вариант своя форма. вот нагуглил )

С помощью MsgBox - сделать кнопку " ОК " и начинает периодически меняться, чтобы обратный отсчет - Инно сетап - CodeRoad.Wiki

Нет встроенной функции с такой функциональностью. Ни в Inno Setup, ни в WinAPI. Вы должны реализовать диалог самостоятельно и использовать таймер для осуществления обратного отсчета. [Code] function...
coderoad.wiki
code_language.pascal: 
function SetTimer(hWnd: LongWord; nIDEvent, uElapse: LongWord;
  lpTimerFunc: LongWord): LongWord; external 'SetTimer@user32.dll stdcall';
function KillTimer(hWnd: HWND; uIDEvent: LongWord): BOOL;
  external 'KillTimer@user32.dll stdcall';

var
  CountdownButton: TNewButton;
  Countdown: Integer;

procedure UpdateCountDownButtonCaption;
begin
  CountdownButton.Caption := Format('%d sec', [Countdown]);
end;

procedure CountdownProc(H: LongWord; Msg: LongWord; IdEvent: LongWord; Time: LongWord);
begin
  Dec(Countdown);
  if Countdown = 0 then
  begin
    CountdownButton.Enabled := True;
    TForm(CountdownButton.Parent).Close;
  end
    else
  begin
    UpdateCountDownButtonCaption;
  end;
end;

procedure CountdownMessageBoxCloseQuery(Sender: TObject; var CanClose: Boolean);
begin
  { Prevent the dialog from being close by the X button and Alt-F4 }
  CanClose := CountdownButton.Enabled;
end;

procedure CountdownMessageBox(Message: string; Seconds: Integer);
var
  Form: TSetupForm;
  MessageLabel: TLabel;
  Timer: LongWord;
begin
  Form := CreateCustomForm;
  try
    Form.ClientWidth := ScaleX(256);
    Form.ClientHeight := ScaleY(96);
    Form.Caption := 'Information';
    Form.Position := poMainFormCenter;
    Form.OnCloseQuery := @CountdownMessageBoxCloseQuery;

    MessageLabel := TLabel.Create(Form);
    MessageLabel.Top := ScaleY(16);
    MessageLabel.Left := ScaleX(16);
    MessageLabel.AutoSize := True;
    MessageLabel.Caption := Message;
    MessageLabel.Parent := Form;

    if CountdownButton <> nil then
      RaiseException('Countdown in progress already');

    Countdown := Seconds;

    CountdownButton := TNewButton.Create(Form);
    CountdownButton.Parent := Form;
    CountdownButton.Width := ScaleX(88);
    CountdownButton.Height := ScaleY(26);
    CountdownButton.Left := Form.ClientWidth - CountdownButton.Width - ScaleX(18);
    CountdownButton.Top := Form.ClientHeight - CountdownButton.Height - ScaleX(11);
    UpdateCountDownButtonCaption;
    CountdownButton.Name := 'CountdownButton';
    CountdownButton.ModalResult := mrOk;
    CountdownButton.Default := True;
    CountdownButton.Enabled := False;

    Timer := SetTimer(0, 0, 1000, CreateCallback(@CountdownProc));

    try
      Form.ShowModal();
    finally
      KillTimer(0, Timer);
    end;
  finally
    Form.Free();
    CountdownButton := nil;
  end;
end;
Используйте его, как:
CountdownMessageBox('Message here', 10);
 
Хамик

Хамик

Старожил
Всем спасибо! На основе ваших сообщений сочинил под свои нужды.
Может кому-то пригодится. Сочинил в виде модуля для удобства использования:
code_language.pascal: 
[Code]
#ifdef UNICODE
  #define AW "W"
#else
  #define AW "A"
#endif

var
  tmr: TTimer;
  i: integer;
  ext: boolean;

const
  WM_CLOSE = $0010;
  WM_SETTEXT = $C;

function SetWindowText(hWnd: hWnd; LPCSTR: string): bool; external 'SetWindowText{#AW}@user32.dll stdcall';
function GetDlgItem(hWnd: hWnd; nIDDlgItem: integer): HWND; external 'GetDlgItem@user32.dll stdcall';

procedure Timer(Sender: TObject);
var
wnd, btn : HWND;
begin
  wnd := FindWindowByWindowName(SetupMessage(msgSetupAppTitle));
  if wnd <> 0 then
  begin
    btn := GetDlgItem(wnd, 2);
    if btn <> 0 then
      begin
        SetWindowText(btn, 'ОК '+IntToStr(i-1));
        i:=i-1;
        if i < 1 then
          begin
            if ext <> false then
            SendMessage(wnd, WM_CLOSE, 0, 0) else
            SetWindowText(btn, 'ОК');
            tmr.Enabled := false;
          end;
      end;
  end;
end;

procedure MsgBoxTimeOut(const Text: string; WaitSeconds: integer; AutoClose: boolean);
begin
  i := WaitSeconds+1;
  ext := AutoClose;
  tmr := TTimer.Create(nil);
  with tmr do
    begin
      Interval := 1000;
      OnTimer := @Timer;
    end;
    MsgBox(Text, mbInformation, MB_OK);
end;
Пример использования:
code_language.pascal: 
#include "MsgBoxTimeOut.iss"

[Setup]
AppName = My Program
AppVersion = 1.0
DefaultDirName = {pf}\MsgBoxTimeOut
OutputDir = .
OutputBaseFilename = MsgBoxTimeOut

[Code]
procedure InitializeWizard();
begin
  MsgBoxTimeOut('Hello', 5, true);
end;
 
Последнее редактирование:
Krinkels

Krinkels

Он где то тут
Администратор
ИМХО всё что связано с переменной "frst" лишнее. Ну и "sname: PansiChar;" нужно удалить.
И нужно разбираться с кодировкой, на юникод версии на кнопку каракули выводятся
А вообще получается нечто типа такого(MsgBoxTimeOut.iss):
code_language.pascal: 
[Code]
#ifdef UNICODE
    #define AW "W"
#else
    #define AW "A"
#endif

var
    tmr: TTimer;
    i: integer;
    ext: boolean;

const
    WM_CLOSE = $0010;
    WM_SETTEXT = $C;

function SetWindowText(hWnd: hWnd; LPCSTR: string): bool; external 'SetWindowText{#AW}@user32.dll stdcall';
function GetDlgItem(hWnd: hWnd; nIDDlgItem: integer): HWND; external 'GetDlgItem@user32.dll stdcall';

procedure Timer(Sender: TObject);
var
    wnd, btn : HWND;
begin
    wnd := FindWindowByWindowName(SetupMessage(msgSetupAppTitle));
    if wnd <> 0 then
    begin
        btn := GetDlgItem(wnd, 2);
        if btn <> 0 then
        begin
            SetWindowText(btn, 'ОК '+IntToStr(i));
            i:=i-1;
            if i < 1 then
            begin
                if ext = true then
                    SendMessage(wnd, WM_CLOSE, 0, 0)
                else
                    SetWindowText(btn, 'ОК');

                tmr.Enabled := false;
            end;
        end;
    end;
end;

procedure MsgBoxTimeOut(const Text: string; WaitSeconds: integer; AutoClose: boolean);
begin
    i := WaitSeconds;
    ext := AutoClose;
    tmr := TTimer.Create(nil);
    with tmr do
        begin
            Interval := 1000;
            OnTimer := @Timer;
        end;
    MsgBox(Text, mbInformation, MB_OK);
end;
 
sergey3695

sergey3695

Ветеран
Модератор
Krinkels написал(а):
И нужно разбираться с кодировкой, на юникод версии на кнопку каракули выводятся
Нажмите для раскрытия...
code_language.pascal: 
var
  tmr: TTimer;
  i: integer;
  ext: boolean;
  wnd, btn : HWND;
const
  WM_CLOSE = $0010;
  WM_SETTEXT = $C;

function SendMessageW(hWnd: HWND; Msg: UINT; wParam: Longint; lParam: Pansichar): Longint; external 'SendMessageA@user32.dll stdcall';
function GetDlgItem(hWnd: hWnd; nIDDlgItem: integer): HWND; external 'GetDlgItem@user32.dll stdcall';

procedure Timer(Sender: TObject);
begin
  i:= i - 1;
  if (wnd = 0) then
  begin
    wnd := FindWindowByWindowName(SetupMessage(msgSetupAppTitle));
    tmr.Interval:= 1000;
  end;
  if (btn = 0) and (wnd <> 0) then
    btn := GetDlgItem(wnd, 2);
  if (btn <> 0) then
    SendMessageW(btn, WM_SETTEXT, 0, SetupMessage(msgButtonOK) + ' ' + IntToStr(i));
  if (i = 0) then
  begin
  if (ext = true) and (wnd <> 0) then
    SendMessage(wnd, WM_CLOSE, 0, 0);
    tmr.Enabled := false;
  end;
end;

procedure MsgBoxTimeOut(const Text: string; WaitSeconds: integer; AutoClose: boolean);
begin
  i := WaitSeconds + 1;
  ext := AutoClose;
  tmr := TTimer.Create(nil);
  with tmr do
  begin
    Interval := 1;
    OnTimer := @Timer;
  end;
  MsgBox(Text, mbInformation, MB_OK);
  wnd:= 0;
  btn:= 0;
  tmr.Free;
end;

procedure InitializeWizard;
begin
  MsgBoxTimeOut('Текст', 3, true);
end;
ИМХО каждый раз получать хендл лишнее. Ну и "tmr.Free;" и смену текста при появлении можно добавить. 🙃
 
Последнее редактирование:
nik1967

nik1967

Old Men
Проверенный
Хамик написал(а):
Инка расширенная китайская.
Нажмите для раскрытия...
А так?
function MsgBoxEx(AWnd: HWND; AText, ACaption: string; AType, AIcon: UINT; ATimeOut: Integer): Integer;
Описание: Расширенный месседжбокс.
Правда таймер не на кнопке.
code_language.pascal: 
#ifndef IS_ENHANCED
  #error Enhanced edition of Inno Setup (restools) is required to compile this script
#endif

[Setup]
AppName=exit v1.0
AppVerName=exit v1.0
OutputDir=.
CreateAppDir=no
CreateUninstallRegKey=no

[Code]

procedure CancelButtonClick(CurPageID: Integer; var Cancel, Confirm: Boolean);
begin
  Confirm:= false;
    Cancel:= false;
  if MsgBoxEx(WizardForm.Handle, SetupMessage(msgExitSetupMessage), SetupMessage(msgExitSetupTitle), MB_YESNO or MB_ICONINFORMATION, 0, 10) = IDYES then Cancel:= true;
end;
 
Последнее редактирование:
Войдите или зарегистрируйтесь для ответа.
Сверху