pubmotion.~pas

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

unit pubmotion;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, Menus, StdActns, ActnList, ExtCtrls, StdCtrls, ToolWin, ComCtrls,
  Buttons,   Grids,ImgList;
var user,username,passwords,czymc,bmmc,dlmc,xlmc,csmc,spmc,cdmc:string;
    rw,price,prin,sh,sumnumber:integer;
    btruning, close0:boolean;
    menu1,power,rwpower,prinpower,shpower:array of string;
procedure openform(formclass:tformclass;var frm;aowner:tcomponent);
function ghscreate: string;
function csxxtzcreate: string;
function csztcreate: string;
function xprcdcreate:string;
function checkinput(state:string;str:string):boolean;
function spxxtzcreate:string;
function gxxzcreate:string;
function spztcreate:string;
function spxztzcreate:string;
function spzltzcreate:string;
function SmallTOBig(small:real):string;
function  getstringgridedit(vstringgrid:tstringgrid):tedit;
function  fkdh:string;
function  jhdh:string;
function  xsdh:string;
function  htdh:string;
procedure powercheck(str:string);
function  checkprin(str:string):boolean;
function  checkrw(str:string):boolean;
function  checksh(str:string):boolean;



implementation

uses  date1, main;
//判断打印
function  checkprin(str:string):boolean;
var i:integer;
begin
for i:=0 to sumnumber-1 do
   begin
   if trim(menu1[i])=str then
      if prinpower[i]='0' then
         checkprin:=false;
   end;
end;
function  checkrw(str:string):boolean;
var i:integer;
begin
for i:=0 to sumnumber-1 do
   begin
   if trim(menu1[i])=str then
      if rwpower[i]='0' then
         checkrw:=false;
   end;
end;
function  checksh(str:string):boolean;
var i:integer;
begin
for i:=0 to sumnumber-1 do
   begin
   if trim(menu1[i])=str then
      if shpower[i]='0' then
         checksh:=false;
   end;
