开通博客赚积分
发布资源赚积分
分类

源码开发语言/平台
当前位置：首页 > 源码/资料 > 行业应用 > 医药行业 > 查看源码
Upf.pas
资源名称：连锁药店源码.rar　[点击查看]
上传用户：jiete_yjc
上传日期：2010-02-11
资源大小：422k
文件大小：8k
源码类别：

医药行业

开发平台：

Delphi

Upf.pas：源码内容
  1. unit Upf;
  3. interface
  5. uses
  6.   Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  7.   Dialogs, StdCtrls, Grids, DBGridEh, ComCtrls, Buttons, 
  8.   DBLookupEh,upreview,udm, DBSumLst, DBCtrlsEh, sncCurrency, Mask;
  10. type
  11.   Tfpf = class(TForm)
  12.     DBGridEh1: TDBGridEh;
  13.     Label1: TLabel;
  14.     TabControl1: TTabControl;
  15.     TabControl2: TTabControl;
  16.     Label2: TLabel;
  17.     Label3: TLabel;
  18.     dw: TDBLookupComboboxEh;
  19.     Label4: TLabel;
  20.     Edit1: TEdit;
  21.     Label5: TLabel;
  22.     Label6: TLabel;
  23.     ren: TDBLookupComboboxEh;
  24.     Edit2: TEdit;
  25.     print: TCheckBox;
  26.     save: TBitBtn;
  27.     ret: TBitBtn;
  28.     Label7: TLabel;
  29.     Label8: TLabel;
  30.     sum1: TDBSumList;
  31.     sncCurrencyLabel1: TsncCurrencyLabel;
  32.     sf: TsncCurrencyEdit;
  33.     zq: TsncCurrencyEdit;
  34.     BitBtn3: TBitBtn;
  35.     procedure FormShow(Sender: TObject);
  36.     procedure DBGridEh1ColExit(Sender: TObject);
  37.     procedure saveClick(Sender: TObject);
  38.     procedure retClick(Sender: TObject);
  39.     procedure FormClose(Sender: TObject; var Action: TCloseAction);
  40.     procedure DBGridEh1KeyDown(Sender: TObject; var Key: Word;
  41.       Shift: TShiftState);
  42.     procedure sfExit(Sender: TObject);
  43.     procedure DBGridEh1ColEnter(Sender: TObject);
  44.     procedure dwChange(Sender: TObject);
  45.     procedure dwExit(Sender: TObject);
  46.     procedure renChange(Sender: TObject);
  47.     procedure BitBtn3Click(Sender: TObject);
  48.     procedure renExit(Sender: TObject);
  49.   private
  50.     function  check():boolean;
  52.     { Private declarations }
  53.   public
  54.     { Public declarations }
  55.   end;
  56.   var dwfilter:string;
  59. implementation
  61. {$R *.dfm}
  63. procedure Tfpf.FormShow(Sender: TObject);
  64. begin
  65.  // showmessage(inttostr(height));
  66.   try
  67.   adodm.tcr.Close;
  68.   adodm.tcr.Open;
  69.   except
  70.   showmessage('mistake;');
  71.   end;
  72.   dwfilter:= ' 出入<>1 and clientid>=0';
  73.   label3.caption:=datetimetostr(date());
  74.   adodm.tdw.Filter:=' 出入<>1 and clientid>=0' ;
  75.   adodm.tdw.Filtered:=true;
  76.   dw.Text:='顾客';
  77. end;
  79. procedure Tfpf.DBGridEh1ColExit(Sender: TObject);
  80. begin
  81.  if (trim(adodm.tcr.FieldByName('ypid').AsString)<>'') and (trim(adodm.tcr.FieldByName('数量').AsString)<>'')  then
  83.    if  adodm.tkc.Locate('ypid',adodm.tcr.Fieldvalues['ypid'],[])  then
  84.       begin
  85.        if adodm.tkc.FieldByName('数量').AsInteger<adodm.tcr.FieldByName('数量').AsInteger then
  86.         begin
  87.           showmessage('库存数量:'+adodm.tkc.FieldByName('数量').Asstring+'    不足以支付');
  88.           adodm.tcr.Edit;
  89.           adodm.tcr.FieldByName('数量').AsString:='';
  90.           dbgrideh1.col:=2;
  91.         end
  92.         else
  93.         begin
  94.         if  adodm.typzdk.Locate('id',adodm.tcr.Fieldvalues['ypid'],[]) then
  95.         begin
  96.         adodm.tcr.edit;
  97.         adodm.tcr.FieldByName('单价').Asfloat:=adodm.typzdk.fieldbyname('批发价').asfloat
  98.         end
  99.         else showmessage('发生错误，请手工录入该商品的单价');
  100.         end
  101.       end
  102.    else
  103.     begin
  104.     showmessage('该药品没有库存');
  105.     adodm.tcr.Edit;
  106.     adodm.tcr.FieldByName('药品简码').AsString:='';
  107.     dbgrideh1.col:=1;
  108.    end;
  111.   if (adodm.tcr.FieldByName('单价').AsString<>'') and  (adodm.tcr.FieldByName('数量').Asstring<>'') then
  112.     begin
  113.             adodm.tcr.edit;
  114.     adodm.tcr.FieldByName('金额').AsFloat:=adodm.tcr.FieldByName('数量').Asinteger*adodm.tcr.FieldByName('单价').Asfloat ;
  115.     end  ;
  119. end;
  124. function Tfpf.check: boolean;
  125. begin
  126.   result:=true;
  127.  if trim(dw.Text)='' then
  128.    begin
  129.     showmessage('请选择一个购药单位，如果没有出现在列表中，请添加！');
  130.     result:=false;
  131.     exit;
  132.     end;
  133.  if trim(ren.Text)='' then
  134.    begin
  135.     showmessage('请选择开票人，如果没有出现在列表中，请添加！');
  136.     result:=false;
  137.     exit;
  138.     end;
  140.  if adodm.tcr.RecordCount<=0 then
  141.    begin
  142.     showmessage('请录入销售的药品信息！');
  143.     result:=false;
  144.     exit;
  145.    end;
  146. end;
  148. procedure Tfpf.saveClick(Sender: TObject);
  149. begin
  150.  
  151.   if not check then
  152.   exit;
  153.   adodm.ctemp.Parameters.ParamValues['@lx']:='pf';
  154.   adodm.ctemp.Execute;
  155.   edit2.Text:=adodm.ctemp.Parameters.ParamValues['@bh'];
  156.     {GETbh}
  157.   adodm.tcr.First;
  158.   while not adodm.tcr.Eof do
  159.   begin
  160.     adodm.tcr.Edit;
  161.     adodm.tcr.FieldByName('编号').AsString:=trim(edit2.Text);
  162.     if trim(dw.Text)<>'' then
  163.     adodm.tcr.FieldByName('入库单位').AsInteger:=adodm.tdw.fieldbyname('clientid').AsInteger;
  164.     
  165.     adodm.tcr.FieldByName('开票人').Asinteger:=adodm.tyg.fieldbyname('ygid').Asinteger;
  166.     adodm.tcr.FieldByName('操作人').Asstring:=trim(edit1.Text);
  167.     adodm.tcr.FieldByName('类型').Asstring:='批发';
  168.     adodm.tcr.fieldbyname('出入').asboolean:=false;
  169.     adodm.tcr.FieldByName('日期').Asdatetime:=date;
  170.     
  171.     if adodm.tkc.Locate('ypid',adodm.tcr.FieldValues['ypid'],[]) then
  172.     begin
  173.       adodm.tkc.Edit;
  174.       adodm.tkc.FieldByName('数量').AsInteger:=adodm.tkc.FieldByName('数量').AsInteger-adodm.tcr.FieldByName('数量').AsInteger;
  175.       adodm.tkc.FieldByName('购进金额').Asfloat:=adodm.tkc.FieldByName('购进单价').Asfloat*adodm.tkc.FieldByName('数量').Asfloat;
  176.       adodm.tcr.FieldByName('成本金额').AsFloat:=adodm.tkc.FieldByName('购进单价').Asfloat*adodm.tcr.FieldByName('数量').Asfloat;
  177.       adodm.tkc.Post;
  178.     end  ;
  180.    adodm.tcr.Next;
  181.    end;
  182.    adodm.tcr.UpdateBatch();
  183.    dbgrideh1.Enabled:=false;
  184.    if print.Checked then
  185.    begin
  186.    fpreview.frrk.FindObject('memo27').Memo.Text:='开票人：'+ren.text;
  187.    fpreview.frrk.ShowReport;
  188.    fpreview.ShowModal;
  189.    fpreview.frrk.FindObject('memo27').Memo.Text:='经办人（签字）：'  ;
  190.    end;
  191.    save.Enabled:=false;
  196. end;
  198. procedure Tfpf.retClick(Sender: TObject);
  199. begin
  200.  dbgrideh1.Enabled:=true;
  201.  adodm.tcr.close;
  202.  adodm.tcr.Open;
  203.  edit2.Text:='';
  204.  save.Enabled:=true;
  205.  sf.Value:=0;
  206.  zq.Value:=0;
  207.  dw.Text:='顾客';
  208. end;
  210. procedure Tfpf.FormClose(Sender: TObject; var Action: TCloseAction);
  211. begin
  212. try
  213. adodm.tcr.CancelBatch();
  214. except
  215. showmessage('取消失败');
  216. end;
  217. try
  218. adodm.tcr.Close;
  219. except
  220. showmessage('关闭失败');
  221. end;
  222. action:=cafree;
  223. end;
  225. procedure Tfpf.DBGridEh1KeyDown(Sender: TObject; var Key: Word;
  226.   Shift: TShiftState);
  227. begin
  228. if (key=vk_down) and adodm.tcr.Eof   then
  229. BEGIN
  230.  sendmessage(dbgrideh1.Handle,wm_keydown,vk_tab,0); 
  231.  adodm.tcr.Append;
  232.  dbgrideh1.Col:=1;
  233. end;
  234. end;
  236. procedure Tfpf.sfExit(Sender: TObject);
  237. var aa:real;
  238. begin
  240. sum1.Activate(true);
  241. //showmessage(floattostr(sum1.SumCollection[0].SumValue));
  242. zq.Value:=0;
  243. if sf.Value=0 then
  244. begin
  245. exit;
  246. sum1.Active:=false;
  247. end;
  248. try
  249.   aa:=sf.Value;
  250.   aa:=aa-sum1.SumCollection[0].SumValue;
  251.   if aa<0 then
  252.   begin
  253.   showmessage('所付金额不足！！');
  254.   sf.SetFocus;
  255.   end
  256.   else
  257.   zq.value:=aa;
  259. except
  260.   sf.SetFocus;
  261. end;
  262.  sum1.Active:=false;
  264. end;
  266. procedure Tfpf.DBGridEh1ColEnter(Sender: TObject);
  267. begin
  268. sf.Value:=0;
  269. zq.Value:=0;
  270. end;
  272. procedure Tfpf.dwChange(Sender: TObject);
  273. begin
  274. if trim(dw.Text)<>'' then
  275.  begin
  276.   adodm.tdw.DisableControls;
  277.   adodm.tdw.filtered:=false;
  278.   adodm.tdw.Filter:='(简码 like '''+trim(dw.text)+'%'' and '+dwfilter+') or (名称 like '''+trim(dw.text)+'%'' and '+dwfilter+')';
  279.   //showmessage(adodm.tdw.Filter);
  280.   adodm.tdw.Filtered:=true;
  281.   adodm.tdw.EnableControls;
  282.  end
  283. else
  284.   adodm.tdw.Filter:=dwfilter;
  285.   adodm.tdw.Filtered:=true;
  286. end;
  288. procedure Tfpf.dwExit(Sender: TObject);
  289. begin
  290. if not adodm.tdw.Locate('名称',dw.Text,[]) then
  291. begin
  292.   dw.SetFocus;
  293.   showmessage('没有此单位，请重新录入！');
  294. end;
  295. end;
  297. procedure Tfpf.renChange(Sender: TObject);
  298. begin
  299. if trim(ren.Text)<>'' then
  300.  begin
  301.   adodm.tyg.DisableControls;
  302.   adodm.tyg.filtered:=false;
  303.   adodm.tyg.Filter:=' 姓名 like '''+trim(ren.text)+'%'' or '+'员工编号 like '''+trim(ren.text)+'%''';
  304.   //showmessage(adodm.tdw.Filter);
  305.   adodm.tyg.Filtered:=true;
  306.   adodm.tyg.EnableControls;
  307.  end
  308. else
  309.   adodm.tyg.Filtered:=false;
  311. end;
  313. procedure Tfpf.BitBtn3Click(Sender: TObject);
  314. begin
  315. close;
  316. end;
  317. procedure Tfpf.renExit(Sender: TObject);
  318. begin
  319.  if not adodm.tyg.Locate('姓名',ren.Text,[]) then
  320. begin
  321.   ren.SetFocus;
  322.   showmessage('没有此人，请重新录入！');
  323. end;
  324. end;
  326. end.