Recent

Author Topic: [SOLVED]StringGrid with subcontrol causes Error when started form Lazarus-IDE.  (Read 4297 times)

SunyD

  • Guest
Hi,
i am writing a Grid-Control with sum row. Also StringGrid with another Stringgrid as Childcontrol.
If the grid (owner or Subgrid) has focus it causes error on destroying. Only when i start the programm from Lazarus-IDE. 
Is anyone knows the reason for this error?

Here is the function that causes error:
Code: [Select]
destructor TSStrGridEx.Destroy;
begin
  // if Self or fGrSum has focus next line causes erros, only if it started from Lazarus IDE
  // 1. Error-message: "External:SIGSEGV" 2. Error-message: "Division by Zero"
  // It doesn't help, if I comment out the next lines.
  fGrSum.Free; fGrSum:=nil;

  inherited Destroy;
end;       

And here is complete source with demo-form:
Code: [Select]
{
State:
1. Focus causes error, look at TSStrGridEx.Destroy
}
unit GrSumRowMainForm;

{$mode objfpc}{$H+}

interface

uses
  Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, Grids, StdCtrls;

type
 TSStrGridEx = class(TStringGrid)
 protected
   vGrSumHeight: integer; //Store it as Variable to avoid if Assigned(fGrSum)...
   fGrSum: TStringGrid;
   procedure GrSumResize;
   procedure GrSumUpdateProps;
   function  GetClientRect: TRect; override;
   procedure Resize; override;
   procedure TopLeftChanged; override;
   procedure GrSumTopLeftChanged(Sender: TObject);
 public
   constructor Create(AOwner: TComponent); override;
   destructor Destroy; override;

   property SumGrid: TStringGrid read fGrSum;
 end;

  { TForm1 }

  TForm1 = class(TForm)
    StringGrid1: TStringGrid;
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
  private
    { private declarations }
  public
    myGrid: TSStrGridEx;
    { public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.lfm}

constructor TSStrGridEx.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);

  Options:=Options-[goSmoothScroll];  //No half-scroll of columns
  vGrSumHeight:=DefaultRowHeight+2;

  fGrSum:= TStringGrid.Create(self);
   fGrSum.OnTopLeftChanged:=@GrSumTopLeftChanged;
   fGrSum.Parent:=self;
   GrSumUpdateProps;
end;

destructor TSStrGridEx.Destroy;
begin
  // if Self or fGrSum has focus next line causes erros, only if it started from Lazarus IDE
  // 1. Error-message: "External:SIGSEGV" 2. Error-message: "Division by Zero"
  // It doesn't help, if I comment out the next lines.
  fGrSum.Free; fGrSum:=nil;

  inherited Destroy;
end;

function TSStrGridEx.GetClientRect: TRect;
begin
  Result:=inherited GetClientRect;
  Result.Bottom:=Result.Bottom-vGrSumHeight;
end;

procedure TSStrGridEx.Resize;
begin
  inherited Resize;
  GrSumResize;
end;

procedure TSStrGridEx.TopLeftChanged;
begin
  inherited TopLeftChanged;
  //Called if user scrolling self --> synchronize fGrSum
  if Assigned(fGrSum) then fGrSum.LeftCol:=LeftCol;
end;

procedure TSStrGridEx.GrSumTopLeftChanged(Sender: TObject);
begin
  //Called if user scrolling fGrSum --> synchronize self
  if LeftCol<>fGrSum.LeftCol then LeftCol:=fGrSum.LeftCol;
end;

procedure TSStrGridEx.GrSumResize;
var r: TRect;
begin
  if not Assigned(fGrSum) then exit;
  r:=GetClientRect;
   r.Top:=r.Bottom;
   r.Bottom:=ClientHeight;
  fGrSum.SetBounds(r.Left, r.Top, r.Right, r.Bottom);
end;

