Home: Code Repository: Mastering Delphi 5

Project CLASSINFO

Project Structure

CLASSINFO.DPR
INFOFORM.PAS
INFOFORM.DFM

program ClassInfo;

uses
  Forms,
  InfoForm in 'InfoForm.pas' {Form1};

{$R *.RES}

begin
  Application.Initialize;
  Application.CreateForm(TForm1, Form1);
  Application.Run;
end.

unit InfoForm;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms,
  StdCtrls, ExtCtrls, Buttons, Grids, Menus;

type
  TForm1 = class(TForm)
    ListParent: TListBox;
    Label1: TLabel;
    EditInfo: TEdit;
    Label2: TLabel;
    Label3: TLabel;
    Panel1: TPanel;
    ListClasses: TListBox;
    procedure FormCreate(Sender: TObject);
    procedure ListClassesClick(Sender: TObject);
  private
    ClassArray: array of TClass;
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.DFM}

procedure TForm1.FormCreate(Sender: TObject);
var
  I: Integer;
begin
  SetLength (ClassArray, 50);

  ClassArray [0] := TButton;
  ClassArray [1] := TBitBtn;
     ClassArray [2] := TEdit;
  ClassArray [3] := TPopupMenu;
  ClassArray [4] := TRadioButton;
  ClassArray [5] := TRadioGroup;
  ClassArray [6] := TPanel;
  ClassArray [7] := TCheckBox;
  ClassArray [8] := TForm;
  ClassArray [9] := TComboBox;
  ClassArray [10] := TGroupBox;
  ClassArray [11] := TSpeedButton;
  ClassArray [12] := TLabel;
  ClassArray [13] := TListBox;
  ClassArray [14] := TMainMenu;
  ClassArray [15] := TMemo;

  // copy class names to the listbox
  for I := 0 to 15 do
    ListClasses.Items.Add (ClassArray [I].ClassName);
  // select the first class
  ListClasses.ItemIndex := 0;
  // show initial information
  ListClassesClick (Sender);
end;

procedure TForm1.ListClassesClick(Sender: TObject);
var
  MyClass: TClass;
begin
  MyClass := ClassArray [ListClasses.ItemIndex];
  EditInfo.Text := Format ('Name: %s - Size: %d bytes',
    [MyClass.ClassName, MyClass.InstanceSize]);
  with ListParent.Items do
  begin
    Clear;
    while MyClass.ClassParent <> nil do
    begin
      MyClass := MyClass.ClassParent;
      Add (MyClass.ClassName);
    end;
  end;
end;

end.

object Form1: TForm1
  Left = 217
  Top = 109
  Width = 397
  Height = 236
  Caption = 'Class Info'
  Color = clBtnFace
  Font.Charset = DEFAULT_CHARSET
  Font.Color = clWindowText
  Font.Height = -11
  Font.Name = 'MS Sans Serif'
  Font.Style = []
  OldCreateOrder = True
  OnCreate = FormCreate
  PixelsPerInch = 96
  TextHeight = 13
  object Label3: TLabel
    Left = 8
    Top = 8
    Width = 56
    Height = 13
    Caption = 'Class Name'
  end
  object Panel1: TPanel
    Left = 168
    Top = 8
    Width = 209
    Height = 193
    Caption = 'Panel1'
    TabOrder = 0
    object Label1: TLabel
      Left = 8
      Top = 48
      Width = 63
      Height = 13
      Caption = 'Base Classes'
    end
    object Label2: TLabel
      Left = 8
      Top = 8
      Width = 25
      Height = 13
      Caption = 'Class'
    end
    object ListParent: TListBox
      Left = 8
      Top = 64
      Width = 193
      Height = 121
      ItemHeight = 13
      TabOrder = 0
    end
    object EditInfo: TEdit
      Left = 8
      Top = 24
      Width = 193
      Height = 21
      ReadOnly = True
      TabOrder = 1
    end
  end
  object ListClasses: TListBox
    Left = 8
    Top = 24
    Width = 153
    Height = 177
    ItemHeight = 13
    TabOrder = 1
    OnClick = ListClassesClick
  end
end