commain.pas

来自「delphi作得信息业进销存源码.功能全面,运行稳定.」· PAS 代码 · 共 1,122 行 · 第 1/3 页

unit ComMain;

{
1.
procedure TfrmMain.AppBtn2Click(Sender: TObject);
begin
  inherited;
  screen.Cursor := crHourGlass;
  SAction('mnuSpcx', 'Sp', '');
  SAction('mnuXsd' , 'Xsdzb;明细-Xsd', '');
  SAction('mnuRs'  , 'Rs', '其它-Qtgl');
  screen.Cursor := crDefault;
  MessageDlg('Set AppAction OK!', mtInformation, [mbOk], 0);
end;

2.
  pstrComputerName: string;
  pintUserId: Integer;
  pstrUserCode: string;
  pstrUserName: string;
  pstrUserPassword: string;
  pstrUserGroup: string;
  pblnLoadAppSelect: boolean;
  pblnSaveAppSelect: boolean;
  pHKL: HKL;

3.
  BeginShow(Sender);
  if not IsOpenMdiForm('frmSppp') then
    frmSppp := TfrmSppp.Create(application);
  frmSppp.Show;
  EndShow(Sender);

4. (dpr)
  ...
  Application.CreateForm(TfrmMain, frmMain);
  frmMain.Animate1.Active := True;
  frmMain.pnlMain.Visible := True;
  frmMain.pnlMain.Repaint;
  ...
  frmMain.Animate1.Active := False;
  frmMain.pnlMain.Visible := False;
}

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  ComCtrls, ExtCtrls, ImgList, Menus, StdCtrls, AppEvnts, inifiles,
  shellapi, Clipbrd, ActnList, Buttons, ToolWin, DBGrids,
  Mask, DBCtrls, OleServer, TeEngine, Series, TeeProcs,
  Chart, DBChart, printers, FileCtrl, Excel97, Word97, Excel2000, Word2000;

