carinfo.pas

一个详细功能齐全的档案管理信息系统 跟大家分享一下。这是老师给的光盘里带的

unit Carinfo;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ActnList, ImgList, ComCtrls, StdCtrls, Buttons, ToolWin, Grids,
  DBGrids, ExtCtrls, DB, Mask, DBCtrls;

type
  TfCarinfo = class(TForm)
    ImageList: TImageList;
    ActManage: TActionList;
    ActFilter: TAction;
    ActOpen: TAction;
    ActExit: TAction;
    CoolBar1: TCoolBar;
    ToolBar1: TToolBar;
    ToolButton1: TToolButton;
    BitBtn3: TBitBtn;
    Panel1: TPanel;
    DBGrid1: TDBGrid;
    DataSource1: TDataSource;
    Actadd: TAction;
    BitBtn1: TBitBtn;
    BitBtn2: TBitBtn;
    Actdelete: TAction;
    Label1: TLabel;
    CheckBox1: TCheckBox;
    ActSave: TAction;
    BitBtn4: TBitBtn;
    CheckBox2: TCheckBox;
    CheckBox3: TCheckBox;
    CheckBox4: TCheckBox;
    CheckBox5: TCheckBox;
    CheckBox6: TCheckBox;
    CheckBox11: TCheckBox;
    CheckBox12: TCheckBox;
    userna: TDBEdit;
    procedure FormCreate(Sender: TObject);
    procedure ActExitExecute(Sender: TObject);
    procedure ActaddExecute(Sender: TObject);
    procedure ActdeleteExecute(Sender: TObject);
    procedure DBGrid1CellClick(Column: TColumn);
    procedure ActSaveExecute(Sender: TObject);
  private
    { Private declarations }
    procedure setcheck(var str:string);
    function getcheck :string;
  public
    { Public declarations }
  end;

var
  fCarinfo: TfCarinfo;

implementation
uses dm,Adduser;

{$R *.dfm}

procedure TfCarinfo.FormCreate(Sender: TObject);
begin
  with fdm.UserList do
  begin
    close;
    open;
  end;
end;

procedure TfCarinfo.ActExitExecute(Sender: TObject);
begin
  close;
end;

procedure TfCarinfo.ActaddExecute(Sender: TObject);
var
auser,apassword:string;
begin
  if fAdduser.InputCount(auser,apassword) then
  begin
    with fdm.UserList do
    begin
      open;
      Append;
      FieldByname('usercount').AsString:=auser;
      FieldByname('password').AsString:=apassword;
      post;
      close;
      open;
    end;
  end;
end;

procedure TfCarinfo.ActdeleteExecute(Sender: TObject);
begin
if uppercase(userna.Text)<>'ADMIN' then
begin
  with fdm.UserList do
  begin
    edit;
    delete;
    close;
    open;
  end;
end;
end;

procedure TfCarinfo.DBGrid1CellClick(Column: TColumn);
var
str:string;
begin
  with fdm.UserList do
  begin
    str:=fieldbyname('quanxian').AsString;
  end;
  setcheck(str);
end;
function TfCarinfo.getcheck:string;
var
i:integer;
str:string;
begin
  for i:=0 to fcarinfo.ComponentCount-1 do
  begin
    if Components[i] is TCheckBox then
    begin
      if (Components[i] as TCheckBox).Checked then
      str := str+(Components[i] as TCheckBox).Hint+',';
    end;
  end;
  result:=str;
end;
procedure TfCarinfo.setcheck(var str:string);
var
i:integer;
hints:string;
begin
  for i:=0 to fcarinfo.ComponentCount-1 do
  begin
    if Components[i] is TCheckBox then
    begin
      hints := (Components[i] as TCheckBox).Hint;
      if pos(hints,str)>0 then
       (Components[i] as TCheckBox).Checked:=true
      else
       (Components[i] as TCheckBox).Checked:=false;
    end;
  end;
end;

procedure TfCarinfo.ActSaveExecute(Sender: TObject);
var
user,quanx,sql:string;
begin
  user:=userna.Text;
  quanx:=getcheck;
  sql:=format('update logouser set quanxian=''%s'' where usercount=''%s'' ',[quanx,user]);
  ExecSql(sql);
end;

end.