本例效果图:



准备工作: 新建工程后, 在窗体上添加一个 Panel 和四个 CheckBox; 双击它们产生默认事件, 然后全选代码, 用下面代码覆盖.
unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ExtCtrls;

type
  TForm1 = class(TForm)
    Panel1: TPanel;
    CheckBox1: TCheckBox;
    CheckBox2: TCheckBox;
    CheckBox3: TCheckBox;
    CheckBox4: TCheckBox;
    procedure FormCreate(Sender: TObject);
    procedure CheckBox1Click(Sender: TObject);
    procedure CheckBox2Click(Sender: TObject);
    procedure CheckBox3Click(Sender: TObject);
    procedure CheckBox4Click(Sender: TObject);
    procedure Panel1Click(Sender: TObject);
    procedure SetAnchor(Sender: TObject; ak: TAnchors); {自定义的过程}
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

{给 CheckBox 做一个公用过程}
procedure TForm1.SetAnchor(Sender: TObject; ak: TAnchors);
begin
  with Panel1 do if TCheckBox(Sender).Checked then
    Anchors := Anchors + ak
  else
    Anchors := Anchors - ak;
end;

{初始化}
procedure TForm1.FormCreate(Sender: TObject);
begin
  Panel1.Anchors := [akLeft, akTop]; {这本来就是默认值}

  CheckBox1.Checked := True;
  CheckBox2.Checked := True;

  CheckBox1.Caption := 'akLeft';
  CheckBox2.Caption := 'akTop';
  CheckBox3.Caption := 'akRight';
  CheckBox4.Caption := 'akBottom';

  Panel1.ParentBackground := False;
  Panel1.Color := clYellow;
end;

{变化窗体大小}
procedure TForm1.Panel1Click(Sender: TObject);
const
  s1 = '点击放大窗体';
  s2 = '点击缩小窗体';
begin
  if Panel1.Caption = s2 then
  begin
    Panel1.Caption := s1;
    Width := Round(Width / 1.5);
    Height := Round(Height / 1.5);
  end
  else
  begin
    Panel1.Caption := s2;
    Width := Round(Width * 1.5);
    Height := Round(Height * 1.5);
  end;
end;

procedure TForm1.CheckBox1Click(Sender: TObject);
begin
  SetAnchor(Sender, [akLeft]);
end;

procedure TForm1.CheckBox2Click(Sender: TObject);
begin
  SetAnchor(Sender, [akTop]);
end;

procedure TForm1.CheckBox3Click(Sender: TObject);
begin
  SetAnchor(Sender, [akRight]);
end;

procedure TForm1.CheckBox4Click(Sender: TObject);
begin
  SetAnchor(Sender, [akBottom]);
end;

end.

posted on 2008-04-29 21:26  万一  阅读(4680)  评论(4编辑  收藏  举报