Free components, access violation in module ntdll.dll

Here is the recursive destroy components routine I build.

I did try TEyda.Destroy also.

{----------------------------------------------------------------------}
PROCEDURE Destroy_Components (TComp : TComponent);
 
  PROCEDURE Destroy_Component (TEyda : TComponent);
    VAR
      I_Tmp   : INTEGER;
  BEGIN
    IF (TEyda.ComponentCount > 0) THEN
      FOR I_Tmp := (TEyda.ComponentCount - 1) DOWNTO 0 DO
        Destroy_Component (TEyda.Components[I_Tmp])
    ELSE
    BEGIN
      TEyda.Free;
    END;
  END;
 
BEGIN
  IF (TComp.ComponentCount > 0) THEN
    Destory_Component (TComp);
END;
{----------------------------------------------------------------------}

Select allOpen in new window

Are verifying the Button like this?

if Button <> nil the Button.Free;

Could you please post your code (the recursive one)?

can you post how you are calling this function, please?

Have you tried using FreeAndNil(yourbutton);?
Also, I just have to ask.  Why are you repeatedly using this one form and doing allo of these manipulations when you could have multiple forms that you create with all of the components already on them?  Seems to me that it would be a whole lot less effort and trouble, to say nothing of avoiding issues like this.

I don't know why you make it so complicated with a recursive procedure (always dangerous).
The following single line of code worked fine with me:

procedure TForm1.FormDblClick(Sender: TObject);
begin
//Destroy_Components (Form1);
while ComponentCount>0 do Components[0].Free;
end;

Select allOpen in new window

There are some problems in your code :
If your TComp in Destroy_Components has no components , it is not freed like when it has. I don't see why you would do so as normal way of destroying a tree is destroying all child of an element before destroying the element itself meaning both are done, not one of them.

So the code would be :

PROCEDURE Destroy_Components (TComp : TComponent);
VAR
      I_Tmp   : INTEGER;
begin
 FOR I_Tmp := (TComp.ComponentCount - 1) DOWNTO 0 DO
        Destroy_Components (TComp .Components[I_Tmp]);
 TComp .Free;
end;

=> No need for 2 procedures.

Besides, I'm pretty sure that all this is done automatically by the destruction of the form. If, when you create your components, you specify that Owner = your form, or a component on your form, then by cascading destruction of the form and components owned by it everything would be free.

To test it, add an :
Inc(ColorButtonsCount);
in the constructor

and
Dec(ColorButtonCount);
in the destructor.

Create your form, and display somewhere the ColorButtonCount
then destroy it, and again display somewhere the ColorButtonCount . It should be back to 0 (except if you had some other forms created with your ColorButtons)

I would o something like this:

procedure DestroyColorButtons (Form: TForm);
var
i: integer;
begin
  if (Form.ComponentCount > 0) then
    begin
      for i := 0 to Form.ComponentCount-1 do
        begin  
        if (Form.Components[i] is TColorButton) then
          begin
          if  (Form.Components[i] as TColorButton) <> nil
            (Form.Components[i] as TColorButton).Free;      
          end;      
        end;
      end;
end;

//example
DestroyColorButtons(Form1);

Any test of the like is useless :

var
i: integer;
begin
  if (Form.ComponentCount > 0) then
    begin
      for i := 0 to Form.ComponentCount-1 do
 
As if ComponentCount is 0, then ComponentCount-1 =-1 which is <0 so the loop will not execute once (because i has been declared as integer, so signed, which would be different with Cardinal, unsigned)

Then , looping from 0 to ComponentCount-1 while destroying some of them along the way is extremly dangerous.

And to finish, in :
if  (Form.Components[i] as TColorButton) <> nil Then (Form.Components[i] as TColorButton).Free;

The test is useless as Free checks for nil already before calling Destroy.

And I forgot,
if  (Form.Components[i] as TColorButton)
=> will most likely raise an exception, when one component will not be TColorButon.
You might wanted to write
if (Form.Components[i] Is TColorButton)

Basically, your exception occured because you are in this typical case :

you destroyed an object, but it is still referenced somewhere with it's pointer still pointing to the old memory just freed, and once there is access to this old reference , Assigned(Ref) is TRUE (because pointer<>nil) but memory is INVALID

