123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220 |
- {*
- * Vista image improvements from http://www.installationexcellence.com/articles/VistaWithDelphi/Original/Index.html
- * and http://www.installationexcellence.com/articles/VistaWithDelphi/Index.html
- *
- * This application launches DMDirc on windows and passes control to the
- * update engine as necessary.
- *
- * DMDirc - Open Source IRC Client
- * Copyright (c) 2006-2009 Chris Smith, Shane Mc Cormack, Gregory Holmes,
- * Michael Nixon
- *
- * Permission is hereby granted, free of charge, to any person obtaining a copy
- * of this software and associated documentation files (the "Software"), to deal
- * in the Software without restriction, including without limitation the rights
- * to use, copy, modify, merge, publish, distribute, sublicense, and/or sell
- * copies of the Software, and to permit persons to whom the Software is
- * furnished to do so, subject to the following conditions:
- *
- * The above copyright notice and this permission notice shall be included in
- * all copies or substantial portions of the Software.
- *
- * THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
- * IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
- * FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
- * AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
- * LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
- * OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE
- * SOFTWARE.
- *}
- {* NOTE: The version in the installer/ directory is the one to edit! *}
- unit Vista;
-
- interface
-
- uses 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;
- //procedure SetVistaFonts(const AForm: TCustomForm);
-
- 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;
-
- mrNone = 0;
- mrOK = mrNone + 1;
- mrCancel = mrNone + 2;
- mrAbort = mrNone + 3;
- mrRetry = mrNone + 4;
- mrYes = mrNone + 6;
- mrNo = mrNone + 7;
-
- implementation
-
- {*
- 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;
- *}
-
- 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;
- type
- tTaskDialogProc = function(HWND: THandle; hInstance: THandle; cTitle, cDescription, cContent: pwidechar; Buttons: Integer; Icon: integer; ResButton: pinteger): integer; stdcall;
- var
- DLLHandle: THandle;
- res: integer;
- wS: WideString;
- S: String;
- {$IFDEF MESSAGEDLG}
- Btns: TMsgDlgButtons;
- DlgType: TMsgDlgType;
- {$ELSE}
- Btns: Integer;
- myIcon: Integer;
- {$ENDIF}
- TaskDialogFound: boolean;
- TaskDialogProc: tTaskDialogProc;
- begin
- TaskDialogFound := false;
- Result := 0;
- if IsWindowsVista then begin
- DLLHandle := LoadLibrary('comctl32.dll');
- if DLLHandle >= 32 then begin
- TaskDialogProc := tTaskDialogProc(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.
-
|