paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-04-07 21:38:00 +02:00
Code Issues Packages Projects Releases Wiki Activity

lcl: add TWidgetset.AppSetIcon

Browse Source 
win32, qt, carbon: implement AppSetIcon

git-svn-id: trunk@15497 -
This commit is contained in:
paul 2008-06-21 12:23:31 +00:00
parent 5353d4968f
commit ce329d855d
10 changed files with 27 additions and 7 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

4
lcl/include/application.inc
View File

@ -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;
{------------------------------------------------------------------------------

3
lcl/include/customform.inc
View File

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

6
lcl/include/interfacebase.inc
View File

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

1
lcl/interfacebase.pp
View File

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

1
lcl/interfaces/carbon/carbonint.pas
View File

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

8
lcl/interfaces/carbon/carbonobject.inc
View File

@ -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

1
lcl/interfaces/qt/qtint.pp
View File

@ -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

4
lcl/interfaces/qt/qtobject.inc
View File

@ -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

1
lcl/interfaces/win32/win32int.pp
View File

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

5
lcl/interfaces/win32/win32object.inc
View File

@ -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}