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

renamed TinterfaceObject.Init to AppInit and TWinControls can now contain childs in gtk

Browse Source 
git-svn-id: trunk@1389 -
This commit is contained in:
mattias 2002-02-09 01:48:23 +00:00
parent 004a1277d0
commit 9db0976b62
13 changed files with 177 additions and 119 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

5
lcl/controls.pp
View File

@ -563,6 +563,7 @@ type
procedure SetAutoSize(const Value : Boolean); virtual;
procedure BoundsChanged; dynamic;
procedure DoConstraintsChange(Sender : TObject); virtual;
procedure SendMoveSizeMessages(SizeChanged, PosChanged: boolean); virtual;
procedure Changed;
procedure WMLButtonDown(Var Message: TLMLButtonDown); message LM_LBUTTONDOWN;
procedure WMRButtonDown(Var Message: TLMRButtonDown); message LM_RBUTTONDOWN;
@ -863,6 +864,7 @@ type
function IsControlMouseMsg(var TheMessage : TLMMouse): Boolean;
procedure SetZOrderPosition(Position: Integer); override;
procedure SetZOrder(Topmost: Boolean); override;
procedure SendMoveSizeMessages(SizeChanged, PosChanged: boolean); override;
property BorderWidth : TBorderWidth read FBorderWidth write SetBorderWidth default 0;
property DefWndProc: Pointer read FDefWndProc write FDefWndPRoc;
@ -1447,6 +1449,9 @@ end.
{ =============================================================================
$Log$
Revision 1.94 2002/02/09 01:48:23 mattias
renamed TinterfaceObject.Init to AppInit and TWinControls can now contain childs in gtk
Revision 1.93 2002/12/04 20:39:14 mattias
patch from Vincent: clean ups and fixed crash on destroying window

5
lcl/include/application.inc
View File

@ -202,7 +202,7 @@ begin
writeln('ERROR: ',NoInterfaceObject);
raise Exception.Create(NoInterfaceObject);
end;
InterfaceObject.Init;
InterfaceObject.AppInit;
CNSendMessage(LM_SCREENINIT, nil, @ScreenInfo);
if LazarusResources.Find('MAINICON')<>nil then begin
if FIcon=nil then begin
@ -834,6 +834,9 @@ end;
{ =============================================================================
$Log$
Revision 1.41 2002/02/09 01:48:23 mattias
renamed TinterfaceObject.Init to AppInit and TWinControls can now contain childs in gtk
Revision 1.40 2002/11/29 15:14:47 mattias
replaced many invalidates by invalidaterect

56
lcl/include/control.inc
View File

@ -118,9 +118,8 @@ End;
}
{------------------------------------------------------------------------------}
procedure TControl.ChangeBounds(ALeft, ATop, AWidth, AHeight : integer);
var SizeChanged, PosChanged : boolean;
SizeMsg : TLMSize;
MoveMsg : TLMMove;
var
SizeChanged, PosChanged : boolean;
begin
DoConstrainedResize(AWidth, AHeight);
SizeChanged:= (FWidth <> AWidth) or (FHeight <> AHeight);
@ -153,38 +152,7 @@ begin
RequestAlign;
if (not (csLoading in ComponentState)) then begin
Resize;
Perform(LM_WindowposChanged, 0, 0);
{ TODO : Replace this with LCL functions eventually.
Right now we have to call these messages as some
descendents incorrectly depend on it, so force it
down their throat }
if SizeChanged then begin
with SizeMsg do begin
Msg:= LM_SIZE;
SizeType:= 6; // force realign
Width:= FWidth;
Height:= FHeight;
{$IFDEF CHECK_POSITION}
writeln(' [TControl.ChangeBounds] ',Name,':',ClassName,' SizeMsg Width=',Width,' Height=',Height);
{$ENDIF}
end;
WindowProc(TLMessage(SizeMsg));
end;
if PosChanged then begin
with MoveMsg do begin
Msg:= LM_MOVE;
MoveType:= 1;
XPos:= FLeft;
YPos:= FTop;
{$IFDEF CHECK_POSITION}
writeln(' [TControl.ChangeBounds] ',Name,':',ClassName,' MoveMsg XPos=',XPos,' YPos=',YPos);
{$ENDIF}
end;
WindowProc(TLMessage(MoveMsg));
end;
SendMoveSizeMessages(SizeChanged,PosChanged);
end;
If Parent <> nil then
Parent.DoAutoSize;
@ -463,10 +431,17 @@ begin
AdjustSize;
end;
{------------------------------------------------------------------------------}
{ TControl.DragCanceled
}
{------------------------------------------------------------------------------}
{------------------------------------------------------------------------------
procedure TControl.SendMoveSizeMessages(SizeChanged, PosChanged: boolean);
------------------------------------------------------------------------------}
procedure TControl.SendMoveSizeMessages(SizeChanged, PosChanged: boolean);
begin
end;
{------------------------------------------------------------------------------
TControl.DragCanceled
------------------------------------------------------------------------------}
procedure TControl.DragCanceled;
begin
end;
@ -2082,6 +2057,9 @@ end;
{ =============================================================================
$Log$
Revision 1.108 2002/02/09 01:48:23 mattias
renamed TinterfaceObject.Init to AppInit and TWinControls can now contain childs in gtk
Revision 1.107 2002/12/04 20:39:14 mattias
patch from Vincent: clean ups and fixed crash on destroying window

8
lcl/include/interfacebase.inc
View File

@ -1072,6 +1072,11 @@ begin
Result := False;
end;
procedure TInterfaceBase.PassCmdLineOptions;
begin
end;
Function TInterfaceBase.PromptUser(const DialogCaption, DialogMessage : String;
DialogType : longint; Buttons : PLongint;
ButtonCount, DefaultIndex, EscapeResult : Longint) : Longint;
@ -1506,6 +1511,9 @@ end;
{ =============================================================================
$Log$
Revision 1.71 2002/02/09 01:48:23 mattias
renamed TinterfaceObject.Init to AppInit and TWinControls can now contain childs in gtk
Revision 1.70 2002/12/05 22:16:29 mattias
double byte char font started

45
lcl/include/wincontrol.inc
View File

@ -672,6 +672,48 @@ begin
end;
end;
procedure TWinControl.SendMoveSizeMessages(SizeChanged, PosChanged: boolean);
var
SizeMsg : TLMSize;
MoveMsg : TLMMove;
begin
if (not HandleAllocated)
or ((not SizeChanged) and (not PosChanged)) then exit;
{ TODO : Replace this with LCL functions eventually.
Right now we have to call these messages as some
descendents incorrectly depend on it, so force it
down their throat }
Perform(LM_WindowposChanged, 0, 0);
if SizeChanged then begin
with SizeMsg do begin
Msg:= LM_SIZE;
SizeType:= 6; // force realign
Width:= FWidth;
Height:= FHeight;
{$IFDEF CHECK_POSITION}
writeln(' [TControl.ChangeBounds] ',Name,':',ClassName,' SizeMsg Width=',Width,' Height=',Height);
{$ENDIF}
end;
WindowProc(TLMessage(SizeMsg));
end;
if PosChanged then begin
with MoveMsg do begin
Msg:= LM_MOVE;
MoveType:= 1;
XPos:= FLeft;
YPos:= FTop;
{$IFDEF CHECK_POSITION}
writeln(' [TControl.ChangeBounds] ',Name,':',ClassName,' MoveMsg XPos=',XPos,' YPos=',YPos);
{$ENDIF}
end;
WindowProc(TLMessage(MoveMsg));
end;
end;
{------------------------------------------------------------------------------}
{ TWinControl UpdateShowing }
{------------------------------------------------------------------------------}
@ -2483,6 +2525,9 @@ end;
{ =============================================================================
$Log$
Revision 1.107 2002/02/09 01:48:23 mattias
renamed TinterfaceObject.Init to AppInit and TWinControls can now contain childs in gtk
Revision 1.106 2002/12/04 20:39:15 mattias
patch from Vincent: clean ups and fixed crash on destroying window

9
lcl/interfacebase.pp
View File

@ -53,13 +53,15 @@ type
Currently maintained by Marc Weustink <weus@quicknet.nl>
}
TInterfaceBase = Class(TObject)
protected
procedure PassCmdLineOptions; virtual;
public
constructor Create;
destructor Destroy; override;
procedure AppTerminate; virtual; abstract;
procedure HandleEvents; virtual; abstract;
procedure WaitMessage; virtual; abstract;
procedure Init; virtual; abstract;
procedure AppInit; virtual; abstract;
procedure AppTerminate; virtual; abstract;
function IntSendMessage3(LM_Message : Integer; Sender : TObject; data : pointer) : integer; virtual; abstract;
function CreateTimer(Interval: integer; TimerFunc: TFNTimerProc) : integer; virtual; abstract;
@ -107,6 +109,9 @@ end.
{
$Log$
Revision 1.28 2002/02/09 01:48:23 mattias
renamed TinterfaceObject.Init to AppInit and TWinControls can now contain childs in gtk
Revision 1.27 2002/12/04 20:39:14 mattias
patch from Vincent: clean ups and fixed crash on destroying window

44
lcl/interfaces/gnome/gnomeint.pp
View File

@ -47,6 +47,7 @@ uses
type
TGnomeObject = class(TGtkObject)
private
procedure PassCmdLineOptions; override;
Function PromptUserWidget(const DialogCaption, DialogMessage : String;
DialogType : longint; Buttons : PLongint; ButtonCount, DefaultIndex : Longint) : Pointer;
protected
@ -54,7 +55,6 @@ type
procedure FreeStockItems; override;
procedure CreateComponent(Sender : TObject); override;
procedure Init; override;
public
{$I gnomewinapih.inc}
end;
@ -82,6 +82,12 @@ uses
KeyMap, Calendar, Arrow, Spin, CommCtrl, ExtCtrls, Dialogs, FileCtrl,
LResources, Math, gtkglobals, gtkproc, LCLStrConsts;
procedure TGnomeObject.PassCmdLineOptions;
begin
// call init and pass cmd line args
gnome_init(PChar(Application.Title), '0.8.5a', argc, argv);
end;
Procedure TGnomeObject.InitStockItems;
begin
Inherited InitStockItems;
@ -157,39 +163,6 @@ begin
Dispose(LAZBTNIGNORE);
end;
procedure TGnomeObject.Init;
begin
// initialize app level gtk engine
gtk_set_locale ();
// call init and pass cmd line args
gnome_init(PChar(Application.Title), '0.8.5a', argc, argv);
If Assigned(Screen) then
FillScreenFonts(Screen.Fonts);
// read gtk rc file
ParseRCFile;
// Initialize Stringlist for holding styles
Styles := TStringlist.Create;
gtk_key_snooper_install(@GTKKeySnooper, @FKeyStateList);
// Init tooltips
FGTKToolTips := gtk_tooltips_new;
gtk_object_ref(PGTKObject(FGTKToolTips));
gtk_toolTips_Enable(FGTKToolTips);
// Init stock objects;
InitStockItems;
// clipboard
ClipboardTypeAtoms[ctPrimarySelection]:=GDK_SELECTION_PRIMARY;
ClipboardTypeAtoms[ctSecondarySelection]:=GDK_SELECTION_SECONDARY;
ClipboardTypeAtoms[ctClipboard]:=gdk_atom_intern('CLIPBOARD',0);
end;
procedure TGnomeObject.CreateComponent(Sender : TObject);
var
//Caption : AnsiString;
@ -273,6 +246,9 @@ end.
{
$Log$
Revision 1.15 2002/02/09 01:48:23 mattias
renamed TinterfaceObject.Init to AppInit and TWinControls can now contain childs in gtk
Revision 1.14 2002/11/03 22:40:00 lazarus
MG: fixed ControlAtPos

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

@ -89,6 +89,7 @@ type
procedure InitStockItems; virtual;
procedure FreeStockItems; virtual;
procedure PassCmdLineOptions; override;
Procedure FinishComponentCreate(Sender : TObject; Handle : Pointer;
SetupProps : Boolean); Virtual;
@ -194,7 +195,7 @@ type
procedure WaitMessage; override;
procedure SendCachedLCLMessages; override;
procedure AppTerminate; override;
procedure Init; override;
procedure AppInit; override;
function CreateTimer(Interval: integer; TimerFunc: TFNTimerProc) : integer; override;
function DestroyTimer(TimerHandle: integer) : boolean; override;
@ -305,6 +306,9 @@ end.
{ =============================================================================
$Log$
Revision 1.111 2002/02/09 01:48:23 mattias
renamed TinterfaceObject.Init to AppInit and TWinControls can now contain childs in gtk
Revision 1.110 2002/12/04 20:39:15 mattias
patch from Vincent: clean ups and fixed crash on destroying window

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

@ -32,11 +32,15 @@
constructor TGtkObject.Create;
begin
inherited Create;
FKeyStateList := TList.Create;
// DCs, GDIObjects
FDeviceContexts := TDynHashArray.Create(-1);
FDeviceContexts.Options:=FDeviceContexts.Options+[dhaoCacheContains];
FGDIObjects := TDynHashArray.Create(-1);
FGDIObjects.Options:=FGDIObjects.Options+[dhaoCacheContains];
FDefaultFont:= nil;
// messages
FMessageQueue := TLazQueue.Create;
FPaintMessages := TDynHashArray.Create(-1);
FPaintMessages.OwnerHashFunction := @HashPaintMessage;
@ -47,10 +51,51 @@ begin
FWidgetsResized := TDynHashArray.Create(-1);
FWidgetsResized.Options:=FWidgetsResized.Options+[dhaoCacheContains];
FFixWidgetsResized := TDynHashArray.Create(-1);
FTimerData := TList.Create;
FDefaultFont:= nil;
FKeyStateList := TList.Create;
FRCFilename := ChangeFileExt(ParamStr(0),'.gtkrc');
FRCFileParsed := false;
// initialize app level gtk engine
gtk_set_locale ();
// call init and pass cmd line args
PassCmdLineOptions;
// read gtk rc file
ParseRCFile;
// Initialize Stringlist for holding styles
Styles := TStringlist.Create;
gtk_key_snooper_install(@GTKKeySnooper, @FKeyStateList);
// Init tooltips
FGTKToolTips := gtk_tooltips_new;
gtk_object_ref(PGTKObject(FGTKToolTips));
gtk_toolTips_Enable(FGTKToolTips);
// Init stock objects;
InitStockItems;
// clipboard
ClipboardTypeAtoms[ctPrimarySelection]:=GDK_SELECTION_PRIMARY;
ClipboardTypeAtoms[ctSecondarySelection]:=GDK_SELECTION_SECONDARY;
ClipboardTypeAtoms[ctClipboard]:=gdk_atom_intern('CLIPBOARD',0);
end;
{------------------------------------------------------------------------------
Method: Tgtkobject.PassCmdLineOptions
Params: None
Returns: Nothing
Passes command line options to the gtk engine
------------------------------------------------------------------------------}
procedure Tgtkobject.PassCmdLineOptions;
begin
gtk_init (@argc, @argv);
end;
{------------------------------------------------------------------------------
@ -831,43 +876,18 @@ begin
end;
{------------------------------------------------------------------------------
Method: TGtkObject.Init
Method: TGtkObject.AppInit
Params: None
Returns: Nothing
*Note: Initialite GTK engine
*Note: Initialize GTK engine
(is called by TApplication.Initialize which is typically after all
finalization sections)
------------------------------------------------------------------------------}
procedure TGtkObject.Init;
procedure TGtkObject.AppInit;
begin
// initialize app level gtk engine
gtk_set_locale ();
// call init and pass cmd line args
gtk_init (@argc, @argv);
If Assigned(Screen) then
FillScreenFonts(Screen.Fonts);
// read gtk rc file
ParseRCFile;
// Initialize Stringlist for holding styles
Styles := TStringlist.Create;
gtk_key_snooper_install(@GTKKeySnooper, @FKeyStateList);
// Init tooltips
FGTKToolTips := gtk_tooltips_new;
gtk_object_ref(PGTKObject(FGTKToolTips));
gtk_toolTips_Enable(FGTKToolTips);
// Init stock objects;
InitStockItems;
// clipboard
ClipboardTypeAtoms[ctPrimarySelection]:=GDK_SELECTION_PRIMARY;
ClipboardTypeAtoms[ctSecondarySelection]:=GDK_SELECTION_SECONDARY;
ClipboardTypeAtoms[ctClipboard]:=gdk_atom_intern('CLIPBOARD',0);
end;
@ -4009,10 +4029,6 @@ end;
Tells GTK Engine to create a widget
------------------------------------------------------------------------------}
procedure TgtkObject.CreateComponent(Sender : TObject);
//unused:type
//unused: Tpixdata = Array[1..20] of String;
var
Caption : ansistring; // the caption of "Sender"
StrTemp : PChar; // same as "caption" but as PChar
@ -6701,6 +6717,9 @@ end;
{ =============================================================================
$Log$
Revision 1.298 2002/02/09 01:48:23 mattias
renamed TinterfaceObject.Init to AppInit and TWinControls can now contain childs in gtk
Revision 1.297 2002/12/12 17:47:46 mattias
new constants for compatibility

8
lcl/interfaces/gtk/gtkproc.inc
View File

@ -1190,7 +1190,10 @@ begin
else If GTKWidgetIsA(Parent, GTK_Layout_Get_Type) then
gtk_Layout_Put(PGtkLayout(Parent), Child, Left, Top)
else
WriteLn('[FixedPutControl] WARNING: Invalid Fixed Widget');
WriteLn('[FixedPutControl] WARNING: Invalid Fixed Widget.',
' Parent=',HexStr(Cardinal(Parent),8),
' Child=',HexStr(Cardinal(Child),8)
);
end;
{------------------------------------------------------------------------------
@ -3945,6 +3948,9 @@ end;
{ =============================================================================
$Log$
Revision 1.152 2002/02/09 01:48:23 mattias
renamed TinterfaceObject.Init to AppInit and TWinControls can now contain childs in gtk
Revision 1.151 2002/12/05 22:16:32 mattias
double byte char font started

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

@ -88,7 +88,7 @@ type
PGTKAPIWidgetClient = ^TGTKAPIWidgetClient;
TGTKAPIWidgetClient = record
// ! the Widget must be the first attribute of the record !
Widget: TGTKWidget;
Widget: TGTKFixed;
OtherWindow: PGDKWindow;
Caret: TCaretInfo;
end;
@ -314,7 +314,7 @@ const
);
begin
if (TheType = 0)
then TheType := gtk_type_unique(gtk_widget_get_type, @Info);
then TheType := gtk_type_unique(gtk_fixed_get_type, @Info);
Result := TheType;
end;
@ -732,6 +732,9 @@ end.
{ =============================================================================
$Log$
Revision 1.36 2002/02/09 01:48:23 mattias
renamed TinterfaceObject.Init to AppInit and TWinControls can now contain childs in gtk
Revision 1.35 2002/10/21 22:12:49 lazarus
MG: fixed frmactivate

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

@ -117,7 +117,7 @@ Type
{ Destructor of the class }
Destructor Destroy; Override;
{ Initialize the API }
Procedure Init; Override;
Procedure AppInit; Override;
Function IntSendMessage3(LM_Message: Integer; Sender: TObject; Data: Pointer) : Integer; Override;
Procedure HandleEvents; Override;
Procedure WaitMessage; Override;
@ -187,6 +187,9 @@ End.
{ =============================================================================
$Log$
Revision 1.24 2002/02/09 01:48:23 mattias
renamed TinterfaceObject.Init to AppInit and TWinControls can now contain childs in gtk
Revision 1.23 2002/12/04 20:39:16 mattias
patch from Vincent: clean ups and fixed crash on destroying window

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

@ -84,13 +84,13 @@ Begin
End;
{------------------------------------------------------------------------------
Method: TWin32Object.Init
Method: TWin32Object.AppInit
Params: None
Returns: Nothing
Initialize Windows
------------------------------------------------------------------------------}
Procedure TWin32Object.Init;
Procedure TWin32Object.AppInit;
Var
LogBrush: TLOGBRUSH;
Begin
@ -2575,6 +2575,9 @@ End;
{
$Log$
Revision 1.32 2002/02/09 01:48:23 mattias
renamed TinterfaceObject.Init to AppInit and TWinControls can now contain childs in gtk
Revision 1.31 2002/12/13 10:10:44 mattias
fixed illegal type cast