main.pas

来自「这是一个三层的进销存系统」· PAS 代码 · 共 644 行

unit main;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, Base, ActnList, Menus, ComCtrls, Buttons, StdCtrls, ExtCtrls,
  ImgList, StdActns, ShellAPI, Grids, DBGridEh;

type
  Tfrmmain = class(TfrmBase)
    MainMenu1: TMainMenu;
    ActionList1: TActionList;
    N1: TMenuItem;
    I1: TMenuItem;
    S1: TMenuItem;
    O1: TMenuItem;
    M1: TMenuItem;
    N2: TMenuItem;
    N3: TMenuItem;
    N4: TMenuItem;
    N6: TMenuItem;
    N7: TMenuItem;
    StatusBar1: TStatusBar;
    N122: TMenuItem;
    paneltoolbar: TPanel;
    paneltool: TPanel;
    Label1: TLabel;
    spbtnstandart: TSpeedButton;
    spbtn1: TSpeedButton;
    spbtn2: TSpeedButton;
    spbtn3: TSpeedButton;
    spbtn4: TSpeedButton;
    spbtn5: TSpeedButton;
    SystemDate: TDateTimePicker;
    Pagec: TPageControl;
    spbtn6: TSpeedButton;
    WindowCascade1: TWindowCascade;
    WindowTileHorizontal1: TWindowTileHorizontal;
    WindowTileVertical1: TWindowTileVertical;
    h1001: TAction;
    h1002: TAction;
    nonimagelist: TImageList;
    PopupMenu1: TPopupMenu;
    a01: TAction;
    a02: TAction;
    a03: TAction;
    a04: TAction;
    a05: TAction;
    b01: TAction;
    b02: TAction;
    b03: TAction;
    b04: TAction;
    c01: TAction;
    c02: TAction;
    c03: TAction;
    c04: TAction;
    c05: TAction;
    d01: TAction;
    d02: TAction;
    d03: TAction;
    d04: TAction;
    d05: TAction;
    d06: TAction;
    e01: TAction;
    e02: TAction;
    f01: TAction;
    f02: TAction;
    f03: TAction;
    f04: TAction;
    f05: TAction;
    f06: TAction;
    f07: TAction;
    f08: TAction;
    f09: TAction;
    f10: TAction;
    g01: TAction;
    g02: TAction;
    g03: TAction;
    g04: TAction;
    POSP1: TMenuItem;
    N5: TMenuItem;
    N9: TMenuItem;
    N19: TMenuItem;
    N27: TMenuItem;
    N8: TMenuItem;
    N10: TMenuItem;
    N11: TMenuItem;
    N12: TMenuItem;
    N13: TMenuItem;
    N14: TMenuItem;
    N15: TMenuItem;
    N16: TMenuItem;
    N17: TMenuItem;
    N18: TMenuItem;
    N20: TMenuItem;
    N21: TMenuItem;
    N22: TMenuItem;
    N23: TMenuItem;
    N24: TMenuItem;
    N25: TMenuItem;
    N26: TMenuItem;
    N28: TMenuItem;
    N29: TMenuItem;
    N30: TMenuItem;
    N31: TMenuItem;
    N32: TMenuItem;
    N33: TMenuItem;
    N34: TMenuItem;
    N35: TMenuItem;
    d07: TAction;
    N36: TMenuItem;
    N37: TMenuItem;
    N38: TMenuItem;
    N39: TMenuItem;
    N40: TMenuItem;
    N41: TMenuItem;
    N42: TMenuItem;
    N43: TMenuItem;
    N44: TMenuItem;
    N45: TMenuItem;
    N46: TMenuItem;
    N47: TMenuItem;
    N48: TMenuItem;
    N49: TMenuItem;
    N50: TMenuItem;
    N51: TMenuItem;
    N52: TMenuItem;
    N53: TMenuItem;
    POS1: TMenuItem;
    POS2: TMenuItem;
    N54: TMenuItem;
    POS3: TMenuItem;
    POS4: TMenuItem;
    h01: TAction;
    h02: TAction;
    h03: TAction;
    h04: TAction;
    h05: TAction;
    h06: TAction;
    h07: TAction;
    h1003: TAction;
    POS5: TMenuItem;
    N55: TMenuItem;
    N57: TMenuItem;
    N58: TMenuItem;
    N60: TMenuItem;
    N61: TMenuItem;
    N62: TMenuItem;
    N63: TMenuItem;
    N64: TMenuItem;
    N66: TMenuItem;
    h10031: TMenuItem;
    h08: TAction;
    N68: TMenuItem;
    N69: TMenuItem;
    b05: TAction;
    d08: TAction;
    N59: TMenuItem;
    c06: TAction;
    N70: TMenuItem;
    N71: TMenuItem;
    N56: TMenuItem;
    N72: TMenuItem;
    N73: TMenuItem;
    N74: TMenuItem;
    N75: TMenuItem;
    N76: TMenuItem;
    N77: TMenuItem;
    N78: TMenuItem;
    d09: TAction;
    d10: TAction;
    d11: TAction;
    N79: TMenuItem;
    N80: TMenuItem;
    N81: TMenuItem;
    N82: TMenuItem;
    N65: TMenuItem;
    h09: TAction;
    i01: TAction;
    i02: TAction;
    i03: TAction;
    i04: TAction;
    E1: TMenuItem;
    N67: TMenuItem;
    N83: TMenuItem;
    N84: TMenuItem;
    N85: TMenuItem;
    N86: TMenuItem;
    N87: TMenuItem;
    N88: TMenuItem;
    h10: TAction;
    N89: TMenuItem;
    f0701: TAction;
    N90: TMenuItem;
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure FormCreate(Sender: TObject);
    procedure PagecChange(Sender: TObject);
    procedure FormShow(Sender: TObject);
    procedure spbtnstandartClick(Sender: TObject);
    procedure h1001Execute(Sender: TObject);
    procedure h1002Execute(Sender: TObject);
    procedure h1003Execute(Sender: TObject);
    procedure h06Execute(Sender: TObject);
    procedure h08Execute(Sender: TObject);
    procedure h03Execute(Sender: TObject);
    procedure h09Execute(Sender: TObject);
    procedure d07Execute(Sender: TObject);
    procedure d09Execute(Sender: TObject);
    procedure d01Execute(Sender: TObject);
    procedure d11Execute(Sender: TObject);
    procedure d10Execute(Sender: TObject);
    procedure c01Execute(Sender: TObject);
    procedure c06Execute(Sender: TObject);
    procedure d08Execute(Sender: TObject);
    procedure d03Execute(Sender: TObject);
    procedure d06Execute(Sender: TObject);
    procedure d02Execute(Sender: TObject);
    procedure d04Execute(Sender: TObject);
    procedure d05Execute(Sender: TObject);
    procedure a01Execute(Sender: TObject);
    procedure h10Execute(Sender: TObject);
    procedure g01Execute(Sender: TObject);
    procedure h01Execute(Sender: TObject);
    procedure SystemDateChange(Sender: TObject);
    procedure h04Execute(Sender: TObject);
    procedure h05Execute(Sender: TObject);
    procedure h07Execute(Sender: TObject);
    procedure a02Execute(Sender: TObject);
    procedure a03Execute(Sender: TObject);
    procedure a04Execute(Sender: TObject);
    procedure a05Execute(Sender: TObject);
    procedure f07Execute(Sender: TObject);
    procedure f08Execute(Sender: TObject);
    procedure N90Click(Sender: TObject);
    procedure f09Execute(Sender: TObject);
    procedure f0701Execute(Sender: TObject);
    procedure c02Execute(Sender: TObject);
  private
    procedure forminit;
    procedure showboot;
    { Private declarations }
  public
    procedure setformname(name: string);
    procedure delformname(name:string);
    { Public declarations }
  end;