Say :
B:=TButton.Create(MyForm);
B2:=B;
FreeAndNil(B);
FreeAndNil(B); // Ok
FreeAndNil(B2); // Raise an exception

Imagine what could happen if you try destroying yourself bunch of components while Delphi automatic components destruction is just doing the same. I'm sure that it could be fixed, but since there is no point doing so, just let it be => no need for handmade destruction.

To begin with, my recursive destroy_components routine works fine. If I use straight the class TButton instead of TColorButton, everything works allright!

Whe destroying tree, you have to go to the lowest branch and cleaning up from there and that is what I do with the routine I posted.

The problem lies in the Destructor TColorButton.Destroy. And as I did mention, only the last button raise this error.

I can post this component (TColorButton) if you like.

Ok.. I will.

But to explain the recursive routine, the line, if components.count > 0 checks out if component is the last or not. If it has count > 0 then the recursive routine sink deeper in the tree and stops only when it reech the lowest one, then back to nest branch etc. And by counting DOWNTO it 0, it will not effect the counter as it would do in some of above routines.

And finally, I did use initally the original free (Panel1.free) and got the same error! The recursive routine was build to debug and to get some information why I got this error.

>> But to explain the recursive routine, the line, if components.count > 0 checks out if component is the last or not.
>> If it has count > 0 then the recursive routine sink deeper in the tree and stops only when it reech the lowest one, then back to nest branch etc.
Nope, this is not what your code is doing. Each Component has a ComponentCount representing the number of Childs, not the total ComponentCount of the form

>> And by counting DOWNTO it 0, it will not effect the counter as it would do in some of above routines.
Yes, I've seen that

It is likely that your problem occurs because some resource or object is free twice. Once by you, and once by the system after you have finished destroying. Which is why you have your error seemingly on the last one.

>>Nope, this is not what your code is doing. Each Component has a ComponentCount representing the number of Childs, not the total ComponentCount of the form

Yes I know, that's why I use recursive routine, whenever the routine finds a comp wtih a child, one or more, it will recall itself, again, and again, and again, in the end, adds upp all of the comps owned by the parent object I'm destroying.

I have build a small apps using this comp TColorButton and Panel1.free works fine there.. so, I have to digg deeper in my own source!

unit UTestButtons;
 
interface
 
uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, ExtCtrls, ColorButton;
 
type
  TForm1 = class(TForm)
    Button1: TButton;
    Button2: TButton;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
    Bt_1,
    Bt_2,
    Bt_3,
    Bt_4     : TColorButton;
    Panel1   : TPanel;
    PROCEDURE Create_Button (Bt_Button : TColorButton; B_Nr : BYTE);
  end;
 
var
  Form1: TForm1;
 
implementation
 
{$R *.DFM}
PROCEDURE TForm1.Create_Button (Bt_Button : TColorButton; B_Nr : BYTE);
BEGIN
  Bt_Button            := TColorButton.Create (Panel1);
  WITH Bt_Button DO
  BEGIN
    Parent     := Panel1;
    Name       := 'Button_'+Chr(B_Nr+48);
    BackColor  := clSilver;
    ForeColor  := clBlack;
    HoverColor := clYellow;
    Left       := 40 + 100 * (B_Nr - 1);
    Top        := 100;
  END;
END;
 
procedure TForm1.Button1Click(Sender: TObject);
begin
  IF (Assigned (Panel1)) THEN
    Exit;
 
  Panel1 := TPanel.Create (Form1);
  WITH Panel1 DO
  BEGIN
    Parent                  := Form1;
    Panel1.Top              := 5;
    Panel1.Left             := 5;
    Panel1.Width            := 450;
    Panel1.Height           := 190;
  END;
 
  Create_Button (Bt_1, 1);
  Create_Button (Bt_2, 2);
  Create_Button (Bt_3, 3);
  Create_Button (Bt_4, 4);
end;
 
procedure TForm1.Button2Click(Sender: TObject);
begin
  Panel1.Free;
  Panel1 := NIL;
end;
 
end.

Select allOpen in new window

