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

convert LM_DESTROY message to interface methods

Browse Source 
git-svn-id: trunk@6028 -
This commit is contained in:
micha 2004-09-18 12:43:15 +00:00
parent 5ecbd3487f
commit 07ce1184e8
15 changed files with 98 additions and 67 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

5
lcl/include/commondialog.inc
View File

@ -40,7 +40,7 @@ end;
procedure TCommonDialog.Close;
begin
DoClose;
CNSendMessage(LM_DESTROY, Self, nil);
TWSCommonDialogClass(WidgetSetClass).DestroyHandle(Self);
FHandle := 0;
end;
@ -97,6 +97,9 @@ end;
{ =============================================================================
$Log$
Revision 1.17 2004/09/18 12:43:15 micha
convert LM_DESTROY message to interface methods
Revision 1.16 2004/09/13 13:13:46 micha
convert LM_SHOWMODAL to interface methods

8
lcl/include/menuitem.inc
View File

@ -554,7 +554,7 @@ begin
dec(i);
end;
end;
SendMsgToInterface(LM_DESTROY, Self, nil);
TWSMenuItemClass(WidgetSetClass).DestroyHandle(Self);
FHandle:=0;
end;
@ -1150,6 +1150,9 @@ end;
{ =============================================================================
$Log$
Revision 1.63 2004/09/18 12:43:15 micha
convert LM_DESTROY message to interface methods
Revision 1.62 2004/09/17 10:56:25 micha
convert LM_SHORTCUT message to interface methods
@ -1364,6 +1367,9 @@ end;
$Log$
Revision 1.63 2004/09/18 12:43:15 micha
convert LM_DESTROY message to interface methods
Revision 1.62 2004/09/17 10:56:25 micha
convert LM_SHORTCUT message to interface methods

5
lcl/include/wincontrol.inc
View File

@ -3423,7 +3423,7 @@ procedure TWinControl.DestroyComponent;
begin
if not HandleAllocated then
RaiseGDBException('TWinControl.DestroyComponent Handle already destroyed');
CNSendMessage(LM_DESTROY, Self, nil);
TWSWinControlClass(WidgetSetClass).DestroyHandle(Self);
end;
{------------------------------------------------------------------------------
@ -3912,6 +3912,9 @@ end;
{ =============================================================================
$Log$
Revision 1.279 2004/09/18 12:43:15 micha
convert LM_DESTROY message to interface methods
Revision 1.278 2004/09/14 15:48:28 micha
convert LM_INVALIDATE message to interface method

5
lcl/interfaces/gtk/gtkint.pp
View File

@ -145,7 +145,6 @@ type
NotOnParentsClientArea: boolean): PGtkWidget;
function CreateToolBar(ToolBarObject: TObject): PGtkWidget;
procedure DestroyEmptySubmenu(Sender: TObject);virtual;
procedure DestroyLCLComponent(Sender: TObject);virtual;
procedure DestroyConnectedWidget(Widget: PGtkWidget;
CheckIfDestroying: boolean);virtual;
function RecreateWnd(Sender: TObject): Integer; virtual;
@ -308,6 +307,7 @@ type
function CreateComponent(Sender : TObject): THandle; override;
function CreateTimer(Interval: integer; TimerFunc: TFNTimerProc) : integer; override;
function DestroyTimer(TimerHandle: integer) : boolean; override;
procedure DestroyLCLComponent(Sender: TObject);virtual;
{$I gtkwinapih.inc}
{$I gtklclintfh.inc}
@ -455,6 +455,9 @@ end.
{ =============================================================================
$Log$
Revision 1.208 2004/09/18 12:43:15 micha
convert LM_DESTROY message to interface methods
Revision 1.207 2004/09/18 10:52:48 micha
convert LM_SCREENINIT message to interface method (integrated with TWidgetSet.AppInit(var ScreenInfo)

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

@ -3107,9 +3107,6 @@ begin
begin
Case LM_Message of
LM_DESTROY :
DestroyLCLComponent(Sender);
LM_MovePage :
if Sender is TCustomNoteBook then begin
MoveNBPage(TControl(Sender), TLMNotebookEvent(Data^).Child,
@ -7890,6 +7887,9 @@ end;
{ =============================================================================
$Log$
Revision 1.583 2004/09/18 12:43:15 micha
convert LM_DESTROY message to interface methods
Revision 1.582 2004/09/18 11:06:47 micha
remove LM_RECREATEWND message, as it is not used by LCL

6
lcl/interfaces/gtk/gtkwscontrols.pp
View File

@ -70,6 +70,7 @@ type
class procedure SetColor(const AWinControl: TWinControl); override;
class procedure SetText(const AWinControl: TWinControl; const AText: string); override;
class procedure DestroyHandle(const AWinControl: TWinControl); override;
class procedure Invalidate(const AWinControl: TWinControl); override;
class procedure ShowHide(const AWinControl: TWinControl); override;
end;
@ -421,6 +422,11 @@ begin
Assert(False, Format('trace: [TGtkWidgetSet.SetLabel] %s --> END', [AWinControl.ClassName]));
end;
procedure TGtkWSWinControl.DestroyHandle(const AWinControl: TWinControl);
begin
TGtkWidgetSet(InterfaceObject).DestroyLCLComponent(AWinControl);
end;
procedure TGtkWSWinControl.Invalidate(const AWinControl: TWinControl);
begin
Assert(false, 'Trace:Trying to invalidate window... !!!');

7
lcl/interfaces/gtk/gtkwsdialogs.pp
View File

@ -40,6 +40,7 @@ type
protected
public
class procedure ShowModal(const ACommonDialog: TCommonDialog); override;
class procedure DestroyHandle(const ACommonDialog: TCommonDialog); override;
end;
{ TGtkWSFileDialog }
@ -144,6 +145,12 @@ begin
GtkWindowShowModal(GtkWindow);
end;
procedure TGtkWSCommonDialog.DestroyHandle(const ACommonDialog: TCommonDialog);
begin
{ TODO: cleanup }
TGtkWidgetSet(InterfaceObject).DestroyLCLComponent(ACommonDialog);
end;
initialization
////////////////////////////////////////////////////

7
lcl/interfaces/gtk/gtkwsmenus.pp
View File

@ -44,6 +44,7 @@ type
protected
public
class procedure AttachMenu(const AMenuItem: TMenuItem); override;
class procedure DestroyHandle(const AMenuItem: TMenuItem); override;
class procedure SetCaption(const AMenuItem: TMenuItem; const ACaption: string); override;
class procedure SetShortCut(const AMenuItem: TMenuItem; const OldShortCut, NewShortCut: TShortCut); override;
end;
@ -142,6 +143,12 @@ begin
//DebugLn('TGtkWidgetSet.AttachMenu END ',AMenuItem.Name,':',AMenuItem.ClassName);
end;
procedure TGtkWSMenuItem.DestroyHandle(const AMenuItem: TMenuItem);
begin
{ TODO: cleanup }
TGtkWidgetSet(InterfaceObject).DestroyLCLComponent(AMenuItem);
end;
procedure TGtkWSMenuItem.SetCaption(const AMenuItem: TMenuItem; const ACaption: string);
var
MenuItemWidget: PGtkWidget;

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

@ -258,13 +258,6 @@ end;
integer!!!!!
------------------------------------------------------------------------------}
Function TWin32WidgetSet.IntSendMessage3(LM_Message: Integer; Sender: TObject; Data: Pointer): Integer;
Var
//Bitmap: HBITMAP; // Pixel map type image
//CBI: COMBOBOXINFO;
Handle: HWND;
AMenu: TMenu;
AccelTable: HACCEL;
Begin
Result := 0; //default value just in case nothing sets it
Assert(False, 'Trace:IntSendMessage3 - Start, Received (' + GetMessageName(LM_Message) + ')');
@ -280,55 +273,6 @@ Begin
Result := SetProperties(Sender);
LM_SETDESIGNING:
if Data<>nil then EnableWindow((Sender As TWinControl).Handle, boolean(Data^));
Else
Begin
Handle := ObjectToHWND(Sender);
If Handle = HWND(Nil) Then
Begin
//Assert (False, Format('Trace:[TWin32WidgetSet.IntSendMessage3] %S --> got Handle = Nil', [Sender.ClassName]));
//Handle := (Sender As TWinControl).Handle;
//TWinControl(Sender).Handle := Handle;
//Assert(False, Format('Trace:[TWin32WidgetSet.IntSendMessag3] Sender is %S', [Sender.ClassName]));
Exit;
End;
Case LM_Message of
LM_DESTROY:
Begin
If (Sender Is TWinControl) Or (Sender Is TCommonDialog) Then
Begin
If Handle <> 0 Then
begin
AccelTable := Windows.GetProp(Handle, 'Accel');
if AccelTable <> 0 then
DestroyAcceleratorTable(AccelTable);
DestroyWindow(Handle);
end;
End
Else If Sender Is TMenu Then
Begin
If Handle <> 0 Then
DestroyMenu(Handle)
End
Else If Sender Is TMenuItem Then
Begin
{ not assigned when this the menuitem of a TMenu; handle is destroyed above }
if Assigned(TMenuItem(Sender).Parent) then
DeleteMenu((Sender as TMenuItem).Parent.Handle, TMenuItem(Sender).Command, MF_BYCOMMAND);
AMenu:=TMenuItem(Sender).GetParentMenu;
if (AMenu<>nil) and (AMenu.Parent<>nil)
and (AMenu.Parent is TCustomForm)
and TCustomForm(AMenu.Parent).HandleAllocated
and not (csDestroying in AMenu.Parent.ComponentState) then
DrawMenuBar(TCustomForm(AMenu.Parent).Handle);
End
Else
Assert(False, Format('Trace:I don''t know how to destroy component %S', [Sender.ClassName]));
End;
Else
Assert(True, Format ('WARNING: Unhandled message %d in IntSendMessage3 send by %s --> message:Redraw', [LM_Message, Sender.ClassName]));
// unhandled message
End; // end of 2nd case
End; // end of else-part of 1st case
End; // end of 1st case
End;
@ -2066,6 +2010,9 @@ End;
{
$Log$
Revision 1.274 2004/09/18 12:43:15 micha
convert LM_DESTROY message to interface methods
Revision 1.273 2004/09/18 11:06:47 micha
remove LM_RECREATEWND message, as it is not used by LCL

13
lcl/interfaces/win32/win32wscontrols.pp
View File

@ -73,6 +73,7 @@ type
class procedure SetFont(const AWinControl: TWinControl; const AFont: TFont); override;
class procedure SetText(const AWinControl: TWinControl; const AText: string); override;
class procedure DestroyHandle(const AWinControl: TWinControl); override;
class procedure Invalidate(const AWinControl: TWinControl); override;
class procedure ShowHide(const AWinControl: TWinControl); override;
end;
@ -314,6 +315,18 @@ Begin
Assert(False, Format('Trace:[TWin32WidgetSet.SetLabel] %S --> END', [AWinControl.ClassName]));
End;
procedure TWin32WSWinControl.DestroyHandle(const AWinControl: TWinControl);
var
Handle: HWND;
AccelTable: HACCEL;
begin
Handle := AWinControl.Handle;
AccelTable := Windows.GetProp(Handle, 'Accel');
if AccelTable <> 0 then
DestroyAcceleratorTable(AccelTable);
DestroyWindow(Handle);
end;
procedure TWin32WSWinControl.Invalidate(const AWinControl: TWinControl);
begin
// lpRect = nil updates entire client area of window

12
lcl/interfaces/win32/win32wsdialogs.pp
View File

@ -33,9 +33,9 @@ uses
// To get as little as posible circles,
// uncomment only when needed for registration
////////////////////////////////////////////////////
// Dialogs,
Dialogs,
////////////////////////////////////////////////////
WSDialogs, WSLCLClasses;
WSDialogs, WSLCLClasses, Windows;
type
@ -45,6 +45,7 @@ type
private
protected
public
class procedure DestroyHandle(const ACommonDialog: TCommonDialog); override;
end;
{ TWin32WSFileDialog }
@ -106,6 +107,11 @@ type
implementation
procedure TWin32WSCommonDialog.DestroyHandle(const ACommonDialog: TCommonDialog);
begin
DestroyWindow(ACommonDialog.Handle);
end;
initialization
////////////////////////////////////////////////////
@ -114,7 +120,7 @@ initialization
// To improve speed, register only classes
// which actually implement something
////////////////////////////////////////////////////
// RegisterWSComponent(TCommonDialog, TWin32WSCommonDialog);
RegisterWSComponent(TCommonDialog, TWin32WSCommonDialog);
// RegisterWSComponent(TFileDialog, TWin32WSFileDialog);
// RegisterWSComponent(TOpenDialog, TWin32WSOpenDialog);
// RegisterWSComponent(TSaveDialog, TWin32WSSaveDialog);

17
lcl/interfaces/win32/win32wsmenus.pp
View File

@ -33,7 +33,7 @@ uses
// To get as little as posible circles,
// uncomment only when needed for registration
////////////////////////////////////////////////////
Menus,
Menus, Forms,
////////////////////////////////////////////////////
WSMenus, WSLCLClasses,
Windows, Controls, Classes, SysUtils, Win32Int, Win32Proc, InterfaceBase, LCLProc;
@ -47,6 +47,7 @@ type
protected
public
class procedure AttachMenu(const AMenuItem: TMenuItem); override;
class procedure DestroyHandle(const AMenuItem: TMenuItem); override;
class procedure SetCaption(const AMenuItem: TMenuItem; const ACaption: string); override;
class procedure SetShortCut(const AMenuItem: TMenuItem; const OldShortCut, NewShortCut: TShortCut); override;
end;
@ -219,6 +220,20 @@ begin
DrawMenuBar(TWinControl(AMenuItem.Owner).Handle);
end;
procedure TWin32WSMenuItem.DestroyHandle(const AMenuItem: TMenuItem);
var
AMenu: TMenu;
begin
{ not assigned when this the menuitem of a TMenu; handle is destroyed above }
if Assigned(AMenuItem.Parent) then
DeleteMenu(AMenuItem.Parent.Handle, AMenuItem.Command, MF_BYCOMMAND);
AMenu := AMenuItem.GetParentMenu;
if (AMenu<>nil) and (AMenu.Parent<>nil)
and (AMenu.Parent is TCustomForm)
and TCustomForm(AMenu.Parent).HandleAllocated
and not (csDestroying in AMenu.Parent.ComponentState) then
DrawMenuBar(TCustomForm(AMenu.Parent).Handle);
end;
procedure TWin32WSMenuItem.SetCaption(const AMenuItem: TMenuItem; const ACaption: string);
var

5
lcl/widgetset/wscontrols.pp
View File

@ -77,6 +77,7 @@ type
class procedure SetText(const AWinControl: TWinControl; const AText: String); virtual;
class procedure SetColor(const AWinControl: TWinControl); virtual;
class procedure DestroyHandle(const AWinControl: TWinControl); virtual;
class procedure Invalidate(const AWinControl: TWinControl); virtual;
class procedure ShowHide(const AWinControl: TWinControl); virtual;
end;
@ -170,6 +171,10 @@ procedure TWSWinControl.SetColor(const AWinControl: TWinControl);
begin
end;
procedure TWSWinControl.DestroyHandle(const AWinControl: TWinControl);
begin
end;
procedure TWSWinControl.Invalidate(const AWinControl: TWinControl);
begin
end;

5
lcl/widgetset/wsdialogs.pp
View File

@ -54,6 +54,7 @@ type
TWSCommonDialogClass = class of TWSCommonDialog;
TWSCommonDialog = class(TWSLCLComponent)
class procedure ShowModal(const ACommonDialog: TCommonDialog); virtual;
class procedure DestroyHandle(const ACommonDialog: TCommonDialog); virtual;
end;
{ TWSFileDialog }
@ -94,6 +95,10 @@ type
implementation
procedure TWSCommonDialog.DestroyHandle(const ACommonDialog: TCommonDialog);
begin
end;
procedure TWSCommonDialog.ShowModal(const ACommonDialog: TCommonDialog);
begin
end;

5
lcl/widgetset/wsmenus.pp
View File

@ -53,6 +53,7 @@ type
TWSMenuItem = class(TWSLCLComponent)
class procedure AttachMenu(const AMenuItem: TMenuItem); virtual;
class procedure DestroyHandle(const AMenuItem: TMenuItem); virtual;
class procedure SetCaption(const AMenuItem: TMenuItem; const ACaption: string); virtual;
class procedure SetShortCut(const AMenuItem: TMenuItem; const OldShortCut, NewShortCut: TShortCut); virtual;
end;
@ -84,6 +85,10 @@ procedure TWSMenuItem.AttachMenu(const AMenuItem: TMenuItem);
begin
end;
procedure TWSMenuItem.DestroyHandle(const AMenuItem: TMenuItem);
begin
end;
procedure TWSMenuItem.SetCaption(const AMenuItem: TMenuItem; const ACaption: string);
begin
end;