csda.pas

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

stringgrid1.Cells[8,0]:='E-mail';
stringgrid1.Cells[9,0]:='网址'; ;
stringgrid1.ColWidths[0]:=10;
stringgrid1.ColWidths[1]:=50;
stringgrid1.ColWidths[2]:=200;
stringgrid1.ColWidths[3]:=200;
stringgrid1.ColWidths[4]:=100;
stringgrid1.ColWidths[5]:=100;
stringgrid1.ColWidths[6]:=100;
stringgrid1.ColWidths[7]:=100;
stringgrid1.ColWidths[8]:=150;
stringgrid1.ColWidths[9]:=150;
aenabeld(0);
end;

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

begin
   action:=cafree; 
end;

procedure Tfrm_csda.tsaveClick(Sender: TObject);
var mation,mation1,mation2:string;
begin
   mation:='';
   mation1:='';
   mation:='要增加新的供应商吗？';
   mation2:='确定修改此客户内容吗？';
   if editflag=1 then
   begin
   mation1:='修改完毕';
   if messagedlg(mation2,mtinformation,[mbyes,mbno],0)=mrno then
   begin
   aenabeld(3);
    screen.Cursor:=crDefault;
    exit;
   end;
   end
   else
   begin
   mation1:='新供应商已入库';
   if messagedlg(mation,mtinformation,[mbyes,mbno],0)=mrno then
   begin
    aenabeld(3);
    screen.Cursor:=crDefault;
    exit;
   end;
   end;
   {if txtkhbh.text='' then
   begin
   messagedlg('供应商编号不能为空',mtinformation,[mbok],1);
   txtkhbh.SetFocus;
   txtkhbh.Color:=clskyblue;
   exit;
   end;}
   if txtkhmc.text='' then
   begin
   messagedlg('供应商名称不能为空',mtinformation,[mbok],1);
   txtkhmc.SetFocus;
   txtkhmc.Color:=clskyblue;
   exit;
   end;
   if txtlxr.text='' then
   begin
   messagedlg('联系人不能为空',mtinformation,[mbok],1);
   txtlxr.SetFocus;
   txtlxr.Color:=clskyblue;
   exit;
   end;
   with data do
   begin
   aq1.Connection:=adoc1;
   adoc1.BeginTrans;
   screen.Cursor:=crHourGlass;
   //编辑时
   if editflag=1 then
   begin
   aq1.Close;
   aq1.SQL.Clear;
   aq1.SQL.Add('delete from csda where csbh=:khbh');
   aq1.Parameters.ParamByName('khbh').Value:=trim(txtkhbh.text);
   aq1.ExecSQL;
   end
   else
   csbhcreate;
   aq1.Close;
   aq1.SQL.Clear;
   aq1.SQL.Add('insert into csda (csbh,csmc,lxr,phone,dz,fax,email,http,sfz) '+
              ' values (:khbh,:khmc,:lxr,:phone,:dz,:fax,:email,:http,:sfz)');
   aq1.Parameters.ParamByName('khbh').Value:=trim(txtkhbh.text);
   aq1.Parameters.ParamByName('khmc').Value:=trim(txtkhmc.text);
   aq1.Parameters.ParamByName('lxr').Value:=trim(txtlxr.text);
   aq1.Parameters.ParamByName('phone').Value:=trim(txtphone.text);
   aq1.Parameters.ParamByName('dz').Value:=trim(txtdz.text);
   aq1.Parameters.ParamByName('fax').Value:=trim(txtfax.text);
   aq1.Parameters.ParamByName('email').Value:=trim(txtemail.text);
   aq1.Parameters.ParamByName('http').Value:=trim(txthttp.text);
   aq1.Parameters.ParamByName('sfz').Value:=trim(txtsfz.text);
   aq1.ExecSQL;
   {if messagedlg(mation,mtinformation,[mbyes,mbno],0)=mrno then
   begin
   adoc1.RollbackTrans;
   screen.Cursor:=crDefault;
   exit;
   end;}
   adoc1.CommitTrans;
   messagedlg(mation1,mtinformation,[mbyes],1);
   editflag:=0;
   khreflesh;
   screen.Cursor:=crDefault;
   end;
   aenabeld(3);