And the ColorButton unit

{$D+,L+}
UNIT ColorButton;
 
{
Article:
 
TColorButton - button with Color properties
 
http://delphi.about.com/library/weekly/aa061104a.htm
 
Full source code of the TColorButton Delphi component,
an extension to the standard TButton control,
with font color, background color and mouse over color properties.
 
}
 
interface
 
uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, StdCtrls, Buttons, ExtCtrls;
 
type
  Typ_StdCall      = PROCEDURE ;
  TColorButton = class(TButton)
  private
    FBackBeforeHoverColor: TColor;
  private
    FCanvas  :  TCanvas;
    IsFocused: Boolean;
    FBackColor: TColor;
    FForeColor: TColor;
    FHoverColor: TColor;
    PROCEDURE SetBackColor(const Value: TColor);
    PROCEDURE SetForeColor(const Value: TColor);
    PROCEDURE SetHoverColor(const Value: TColor);
 
    property BackBeforeHoverColor : TColor read FBackBeforeHoverColor write FBackBeforeHoverColor;
  protected
    PROCEDURE CreateParams(var Params: TCreateParams); override;
    PROCEDURE WndProc(var Message : TMessage); override;
 
    PROCEDURE SetButtonStyle(Value: Boolean); override;
    PROCEDURE DrawButton(Rect: TRect; State: UINT);
 
    PROCEDURE CMEnabledChanged(var Message: TMessage); message CM_ENABLEDCHANGED;
    PROCEDURE CMFontChanged(var Message: TMessage); message CM_FONTCHANGED;
    PROCEDURE CNMeasureItem(var Message: TWMMeasureItem); message CN_MEASUREITEM;
    PROCEDURE CNDrawItem(var Message: TWMDrawItem); message CN_DRAWITEM;
  PUBLIC
    OrgColor      : TColor;
    Proc_OnClick  : Typ_StdCall;
    CONSTRUCTOR Create(AOwner: TComponent); override;
    DESTRUCTOR Destroy; override;
 
  published
    PROCEDURE ButtonClick(SENDer: TObject) ;
    property BackColor: TColor read FBackColor write SetBackColor default clBtnFace;
    property ForeColor: TColor read FForeColor write SetForeColor default clBtnText;
    property HoverColor: TColor read FHoverColor write SetHoverColor default clBtnFace;
  END;
 
PROCEDURE Register;
 
implementation
 
//****************************************************************************
  CONSTRUCTOR TColorButton.Create(AOwner: TComponent);
  BEGIN
    INHERITED Create(AOwner);
    FCanvas := TCanvas.Create;
    BackColor := clBtnFace;
    ForeColor := clBtnText;
    HoverColor := clBtnFace;
  END; (*Create*)
//****************************************************************************
  DESTRUCTOR TColorButton.Destroy;
  BEGIN
    IF Assigned (FCanvas) THEN
      FCanvas.Free;
    INHERITED Destroy;
  END; (*Destroy*)
//****************************************************************************
  PROCEDURE TColorButton.ButtonClick(SENDer: TObject) ;
  BEGIN
    IF (@Proc_OnClick <> NIL) THEN
      Proc_OnClick;
  END;
