From ce329d855d2c1ba920d68324ed1f97980b1f4a28 Mon Sep 17 00:00:00 2001 From: paul Date: Sat, 21 Jun 2008 12:23:31 +0000 Subject: [PATCH] lcl: add TWidgetset.AppSetIcon win32, qt, carbon: implement AppSetIcon git-svn-id: trunk@15497 - --- lcl/include/application.inc | 4 ++-- lcl/include/customform.inc | 3 +-- lcl/include/interfacebase.inc | 6 +++++- lcl/interfacebase.pp | 1 + lcl/interfaces/carbon/carbonint.pas | 1 + lcl/interfaces/carbon/carbonobject.inc | 8 ++++++++ lcl/interfaces/qt/qtint.pp | 1 + lcl/interfaces/qt/qtobject.inc | 4 ++-- lcl/interfaces/win32/win32int.pp | 1 + lcl/interfaces/win32/win32object.inc | 5 +++++ 10 files changed, 27 insertions(+), 7 deletions(-) diff --git a/lcl/include/application.inc b/lcl/include/application.inc index aff931beaf..9993c11f1d 100644 --- a/lcl/include/application.inc +++ b/lcl/include/application.inc @@ -886,10 +886,10 @@ end; ------------------------------------------------------------------------------} function TApplication.GetIconHandle: HICON; begin - if FIcon<>nil then + if FIcon <> nil then Result := FIcon.Handle else - Result:=0; + Result := 0; end; {------------------------------------------------------------------------------ diff --git a/lcl/include/customform.inc b/lcl/include/customform.inc index e904ce95eb..9a9107c32b 100644 --- a/lcl/include/customform.inc +++ b/lcl/include/customform.inc @@ -252,8 +252,7 @@ end; ------------------------------------------------------------------------------} function TCustomForm.GetIconHandle: HICON; begin - //DebugLn('[TCustomForm.GetIconHandle] ',ClassName,' ',FIcon<>nil); - if (FIcon<>nil) and (not Icon.Empty) then + if (FIcon <> nil) and (not FIcon.Empty) then Result := FIcon.Handle else Result := Application.GetIconHandle; diff --git a/lcl/include/interfacebase.inc b/lcl/include/interfacebase.inc index 41276278d2..587bbfa69d 100644 --- a/lcl/include/interfacebase.inc +++ b/lcl/include/interfacebase.inc @@ -49,9 +49,13 @@ begin if Assigned(ALoop) then ALoop; end; +procedure TWidgetSet.AppSetIcon(const AIcon: HICON); +begin +end; + procedure TWidgetSet.AppSetTitle(const ATitle: string); begin - Debugln('TWidgetSet.AppSetTitle not implemented by ', ClassName); + Debugln('TWidgetSet.AppSetTitle is not implemented by ', ClassName); end; function TWidgetSet.LCLCapability(ACapability: TLCLCapability): PtrUInt; diff --git a/lcl/interfacebase.pp b/lcl/interfacebase.pp index 2db1bb606b..8504083000 100644 --- a/lcl/interfacebase.pp +++ b/lcl/interfacebase.pp @@ -91,6 +91,7 @@ type procedure AppMinimize; virtual; abstract; procedure AppRestore; virtual; abstract; procedure AppBringToFront; virtual; abstract; + procedure AppSetIcon(const AIcon: HICON); virtual; procedure AppSetTitle(const ATitle: string); virtual; function LCLPlatform: TLCLPlatform; virtual; abstract; diff --git a/lcl/interfaces/carbon/carbonint.pas b/lcl/interfaces/carbon/carbonint.pas index 9d168ab73b..1d286a3d18 100644 --- a/lcl/interfaces/carbon/carbonint.pas +++ b/lcl/interfaces/carbon/carbonint.pas @@ -104,6 +104,7 @@ type procedure AppMinimize; override; procedure AppRestore; override; procedure AppBringToFront; override; + procedure AppSetIcon(const AIcon: HICON); override; procedure AppSetTitle(const ATitle: string); override; procedure AttachMenuToWindow(AMenuObject: TComponent); override; diff --git a/lcl/interfaces/carbon/carbonobject.inc b/lcl/interfaces/carbon/carbonobject.inc index 52fb5536c1..95da17b717 100644 --- a/lcl/interfaces/carbon/carbonobject.inc +++ b/lcl/interfaces/carbon/carbonobject.inc @@ -974,6 +974,14 @@ begin OSError(SetFrontProcess(Proc), Self, SName, 'SetFrontProcess'); end; +procedure TCarbonWidgetSet.AppSetIcon(const AIcon: HICON); +begin + if AIcon <> 0 then + SetApplicationDockTileImage(TCarbonBitmap(AIcon).CGImage) + else + RestoreApplicationDockTileImage; +end; + {------------------------------------------------------------------------------ Method: TCarbonWidgetSet.AppSetTitle Params: ATitle - New application title diff --git a/lcl/interfaces/qt/qtint.pp b/lcl/interfaces/qt/qtint.pp index 9ccf2e3996..8355161fa1 100644 --- a/lcl/interfaces/qt/qtint.pp +++ b/lcl/interfaces/qt/qtint.pp @@ -93,6 +93,7 @@ type procedure AppMinimize; override; procedure AppRestore; override; procedure AppBringToFront; override; + procedure AppSetIcon(const AIcon: HICON); override; procedure AppSetTitle(const ATitle: string); override; procedure AttachMenuToWindow(AMenuObject: TComponent); override; public diff --git a/lcl/interfaces/qt/qtobject.inc b/lcl/interfaces/qt/qtobject.inc index b000758228..45d74da138 100644 --- a/lcl/interfaces/qt/qtobject.inc +++ b/lcl/interfaces/qt/qtobject.inc @@ -217,7 +217,7 @@ begin TQtMainWindow(Application.MainForm.Handle).BringToFront; end; -{procedure TQtWidgetSet.AppSetIcon(const AIcon: HICON); +procedure TQtWidgetSet.AppSetIcon(const AIcon: HICON); var Icon: TQtIcon; begin @@ -227,7 +227,7 @@ begin else QApplication_setWindowIcon(nil); end; -} + procedure TQtWidgetSet.AppSetTitle(const ATitle: string); var diff --git a/lcl/interfaces/win32/win32int.pp b/lcl/interfaces/win32/win32int.pp index ef40d48b41..189a81e674 100644 --- a/lcl/interfaces/win32/win32int.pp +++ b/lcl/interfaces/win32/win32int.pp @@ -184,6 +184,7 @@ type procedure AppProcessMessages; override; procedure AppWaitMessage; override; procedure AppTerminate; override; + procedure AppSetIcon(const AIcon: HICON); override; procedure AppSetTitle(const ATitle: string); override; function InitHintFont(HintFont: TObject): Boolean; Override; diff --git a/lcl/interfaces/win32/win32object.inc b/lcl/interfaces/win32/win32object.inc index 173460dfb6..0d78402cbb 100644 --- a/lcl/interfaces/win32/win32object.inc +++ b/lcl/interfaces/win32/win32object.inc @@ -390,6 +390,11 @@ begin Assert(False, 'Trace:TWin32WidgetSet.AppTerminate - Start'); end; +procedure TWin32WidgetSet.AppSetIcon(const AIcon: HICON); +begin + SendMessage(Win32Widgetset.AppHandle, WM_SETICON, ICON_BIG, AIcon); +end; + procedure TWin32WidgetSet.AppSetTitle(const ATitle: string); begin {$ifdef WindowsUnicodeSupport}