hcrk.~pas

一个基于数据的药品行业管理系统,较全面,可供学习数据的开发人员参考消息

unit HCRK;

interface

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

type
  Tfrm_hcRK = class(TForm)
    ToolBar1: TToolBar;
    tadd: TToolButton;
    tdel: TToolButton;
    tedit: TToolButton;
    tsave: TToolButton;
    tcancel: TToolButton;
    tprint: TToolButton;
    tfind: TToolButton;
    GroupBox1: TGroupBox;
    Label1: TLabel;
    Label2: TLabel;
    txthcbh: TEdit;
    txthcmc: TEdit;
    txtdw: TEdit;
    Label5: TLabel;
    Label6: TLabel;
    StatusBar1: TStatusBar;
    Label8: TLabel;
    Label9: TLabel;
    Label10: TLabel;
    Label12: TLabel;
    Label13: TLabel;
    Label15: TLabel;
    Label3: TLabel;
    txtdqkc: TEdit;
    txtjhdj: TEdit;
    StringGrid1: TStringGrid;
    txtcsbh: TComboBox;
    Label4: TLabel;
    txtpc: TEdit;
    ImageList2: TImageList;
    txtaqkc: TEdit;
    txtgg: TEdit;
    SpeedButton1: TSpeedButton;
    Label7: TLabel;
    txtjhsl: TEdit;
    Label11: TLabel;
    txtjhje: TEdit;
    txtjhdh1: TLabel;
    txtjhdh: TEdit;
    Label14: TLabel;
    Label16: TLabel;
    txtczy: TEdit;
    DataSource1: TDataSource;
    DBGrid1: TDBGrid;
    txtjhrq: TEdit;
    procedure taddClick(Sender: TObject);
    {procedure txtkhbhExit(Sender: TObject);
    procedure txtggExit(Sender: TObject);
    procedure txtdqkcExit(Sender: TObject);
    procedure txthcmcExit(Sender: TObject);
    procedure txtdwExit(Sender: TObject);
    procedure txtkhbhKeyPress(Sender: TObject; var Key: Char);
    procedure txtggKeyPress(Sender: TObject; var Key: Char);
    procedure txthcmcKeyPress(Sender: TObject; var Key: Char);
    procedure txtdwKeyPress(Sender: TObject; var Key: Char);
    procedure txtdqkcKeyPress(Sender: TObject; var Key: Char); }
    procedure FormCreate(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure tsaveClick(Sender: TObject);
    procedure hcreflesh;
    procedure tdelClick(Sender: TObject);
    procedure teditClick(Sender: TObject);
    procedure StringGrid1SelectCell(Sender: TObject; ACol, ARow: Integer;
      var CanSelect: Boolean);
  
    procedure tcancelClick(Sender: TObject);
    procedure tfindClick(Sender: TObject);
    procedure FormShow(Sender: TObject);
    procedure SpeedButton1Click(Sender: TObject);
    procedure DBGrid1DblClick(Sender: TObject);
    procedure txtcsbhExit(Sender: TObject);
    procedure txtcsbhChange(Sender: TObject);
    procedure txtjhslKeyPress(Sender: TObject; var Key: Char);
    procedure txtjhdjKeyPress(Sender: TObject; var Key: Char);
    procedure txtjhslKeyUp(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure txtjhdjExit(Sender: TObject);
    procedure txthcbhExit(Sender: TObject);


  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  frm_hcRK: Tfrm_hcRK;
  mycell:integer;
  editflag:integer;

implementation

uses csda, date1, HCXX, pubmotion;
{$R *.dfm}

function aenabeld(key:integer):boolean;
begin
    with frm_hcrk do
    begin
    //浏览模式
    if key=0 then
    begin
    groupbox1.Enabled:=false;
    txtcsbh.enabled:=true;
    txthcbh.enabled:=false;
    txthcmc.enabled:=false;
    txtdw.enabled:=false;
    txtgg.enabled:=false;
    txtdqkc.enabled:=false;
    txtjhdj.enabled:=false;
    txtaqkc.enabled:=false;
    txtpc.enabled:=false;
    tadd.Enabled:=true;
    tdel.Enabled:=true;
    tedit.Enabled:=true;
    tsave.Enabled:=false;
    tcancel.Enabled:=false;
    tfind.Enabled:=true;
    tprint.Enabled:=true;
    end;
    //  编辑模式
    if key=1 then
    begin
    groupbox1.Enabled:=true;
    tadd.Enabled:=false;
    tdel.Enabled:=false;
    tedit.Enabled:=false;
    tsave.Enabled:=true;
    tcancel.Enabled:=true;
    tfind.Enabled:=false;
    txtcsbh.enabled:=true;
    txthcbh.enabled:=false;
    txthcmc.enabled:=true;
    txtdw.enabled:=true;
    txtgg.enabled:=true;
    txtdqkc.enabled:=false;
    txtjhdj.enabled:=true;
    txtaqkc.enabled:=true;
    txtpc.enabled:=true;
    end;
    //新增
    if key=2 then
    begin
    tadd.Enabled:=false;
    tdel.Enabled:=false;
    tedit.Enabled:=false;
    tsave.Enabled:=true;
    tcancel.Enabled:=true;
    tfind.Enabled:=false;
    groupbox1.Enabled:=true;
    txthcbh.Enabled:=true;
    {txthcmc.enabled:=true;
    txtdw.enabled:=true;
    txtgg.enabled:=true;
    txtdqkc.enabled:=false;
    txtaqkc.enabled:=true;}
    txtjhdj.enabled:=true;
    txtpc.enabled:=true;
    txtjhdh.Clear;
    txthcbh.Clear;
    txthcmc.clear;
    txtdw.clear;
    txtgg.clear;
    txtjhdj.clear;
    txtaqkc.clear;
    txtpc.clear;
    txtjhsl.Clear;
    txtczy.Clear;
    txtcsbh.SetFocus;
     txtdqkc.Clear;
     txtjhje.clear;
    txtcsbh.Color:=clskyblue;
    end;
    // 保存
    if key=3 then
    begin
    txtcsbh.enabled:=false;
    txthcbh.enabled:=false;
    txthcmc.enabled:=false;
    txtdw.enabled:=false;
    txtgg.enabled:=false;
    txtdqkc.enabled:=false;
    txtjhdj.enabled:=false;
    txtaqkc.enabled:=false;
    txtpc.enabled:=false;
    tadd.Enabled:=true;
    tdel.Enabled:=true;
    tedit.Enabled:=true;
    tsave.Enabled:=false;
    tcancel.Enabled:=false;
    tfind.Enabled:=true;
    tprint.Enabled:=true;
    groupbox1.Enabled:=false;
  end;
  if key=3 then//取消
    begin
    txtjhdh.Clear;
    txthcbh.Clear; 
    txthcmc.clear;
    txtdw.clear;
    txtgg.clear;
    txtjhdj.clear;
    txtaqkc.clear;
    txtpc.clear;
    txtdqkc.Clear;
     txtjhje.clear;
    txtcsbh.enabled:=true;
    txthcbh.enabled:=false;
    txthcmc.enabled:=false;
    txtdw.enabled:=false;
    txtgg.enabled:=false;
    txtdqkc.enabled:=false;
    txtjhdj.enabled:=false;
    txtaqkc.enabled:=false;
    txtpc.enabled:=false;
    tadd.Enabled:=true;
    tdel.Enabled:=true;
    tedit.Enabled:=true;
    tsave.Enabled:=false;
    tcancel.Enabled:=false;
    tfind.Enabled:=true;
    tprint.Enabled:=true;
    groupbox1.Enabled:=false;
  end;
  end;
  end;

procedure Tfrm_hcRK.taddClick(Sender: TObject);
var s,s1,s2,s3,csbh:string;
    i,k,j:integer;
begin
editflag:=0;
aenabeld(2);
txtjhrq.Text:=formatdatetime('yyyy-mm-dd',now);
txtczy.Text:='user';
if txtcsbh.Text='' then
begin
 showmessage('供货商不能为空');
 exit;
end; 

end;



{procedure Tfrm_hcxx.txtkhbhExit(Sender: TObject);
begin
with data do
begin
aq1.Connection:=adoc1;
aq1.Close;
aq1.SQL.Clear;
aq1.SQL.add('select csbh from csda where csbh=:khbh');
aq1.Parameters.ParamByName('khbh').Value:=trim(txtkhbh.Text);
aq1.Open;
if aq1.Recordset.RecordCount>0 then
begin
showmessage('该供应商编号已存在');
txtkhbh.SetFocus;
txtkhbh.SelectAll;
exit;
end;
end;
if not txtkhbh.Focused then
   txtkhbh.Color:=clwindow;
end;
procedure Tfrm_hcxx.txtggExit(Sender: TObject);
begin
if not txtlxr.Focused then
   txtlxr.Color:=clwindow;
end; 
procedure Tfrm_hcxx.txtdqkcExit(Sender: TObject);
begin
if not txtphone.Focused then
   txtphone.Color:=clwindow;
end;

procedure Tfrm_hcxx.txthcmcExit(Sender: TObject);
begin
if not txtkhmc.Focused then
   txtkhmc.Color:=clwindow;
end;

procedure Tfrm_hcxx.txtdwExit(Sender: TObject);
begin
if not txtdz.Focused then
   txtdz.Color:=clwindow;
end;

procedure Tfrm_hcxx.txtkhbhKeyPress(Sender: TObject; var Key: Char);
begin
if key=#13 then
begin
with database do
begin
aq1.Connection:=adoc1;
aq1.Close;
aq1.SQL.Clear;
aq1.SQL.add('select csbh from csda where csbh=:khbh');
aq1.Parameters.ParamByName('khbh').Value:=trim(txtkhbh.Text);
aq1.Open;
if aq1.Recordset.RecordCount>0 then
begin
showmessage('该供应商编号已存在');
txtkhbh.SetFocus;
txtkhbh.SelectAll; 
exit;
end;
end;
txtkhmc.SetFocus;
txtkhmc.Color:=clskyblue;
end;
end;
procedure Tfrm_hcxx.txtggKeyPress(Sender: TObject; var Key: Char);
begin
if key=#13 then
begin
txtphone.SetFocus;
txtphone.Color:=clskyblue;
end;
end;

procedure Tfrm_hcxx.txthcmcKeyPress(Sender: TObject; var Key: Char);
begin
if key=#13 then
begin
if txtkhmc.Text<>'' then
begin
txtdz.SetFocus;
txtdz.Color:=clskyblue;
end
else
messagebox(frm_csda.Handle,'供应商 名称不能为空','提示信息',mb_ok);
end;
end;

procedure Tfrm_hcxx.txtdwKeyPress(Sender: TObject; var Key: Char);
begin
if key=#13 then
begin
txtlxr.SetFocus;
txtlxr.Color:=clskyblue;
end;
end;

procedure Tfrm_hcxx.txtdqkcKeyPress(Sender: TObject; var Key: Char);
begin
if key=#13 then
begin
txtfax.SetFocus;
txtfax.Color:=clskyblue;
end;
end; }
procedure Tfrm_hcRK.FormCreate(Sender: TObject);
begin
stringgrid1.FixedRows:=1;
stringgrid1.FixedColor:=clbtnface;
stringgrid1.RowCount:=2;
stringgrid1.ColCount:=16;
stringgrid1.Cells[0,0]:='';
stringgrid1.Cells[1,0]:='进货单号';
stringgrid1.Cells[2,0]:='耗材编号';
stringgrid1.Cells[3,0]:='耗材名称';
stringgrid1.Cells[4,0]:='进货数量';
stringgrid1.Cells[5,0]:='进货日期';
stringgrid1.Cells[6,0]:='操作员';
stringgrid1.Cells[7,0]:='供应商';
stringgrid1.Cells[8,0]:='进货价格';
stringgrid1.Cells[9,0]:='进货金额';
stringgrid1.Cells[10,0]:='批次';
stringgrid1.Cells[11,0]:='制单日期';
stringgrid1.Cells[12,0]:='规格';
stringgrid1.Cells[13,0]:='单位';
stringgrid1.Cells[14,0]:='当前库存量';
stringgrid1.Cells[15,0]:='安全库存量';
stringgrid1.ColWidths[0]:=10;
stringgrid1.ColWidths[1]:=100;
stringgrid1.ColWidths[2]:=50;
stringgrid1.ColWidths[3]:=200;
stringgrid1.ColWidths[4]:=80;
stringgrid1.ColWidths[5]:=80;
stringgrid1.ColWidths[6]:=150;
stringgrid1.ColWidths[7]:=80;
stringgrid1.ColWidths[8]:=80;
stringgrid1.ColWidths[9]:=80;
stringgrid1.ColWidths[10]:=80;
stringgrid1.ColWidths[11]:=80;
stringgrid1.ColWidths[12]:=80;
stringgrid1.ColWidths[13]:=80;
stringgrid1.ColWidths[14]:=80;
stringgrid1.ColWidths[15]:=80;
aenabeld(0);
end;

procedure Tfrm_hcRK.FormClose(Sender: TObject; var Action: TCloseAction);

begin
   action:=cafree; 
end;

procedure Tfrm_hcRK.tsaveClick(Sender: TObject);
var mation,mation1:string;
begin
   mation:='';
   mation1:='';
   if txtcsbh.text='' then
   begin
   messagedlg('供应商编号不能为空',mtinformation,[mbok],1);
   txtcsbh.SetFocus;
   txtcsbh.Color:=clskyblue;
   exit;
   end;
   if txthcmc.text='' then
   begin
   messagedlg('耗材名称不能为空',mtinformation,[mbok],1);
   txthcmc.SetFocus;
   txthcmc.Color:=clskyblue;
   exit;
   end;
  if txtjhdj.text='' then
   begin
   messagedlg('耗材单价不能为空',mtinformation,[mbok],1);
   txtjhdj.SetFocus;
   txtjhdj.Color:=clskyblue;
   exit;
   end;
   if txtjhsl.text='' then
   begin
   messagedlg('进货数量不能为空',mtinformation,[mbok],1);
   txtjhsl.SetFocus;
   txtjhsl.Color:=clskyblue;
   exit;
   end;
  { if txtlxr.text='' then
   begin
   messagedlg('联系人不能为空',mtinformation,[mbok],1);
   txtlxr.SetFocus;
   txtlxr.Color:=clskyblue;
   exit;
   end;}
   if editflag=1 then
   begin
   mation:='你需要修改此耗材入库信息吗';
   mation1:='此耗材入库 信息已经改变；';
   if messagedlg(mation,mtinformation,[mbyes,mbno],0)=mrno then
   begin
    screen.Cursor:=crDefault;
    exit;
   end;
   end
   else
   begin
   mation:='要增加新的耗材信息吗？';
   mation1:='此耗材信息已经入库；';
   if messagedlg(mation,mtinformation,[mbyes,mbno],0)=mrno then
   begin
    screen.Cursor:=crDefault;
    exit;
   end;
   end;
   with data do
   begin
   adoc1.BeginTrans;
   aq1.Connection:=adoc1;
   screen.Cursor:=crHourGlass;
   //编辑时
   if editflag=1 then
   begin