lcl, widgetsets: reimplement form, application icon setting to allow set 2 icons: small and big (#0012401)

git-svn-id: trunk@17015 -
This commit is contained in:
paul 2008-10-16 03:23:40 +00:00
parent 33015ac694
commit 06924525ea
17 changed files with 172 additions and 65 deletions

View File

@ -385,6 +385,8 @@ type
FFormHandlers: array[TFormHandlerType] of TMethodList;
FHelpFile: string;
FIcon: TIcon;
FSmallIconHandle: HICON;
FBigIconHandle: HICON;
FKeyPreview: Boolean;
FMenu: TMainMenu;
FModalResult: TModalResult;
@ -416,6 +418,7 @@ type
function IsHelpFileStored: boolean;
function IsIconStored: Boolean;
procedure CloseModal;
procedure FreeIconHandles;
procedure IconChanged(Sender: TObject);
function IsKeyPreviewStored: boolean;
procedure SetActive(AValue: Boolean);
@ -457,7 +460,7 @@ type
procedure BeginFormUpdate;
procedure CreateParams(var Params: TCreateParams); override;
procedure CreateWnd; override;
procedure Deactivate;dynamic;
procedure Deactivate; dynamic;
procedure DestroyWnd; override;
procedure DoClose(var CloseAction: TCloseAction); dynamic;
procedure DoCreate; virtual;
@ -502,7 +505,8 @@ type
constructor Create(AOwner: TComponent); override;
constructor CreateNew(AOwner: TComponent; Num : Integer{=0}); virtual;
procedure BeforeDestruction; override;
function GetIconHandle: HICON;
function BigIconHandle: HICON;
function SmallIconHandle: HICON;
destructor Destroy; override;
procedure Close;
function CloseQuery: boolean; virtual;
@ -976,6 +980,8 @@ type
FHintTimerType: TAppHintTimerType;
FHintWindow: THintWindow;
FIcon: TIcon;
FBigIconHandle: HICON;
FSmallIconHandle: HICON;
FIdleLockCount: Integer;
FFormList: TList;
FLastKeyDownSender: TWinControl;
@ -1014,8 +1020,8 @@ type
function GetActive: boolean;
function GetCurrentHelpFile: string;
function GetExename: String;
function GetIconHandle: HICON;
function GetTitle: string;
procedure FreeIconHandles;
procedure IconChanged(Sender: TObject);
function InvokeHelp(Command: Word; Data: Longint): Boolean;
function GetControlAtMouse: TControl;
@ -1062,6 +1068,8 @@ type
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
procedure ControlDestroyed(AControl: TControl);
function BigIconHandle: HIcon;
function SmallIconHandle: HIcon;
procedure BringToFront;
procedure CreateForm(InstanceClass: TComponentClass; out Reference);
procedure UpdateMainForm(AForm: TForm);
@ -1083,7 +1091,6 @@ type
procedure CancelHint;
procedure HideHint;
procedure HintMouseMessage(Control : TControl; var AMessage: TLMessage);
property Icon: TIcon read FIcon write SetIcon;
procedure Initialize; override;
function MessageBox(Text, Caption: PChar; Flags: Longint): Integer;
procedure Minimize;
@ -1165,6 +1172,7 @@ type
property HintPause: Integer read FHintPause write FHintPause;
property HintShortCuts: Boolean read FHintShortCuts write FHintShortCuts;
property HintShortPause: Integer read FHintShortPause write FHintShortPause;
property Icon: TIcon read FIcon write SetIcon;
property Navigation: TApplicationNavigationOptions read FNavigation write SetNavigation;
property MainForm: TForm read FMainForm;
property OnActionExecute: TActionEvent read FOnActionExecute write FOnActionExecute;

View File

@ -149,6 +149,7 @@ begin
// destroying
ApplicationActionComponent:=nil;
FreeThenNil(FIcon);
FreeIconHandles;
FreeThenNil(FFormList);
for HandlerType:=Low(TApplicationHandlerType) to High(TApplicationHandlerType) do
@ -878,25 +879,51 @@ procedure TApplication.IconChanged(Sender: TObject);
var
i: integer;
begin
Icon.OnChange := nil;
Icon.Current := Icon.GetBestIndexForSize(Size(GetSystemMetrics(SM_CXICON), GetSystemMetrics(SM_CYICON)));
Widgetset.AppSetIcon(GetIconHandle);
if FFormList<>nil then
for i :=0 to FFormList.Count - 1 do
FreeIconHandles;
Widgetset.AppSetIcon(SmallIconHandle, BigIconHandle);
if FFormList <> nil then
for i := 0 to FFormList.Count - 1 do
TForm(FFormList[i]).Perform(CM_ICONCHANGED, 0, 0);
Icon.OnChange := @IconChanged;
end;
{------------------------------------------------------------------------------
Method: TApplication.GetIconHandle
Returns: handle of default form icon
Method: TApplication.SmallIconHandle
Returns: handle of application icon
------------------------------------------------------------------------------}
function TApplication.GetIconHandle: HICON;
function TApplication.SmallIconHandle: HIcon;
begin
if not Icon.Empty then
Result := Icon.Handle
begin
if FSmallIconHandle = 0 then
begin
Icon.OnChange := nil;
Icon.Current := Icon.GetBestIndexForSize(Size(GetSystemMetrics(SM_CXSMICON), GetSystemMetrics(SM_CYSMICON)));
FSmallIconHandle := Icon.ReleaseHandle;
Icon.OnChange := @IconChanged;
end;
Result := FSmallIconHandle;
end
else
Result := 0;
end;
{------------------------------------------------------------------------------
Method: TApplication.BigIconHandle
Returns: handle of application icon
------------------------------------------------------------------------------}
function TApplication.BigIconHandle: HIcon;
begin
if not Icon.Empty then
begin
if FBigIconHandle = 0 then
begin
Icon.OnChange := nil;
Icon.Current := Icon.GetBestIndexForSize(Size(GetSystemMetrics(SM_CXICON), GetSystemMetrics(SM_CYICON)));
FBigIconHandle := Icon.ReleaseHandle;
Icon.OnChange := @IconChanged;
end;
Result := FBigIconHandle;
end
else
Result := 0;
end;
@ -918,6 +945,21 @@ begin
end;
end;
procedure TApplication.FreeIconHandles;
begin
if FSmallIconHandle <> 0 then
begin
DestroyIcon(FSmallIconHandle);
FSmallIconHandle := 0;
end;
if FBigIconHandle <> 0 then
begin
DestroyIcon(FBigIconHandle);
FBigIconHandle := 0;
end;
end;
{------------------------------------------------------------------------------
Method: TApplication.HandleException
Params: Sender

View File

@ -48,6 +48,21 @@ begin
end;
end;
procedure TCustomForm.FreeIconHandles;
begin
if FSmallIconHandle <> 0 then
begin
DestroyIcon(FSmallIconHandle);
FSmallIconHandle := 0;
end;
if FBigIconHandle <> 0 then
begin
DestroyIcon(FBigIconHandle);
FBigIconHandle := 0;
end;
end;
{------------------------------------------------------------------------------
Method: TCustomForm.BeforeDestruction
Params: None
@ -83,6 +98,7 @@ begin
try
FreeThenNil(FMenu);
FreeThenNil(FIcon);
FreeIconHandles;
Screen.RemoveForm(Self);
FreeThenNil(FActionLists);
for HandlerType:=Low(FFormHandlers) to High(FFormHandlers) do
@ -115,7 +131,7 @@ end;
------------------------------------------------------------------------------}
procedure TCustomForm.Notification(AComponent: TComponent;
Operation: TOperation);
Begin
begin
inherited Notification(AComponent,Operation);
case Operation of
@ -153,21 +169,19 @@ Begin
FCancelControl:=nil;
end;
end;
if FDesigner<>nil then FDesigner.Notification(AComponent,Operation);
End;
if FDesigner <> nil then FDesigner.Notification(AComponent,Operation);
end;
{------------------------------------------------------------------------------
Method: TCustomForm.IconChanged
------------------------------------------------------------------------------}
procedure TCustomForm.IconChanged(Sender: TObject);
begin
Icon.OnChange := nil;
Icon.Current := Icon.GetBestIndexForSize(Size(GetSystemMetrics(SM_CXICON), GetSystemMetrics(SM_CYICON)));
if HandleAllocated then
TWSCustomFormClass(WidgetSetClass).SetIcon(Self, GetIconHandle);
Icon.OnChange := @IconChanged;
begin
FreeIconHandles;
TWSCustomFormClass(WidgetSetClass).SetIcon(Self, SmallIconHandle, BigIconHandle);
end;
end;
{------------------------------------------------------------------------------
@ -244,19 +258,49 @@ end;
------------------------------------------------------------------------------}
function TCustomForm.IsIconStored: Boolean;
begin
Result := IsForm and (Icon<>nil);
Result := IsForm and (Icon <> nil);
end;
{------------------------------------------------------------------------------
Method: TCustomForm.GetIconHandle
Returns: handle of form icon
Method: TCustomForm.BigIconHandle
Returns: HICON
------------------------------------------------------------------------------}
function TCustomForm.GetIconHandle: HICON;
function TCustomForm.BigIconHandle: HICON;
begin
if not FIcon.Empty then
Result := FIcon.Handle
begin
if FBigIconHandle = 0 then
begin
FIcon.OnChange := nil;
FIcon.Current := Icon.GetBestIndexForSize(Size(GetSystemMetrics(SM_CXICON), GetSystemMetrics(SM_CYICON)));
FBigIconHandle := FIcon.ReleaseHandle;
FIcon.OnChange := @IconChanged;
end;
Result := FBigIconHandle;
end
else
Result := Application.GetIconHandle;
Result := Application.BigIconHandle;
end;
{------------------------------------------------------------------------------
Method: TCustomForm.SmallIconHandle
Returns: HICON
------------------------------------------------------------------------------}
function TCustomForm.SmallIconHandle: HICON;
begin
if not FIcon.Empty then
begin
if FSmallIconHandle = 0 then
begin
FIcon.OnChange := nil;
FIcon.Current := Icon.GetBestIndexForSize(Size(GetSystemMetrics(SM_CXSMICON), GetSystemMetrics(SM_CYSMICON)));
FSmallIconHandle := FIcon.ReleaseHandle;
FIcon.OnChange := @IconChanged;
end;
Result := FSmallIconHandle;
end
else
Result := Application.SmallIconHandle;
end;
{------------------------------------------------------------------------------

View File

@ -49,7 +49,7 @@ begin
if Assigned(ALoop) then ALoop;
end;
procedure TWidgetSet.AppSetIcon(const AIcon: HICON);
procedure TWidgetSet.AppSetIcon(const Small, Big: HICON);
begin
end;

View File

@ -96,7 +96,7 @@ type
procedure AppMinimize; virtual; abstract;
procedure AppRestore; virtual; abstract;
procedure AppBringToFront; virtual; abstract;
procedure AppSetIcon(const AIcon: HICON); virtual;
procedure AppSetIcon(const Small, Big: HICON); virtual;
procedure AppSetTitle(const ATitle: string); virtual;
function LCLPlatform: TLCLPlatform; virtual; abstract;

View File

@ -96,7 +96,7 @@ type
procedure AppMinimize; override;
procedure AppRestore; override;
procedure AppBringToFront; override;
procedure AppSetIcon(const AIcon: HICON); override;
procedure AppSetIcon(const Small, Big: HICON); override;
procedure AppSetTitle(const ATitle: string); override;
function GetLCLCapability(ACapability: TLCLCapability): PtrUInt; override;

View File

@ -1040,10 +1040,10 @@ begin
OSError(SetFrontProcess(Proc), Self, SName, 'SetFrontProcess');
end;
procedure TCarbonWidgetSet.AppSetIcon(const AIcon: HICON);
procedure TCarbonWidgetSet.AppSetIcon(const Small, Big: HICON);
begin
if AIcon <> 0 then
SetApplicationDockTileImage(TCarbonBitmap(AIcon).CGImage)
if Big <> 0 then
SetApplicationDockTileImage(TCarbonBitmap(Big).CGImage)
else
RestoreApplicationDockTileImage;
end;

View File

@ -87,7 +87,7 @@ type
class procedure SetAllowDropFiles(const AForm: TCustomForm; AValue: Boolean); override;
class procedure SetFormBorderStyle(const AForm: TCustomForm;
const AFormBorderStyle: TFormBorderStyle); override;
class procedure SetIcon(const AForm: TCustomForm; const AIcon: HICON); override;
class procedure SetIcon(const AForm: TCustomForm; const Small, Big: HICON); override;
class procedure SetShowInTaskbar(const AForm: TCustomForm; const AValue: TShowInTaskbar); override;
class procedure ShowModal(const AForm: TCustomForm); override;
class procedure SetBorderIcons(const AForm: TCustomForm;
@ -406,7 +406,7 @@ begin
RecreateWnd(AForm);
end;
class procedure TGtkWSCustomForm.SetIcon(const AForm: TCustomForm; const AIcon: HICON);
class procedure TGtkWSCustomForm.SetIcon(const AForm: TCustomForm; const Small, Big: HICON);
var
APixbuf: PGdkPixbuf;
Window: PGdkWindow;
@ -421,11 +421,12 @@ begin
Window := GetControlWindow(PGtkWidget(AForm.Handle));
if Window = nil then Exit;
APixbuf := PGdkPixbuf(AIcon);
APixbuf := PGdkPixbuf(Big);
Image := nil;
Mask := nil;
if APixbuf <> nil then
gdk_pixbuf_render_pixmap_and_mask(APixbuf, Image, Mask, $80);
gdk_window_set_icon(Window, nil, Image, Mask);
end;

View File

@ -80,7 +80,7 @@ type
class procedure SetCallbacks(const AWidget: PGtkWidget; const AWidgetInfo: PWidgetInfo); override;
public
class function CreateHandle(const AWinControl: TWinControl; const AParams: TCreateParams): TLCLIntfHandle; override;
class procedure SetIcon(const AForm: TCustomForm; const AIcon: HICON); override;
class procedure SetIcon(const AForm: TCustomForm; const Small, Big: HICON); override;
{ class function GetDefaultClientRect(const AWinControl: TWinControl;
const aLeft, aTop, aWidth, aHeight: integer; var aClientRect: TRect
@ -238,14 +238,20 @@ begin
end;
class procedure TGtk2WSCustomForm.SetIcon(const AForm: TCustomForm;
const AIcon: HICON);
const Small, Big: HICON);
var
List: PGList;
begin
if not WSCheckHandleAllocated(AForm, 'SetIcon')
then Exit;
if AForm.Parent <> nil then Exit;
gtk_window_set_icon(PGtkWindow(AForm.Handle), PGdkPixbuf(AIcon));
List := g_list_alloc;
g_list_append(List, PGdkPixbuf(Small));
g_list_append(List, PGdkPixbuf(Big));
gtk_window_set_icon_list(PGtkWindow(AForm.Handle), List);
g_list_free(List);
end;
{class function TGtk2WSCustomForm.GetDefaultClientRect(

View File

@ -94,7 +94,7 @@ type
procedure AppMinimize; override;
procedure AppRestore; override;
procedure AppBringToFront; override;
procedure AppSetIcon(const AIcon: HICON); override;
procedure AppSetIcon(const Small, Big: HICON); override;
procedure AppSetTitle(const ATitle: string); override;
procedure AttachMenuToWindow(AMenuObject: TComponent); override;
public

View File

@ -217,16 +217,16 @@ begin
TQtMainWindow(Application.MainForm.Handle).BringToFront;
end;
procedure TQtWidgetSet.AppSetIcon(const AIcon: HICON);
procedure TQtWidgetSet.AppSetIcon(const Small, Big: HICON);
var
DoDestroyIcon: Boolean;
Icon: QIconH;
begin
DoDestroyIcon := AIcon = 0;
DoDestroyIcon := Big = 0;
if DoDestroyIcon then
Icon := QIcon_create()
else
Icon := TQtIcon(AIcon).Handle;
Icon := TQtIcon(Big).Handle;
QApplication_setWindowIcon(Icon);
if DoDestroyIcon then
QIcon_destroy(Icon);

View File

@ -91,7 +91,7 @@ type
class procedure CloseModal(const ACustomForm: TCustomForm); override;
class procedure SetFormBorderStyle(const AForm: TCustomForm; const AFormBorderStyle: TFormBorderStyle); override;
class procedure SetFormStyle(const AForm: TCustomform; const AFormStyle: TFormStyle); override;
class procedure SetIcon(const AForm: TCustomForm; const AIcon: HICON); override;
class procedure SetIcon(const AForm: TCustomForm; const Small, Big: HICON); override;
class procedure SetShowInTaskbar(const AForm: TCustomForm; const AValue: TShowInTaskbar); override;
class procedure ShowModal(const ACustomForm: TCustomForm); override;
class procedure SetBorderIcons(const AForm: TCustomForm; const ABorderIcons: TBorderIcons); override;
@ -232,11 +232,11 @@ end;
Params:
Returns: Nothing
------------------------------------------------------------------------------}
class procedure TQtWSCustomForm.SetIcon(const AForm: TCustomForm; const AIcon: HICON);
class procedure TQtWSCustomForm.SetIcon(const AForm: TCustomForm; const Small, Big: HICON);
var
Icon: TQtIcon;
begin
Icon := TQtIcon(AIcon);
Icon := TQtIcon(Big);
if Icon <> nil then
TQtWidget(AForm.Handle).setWindowIcon(Icon.Handle)
else

View File

@ -185,7 +185,7 @@ type
procedure AppProcessMessages; override;
procedure AppWaitMessage; override;
procedure AppTerminate; override;
procedure AppSetIcon(const AIcon: HICON); override;
procedure AppSetIcon(const Small, Big: HICON); override;
procedure AppSetTitle(const ATitle: string); override;
function InitHintFont(HintFont: TObject): Boolean; Override;

View File

@ -411,9 +411,10 @@ begin
Assert(False, 'Trace:TWin32WidgetSet.AppTerminate - Start');
end;
procedure TWin32WidgetSet.AppSetIcon(const AIcon: HICON);
procedure TWin32WidgetSet.AppSetIcon(const Small, Big: HICON);
begin
Windows.SendMessage(Win32Widgetset.AppHandle, WM_SETICON, ICON_BIG, LPARAM(AIcon));
Windows.SendMessage(Win32Widgetset.AppHandle, WM_SETICON, ICON_SMALL, LPARAM(Small));
Windows.SendMessage(Win32Widgetset.AppHandle, WM_SETICON, ICON_BIG, LPARAM(Big));
end;
procedure TWin32WidgetSet.AppSetTitle(const ATitle: string);
@ -638,8 +639,11 @@ begin
if Flags = SW_SHOWMAXIMIZED then
Windows.SendMessage(Handle, WM_SHOWWINDOW, 1, 0);
end;
if (Sender Is TCustomForm) then
SetClassLong(Handle, GCL_HICON, LONG(TCustomForm(Sender).GetIconHandle));
if (Sender is TCustomForm) then
begin
SetClassLong(Handle, GCL_HICONSM, LONG(TCustomForm(Sender).SmallIconHandle));
SetClassLong(Handle, GCL_HICON, LONG(TCustomForm(Sender).BigIconHandle));
end;
end
else
begin

View File

@ -92,7 +92,7 @@ type
AWidth, AHeight: Integer); override;
class procedure SetFormBorderStyle(const AForm: TCustomForm;
const AFormBorderStyle: TFormBorderStyle); override;
class procedure SetIcon(const AForm: TCustomForm; const AIcon: HICON); override;
class procedure SetIcon(const AForm: TCustomForm; const Small, Big: HICON); override;
class procedure SetShowInTaskbar(const AForm: TCustomForm; const AValue: TShowInTaskbar); override;
class procedure ShowModal(const ACustomForm: TCustomForm); override;
end;
@ -355,7 +355,7 @@ class procedure TWin32WSCustomForm.SetBorderIcons(const AForm: TCustomForm;
begin
UpdateWindowStyle(AForm.Handle, CalcBorderIconsFlags(AForm),
WS_SYSMENU or WS_MINIMIZEBOX or WS_MAXIMIZEBOX);
SetIcon(AForm, 0);
SetIcon(AForm, 0, 0);
end;
class procedure TWin32WSCustomForm.SetFormBorderStyle(const AForm: TCustomForm;
@ -414,11 +414,12 @@ begin
TWin32WSWinControl.SetBounds(AWinControl, L, T, W, H);
end;
class procedure TWin32WSCustomForm.SetIcon(const AForm: TCustomForm; const AIcon: HICON);
class procedure TWin32WSCustomForm.SetIcon(const AForm: TCustomForm; const Small, Big: HICON);
begin
if not WSCheckHandleAllocated(AForm, 'SetIcon') then
Exit;
SendMessage(AForm.Handle, WM_SETICON, ICON_BIG, LPARAM(AIcon));
SendMessage(AForm.Handle, WM_SETICON, ICON_SMALL, LPARAM(Small));
SendMessage(AForm.Handle, WM_SETICON, ICON_BIG, LPARAM(Big));
end;
class procedure TWin32WSCustomForm.SetShowInTaskbar(const AForm: TCustomForm;

View File

@ -87,7 +87,7 @@ type
const ABorderIcons: TBorderIcons); override;
class procedure SetFormBorderStyle(const AForm: TCustomForm;
const AFormBorderStyle: TFormBorderStyle); override;
class procedure SetIcon(const AForm: TCustomForm; const AIcon: HICON); override;
class procedure SetIcon(const AForm: TCustomForm; const Small, Big: HICON); override;
class procedure SetShowInTaskbar(const AForm: TCustomForm; const AValue: TShowInTaskbar); override;
class procedure ShowModal(const ACustomForm: TCustomForm); override;
end;
@ -355,7 +355,7 @@ class procedure TWinCEWSCustomForm.SetBorderIcons(const AForm: TCustomForm;
begin
UpdateWindowStyle(AForm.Handle, CalcBorderIconsFlags(AForm),
WS_SYSMENU or WS_MINIMIZEBOX or WS_MAXIMIZEBOX);
SetIcon(AForm, 0);
SetIcon(AForm, 0, 0);
end;
class procedure TWinCEWSCustomForm.SetFormBorderStyle(const AForm: TCustomForm;
@ -408,11 +408,12 @@ begin
SizeRect.Right - SizeRect.Left, SizeRect.Bottom - SizeRect.Top);
end;
class procedure TWinCEWSCustomForm.SetIcon(const AForm: TCustomForm; const AIcon: HICON);
class procedure TWinCEWSCustomForm.SetIcon(const AForm: TCustomForm; const Small, Big: HICON);
begin
if not WSCheckHandleAllocated(AForm, 'SetIcon') then
Exit;
SendMessage(AForm.Handle, WM_SETICON, ICON_BIG, LPARAM(AIcon));
SendMessage(AForm.Handle, WM_SETICON, ICON_SMALL, LPARAM(Small));
SendMessage(AForm.Handle, WM_SETICON, ICON_BIG, LPARAM(Big));
end;
class procedure TWinCEWSCustomForm.SetShowInTaskbar(const AForm: TCustomForm;

View File

@ -82,7 +82,7 @@ type
class procedure SetFormBorderStyle(const AForm: TCustomForm;
const AFormBorderStyle: TFormBorderStyle); virtual;
class procedure SetFormStyle(const AForm: TCustomform; const AFormStyle: TFormStyle); virtual;
class procedure SetIcon(const AForm: TCustomForm; const AIcon: HICON); virtual;
class procedure SetIcon(const AForm: TCustomForm; const Small, Big: HICON); virtual;
class procedure SetShowInTaskbar(const AForm: TCustomForm; const AValue: TShowInTaskbar); virtual;
class procedure SetZPosition(const AWinControl: TWinControl; const APosition: TWSZPosition); virtual;
class procedure ShowModal(const ACustomForm: TCustomForm); virtual;
@ -146,7 +146,7 @@ class procedure TWSCustomForm.SetFormStyle(const AForm: TCustomform;
begin
end;
class procedure TWSCustomForm.SetIcon(const AForm: TCustomForm; const AIcon: HICON);
class procedure TWSCustomForm.SetIcon(const AForm: TCustomForm; const Small, Big: HICON);
begin
end;