⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 fmdynamiccheckbox.pas

📁 这是不可多得的源代码
💻 PAS
字号:
unit fmDynamicCheckBox;

interface

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

type
  TForm1 = class(TForm)
    GroupBox1: TGroupBox;
    btnCreateCheckBox: TButton;
    btnLoadCheckBox: TButton;
    btnSaveCheckBox: TButton;
    BitBtn1: TBitBtn;
    procedure btnCreateCheckBoxClick(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure btnSaveCheckBoxClick(Sender: TObject);
    procedure btnLoadCheckBoxClick(Sender: TObject);
  private
    { Private declarations }
    aList : TList;

    procedure DeleteCheckBoxes;
    procedure RegisterCheckBoxClass;
    procedure LoadCheckBoxes;
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

const
  OFFSET = 40;
  CMPFILENAME = 'custommizedComponents.cks';

procedure TForm1.btnCreateCheckBoxClick(Sender: TObject);
var
  iCount , iYPos : Integer;
  aCB : TCheckBox;
begin
  iYPos := 30;

  for iCount := 1 to 5 do
  begin
    aCB := TCheckBox.Create(Self);
    aCB.Parent := Self.GroupBox1;
    aCB.Left := 10;
    aCB.Top := iYPos;
    aCB.Width := 300;
    aCB.Caption := 'CheckBox控件' + IntToStr(iCount);
    Inc(iYPos, OFFSET);
    aList.Add(aCB);
  end;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  aList := TList.Create;
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
  FreeAndNil(aList);
end;

procedure TForm1.btnSaveCheckBoxClick(Sender: TObject);
var
  fss : TMemoryStream;
  iCount : Integer;
begin
  try
    fss := TMemoryStream.Create;
    for iCount := 0 to aList.Count - 1 do
      fss.WriteComponent(TCheckBox(aList.Items[iCount]));

    fss.SaveToFile(CMPFILENAME);
  finally
    FreeAndNil(fss);
  end;
end;

procedure TForm1.btnLoadCheckBoxClick(Sender: TObject);
begin
  if (FileExists(CMPFILENAME)) then
  begin
    DeleteCheckBoxes;
    RegisterCheckBoxClass;
    LoadCheckBoxes;
  end;
end;

procedure TForm1.DeleteCheckBoxes;
var
  iCount : Integer;
begin
  for iCount := aList.Count - 1 downto 0 do
  begin
    TCheckBox(aList.Items[iCount]).Free;
    aList.Delete(iCount);
  end;
end;

procedure TForm1.LoadCheckBoxes;
var
  fss : TMemoryStream;
  iCount : Integer;
  acb : TCheckBox;
begin
  try
    fss := TMemoryStream.Create;
    fss.LoadFromFile(CMPFILENAME);
    for iCount := 1 to 5 do
    begin
      acb := TCheckBox(fss.ReadComponent(nil));
      acb.Parent := Self.GroupBox1;
      acb.Font.Color := clRed;
      aList.Add(acb);
    end;
  finally
    FreeAndNil(fss);
  end;
end;

procedure TForm1.RegisterCheckBoxClass;
begin
  try
    Classes.FindClass('TCheckBox');
  except
    on Exception do
      Classes.RegisterClass(TCheckBox);
  end;
end;

end.

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -