paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-12-06 17:47:26 +01:00
Code Issues Packages Projects Releases Wiki Activity

patch from Vincent: clean ups and fixed crash on destroying window

Browse Source 
git-svn-id: trunk@1385 -
This commit is contained in:
mattias 2002-02-09 01:48:22 +00:00
parent babefcd9dd
commit 1ae5952b58
6 changed files with 29 additions and 62 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

5
lcl/controls.pp
View File

@ -800,7 +800,6 @@ type
procedure BoundsChanged; override;
Function CanTab: Boolean; override;
Procedure CMDrag(var Message : TCMDrag); message CM_DRAG;
procedure CMShowHintChanged(var Message: TLMessage); message CM_SHOWHINTCHANGED;
procedure CMShowingChanged(var Message: TLMessage); message CM_SHOWINGCHANGED;
procedure CMVisibleChanged(var TheMessage: TLMessage); message CM_VISIBLECHANGED;
procedure CreateSubClass(var Params: TCreateParams;ControlClassName: PChar);
@ -840,7 +839,6 @@ type
procedure ReAlign;
procedure ReCreateWnd;
procedure RemoveFocus(Removing: Boolean);
procedure SetHint(const Value: String); override;
procedure SetText(const Value: TCaption); override;
procedure UpdateControlState;
procedure CreateHandle; virtual;
@ -1449,6 +1447,9 @@ end.
{ =============================================================================
$Log$
Revision 1.93 2002/12/04 20:39:14 mattias
patch from Vincent: clean ups and fixed crash on destroying window
Revision 1.92 2002/11/29 15:14:47 mattias
replaced many invalidates by invalidaterect

5
lcl/include/control.inc
View File

@ -1383,7 +1383,7 @@ begin
if (Self is TWinControl)
and TWinControl(Self).HandleAllocated
and (not (csLoading in ComponentState))
and InterfaceObject.GetText(Self, Result)
and boolean(CNSendMessage(LM_GETTEXT, Self, @Result))
then Assert(False, Format('Trace:[TControl.GetText] %s got: "%s"', [ClassName, Result]))
else Result := FCaption;
@ -2082,6 +2082,9 @@ end;
{ =============================================================================
$Log$
Revision 1.107 2002/12/04 20:39:14 mattias
patch from Vincent: clean ups and fixed crash on destroying window
Revision 1.106 2002/11/29 15:14:47 mattias
replaced many invalidates by invalidaterect

31
lcl/include/wincontrol.inc
View File

@ -2401,22 +2401,6 @@ begin
else FCaption := Value;
end;
{------------------------------------------------------------------------------
Method: TWinControl.SetHint
Params: Value: the text of the hint to be set
Returns: Nothing
Sets the hint text of a control
------------------------------------------------------------------------------}
procedure TWinControl.SetHint(const Value: String);
begin
if FHint <> Value then
begin
inherited SetHint(Value);
if HandleAllocated then InterfaceObject.UpdateHint(Self);
end;
end;
{------------------------------------------------------------------------------
Method: TWinControl.GetDeviceContext
Params: WindowHandle: the windowhandle of this control
@ -2466,18 +2450,6 @@ begin
then UpdateControlState;
end;
{------------------------------------------------------------------------------
Method: TWinControl.CMShowHintChanged
Params: Message : not used
Returns: nothing
Notifies that the hint visibility has changed
------------------------------------------------------------------------------}
procedure TWinControl.CMShowHintChanged(var Message: TLMessage);
begin
if HandleAllocated then InterfaceObject.UpdateHint(Self);
end;
{------------------------------------------------------------------------------
Method: TWinControl.CMShowingChanged
Params: Message : not used
@ -2511,6 +2483,9 @@ end;
{ =============================================================================
$Log$
Revision 1.106 2002/12/04 20:39:15 mattias
patch from Vincent: clean ups and fixed crash on destroying window
Revision 1.105 2002/12/03 09:28:31 mattias
cleaned up

12
lcl/interfacebase.pp
View File

@ -53,13 +53,6 @@ type
Currently maintained by Marc Weustink <weus@quicknet.nl>
}
TInterfaceBase = Class(TObject)
private
// procedure SetCallback(Msg : LongInt; Sender : TObject); virtual; abstract;
// procedure RemoveCallbacks(Sender : TObject); virtual; abstract;
protected
procedure SetCallback(Msg : LongInt; Sender : TObject); virtual; abstract;
procedure RemoveCallbacks(Sender : TObject); virtual; abstract;
function RecreateWnd(Sender: TObject): Integer; virtual; abstract;
public
constructor Create;
destructor Destroy; override;
@ -67,9 +60,7 @@ type
procedure HandleEvents; virtual; abstract;
procedure WaitMessage; virtual; abstract;
procedure Init; virtual; abstract;
function GetText(Sender: TComponent; var Text: String): Boolean; virtual; abstract;
function IntSendMessage3(LM_Message : Integer; Sender : TObject; data : pointer) : integer; virtual; abstract;
function UpdateHint(Sender: TObject): Integer; virtual; abstract;
function CreateTimer(Interval: integer; TimerFunc: TFNTimerProc) : integer; virtual; abstract;
function DestroyTimer(TimerHandle: integer) : boolean; virtual; abstract;
@ -116,6 +107,9 @@ end.
{
$Log$
Revision 1.27 2002/12/04 20:39:14 mattias
patch from Vincent: clean ups and fixed crash on destroying window
Revision 1.26 2002/12/03 09:11:36 mattias
cleaned up

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

@ -151,7 +151,7 @@ type
procedure ListViewAddItem(TheListView: TObject);
procedure BringFormToFront(Sender: TObject);
function GetText(Sender: TComponent; var Text: String): Boolean; override;
function GetText(Sender: TComponent; var Text: String): Boolean; virtual;
procedure SetText(Child,Data : Pointer);virtual;
procedure SetLabel(Sender : TObject; Data : Pointer); virtual;
procedure SetColor(Sender : TObject);virtual;
@ -174,11 +174,11 @@ type
procedure SetWindowSizeAndPosition(Window: PGtkWindow;
AWinControl: TWinControl);virtual;
procedure RemoveCallbacks(Sender : TObject); override;
function RecreateWnd(Sender: TObject): Integer; override;
public
procedure RemoveCallbacks(Sender : TObject); virtual;
function RecreateWnd(Sender: TObject): Integer; virtual;
// public
// for gtk specific components:
procedure SetCallback(Msg : LongInt; Sender : TObject); override;
procedure SetCallback(Msg : LongInt; Sender : TObject); virtual;
procedure SendPaintMessagesForInternalWidgets(AWinControl: TWinControl);
function LCLtoGtkMessagePending: boolean;virtual;
procedure SendCachedGtkMessages;virtual;
@ -195,7 +195,6 @@ type
procedure SendCachedLCLMessages; override;
procedure AppTerminate; override;
procedure Init; override;
function UpdateHint(Sender: TObject): Integer; override;
function CreateTimer(Interval: integer; TimerFunc: TFNTimerProc) : integer; override;
function DestroyTimer(TimerHandle: integer) : boolean; override;
@ -306,6 +305,9 @@ end.
{ =============================================================================
$Log$
Revision 1.110 2002/12/04 20:39:15 mattias
patch from Vincent: clean ups and fixed crash on destroying window
Revision 1.109 2002/12/03 09:20:53 mattias
cleaned up

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

@ -75,7 +75,9 @@ Type
FStockWhiteBrush: HBRUSH;
Procedure CreateComponent(Sender: TObject);
Function RecreateWnd(Sender: TObject): Integer; Override;
Function RecreateWnd(Sender: TObject): Integer; virtual;
Function GetText(Sender: TComponent; var Data: String): Boolean; virtual;
Procedure SetLabel(Sender: TObject; Data: Pointer);
Procedure AddChild(Parent, Child: HWND);
Procedure ResizeChild(Sender: TObject; Left, Top, Width, Height: Integer);
Procedure AssignSelf(Window: HWnd; Data: Pointer);
@ -104,13 +106,10 @@ Type
Procedure NormalizeIconName(Var IconName: PChar);
Procedure CreateCommonDialog(Sender: TCommonDialog);
Public
{ for win32 specific components }
{ Creates a callback of Lazarus message Msg for Sender }
Procedure SetCallback(Msg: LongInt; Sender: TObject); Override;
Procedure SetCallback(Msg: LongInt; Sender: TObject); virtual;
{ Removes all callbacks for Sender }
Procedure RemoveCallbacks(Sender: TObject); Override;
Procedure RemoveCallbacks(Sender: TObject); virtual;
Public
{ Constructor of the class }
@ -119,20 +118,10 @@ Type
Destructor Destroy; Override;
{ Initialize the API }
Procedure Init; Override;
{ Get the text from control Sender and store it in variable Data }
Function GetText(Sender: TComponent; var Data: String): Boolean; override;
{ Set Label of control Sender to Data }
Procedure SetLabel(Sender: TObject; Data: Pointer);
{ Process Lazarus message LM_Message and return an integer result }
Function IntSendMessage3(LM_Message: Integer; Sender: TObject; Data: Pointer) : Integer; Override;
{ Processes all events (Window messages) in the queue }
Procedure HandleEvents; Override;
{ Wait until a message is received }
Procedure WaitMessage; Override;
{ Abruptly halt execution of the program }
Procedure AppTerminate; Override;
{ Update a hint (tool tip) }
Function UpdateHint(Sender: TObject): Integer; Override;
function CreateTimer(Interval: integer; TimerFunc: TFNTimerProc) : integer; override;
function DestroyTimer(TimerHandle: integer) : boolean; override;
@ -198,6 +187,9 @@ End.
{ =============================================================================
$Log$
Revision 1.23 2002/12/04 20:39:16 mattias
patch from Vincent: clean ups and fixed crash on destroying window
Revision 1.22 2002/12/03 09:15:15 mattias
cleaned up