This should have already existed!

git-svn-id: http://svn.dmdirc.com/trunk@4182 00569f92-eb28-0410-84fd-f71c24880f

installer/windows/Vista.pas

@@ -0,0 +1,200 @@
+{*
+ * Vista image improvements from http://www.installationexcellence.com/articles/VistaWithDelphi/Original/Index.html
+ * and http://www.installationexcellence.com/articles/VistaWithDelphi/Index.html
+ *}
+unit Vista;
+
+//{$IFDEF LAZARUS}
+//	{$DEFINE MESSAGEDLG}
+// {$ENDIF}
+
+interface
+
+uses {$IFDEF LAZARUS}Forms, Graphics, Controls,{$IFDEF MESSAGEDLG} Dialogs,{$ENDIF}{$ENDIF} Windows, SysUtils;
+
+function IsWindowsVista: Boolean;
+function TaskDialog(const AHandle: THandle; const ATitle, ADescription, AContent: WideString; const Icon, Buttons: integer; includeDescInXP: boolean = false; stripLineFeed: boolean = true): Integer;
+{$IFDEF LAZARUS}
+procedure SetVistaFonts(const AForm: TCustomForm);
+{$ENDIF}
+
+const
+	VistaFont = 'Segoe UI'; 
+	VistaContentFont = 'Calibri';
+	XPContentFont = 'Verdana';
+	XPFont = 'Tahoma';
+
+	TD_ICON_BLANK = 0;
+	TD_ICON_WARNING = 84;
+	TD_ICON_QUESTION = 99;
+	TD_ICON_ERROR = 98;
+	TD_ICON_INFORMATION = 81;
+	TD_ICON_SHIELD_QUESTION = 104;
+	TD_ICON_SHIELD_ERROR = 105;
+	TD_ICON_SHIELD_OK = 106;
+	TD_ICON_SHIELD_WARNING = 107;
+
+	TD_BUTTON_OK = 1;
+	TD_BUTTON_YES = 2;
+	TD_BUTTON_NO = 4;
+	TD_BUTTON_CANCEL = 8;
+	TD_BUTTON_RETRY = 16;
+	TD_BUTTON_CLOSE = 32;
+
+	TD_RESULT_OK = 1;
+	TD_RESULT_CANCEL = 2;
+	TD_RESULT_RETRY = 4;
+	TD_RESULT_YES = 6;
+	TD_RESULT_NO = 7;
+	TD_RESULT_CLOSE = 8;
+	
+	{$IFNDEF LAZARUS}
+		mrNone = 0;
+		mrOK = mrNone + 1;
+		mrCancel = mrNone + 2;
+		mrAbort = mrNone + 3;
+		mrRetry = mrNone + 4;
+		mrYes = mrNone + 6;
+		mrNo = mrNone + 7;
+	{$ENDIF}
+
+implementation
+
+{$IFDEF LAZARUS}
+procedure SetVistaFonts(const AForm: TCustomForm);
+begin
+	if IsWindowsVista and not SameText(AForm.Font.Name, VistaFont) and (Screen.Fonts.IndexOf(VistaFont) >= 0) then
+	begin
+		AForm.Font.Size := AForm.Font.Size + 1;
+		AForm.Font.Name := VistaFont;
+	end;
+end;
+{$ENDIF}
+
+function IsWindowsVista: Boolean;
+var
+	VerInfo: TOSVersioninfo;
+begin
+	VerInfo.dwOSVersionInfoSize := SizeOf(TOSVersionInfo);
+	GetVersionEx(VerInfo);
+	Result := VerInfo.dwMajorVersion >= 6;
+end;
+
+// http://www.swissdelphicenter.ch/en/showcode.php?id=1692
+{:Converts Unicode string to Ansi string using specified code page.
+  @param   ws       Unicode string.
+  @param   codePage Code page to be used in conversion.
+  @returns Converted ansi string.
+}
+function WideStringToString(const ws: WideString; codePage: Word): AnsiString;
+var
+  l: integer;
+begin
+	if ws = '' then begin
+		Result := ''
+	end
+	else begin
+		l := WideCharToMultiByte(codePage, WC_COMPOSITECHECK or WC_DISCARDNS or WC_SEPCHARS or WC_DEFAULTCHAR, @ws[1], - 1, nil, 0, nil, nil);
+		SetLength(Result, l - 1);
+		if l > 1 then begin
+			WideCharToMultiByte(codePage, WC_COMPOSITECHECK or WC_DISCARDNS or WC_SEPCHARS or WC_DEFAULTCHAR, @ws[1], - 1, @Result[1], l - 1, nil, nil);
+		end;
+	end;
+end;
+
+
+//from http://www.tmssoftware.com/atbdev5.htm
+function TaskDialog(const AHandle: THandle; const ATitle, ADescription, AContent: WideString; const Icon, Buttons: integer; includeDescInXP: boolean = false; stripLineFeed: boolean = true): Integer;
+var
+	DLLHandle: THandle;
+	res: integer;
+	wS: WideString;
+	S: String;
+	{$IFDEF MESSAGEDLG}
+	Btns: TMsgDlgButtons;
+	DlgType: TMsgDlgType;
+	{$ELSE}
+	Btns: Integer;
+	myIcon: Integer;
+	{$ENDIF}
+	TaskDialogFound: boolean;
+	TaskDialogProc: function(HWND: THandle; hInstance: THandle; cTitle, cDescription, cContent: pwidechar; Buttons: Integer; Icon: integer; ResButton: pinteger): integer; stdcall;
+begin
+	TaskDialogFound := false;
+	Result := 0;
+	if IsWindowsVista then begin
+		DLLHandle := LoadLibrary('comctl32.dll');
+		if DLLHandle >= 32 then begin
+			@TaskDialogProc := GetProcAddress(DLLHandle,'TaskDialog');
+			
+			if Assigned(TaskDialogProc) then begin
+				
+				if stripLineFeed then begin
+					wS := StringReplace(AContent, #10, '', [rfReplaceAll]);
+					wS := StringReplace(wS, #13, '', [rfReplaceAll]);
+				end
+				else begin
+					wS := AContent;
+				end;
+
+				TaskDialogProc(AHandle, 0, PWideChar(ATitle), PWideChar(ADescription), PWideChar(wS), Buttons, Icon, @res);
+				TaskDialogFound := true;
+				Result := mrOK;
+				case res of
+					TD_RESULT_CANCEL : Result := mrCancel;
+					TD_RESULT_RETRY : Result := mrRetry;
+					TD_RESULT_YES : Result := mrYes;
+					TD_RESULT_NO : Result := mrNo;
+					TD_RESULT_CLOSE : Result := mrAbort;
+				end;
+			end;
+			FreeLibrary(DLLHandle);
+		end;
+	end;
+	
+	if not TaskDialogFound then begin
+		S := '';
+		if includeDescInXP then S := ADescription + #10#13 + #10#13 + AContent else S := AContent;
+		
+		{$IFDEF MESSAGEDLG}
+			Btns := [];
+			if Buttons and TD_BUTTON_OK = TD_BUTTON_OK then Btns := Btns + [MBOK];
+			if Buttons and TD_BUTTON_YES = TD_BUTTON_YES then Btns := Btns + [MBYES];
+			if Buttons and TD_BUTTON_NO = TD_BUTTON_NO then Btns := Btns + [MBNO];
+			if Buttons and TD_BUTTON_CANCEL = TD_BUTTON_CANCEL then Btns := Btns + [MBCANCEL];
+			if Buttons and TD_BUTTON_RETRY = TD_BUTTON_RETRY then Btns := Btns + [MBRETRY];
+	
+			if Buttons and TD_BUTTON_CLOSE = TD_BUTTON_CLOSE then Btns := Btns + [MBABORT];
+	
+			DlgType := mtCustom;
+	
+			case Icon of
+				TD_ICON_WARNING : DlgType := mtWarning;
+				TD_ICON_QUESTION : DlgType := mtConfirmation;
+				TD_ICON_ERROR : DlgType := mtError;
+				TD_ICON_INFORMATION: DlgType := mtInformation;
+			end;
+	
+			Result := MessageDlg(S, DlgType, Btns, 0);
+		{$ELSE}
+			Btns := 0;
+			if Buttons and TD_BUTTON_OK = TD_BUTTON_OK then Btns := MB_OK;
+			if (Buttons and TD_BUTTON_YES = TD_BUTTON_YES) and (Buttons and TD_BUTTON_NO = TD_BUTTON_NO) then Btns := MB_YESNO;
+			if (Buttons and TD_BUTTON_CANCEL = TD_BUTTON_CANCEL) and (Buttons and TD_BUTTON_YES = TD_BUTTON_YES) and (Buttons and TD_BUTTON_NO = TD_BUTTON_NO) then Btns := MB_YESNOCANCEL;
+			if (Buttons and TD_BUTTON_CANCEL = TD_BUTTON_CANCEL) and (Buttons and TD_BUTTON_OK = TD_BUTTON_OK) then Btns := MB_OKCANCEL;
+			if (Buttons and TD_BUTTON_CANCEL = TD_BUTTON_CANCEL) and (Buttons and TD_BUTTON_RETRY = TD_BUTTON_RETRY) then Btns := MB_RETRYCANCEL;
+			
+			myIcon := 0;
+			case Icon of
+				TD_ICON_QUESTION : myIcon := MB_ICONQUESTION;
+				TD_ICON_ERROR : myIcon := MB_ICONSTOP;
+				TD_ICON_INFORMATION: myIcon := MB_ICONINFORMATION;
+			end;
+			
+			Result := MessageBox(0, pchar(S), pchar(String(ATitle)), Btns + myIcon);
+		{$ENDIF}
+	end;
+end;
+
+end.
+