var
  frmmain: Tfrmmain;

implementation

uses Login, Global, boot, uunit, udept, ucurrency, itemtype, uemployeetype,
  ubilltype, uform, uemployee, uvipcard, uvip, item, uworkmode,
  userverproj, ufuli, uliaochen, upurchase, upermiss, utest, Abort,
  usyslog, uchangepwd, Regist, ustore, upurreturn, upurpayment, usale,
  upurchasedetail, upurchasetotal, usaledetail, upaymentdetail, uvipfull;

{$R *.dfm}

procedure Tfrmmain.delformname(name: string);
var
  i:integer;
begin
  for i:=0 to pagec.PageCount-1 do
    begin
      if pagec.Pages[i].Caption=Trim(name) then
        begin
          pagec.Pages[i].Free;
          break;
        end;
    end;
end;

procedure Tfrmmain.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  inherited;
  Action:=caFree;
end;

procedure Tfrmmain.FormCreate(Sender: TObject);
begin
  inherited;
  if not assigned(frmlogin) then
    frmlogin:=Tfrmlogin.Create(Application);

  if frmlogin.ShowModal = mrOk then
    begin
      forminit;
    end
    else
    begin
      close;
      application.Terminate;
    end;
end;

procedure Tfrmmain.setformname(name: string);
var
  Ttab:Ttabsheet;
