123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200 |
- {*
- * 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.
|