usettype.pas

一个把具有名片功能的通讯录

unit uSetType;
{设置通信录分类}

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, DB, Grids, DBGrids, StdCtrls,TinyDB, ComCtrls;

type
  TSetADTypeFrm = class(TForm)
    GroupBox1: TGroupBox;
    ExitBtn: TButton;
    DBGrid1: TDBGrid;
    DataSource1: TDataSource;
    GroupBox2: TGroupBox;
    Label1: TLabel;
    Label2: TLabel;
    Label3: TLabel;
    procedure FormCreate(Sender: TObject);
    procedure ExitBtnClick(Sender: TObject);
    procedure DBGrid1DblClick(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  SetADTypeFrm: TSetADTypeFrm;
  TTB:TTinyTable;

implementation

uses uInfoCard;

{$R *.dfm}

procedure TSetADTypeFrm.FormCreate(Sender: TObject);
begin
  TTB:=TTinyTable.Create(self);
  with TTB do
  begin
    DatabaseName := InfoCardFrm.DBName;
    TableName := 'ADTypes';
    Password := DBPassWord;
    Open;
  end;
  DataSource1.DataSet := TTB;
end;

procedure TSetADTypeFrm.ExitBtnClick(Sender: TObject);
begin
  Close;
end;

procedure TSetADTypeFrm.DBGrid1DblClick(Sender: TObject);
begin
  if MessageDlg('是否要删除 ['+TTB.FieldValues['TypeName']+
    '] 项分类?', mtConfirmation, [mbYes, mbNo],0) = mrYes then
  begin
    try
      TTB.Delete;
    except
      ShowMessage('操作错误!');
    end;
  end;
end;

procedure TSetADTypeFrm.FormClose(Sender: TObject;
  var Action: TCloseAction);
begin
  with TTB do
  begin
  if TTB.RecordCount <= 0 then
    try
      {========加入四类基本名片通信录分类========}
      AppendRecord(['朋友']);
      AppendRecord(['亲戚']);
      AppendRecord(['同学']);
      AppendRecord(['网友']);
    finally
      Free;
    end;
  end;
end;

end.