diff --git a/lcl/forms.pp b/lcl/forms.pp index f3e54b191d..5dae7e7812 100644 --- a/lcl/forms.pp +++ b/lcl/forms.pp @@ -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; diff --git a/lcl/include/application.inc b/lcl/include/application.inc index 9c20872d7a..5177cc82da 100644 --- a/lcl/include/application.inc +++ b/lcl/include/application.inc @@ -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 diff --git a/lcl/include/customform.inc b/lcl/include/customform.inc index 608faca51b..0ec8965af9 100644 --- a/lcl/include/customform.inc +++ b/lcl/include/customform.inc @@ -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; {------------------------------------------------------------------------------ diff --git a/lcl/include/interfacebase.inc b/lcl/include/interfacebase.inc index 6d0c72b70d..d7e71d067c 100644 --- a/lcl/include/interfacebase.inc +++ b/lcl/include/interfacebase.inc @@ -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; diff --git a/lcl/interfacebase.pp b/lcl/interfacebase.pp index b9020b4adc..07a808af51 100644 --- a/lcl/interfacebase.pp +++ b/lcl/interfacebase.pp @@ -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; diff --git a/lcl/interfaces/carbon/carbonint.pas b/lcl/interfaces/carbon/carbonint.pas index c72d015e28..975709e33e 100644 --- a/lcl/interfaces/carbon/carbonint.pas +++ b/lcl/interfaces/carbon/carbonint.pas @@ -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; diff --git a/lcl/interfaces/carbon/carbonobject.inc b/lcl/interfaces/carbon/carbonobject.inc index ddeb6073ce..a2f3f9784b 100644 --- a/lcl/interfaces/carbon/carbonobject.inc +++ b/lcl/interfaces/carbon/carbonobject.inc @@ -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; diff --git a/lcl/interfaces/gtk/gtkwsforms.pp b/lcl/interfaces/gtk/gtkwsforms.pp index 2bd8d0ed4f..298f7283f9 100644 --- a/lcl/interfaces/gtk/gtkwsforms.pp +++ b/lcl/interfaces/gtk/gtkwsforms.pp @@ -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; diff --git a/lcl/interfaces/gtk2/gtk2wsforms.pp b/lcl/interfaces/gtk2/gtk2wsforms.pp index 00bf91a8f8..349490fc3e 100644 --- a/lcl/interfaces/gtk2/gtk2wsforms.pp +++ b/lcl/interfaces/gtk2/gtk2wsforms.pp @@ -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( diff --git a/lcl/interfaces/qt/qtint.pp b/lcl/interfaces/qt/qtint.pp index db1f6d0163..d833cb3417 100644 --- a/lcl/interfaces/qt/qtint.pp +++ b/lcl/interfaces/qt/qtint.pp @@ -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 diff --git a/lcl/interfaces/qt/qtobject.inc b/lcl/interfaces/qt/qtobject.inc index 2172773dd3..e181196f50 100644 --- a/lcl/interfaces/qt/qtobject.inc +++ b/lcl/interfaces/qt/qtobject.inc @@ -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); diff --git a/lcl/interfaces/qt/qtwsforms.pp b/lcl/interfaces/qt/qtwsforms.pp index fa18a77dfd..deb2cb83c0 100644 --- a/lcl/interfaces/qt/qtwsforms.pp +++ b/lcl/interfaces/qt/qtwsforms.pp @@ -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 diff --git a/lcl/interfaces/win32/win32int.pp b/lcl/interfaces/win32/win32int.pp index d43ad24404..0b0b2713c6 100644 --- a/lcl/interfaces/win32/win32int.pp +++ b/lcl/interfaces/win32/win32int.pp @@ -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; diff --git a/lcl/interfaces/win32/win32object.inc b/lcl/interfaces/win32/win32object.inc index 62c69f762b..721cfcf97d 100644 --- a/lcl/interfaces/win32/win32object.inc +++ b/lcl/interfaces/win32/win32object.inc @@ -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 diff --git a/lcl/interfaces/win32/win32wsforms.pp b/lcl/interfaces/win32/win32wsforms.pp index c604916132..3349e08ce2 100644 --- a/lcl/interfaces/win32/win32wsforms.pp +++ b/lcl/interfaces/win32/win32wsforms.pp @@ -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; diff --git a/lcl/interfaces/wince/wincewsforms.pp b/lcl/interfaces/wince/wincewsforms.pp index 8c4f16e157..feb56b3160 100644 --- a/lcl/interfaces/wince/wincewsforms.pp +++ b/lcl/interfaces/wince/wincewsforms.pp @@ -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; diff --git a/lcl/widgetset/wsforms.pp b/lcl/widgetset/wsforms.pp index b0c4286ec0..ab2df72313 100644 --- a/lcl/widgetset/wsforms.pp +++ b/lcl/widgetset/wsforms.pp @@ -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;