end;

procedure Tfrm_csda.khreflesh;
var i:integer;
begin
for i:=1 to stringgrid1.RowCount-1 do
begin
stringgrid1.Rows[i].Clear;
end;
with data do
begin
aq1.Connection:=adoc1;
aq1.Close;
aq1.SQL.Clear;
aq1.SQL.Add('select * from csda order by csbh');
aq1.Open;
if aq1.Recordset.RecordCount=0 then exit;
stringgrid1.RowCount:=aq1.Recordset.RecordCount+1;
frm_csda.StatusBar1.Panels[1].Text:=inttostr(aq1.Recordset.RecordCount);
stringgrid1.Font.Color:=clblack;
while not aq1.Eof do
begin
for i:=1 to stringgrid1.RowCount do
begin
stringgrid1.Cells[1,i]:=aq1.Fields.fieldbyname('csbh').Value;
stringgrid1.Cells[2,i]:=aq1.Fields.fieldbyname('csmc').Value;
stringgrid1.Cells[3,i]:=aq1.Fields.fieldbyname('dz').Value;
stringgrid1.Cells[4,i]:=aq1.Fields.fieldbyname('sfz').Value;
stringgrid1.Cells[5,i]:=aq1.Fields.fieldbyname('lxr').Value;
stringgrid1.Cells[6,i]:=aq1.Fields.fieldbyname('phone').Value;
stringgrid1.Cells[7,i]:=aq1.Fields.fieldbyname('fax').Value;
stringgrid1.Cells[8,i]:=aq1.Fields.fieldbyname('email').Value;
stringgrid1.Cells[9,i]:=aq1.Fields.fieldbyname('http').Value;
aq1.Next;
end;
txtkhbh.Text:=stringgrid1.Cells[1,1];
txtkhmc.Text:=stringgrid1.Cells[2,1];
txtdz.Text:=stringgrid1.Cells[3,1];
txtsfz.Text:=frm_csda.stringgrid1.Cells[4,1];
txtlxr.Text:=frm_csda.stringgrid1.Cells[5,1];
txtphone.Text:=stringgrid1.Cells[6,1];
txtfax.Text:=stringgrid1.Cells[7,1];
txtemail.Text:=stringgrid1.Cells[8,1];
txthttp.Text:=stringgrid1.Cells[9,1];
end;
aq1.Close;
end;
end;

procedure Tfrm_csda.tdelClick(Sender: TObject);
begin
if (stringgrid1.Focused) and (stringgrid1.Cells[1,mycell]<>'') and (mycell<>0) then
begin
if messagedlg('确定删除此供应商吗？',mtinformation,[mbyes,mbno],0)=mrno then
  begin  
  exit;
  end;
with data do
begin
adoc1.BeginTrans;
aq1.Connection:=adoc1;
aq1.Close;
aq1.SQL.Clear;
aq1.SQL.Add('delete from csda where csbh=:khbh');
aq1.Parameters.ParamByName('khbh').Value:=stringgrid1.Cells[1,mycell];
try
{if messagedlg('确定删除此供应商吗？',mtinformation,[mbyes,mbno],0)=mrno then
  begin
  adoc1.RollbackTrans;
  exit;
  end;}
   aq1.ExecSQL;
   adoc1.CommitTrans;
   messagedlg('此供应商已删除库',mtinformation,[mbyes],1);
   khreflesh;
except
   showmessage('数据库连接错误');
   end;
end;
end
else
begin
showmessage('请选择纪录');
exit;
end;
end;
procedure Tfrm_csda.teditClick(Sender: TObject);
begin
if (stringgrid1.Focused) and (stringgrid1.Cells[1,mycell]<>'') and (mycell<>0) then
begin
aenabeld(1);
editflag:=1;
txtkhbh.Text:=stringgrid1.Cells[1,mycell];
txtkhmc.Text:=stringgrid1.Cells[2,mycell];
txtdz.Text:=stringgrid1.Cells[3,mycell];
txtsfz.Text:=frm_csda.stringgrid1.Cells[4,mycell];
txtlxr.Text:=frm_csda.stringgrid1.Cells[5,mycell];
txtphone.Text:=stringgrid1.Cells[6,mycell];
txtfax.Text:=stringgrid1.Cells[7,mycell];
txtemail.Text:=stringgrid1.Cells[8,mycell];
txthttp.Text:=stringgrid1.Cells[9,mycell];
txtkhmc.SetFocus;
end
else
begin
showmessage('请选择纪录');
exit;
end;
end;
procedure Tfrm_csda.StringGrid1SelectCell(Sender: TObject; ACol,
  ARow: Integer; var CanSelect: Boolean);