type
  TfrmComMain = class(TForm)
    PopupMenu1: TPopupMenu;
    pmnCascade: TMenuItem;
    pmnHorizontally: TMenuItem;
    pmnMinAll: TMenuItem;
    LineP1: TMenuItem;
    pmnCloseAll: TMenuItem;
    PrinterSetupDialog1: TPrinterSetupDialog;
    StatusBar1: TStatusBar;
    ProgressBar1: TProgressBar;
    MainMenu1: TMainMenu;
    mnuFile: TMenuItem;
    mnuBackup: TMenuItem;
    mnuRestore: TMenuItem;
    mnuChangUser: TMenuItem;
    LineF2: TMenuItem;
    mnuExit: TMenuItem;
    mnuWindow: TMenuItem;
    mnuCascade: TMenuItem;
    mnuHorizontally: TMenuItem;
    mnuMinAll: TMenuItem;
    mnuCloseAll: TMenuItem;
    mnuTools: TMenuItem;
    mnuUser: TMenuItem;
    mnuPassword: TMenuItem;
    LineT2: TMenuItem;
    mnuCalendar: TMenuItem;
    mnuCalculator: TMenuItem;
    LineT3: TMenuItem;
    mnuOption: TMenuItem;
    mnuHelp: TMenuItem;
    mnuHelpBook: TMenuItem;
    LineH1: TMenuItem;
    mnuAbout: TMenuItem;
    ApplicationEvents1: TApplicationEvents;
    mnuDesktop: TMenuItem;
    mnuPopedom: TMenuItem;
    AppPnl: TPanel;
    AppBtn1: TButton;
    AppBtn2: TButton;
    AppMemo: TMemo;
    PageScroller1: TPageScroller;
    tlbSKey: TToolBar;
    btnGuide: TToolButton;
    btnInCommonUse: TToolButton;
    mnuSetIcon: TMenuItem;
    mnuSjzl: TMenuItem;
    LineF1: TMenuItem;
    LineT1: TMenuItem;
    LineW2: TMenuItem;
    btnWord: TToolButton;
    btnExcel: TToolButton;
    WordApplication1: TWordApplication;
    ExcelApplication1: TExcelApplication;
    PageScroller2: TPageScroller;
    tlbAForm: TToolBar;
    mmuPrintSet: TMenuItem;
    mnuStatusBar: TMenuItem;
    LineW1: TMenuItem;
    labOpenAppButton: TLabel;
    Label1: TLabel;
    AppPath: TEdit;
    Button1: TButton;
    mnuToolBar: TMenuItem;
    LineT4: TMenuItem;
    mnuLog: TMenuItem;
    pmnInCommonUse: TPopupMenu;
    pnlMain: TPanel;
    Label2: TLabel;
    Animate1: TAnimate;
    Label3: TLabel;
    Label4: TLabel;
    Label5: TLabel;
    Label6: TLabel;
    Label7: TLabel;
    labMain: TLabel;
    labBack: TLabel;
    ilsBar: TImageList;
    ilsSub: TImageList;
    ilsMain: TImageList;
    //App Even
    procedure ActiveFormChange(Sender: TObject);virtual;
    procedure ActiveControlChange(Sender: TObject);virtual;
    procedure ApplicationEvents1Exception(Sender: TObject; E: Exception);virtual;
    //Form Even
    procedure FormCreate(Sender: TObject);virtual;
    procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);virtual;
    procedure FormClose(Sender: TObject; var Action: TCloseAction);virtual;
    //File
    procedure mnuBackupClick(Sender: TObject);virtual;
    procedure mnuRestoreClick(Sender: TObject);virtual;
    procedure mnuSjzlClick(Sender: TObject);virtual;
    procedure mnuPrinterSetupClick(Sender: TObject);virtual;
    procedure mnuChangUserClick(Sender: TObject);virtual;
    procedure mnuExitClick(Sender: TObject);virtual;
    //Windows
    procedure mnuStatusBarClick(Sender: TObject);
    procedure mnuCascadeClick(Sender: TObject);virtual;
    procedure mnuHorizontallyClick(Sender: TObject);virtual;
    procedure mnuMinAllClick(Sender: TObject);virtual;
    procedure mnuCloseAllClick(Sender: TObject);virtual;
    //Tools
    procedure mnuPopedomClick(Sender: TObject);virtual;
    procedure mnuUserClick(Sender: TObject);virtual;
    procedure mnuPasswordClick(Sender: TObject);virtual;
    procedure mnuSetIconClick(Sender: TObject);virtual;
    procedure mnuDesktopClick(Sender: TObject);virtual;
    procedure mnuCalendarClick(Sender: TObject);virtual;
    procedure mnuCalculatorClick(Sender: TObject);virtual;
    procedure mnuOptionClick(Sender: TObject);virtual;
    //Help
    procedure mnuHelpBookClick(Sender: TObject);virtual;
    procedure mnuAboutClick(Sender: TObject);virtual;
    //Bar
    procedure ToolButtonClick(Sender: TObject);virtual;
    procedure btnGuideClick(Sender: TObject);virtual;
    procedure btnWordClick(Sender: TObject);virtual;
    procedure btnExcelClick(Sender: TObject);virtual;
    //Other
    procedure labOpenAppButtonDblClick(Sender: TObject);
    procedure SetMenuEnabled(mnuTmp: TMenuItem);virtual;
    procedure MenuPopedom;virtual;
    procedure MenuRepair(MenuItem: TMenuItem);
    procedure BeginShow(Sender: TObject);virtual;
    procedure EndShow(Sender: TObject);virtual;
    procedure SaveInCommonUse(Sender: TObject);virtual;
    function IsOpenMdiForm(strName: string): boolean;virtual;
    //Create App
    procedure AppBtn1Click(Sender: TObject);virtual;
    procedure GetMnuInfo(mnuTmp: TMenuItem);virtual;
    procedure SaveAppMenu(mnuTmp: TMenuItem; strIsParent: string);virtual;
    procedure AppBtn2Click(Sender: TObject);virtual;
    procedure SAction(AMenuName, AFormNames, AOther: string);virtual;
    procedure SaveAction(mName, fName, aName, aCaption: string);virtual;
    procedure mnuToolBarClick(Sender: TObject);
    procedure mnuLogClick(Sender: TObject);
    procedure FormShow(Sender: TObject);
    procedure StatusBar1DrawPanel(StatusBar: TStatusBar;
      Panel: TStatusPanel; const Rect: TRect);
    procedure FormResize(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  frmComMain: TfrmComMain;

implementation

uses Common, Wnl, Dm, Popedom, PopedomCopy, User,
  Password, Login, SetIcon, Desktop, About, Main, Guide, Log;

{$R *.DFM}

{-Form Even 窗体事件-}

//Form.Create
procedure TfrmComMain.FormCreate(Sender: TObject);
var
  c: TComponent;
  mi: TMenuItem;
begin
  Top := 0;
  //Create Directory
  if not DirectoryExists(ExtractFilePath(Application.ExeName) + 'System') then
    ForceDirectories(ExtractFilePath(Application.ExeName) + 'System');
  if not DirectoryExists(ExtractFilePath(Application.ExeName) + 'Icon') then
    ForceDirectories(ExtractFilePath(Application.ExeName) + 'Icon');
  if not DirectoryExists(ExtractFilePath(Application.ExeName) + 'Report') then
    ForceDirectories(ExtractFilePath(Application.ExeName) + 'Report');
  if not DirectoryExists(ExtractFilePath(Application.ExeName) + 'Column') then
    ForceDirectories(ExtractFilePath(Application.ExeName) + 'Column');
  if not DirectoryExists(ExtractFilePath(Application.ExeName) + 'Filter') then
    ForceDirectories(ExtractFilePath(Application.ExeName) + 'Filter');
  //Ime
  pHKL := GetKeyboardLayout(0);
  //Login
  frmLogin := TfrmLogin.Create(self);
  frmLogin.ShowModal;
  if frmLogin.ModalResult <> MROK then
  begin
    screen.OnActiveFormChange := nil;
    screen.OnActiveControlChange := nil;
    Application.Terminate;
  end;
  frmLogin.Free;
  Self.Caption := Application.Title;
  Screen.OnActiveFormChange := ActiveFormChange;
  Screen.OnActiveControlChange := ActiveControlChange;
  ShortDateFormat := 'yyyy-mm-dd';
  DateSeparator := '-';
  //set ProgressBar1
  ProgressBar1.Visible := False;
  ProgressBar1.Parent := StatusBar1;
  //set StatusBar1
  StatusBar1.Panels[2].Text := DateToStr(Date());
  StatusBar1.Panels[3].Text := pstrUserName;
  //Set pmnInCommonUse
  with Data.Tmpl do
  begin
    Close;
    CommandText := 'select top 15 * from AppInCommonUse ' +
      'where uID = ' + IntToStr(pintUserId) + ' ' +
      'order by UseCount desc';
    Open;
    while not Eof do
    begin
      c := self.FindComponent(FieldByName('mName').AsString);
      if c <> nil then
      begin
        mi := TMenuItem.Create(self);
        mi.Caption := TMenuItem(c).Caption;
        mi.OnClick := TMenuItem(c).OnClick;
        self.pmnInCommonUse.Items.Add(mi);
      end;
      Next;
    end;
  end;
  //MenuPopedom
  MenuPopedom;
end;

//Form.Show
procedure TfrmComMain.FormShow(Sender: TObject);
begin
  pblnLoadAppSelect := True;
  pblnSaveAppSelect := True;
end;

//Form.Resize
procedure TfrmComMain.FormResize(Sender: TObject);
begin
  PageScroller1.Visible := False;
  PageScroller1.Visible := True;
end;

//Form.CloseQuery
procedure TfrmComMain.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
begin
  if Application.MessageBox('确实要退出系统吗？', '退出系统',
     MB_YESNO+MB_ICONINFORMATION) = IDYES then
  begin
    //Log
    with Data.Tmp do
    begin
      Close;
      CommandText := 'insert into AppLog (uName, cName, CZ, RQ, SJ) ' +
        'values (''' + pstrUserName + ''', ' +
        '''' + pstrComputerName + ''', ' +
        '''退出系统'', ' +
        '''' + FormatDateTime('yyyy-mm-dd', Date) + ''', ' +
        '''' + FormatDateTime('hh:nn', Time) + ''')';
      Execute;
    end;
    mnuCloseAllClick( nil );
    Application.Terminate;
  end
  else
    CanClose := false;
