shapes.pas

这是不可多得的源代码

unit Shapes;

interface

uses
  System.Globalization, System.Reflection,
  System.Collections,
  System.Runtime.InteropServices,
	Borland.Win32.Windows,
	Borland.Win32.Messages,
	Borland.Delphi.SysUtils,
	Borland.Delphi.Variants,
	Borland.Delphi.Classes,
	Borland.Vcl.Graphics,
	Borland.Vcl.Controls,
	Borland.Vcl.Forms,
	Borland.Vcl.Dialogs,
	Borland.Vcl.StdCtrls,
	Borland.Vcl.ExtCtrls;

type
  TForm1 = class(TForm)
    ColorBox1: TColorBox;
    Label1: TLabel;
    Shape1: TShape;
    RadioGroup1: TRadioGroup;
    lbMethods : TListBox;
    aButton : TButton;
  private
    { Private declarations }
		procedure InitializeControls;
  public
    { Public declarations }
		constructor Create(AOwner: TComponent); override;
    procedure UpdateShape(Sender: TObject);
    procedure GetMethods(Sender: TObject);
  end;

var
  Form1: TForm1;

implementation


constructor TForm1.Create(AOwner: TComponent);
begin
	inherited;
	InitializeControls;
end;

procedure TForm1.GetMethods(Sender: TObject);
var
  MethodInfos: array of MethodInfo;
  MethodInfoIndex: Integer;
  MethodInfo: System.Reflection.MethodInfo;
  Attributes: array of TObject;
  AttributeIndex: Integer;
  Attribute: TObject;
  Params: array of ParameterInfo;

  sResult : String;
  ClassType : System.Type;
begin
  ClassType := aButton.GetType;
  MethodInfos := ClassType.GetMethods(BindingFlags(Integer(BindingFlags.Public) or Integer(BindingFlags.NonPublic) or Integer(BindingFlags.Instance) or Integer(BindingFlags.DeclaredOnly)));
  for MethodInfoIndex := Low(MethodInfos) to High(MethodInfos) do
  begin
    MethodInfo := MethodInfos[MethodInfoIndex];
    Attributes := MethodInfo.GetCustomAttributes(TypeOf(MessageMethodAttribute), False);
    if Length(Attributes) > 0 then
    begin
      Params := MethodInfo.GetParameters;
      if Length(Params) = 1 then
        for AttributeIndex := Low(Attributes) to High(Attributes) do
        begin
          Attribute := Attributes[AttributeIndex];
          sResult := (Attribute as MessageMethodAttribute).ID.ToString() +
                     ' : ' + MethodInfo.Name;
          lbMethods.Items.Add(sResult);
        end;
    end;
  end;
end;

procedure TForm1.InitializeControls;
begin
  // Initalizing all controls...
  ColorBox1 := TColorBox.Create(Form1);
	Label1 := TLabel.Create(Form1);
	Shape1 := TShape.Create(Form1);
	RadioGroup1 := TRadioGroup.Create(Form1);
  lbMethods := TListBox.Create(Form1);
  aButton := TButton.Create(Form1);

	// Form's PMEs'
	Caption:= 'Shape Changer';
	Color:= clBtnFace;
	Font.Charset:= DEFAULT_CHARSET;
	Font.Color:= clWindowText;
	Font.Height:= -11;
	Font.Name:= 'MS Sans Serif';
	Font.Style:= [];
	PixelsPerInch:= 96;

  with ColorBox1 do
  begin
    Parent := Self;
    Left := 175;
    Top := 150;
    OnSelect := UpdateShape;
  end;

	with Label1 do
	begin
		Parent:= Self;
		Left:= 20;
		Top:= 20;
    Caption := 'Rectangle';
	end;

	with Shape1 do
	begin
		Parent:= Self;
		Left:= 20;
		Top:= 60;
    Width := 150;
		Shape := stRectangle;
    Brush.Color := clBlack;
	end;

	with RadioGroup1 do
	begin
		Parent:= Self;
		Left:= 175;
		Top:= 20;
    Items.Add('Rectangle');
    Items.Add('Square');
    Items.Add('RoundRect');
    Items.Add('RoundSquare');
    Items.Add('Ellipse');
    Items.Add('Circle');
    ItemIndex := 0;
    OnClick := UpdateShape;
	end;

  with lbMethods do
	begin
		Parent:= Self;
		Left:= 400;
		Top:= 50;
    Width := 300;
    Height := 400;
	end;
end;

procedure TForm1.UpdateShape(Sender: TObject);
var
  S: string;
begin
  S := RadioGroup1.Items[RadioGroup1.ItemIndex];
  Label1.Caption := S;
  Shape1.Brush.Color := ColorBox1.Selected;
  if SameText(S, 'Rectangle') then
    Shape1.Shape := stRectangle
  else if SameText(S, 'Square') then
    Shape1.Shape := stSquare
  else if SameText(S, 'RoundRect') then
    Shape1.Shape := stRoundRect
  else if SameText(S, 'RoundSquare') then
    Shape1.Shape := stRoundSquare
  else if SameText(S, 'Ellipse') then
    Shape1.Shape := stEllipse
  else
    Shape1.Shape := stCircle;
  GetMethods(Self);
end;

end.