ufrm_authorization.pas

完整的进销存系统。 设计文件及完整的源代码。 Delphi6.0

//  ***************************************
//  *    Program name : ufrm_authorization*
//  *    AUTHOR       : Guo xuliang       *
//  *    Name         :郭许良　　　　     *
//  *    Date         : 2005/05/18        *
//  *    Porgram type : subroutine        *
//  ***************************************
unit ufrm_authorization;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ComCtrls, ImgList, StdCtrls, Buttons, CheckLst, DB, ADODB,
  DBTables;

type
  Tfrm_authorization = class(TForm)
    PageControl1: TPageControl;
    TabSheet1: TTabSheet;
    ImageList1: TImageList;
    btn_no: TBitBtn;
    btn_yes: TBitBtn;
    Label1: TLabel;
    edt_select: TEdit;
    spb_select: TSpeedButton;
    ckl_prog: TCheckListBox;
    btn_selectall: TBitBtn;
    btn_clearall: TBitBtn;
    md_update: TQuery;
    procedure FormKeyDown(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure btn_noClick(Sender: TObject);
    procedure btn_yesClick(Sender: TObject);
    procedure edt_selectExit(Sender: TObject);
    procedure btn_selectallClick(Sender: TObject);
    procedure btn_clearallClick(Sender: TObject);
    procedure spb_selectClick(Sender: TObject);
    procedure edt_selectEnter(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure FormCreate(Sender: TObject);
  private
    { Private declarations }
    g_flag,g_md01,g_oldmd02,g_oldmd03:string;
    g_newmd02,g_newmd03:string;
    l_sqlstr:string;
    g_errormessage:string;
  public
    { Public declarations }
    procedure ini(p_flag,p_md01,p_md02,p_md03:string);
    procedure fill_ckl(p_prog:string);
    procedure mark_checked(p_permission:string);
    function  get_str:string;
    function  check(p_key:string):boolean;
  end;

var
  frm_authorization: Tfrm_authorization;

implementation
uses udm, ufrm_program_select;
{$R *.dfm}
procedure Tfrm_authorization.ini(p_flag,p_md01,p_md02,p_md03:string);
begin
  g_errormessage:='';
  //get the values form invoker
  g_flag:=p_flag;
  g_md01:=p_md01;
  g_oldmd02:=p_md02;
  g_oldmd03:=p_md03;
  //initialize layout
  if g_flag='U' then
    begin
      edt_select.Enabled:=false;
      spb_select.Enabled:=false;
      edt_select.Text:=p_md02;
      //fill checklist
      fill_ckl(p_md02);
      mark_checked(p_md03);
    end;
end;

procedure Tfrm_authorization.fill_ckl(p_prog:string);
var str:string;
begin
  ckl_prog.Clear;
  l_sqlstr:='SELECT * FROM ZB_FILE WHERE ZB01='''+p_prog+'''';
  md_update.Close;
  md_update.SQL.Clear;
  md_update.SQL.Add(l_sqlstr);
  md_update.Open;
  while not md_update.Eof do
    begin
      str:=trim(md_update.fieldbyname('ZB02').AsString)+':'+trim(md_update.fieldbyname('ZB03').AsString);
      ckl_prog.Items.Add(str);
      md_update.Next;
    end;
end;

procedure Tfrm_authorization.mark_checked(p_permission:string);
var i,j:integer;
    currchar:string;
begin
  for i:=1 to length(p_permission) do
    begin
      currchar:=copy(p_permission,i,1);
      for j:=0 to ckl_prog.Items.Count-1 do
        begin
          if currchar=copy(ckl_prog.Items[j],1,1) then
            begin
              ckl_prog.Checked[j]:=true;
              break;
            end;
        end;
    end;
end;

function Tfrm_authorization.get_str:string;
var i:integer;
    str:string;
begin
  str:='';
  for i:=0 to ckl_prog.Items.Count-1 do
    begin
      if ckl_prog.Checked[i] then
        str:=str+ copy(ckl_prog.Items[i],1,1);
    end;
  result:=str;
end;

function Tfrm_authorization.check(p_key:string):boolean;
begin
  result:=true;
  if p_key='' then begin result:=false; exit; end;
  l_sqlstr:='SELECT COUNT(*) FROM ZE_FILE WHERE ZE01='''+g_md01+''''+
            ' AND ZE02='''+p_key+'''';
  md_update.Close;
  md_update.SQL.Clear;
  md_update.SQL.Add(l_sqlstr);
  md_update.Open;
  if md_update.Fields[0].AsInteger>0 then
    begin
      result:=false;
      g_errormessage:='編號重復';
      exit;
    end;
  l_sqlstr:='SELECT COUNT(*) FROM ZA_FILE WHERE ZA03='''+p_key+'''';
  md_update.Close;
  md_update.SQL.Clear;
  md_update.SQL.Add(l_sqlstr);
  md_update.Open;
  if md_update.Fields[0].AsInteger<1 then
    begin
      result:=false;
      g_errormessage:='程序代碼不存在';
      exit;
    end;

end;
procedure Tfrm_authorization.FormKeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin
 if key=13 then selectnext(activecontrol,true,true);
end;

procedure Tfrm_authorization.btn_noClick(Sender: TObject);
begin
  close;
end;

procedure Tfrm_authorization.btn_yesClick(Sender: TObject);
begin
  g_newmd02:=edt_select.Text;
  g_newmd03:=self.get_str;
  if g_flag='U' then
    begin
      l_sqlstr:='UPDATE ZE_FILE SET ZE03='''+g_newmd03+''''+
                ' WHERE ZE01='''+g_md01+''''+
                ' AND ZE02='''+g_newmd02+'''';
      try
        md_update.Close;
        md_update.SQL.Clear;
        md_update.SQL.Add(l_sqlstr);
        md_update.ExecSQL;
        frm_authorization.ModalResult:=mrok;
      except
        ;
      end;
    end
  else if g_flag='A' then
    begin
      //check md02
      if not self.check(g_newmd02) then
        begin
          messagedlg(g_errormessage,mtinformation,[mbok],0);
          exit;
        end;
      l_sqlstr:='INSERT INTO ZE_FILE (ZE01,ZE02,ZE03) VALUES('''+
                g_md01+''','''+g_newmd02+''','''+g_newmd03+''')';
      try
        md_update.Close;
        md_update.SQL.Clear;
        md_update.SQL.Add(l_sqlstr);
        md_update.ExecSQL;
        frm_authorization.ModalResult:=mrok;
      except
        ;
      end;
    end;
end;

procedure Tfrm_authorization.edt_selectExit(Sender: TObject);
begin
  self.fill_ckl(edt_select.Text);
end;

procedure Tfrm_authorization.btn_selectallClick(Sender: TObject);
var i:integer;
begin
  for i:=0 to ckl_prog.Items.Count-1 do
    begin
      ckl_prog.Checked[i]:=true;
    end;
end;

procedure Tfrm_authorization.btn_clearallClick(Sender: TObject);
var i:integer;
begin
  for i:=0 to ckl_prog.Items.Count-1 do
    begin
      ckl_prog.Checked[i]:=false;
    end;
end;

procedure Tfrm_authorization.spb_selectClick(Sender: TObject);
{var l_select:string;
    l_table:string;
    l_where:string;
    l_order:string;}
begin
 Application.CreateForm(Tfrm_program_select,frm_program_select);
 frm_program_select.init(g_md01,'1');
 if frm_program_select.showmodal=mrok then
   begin
     edt_select.Text:=frm_program_select.za_file.Fields[2].AsString;
     self.edt_selectExit(nil);
   end;
 try
  frm_program_select.release;
 except
  ;
 end;
{ Application.CreateForm(Tfrm_common_select, frm_common_select);
 //need change
 l_select:=' MA01,MA02 ';
 l_table:='MA_FILE';
 l_where:='1=1 ';
 l_order:=' ORDER BY MA01';

 frm_common_select.init(l_select,l_table,l_where,l_order);
 if frm_common_select.ShowModal=mrok then
  begin
   //need change
   edt_select.Text:=frm_common_select.query1.Fields[0].AsString;
   self.edt_selectExit(nil);
  end;
 try
  frm_common_select.release;
 except
  ;
 end;}
end;

procedure Tfrm_authorization.edt_selectEnter(Sender: TObject);
begin
  ckl_prog.Clear;
end;

procedure Tfrm_authorization.FormClose(Sender: TObject;
  var Action: TCloseAction);
begin
action:=cafree;
end;

procedure Tfrm_authorization.FormCreate(Sender: TObject);
begin
  md_update.DatabaseName:=dm.connection.DatabaseName;
end;

end.