Имя пользователя:
Пароль:  
Помощь | Регистрация | Забыли пароль?  

Показать сообщение отдельно

Аватара для Johny777

Ветеран


Сообщения: 649
Благодарности: 444

Профиль | Отправить PM | Цитировать


Системные месседжбоксы:
1. выглядят жутко со скином

2. Их трудно программно сдвинуть в сторону или отобразить не по центру
3. Нельзя изменить размер кнопки и пр.
Поэтому запилил под свои нужды самопальный месседжбокс, который умеет:
старый месседжбокс:
читать дальше »

1: Подстраиваться под размер текста (как и систмный), правда алгоритм хромает
2: Возвращает результат (пока добавил только несколько комбинаций кнопок, но не все)
3: умеет как и его расширенный собрат самозакрываться
пока что не умеет:
1: Отображать на себе иконку
2: Воспроизводить звуки (ошибка, критическая ошибка и пр.)
Код:
Код: Выделить весь код
[Setup]
AppName=My Application
AppVersion=1.5
DefaultDirName={pf}\My Application

[code]
#ifdef UNICODE
    #define A "W"
#else
    #define A "A"
#endif


const
  GWL_EXSTYLE = -20;
  WS_EX_APPWINDOW = $40000;
  WS_EX_TOOLWINDOW = $80;
  //SW_HIDE = 0;
  SW_NORMAL = 1;
  GWL_HWNDPARENT = -8;
  GCL_STYLE = -26;
  CS_NOCLOSE = $200;
  WM_CLOSE = $10;
//  hhkAtlTab = 101;
//  hhkAtlSpace = 102;
//  MOD_ALT = 1;
//  VK_TAB = 9;
  MB_ICONHAND = $00000010;
//  MB_ICONQUESTION = $00000020;
  MB_ICONEXCLAMATION = $00000030;
  MB_ICONASTERISK = $00000040;
  MB_USERICON = $00000080;
//  MB_ICONWARNING                 = MB_ICONEXCLAMATION;
//  MB_ICONERROR                   = MB_ICONHAND;
//  MB_ICONINFORMATION             = MB_ICONASTERISK;
  MB_ICONSTOP                    = MB_ICONHAND;
    
type
  HDC = LongWord;
  HFONT = LongWord;
  HGDIOBJ = LongWord;
  
  STR_SIZE = record
    cx: Longint;
    cy: Longint;
  end;
  
  _MESSAGE_INFO = record
    hMsgLabel: HWND;
    dTimeOut: DWORD;
    dStartTime: DWORD;
    hMsgForm: HWND;
  end;
    
var
  MESSAGE_INFO: _MESSAGE_INFO;
    


//function GetClassLong(Wnd: HWnd; Index: Integer): Longint; external 'GetClassLong{#A}@user32.dll stdcall';
//function SetClassLong(Wnd: HWnd; Index: Integer; NewLong: Longint): Longint; external 'SetClassLong{#A}@user32.dll stdcall';
//function SetWindowLong(hWnd: HWND; nIndex: Integer; dwNewLong: Longint): Longint; external 'SetWindowLong{#A}@user32.dll stdcall';
function GetWindowLong(hWnd: HWND; nIndex: Integer): Longint; external 'GetWindowLong{#A}@user32.dll stdcall';
function ShowWindow(hWnd: HWND; nCmdShow: Integer): BOOL; external 'ShowWindow@user32.dll stdcall';
function GetDC(hWnd: HWND): HDC; external 'GetDC@user32.dll stdcall';
function SelectObject(DC: HDC; p2: HGDIOBJ): HGDIOBJ; external 'SelectObject@gdi32.dll stdcall';
function GetTextExtentPoint32(DC: HDC; Str: PChar; Count: Integer; var Size: STR_SIZE): BOOL; external 'GetTextExtentPoint32{#A}@gdi32.dll stdcall';
function ReleaseDC(hWnd: HWND; hDC: HDC): Integer; external 'ReleaseDC@user32.dll stdcall';
function StrFromTimeInterval(var pszOut: Char; cchMax: UINT; dwTimeMS: DWORD; digits: Byte): Integer; external 'StrFromTimeInterval{#A}@shlwapi.dll stdcall';
function GetTickCount: DWORD; external 'GetTickCount@kernel32.dll stdcall';
//function RegisterHotKey(hWnd: HWND; id: Integer; fsModifiers, vk: UINT): BOOL; external 'RegisterHotKey@user32.dll stdcall';
//function UnregisterHotKey(hWnd: HWND; id: Integer): BOOL; external 'UnregisterHotKey@user32.dll stdcall';
function SetTimer(hWnd, nIDEvent, uElapse, lpTimerFunc: LongWord): LongWord; external 'SetTimer@user32.dll stdcall';
function KillTimer(hWnd, nIDEvent: LongWord): LongWord; external 'KillTimer@user32.dll stdcall';
function SetWindowText(hWnd: HWND; lpString: String): BOOL; external 'SetWindowText{#A}@user32.dll stdcall';
function MessageBeep(uType: UINT): BOOL; external 'MessageBeep@user32.dll stdcall';
    
