505 lines
15 KiB
Plaintext
505 lines
15 KiB
Plaintext
[Code]
|
|
(* MessageWithURL
|
|
*
|
|
* Copyright (c) 2010-2011 Jernej Simončič
|
|
*
|
|
* This software is provided 'as-is', without any express or implied
|
|
* warranty. In no event will the authors be held liable for any damages
|
|
* arising from the use of this software.
|
|
*
|
|
* Permission is granted to anyone to use this software for any purpose,
|
|
* including commercial applications, and to alter it and redistribute it
|
|
* freely, subject to the following restrictions:
|
|
*
|
|
* 1. The origin of this software must not be misrepresented; you must
|
|
* not claim that you wrote the original software. If you use this
|
|
* software in a product, an acknowledgment in the product
|
|
* documentation would be appreciated but is not required.
|
|
*
|
|
* 2. Altered source versions must be plainly marked as such, and must
|
|
* not be misrepresented as being the original software.
|
|
*
|
|
* 3. This notice may not be removed or altered from any source
|
|
* distribution.
|
|
*)
|
|
|
|
(* * * * * * * * * *
|
|
* MessageWithURL(Message: TArrayOfString; Title: String: ButtonText: TArrayOfString; Typ: TMsgBoxType;
|
|
* DefaultButton, CancelButton: Integer): Integer;
|
|
*
|
|
* Parameters:
|
|
* Title dialog box caption
|
|
* Message messages to display; if a message starts with _, the text following it up to the first space character
|
|
* is interpreted as URL, and the rest of the message is used as clickable text for that URL
|
|
* Typ icon to show
|
|
* ButtonText buttons to show under the text
|
|
* DefaultButton default button (first button = 1)
|
|
* CancelButton cancel button (first button = 1)
|
|
*
|
|
* Return value button that was clicked (first button = 1); if running in silent mode, DefaultButton is returned
|
|
*)
|
|
function MessageWithURL(Message: TArrayOfString; const Title: String; ButtonText: TArrayOfString; const Typ: TMsgBoxType;
|
|
const DefaultButton, CancelButton: Integer): Integer; forward;
|
|
|
|
function GetSystemMetrics(nIndex: Integer): Integer; external 'GetSystemMetrics@User32 stdcall';
|
|
function GetDialogBaseUnits(): Integer; external 'GetDialogBaseUnits@User32 stdcall';
|
|
|
|
//function GetSysColor(nIndex: Integer): DWORD; external 'GetSysColor@user32.dll stdcall';
|
|
|
|
function LoadIcon(hInstance: Integer; lpIconName: Integer): Integer; external 'LoadIconW@user32 stdcall';
|
|
//function LoadImage(hinst: Integer; lpszName: Integer; uType: Cardinal; cxDesired, cyDesired: Integer; fuLoad: Cardinal): Integer; external 'LoadImageW@user32 stdcall';
|
|
function DrawIcon(hdc: HBitmap; x,y: Integer; hIcon: Integer): Integer; external 'DrawIcon@user32 stdcall';
|
|
//function DrawIconEx(hdc: HBitmap; xLeft,yTop: Integer; hIcon: Integer; cxWidth, cyWidth: Integer; istepIfAniCur: Cardinal; hbrFlickerFreeDraw: Integer; diFlags: Cardinal): Integer; external 'DrawIconEx@user32 stdcall';
|
|
//function DestroyIcon(hIcon: Integer): Integer; external 'DestroyIcon@user32 stdcall';
|
|
|
|
function DrawFocusRect(hDC: Integer; var lprc: TRect): BOOL; external 'DrawFocusRect@user32 stdcall';
|
|
|
|
type
|
|
TArrayOfButton = Array of TNewButton;
|
|
|
|
const
|
|
//borders around message
|
|
MWU_LEFTBORDER = 25;
|
|
MWU_RIGHTBORDER = MWU_LEFTBORDER;
|
|
MWU_TOPBORDER = 26;
|
|
MWU_BOTTOMBORDER = MWU_TOPBORDER;
|
|
//space between elements (icon-text and between buttons)
|
|
MWU_HORZSPACING = 8;
|
|
//space between labels
|
|
MWU_VERTSPACING = 4;
|
|
//button sizes
|
|
MWU_BUTTONHEIGHT = 24;
|
|
MWU_MINBUTTONWIDTH = 86;
|
|
//height of area where buttons are placed
|
|
MWU_BUTTONAREAHEIGHT = 45;
|
|
|
|
SM_CXSCREEN = 0;
|
|
SM_CXICON = 11;
|
|
SM_CYICON = 12;
|
|
SM_CXICONSPACING = 38;
|
|
SM_CYICONSPACING = 39;
|
|
|
|
//COLOR_HOTLIGHT = 26;
|
|
|
|
OIC_HAND = 32513;
|
|
OIC_QUES = 32514;
|
|
OIC_BANG = 32515;
|
|
OIC_NOTE = 32516;
|
|
|
|
LR_DEFAULTSIZE = $00000040;
|
|
LR_SHARED = $00008000;
|
|
|
|
IMAGE_BITMAP = 0;
|
|
IMAGE_ICON = 1;
|
|
IMAGE_CURSOR = 2;
|
|
|
|
DI_IMAGE = 1;
|
|
DI_MASK = 2;
|
|
DI_NORMAL = DI_IMAGE or DI_MASK;
|
|
DI_DEFAULTSIZE = 8;
|
|
|
|
var
|
|
URLList: TArrayOfString;
|
|
TextLabel: Array of TNewStaticText;
|
|
URLFocusImg: Array of TBitmapImage;
|
|
SingleLineHeight: Integer;
|
|
|
|
|
|
procedure UrlClick(Sender: TObject);
|
|
var ErrorCode: Integer;
|
|
begin
|
|
ShellExecAsOriginalUser('open',URLList[TNewStaticText(Sender).Tag],'','',SW_SHOWNORMAL,ewNoWait,ErrorCode);
|
|
end;
|
|
|
|
|
|
// calculates maximum width of text labels
|
|
// also counts URLs, and sets the length of URLList accordingly
|
|
function Message_CalcLabelWidth(var Message: TArrayOfString; MessageForm: TSetupForm): Integer;
|
|
var MeasureLabel: TNewStaticText;
|
|
i,URLCount,DlgUnit,ScreenWidth: Integer;
|
|
begin
|
|
MeasureLabel := TNewStaticText.Create(MessageForm);
|
|
with MeasureLabel do
|
|
begin
|
|
Parent := MessageForm;
|
|
Left := 0;
|
|
Top := 0;
|
|
AutoSize := True;
|
|
end;
|
|
|
|
MeasureLabel.Caption := 'X';
|
|
SingleLineHeight := MeasureLabel.Height;
|
|
|
|
Result := 0; //minimum width
|
|
URLCount := 0;
|
|
for i := 0 to GetArrayLength(Message) - 1 do
|
|
begin
|
|
if Length(Message[i]) < 1 then //simplifies things
|
|
Message[i] := ' ';
|
|
|
|
if Message[i][1] <> '_' then
|
|
MeasureLabel.Caption := Message[i] //not an URL
|
|
else
|
|
begin //URL - check only the displayed text
|
|
if Pos(' ',Message[i]) > 0 then
|
|
MeasureLabel.Caption := Copy(Message[i],Pos(' ',Message[i])+1,Length(Message[i]))
|
|
else
|
|
MeasureLabel.Caption := Copy(Message[i],2,Length(Message[i]));
|
|
|
|
URLCount := URLCount + 1;
|
|
end;
|
|
|
|
if MeasureLabel.Width > Result then
|
|
Result := MeasureLabel.Width;
|
|
end;
|
|
MeasureLabel.Free;
|
|
|
|
SetArrayLength(URLList,URLCount); //needed later - no need to do a special loop just for this
|
|
SetArrayLength(URLFocusImg,URLCount);
|
|
|
|
DlgUnit := GetDialogBaseUnits() and $FFFF; //ensure the dialog isn't too wide
|
|
ScreenWidth := GetSystemMetrics(SM_CXSCREEN);
|
|
if Result > ((278 * DlgUnit) div 4) then //278 is from http://blogs.msdn.com/b/oldnewthing/archive/2011/06/24/10178386.aspx
|
|
Result := ((278 * DlgUnit) div 4);
|
|
if Result > (ScreenWidth * 3) div 4 then
|
|
Result := (ScreenWidth * 3) div 4;
|
|
|
|
end;
|
|
|
|
|
|
//find the longest button
|
|
function Message_CalcButtonWidth(const ButtonText: TArrayOfString; MessageForm: TSetupForm): Integer;
|
|
var MeasureLabel: TNewStaticText;
|
|
i: Integer;
|
|
begin
|
|
MeasureLabel := TNewStaticText.Create(MessageForm);
|
|
with MeasureLabel do
|
|
begin
|
|
Parent := MessageForm;
|
|
Left := 0;
|
|
Top := 0;
|
|
AutoSize := True;
|
|
end;
|
|
|
|
Result := ScaleX(MWU_MINBUTTONWIDTH - MWU_HORZSPACING * 2); //minimum width
|
|
for i := 0 to GetArrayLength(ButtonText) - 1 do
|
|
begin
|
|
MeasureLabel.Caption := ButtonText[i]
|
|
|
|
if MeasureLabel.Width > Result then
|
|
Result := MeasureLabel.Width;
|
|
end;
|
|
MeasureLabel.Free;
|
|
|
|
Result := Result + ScaleX(MWU_HORZSPACING * 2); //account for borders
|
|
end;
|
|
|
|
|
|
procedure Message_Icon(const Typ: TMsgBoxType; TypImg: TBitmapImage);
|
|
var TypRect: TRect;
|
|
Icon: THandle;
|
|
TypIcon: Integer;
|
|
begin
|
|
TypRect.Left := 0;
|
|
TypRect.Top := 0;
|
|
TypRect.Right := GetSystemMetrics(SM_CXICON);
|
|
TypRect.Bottom := GetSystemMetrics(SM_CYICON);
|
|
|
|
case Typ of
|
|
mbInformation:
|
|
TypIcon := OIC_NOTE;
|
|
mbConfirmation:
|
|
TypIcon := OIC_QUES;
|
|
mbError:
|
|
TypIcon := OIC_BANG;
|
|
else
|
|
TypIcon := OIC_HAND;
|
|
end;
|
|
|
|
//TODO: icon loads with wrong size when using Large Fonts (SM_CXICON/CYICON is 40, but 32x32 icon loads - find out how to get the right size)
|
|
Icon := LoadIcon(0,TypIcon);
|
|
//Icon := LoadImage(0,TypIcon,IMAGE_ICON,0,0,LR_SHARED or LR_DEFAULTSIZE);
|
|
with TypImg do
|
|
begin
|
|
Left := ScaleX(MWU_LEFTBORDER);
|
|
Top := ScaleY(MWU_TOPBORDER);
|
|
Center := False;
|
|
Stretch := False;
|
|
AutoSize := True;
|
|
Bitmap.Width := GetSystemMetrics(SM_CXICON);
|
|
Bitmap.Height := GetSystemMetrics(SM_CYICON);
|
|
Bitmap.Canvas.Brush.Color := TPanel(Parent).Color;
|
|
Bitmap.Canvas.FillRect(TypRect);
|
|
DrawIcon(Bitmap.Canvas.Handle,0,0,Icon); //draws icon scaled
|
|
//DrawIconEx(Bitmap.Canvas.Handle,0,0,Icon,0,0,0,0,DI_NORMAL {or DI_DEFAULTSIZE}); //draws icon without scaling
|
|
end;
|
|
//DestroyIcon(Icon); //not needed with LR_SHARED or with LoadIcon
|
|
end;
|
|
|
|
|
|
procedure Message_SetUpURLLabel(URLLabel: TNewStaticText; const Msg: String; const URLNum: Integer);
|
|
var Blank: TRect;
|
|
begin
|
|
with URLLabel do
|
|
begin
|
|
if Pos(' ',Msg) > 0 then
|
|
begin
|
|
Caption := Copy(Msg,Pos(' ',Msg)+1,Length(Msg));
|
|
URLList[URLNum] := Copy(Msg, 2, Pos(' ',Msg)-1);
|
|
end
|
|
else
|
|
begin //no text after URL - display just URL
|
|
URLList[URLNum] := Copy(Msg, 2, Length(Msg));
|
|
Caption := URLList[URLNum];
|
|
end;
|
|
|
|
Hint := URLList[URLNum];
|
|
ShowHint := True;
|
|
|
|
Font.Color := GetSysColor(COLOR_HOTLIGHT);
|
|
Font.Style := [fsUnderline];
|
|
Cursor := crHand;
|
|
OnClick := @UrlClick;
|
|
|
|
Tag := URLNum; //used to find the URL to open and bitmap to draw focus rectangle on
|
|
|
|
if Height = SingleLineHeight then //shrink label to actual text width
|
|
WordWrap := False;
|
|
|
|
TabStop := True; //keyboard accessibility
|
|
TabOrder := URLNum;
|
|
end;
|
|
|
|
URLFocusImg[URLNum] := TBitmapImage.Create(URLLabel.Parent); //focus rectangle needs a bitmap - prepare it here
|
|
with URLFocusImg[URLNum] do
|
|
begin
|
|
Left := URLLabel.Left - 1;
|
|
Top := URLLabel.Top - 1;
|
|
Stretch := False;
|
|
AutoSize := True;
|
|
Parent := URLLabel.Parent;
|
|
Bitmap.Width := URLLabel.Width + 2;
|
|
Bitmap.Height := URLLabel.Height + 2;
|
|
|
|
SendToBack;
|
|
|
|
Blank.Left := 0;
|
|
Blank.Top := 0;
|
|
Blank.Right := Width;
|
|
Blank.Bottom := Height;
|
|
Bitmap.Canvas.Brush.Color := TPanel(Parent).Color;
|
|
Bitmap.Canvas.FillRect(Blank);
|
|
end;
|
|
end;
|
|
|
|
|
|
procedure Message_SetUpLabels(Message: TArrayOfString; TypImg: TBitmapImage;
|
|
const DialogTextWidth: Integer; MessagePanel: TPanel);
|
|
var i,URLNum,dy: Integer;
|
|
begin
|
|
SetArrayLength(TextLabel,GetArrayLength(Message));
|
|
URLNum := 0;
|
|
for i := 0 to GetArrayLength(TextLabel) - 1 do
|
|
begin
|
|
TextLabel[i] := TNewStaticText.Create(MessagePanel);
|
|
with TextLabel[i] do
|
|
begin
|
|
Parent := MessagePanel;
|
|
Left := TypImg.Left + TypImg.Width + ScaleX(MWU_HORZSPACING);
|
|
if i = 0 then
|
|
Top := TypImg.Top
|
|
else
|
|
Top := TextLabel[i-1].Top + TextLabel[i-1].Height + ScaleY(MWU_VERTSPACING);
|
|
|
|
WordWrap := True;
|
|
AutoSize := True;
|
|
Width := DialogTextWidth;
|
|
|
|
if Message[i][1] <> '_' then
|
|
Caption := Message[i]
|
|
else
|
|
begin // apply URL formatting
|
|
Message_SetUpURLLabel(TextLabel[i], Message[i], URLNum);
|
|
URLNum := URLNum + 1;
|
|
end;
|
|
|
|
end;
|
|
end;
|
|
|
|
i := GetArrayLength(TextLabel) - 1;
|
|
if TextLabel[i].Top + TextLabel[i].Height < TypImg.Top + TypImg.Height then //center labels vertically
|
|
begin
|
|
dy := (TypImg.Top + TypImg.Height - TextLabel[i].Top - TextLabel[i].Height) div 2;
|
|
for i := 0 to GetArrayLength(TextLabel) - 1 do
|
|
TextLabel[i].Top := TextLabel[i].Top + dy;
|
|
end;
|
|
end;
|
|
|
|
|
|
procedure Message_SetUpButtons(var Button: TArrayOfButton; ButtonText: TArrayOfString;
|
|
const ButtonWidth, DefaultButton, CancelButton: Integer; MessageForm: TSetupForm);
|
|
var i: Integer;
|
|
begin
|
|
SetArrayLength(Button,GetArrayLength(ButtonText));
|
|
for i := 0 to GetArrayLength(Button) - 1 do
|
|
begin
|
|
Button[i] := TNewButton.Create(MessageForm);
|
|
with Button[i] do
|
|
begin
|
|
Parent := MessageForm;
|
|
Width := ButtonWidth;
|
|
Height := ScaleY(MWU_BUTTONHEIGHT);
|
|
|
|
if i = 0 then
|
|
begin
|
|
Left := MessageForm.ClientWidth - (ScaleX(MWU_HORZSPACING) + ButtonWidth) * GetArrayLength(ButtonText);
|
|
Top := MessageForm.ClientHeight - ScaleY(MWU_BUTTONAREAHEIGHT) +
|
|
ScaleY(MWU_BUTTONAREAHEIGHT - MWU_BUTTONHEIGHT) div 2;
|
|
end else
|
|
begin
|
|
Left := Button[i-1].Left + ScaleX(MWU_HORZSPACING) + ButtonWidth;
|
|
Top := Button[i-1].Top;
|
|
end;
|
|
|
|
Caption := ButtonText[i];
|
|
ModalResult := i + 1;
|
|
|
|
//set the initial focus to the default button
|
|
TabOrder := ((i - (DefaultButton - 1)) + GetArrayLength(Button)) mod (GetArrayLength(Button));
|
|
|
|
if DefaultButton = i + 1 then
|
|
Default := True;
|
|
|
|
if CancelButton = i + 1 then
|
|
Cancel := True;
|
|
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
|
|
//find out if URL label has focus
|
|
//draw focus rectangle around it if so and return index of focused label
|
|
function Message_FocusLabel(): Integer;
|
|
var i: Integer;
|
|
FocusRect: TRect;
|
|
begin
|
|
Result := -1;
|
|
|
|
for i := 0 to GetArrayLength(URLFocusImg) - 1 do //clear existing focus rectangle
|
|
begin
|
|
FocusRect.Left := 0;
|
|
FocusRect.Top := 0;
|
|
FocusRect.Right := URLFocusImg[i].Bitmap.Width;
|
|
FocusRect.Bottom := URLFocusImg[i].Bitmap.Height;
|
|
URLFocusImg[i].Bitmap.Canvas.FillRect(FocusRect);
|
|
end;
|
|
|
|
for i := 0 to GetArrayLength(TextLabel) - 1 do
|
|
begin
|
|
if TextLabel[i].Focused then
|
|
begin
|
|
Result := i;
|
|
|
|
FocusRect.Left := 0;
|
|
FocusRect.Top := 0;
|
|
FocusRect.Right := URLFocusImg[TextLabel[i].Tag].Bitmap.Width;
|
|
FocusRect.Bottom := URLFocusImg[TextLabel[i].Tag].Bitmap.Height;
|
|
|
|
DrawFocusRect(URLFocusImg[TextLabel[i].Tag].Bitmap.Canvas.Handle, FocusRect);
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
|
|
//TNewStaticText doesn't have OnFocus - handle that here
|
|
//(not perfect - if you focus label with keyboard, then focus a button with mouse, the label keeps it's underline)
|
|
procedure Message_KeyUp(Sender: TObject; var Key: Word; Shift: TShiftState);
|
|
var URLIdx: Integer;
|
|
begin
|
|
case Key of
|
|
9,37..40: //tab, arrow keys
|
|
begin
|
|
Message_FocusLabel();
|
|
end;
|
|
13,32: //enter, spacebar
|
|
begin
|
|
URLIdx := Message_FocusLabel(); //get focused label
|
|
if URLIdx > -1 then
|
|
UrlClick(TextLabel[URLIdx]);
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
|
|
function MessageWithURL(Message: TArrayOfString; const Title: String; ButtonText: TArrayOfString; const Typ: TMsgBoxType;
|
|
const DefaultButton, CancelButton: Integer): Integer;
|
|
var MessageForm: TSetupForm;
|
|
Button: TArrayOfButton;
|
|
DialogTextWidth, ButtonWidth: Integer;
|
|
MessagePanel: TPanel;
|
|
TypImg: TBitmapImage;
|
|
i: Integer;
|
|
begin
|
|
if (not IsUninstaller and WizardSilent) or (IsUninstaller and UninstallSilent) then
|
|
begin
|
|
Result := DefaultButton;
|
|
exit;
|
|
end;
|
|
|
|
MessageForm := CreateCustomForm();
|
|
|
|
MessageForm.Caption := Title;
|
|
if (CancelButton = 0) or (CancelButton > GetArrayLength(ButtonText)) then //no cancel button - remove close button
|
|
MessageForm.BorderIcons := MessageForm.BorderIcons - [biSystemMenu];
|
|
|
|
MessagePanel := TPanel.Create(MessageForm); //Vista-style background
|
|
with MessagePanel do
|
|
begin
|
|
Parent := MessageForm;
|
|
BevelInner := bvNone;
|
|
BevelOuter := bvNone;
|
|
BevelWidth := 0;
|
|
ParentBackground := False;
|
|
Color := clWindow;
|
|
Left := 0;
|
|
Top := 0;
|
|
end;
|
|
|
|
DialogTextWidth := Message_CalcLabelWidth(Message, MessageForm);
|
|
ButtonWidth := Message_CalcButtonWidth(ButtonText, MessageForm);
|
|
|
|
TypImg := TBitmapImage.Create(MessagePanel);
|
|
TypImg.Parent := MessagePanel;
|
|
Message_Icon(Typ, TypImg);
|
|
|
|
Message_SetUpLabels(Message, TypImg, DialogTextWidth, MessagePanel);
|
|
|
|
i := GetArrayLength(TextLabel) - 1;
|
|
MessagePanel.ClientHeight := TextLabel[i].Top + TextLabel[i].Height + ScaleY(MWU_BOTTOMBORDER);
|
|
|
|
MessagePanel.ClientWidth := DialogTextWidth + TypImg.Width + TypImg.Left + ScaleX(MWU_HORZSPACING + MWU_RIGHTBORDER);
|
|
if MessagePanel.ClientWidth <
|
|
(ButtonWidth + ScaleX(MWU_HORZSPACING)) * GetArrayLength(ButtonText) + ScaleX(MWU_HORZSPACING) then //ensure buttons fit
|
|
MessagePanel.ClientWidth := (ButtonWidth + ScaleX(MWU_HORZSPACING)) * GetArrayLength(ButtonText) + ScaleX(MWU_HORZSPACING);
|
|
|
|
MessageForm.ClientWidth := MessagePanel.Width;
|
|
MessageForm.ClientHeight := MessagePanel.Height + ScaleY(MWU_BUTTONAREAHEIGHT);
|
|
|
|
Message_SetUpButtons(Button, ButtonText, ButtonWidth, DefaultButton, CancelButton, MessageForm);
|
|
|
|
MessageForm.OnKeyUp := @Message_KeyUp; //needed for keyboard access of URL labels
|
|
MessageForm.KeyPreView := True;
|
|
|
|
Result := MessageForm.ShowModal;
|
|
|
|
for i := 0 to GetArrayLength(TextLabel) - 1 do
|
|
TextLabel[i].Free;
|
|
SetArrayLength(TextLabel,0);
|
|
for i := 0 to GetArrayLength(URLFocusImg) - 1 do
|
|
URLFocusImg[i].Free;
|
|
SetArrayLength(URLFocusImg,0);
|
|
|
|
MessageForm.Release;
|
|
end;
|
