sprcd.pas

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

unit sprcd;

interface

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

type
  Tfrm_sprcd = class(TForm)
    GroupBox1: TGroupBox;
    Label1: TLabel;
    Label2: TLabel;
    Label3: TLabel;
    Label4: TLabel;
    txtjhdh: TEdit;
    txtzdrq: TEdit;
    txtczybh: TEdit;
    txtczymc: TEdit;
    txtshflag: TEdit;
    StringGrid1: TStringGrid;
    ImageList1: TImageList;
    Label5: TLabel;
    txtpc: TEdit;
    ToolBar2: TToolBar;
    tadd: TToolButton;
    tdel: TToolButton;
    tedit: TToolButton;
    tup: TToolButton;
    tdown: TToolButton;
    tcheck: TToolButton;
    GroupBox2: TGroupBox;
    Label9: TLabel;
    Label11: TLabel;
    Label12: TLabel;
    TXTYPBH: TEdit;
    TXTYPJX: TEdit;
    TXTSCCS: TEdit;
    Edit5: TEdit;
    ComboBox1: TComboBox;
    TXTJC: TEdit;
    Label10: TLabel;
    Label6: TLabel;
    TXTPYJM: TEdit;
    Label7: TLabel;
    Label8: TLabel;
    Label13: TLabel;
    TXTJHDJ: TEdit;
    TXTGG: TEdit;
    TXTYPMC: TEdit;
    Label14: TLabel;
    Label15: TLabel;
    Label16: TLabel;
    TXTPFDJ: TEdit;
    Label17: TLabel;
    TXTLSDJ: TEdit;
    Label18: TLabel;
    procedure taddClick(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure tdownClick(Sender: TObject);
    procedure tupClick(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure tcheckClick(Sender: TObject);
    procedure teditClick(Sender: TObject);
    procedure StringGrid1SelectCell(Sender: TObject; ACol, ARow: Integer;
      var CanSelect: Boolean);
    procedure tdelClick(Sender: TObject);
    procedure tfindClick(Sender: TObject);
    procedure Edit7Exit(Sender: TObject);
    procedure Edit9Exit(Sender: TObject);
    procedure Edit11Exit(Sender: TObject);
    procedure Edit13Exit(Sender: TObject);
    procedure Edit13Enter(Sender: TObject);
    procedure Edit7Enter(Sender: TObject);
    procedure Edit9Enter(Sender: TObject);
    procedure Edit11Enter(Sender: TObject);
    //procedure Edit7KeyPress(Sender: TObject; var Key: Char);
    procedure ComboBox1Change(Sender: TObject);
//    procedure Edit9KeyPress(Sender: TObject; var Key: Char);
//    procedure Edit11KeyPress(Sender: TObject; var Key: Char);
//    procedure Edit13KeyPress(Sender: TObject; var Key: Char);
    procedure Edit7Change(Sender: TObject);
    procedure txtczybhChange(Sender: TObject);
    procedure Edit9Change(Sender: TObject);
    procedure Edit11Change(Sender: TObject);
    procedure Edit13Change(Sender: TObject);
    procedure csbhcreate;
  private
    { Private declarations }
  public
   number:array of string;
   mainnumber,nownumber:integer;
   cell:integer;
   procedure loaddata(key:string);
    { Public declarations }
  end;

var
  frm_sprcd: Tfrm_sprcd;
  editflag:integer;//用来纪录所选择的行数

implementation

uses  date1,  pubmotion,  sprcdedit, sprcdcx, sprcdnew;

{$R *.dfm}
function aeanbled(key:integer):boolean;
var i:integer;
begin
   with frm_sprcd do
  begin
  //新增
  if key=4 then
  begin
    groupbox1.enabled:=true;
    tadd.Caption:='新增栏目';
    tdel.Caption:='删除栏目';
    tedit.Caption:='编辑栏目';
    tup.Caption:='保存退出';//
    tdown.Caption:='取消退出';
    tup.ImageIndex:=2;
    tdown.ImageIndex:=3;
    tfind.visible:=false;
    tprint.visible:=false;
    tcheck.visible:=false;
    txtjhdh.Clear;
    txtzdrq.Clear;
    txtczybh.Clear;
    txtczymc.clear;
    txtcsbh.clear;
    txtshflag.text:='0-未审核';
    txtpc.clear;
    txtzdrq.text:=formatdatetime('yyyy-mm-dd',now);
    txtczybh.text:=user;
    csbhcreate;
    for i:=1 to StringGrid1.RowCount-1 do
    begin
    stringgrid1.Rows[i].Clear;
    end;
    stringgrid1.RowCount:=2;
     //flag:=true;
  end
   //编辑状态
  else if key=1 then
  begin
    groupbox1.enabled:=true;
    tadd.Caption:='新增栏目';
    tdel.Caption:='删除栏目';
    tedit.Caption:='编辑栏目';
    tup.Caption:='保存退出';//
    tdown.Caption:='取消退出';
    tup.ImageIndex:=2;
    tdown.ImageIndex:=3;
    tfind.visible:=false;
    tprint.visible:=false;
    tcheck.visible:=false;
  end
  else  if key=2 then
  //浏览状态
  begin
    groupbox1.enabled:=false;
    tadd.Caption:=' 新增';
    tdel.Caption:=' 删除';
    tedit.Caption:=' 编辑';
    tup.Caption:=' 前页';
    tup.ImageIndex:=6;
    tdown.Caption:=' 后页';
    tdown.ImageIndex:=7;
    tfind.visible:=true;
    tprint.visible:=true;
    tcheck.visible:=true;
  end
  //取消
  else if key=3 then
  begin
    tadd.Caption:='新增';
    tdel.Caption:='删除';
    tedit.Caption:='编辑';
    tup.Caption:='前页';
    tup.ImageIndex:=6;
    tdown.Caption:='后页';
    tdown.ImageIndex:=7;
    tfind.visible:=true;
    tprint.visible:=true;
    tcheck.visible:=true;
    txtjhdh.Clear;
    txtzdrq.Clear;
    txtczybh.Clear;
    txtczymc.clear;
    txtcsbh.clear;
    txtshflag.text:='0-未审核';
    txtpc.clear;
    for i:=1 to StringGrid1.RowCount-1 do
    begin
    stringgrid1.Rows[i].Clear;
    end;
    stringgrid1.RowCount:=2;
  end
  else
   if key=0 then  //保存
  begin
    groupbox1.enabled:=false;
    tadd.Caption:='新增';
    tdel.Caption:='删除';
    tedit.Caption:='编辑';
    tup.Caption:='前页';
    tup.ImageIndex:=6;
    tdown.Caption:='后页';
    tdown.ImageIndex:=7;
    tfind.visible:=true;
    tprint.visible:=true;
    tcheck.visible:=true;
  end;
end;
end;
function pccreate(str:string):string;
begin
with data do
begin
 aq2.Connection:=adoc1;
 aq2.Close;
 aq2.SQL.Clear;
 aq2.SQL.Add('select pc  from hcda where hcbh='''+str+'''');
 aq2.Open;
 if aq2.Recordset.RecordCount>0 then
 begin
 pccreate:=trim(aq2.Fields.Fieldbyname('pc').Value);
 end
 else
 pccreate:='0';
end;
end;


procedure Tfrm_sprcd.taddClick(Sender: TObject);
var flag:boolean;
begin
    flag:=false;
    if trim(tadd.Caption)='新增' then
    begin
    aeanbled(4);//新增
    flag:=true;
    end;
    if not flag then
    begin
    if trim(tadd.Caption)='新增栏目' then
    begin
     if (txtcsbh.itemindex>0) then
        begin
         //新品入场单
         frm_sprcnew:=tfrm_sprcnew.Create(application);
         frm_sprcnew.ShowModal;
        end
     else
        begin
        showmessage('供应商不能为空');
        //txtcsbh.setfous;
        exit;
        end;
    end;
    end;
end;

procedure Tfrm_sprcd.FormClose(Sender: TObject; var Action: TCloseAction);
begin
   action:=cafree;
end;
procedure Tfrm_sprcd.tdownClick(Sender: TObject);
begin
 if trim(tdown.Caption)='取消退出' then
    begin
      aeanbled(3);
    end
 else
 if  trim(tdown.Caption)='后页'  then
    begin
       nownumber:=nownumber+1;
       if nownumber>=mainnumber  then
          begin
          nownumber:=mainnumber-1;
          showmessage('这是满足条件的最后一条纪录');
          exit
          end;
       if frm_sprcd.nownumber=frm_sprcd.mainnumber-1  then
         begin
           loaddata(number[nownumber]);
           showmessage('这是满足条件的最后一条纪录');
           exit;
           end
       else
       if frm_sprcd.nownumber<frm_sprcd.mainnumber-1  then
           loaddata(number[nownumber]);
    end;

end;
procedure Tfrm_sprcd.tupClick(Sender: TObject);
var i,k:integer;
     flag:boolean;
     mation,mation1,sqlinsert1,sqlinsert2,sq1edit1,sq1edit2:string;
begin
  sqlinsert1:=' insert into hcrkd0 (jhdh,csbh,czybh,zdrq,flag)'+
              ' values (:jhdh,:csbh,:czybh,:zdrq,:flag)';
  sqlinsert2:=' insert into hcrkd1 (jhdh,hcbh,jhsl,jhdj,jhje,pc)'+
              ' values (:jhdh,:hcbh,:jhsl,:jhdj,:jhje,:pc)';
  sq1edit1:=  ' delete   from hcrkd0  where jhdh=:jhdh ';
  sq1edit2:=  ' delete   from hcrkd1  where jhdh=:jhdh ';
  flag:=false;
if (trim(tup.Caption)='保存退出') and (stringgrid1.RowCount>=2) and (copy(txtshflag.text,1,1)='0') then
begin
    //耗材检查
    for i:=1 to stringgrid1.RowCount-2 do
     for k:=i+1 to stringgrid1.RowCount-2 do
     begin
       if stringgrid1.cells[1,i]=stringgrid1.cells[1,k] then
          begin
          showmessage('栏目中有重复的耗材编号,存盘失败');
          exit;
          end;
     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
   aq1.Close;
   aq1.SQL.Clear;
   aq1.SQL.Add('delete from hcrkd0 where jhdh=:jhdh');
   aq1.Parameters.ParamByName('jhdh').Value:=trim(txtjhdh.text);
   aq1.ExecSQL;
   aq1.Close;
   aq1.SQL.Clear;
   aq1.SQL.Add('delete from hcrkd1 where jhdh=:jhdh');
   aq1.Parameters.ParamByName('jhdh').Value:=trim(txtjhdh.text);
   aq1.ExecSQL;
   end
   else
   begin
   txtjhdh.text:=jhdh;
   end;
   //写入入库单一
   aq1.Close;
   aq1.SQL.Clear;
   aq1.SQL.Add(sqlinsert1);
   aq1.Parameters.ParamByName('jhdh').Value:=trim(txtjhdh.text);
   aq1.Parameters.ParamByName('csbh').Value:=copy(trim(frm_sprcd.txtcsbh.items[frm_sprcd.txtcsbh.itemindex]),1,4);
   //aq1.Parameters.ParamByName('pc').Value:=trim(txtpc.text);
   aq1.Parameters.ParamByName('zdrq').Value:=formatdatetime('yyyy-mm-dd',now);
   aq1.Parameters.ParamByName('czybh').Value:=trim(txtczybh.text);
   aq1.Parameters.ParamByName('flag').Value:=copy(trim(txtshflag.text),1,1);
   aq1.ExecSQL;
   //写入入库单二
   aq1.Close;
   aq1.SQL.Clear;
   aq1.SQL.Add(sqlinsert2);
   for i:=1 to stringgrid1.rowcount-1 do
   begin
   if stringgrid1.cells[1,i]<>'' then
   begin
   aq1.Parameters.ParamByName('jhdh').Value:=trim(txtjhdh.text);
   aq1.Parameters.ParamByName('hcbh').Value:=stringgrid1.cells[1,i];
   aq1.Parameters.ParamByName('jhsl').Value:=stringgrid1.cells[6,i];
   aq1.Parameters.ParamByName('jhdj').Value:=StrToCurr(stringgrid1.cells[5,i]);
   aq1.Parameters.ParamByName('jhje').Value:=StrToCurr(stringgrid1.cells[7,i]);
   if editflag=0 then
   stringgrid1.cells[8,i]:=inttostr(strtoint(pccreate(stringgrid1.Cells[1,i]))+1);
   aq1.Parameters.ParamByName('pc').Value:=stringgrid1.cells[8,i];
   aq1.ExecSQL;
   end;
   end;
   adoc1.CommitTrans;
   messagedlg(mation1,mtinformation,[mbyes],1);
   screen.Cursor:=crDefault;
   end;
   editflag:=0;
   //hcreflesh;
   aeanbled(2);
   end
 else
 if (trim(tup.Caption))='前页' then
    begin
    nownumber:=nownumber-1;
    if frm_sprcd.nownumber=0 then
       begin
         loaddata(number[nownumber]);
         showmessage('这是满足条件的第一条纪录');
         exit;
       end
    else if frm_sprcd.nownumber>0 then
         loaddata(number[nownumber])
    else
       begin
         nownumber:=0;
         showmessage('这是满足条件的第一条纪录');
         exit;
       end;
    end;
end;

procedure Tfrm_sprcd.FormCreate(Sender: TObject);
begin
    stringgrid1.ColCount:=9;
    stringgrid1.rowcount:=2;
    stringgrid1.ColWidths[0]:=10;
    stringgrid1.ColWidths[1]:=60;
    stringgrid1.ColWidths[2]:=150;
    stringgrid1.ColWidths[3]:=80 ;
    stringgrid1.ColWidths[4]:=80;
    stringgrid1.ColWidths[5]:=80;
    stringgrid1.ColWidths[6]:=80;
    stringgrid1.ColWidths[7]:=80;
    stringgrid1.ColWidths[8]:=80;
    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[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.cells[16,0]:= '保质期属性';
    stringgrid1.cells[17,0]:= '进货税率';
    stringgrid1.cells[18,0]:= '销售税率';
    stringgrid1.cells[19,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.FixedCols:=1;
    stringgrid1.FixedRows:=1;
    aeanbled(2);
end;
//审核
procedure Tfrm_sprcd.tcheckClick(Sender: TObject);