function GetStrSizeInPixels(Font: TFont; Caption: String): STR_SIZE;
var
  DC: HDC;
  SaveFont: HFONT;
begin
  DC := GetDC(0);
  try
    SaveFont := SelectObject(DC, Font.Handle);
    GetTextExtentPoint32(DC, PChar(Caption), Length(Caption), Result);
    SelectObject(DC, SaveFont);
  finally
    ReleaseDC(0, DC);
  end;
end;

function TicksToTime(Ticks: DWORD): String;
var
    i: Byte;
    arr: array [0..31] of Char;
begin
    for i := 0 to StrFromTimeInterval(arr[0], sizeof(arr), Ticks, 8)-1 do Result := Result + arr[i];
end;

function CharCount(C: Char; aStr: String): Integer;
var
  i: Integer;
begin
  Result := 0;
  for i := 1 to Length(aStr) do if aStr[i] = C then Result := Result + 1;
end;

procedure ATimeOutProc;
var
  PassedTime: DWORD;
begin
  PassedTime := GetTickCount-MESSAGE_INFO.dStartTime;
  if PassedTime >= MESSAGE_INFO.dTimeOut then PostMessage(MESSAGE_INFO.hMsgForm, WM_CLOSE, 0, 0);
  SetWindowText(MESSAGE_INFO.hMsgLabel, TicksToTime(MESSAGE_INFO.dTimeOut-PassedTime));
end;

function ShowMessageEx(AText, ACaption: string; AType: UINT; AMsgTyp: TMsgBoxType; ATimeOut: Integer): Integer;
var
  MsgBoxForm: TSetupForm;
  MsgLabel: TLabel;
  Size: STR_SIZE;
  szStatus: TNewStaticText;
  ATimeOutTimer: LongWord;
begin
  MsgBoxForm := CreateCustomForm;
  with MsgBoxForm do
  begin
    Position := poScreenCenter;
    BorderStyle := bsDialog;
    Caption := ACaption;
    Color := clBtnFace;
    ShowWindow(GetWindowLong(MsgBoxForm.Handle, GWL_HWNDPARENT), SW_HIDE);
