umain.pas

简单的delphi数据库例子

unit umain;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ExtCtrls, Grids, ComCtrls, ImgList, DBGrids, StdCtrls, Menus, shellapi,
  DB, ADODB, WinSkinData, SkinCaption;

type
  Tfrmmain = class(TForm)
    Panel1: TPanel;
    TreeView1: TTreeView;
    ImageList1: TImageList;
    Panel2: TPanel;
    Panel3: TPanel;
    dbgrdshow: TDBGrid;
    GroupBox1: TGroupBox;
    GroupBox2: TGroupBox;
    GroupBox3: TGroupBox;
    btnadd: TButton;
    btnsave: TButton;
    cbbcondition: TComboBox;
    edtcondition: TEdit;
    btnfind: TButton;
    btnrepair: TButton;
    btnsaverep: TButton;
    btndelete: TButton;
    btnabout: TButton;
    btnquit: TButton;
    statmain: TStatusBar;
    Label1: TLabel;
    Label2: TLabel;
    Label6: TLabel;
    Label7: TLabel;
    Label12: TLabel;
    Label15: TLabel;
    Label18: TLabel;
    edtname: TEdit;
    edtage: TEdit;
    edttel: TEdit;
    edtxlt: TEdit;
    edtworktel: TEdit;
    edtaddress: TEdit;
    Memo1: TMemo;
    qrymsg: TADOQuery;
    dsmsg: TDataSource;
    qrymsgDSDesigner: TWideStringField;
    qrymsgDSDesigner9: TWideStringField;
    qrymsgDSDesigner10: TWideStringField;
    qrymsgDSDesigner11: TWideStringField;
    qrymsgDSDesigner14: TWideStringField;
    qrymsgDSDesigner17: TMemoField;
    Timer1: TTimer;
    SkinData1: TSkinData;
    skncptn1: TSkinCaption;
    qrymsgDSDesigner3: TWordField;
    procedure btnquitClick(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure btnaddClick(Sender: TObject);
    procedure dbgrdshowDblClick(Sender: TObject);
    procedure btnsaveClick(Sender: TObject);
    procedure edtageKeyPress(Sender: TObject; var Key: Char);
    procedure edtadrtelKeyPress(Sender: TObject; var Key: Char);
    procedure btndeleteClick(Sender: TObject);
    procedure btnaboutClick(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);
    procedure btnrepairClick(Sender: TObject);
    procedure btnsaverepClick(Sender: TObject);
    procedure TreeView1DblClick(Sender: TObject);
    procedure edtconditionChange(Sender: TObject);
  private
    procedure formini();
    procedure Edittextshow();
    { Private declarations }
  public
    { Public declarations }
  end;

var
  frmmain: Tfrmmain;

implementation
uses about;
{$R *.dfm}

procedure Tfrmmain.btnquitClick(Sender: TObject);
begin
  Application.Terminate;
end;

procedure Tfrmmain.formini();
begin
  edtcondition.Text := '';
  edtname.Text := '';
  edtage.Text := '';
  edttel.Text := '';
  edtxlt.Text := '';
  edtaddress.Text := '';
  edtworktel.Text := '';
  edtaddress.Text := '';
  Memo1.Text := '';
  cbbcondition.ItemIndex := 0;
end;

function IsReadOnly(b: Boolean; colors: Tcolor): Boolean;
begin
  with frmmain do
  begin
    edtname.ReadOnly := b; edtname.color := colors;
    edtage.ReadOnly := b; edtage.color := colors;
    edttel.ReadOnly := b; edttel.color := colors;
    edtxlt.ReadOnly := b; edtxlt.color := colors;
    edtaddress.ReadOnly := b; edtaddress.color := colors;
    edtworktel.ReadOnly := b; edtworktel.color := colors;
    edtaddress.ReadOnly := b; edtaddress.color := colors;
    Memo1.ReadOnly := b; Memo1.color := colors;
  end;
end;

function Load_Week(const Dtime: TDateTime): string;
const
  dstr: array[1..7] of string = ('星期日', '星期一', '星期二', '星期三', '星期四', '星期五', '星期六');
begin
  result := dstr[DayOfWeek(dtime)];
end;

procedure Tfrmmain.FormCreate(Sender: TObject);
var FileName: string;
  errNO: integer;
  hMutex: HWND;
begin
  hMutex := CreateMutex(nil, False, pchar(Application.title));
  errNO := GetLastError;
  if errNO = ERROR_ALREADY_EXISTS then begin //检测是否重复运行
    Application.MessageBox('软件已经在运行', '重复运行', MB_OK);
    Application.Terminate;
  end
  else
  begin
    btnrepair.Enabled := False;
    btnsaverep.Enabled := False;
    statmain.Panels[2].Text := Load_Week(Date);
    statmain.Panels[1].Text := DateToStr(Date);
    formini;
    IsReadOnly(True, cl3DLight);
    FileName := ExtractFilePath(ParamStr(0)) + '\MDB\电子通讯录.mdb';
    qrymsg.ConnectionString := 'Provider=Microsoft.Jet.OLEDB.4.0;Data Source=' +
      FileName + ';Persist Security Info=False;jet OLEDB:Database Password=mimo;';
    with qrymsg do
    begin
      SQL.Text := 'select * from msg';
      Active := True;
    end;
  end;
end;

procedure Tfrmmain.btnaddClick(Sender: TObject);
begin
  formini;
  IsReadOnly(False, clWindow);
  edtname.SetFocus;
end;

procedure Tfrmmain.dbgrdshowDblClick(Sender: TObject);
begin
  try
    with qrymsg do
    begin
      edtname.Text := FieldValues['姓名'];
      edtage.Text := FieldValues['年龄'];
      edttel.Text := FieldValues['手机号码'];
      edtxlt.Text := FieldValues['小灵通'];
      edtaddress.Text := FieldValues['家庭住址'];
      edtworktel.Text := FieldValues['单位电话'];
      Memo1.Text := FieldValues['备注'];
    end;
    btnrepair.Enabled := True;
    btnsaverep.Enabled := True;
  except
  end;
end;

procedure Tfrmmain.Edittextshow;
begin
  with qrymsg do
  begin
    FieldByName('姓名').AsString := Trim(edtname.Text);
    FieldByName('年龄').AsInteger := StrToInt(Trim(edtage.Text));
    FieldByName('手机号码').AsString := Trim(edttel.Text);
    FieldByName('小灵通').AsString := Trim(edtxlt.Text);
    FieldByName('家庭住址').AsString := Trim(edtaddress.Text);
    FieldByName('单位电话').AsString := Trim(edtworktel.Text);
    FieldByName('备注').AsVariant := Memo1.Text;
  end;
end;

procedure Tfrmmain.btnsaveClick(Sender: TObject);
begin
  if (edtname.Text <> '') then
  begin
    with qrymsg do
    begin
      Edit;
      if MessageBox(0, '是否增加本条信息?', '询问', MB_YESNO + MB_ICONQUESTION)
        = IDYES then
      begin
        Append;
        Edittextshow;
        Post;
        if MessageBox(0, '增加信息成功,是否还增加' + #13#10 +
          '     其他信息?', '询问', MB_YESNO + MB_ICONQUESTION) = IDYES then
        begin
          formini;
          edtname.SetFocus;
        end
        else
        begin
          formini;
          IsReadOnly(True, cl3DLight);
        end;
      end;
    end;
  end
  else
    MessageBox(0, '请确认姓名,性别,类型' + #13#10 + '   信息的完整性!   ', '提示',
      MB_OK + MB_ICONINFORMATION);
end;

procedure Tfrmmain.edtageKeyPress(Sender: TObject; var Key: Char);
begin
  if not (Key in ['0'..'9', Char(VK_BACK), Char(VK_RETURN)]) then
  begin
    Key := #0;
  end;
end;

procedure Tfrmmain.edtadrtelKeyPress(Sender: TObject; var Key: Char);
begin
  if not (Key in ['0'..'9', '-', Char(VK_BACK), Char(VK_RETURN)]) then
  begin
    Key := #0;
  end;
  if (Key = '-') and (Pos('-', Trim((Sender as TEdit).Text)) <> 0) then
  begin
    Key := #0;
    (sender as TEdit).SetFocus;
  end;
end;

procedure Tfrmmain.btndeleteClick(Sender: TObject);
begin
  if MessageBox(0, '是否删除本条信息!', '询问', MB_YESNO + MB_ICONQUESTION) =
    IDYES then
  begin
    qrymsg.Delete;
    if qrymsg.RecordCount <> 0 then
    begin
      qrymsg.First;
      frmmain.dbgrdshowDblClick(nil);
    end;
  end;
end;

procedure Tfrmmain.btnaboutClick(Sender: TObject);
begin
  try
    Application.CreateForm(Tfrmabout, frmabout);
    frmabout.ShowModal;
  finally
    frmabout.Free;
  end;
end;

procedure Tfrmmain.Timer1Timer(Sender: TObject);
begin
  statmain.Panels[4].Text := TimeToStr(Now);
end;

procedure Tfrmmain.btnrepairClick(Sender: TObject);
begin
  IsReadOnly(False, clWindow);
  edtname.SetFocus;
end;

procedure Tfrmmain.btnsaverepClick(Sender: TObject);
begin
  if (edtname.Text <> '') then
  begin
    with qrymsg do
    begin
      Edit;
      if MessageBox(0, '是否修改本条信息?', '询问', MB_YESNO + MB_ICONQUESTION)
        = IDYES then
      begin
        Edittextshow;
        Post;
        if MessageBox(0, '修改信息成功,是否还修改' + #13#10 +
          '     其他信息?', '询问', MB_YESNO + MB_ICONQUESTION) = IDYES then
        begin
          First;
          dbgrdshowDblClick(nil);
          edtname.SetFocus;
        end
        else
          formini;
        IsReadOnly(True, cl3DLight);
      end;
    end;
  end
  else
    MessageBox(0, '请确认姓名,性别,类型' + #13#10 + '   信息的完整性!   ', '提示',
      MB_OK + MB_ICONINFORMATION);
end;


procedure Tfrmmain.TreeView1DblClick(Sender: TObject);
var str: string;
  i: Integer;
begin
  str := TreeView1.Selected.Text;
  with qrymsg do
  begin
    Close;
    SQL.Clear;
    i := TreeView1.Selected.Index;
    if i in [0, 1, 2, 3, 4, 5] then
      SQL.Text := 'select * from msg where 类型 = ''' + str + '''order by ''' + str + '''';
    if i in [6] then
      SQL.Text := 'select * from msg';
    Open;
    First;
    if qrymsg.RecordCount < 0 then
      MessageBox(0, '没有找到相关的信息!', '提示', MB_OK + MB_ICONINFORMATION)
    else
      MessageBox(0, pchar('共查找到' + IntToStr(qrymsg.RecordCount) + '条记录!'), '询问', MB_OK + MB_ICONINFORMATION);
  end;
end;

procedure Tfrmmain.edtconditionChange(Sender: TObject);
begin

  if cbbcondition.Text <> '' then
  begin
    with qrymsg do
    begin
      Close;
      SQL.Clear;
      SQL.Text := 'select * from msg where 1=1 ';
      if (cbbcondition.ItemIndex = 1) then
        SQL.Add('and 单位电话 like ''%' + Trim(edtcondition.Text) + '%''');
      if (cbbcondition.ItemIndex = 2) then
        SQL.Add('and 姓名 like ''%' + Trim(edtcondition.Text) + '%''');
      if (cbbcondition.ItemIndex = 3) then
        SQL.Add('and 家庭住址 like ''%' + Trim(edtcondition.Text) + '%''');
      if (cbbcondition.ItemIndex = 4) then
        SQL.Add('and 手机号码 like ''%' + Trim(edtcondition.Text) + '%''');
      if (cbbcondition.ItemIndex = 5) then
        SQL.Add('and 年龄 like ''%' + Trim(edtcondition.Text) + '%''');
      Open;
      First;
    end;
  end;
end;

end.