TForm inheritance and methods

[laggyluk]

Say I have a TForm with some components that I want to use as 'template' for other forms. In lazarus I create new form by New>Inherited item> inherited project component. So I have new form with all the default components and everything is dandy except that I need to call parent methods in couple of places like that:


procedure TmenuPlan.FormCreate(Sender: TObject);
begin
inherited;
end;


procedure TmenuPlan.quitBtnClick(Sender: TObject);
begin
inherited;
end;

It seems redundant, can I somehow skip that step? I mean assign default event methods to existing components unless their behaviour needs to be overriden

[laggyluk]

actually it looks like some methods don't need this and work (buttonOnclick) ok but others are not called at all (formOnActivate) i'm lost

[SilverWarior]

I belive that the reason why you need to call inherited is becouse these methos are actually event handlers which are usually not inherited as they are specific to the form from which they are fired and not the form from which your form inherits.

Anywhay can you show the full code that Lazarus generates for theese inherited forms.

[laggyluk]

Two units and some custom components so it's a lot of code. It's a borderless form with added top bar, close and resize grab button. For some reason it's ok now, no need to call parent methods. Not sure why

[SilverWarior]

Actually I'm only interested in your inherited form class definition and the class definition of the form you are inheriting from that Lazarus made. I don't need to see implementation section.

[laggyluk]

ok
'template' unit:

unit ui_menu_template;


{$mode objfpc}{$H+}


interface


uses
Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, BitmapLabel,
core_ui;


type


{ TmenuTemplate }


TmenuTemplate = class(TForm)
BitmapLabel2: TBitmapLabel;
leftBorder: TBitmapLabel;
quitBtn: TBitmapLabel;
resizeBtn: TBitmapLabel;
rightBorder: TBitmapLabel;
topBar: TBitmapLabel;
procedure FormActivate(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure quitBtnClick(Sender: TObject);
procedure resizeBtnMouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure resizeBtnMouseLeave(Sender: TObject);
procedure resizeBtnMouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
procedure topBarMouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure topBarMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer
);
procedure topBarMouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
private
{ private declarations }
MouseIsDown: boolean;
PX, PY: integer;
public
{ public declarations }
lockWidth:boolean;
lockHeight:boolean;
end;


var
menuTemplate: TmenuTemplate;


implementation


{$R *.lfm}


{ TmenuTemplate }


procedure TmenuTemplate.FormActivate(Sender: TObject);
begin
uiManager.paintFormButtons(self);
uiManager.currentForm:=self;
end;


procedure TmenuTemplate.FormCreate(Sender: TObject);
begin
color:=backgroundColorGrey;
lockWidth:= true;
lockHeight:= false;
end;


procedure TmenuTemplate.quitBtnClick(Sender: TObject);
begin
close;
end;


procedure TmenuTemplate.resizeBtnMouseDown(Sender: TObject;
Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin


end;


procedure TmenuTemplate.resizeBtnMouseLeave(Sender: TObject);
begin
MouseIsDown:=False;
end;


procedure TmenuTemplate.resizeBtnMouseMove(Sender: TObject; Shift: TShiftState;
X, Y: Integer);
var
dx,dy:integer;
begin
if MouseIsDown then begin
if Height+ (Y - PY)<64 then exit;
dx:= (X - PX);
dy:= (Y - PY);
if lockWidth then dx:=0;
if lockHeight then dy:=0;
SetBounds(Left , Top , Width+ dx, Height+ dy);
end;
end;


procedure TmenuTemplate.topBarMouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
if Button = mbLeft then begin
MouseIsDown := True;
PX := X;
PY := Y;
end;
end;


procedure TmenuTemplate.topBarMouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
begin
if MouseIsDown then begin
SetBounds(Left + (X - PX), Top + (Y - PY), Width, Height);
end;
end;


procedure TmenuTemplate.topBarMouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
MouseIsDown:=False;
end;


end.




some child form using it:


unit ui_map;


{$mode objfpc}{$H+}


interface


uses
Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, ExtCtrls,
ui_menu_template, BitmapLabel, core_ui;


type


{ TmenuMap }


TmenuMap = class(TmenuTemplate)
BitmapLabel3: TBitmapLabel;
planetShape: TShape;
windowNameLabel: TBitmapLabel;
procedure FormCreate(Sender: TObject);
private
{ private declarations }
public
{ public declarations }
end;


var
menuMap: TmenuMap;


implementation


{$R *.lfm}


{ TmenuMap }


procedure TmenuMap.FormCreate(Sender: TObject);
begin
inherited;
lockHeight:=true;
lockWidth:=true;
planetSHape.Pen.Color:=fontColorGreen;
planetShape.brush.Color:=backgroundColorGrey;
end;


end.

[SilverWarior]

Sorry for my late reply but I had to do some testing myself about this.
My conclusion is this:
When in Lazarus you create new form which inherits from existing one all Lazarus does is make New form with same components and connects their event handlers to the same methods that are used by parent form and its components. This information is sotred in *.lfm file of you newly created form.
But as soon as you do any action whoch would result in creating new even handler method (doubl clicking on Button for instance) Lazarus conect apropriate event handler to newly created method in new form's unit. So the information about it being inherited is lost.

When I try same thing in Delphi it automatically adds inherited clause on the beggining on new event method whenever creating any event methods on the new inherited form. This preserves the information about form or component being inherited.
I gues you will have to do this manually in Lazarus until it gets corrected by Lazarus development team.

[laggyluk]

ah ok, now it makes sense. thanks for the effort :)

[SilverWarior]

No problem!
While I haven't used this before I was still curious as of how it is being implemented.