end;

//Form.Close
procedure TfrmComMain.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  screen.OnActiveFormChange := nil;
  screen.OnActiveControlChange := nil;
end;

//StatusBar1
procedure TfrmComMain.StatusBar1DrawPanel(StatusBar: TStatusBar;
  Panel: TStatusPanel; const Rect: TRect);
begin
  //set tlbSkey
  if Panel.Index = 0 then
  begin
    PageScroller1.Parent := StatusBar;
    PageScroller1.Top := Rect.Top;
    PageScroller1.Left := Rect.Left;
    PageScroller1.Width := Rect.Right - Rect.Left;
    PageScroller1.Height := Rect.Bottom - Rect.Top;
  end;
  //set PageScroller2
  if Panel.Index = 1 then
  begin
    PageScroller2.Parent := StatusBar1;
    PageScroller2.Top := Rect.Top;
    PageScroller2.Left := Rect.Left;
    PageScroller2.Width := Rect.Right - Rect.Left;
    PageScroller2.Height := Rect.Bottom - Rect.Top;
  end;
end;

{-File 文件-}

//mnuBackup.Click
procedure TfrmComMain.mnuBackupClick(Sender: TObject);
begin
  { TODO : Backup }
end;

//mnuRestore.Click
procedure TfrmComMain.mnuRestoreClick(Sender: TObject);
begin
  { TODO : Restore }
end;

//mnuSjzl.Click
procedure TfrmComMain.mnuSjzlClick(Sender: TObject);
begin
  if Application.MessageBox('确实要进行数据整理吗？', '数据整理',
     MB_YESNO+MB_ICONINFORMATION) <> IDYES then
    Exit;
  Screen.Cursor := crHourGlass;
  try
   { TODO : Sjzl }
  finally
    Screen.Cursor := crdefault;
  end;