procedure TSStrGridEx.GrSumUpdateProps;
begin
  if not Assigned(fGrSum) then exit;
  //Properties
  fGrSum.BorderStyle:=bsNone;
  fGrSum.FixedRows:=0;
  fGrSum.RowCount:=1; //could be variable
  fGrSum.FixedCols:=FixedCols;
  fGrSum.DefaultColWidth:=DefaultColWidth;
  fGrSum.DefaultRowHeight:=DefaultRowHeight;
  fGrSum.ScrollBars:=ssNone;
end;

{ TForm1 }

procedure TForm1.FormCreate(Sender: TObject);
var c: integer;
begin
  myGrid:= TSStrGridEx.Create(self);
   myGrid.Align:=alClient;
   myGrid.Parent:=self;

  //test
  for c:=0 to myGrid.ColCount-1 do begin
    myGrid.Cells[c,0]:=IntToStr(c);
    myGrid.SumGrid.Cells[c,0]:=IntToStr(c);
  end;
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
  myGrid.Free;
end;

end.     

I added complete project-source as 7zip-Attachment.

EDIT: Look at this topic, same error:
http://forum.lazarus.freepascal.org/index.php/topic,26912.0.html
« Last Edit: December 29, 2014, 02:34:25 am by Soner A. »

SunyD

  • Guest
Re: StringGrid with subcontrol causes Error when started form Lazarus-IDE.
« Reply #1 on: December 28, 2014, 06:34:17 pm »
I located the error, if myGrid has focus and I destroy myGrid manually it causes error in TSStrGridEx.Destroy.

Code: [Select]
procedure TForm1.FormDestroy(Sender: TObject);
begin
  //If i comment out next line then TSStrGridEx.Destroy don't cause error,
  //and myGrid destroyed automatic
  //myGrid.Free; myGrid:=nil;
end;   

But why causes focus-state this error?
I create in my projects many controls at runtime and give it in TForm.OnDestroy manually free.

engkin

  • Hero Member
  • *****
  • Posts: 3112
Re: StringGrid with subcontrol causes Error when started form Lazarus-IDE.
« Reply #2 on: December 28, 2014, 08:07:09 pm »
When you create myGrid if you pass an Owner then you do *not* Free/Destroy it. The Owner is going to do that.

1st Edit:
You made that error twice. Once for myGrid, and again in TSStrGridEx.Destroy for fGrSum.

2nd Edit:
Along the chain of destruction:
Code: [Select]
destructor TWinControl.Destroy;
...
  if Parent <> nil then
    RemoveFocus(true);

Code: [Select]
Destructor TComponent.Destroy;
...
  DestroyComponents;
...
« Last Edit: December 28, 2014, 08:25:51 pm by engkin »

SunyD

  • Guest
Re: StringGrid with subcontrol causes Error when started form Lazarus-IDE.
« Reply #3 on: December 28, 2014, 09:44:16 pm »
Thank you engkin.
I can destroy the component (myGrid) in  one Buttons.OnClick-Event and the applications closes without exception.

I commented out this code in LCL:
Code: [Select]
destructor TWinControl.Destroy;
...
  //COMENT OUT: if Parent <> nil then
    //COUMMENT OUT: RemoveFocus(true);
it doesnt' helped.

I modified in LCL:
Code: [Select]
procedure TWinControl.RemoveFocus(Removing : Boolean);
var
  Form: TCustomForm;
begin
  Form := GetParentForm(Self);
  //ORIGINAL: if Form <> nil then Form.DefocusControl(Self, Removing);
 //CHANGED TO:
 if (Form <> nil)and not (csDestroying in Form.ComponentState) then
        Form.DefocusControl(Self, Removing); //soner added
end; 
Also, it doesnt' helped.

This error happens only if i start application from Lazarus IDE and destroy the Grid in forms OnDestroy event.
I runned this example in Delphi 7 without error.

I think this is a design error of LCL or IDE/Debugger.  Maybe located in TComponent's remove-components functions. Because I have the same error, when I create and destroy TDataModule manually. And TDataModule has no focus.

Now first I let them destroy automatic. Maybe one day i can locate the error in LCL. :)

 

TinyPortal © 2005-2018