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

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

医药行业

开发平台：

Delphi

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