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

📄 user.pas

📁 这是应一个市委的朋友要求给做一个物品管理软件。 初始密码:admin
💻 PAS
字号:
unit user;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, Grids, DBGridEh, ExtCtrls, Menus;

type
  Tfuser = class(TForm)
    Panel1: TPanel;
    dg_view: TDBGridEh;
    Label4: TLabel;
    PopupMenu1: TPopupMenu;
    A1: TMenuItem;
    M1: TMenuItem;
    D1: TMenuItem;
    R1: TMenuItem;
    N1: TMenuItem;
    L1: TMenuItem;
    Panel2: TPanel;
    Label1: TLabel;
    Label2: TLabel;
    Label3: TLabel;
    tb_name: TEdit;
    tb_pwd: TEdit;
    tb_pwd2: TEdit;
    Button1: TButton;
    Button2: TButton;
    Label5: TLabel;
    Label6: TLabel;
    procedure Button2Click(Sender: TObject);
    procedure FormShow(Sender: TObject);
    procedure tb_nameKeyPress(Sender: TObject; var Key: Char);
    procedure tb_pwdKeyPress(Sender: TObject; var Key: Char);
    procedure tb_pwd2KeyPress(Sender: TObject; var Key: Char);
    procedure Button1Click(Sender: TObject);
    procedure A1Click(Sender: TObject);
    procedure M1Click(Sender: TObject);
    procedure D1Click(Sender: TObject);
    procedure R1Click(Sender: TObject);
    procedure L1Click(Sender: TObject);
  private  
    flag : char;
    { Private declarations }
  public
    { Public declarations }
  end;

var
  fuser: Tfuser;

implementation
uses dm,vks;

{$R *.dfm}

procedure Tfuser.Button2Click(Sender: TObject);
begin
  close;
end;

procedure Tfuser.FormShow(Sender: TObject);
begin
  fdm.tuser.Active := true;
  flag := 'A';
end;

procedure Tfuser.tb_nameKeyPress(Sender: TObject; var Key: Char);
begin
  if (key=#13) and (tb_name.Text<>'') then tb_pwd.SetFocus;
end;

procedure Tfuser.tb_pwdKeyPress(Sender: TObject; var Key: Char);
begin
  if (key=#13) and (tb_pwd.Text<>'') and (length(tb_pwd.Text)>=3) then tb_pwd2.SetFocus;
end;

procedure Tfuser.tb_pwd2KeyPress(Sender: TObject; var Key: Char);
begin
  if (key=#13) and (tb_pwd2.Text<>'') and (length(tb_pwd2.Text)>=3) then Button1Click(Sender);
end;

procedure Tfuser.Button1Click(Sender: TObject);
var
  cnt : string;
begin
  if tb_name.Text='' then
  begin
    vks.info(1006);
    tb_name.SetFocus;
    exit;
  end;
  if tb_pwd.Text='' then
  begin
    vks.info(1000);
    tb_pwd.SetFocus;
    exit;
  end;
  if tb_pwd2.Text='' then
  begin
    vks.info(1001);
    tb_pwd2.SetFocus;
    exit;
  end;
  if (tb_pwd.Text<>'') and (length(tb_pwd.Text)<3) then
  begin
    vks.info(1002);
    tb_pwd.SetFocus;
    exit;
  end;
  if tb_pwd.Text<>tb_pwd2.Text then
  begin
    vks.info(1003);
    tb_pwd.SetFocus;
    exit;
  end;
  with fdm.q do
  begin
    close;
    sql.Text := 'select count(1) as cnt from [user] where name='''+tb_name.Text+'''';
    if flag='M' then sql.Text := sql.Text + ' and id<>'+dg_view.Fields[0].AsString;
    try
      Open;
      cnt := FieldByName('cnt').AsString;
      close;
      if cnt<>'0' then
      begin
        vks.info(1007);
        exit;
      end;
      if flag='A' then
        sql.Text := 'insert into [user](name,pwd) values('''+tb_name.Text+''','''+tb_pwd.Text+''')'
      else
        sql.Text := 'update [user] set name='''+tb_name.Text+''',pwd='''+tb_pwd.Text+''' where id='+dg_view.Fields[0].AsString;
      try
        execsql;
        A1Click(Sender);
        dg_view.Enabled := true;
        R1Click(Sender);
      except
        close;
        vks.info(1008);
      end;
    except
      close;
      vks.info(1008);
    end;   
  end;
end;

procedure Tfuser.A1Click(Sender: TObject);
begin
  flag := 'A';
  tb_name.Clear;
  tb_pwd.Clear;
  tb_pwd2.Clear;
  tb_name.SetFocus;
end;

procedure Tfuser.M1Click(Sender: TObject);
begin
  if fdm.tuser.RecordCount>0 then
  begin
    flag := 'M';
    tb_name.Text := dg_view.Fields[1].AsString;
    tb_pwd.Text := dg_view.Fields[3].AsString;
    tb_pwd2.Text := dg_view.Fields[3].AsString;
    tb_name.SetFocus;
    dg_view.Enabled := false;
  end;
end;

procedure Tfuser.D1Click(Sender: TObject);
begin
if (fdm.tuser.RecordCount>0) and (vks.box('确定要删除本数据吗?如果没有关联数据,将能被删除.','操作员数据删除窗口')) then
begin
  with fdm.q do
  begin
    close;
    sql.Text := 'delete from [user] where id='+dg_view.Fields[0].AsString;
    try
      execsql;
      A1Click(Sender);
      R1Click(Sender);
      close;
    except
      close;
      vks.info(1008);
    end;
  end;
end;
end;

procedure Tfuser.R1Click(Sender: TObject);
begin
  fdm.tuser.Close;
  fdm.tuser.Open;
end;

procedure Tfuser.L1Click(Sender: TObject);
begin
  with fdm.q do
  begin
    close;
    sql.Text := 'update [user] set flag=not flag where id='+dg_view.Fields[0].AsString;
    try
      execsql;
      A1Click(Sender);
      R1Click(Sender);
      close;
    except
      close;
      vks.info(1008);
    end;
  end;
end;

end.

⌨️ 快捷键说明

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