main.~pas

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

unit main;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, Buttons, ComCtrls, ToolWin, Menus, ExtCtrls, Grids, DBGrids,
  StdCtrls;

type
  Tfrm_main = class(TForm)
    MainMenu1: TMainMenu;
    jbzl: TMenuItem;
    hczl: TMenuItem;
    cszl: TMenuItem;
    N24: TMenuItem;
    zx: TMenuItem;
    tc: TMenuItem;
    rcyy: TMenuItem;
    hcys: TMenuItem;
    lyck: TMenuItem;
    N27: TMenuItem;
    kccx: TMenuItem;
    jxc: TMenuItem;
    xtgl: TMenuItem;
    bak: TMenuItem;
    tc1: TMenuItem;
    czyda: TMenuItem;
    Timer1: TTimer;
    StatusBar1: TStatusBar;
    BitBtn1: TBitBtn;
    ToolBar1: TToolBar;
    TabControl1: TTabControl;
    BitBtn2: TBitBtn;
    help: TMenuItem;
    dohelp: TMenuItem;
    about: TMenuItem;
    Button1: TButton;
    Button2: TButton;
    DBGrid1: TDBGrid;
    N3: TMenuItem;
    Button3: TButton;
    N5: TMenuItem;
    N6: TMenuItem;
    N9: TMenuItem;
    N13: TMenuItem;
    N7: TMenuItem;
    N8: TMenuItem;
    N14: TMenuItem;
    N15: TMenuItem;
    N16: TMenuItem;
    N17: TMenuItem;
    N18: TMenuItem;
    N10: TMenuItem;
    N11: TMenuItem;
    N12: TMenuItem;
    N19: TMenuItem;
    N20: TMenuItem;
    N21: TMenuItem;
    N22: TMenuItem;
    N23: TMenuItem;
    N25: TMenuItem;
    N26: TMenuItem;
    N28: TMenuItem;
    procedure TabControl1Change(Sender: TObject);
    procedure hczlClick(Sender: TObject);
    procedure ygdaClick(Sender: TObject);
    procedure cszlClick(Sender: TObject);
    procedure hcysClick(Sender: TObject);
    procedure lyckClick(Sender: TObject);
    procedure htglClick(Sender: TObject);
    procedure jxcClick(Sender: TObject);
    procedure gzglClick(Sender: TObject);
    procedure FormActivate(Sender: TObject);
    procedure systemlogo;
    procedure checkbj;
    procedure FormCreate(Sender: TObject);
    procedure BitBtn2Click(Sender: TObject);
    procedure aboutClick(Sender: TObject);
    procedure czydaClick(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure zxClick(Sender: TObject);
    procedure N2Click(Sender: TObject);
    procedure N4Click(Sender: TObject);
    procedure N3Click(Sender: TObject);
    procedure Button3Click(Sender: TObject);
    procedure N5Click(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);
    procedure bakClick(Sender: TObject);

    //procedure Timer1Timer(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  frm_main: Tfrm_main;
  btfirst:boolean;

implementation

uses pubmotion, HCXX, ygda, csda, HCRK, HCCK,  jxccx, YGGZ, date1,
  pass, hcbj, sprcd, HCCKD, czyda, passmodify, csht;

{$R *.dfm}
function qxcheck(str:string):boolean;
begin
  if str='1' then
  qxcheck:=true
  else
  qxcheck:=false;
end;  

procedure Tfrm_main.TabControl1Change(Sender: TObject);
var i,k:integer;
begin
k:=tabcontrol1.TabIndex;
for i:=0 to screen.FormCount-1 do
if screen.Forms[i].Caption=tabcontrol1.Tabs.Strings[k] then
      if screen.Forms[i].WindowState<>wsmaximized then
         showwindow(screen.Forms[i].Handle,sw_showmaximized); 
end;


procedure Tfrm_main.hczlClick(Sender: TObject);
begin
openform(tfrm_hcxx,frm_hcxx,self);
frm_hcxx.tprint.Enabled:=checkprin('hczl');
end;

procedure Tfrm_main.ygdaClick(Sender: TObject);
begin
openform(tfrmyg,frmyg,self);
end;

procedure Tfrm_main.cszlClick(Sender: TObject);
begin
openform(tfrm_csda,frm_csda,self);
end;

procedure Tfrm_main.hcysClick(Sender: TObject);
begin
openform(Tfrm_sprcd,frm_sprcd,self);
frm_sprcd.tprint.Enabled:=checkprin('hcys');
frm_sprcd.tadd.Enabled:=checkrw('hcys');
frm_sprcd.tedit.Enabled:=checkrw('hcys');
frm_sprcd.tdel.Enabled:=checkrw('hcys');
frm_sprcd.tcheck.Enabled:=checksh('hcys');
end;

procedure Tfrm_main.lyckClick(Sender: TObject);
begin
openform(tfrm_hcckd,frm_hcckd,self);
frm_hcckd.tprint.Enabled:=checkprin('lyck');
frm_hcckd.tadd.Enabled:=checkrw('lyck');
frm_hcckd.tedit.Enabled:=checkrw('lyck');
frm_hcckd.tdel.Enabled:=checkrw('lyck');
frm_hcckd.tcheck.Enabled:=checksh('lyck');
end;

procedure Tfrm_main.htglClick(Sender: TObject);
begin
openform(tfrm_htgl,frm_htgl,self);
frm_htgl.tprint.Enabled:=checkprin('htgl');
frm_htgl.tadd.Enabled:=checkrw('htgl');
frm_htgl.tedit.Enabled:=checkrw('htgl');
frm_htgl.tdel.Enabled:=checkrw('htgl');
frm_htgl.tcheck.Enabled:=checksh('htgl')
end;

procedure Tfrm_main.jxcClick(Sender: TObject);
begin
openform(tfrm_jxccx,frm_jxccx,self);
frm_jxccx.tprint.Enabled:=checkprin('jxc');
end;

procedure Tfrm_main.gzglClick(Sender: TObject);
begin
openform(TFRM_YGGZ,FRM_YGGZ,self);

end;
procedure Tfrm_main.FormActivate(Sender: TObject);
begin
if not btfirst then
  exit;
  systemlogo;
end;
procedure Tfrm_main.systemlogo;
begin
try
frm_pass:=tfrm_pass.create(application);
frm_pass.showmodal;
if frm_pass.ModalResult<>mrok then
   application.Terminate;
checkbj;
//frm_main.StatusBar1.Panels[1].Text:='当前用户：'+username+'正在运行';
finally
frm_pass.free;
frm_pass:=nil;
btfirst:=false;
end;
end;
procedure Tfrm_main.checkbj;
var i:integer;
     s,khmc,dh,lxr,csrq:string;
begin
with data do
begin
//ado4.Connection:=adoc1;
aq1.Connection:=adoc1;
aq1.Close;
aq1.SQL.clear;
aq1.SQL.Add('select a.csbh as 厂商编号,a.csmc as 厂商名称,'+
'b.hcbh as 耗材编号,b.hcmc as 耗材名称,b.jldw as 单位,b.gg as 规格,'+
'b.dqkc as 总库存,b.aqkc as 安全库存  from hcda b,csda a where b.dqkc<=b.aqkc and b.csbh=a.csbh' );
//aq1.Parameters.ParamByName('jrsj').Value:=copy(formatdatetime('yyyy-mm-dd',now+3),6,5);
aq1.Open;
if aq1.Recordset.RecordCount>0 then
begin
frm_hcbj:=tfrm_hcbj.Create(application);
frm_hcbj.Show;
data.DataSource1.DataSet:=data.Aq1;
frm_hcbj.dbgrid1.DataSource:=data.DataSource1;
aq1.FieldByName('厂商编号').DisplayWidth:=4;
aq1.FieldByName('厂商名称').DisplayWidth:=30;
aq1.FieldByName('耗材编号').DisplayWidth:=4;
aq1.FieldByName('耗材名称').DisplayWidth:=30;
aq1.FieldByName('单位').DisplayWidth:=4;
aq1.FieldByName('规格').DisplayWidth:=4;
aq1.FieldByName('总库存').DisplayWidth:=4;
aq1.FieldByName('安全库存').DisplayWidth:=4;  

end;
{begin
s:=aq1.Fields.FieldByName('jrmc').Value;
messagedlg('还差三天就是：'+s+'即'+formatdatetime('yyyy-mm-dd',now+3)+'准备好礼物',mtinformation,[mbok],1);
end;
aq1.Close;
aq1.SQL.clear;
aq1.SQL.Add('select * from hcda where ' );
aq1.Open;
if aq1.Recordset.RecordCount>0 then
begin
while not aq1.Eof do
begin
if copy(aq1.Fields.Fieldbyname('csrq').value,6,5)=copy(formatdatetime('yyyy-mm-dd',now+3),6,5) then
begin
khmc:=aq1.Fields.FieldByName('khmc').Value;
lxr:=aq1.Fields.FieldByName('lxr').Value;
dh:=aq1.Fields.FieldByName('phone').Value;
csrq:=copy(aq1.Fields.FieldByName('csrq').Value,6,5);
messagedlg('还差三天就是：'+khmc+'-'+dh+'-'+lxr+':'+csrq+'即'+formatdatetime('yyyy-mm-dd',now+3)+'准备好礼物',mtinformation,[mbok],1);
end;
aq1.Next;
end;
end;
ado4.Close;
ado4.SQL.clear;
ado4.SQL.Add('select b.khmc,a.ksrq,a.zzrq,b.lxr,'+
'c.clmc,a.cllx,a.cph,b.khbh,c.clbh,b.dz,b.phone,b.email,b.fax '+
'from bjsz2 a,khda b,clda c '+
'where a.khbh=b.khbh and a.clbh=c.clbh and a.zzrq=:zzrq' );
ado4.Parameters.ParamByName('zzrq').Value:=formatdatetime('yyyy-mm-dd',now);
ado4.Open;
if ado4.Recordset.RecordCount>0 then
begin
form1:=tform1.create(application);
form1.StringGrid1.RowCount:=ado4.Recordset.RecordCount+1;
while not ado4.Eof do
begin
for i:=1 to form1.StringGrid1.RowCount-1 do
begin
form1.StringGrid1.Cells[1,i]:=ado4.Fields.Fieldbyname('khbh').Value;
form1.StringGrid1.Cells[2,i]:=ado4.Fields.Fieldbyname('khmc').Value;
form1.StringGrid1.Cells[3,i]:=ado4.Fields.Fieldbyname('ksrq').Value;
form1.StringGrid1.Cells[4,i]:=ado4.Fields.Fieldbyname('clbh').Value;
form1.StringGrid1.Cells[4,i]:=ado4.Fields.Fieldbyname('clmc').Value;
form1.StringGrid1.Cells[5,i]:=ado4.Fields.Fieldbyname('cllx').Value;
form1.StringGrid1.Cells[6,i]:=ado4.Fields.Fieldbyname('cph').Value;
form1.StringGrid1.Cells[7,i]:=ado4.Fields.Fieldbyname('khbh').Value;
form1.StringGrid1.Cells[8,i]:=ado4.Fields.Fieldbyname('lxr').Value;
form1.StringGrid1.Cells[9,i]:=ado4.Fields.Fieldbyname('phone').Value;
form1.StringGrid1.Cells[10,i]:=ado4.Fields.Fieldbyname('fax').Value;
form1.StringGrid1.Cells[11,i]:=ado4.Fields.Fieldbyname('dz').Value;
form1.StringGrid1.Cells[12,i]:=ado4.Fields.Fieldbyname('email').Value;
ado4.Next;
end;
end;
form1.ShowModal;
end;
end; }
end;
end;

procedure Tfrm_main.FormCreate(Sender: TObject);
var i,j,k:integer;
begin
btfirst:=true;
end;
procedure Tfrm_main.BitBtn2Click(Sender: TObject);
var k,i:integer;
     child:tform;
begin
if close0=true then
begin
//tabcontrol1.TabIndex:=k-1;
if tabcontrol1.TabIndex=-1 then
   tabcontrol1.TabIndex:=0;
if tabcontrol1.Tabs.Count<2 then
    begin
    tabcontrol1.Tabs.Delete(tabcontrol1.TabIndex);
    frm_main.ActiveMDIChild.Close;
    toolbar1.Visible:=false;
    exit;
    end;
for  k:=0 to tabcontrol1.Tabs.Count-1 do
    if tabcontrol1.Tabs.Strings[k]=frm_main.ActiveMDIChild.Caption then
       begin
       tabcontrol1.Tabs.Delete(k);
       tabcontrol1.TabIndex:=k-1;
       if tabcontrol1.TabIndex=-1 then
          tabcontrol1.TabIndex:=0;
       frm_main.ActiveMDIChild.Close;
       for i:=0 to screen.formcount-1 do
      if screen.Forms[i].Caption=tabcontrol1.Tabs.Strings[tabcontrol1.TabIndex] then
      begin
      child:=screen.Forms[i];
      showwindow(child.Handle,SW_MAXIMIZE);
      end;
       //showform;
       break;
       end;
  end
 else
 begin
 showmessage('有数据正在编辑');
 exit;
 end;

end;

procedure Tfrm_main.aboutClick(Sender: TObject);
begin
messagedlg('试用版权所有，如有联系，请拨打13793190541 或[e-mail]',mtinformation,[mbyes],1);
end;

procedure Tfrm_main.czydaClick(Sender: TObject);
begin
openform(tfrm_czyda,frm_czyda,self);
end;

procedure Tfrm_main.Button1Click(Sender: TObject);
var i,j,k:integer;
begin
with data do
begin
aq1.Connection:=adoc1;
aq1.Close;
aq1.SQL.Clear;
aq1.SQL.Add('insert into menulist (menucode,menuname,menuword)'+
'values (:menucode,:menuname,:menuword)');
for i:=0 to frm_main.MainMenu1.Items.Count-1 do
    begin
    if mainmenu1.Items[i].Caption<>'-' then
       begin
       aq1.Parameters.ParamByName('menucode').Value:=inttostr(i);
       aq1.Parameters.ParamByName('menuname').Value:=
       trim(mainmenu1.Items[i].Caption);
       aq1.Parameters.ParamByName('menuword').Value:=
       trim(mainmenu1.Items[i].Name);
       aq1.ExecSQL;
       if mainmenu1.Items[i].Count>0 then
          for j:=0 to mainmenu1.Items[i].Count-1 do
           begin
             if mainmenu1.Items[i].Items[j].Caption<>'-' then
                begin
                aq1.Parameters.ParamByName('menucode').Value:=inttostr(i)+inttostr(j);
                aq1.Parameters.ParamByName('menuname').Value:=
                trim(mainmenu1.Items[i].Items[j].Caption);
                aq1.Parameters.ParamByName('menuword').Value:=
                 trim(mainmenu1.Items[i].Items[j].Name);
                aq1.ExecSQL;
                if mainmenu1.Items[i].Items[j].Count>0 then
                 for k:=0 to mainmenu1.Items[i].Items[j].Count-1 do
                   begin
                     if mainmenu1.Items[i].Items[j].items[k].Caption<>'-' then
                      begin
                      aq1.Parameters.ParamByName('menucode').Value:=inttostr(i)+inttostr(j)+inttostr(k);
                      aq1.Parameters.ParamByName('menuname').Value:=
                      trim(mainmenu1.Items[i].Items[j].Items[k].Caption);
                      aq1.Parameters.ParamByName('menuword').Value:=
                      trim(mainmenu1.Items[i].Items[j].Items[k].Name);
                      aq1.ExecSQL;
                      end;
                    end;
           end;
       end;
   end;
end;
aq1.Close;
aq1.SQL.Clear;
aq1.SQL.Add('select * from menulist');
aq1.Open;
data.DataSource1.DataSet:=aq1;
dbgrid1.DataSource:=data.DataSource1;

end;
end;
procedure Tfrm_main.Button2Click(Sender: TObject);
begin
with data do
begin
aq1.Connection:=adoc1;
aq1.Close;
aq1.SQL.Clear;
aq1.SQL.Add('delete from menulist');
aq1.ExecSQL;
end;
end;

procedure Tfrm_main.zxClick(Sender: TObject);
var i:integer;
begin
for i:=0 to screen.FormCount-1 do
begin
if screen.Forms[i].Name<>frm_main.Name then
screen.Forms[i].Close;
end;
toolbar1.Visible:=false;
tabcontrol1.Tabs.Clear;
frm_pass:=tfrm_pass.Create(application);
frm_pass.ShowModal;
end;
procedure Tfrm_main.N2Click(Sender: TObject);
begin
openform(tfrmyg,frmyg,self);
end;

procedure Tfrm_main.N4Click(Sender: TObject);
begin
openform(TFRM_YGGZ,FRM_YGGZ,self);
end;

procedure Tfrm_main.N3Click(Sender: TObject);
begin
application.Terminate;
close;
end;

procedure Tfrm_main.Button3Click(Sender: TObject);
begin
dbgrid1.Visible:=not dbgrid1.Visible;
end;

procedure Tfrm_main.N5Click(Sender: TObject);
begin
pasmodify:=tpasmodify.Create(application);
pasmodify.ShowModal;
end;

procedure Tfrm_main.Timer1Timer(Sender: TObject);
begin
frm_main.StatusBar1.Panels[3].Text:=formatdatetime('yyyy年-mm月-dd日 hh点:mm分:ss秒',now);
end;

procedure Tfrm_main.bakClick(Sender: TObject);
begin
{label1.Caption:='正在备份....';
a1.Active:=true;
adodm.cback.CommandText:='backup database yd to disk=''d:\Program Files\Microsoft SQL Server\MSSQL\BACKUP\yd.back''';
try
 adodm.cback.Execute;
 label1.Caption:='备份成功！'; a1.Active:=false;
except
 label1.Caption:='备份失败！';a1.Active:=false;
end; }
end;

end.