hcckd.pas

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

unit HCCKD;

interface

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

type
  Tfrm_HCCKD = class(TForm)
    GroupBox1: TGroupBox;
    Label1: TLabel;
    Label2: TLabel;
    Label3: TLabel;
    Label4: TLabel;
    txtjhdh: TEdit;
    txtzdrq: TEdit;
    txtczybh: TEdit;
    txtczymc: TEdit;
    txtshflag: TEdit;
    ToolBar2: TToolBar;
    tadd: TToolButton;
    tdel: TToolButton;
    tedit: TToolButton;
    tup: TToolButton;
    tdown: TToolButton;
    tfind: TToolButton;
    tprint: TToolButton;
    tcheck: TToolButton;
    StringGrid1: TStringGrid;
    ImageList1: TImageList;
    Label6: TLabel;
    txtcsbh: TComboBox;
    Label5: TLabel;
    txtpc: TEdit;
    Label7: TLabel;
    Label8: TLabel;
    txtbm: TComboBox;
    txtyg: TComboBox;
    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;
    procedure bmcreate;
    procedure ygcreate;

    procedure txtbmChange(Sender: TObject);
  private
    { Private declarations }
  public
   number:array of string;
   mainnumber,nownumber:integer;
   cell:integer;
   procedure loaddata(key:string);
    { Public declarations }
  end;

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

implementation

uses  date1,  pubmotion,  sprcdedit, sprcdcx, sprcdnew, hcckdnew, hcckdcx,
  HCCKedit, sprcd;

{$R *.dfm}
function aeanbled(key:integer):boolean;
var i:integer;
begin
   with frm_HCCKD 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;
    bmcreate;
    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_HCCKD.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
        showmessage('供应商不能为空');
        txtcsbh.SetFocus;
        exit;
        end;
       if txtbm.itemindex<=0 then
        begin
        showmessage('部门不能为空');
        txtbm.SetFocus;
        exit;
        end;
        if (txtyg.itemindex<=0) then
        begin
        showmessage('领用人不能为空');
        txtyg.SetFocus;
        exit;
        end;
     if (txtcsbh.itemindex>0) and (txtbm.itemindex>0)  and (txtyg.ItemIndex>0) then
        begin
         //新品入场单
         frm_hcckdnew:=tfrm_hcckdnew.Create(application);
         frm_hcckdnew.ShowModal;
         end;
    end;
    end;
end;

procedure Tfrm_HCCKD.FormClose(Sender: TObject; var Action: TCloseAction);
begin
   action:=cafree;
end;
procedure Tfrm_HCCKD.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_HCCKD.nownumber=frm_HCCKD.mainnumber-1  then
         begin
           loaddata(number[nownumber]);
           showmessage('这是满足条件的最后一条纪录');
           exit;
           end
       else
       if frm_HCCKD.nownumber<frm_HCCKD.mainnumber-1  then
           loaddata(number[nownumber]);
    end;

end;
procedure Tfrm_HCCKD.tupClick(Sender: TObject);
var i,k:integer;
     flag:boolean;
     mation,mation1,sqlinsert1,sqlinsert2,sq1edit1,sq1edit2:string;
begin
  sqlinsert1:=' insert into hcckd0 (lydh,csbh,czybh,zdrq,flag,bmbh,ygbh)'+
              ' values (:lydh,:csbh,:czybh,:zdrq,:flag,:bmbh,:ygbh)';
  sqlinsert2:=' insert into hcckd1 (lydh,hcbh,lysl,jhdj,lyje,pc)'+
              ' values (:lydh,:hcbh,:lysl,:jhdj,:lyje,:pc)';
  sq1edit1:=  ' delete   from hcckd0  where lydh=:lydh ';
  sq1edit2:=  ' delete   from hcckd1  where lydh=:lydh ';
  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;