//****************************************************************************
  PROCEDURE TColorButton.WndProc(var Message : TMessage);
  BEGIN
    IF (Message.Msg = CM_MOUSELEAVE) THEN
    BEGIN
      // Debug ('WindProc CM_MOUSELEAVE');
      BackColor := BackBeforeHoverColor;
      invalidate;
    END
    ELSE IF (Message.Msg = CM_MOUSEENTER) THEN
    BEGIN
      // Debug ('WindProc  CM_MOUSEENTER');
      BackBeforeHoverColor := BackColor;
      BackColor := HoverColor;
      invalidate;
    END;
 
    INHERITED;
 
  //  t2 := Time;
  //  Debug ('WndProc.. '+Form ('##.##########', (t2 - t1)));
 
  END; (*WndProc*)
  //****************************************************************************
  PROCEDURE TColorButton.CreateParams(var Params: TCreateParams);
  BEGIN
    INHERITED CreateParams(Params);
    with Params do
      Style := Style or BS_OWNERDRAW;
  END; (*CreateParams*)
  //****************************************************************************
  PROCEDURE TColorButton.SetButtonStyle(Value: Boolean);
  BEGIN
    IF Value <> IsFocused THEN
    BEGIN
      IsFocused := Value;
      Invalidate;
    END;
  END; (*SetButtonStyle*)
  //****************************************************************************
  PROCEDURE TColorButton.CNMeasureItem(var Message: TWMMeasureItem);
  BEGIN
    // Debug ('CnMeasure..');
    with Message.MeasureItemStruct^ do
    BEGIN
      itemWidth  := Width;
      itemHeight := Height;
    END;
  END; (*CNMeasureItem*)
  //****************************************************************************
  PROCEDURE TColorButton.CNDrawItem(var Message: TWMDrawItem);
    VAR
      SaveIndex: Integer;
  BEGIN
    WITH Message.DrawItemStruct^ DO
    BEGIN
      SaveIndex := SaveDC(hDC);
      FCanvas.Lock;
      try
        FCanvas.Handle := hDC;
        FCanvas.Font := Font;
        FCanvas.Brush := Brush;
        DrawButton(rcItem, itemState);
      finally
        FCanvas.Handle := 0;
        FCanvas.Unlock; 
        RestoreDC(hDC, SaveIndex); 
      END;
    END;
    Message.Result := 1;
  END; (*CNDrawItem*)
  //****************************************************************************
  PROCEDURE TColorButton.CMEnabledChanged(var Message: TMessage);
  BEGIN
    // Debug ('CMEnabled..');
    INHERITED;
    Invalidate;
  END; (*CMEnabledChanged*)
  //****************************************************************************
  PROCEDURE TColorButton.CMFontChanged(var Message: TMessage);
  BEGIN
    // Debug ('CMFontCh..');
    INHERITED;
    Invalidate;
  END; (*CMFontChanged*)
  //****************************************************************************
  PROCEDURE TColorButton.SetBackColor(const Value: TColor);
  BEGIN
    // Debug ('SetBackCol..');
    IF (FBackColor <> Value)  THEN
    BEGIN
      FBackColor:= Value;
      Invalidate;
    END;
  END; (*SetButtonColor*)
  //****************************************************************************
  PROCEDURE TColorButton.SetForeColor(const Value: TColor);
  BEGIN
    // Debug ('SetForeCol..');
    IF FForeColor <> Value THEN
    BEGIN
      FForeColor:= Value;
      Invalidate;
    END;
  END; (*SetForeColor*)
  //****************************************************************************
  PROCEDURE TColorButton.SetHoverColor(const Value: TColor);
  BEGIN
    // Debug ('Set Hov..');
    IF FHoverColor <> Value THEN
    BEGIN
      FHoverColor:= Value;
      Invalidate;
    END;
  END; (*SetHoverColor*)
  //****************************************************************************
  PROCEDURE TColorButton.DrawButton(Rect: TRect; State: UINT);
    var
      Flags, OldMode: Longint;
      IsDown, IsDefault, IsDisabled: Boolean;
      OldColor: TColor;
      OrgRect: TRect;
  BEGIN
    // Debug ('DrawButt..');
  //  t1 := Time;
    OrgRect := Rect;
    Flags := DFCS_BUTTONPUSH or DFCS_ADJUSTRECT;
    IsDown := State and ODS_SELECTED <> 0;
    IsDefault := State and ODS_FOCUS <> 0;
    IsDisabled := State and ODS_DISABLED <> 0;
 
    IF IsDown THEN
      Flags := Flags or DFCS_PUSHED;
 
    IF IsDisabled THEN
      Flags := Flags or DFCS_INACTIVE;
 
    IF IsFocused or IsDefault THEN
    BEGIN
      FCanvas.Pen.Color := clWindowFrame;
      FCanvas.Pen.Width := 1;
      FCanvas.Brush.Style := bsClear;
      FCanvas.Rectangle(Rect.Left, Rect.Top, Rect.Right, Rect.Bottom);
      InflateRect(Rect, - 1, - 1);
    END;
 
    IF IsDown THEN
    BEGIN
      FCanvas.Pen.Color := clBtnShadow;
      FCanvas.Pen.Width := 1;
      FCanvas.Brush.Color := clBtnFace;
      FCanvas.Rectangle(Rect.Left, Rect.Top, Rect.Right, Rect.Bottom);
      InflateRect(Rect, - 1, - 1); 
    END 
    ELSE 
      DrawFrameControl(FCanvas.Handle, Rect, DFC_BUTTON, Flags); 
 
    IF IsDown THEN
      OffsetRect(Rect, 1, 1);
 
    OldColor := FCanvas.Brush.Color;
    FCanvas.Brush.Color := BackColor;
    FCanvas.FillRect(Rect);
    FCanvas.Brush.Color := OldColor;
    OldMode := SetBkMode(FCanvas.Handle, TRANSPARENT);
    FCanvas.Font.Color := ForeColor;
    IF IsDisabled THEN
      DrawState(FCanvas.Handle, FCanvas.Brush.Handle, nil, Integer(Caption), 0,
      ((Rect.Right - Rect.Left) - FCanvas.TextWidth(Caption)) div 2,
      ((Rect.Bottom - Rect.Top) - FCanvas.TextHeight(Caption)) div 2,
        0, 0, DST_TEXT or DSS_DISABLED)
    ELSE
      DrawText(FCanvas.Handle, PChar(Caption), - 1, Rect,
        DT_SINGLELINE or DT_CENTER or DT_VCENTER);
    SetBkMode(FCanvas.Handle, OldMode);
 
    IF IsFocused and IsDefault THEN
    BEGIN
      Rect := OrgRect;
      InflateRect(Rect, - 4, - 4);
      FCanvas.Pen.Color := clWindowFrame;
      FCanvas.Brush.Color := clBtnFace;
      DrawFocusRect(FCanvas.Handle, Rect);
    END;
 
  //  t2 := Time;
  //  Debug ('DrawButton.. '+Form ('##.##########', (t2 - t1)));
 
  END; (*DrawButton*)
  //****************************************************************************
  PROCEDURE Register;
  BEGIN
    RegisterComponents('Snidugt', [TColorButton]);
  END;
  //****************************************************************************
 