begin
  Ttab:=Ttabsheet.Create(nil);
  Ttab.PageControl:=pagec;
  ttab.Caption:=name;
  pagec.ActivePage:=ttab;
end;

procedure Tfrmmain.PagecChange(Sender: TObject);
var
  i:integer;
  sformname:string;
begin
  sformname:=pagec.ActivePage.Caption;
  for i:=0 to Frmmain.MDIChildCount-1 do
    begin
      if frmmain.MDIChildren[i].Caption=sformname then
        frmmain.MDIChildren[i].Show;
    end;
  if sformname='主控制台' then
    frmmain.Show;
end;

procedure Tfrmmain.FormShow(Sender: TObject);
begin
  inherited;
  setformname('主控制台');
  caption:=gs_apptitle;
  showBoot;
end;

procedure Tfrmmain.spbtnstandartClick(Sender: TObject);
var
  point:Tpoint;
begin
  inherited;
  point:=Getscreenpoint(spbtnstandart);
  popupmenu1.Popup(point.X,point.Y);
end;

procedure Tfrmmain.forminit;
begin
  main_ini();
  SystemDate.Date:=Date;
  WorkDate:=SystemDate.Date;
  spbtn1.Caption:='';
  spbtn2.Caption:='';
  spbtn3.Caption:='';
  spbtn4.Caption:='';
  spbtn5.Caption:='';
  spbtn6.Caption:='';
end;

procedure Tfrmmain.showboot;
begin
  if not assigned(frmboot) then
    frmboot:=Tfrmboot.Create(application);
end;

procedure Tfrmmain.h1001Execute(Sender: TObject);
var
  Child:Tform;
  i:integer;
begin
  inherited;
  if frmMain.MDIChildCount > 0 then
    Child:=frmMain.ActiveMDIChild
    Else
    Exit;

  for i:=0 to Child.ComponentCount - 1 do
    begin
      if (Child.Components[i] is TDBGridEH) then
        begin
          LockCount:=LockCount+1;
          if LockCount=(Child.Components[i] as TDBGridEH).columns.Count-1 then
            LockCount:=0;
          (Child.Components[i] as TDBGridEH).frozenCols:=LockCount;
        end;
    end;
end;

procedure Tfrmmain.h1002Execute(Sender: TObject);
var
  Child:Tform;
  i:integer;
begin
  inherited;
  if frmMain.MDIChildCount > 0 then
    Child:=frmMain.ActiveMDIChild
    Else
    Exit;

  for i:=0 to Child.ComponentCount - 1 do
    begin
      if (Child.Components[i] is TDBGridEH) then
        begin
          LockCount:=LockCount-1;
          if LockCount<=0 then
            LockCount:=0;
          (Child.Components[i] as TDBGridEH).frozenCols:=LockCount;
        end;
    end;
end;

procedure Tfrmmain.h1003Execute(Sender: TObject);
begin
  inherited;
  if frmmain.MDIChildCount > 0 then
      if (frmmain.ActiveMDIChild.ClassName<>'Tfrmmain') then
         frmmain.ActiveMDIChild.Close
         else
       else
   if application.MessageBox('您真的要退出系统吗 ? ','退出信息',
                   MB_OKCANCEL+MB_iconquestion+MB_applModal)=idok then
      application.Terminate;
end;

procedure Tfrmmain.h06Execute(Sender: TObject);
var
  ofile:String;
  hwndcalculation:hwnd;
begin
  inherited;
  hwndcalculation:=FindWindow(nil,'CALC');
  if (hwndcalculation=0) then
    begin
      ofile:='Calc.exe';
      ShellExecute(self.Handle,'open',pchar(ofile),
                nil,pchar(Extractfilepath(ofile)),sw_showNormal);
    end;
end;

procedure Tfrmmain.h08Execute(Sender: TObject);
begin
  inherited;
  showboot;
end;

procedure Tfrmmain.h03Execute(Sender: TObject);
begin
  inherited;
  openform(Tfrmform,frmform,self);
end;

procedure Tfrmmain.h09Execute(Sender: TObject);
begin
  inherited;
  openform(Tfrmbilltype,frmbilltype,self);
end;

procedure Tfrmmain.d07Execute(Sender: TObject);
begin
  inherited;
  openform(Tfrmitemtype,frmitemtype,self);
end;

procedure Tfrmmain.d09Execute(Sender: TObject);
begin
  inherited;
  openform(Tfrmcurrency,frmcurrency,self);
end;

procedure Tfrmmain.d01Execute(Sender: TObject);
begin
  inherited;
  openform(Tfrmdept,frmdept,self);