//    RegisterHotKey(Handle, hhkAtlTab, MOD_ALT, VK_TAB);
    MsgLabel := TLabel.Create(nil)
    with MsgLabel do
    begin
      AutoSize := False;
      WordWrap := True;
      Parent := MsgBoxForm;
      Caption := AText;
      Size := GetStrSizeInPixels(Font, AText);
      Left := ScaleX(16);
      Top := ScaleY(16);
      Font.Size := 10;
      if (Size.cx > 300) and (Size.cx <= 500) then
      begin
        Width := ScaleX(Size.cx);
        Height := ScaleY(Size.cy)+Size.cy*CharCount(#13,AText)+3;
      end else if (Size.cx > 500) then
      begin
        Width := ScaleX(500);
        Height := ScaleY(Size.cy*Round(Size.cx/500)+Size.cy*CharCount(#13,AText));
      end else if (Size.cx < 300) then
      begin
        Width := ScaleX(300);
        Height := (Size.cy);
      end;
    end;

    ClientWidth := MsgLabel.Width + ScaleX(30);
    ClientHeight := MsgLabel.Height + ScaleY(70);

    with TButton.Create(nil) do
    begin
      Parent := MsgBoxForm;
      SetBounds(MsgBoxForm.ClientWidth - ScaleX(90), MsgBoxForm.ClientHeight - ScaleY(35), ScaleX(71), ScaleY(25));
      Cursor := crHand;
      case AType of
        MB_OKCANCEL:
        begin
          ModalResult := mrOk;
          Caption := SetupMessage(msgButtonOK);
        end;
        MB_YESNO:
        begin
          ModalResult := mrYes;
          Caption := SetupMessage(msgButtonYes);
        end;
        MB_OK:
        begin
          ModalResult := mrOk;
          Caption := SetupMessage(msgButtonOk);
        end;
      end;
    end;

    if AType <> MB_OK then
    with TButton.Create(nil) do
    begin
      Caption := SetupMessage(msgButtonNo);
      Parent := MsgBoxForm;
      SetBounds(MsgBoxForm.ClientWidth - ScaleX(175), MsgBoxForm.ClientHeight - ScaleY(35), ScaleX(71), ScaleY(25));
      Cursor := crHand;
      case AType of
        MB_OKCANCEL:
        begin
          ModalResult := mrCancel;
          Caption := SetupMessage(msgButtonCancel);
        end;
        MB_YESNO:
        begin
          ModalResult := mrNo;
          Caption := SetupMessage(msgButtonNo);
        end;
      end;
    end;

    if ATimeOut <> 0 then
    begin
      szStatus := TNewStaticText.Create(nil);
      with szStatus do
      begin
        Parent := MsgBoxForm;
        WordWrap := True;
        SetBounds(ScaleX(16), MsgBoxForm.ClientHeight - ScaleY(25), ScaleX(71), ScaleY(25));
      end;
      MESSAGE_INFO.hMsgLabel := szStatus.Handle;
      MESSAGE_INFO.dTimeOut := ATimeOut;
      MESSAGE_INFO.dStartTime := GetTickCount;
      MESSAGE_INFO.hMsgForm := MsgBoxForm.Handle;
      ATimeOutTimer := SetTimer(0, 777, 1, CallbackAddr('ATimeOutProc'));
    end;
    
    case AMsgTyp of
      mbError: MessageBeep(MB_ICONWARNING);
      mbInformation: if not MessageBeep(MB_ICONINFORMATION) then MessageBeep(MB_ICONASTERISK);
      mbCriticalError: if not MessageBeep(MB_ICONSTOP) then MessageBeep(MB_ICONERROR);
    end;

    case AType of
      MB_OKCANCEL:
      case ShowModal of
        mrOk: Result := IDOK;
        mrCancel: Result := IDCANCEL;
        else Result := IDCANCEL;
      end;
      MB_YESNO:
      case ShowModal of
        mrYes: Result := IDYES;
        mrNo: Result := IDNO;
      else Result := IDNO;
      end;
      MB_OK:
      begin
        ShowModal;
        Result := IDOK;
      end;
    end;
    ShowWindow(GetWindowLong(MsgBoxForm.Handle, GWL_HWNDPARENT), SW_NORMAL);
    KillTimer(0, ATimeOutTimer);
//    UnregisterHotKey(Handle,hhkAtlTab);
//    UnregisterHotKey(Handle,hhkAtlSpace);
    Free;
  end;
end;


function InitializeSetup(): Boolean;
begin
  if ShowMessageEx( ' Названия архивов:' + #13#10 +
                    'hl2_update.exe' + #13#10 +
                    'hl2_ep1_update.exe' + #13#10 +
                    'hl2_ep2_update.exe' + #13#10 +
                    'portal_update.exe'
  , SetupMessage(msgErrorTitle), MB_YESNO, mbCriticalError, 7000) = IDNO then MsgBox('Cancel', mbCriticalError, MB_OK);
end;


=====================================================================

UPD: Новый месседжбокс
способен:
1. в точности подстраиваться под размер текста
2. возвращать результат
3. самозакрываться
4. отображать те же системные иконки(берёт у системы), что и системный + ещё одну с вопросом
5. воспроизводить системные звуки под все четыре типа иконки свой
вызов:
function ShowMessageEx(sMessage, sCaption: String; uBtnType: UINT; tMessageType: _MSG_TYPE; dwMessageTimeOut: DWORD): Integer;
где
sMessage - сообщение
sCaption - заголовок окна
uBtnType - комбинации кнопок (на данный момент 3: MB_YESNO, MB_OK, MB_OKCANCEL).
tMessageType - тип сообщения (4 своих типа со звуком на каждый: mError, mInformation, mQuestion, mCriticalError)
dwMessageTimeOut - время до закрытия в миллисекундах
возвращает в зависимости от кнопок: IDOK, IDNO, IDYES, IDCANCEL
если МБ самозакрылся то возврат по умолчанию: IDNO, IDCANCEL
реализация:
грузим сообщение в TStringList
в цикле длиной в TStringList.Count создаём динамичный массив TNewStaticText(один под другим)
получаем высоту формы ClientHeight := StaticArray[0].Height*ArrayLength + ScaleY(70); (+70 пикселей на кнопки)
ширина - самый длинный TNewStaticText + 90
если ширина МБ равна ширине монитора (аналогично с высотой) то рекурсивно выводим сообщение что он не помещается, выходим из процедуры

делал под потребности "полу-распада", но кому нужно забирайте КОД:
читать дальше »
Код: Выделить весь код
[Setup]
AppName=The_Best_MessageBox_Ever_Made
AppVersion=The_Best_MessageBox_Ever_Made_v777
DefaultDirName={pf}\My Application

[code]
#ifdef UNICODE
    #define A "W"
#else
    #define A "A"
#endif


const
  WM_CLOSE = $10;
  MB_ICONHAND = $00000010;
  MB_ICONEXCLAMATION = $00000030;
  MB_ICONASTERISK = $00000040;
  MB_USERICON = $00000080;
  ID_QUESTION = 65579;
  ID_ASTERISK = 65583;
  ID_HAND = 65581;
  ID_EXCLAMATION = 65577;

type
  _MESSAGE_INFO = record
    hMsgLabel: HWND;
    dwTimeOut: DWORD;
    sTimeOut: String;
    dwStartTime: DWORD;
    hMsgForm: HWND;
  end;
  
  _MSG_TYPE = (mError, mInformation, mQuestion, mCriticalError);

var
  MESSAGE_INFO: _MESSAGE_INFO;


function StrFromTimeInterval(var pszOut: Char; cchMax: UINT; dwTimeMS: DWORD; digits: Byte): Integer; external 'StrFromTimeInterval{#A}@shlwapi.dll stdcall';
function GetTickCount: DWORD; external 'GetTickCount@kernel32.dll stdcall';
function SetTimer(hWnd, nIDEvent, uElapse, lpTimerFunc: LongWord): LongWord; external 'SetTimer@user32.dll stdcall';
function KillTimer(hWnd, nIDEvent: LongWord): LongWord; external 'KillTimer@user32.dll stdcall';
function SetWindowText(hWnd: HWND; lpString: String): BOOL; external 'SetWindowText{#A}@user32.dll stdcall';
function MessageBeep(uType: UINT): BOOL; external 'MessageBeep@user32.dll stdcall';

function TicksToTime(Ticks: DWORD): String;
var
    i: Byte;
    arr: array [0..31] of Char;
begin
    for i := 0 to StrFromTimeInterval(arr[0], sizeof(arr), Ticks, 8)-1 do Result := Result + arr[i];
end;


procedure MessageSelfCloseProc;
var
  PassedTime: DWORD;
begin
  PassedTime := GetTickCount-MESSAGE_INFO.dwStartTime;
  if PassedTime >= MESSAGE_INFO.dwTimeOut then PostMessage(MESSAGE_INFO.hMsgForm, WM_CLOSE, 0, 0);
  SetWindowText(MESSAGE_INFO.hMsgLabel, MESSAGE_INFO.sTimeOut + TicksToTime(MESSAGE_INFO.dwTimeOut-PassedTime));
end;




function ShowMessageEx(sMessage, sCaption: String; uBtnType: UINT; tMessageType: _MSG_TYPE; dwMessageTimeOut: DWORD): Integer;
var
  MessageForm: TSetupForm;
  ATimeOutTimer: LongWord;
  StrList: TStringList;
  StaticArray: array of TNewStaticText;
  MaxStaticTextWidth, i, ArrayLength: Integer;
begin
  try
    MessageForm := CreateCustomForm;
    with MessageForm do
    begin
      Position := poScreenCenter;
      BorderStyle := bsDialog;
      Caption := sCaption;
      Color := clBtnFace;
      try
        StrList := TStringList.Create;
        StrList.Text := sMessage;
        SetArrayLength(StaticArray, StrList.Count);
        ArrayLength := GetArrayLength(StaticArray);
        StaticArray[0] := TNewStaticText.Create(MessageForm)
        with StaticArray[0] do
        begin
          Parent := MessageForm;
          Caption := StrList.Strings[0];
          Font.Size := 10;
          Left := ScaleX(65);// 16
          Top := ScaleY(16);
          MaxStaticTextWidth := Width;
        end;
        if ArrayLength > 1 then for i := 1 to ArrayLength-1 do // MsgBox(StrList[i], mbInformation, MB_OK);
        begin
          StaticArray[i] := TNewStaticText.Create(MessageForm)
          with StaticArray[i] do
          begin
            Parent := MessageForm;
            Caption := StrList.Strings[i];
            Font.Size := 10;
            Left := StaticArray[0].Left;
            Top := StaticArray[i-1].Top + StaticArray[i-1].Height;
            if Width > MaxStaticTextWidth then MaxStaticTextWidth := Width;
          end;
        end else if ArrayLength = 1 then MaxStaticTextWidth := StaticArray[0].Width;
        if MaxStaticTextWidth < 200 then ClientWidth := ScaleX(200) else ClientWidth := ScaleX(MaxStaticTextWidth + 90);
        ClientHeight := StaticArray[0].Height*ArrayLength + ScaleY(70);
      finally
        StrList.Free;
      end;
    end;

    if (MessageForm.ClientWidth >= Screen.Width) or (MessageForm.ClientHeight >= Screen.Height) then
    begin
      ShowMessageEx('Слишком большое сообщение для Вашего монитора!', SetupMessage(msgErrorTitle), MB_OK, mError, 10000);
      Exit;
    end;

    with TButton.Create(MessageForm) do
    begin
      Parent := MessageForm;
      SetBounds(MessageForm.ClientWidth - ScaleX(90), MessageForm.ClientHeight - ScaleY(35), ScaleX(71), ScaleY(25));
      Cursor := crHand;
      case uBtnType of
        MB_OKCANCEL:
        begin
          ModalResult := mrOk;
          Caption := SetupMessage(msgButtonOK);
        end;
        MB_YESNO:
        begin
          ModalResult := mrYes;
          Caption := SetupMessage(msgButtonYes);
        end;
        MB_OK:
        begin
          ModalResult := mrOk;
          Caption := SetupMessage(msgButtonOk);
        end;
      end;
    end;

    if uBtnType <> MB_OK then
    with TButton.Create(MessageForm) do
    begin
      Caption := SetupMessage(msgButtonNo);
      Parent := MessageForm;
      SetBounds(MessageForm.ClientWidth - ScaleX(175), MessageForm.ClientHeight - ScaleY(35), ScaleX(71), ScaleY(25));
      Cursor := crHand;
      case uBtnType of
        MB_OKCANCEL:
        begin
          ModalResult := mrCancel;
          Caption := SetupMessage(msgButtonCancel);
        end;
        MB_YESNO:
        begin
          ModalResult := mrNo;
          Caption := SetupMessage(msgButtonNo);
        end;
      end;
    end;

    if dwMessageTimeOut <> 0 then
    begin
      with TNewStaticText.Create(MessageForm) do
      begin
        Parent := MessageForm;
        SetBounds(StaticArray[0].Left, MessageForm.ClientHeight - ScaleY(30), ScaleX(71), ScaleY(25));
        MESSAGE_INFO.hMsgLabel := Handle;
        MESSAGE_INFO.dwTimeOut := dwMessageTimeOut;
        MESSAGE_INFO.sTimeOut := 'это сообщение закроется через ';
        MESSAGE_INFO.dwStartTime := GetTickCount;
        MESSAGE_INFO.hMsgForm := MessageForm.Handle;
        Caption := MESSAGE_INFO.sTimeOut + TicksToTime(dwMessageTimeOut);
      end;
      ATimeOutTimer := SetTimer(0, 777, 1, CallbackAddr('MessageSelfCloseProc'));
    end;

    with TNewIconImage.Create(MessageForm) do
    begin
      Parent := MessageForm;
      SetBounds(ScaleX(16), ScaleY(16), ScaleX(32), ScaleY(32));
      case tMessageType of
        mError:
        begin
          if not MessageBeep(MB_ICONWARNING) then MessageBeep(MB_ICONEXCLAMATION);
          Icon.Handle := ID_EXCLAMATION;
        end;
        mInformation:
        begin
          if not MessageBeep(MB_ICONINFORMATION) then MessageBeep(MB_ICONASTERISK);
          Icon.Handle := ID_ASTERISK;
        end;
        mCriticalError:
        begin
          if not MessageBeep(MB_ICONHAND) then MessageBeep(MB_ICONERROR);
          Icon.Handle := ID_HAND;
        end;
        mQuestion:
        begin
          MessageBeep(MB_USERICON);
          Icon.Handle := ID_QUESTION;
        end;
      end;
    end;

    case uBtnType of
      MB_OKCANCEL:
      case MessageForm.ShowModal of
        mrOk: Result := IDOK;
        mrCancel: Result := IDCANCEL;
      else Result := IDCANCEL;
      end;
      MB_YESNO:
      case MessageForm.ShowModal of
        mrYes: Result := IDYES;
        mrNo: Result := IDNO;
      else Result := IDNO;
      end;
      MB_OK:
      begin
        MessageForm.ShowModal;
        Result := IDOK;
      end;
    end;
    if dwMessageTimeOut <> 0 then KillTimer(0, ATimeOutTimer);
  finally
    MessageForm.Free;
  end;
end;


function InitializeSetup(): Boolean;  
begin
  repeat
  until ShowMessageEx('"It was a low dome, jutting with antennae and radar dishes, tiny red lights blinking above them.' + #13#10 +
                      'Around the dome were more structures, built low and painted white, almost indistinguishable from' + #13#10 +
                      'their surroundings. The whole thing was sprinkled with snow, like powdered sugar, but it was' + #13#10 +
                      'hardly a pristine image. There hard already been fighting here. Smoke rose from a crack in the dome.' + #13#10 +
                      'The soldiers stationed inside the station had massed against the Combine operators as the news of' + #13#10 +
                      'the uprising spread; the fighting had torn it apart from within."' + #13#10#13#10 + #9#9#9#9#9#9#9#9 +
                      '--Weather Control Vignette' + #13#10#13#10 +
                      ''
  , SetupMessage(msgErrorTitle), MB_OKCANCEL, mError, 7000) = IDCANCEL;
end;


================================================================

Последний раз редактировалось Johny777, 13-12-2012 в 03:36.

Это сообщение посчитали полезным следующие участники:

Отправлено: 21:33, 11-12-2012 | #1383