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

📄 usermaintain.pas

📁 自己做的通讯录程序
💻 PAS
字号:
unit UserMaintain;

interface

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

type
  TUserItem = record
    UserName : string;
    OldName  : String;
  end;
  pTUserItem = ^TUserItem;

  TfrmUserMaintain = class(TForm)
    lbUserList: TListBox;
    ADOQuery1: TADOQuery;
    Panel1: TPanel;
    btAdd: TBitBtn;
    btDelete: TBitBtn;
    Label1: TLabel;
    editUserName: TEdit;
    ADOQuerySave: TADOQuery;
    BitBtn1: TBitBtn;
    procedure FormShow(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure btAddClick(Sender: TObject);
    procedure lbUserListClick(Sender: TObject);
    procedure editUserNameChange(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure btDeleteClick(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
    m_UserList: TList;
  end;

var
  frmUserMaintain: TfrmUserMaintain;

implementation

uses main;

{$R *.dfm}

procedure TfrmUserMaintain.FormShow(Sender: TObject);
var
  strName: String;
  p: pTUserItem;
begin
  lbUserList.Items.Clear;
  m_UserList.Clear;
  editUserName.Text := '';

  with ADOQuery1 do
  begin
    Open;
    while not(Eof) do
    begin
      strName := FieldByName('UserName').AsString;
      lbUserList.Items.Add(strName);

      new(p);
      p.UserName := strName;
      p.OldName  := strName;
      m_UserList.Add(p);

      Next;
    end;
    Close;
  end;
end;

procedure TfrmUserMaintain.FormCreate(Sender: TObject);
begin
  m_UserList := TList.Create();
end;

procedure TfrmUserMaintain.FormDestroy(Sender: TObject);
begin
  m_UserList.Free;
end;

procedure TfrmUserMaintain.btAddClick(Sender: TObject);
var
  p: pTUserItem;
begin
  new(p);
  p.UserName := '';
  p.OldName  := '';
  m_UserList.Add(p);

  lbUserList.Items.Add('');
  lbUserList.ItemIndex := lbUserList.Items.Count-1;
  editUserName.Text := '';
  editUserName.SetFocus;
end;

procedure TfrmUserMaintain.lbUserListClick(Sender: TObject);
begin
  if (lbUserList.Items.Count = 0)
     OR (lbUserList.ItemIndex < 0) then
  begin
    editUserName.Text := '';
    exit;
  end;

  editUserName.Text := lbUserList.Items[lbUserList.ItemIndex];
end;

procedure TfrmUserMaintain.editUserNameChange(Sender: TObject);
var
  index: Integer;
begin
  index := lbUserList.ItemIndex;
  if index < 0 then
    Exit;
  lbUserList.Items[index] := editUserName.Text;
  pTUserItem(m_UserList[index]).UserName := editUserName.Text;
end;

procedure TfrmUserMaintain.FormClose(Sender: TObject;
  var Action: TCloseAction);
var
  i, j, count: integer;
  p: pTUserItem;
begin
  //先检查有没有重复的名字。如果有,则将OldName=''的那些删除,因为他们是没有数据的。
  //而且可以肯定的是,那些OldName=''的用户肯定在后面,因为添加的顺序是这样的
  //至于如果前面的那个OldName='',可以不管他,因为本来就是要添加用户的
  i := 0;
  count := m_UserList.Count;
  while (i <= Count-1) do
  begin
    j := i+1;
    while (j <= Count-1) do
    begin
      if pTUserItem(m_UserList[j]).UserName = pTUserItem(m_UserList[i]).UserName then
      //两个用户的名称是一样的
      begin
        lbUserList.Items.Delete(j);
        m_UserList.Delete(j);
        j := j-1;
      end;
      count := m_UserList.Count;
      j := j+1;
    end;
    i := i+1;
  end;

  for i:=0 to m_UserList.Count-1 do
  begin
    p := m_UserList[i];
    if (Length(p.OldName) = 0)
       AND (Length(p.UserName) > 0) then  //新的用户
      with ADOQuerySave do
      begin
        SQL.Clear;
        SQL.Add(Format('Insert Into Users(UserName) Values(''%s'')',[p.UserName]));
        ExecSQL;
      end;

    if (Length(p.OldName) > 0)
       AND (p.UserName <> p.OldName) then  //更新原有的用户
      with ADOQuerySave do
      begin
        SQL.Clear;
        SQL.Add(Format('Update AddressList SET UserName=''%s'' Where UserName=''%s''',
                      [p.UserName, p.OldName]));
        ExecSQL;

        SQL.Clear;
        SQL.Add(Format('Update Users SET UserName=''%s'' Where UserName=''%s''',
                      [p.UserName, p.OldName]));
        ExecSQL;
      end;
  end;
end;

procedure TfrmUserMaintain.btDeleteClick(Sender: TObject);
var
  n, index: Integer;
  UserName, strSQL: string;
begin
  if lbUserList.Items.Count = 0 then
    Exit;
  index := lbUserList.ItemIndex;

  n := MessageBox(Handle, PChar('删除用户“'+lbUserList.Items[lbUserList.ItemIndex]+'”时,'
                                +'要同时删除该用户的通讯录数据吗?'),
             '小心删除', MB_YESNOCANCEL or MB_ICONQUESTION);
  if n = IDCANCEL then
    exit;
  if MessageBox(Handle, '真的要删除吗?', '再次确认', MB_YESNO or MB_ICONWARNING) = IDNO then
    exit;

  UserName := lbUserList.Items[index];
  if (n = IDYES) OR (n = IDNO) then
  begin
    with ADOQuerySave do
    begin
      SQL.Clear;
      strSQL := 'Delete From Users Where UserName='''+UserName+'''';
      SQL.Add(strSQL);
      ExecSQL;
    end;
    lbUserList.Items.Delete(index);
    m_UserList.Delete(index);
  end;

  if n = IDYES then
    with ADOQuerySave do
    begin
      SQL.Clear;
      SQL.Add('Delete From AddressList Where UserName='''+UserName+'''');
      ExecSQL;
    end;

  if index > lbUserList.Items.Count-1 then
    index := lbUserList.Items.Count-1;
  lbUserList.ItemIndex := index;
  lbUserList.SetFocus;
  lbUserListClick(nil);
end;

end.

⌨️ 快捷键说明

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