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

convert LM_SETFORMICON message to interface method

Browse Source 
git-svn-id: trunk@6002 -
This commit is contained in:
micha 2004-09-15 07:58:00 +00:00
parent 89fe6ac437
commit 1a1fa9f508
8 changed files with 56 additions and 33 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

6
lcl/include/application.inc
View File

@ -735,7 +735,8 @@ end;
------------------------------------------------------------------------------}
procedure TApplication.IconChanged(Sender: TObject);
begin
CNSendMessage(LM_SETFORMICON, Self, Pointer(GetIconHandle));
DebugLn('TApplication.IconChanged - TODO: convert this message...no implementation in gtk or win32');
// CNSendMessage(LM_SETFORMICON, Self, Pointer(GetIconHandle));
// NotifyForms(CM_ICONCHANGED);
end;
@ -1339,6 +1340,9 @@ end;
{ =============================================================================
$Log$
Revision 1.91 2004/09/15 07:57:59 micha
convert LM_SETFORMICON message to interface method
Revision 1.90 2004/09/11 13:38:37 micha
convert LM_BRINGTOFRONT message to interface method
NOTE: was only used for tapplication, not from other controls

7
lcl/include/customform.inc
View File

@ -195,7 +195,7 @@ End;
procedure TCustomForm.IconChanged(Sender: TObject);
begin
if HandleAllocated then
CNSendMessage(LM_SETFORMICON,Self,Pointer(GetIconHandle));
TWSCustomForm(WidgetSetClass).SetIcon(Self, GetIconHandle);
end;
{------------------------------------------------------------------------------
@ -1489,7 +1489,7 @@ begin
inherited CreateWnd;
if Parent=nil then begin
CNSendMessage(LM_SETFORMICON, Self, Pointer(GetIconHandle));
TWSCustomFormClass(WidgetSetClass).SetIcon(Self, GetIconHandle);
DC:=GetDC(Handle);
FPixelsPerInch:=GetDeviceCaps(DC,LOGPIXELSX);
ReleaseDC(Handle,DC);
@ -1808,6 +1808,9 @@ end;
{ =============================================================================
$Log$
Revision 1.157 2004/09/15 07:57:59 micha
convert LM_SETFORMICON message to interface method
Revision 1.156 2004/09/13 13:13:46 micha
convert LM_SHOWMODAL to interface methods

24
lcl/interfaces/gtk/gtkobject.inc
View File

@ -3064,9 +3064,7 @@ var
Widget : PGtkWidget; // pointer to gtk-widget (local use when neccessary)
GList : pGList; // Only used for listboxes, replace with widget!!!!!
ListItem : PGtkListItem; // currently only used for listboxes
FormIconGdiObject: PGdiObject; // currently only used by LM_SETFORMICON
Geometry : TGdkGeometry;
AWindow : PGdkWindow;
begin
Result := 0; //default value just in case nothing sets it
@ -3118,25 +3116,6 @@ begin
TLMNotebookEvent(Data^).Page);
end;
LM_SETFORMICON :
begin
if (Sender is TCustomForm) and (TCustomForm(Sender).Parent=nil) then
begin
if (Handle<>0) and (Data<>nil) then begin
FormIconGdiObject:=Data;
//DebugLn('LM_SETFORMICON ',FormIconGdiObject<>nil,' ',pgtkWidget(Handle)^.Window<>nil);
if (FormIconGdiObject<>nil) then begin
AWindow:=GetControlWindow(PGtkWidget(Handle));
if AWindow<>nil then begin
gdk_window_set_icon(AWindow, nil,
FormIconGdiObject^.GDIBitmapObject,
FormIconGdiObject^.GDIBitmapMaskObject);
end;
end;
end;
end;
end;
LM_SCREENINIT :
begin
{ Compute pixels per inch variable }
@ -8211,6 +8190,9 @@ end;
{ =============================================================================
$Log$
Revision 1.568 2004/09/15 07:57:59 micha
convert LM_SETFORMICON message to interface method
Revision 1.567 2004/09/14 15:48:28 micha
convert LM_INVALIDATE message to interface method

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

@ -30,7 +30,7 @@ uses
{$IFDEF GTK2} Gtk2, Glib2, gdk2, {$ELSE} Gtk, gdk, Glib, {$ENDIF}
SysUtils, Classes, Controls, LMessages, InterfaceBase, graphics,
Dialogs, WSDialogs, WSLCLClasses, gtkint, gtkproc, gtkwscontrols,
Forms, WSForms, Math;
Forms, WSForms, Math, lcltype, gtkdef;
type
@ -74,6 +74,7 @@ type
public
class procedure SetFormBorderStyle(const AForm: TCustomForm;
const AFormBorderStyle: TFormBorderStyle); override;
class procedure SetIcon(const AForm: TCustomForm; const AIcon: HICON); override;
class procedure ShowModal(const ACustomForm: TCustomForm); override;
end;
@ -122,6 +123,28 @@ begin
// This is Delphi compatible, so no Recreatewnd needed.
end;
procedure TGtkWSCustomForm.SetIcon(const AForm: TCustomForm; const AIcon: HICON);
var
FormIconGdiObject: PGdiObject;
AWindow : PGdkWindow;
begin
if AForm.Parent = nil then
begin
if AForm.HandleAllocated and (AIcon <> 0) then begin
FormIconGdiObject:=PGdiObject(AIcon);
//DebugLn('LM_SETFORMICON ',FormIconGdiObject<>nil,' ',pgtkWidget(Handle)^.Window<>nil);
if (FormIconGdiObject <> nil) then begin
AWindow:=GetControlWindow(PGtkWidget(AForm.Handle));
if AWindow<>nil then begin
gdk_window_set_icon(AWindow, nil,
FormIconGdiObject^.GDIBitmapObject,
FormIconGdiObject^.GDIBitmapMaskObject);
end;
end;
end;
end;
end;
procedure TGtkWSCustomForm.ShowModal(const ACustomForm: TCustomForm);
var
GtkWindow: PGtkWindow;

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

@ -330,10 +330,6 @@ Begin
Else
Assert(False, Format('Trace:I don''t know how to destroy component %S', [Sender.ClassName]));
End;
LM_SETFORMICON:
Begin
SetClassLong(Handle, GCL_HIcon, integer(Data));
End;
LM_GETITEMS :
Begin
If (Sender as TControl).fCompStyle = csCListBox
@ -2239,6 +2235,9 @@ End;
{
$Log$
Revision 1.261 2004/09/15 07:58:00 micha
convert LM_SETFORMICON message to interface method
Revision 1.260 2004/09/14 21:30:37 vincents
replaced writeln by DebugLn

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

@ -77,6 +77,7 @@ type
private
protected
public
class procedure SetIcon(const AForm: TCustomForm; const AIcon: HICON); override;
class procedure ShowModal(const ACustomForm: TCustomForm); override;
end;
@ -141,6 +142,11 @@ end;
{ TWin32WSCustomForm }
procedure TWin32WSCustomForm.SetIcon(const AForm: TCustomForm; const AIcon: HICON);
begin
SendMessage(AForm.Handle, WM_SETICON, ICON_BIG, AIcon);
end;
procedure TWin32WSCustomForm.ShowModal(const ACustomForm: TCustomForm);
var
FormHandle: HWND;

5
lcl/lmessages.pp
View File

@ -62,7 +62,6 @@ const
LM_GETVALUE = LM_ComUser+41; // get actual value from visual object
LM_RECREATEWND = LM_COMUSER+57;
LM_SETFORMICON = LM_COMUSER+58;
LM_MINIMIZE = LM_COMUSER+59;
@ -831,7 +830,6 @@ begin
LM_GETVALUE :Result:='LM_GETVALUE';
LM_RECREATEWND :Result:='LM_RECREATEWND';
LM_SETFORMICON :Result:='LM_SETFORMICON';
LM_MINIMIZE :Result:='LM_MINIMIZE';
@ -961,6 +959,9 @@ end.
{
$Log$
Revision 1.100 2004/09/15 07:57:59 micha
convert LM_SETFORMICON message to interface method
Revision 1.99 2004/09/14 15:48:28 micha
convert LM_INVALIDATE message to interface method

9
lcl/widgetset/wsforms.pp
View File

@ -46,7 +46,7 @@ uses
////////////////////////////////////////////////////
Forms,
////////////////////////////////////////////////////
WSLCLClasses, WSControls, Controls;
WSLCLClasses, WSControls, Controls, LCLType;
type
{ TWSScrollingWinControl }
@ -74,6 +74,7 @@ type
TWSCustomForm = class(TWSScrollingWinControl)
class procedure SetFormBorderStyle(const AForm: TCustomForm;
const AFormBorderStyle: TFormBorderStyle); virtual;
class procedure SetIcon(const AForm: TCustomForm; const AIcon: HICON); virtual;
class procedure ShowModal(const ACustomForm: TCustomForm); virtual;
end;
TWSCustomFormClass = class of TWSCustomForm;
@ -108,7 +109,11 @@ procedure TWSCustomForm.SetFormBorderStyle(const AForm: TCustomForm;
begin
// will be done in interface override
end;
procedure TWSCustomForm.SetIcon(const AForm: TCustomForm; const AIcon: HICON);
begin
end;
procedure TWSCustomForm.ShowModal(const ACustomForm: TCustomForm);
begin
end;