begin
mycell:=arow;
if (stringgrid1.Focused) and (arow<>0) then
begin
txtkhbh.Text:=stringgrid1.Cells[1,arow];
txtkhmc.Text:=stringgrid1.Cells[2,arow];
txtdz.Text:=stringgrid1.Cells[3,arow];
txtsfz.Text:=frm_csda.stringgrid1.Cells[4,arow];
txtlxr.Text:=frm_csda.stringgrid1.Cells[5,arow];
txtphone.Text:=stringgrid1.Cells[6,arow];
txtfax.Text:=stringgrid1.Cells[7,arow];
txtemail.Text:=stringgrid1.Cells[8,arow];
txthttp.Text:=stringgrid1.Cells[9,arow];
end;
end;

procedure Tfrm_csda.txtfaxExit(Sender: TObject);
begin
if not txtfax.Focused then
txtfax.Color:=clwindow;
end;

procedure Tfrm_csda.txtemailExit(Sender: TObject);
begin
if not txtemail.Focused then
txtemail.Color:=clwindow;
end;

procedure Tfrm_csda.txthttpExit(Sender: TObject);
begin
if not txthttp.Focused then
txthttp.Color:=clwindow;
end;

procedure Tfrm_csda.txtkhbhMouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
txtkhbh.Color:=clskyblue;
end;

procedure Tfrm_csda.TXTsfzKeyPress(Sender: TObject; var Key: Char);
begin
if key=#13 then
begin
txtsfz.Color:=clskyblue;
tsave.Click;
end;
end;

procedure Tfrm_csda.TXTsfzExit(Sender: TObject);
begin
if not txtsfz.Focused then
txtsfz.Color:=clwindow;
end;

procedure Tfrm_csda.txtcsrqKeyPress(Sender: TObject; var Key: Char);
begin
if key=#13 then
   begin
   txtphone.SetFocus;
   txtphone.Color:=clskyblue;
   end;
end;

procedure Tfrm_csda.txtfaxKeyPress(Sender: TObject; var Key: Char);
begin
if key=#13 then
   begin
   txtemail.SetFocus;
   txtemail.Color:=clskyblue;
   end;
end;

procedure Tfrm_csda.txtemailKeyPress(Sender: TObject; var Key: Char);
begin
 if key=#13 then
   begin
   txthttp.SetFocus;
   txthttp.Color:=clskyblue;
   end;
end;

procedure Tfrm_csda.tcancelClick(Sender: TObject);
begin
aenabeld(3);
end;

procedure Tfrm_csda.txthttpKeyPress(Sender: TObject; var Key: Char);
begin
if key=#13 then
   begin
   txtsfz.SetFocus;
   txtsfz.Color:=clskyblue;
   end;
end;

procedure Tfrm_csda.tfindClick(Sender: TObject);
begin
khreflesh;
end;

procedure Tfrm_csda.csbhcreate;
var s,s1,s2,s3,csbh:string;
    i,k,j:integer;
begin
editflag:=0;
screen.Cursor:=crDefault;
with data do
begin
  aq2.Connection:=adoc1;
   aq2.Close;
   aq2.SQL.Clear;
   aq2.sql.Add('select csbh from csda  order by csbh');
   aq2.open;
   if aq2.Recordset.RecordCount=0 then
         begin
          csbh:='2001';
          end
        else
           begin
           aq2.Last;
           csbh:=inttostr(strtoint(trim(aq2.Fields.Fieldbyname('csbh').value))+1);
        end;
        txtkhbh.text:=csbh;
        end;
end;

end.