END.

Select allOpen in new window

Ok, I'll check it all and keep you informed by tomorrow.

But did I understood correctly that your small app was working ? What is the difference in concept between the 2 projects ?

Found it!

Guys, thanks for your time spending. It was of cause a clumsy user error. A calling error. Not like me usual, I used the name parent as parameter in the routine which created the buttons. Inside this routine I did use WITH statement and then obviously because of scope it used the parent of the button it self. Dummy me!!!!

I try always to use prefix in name callings, as Obj_Parent instead etc.

nice one !
some times you need to step back to see what's under your nose.

Thanks again!

Report:

1. I did use improper name for the parent object I passed to the routine Create_Buttons.

2. I did also use Panel1.DestroyComponents and then got this error I mentioned in my first post.

3. I build my own DestroyComponents to trace where the error occurred and found out it was in this unit, Colorbutton I posted yesterday.

4. I did use Panel1.Free which works fine with the class, TButton but not with TColorButton. This situation

5. After further tests I have found out other bug and as someone mention it here above, that is, the TColorButton.Destructor did illegal instruction when it free the Canvas. I removed this instruction and then this code works fine.

6. However, I'm not 100% sure if the Destructor of TColorButton frees up the memory taken by FCanvas in that object.

>>Try also with commenting out the FCanvas.Free in your destructor. He is one Usual Suspect.

This was the key to the solution!

>> 6. However, I'm not 100% sure if the Destructor of TColorButton frees up the memory taken by FCanvas in that object.

Who cares as long as it works ???

Ok, just kidding :o) It would be good to know why Freeing it is causing problems. Normally, everything created in your constructor should be freed in your destructor.
I Don't know if that applies here, but this kind of problems can come when it is a property declared in an ancestor. it can be created twice, stored in the same variable, one of which memory area is lost without reference, and when both classes frees it, there can be problems. If you Use FreeAndNil before calling the inherited Destroy; this case should be handled (not quite properly because there would still be another object floating somewhere - but that is some clue)