Ветеран
Сообщения: 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;
================================================================
|
