[lazarus] new forms.pp
Sergio Kessler
sak at perio.unlp.edu.ar
Tue May 18 01:51:05 EDT 1999
Hi, I'm playing a little with forms.pp, I'm using
gtk_signal_connect_object and not gtk_signal_connect.
I've simplyfied a little the code, all is working here
(ok, that part :)
Take a look and tell me what you think (forms.pp attached).
Also there is no need to disconnect signals one by one,
(like in destructor TCustomForm.destroy in forms.pp)
gtk_signal_handlers_destroy( GtkObject *object );
disconnects all signals from a widget.
in compileroptions.pp I've changed this
procedure TForm1.mnuViewCompilerSettingsClicked;
begin
fmCompilerOptions := TfmCompilerOptions.Create( self);
fmCompilerOptions.Caption := 'Compiler Options2';
fmCompilerOptions.Show;
fmCompilerOptions.Destroy; // should be release, not destroy
end;
and commented the proper line in lazarus.pp
in this way I can do View -> Compiler options all times I want,
previously only one time and boom !
Sergio
(3 AM, going to bed...)
--
| Sergio A. Kessler http://perio.unlp.edu.ar/~sergio
-O_O- Keep working at it... you will either succeed, or become an
expert.
{ $Id: forms.pp,v 1.10 1999/05/17 04:16:24 lazarus Exp $}
{
Forms.pp
by Shane Miller
}
Unit Forms;
{$mode objfpc}
Interface
Uses
glib,gdk,gtk,controls,vclglobals,classes,sysutils;
Type
TNotifyEvent = procedure (Sender : TObject);
{CustomForm}
TCustomForm = class(TWinControl)
private
FClientHandle: HWND;
FOnDestroy : TNotifyEvent;
FOnShow: TNotifyEvent;
FOnResize: TNotifyEvent;
FOnFocus: TNotifyEvent;
onDestroyint : Integer;
onShowint : Integer;
onFocusint : Integer;
onResizeint : Integer;
procedure AssignOnDestroy;
procedure AssignOnShow;
procedure AssignOnFocus;
procedure AssignOnResize;
procedure DoDestroy;
procedure DoShow;
procedure DoResize;
procedure DoFocus;
function gtkOnFocus( widget: PGtkWidget): boolean; cdecl;
function gtkOnResize( widget: PGtkWidget): boolean; cdecl;
function gtkOnDestroy( widget: PGtkWidget): boolean; cdecl;
function gtkOnShow( widget: PGtkWidget): boolean; cdecl;
protected
procedure Notification(AComponent: TComponent; Operation: TOperation); override;
public
constructor Create(AOwner: TComponent); override;
destructor destroy; override;
property Caption;
property ClientHandle: HWND read FClientHandle;
{events}
property OnDestroy: TNotifyEvent read FOnDestroy write FOnDestroy;
property OnShow: TNotifyEvent read FOnShow write FOnShow;
property OnResize: TNotifyEvent read FOnResize write FOnResize;
property OnFocus: TNotifyEvent read FOnFocus write FOnFocus;
end;
TForm = class(TCustomForm)
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; Override;
published
property Caption;
end;
TFormClass = class of TForm;
TApplication = class(TComponent)
private
FTerminate : Boolean;
FMainForm : TForm;
FList: TList;
public
constructor Create(AOwner: TComponent); override;
procedure CreateForm(NewForm : TFormClass; var ref);
procedure Initialize;
procedure Run;
procedure Terminate;
protected
end;
TProcedure = procedure;
var
Application : TApplication;
InitProcedure : Pointer;
Implementation
uses guiapi,main;
{------------------------------------------------------------------------------}
function TCustomForm.gtkOnFocus( widget: PGtkWidget) : Boolean; cdecl;
var
Temp : Boolean;
begin
Writeln('Check Focus');
TCustomForm(self).DoFocus;
end;
{-----------------------------------------------------------------------------}
function TCustomForm.gtkOnResize( widget: PGtkWidget) : Boolean;cdecl;
var
Temp : Boolean;
begin
Writeln('Check Resize');
TCustomForm(self).DoResize;
end;
{-----------------------------------------------------------------------------}
function TCustomForm.gtkOnDestroy( widget: PGtkWidget) : Boolean; cdecl;
var
Temp : Boolean;
begin
Writeln('Check Destroy');
TCustomForm(self).DoDestroy;
end;
{------------------------------------------------------------------------------}
function TCustomForm.gtkOnShow( widget: PGtkWidget) : Boolean; cdecl;
var
Temp : Boolean;
begin
Writeln('Check Show');
TCustomForm(self).DoShow;
end;
{------------------------------------------------------------------------------}
procedure TCustomForm.AssignOnDestroy;
begin
Writeln('Assigning OnDestroy');
writeln('DESTROYINT = '+inttostr(onDestroyInt));
onDestroyint := gtk_signal_connect_object( gtk_Object(fcomponent),
'destroy',
gtk_Signal_Func(@gtkOnDestroy),
gtk_Object( Self));
end;
{------------------------------------------------------------------------------}
procedure TCustomForm.AssignOnShow;
begin
Writeln('Assigning OnShow');
writeln('ShowINT = '+inttostr(onShowInt));
onShowint := gtk_signal_connect_object( gtk_Object(fcomponent),
'show',
gtk_Signal_Func(@gtkOnShow),
gtk_Object( Self));
end;
{------------------------------------------------------------------------------}
procedure TCustomForm.AssignOnFocus;
begin
Writeln('Assigning OnFocus');
writeln('FocusINT = '+inttostr(onFocusInt));
onFocusint := gtk_signal_connect_object( gtk_Object(fcomponent),
'set_focus',
gtk_Signal_Func(@gtkOnFocus),
gtk_Object( Self));
end;
{------------------------------------------------------------------------------}
procedure TCustomForm.AssignOnresize;
begin
Writeln('Assigning Onresize');
writeln('ResizeINT = '+inttostr(onResizeInt));
onResizeint := gtk_signal_connect_object( gtk_Object(fcomponent),
'move_resize',
gtk_Signal_Func(@gtkOnresize),
gtk_Object( Self));
end;
{------------------------------------------------------------------------------}
destructor TCustomForm.destroy;
begin
writeln('Destroying signals for TForm');
gtk_signal_handlers_destroy( gtk_object( FComponent));
inherited Destroy;
end;
{------------------------------------------------------------------------------}
procedure TCustomForm.DoDestroy;
Begin
Writeln('+++++++++++++++++++++++++++++++++++IN DO DESTROY+++++++++++++++++++++++++++++');
if Assigned (FOnDestroy) then
FOnDestroy(Self);
end;
{------------------------------------------------------------------------------}
procedure TCustomForm.DoShow;
begin
Writeln('+++++++++++++++++++++++++++++++++++IN DO SHOW+++++++++++++++++++++++++++++');
if Assigned (FOnShow) then
FOnShow(Self);
end;
{------------------------------------------------------------------------------}
procedure TCustomForm.Doresize;
begin
Writeln('+++++++++++++++++++++++++++++++++++IN DO Resize+++++++++++++++++++++++++++++');
if Assigned (FOnResize) then
FOnResize(Self);
end;
{------------------------------------------------------------------------------}
procedure TCustomForm.DoFocus;
begin
Writeln('+++++++++++++++++++++++++++++++++++IN DO FOCUS+++++++++++++++++++++++++++++');
if Assigned (FOnFOCUS) then
FOnFocus(Self);
end;
{------------------------------------------------------------------------------}
constructor TCustomForm.Create(AOwner : TComponent);
begin
inherited Create(AOwner);
If AOwner = nil then
fCompStyle := csMainForm
else
fCompStyle := csForm;
Top := 1;
Left := 1;
Width := 120;
Height := 120;
Writeln('CreateComponent being called for TFORM');
CreateComponent(AOwner);
{ Assign Signals }
AssignOnDestroy;
AssignOnShow;
AssignOnFocus;
AssignOnResize;
end;
{------------------------------------------------------------------------------}
procedure TCustomForm.Notification(AComponent: TComponent; Operation: TOperation);
begin
inherited Notification(AComponent, Operation);
end;
{TFORM}
{------------------------------------------------------------------------------}
constructor TForm.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
end;
{-----------------------------------------------------------------------------}
destructor TForm.Destroy;
begin
inherited Destroy;
end;
{------------------------------------------------------------------------------}
{TAPPLICATON}
constructor TApplication.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
FTerminate := False;
FMainForm := nil;
end;
procedure TApplication.Initialize;
begin
if InitProcedure <> nil then TProcedure(InitProcedure);
end;
procedure TApplication.Run;
begin
if FMainForm <> nil then
FMainForm.Show;
GUIAPI_HandleEvents;
end;
procedure TApplication.Terminate;
begin
FTerminate := True;
GUIAPI_App_Terminate;
end;
procedure TApplication.CreateForm(NewForm : TFormClass; var ref);
begin
try
TForm(ref) := NewForm.Create(Self);
except
raise;
end;
if FMainForm = nil then
begin
TForm(ref) := NewForm.Create(Self);
FMainForm := TForm(ref);
end
else
begin;
if not assigned(FList) then
FList := TList.Create;
TForm(ref) := NewForm.Create(Self);
FList.Add(TForm(ref));
end;
{ The next thing to do at this point will be to establish whether this }
{ is the first form that the TApplication is creating. If it is it sets }
{ this form as the controling form otherwise it just adds the form to a }
{ list stored with the Applications }
end;
{------------------------------------------------------------------------------}
procedure RunStartup;
begin
Application := TApplication.Create(nil);
InitProcedure := nil;
end;
procedure Cleanup;
begin
Application.Free;
Application := nil;
end;
initialization
RunStartup;
finalization
Cleanup;
end.
{
$Log: forms.pp,v $
Revision 1.10 1999/05/17 04:16:24 lazarus
TMemo colors files now.
Still crashes once in a while. Certain files seem to make it crash.
Try open buttons.pp
Revision 1.8 1999/05/15 21:15:04 lazarus
*** empty log message ***
Revision 1.7 1999/05/14 18:44:10 lazarus
*** empty log message ***
Revision 1.6 1999/05/14 14:53:05 michael
+ Removed objpas from uses clause
Revision 1.5 1999/05/07 05:46:50 lazarus
*** empty log message ***
Revision 1.4 1999/05/01 04:33:11 lazarus
*** empty log message ***
Revision 1.3 1999/05/01 03:55:27 lazarus
*** empty log message ***
Revision 1.2 1999/04/18 05:42:08 lazarus
*** empty log message ***
Revision 1.1 1999/04/14 07:31:44 michael
+ Initial implementation
}
More information about the Lazarus
mailing list