umain.~pas

提供个人信息资料的编辑

unit umain;

interface

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

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;
    Label3: TLabel;
    Label4: TLabel;
    Label5: TLabel;
    Label6: TLabel;
    Label7: TLabel;
    Label8: TLabel;
    Label9: TLabel;
    Label10: TLabel;
    Label11: TLabel;
    Label12: TLabel;
    Label13: TLabel;
    Label14: TLabel;
    Label15: TLabel;
    Label16: TLabel;
    Label17: TLabel;
    Label18: TLabel;
    edtname: TEdit;
    edtage: TEdit;
    edtename: TEdit;
    edtadrtel: TEdit;
    edttel: TEdit;
    edtxlt: TEdit;
    cbbsex: TComboBox;
    dtpbirthday: TDateTimePicker;
    edtnation: TEdit;
    edtqqnum: TEdit;
    edtworktel: TEdit;
    edtfax: TEdit;
    edtpostnum: TEdit;
    cbbbkind: TComboBox;
    GroupBox4: TGroupBox;
    cbbkind: TComboBox;
    edtaddress: TEdit;
    edtwwwadr: TEdit;
    edtemail: TEdit;
    Memo1: TMemo;
    btnskim: TButton;
    btnletter: TButton;
    qrymsg: TADOQuery;
    dsmsg: TDataSource;
    qrymsgDSDesigner: TWideStringField;
    qrymsgDSDesigner2: TWideStringField;
    qrymsgDSDesigner3: TWordField;
    qrymsgDSDesigner4: TDateTimeField;
    qrymsgDSDesigner5: TWideStringField;
    qrymsgDSDesigner6: TWideStringField;
    qrymsgDSDesigner7: TWideStringField;
    qrymsgDSDesigner8: TWideStringField;
    qrymsgDSDesigner9: TWideStringField;
    qrymsgDSDesigner10: TWideStringField;
    qrymsgDSDesigner11: TWideStringField;
    qrymsgDSDesigner12: TWideStringField;
    qrymsgDSDesigner13: TWideStringField;
    qrymsgDSDesigner14: TWideStringField;
    qrymsgOICQ: TWideStringField;
    qrymsgEMAIL: TWideStringField;
    qrymsgDSDesigner15: TWideStringField;
    qrymsgDSDesigner16: TWideStringField;
    qrymsgDSDesigner17: TMemoField;
    Timer1: TTimer;
    procedure btnquitClick(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure btnaddClick(Sender: TObject);
    procedure btnletterClick(Sender: TObject);
    procedure dbgrdshowDblClick(Sender: TObject);
    procedure edtwwwadrChange(Sender: TObject);
    procedure btnskimClick(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 edtemailChange(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 := '';
  edtename.Text := '';
  edtadrtel.Text := '';
  edttel.Text := '';
  edtxlt.Text := '';
  edtnation.Text := '';
  edtqqnum.Text := '';
  edtaddress.Text := '';
  edtworktel.Text := '';
  edtfax.Text := '';
  edtpostnum.Text := '';
  edtaddress.Text := '';
  edtwwwadr.Text := '';
  edtemail.Text := '';
  Memo1.Text := '';
  cbbcondition.ItemIndex := 0;
  cbbsex.ItemIndex := -1;
  cbbbkind.ItemIndex := -1;
  cbbkind.ItemIndex := -1;
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;
    edtename.ReadOnly := b; edtename.color := colors;
    edtadrtel.ReadOnly := b; edtadrtel.color := colors;
    edttel.ReadOnly := b; edttel.color := colors;
    edtxlt.ReadOnly := b; edtxlt.color := colors;
    edtnation.ReadOnly := b; edtnation.color := colors;
    edtqqnum.ReadOnly := b; edtqqnum.color := colors;
    edtaddress.ReadOnly := b; edtaddress.color := colors;
    edtworktel.ReadOnly := b; edtworktel.color := colors;
    edtfax.ReadOnly := b; edtfax.color := colors;
    edtpostnum.ReadOnly := b; edtpostnum.color := colors;
    edtaddress.ReadOnly := b; edtaddress.color := colors;
    edtwwwadr.ReadOnly := b; edtwwwadr.color := colors;
    edtemail.ReadOnly := b; edtemail.color := colors;
    Memo1.ReadOnly := b; Memo1.color := colors;
    cbbsex.Enabled := not b; cbbsex.color := colors;
    cbbbkind.Enabled := not b; cbbbkind.color := colors;
    cbbkind.Enabled := not b; cbbkind.color := colors;
    dtpbirthday.Enabled := not b; dtpbirthday.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);
    btnletter.Enabled := (edtemail.Text <> '');
    btnskim.Enabled := (edtwwwadr.Text <> '');
    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.btnletterClick(Sender: TObject);
begin
  ShellExecute(Handle, 'open', PChar('mailto:' + edtemail.Text + '?subject='), nil, nil, SW_SHOW);
end;

procedure Tfrmmain.dbgrdshowDblClick(Sender: TObject);
begin
  try
    with qrymsg do
    begin
      edtname.Text := FieldValues['姓名'];
      edtage.Text := FieldValues['年龄'];
      edtename.Text := FieldValues['网名'];
      edtadrtel.Text := FieldValues['住宅电话'];
      edttel.Text := FieldValues['手机号码'];
      edtxlt.Text := FieldValues['小灵通'];
      edtnation.Text := FieldValues['民族'];
      edtqqnum.Text := FieldValues['OICQ号'];
      edtaddress.Text := FieldValues['家庭住址'];
      edtworktel.Text := FieldValues['单位电话'];
      edtfax.Text := FieldValues['传真号码'];
      edtpostnum.Text := FieldValues['邮政编码'];
      edtwwwadr.Text := FieldValues['网址'];
      edtemail.Text := FieldValues['E-MAIL'];
      Memo1.Text := FieldValues['备注']; cbbsex.Style := csDropDown;
      cbbsex.Text := FieldValues['性别']; cbbbkind.Style := csDropDown;
      cbbbkind.Text := FieldValues['血型']; cbbkind.Style := csDropDown;
      cbbkind.Text := FieldValues['类型'];
      dtpbirthday.Date := FieldValues['生日'];
    end;
    btnrepair.Enabled := True;
    btnsaverep.Enabled := True;
  except
  end;
end;

procedure Tfrmmain.edtwwwadrChange(Sender: TObject);
begin
  btnskim.Enabled := (edtwwwadr.Text <> '');
end;

procedure Tfrmmain.btnskimClick(Sender: TObject);
begin
  ShellExecute(Handle, 'open', pchar(edtwwwadr.text), nil, nil, SW_SHOW);
end;

procedure Tfrmmain.Edittextshow;
begin
  with qrymsg do
  begin
    FieldByName('姓名').AsString := Trim(edtname.Text);
    FieldByName('年龄').AsInteger := StrToInt(Trim(edtage.Text));
    FieldByName('网名').AsString := Trim(edtename.Text);
    FieldByName('住宅电话').AsString := Trim(edtadrtel.Text);
    FieldByName('手机号码').AsString := Trim(edttel.Text);
    FieldByName('小灵通').AsString := Trim(edtxlt.Text);
    FieldByName('民族').AsString := Trim(edtnation.Text);
    FieldByName('OICQ号').AsString := Trim(edtqqnum.Text);
    FieldByName('家庭住址').AsString := Trim(edtaddress.Text);
    FieldByName('单位电话').AsString := Trim(edtworktel.Text);
    FieldByName('传真号码').AsString := Trim(edtfax.Text);
    FieldByName('邮政编码').AsString := Trim(edtpostnum.Text);
    FieldByName('网址').AsString := Trim(edtwwwadr.Text);
    FieldByName('E-MAIL').AsString := Trim(edtemail.Text);
    FieldByName('备注').AsVariant := Memo1.Text;
    FieldByName('生日').AsString := DateToStr(dtpbirthday.Date);
    FieldByName('性别').AsString := cbbsex.Text;
    FieldByName('血型').AsString := cbbbkind.Text;
    FieldByName('类型').AsString := cbbkind.Text;
  end;
end;

//保存新记录
procedure Tfrmmain.btnsaveClick(Sender: TObject);
begin
  if (edtname.Text <> '') and (cbbkind.Text <> '') and (cbbsex.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.edtemailChange(Sender: TObject);
begin
  btnletter.Enabled := (edtemail.Text <> '');
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 <> '') and (cbbkind.Text <> '') and (cbbsex.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
          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 (' + cbbcondition.Text + ' like ''' + edtcondition.Text + '%'')or(' + cbbcondition.Text + ' like ''%' + edtcondition.Text + '%'')or(' + cbbcondition.Text + ' like ''%' + edtcondition.Text + '%'') ';
      Open;
      First;
    end;
  end;
end;

end.