end;
procedure  powercheck(str:string);
var  number,i,j,k,h:integer;
begin
  with data do
  begin
  aq1.Connection:=adoc1;
  aq1.Close;
  aq1.sql.clear;
  aq1.SQL.Add(' select t1.czybh,t2.menucode,t2.menuword,t3.price,'+
              ' t3.rw,t3.prin,t3.sh from czyda t1,userpower t3,menulist '+
              ' t2 where t1.czybh=t3.czybh and t2.menucode=t3.menucode'+
              ' and t1.czybh='''+str+'''');
 aq1.Open;
 if aq1.Recordset.RecordCount>0 then
 begin
 sumnumber:=aq1.Recordset.RecordCount;
 setlength(menu1,sumnumber);
 setlength(power,sumnumber);
 setlength(rwpower,sumnumber);
 setlength(prinpower,sumnumber);
 setlength(shpower,sumnumber);
// 把每个功能变成一格数组
 while not aq1.Eof do
 begin
   for i:=0 to sumnumber-1 do
   begin
   menu1[i]:=trim(aq1.Fields.Fieldbyname('menuword').Value);
   power[i]:=inttostr(aq1.Fields.Fieldbyname('price').Value);
   rwpower[i]:=inttostr(aq1.Fields.Fieldbyname('rw').Value);
   prinpower[i]:=inttostr(aq1.Fields.Fieldbyname('prin').Value);
   shpower[i]:=inttostr(aq1.Fields.Fieldbyname('sh').Value);
   //检查功能
   for j:=0 to frm_main.MainMenu1.Items.Count-1 do
   begin
    if menu1[i]=frm_main.MainMenu1.Items[j].Name then
       begin
       if power[i]='1' then
       frm_main.MainMenu1.Items[j].Visible:=true
       else
       frm_main.MainMenu1.Items[j].Visible:=false;
       end;
       //检查子功能
      for k:=0 to frm_main.MainMenu1.Items[j].Count-1 do
       if menu1[i]=frm_main.MainMenu1.Items[j].Items[k].Name then
        begin
         if power[i]='1' then
         frm_main.MainMenu1.Items[j].Items[k].Visible:=true
         else
         frm_main.MainMenu1.Items[j].Items[k].Visible:=false;
        end;
   end;
   aq1.Next;
   end;
   end;
end;
end;
end;
function checkinput(state:string;str:string):boolean;
begin           //操作员信息核查
 with data do
  begin
    if state='cdbh'   then
    begin
        aq2.connection:=adoc1;
            with aq2 do
              begin
                close;
                sql.clear;
                sql.add('select cdmc from cdda where cdbh=:cdbh');
                aq2.parameters.ParamByName('cdbh').value:=str;
                aq2.open;
                if aq2.recordcount>0 then
                begin
                  czymc:=aq2.fields.fieldbyname('cdmc').value;
                  checkinput:=true;
                end;
                 checkinput:=false;
              end;
        end
    else if  state='czybh' then
        begin
            aq2.connection:=adoc1;
            with aq2 do
              begin
                close;
                sql.clear;
                sql.add('select czymc from czyda where czybh=:czybh');
                aq2.parameters.ParamByName('czybh').value:=str;
                aq2.open;
                if aq2.recordcount>0 then
                begin
                  czymc:=aq2.fields.fieldbyname('czymc').value;
                  checkinput:=true;
                end;
                checkinput:=false;
              end;
        end
     else if state='bmbh' then  //部门
        begin
            aq2.connection:=adoc1;
            with aq2 do
              begin
                close;
                sql.clear;
                sql.add('select bmmc from bm where bmbh=:bmbh');
                aq2.parameters.ParamByName('bmbh').value:=str;
                aq2.open;
                if aq2.recordcount>0 then
                begin
                  bmmc:=aq2.fields.fieldbyname('bmmc').value;
                  checkinput:=true;
                end;
                checkinput:=false;
              end;
        end
        //大类
     else if state='dlbh' then
        begin
            aq2.connection:=adoc1;
            with aq2 do
              begin
                close;
                sql.clear;
                sql.add('select dlmc from dl where dlbh=:dlbh');
                aq2.parameters.ParamByName('dlbh').value:=str;
                aq2.open;
                if aq2.recordcount>0 then
                begin
                  dlmc:=aq2.fields.fieldbyname('dlmc').value;
                  checkinput:=true;
                end
                else
                begin
                  checkinput:=false;
                  showmessage('此大类不存在');
                end;
              end;
        end
      else if state='xlbh' then
        begin
            aq2.connection:=adoc1;
            with aq2 do
              begin
                close;
                sql.clear;
                sql.add('select xlmc from xl where xlbh=:xlbh');
                aq2.parameters.ParamByName('xlbh').value:=str;
                aq2.open;
                if aq2.recordcount>0 then
                begin
                  xlmc:=aq2.fields.fieldbyname('xlmc').value;
                  checkinput:=true;
                end;
                  checkinput:=false;
              end;
        end
     else if state='spbh' then
        begin
            aq2.connection:=adoc1;
            with aq2 do
              begin
                close;
                sql.clear;
                sql.add('select spmc from spda where spbh=:czybh');
                aq2.parameters.ParamByName('czybh').value:=str;
                aq2.open;
                if aq2.recordcount>0 then
                begin
                  spmc:=aq2.fields.fieldbyname('spmc').value;
                  checkinput:=true;
                end;
                checkinput:=false;
              end;
        end
     else if state='csbh' then
        begin
            aq2.connection:=adoc1;
            with aq2 do
              begin
                close;
                sql.clear;
                sql.add('select csmc from csda where csbh=:csbh');
                aq2.parameters.ParamByName('csbh').value:=str;
                aq2.open;
                if aq2.recordcount>0 then
                begin
                  csmc:=aq2.fields.fieldbyname('csmc').value;
                  checkinput:=true;
                end;
                checkinput:=false;
              end;
        end;
end;
end;
procedure openform(formclass:tformclass;var frm;aowner:tcomponent);
var i,j,k:integer;
    child:tform;
begin
   close0:=true;
if not  frm_main.ToolBar1.Visible then
   frm_main.ToolBar1.Visible:=true;
for i:=0 to screen.formcount-1 do
    if screen.Forms[i].ClassType=formclass then
      begin
          child:=screen.Forms[i];
      for k:=0 to frm_main.TabControl1.Tabs.Count-1 do
          if frm_main.TabControl1.tabs.Strings[k]=child.Caption then
             frm_main.TabControl1.TabIndex:=k;
          showwindow(child.Handle,SW_MAXIMIZE);
      if not child.Showing then child.Visible:=true;
          child.BringToFront;
          exit;
      end;
      child:=tform(formclass.NewInstance);
      tform(frm):=child;
      child.create(aowner);
      {child.Top:=frm_main.Top;
      child.Left:=frm_main.Left;
      child.ClientWidth:=frm_main.ClientWidth;
      child.ClientHeight:=frm_main.ClientHeight;}
      j:=frm_main.TabControl1.Tabs.Count-1;
      frm_main.TabControl1.Tabs.Add(trim(child.Caption));
      frm_main.TabControl1.TabIndex:=j+1;
      btruning:=false;
end;
function spzltzcreate:string;
var s1,s2,s3:string;
    j, i,k:integer;
begin
    s1:='TZ';
  with data do
    begin
    aq2.Connection:=adoc1;
    with aq2 do
    begin
    close;
    sql.Clear;
    sql.add('select * from zlbhtzd where convert(char(10),date,120)=:date order by date');
    aq2.Parameters.ParamByName('date').value:=FormatDateTime('yyyy-mm-dd ',now);
    open;
    aq2.Last;
    if aq2.RecordCount>0 then
      begin
      s2:=copy(fieldbyname('djbh').AsString,11,3);
      k:=strtoint(s2);
      j:=k+1;
      i:=length(inttostr(j));
      case i of
      1: s3:='00'+inttostr(j);
      2: s3:='0'+inttostr(j);
      3: s3:=inttostr(j);
      end;
     spzltzcreate:=copy(fieldbyname('djbh').AsString,1,10)+s3;
      end
     else
     spzltzcreate:=s1+'01'+FormatDateTime('yy',now)+FormatDateTime('mm',now)+FormatDateTime('dd',now)+'001';
     end;
     end;
end;
function spztcreate:string;
var s1,s2,s3:string;
    j, i,k:integer;
begin
    s1:='TP';
  with data do
    begin
    aq2.Connection:=adoc1;
    with aq2 do
    begin
    close;
    sql.Clear;
    sql.add('select * from spzttzd where convert(char(10),tzrq,120)=:date order by tzrq');
    aq2.Parameters.ParamByName('date').value:=FormatDateTime('yyyy-mm-dd ',now);
    open;
    aq2.Last;
    if aq2.RecordCount>0 then
      begin
      s2:=copy(fieldbyname('djbh').AsString,11,3);
      k:=strtoint(s2);
      j:=k+1;
      i:=length(inttostr(j));
      case i of
      1: s3:='00'+inttostr(j);
      2: s3:='0'+inttostr(j);
      3: s3:=inttostr(j);
      end;
     spztcreate:=copy(fieldbyname('djbh').AsString,1,10)+s3;
      end
     else
     spztcreate:=s1+'01'+FormatDateTime('yy',now)+FormatDateTime('mm',now)+FormatDateTime('dd',now)+'001';
     end;
     end;
end;
function spxztzcreate:string;
var s1,s2,s3:string;
    j, i,k:integer;
begin
    s1:='XZ';
  with data do
    begin
    aq2.Connection:=adoc1;
    with aq2 do
    begin
    close;
    sql.Clear;
    sql.add('select * from spxztzd where convert(char(10),tzrq,120)=:tzrq order by tzrq');
    aq2.Parameters.ParamByName('tzrq').value:=FormatDateTime('yyyy-mm-dd ',now);
    open;
    aq2.Last;
    if aq2.RecordCount>0 then
      begin
      s2:=copy(fieldbyname('djbh').AsString,11,3);
      k:=strtoint(s2);
      j:=k+1;
      i:=length(inttostr(j));
      case i of
      1: s3:='00'+inttostr(j);
      2: s3:='0'+inttostr(j);
      3: s3:=inttostr(j);
      end;
     spxztzcreate:=copy(fieldbyname('djbh').AsString,1,10)+s3;
      end
     else
     spxztzcreate:=s1+'01'+FormatDateTime('yy',now)+FormatDateTime('mm',now)+FormatDateTime('dd',now)+'001';
     end;
     end;
end;
function gxxzcreate:string;
var s1,s2,s3:string;
    j, i,k:integer;
begin
    s1:='GX';
  with data do
    begin
    aq2.Connection:=adoc1;
    with aq2 do
    begin
    close;
    sql.Clear;
    sql.add('select * from gxxztzd where convert(char(10),date,120)=:date order by date');