end;

procedure Tfrmmain.d11Execute(Sender: TObject);
begin
  inherited;
  openform(Tfrmunit,frmunit,self);
end;

procedure Tfrmmain.d10Execute(Sender: TObject);
begin
  inherited;
  openform(Tfrmemployeetype,frmemployeetype,self);
end;

procedure Tfrmmain.c01Execute(Sender: TObject);
begin
  inherited;
  openform(Tfrmvipcard,frmvipcard,self);
end;

procedure Tfrmmain.c06Execute(Sender: TObject);
begin
  inherited;
  openform(Tfrmvip,frmvip,self);
end;

procedure Tfrmmain.d08Execute(Sender: TObject);
begin
  inherited;
  openform(Tfrmemployee,frmemployee,self);
end;

procedure Tfrmmain.d03Execute(Sender: TObject);
begin
  inherited;
  openform(Tfrmitem,frmitem,self);
end;

procedure Tfrmmain.d06Execute(Sender: TObject);
begin
  inherited;
  openform(Tfrmworkmode,frmworkmode,self);
end;

procedure Tfrmmain.d02Execute(Sender: TObject);
begin
  inherited;
  openform(TfrmServerproj,Frmserverproj,self);
end;

procedure Tfrmmain.d04Execute(Sender: TObject);
begin
  inherited;
  openform(Tfrmfuli,frmfuli,self);
end;

procedure Tfrmmain.d05Execute(Sender: TObject);
begin
  inherited;
  openform(Tfrmliaochen,frmliaochen,self);
end;

procedure Tfrmmain.a01Execute(Sender: TObject);
begin
  inherited;
  openform(Tfrmpurchase,frmpurchase,self);
end;

procedure Tfrmmain.h10Execute(Sender: TObject);
begin
  inherited;
  openform(Tfrmpermiss,frmpermiss,self);
end;

procedure Tfrmmain.g01Execute(Sender: TObject);
begin
  inherited;
  openform(Tfrmtest,frmtest,self); 
end;

procedure Tfrmmain.h01Execute(Sender: TObject);
begin
  inherited;
  if not assigned(frmabout) then
     frmabout:=Tfrmabout.Create(application); 
end;

procedure Tfrmmain.SystemDateChange(Sender: TObject);
begin
  inherited;
  WorkDate:=SystemDate.Date;
end;

procedure Tfrmmain.h04Execute(Sender: TObject);
begin
  inherited;
  openform(Tfrmsyslog,frmsyslog,self);
end;

procedure Tfrmmain.h05Execute(Sender: TObject);
begin
  inherited;
  if not assigned(frmchangepwd) then
    frmChangepwd:=TfrmChangepwd.Create(application);
    frmchangepwd.ShowModal;  
end;

procedure Tfrmmain.h07Execute(Sender: TObject);
begin
  inherited;
  if not assigned(frmregist) then
    frmregist:=Tfrmregist.Create(application);
    frmregist.ShowModal;  
end;

procedure Tfrmmain.a02Execute(Sender: TObject);
begin
  inherited;
  openform(Tfrmstore,frmstore,self);
end;

procedure Tfrmmain.a03Execute(Sender: TObject);
begin
  inherited;
  openform(Tfrmpurreturn,frmpurreturn,self);
end;

procedure Tfrmmain.a04Execute(Sender: TObject);
begin
  inherited;
  openform(Tfrmpurpayment,frmpurpayment,self);
end;

procedure Tfrmmain.a05Execute(Sender: TObject);
begin
  inherited;
  openform(Tfrmsale,frmsale,self);
end;

procedure Tfrmmain.f07Execute(Sender: TObject);
begin
  inherited;
  openform(Tfrmpurchasedetail,frmpurchasedetail,self);
end;

procedure Tfrmmain.f08Execute(Sender: TObject);
begin
  inherited;
  openform(Tfrmpurchasetotal,frmpurchasetotal,self);
end;

procedure Tfrmmain.N90Click(Sender: TObject);
begin
  inherited;
  openform(Tfrmsaledetail,frmsaledetail,self);
end;

procedure Tfrmmain.f09Execute(Sender: TObject);
begin
  inherited;
  openform(Tfrmpaymentdetail,frmpaymentdetail,self);
end;

procedure Tfrmmain.f0701Execute(Sender: TObject);
begin
  inherited;
  openform(Tfrmsaledetail,frmsaledetail,self);
end;

procedure Tfrmmain.c02Execute(Sender: TObject);
begin
  inherited;
  openform(Tfrmvipfull,frmvipfull,self);
end;

end.