paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-05-30 16:02:51 +02:00
Code Issues Packages Projects Releases Wiki Activity

win32, gtk1, gtk2: update/add TWSCustomForm.SetIcon implementation

Browse Source 
git-svn-id: trunk@15500 -
This commit is contained in:
paul 2008-06-21 13:00:44 +00:00
parent d79dcb8585
commit f40ea524b5
4 changed files with 59 additions and 43 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

17
lcl/interfaces/gtk/gtkwsforms.pp
View File

@ -28,9 +28,9 @@ interface
uses
{$IFDEF GTK2}
Gtk2, Glib2, gdk2,
Gtk2, Glib2, Gdk2, Gdk2Pixbuf,
{$ELSE}
Gtk, gdk, Glib, X, Xlib,
Gtk, Glib, Gdk, GdkPixbuf, X, Xlib,
{$ENDIF}
SysUtils, Classes, LCLProc, LCLType, Controls, LMessages, InterfaceBase,
Graphics, Dialogs,Forms, Math,
@ -408,20 +408,25 @@ end;
class procedure TGtkWSCustomForm.SetIcon(const AForm: TCustomForm; const AIcon: HICON);
var
GdiObject: PGdiObject;
APixbuf: PGdkPixbuf;
Window: PGdkWindow;
Image: PGdkPixmap;
Mask: PGdkBitmap;
begin
if not WSCheckHandleAllocated(AForm, 'SetIcon')
then Exit;
if AForm.Parent <> nil then Exit;
if AIcon = 0 then Exit;
Window := GetControlWindow(PGtkWidget(AForm.Handle));
if Window = nil then Exit;
GdiObject := PGdiObject(AIcon);
gdk_window_set_icon(Window, nil, GdiObject^.GDIPixmapObject.Image, GdiObject^.GDIPixmapObject.Mask);
APixbuf := PGdkPixbuf(AIcon);
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;
class procedure TGtkWSCustomForm.SetShowInTaskbar(const AForm: TCustomForm;

36
lcl/interfaces/gtk2/gtk2wsforms.pp
View File

@ -28,7 +28,7 @@ interface
uses
// Bindings
Gtk2, Glib2, gdk2,
Gtk2, Glib2, Gdk2, Gdk2Pixbuf,
// RTL, FCL, LCL
SysUtils, Classes, LCLProc, LCLType, Controls, LMessages, InterfaceBase,
Graphics, Dialogs,Forms, Math,
@ -80,6 +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 function GetDefaultClientRect(const AWinControl: TWinControl;
const aLeft, aTop, aWidth, aHeight: integer; var aClientRect: TRect
@ -236,6 +237,39 @@ begin
SetCallbacks(P, WidgetInfo);
end;
class procedure TGtk2WSCustomForm.SetIcon(const AForm: TCustomForm;
const AIcon: HICON);
{$ifdef windows}
var
Old8087CW: Word;
procedure SetCW;
begin
Old8087CW := Get8087CW;
Set8087CW($133F);
end;
procedure ResetCW;
begin
Set8087CW(Old8087CW);
end;
{$endif}
begin
if not WSCheckHandleAllocated(AForm, 'SetIcon')
then Exit;
if AForm.Parent <> nil then Exit;
{$ifdef windows}
SetCW;
{$endif}
gtk_window_set_icon(PGtkWindow(AForm.Handle), PGdkPixbuf(AIcon));
{$ifdef windows}
ResetCW;
{$endif}
end;
{class function TGtk2WSCustomForm.GetDefaultClientRect(
const AWinControl: TWinControl; const aLeft, aTop, aWidth, aHeight: integer;
var aClientRect: TRect): boolean;

24
lcl/interfaces/win32/win32wsforms.pp
View File

@ -335,8 +335,6 @@ begin
SetStdBiDiModeParams(AWinControl, Params);
// create window
FinishCreateWindow(AWinControl, Params, false);
// TODO: proper icon, for now set default icon
SetIcon(TCustomForm(AWinControl), 0);
Result := Params.Window;
end;
@ -417,29 +415,19 @@ begin
end;
class procedure TWin32WSCustomForm.SetIcon(const AForm: TCustomForm; const AIcon: HICON);
var
winHandle: HWND;
iconHandle: HICON;
begin
winHandle := AForm.Handle;
if GetDesigningBorderStyle(AForm) = bsDialog then
iconHandle := 0
{ TODO: fix icon handling
else
if AIcon <> 0 then
iconHandle := AIcon
}
else
iconHandle := Windows.LoadIcon(MainInstance, 'MAINICON');
SendMessage(winHandle, WM_SETICON, ICON_BIG, LPARAM(iconHandle));
if not WSCheckHandleAllocated(AForm, 'SetIcon') then
Exit;
SendMessage(AForm.Handle, WM_SETICON, ICON_BIG, LPARAM(AIcon));
end;
class procedure TWin32WSCustomForm.SetShowInTaskbar(const AForm: TCustomForm;
const AValue: TShowInTaskbar);
begin
if not AForm.HandleAllocated then exit;
if not WSCheckHandleAllocated(AForm, 'SetShowInTaskbar') then
Exit;
if (Application <> nil) and (AForm = Application.MainForm) then
exit;
Exit;
RecreateWnd(AForm);
end;

25
lcl/interfaces/wince/wincewsforms.pp
View File

@ -32,7 +32,7 @@ uses
SysUtils, Controls, LCLType, Forms, InterfaceBase,
// Widgetset
winceproc, wincewscontrols,
WSForms, WSLCLClasses;
WSForms, WSProc, WSLCLClasses;
type
@ -338,8 +338,6 @@ begin
// create window
FinishCreateWindow(AWinControl, Params, false);
// TODO: proper icon, for now set default icon
SetIcon(TCustomForm(AWinControl), 0);
Result := Params.Window;
{$ifdef VerboseWinCE}
@ -411,29 +409,20 @@ begin
end;
class procedure TWinCEWSCustomForm.SetIcon(const AForm: TCustomForm; const AIcon: HICON);
var
winHandle: HWND;
iconHandle: HICON;
begin
winHandle := AForm.Handle;
if AForm.BorderStyle = bsDialog then
iconHandle := 0
{ TODO: fix icon handling
else
if AIcon <> 0 then
iconHandle := AIcon
}
else
iconHandle := Windows.LoadIcon(MainInstance, 'MAINICON');
SendMessage(winHandle, WM_SETICON, ICON_BIG, iconHandle);
if not WSCheckHandleAllocated(AForm, 'SetIcon') then
Exit;
SendMessage(AForm.Handle, WM_SETICON, ICON_BIG, LPARAM(AIcon));
end;
class procedure TWinCEWSCustomForm.SetShowInTaskbar(const AForm: TCustomForm;
const AValue: TShowInTaskbar);
begin
if not AForm.HandleAllocated then exit;
if not WSCheckHandleAllocated(AForm, 'SetShowInTaskbar') then
Exit;
if (Application <> nil) and (AForm = Application.MainForm) then
exit;
Exit;
RecreateWnd(AForm);
end;