PIKApp/build/windows/installer/MessageWithURL.isi

[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;