commain.pas

来自「IT业进销存管理系统源代码Delphi」· PAS 代码 · 共 1,122 行 · 第 1/3 页

  Application.MessageBox( '数据已经整理完!', '数据整理',MB_OK );
end;

//mnuPrinter.SetupClick
procedure TfrmComMain.mnuPrinterSetupClick(Sender: TObject);
begin
  PrinterSetupDialog1.Execute;
end;

//mnuChang.UserClick
procedure TfrmComMain.mnuChangUserClick(Sender: TObject);
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;
  frmLogin := TfrmLogin.Create(self);
  frmLogin.ShowModal;
  if frmLogin.ModalResult <> MROK then
  begin
    screen.OnActiveFormChange := nil;
    screen.OnActiveControlChange := nil;
    Application.Terminate;
  end
  else
  begin
    screen.Cursor := crHourGlass;
    SetMenuEnabled(MainMenu1.Items);
    MenuPopedom;
    frmGuide.Free;
    Animate1.Active := True;
    pnlMain.Visible := True;
    pnlMain.Repaint;
    if not IsOpenMdiForm('frmGuide') then
      frmGuide := TfrmGuide.Create(self);
    frmGuide.Show;
    Animate1.Active := False;
    pnlMain.Visible := False;
    screen.Cursor := crdefault;
  end;
  frmLogin.Free;
  StatusBar1.Panels[2].Text := DateToStr(Date);
  StatusBar1.Panels[3].Text := pstrUserName;
end;

//mnuExit.Click
procedure TfrmComMain.mnuExitClick(Sender: TObject);
begin
  Close;
end;

{-Windows 窗口-}

//mnuToolBar.Click
procedure TfrmComMain.mnuToolBarClick(Sender: TObject);
var
  comTmp: TComponent;
begin
  mnuToolBar.Checked := not mnuToolBar.Checked;
  comTmp := Screen.ActiveCustomForm.FindComponent('ControlBar1');
  if comTmp <> nil then
    TControlBar(comTmp).Visible := mnuToolBar.Checked;
end;

//mnuStatusBar.Click
procedure TfrmComMain.mnuStatusBarClick(Sender: TObject);
begin
  mnuStatusBar.Checked := not mnuStatusBar.Checked;
  StatusBar1.Visible := mnuStatusBar.Checked;
end;

//mnuCascade.Click
procedure TfrmComMain.mnuCascadeClick(Sender: TObject);
var
  i:integer;
begin
  for i := MDIChildCount - 1 downto 0 do
    MDIChildren[i].WindowState := wsNormal;
  for i := MDIChildCount - 1 downto 0 do
    MDIChildren[i].WindowState := wsNormal;
  Cascade;
end;

//mnuHorizontally.Click
procedure TfrmComMain.mnuHorizontallyClick(Sender: TObject);
var
  i:integer;
begin
  for i := MDIChildCount - 1 downto 0 do
    MDIChildren[i].WindowState := wsNormal;
  for i := MDIChildCount - 1 downto 0 do
    MDIChildren[i].WindowState := wsNormal;
  Tile;
end;

//mnuMinAll.Click
procedure TfrmComMain.mnuMinAllClick(Sender: TObject);
var
 i:integer;
begin
  for i := MDIChildCount - 1 downto 0 do
    MDIChildren[i].WindowState := wsMinimized;
  ArrangeIcons;
end;

//mnuCloseAll.Click
procedure TfrmComMain.mnuCloseAllClick(Sender: TObject);
var
 i:integer;
begin
  for i := MDIChildCount - 1 downto 0 do
    MDIChildren[i].Close;
end;

{-Tools 工具-}

//mnuPopedom.Click
procedure TfrmComMain.mnuPopedomClick(Sender: TObject);
begin
  BeginShow(Sender);
  if not IsOpenMdiForm('frmPopedom') then
    frmPopedom := TfrmPopedom.Create(self);
  frmPopedom.Show;
  EndShow(Sender);
end;

//mnuUser.Click
procedure TfrmComMain.mnuUserClick(Sender: TObject);
begin
  BeginShow(Sender);
  if not IsOpenMdiForm('frmUser') then
    frmUser := TfrmUser.Create(self);
  frmUser.Show;
  EndShow(Sender);
end;

//mnuPassword.Click
procedure TfrmComMain.mnuPasswordClick(Sender: TObject);
begin
  frmPassword := TfrmPassword.Create(self);
  frmPassword.ShowModal;
  frmPassword.Free;
end;

//mnuLog.Click
procedure TfrmComMain.mnuLogClick(Sender: TObject);
begin
  BeginShow(Sender);
  if not IsOpenMdiForm('frmLog') then
    frmLog := TfrmLog.Create(self);
  frmLog.Show;
  EndShow(Sender);
end;

//mnuSetIcon.Click
procedure TfrmComMain.mnuSetIconClick(Sender: TObject);
begin
  frmSetIcon := TfrmSetIcon.Create(self);
  frmSetIcon.ShowModal;
  frmSetIcon.Free;
end;

//mnuDesktop.Click
procedure TfrmComMain.mnuDesktopClick(Sender: TObject);
begin
  if frmDesktop = nil then
    frmDesktop := TfrmDesktop.Create(self);
  frmDesktop.Show;
end;

//mnuCalendar.Click
procedure TfrmComMain.mnuCalendarClick(Sender: TObject);
begin
  if frmWnl = nil then
    frmWnl := TfrmWnl.Create(self);
  frmWnl.MonthCalendar1.Date := Date;
  frmWnl.Show;
end;

//mnuCalculator.Click
procedure TfrmComMain.mnuCalculatorClick(Sender: TObject);
begin
  WinExec('Calc.exe', SW_SHOWDEFAULT);
end;

procedure TfrmComMain.mnuOptionClick(Sender: TObject);
begin
  { TODO : Option }
end;

{-Help 帮助-}

//mnuHelpBook.Click
procedure TfrmComMain.mnuHelpBookClick(Sender: TObject);
begin
  { TODO : Help Book }
end;

//mnuAbout.Click
procedure TfrmComMain.mnuAboutClick(Sender: TObject);
begin
  frmAbout := TfrmAbout.Create(self);
  frmAbout.ShowModal;
  frmAbout.Free;
end;

{-Bar 快捷菜单 窗体切换-}

//ToolButtonClick
procedure TfrmComMain.ToolButtonClick(Sender: TObject);
var
  i: integer;
begin
  if Sender is TToolButton then
  begin
    if TToolButton(Sender).Hint <> screen.ActiveForm.name then
    begin
      for i := 0 to self.tlbAForm.ButtonCount - 1 do
        if TToolButton(Sender) <> self.tlbAForm.Buttons[i] then
          self.tlbAForm.Buttons[i].ImageIndex := 0
        else
          self.tlbAForm.Buttons[i].ImageIndex := 1;
      for i := 0 to self.MDIChildCount - 1 do
      begin
        self.Next;
        if screen.ActiveCustomForm.name = TToolButton(Sender).Hint then
          break;
      end;
    end;
  end;
end;

//btnGuide.Click
procedure TfrmComMain.btnGuideClick(Sender: TObject);
begin
  Animate1.Active := True;
  pnlMain.Visible := True;
  pnlMain.Repaint;
  if not IsOpenMdiForm('frmGuide') then
    frmGuide := TfrmGuide.Create(self);
  frmGuide.Show;
  Animate1.Active := False;
  pnlMain.Visible := False;
end;

//btnWord.Click
procedure TfrmComMain.btnWordClick(Sender: TObject);
begin
  self.WordApplication1.Quit;
  self.WordApplication1.Disconnect;
  self.WordApplication1.Connect;
  self.WordApplication1.Visible := true;
end;

//btnExcel.Click
procedure TfrmComMain.btnExcelClick(Sender: TObject);
begin
  self.ExcelApplication1.Quit;
  self.ExcelApplication1.Disconnect;
  self.ExcelApplication1.Connect;
  self.ExcelApplication1.Visible[0] := true;
end;

{-App Even 系统事件-}

//ActiveFormChange
procedure TfrmComMain.ActiveFormChange(Sender: TObject);
begin
  ActivateKeyboardLayout(pHKL, KLF_ACTIVATE);
  mnuCascade.Enabled      := self.MDIChildCount > 0;
  mnuHorizontally.Enabled := mnuCascade.Enabled;
  mnuMinAll.Enabled       := mnuCascade.Enabled;
  mnuCloseAll.Enabled     := mnuCascade.Enabled;
  pmnCascade.Enabled      := mnuCascade.Enabled;
  pmnHorizontally.Enabled := mnuCascade.Enabled;
  pmnMinAll.Enabled       := mnuCascade.Enabled;
  pmnCloseAll.Enabled     := mnuCascade.Enabled;
end;

//ActiveControlChange
procedure TfrmComMain.ActiveControlChange(Sender: TObject);
begin
  pHKL := GetKeyboardLayout(0);
end;

//ApplicationEvents1.Exception
procedure TfrmComMain.ApplicationEvents1Exception(Sender: TObject;
  E: Exception);
begin
  if Pos( 'not a valid date',E.Message ) <> 0 then
    E.Message := '日期输入错误，请重新输入！'
  Else if Pos( 'Cannot perform this operation on an empty dataset',E.Message ) <> 0 then
    E.Message := '已经没有数据，不能删除！'
  Else if Pos( 'not a valid floating point value',E.Message ) <> 0 then
    E.Message := '数据输入错误，请重输！'
  Else if Pos( 'Invalid input value.  Use escape key to abandon changes',E.Message ) <> 0 then
    E.Message := '数据输入错误，请按Esc键后重输！'
  Else if Pos( 'Key violation', E.Message ) <> 0 then
    E.Message := '已有相同的编号，不能修改！'
  else if Pos( 'Field value required', E.Message ) <> 0 then
    E.Message := '编号不能为空！'
  else if Pos( 'I/O error 21', E.Message ) <> 0 then
    E.Message := '驱动器未准备好，无法访问！'
  else if Pos( 'read-only dataset', E.Message ) <> 0 then
    E.Message := '此项资料不能修改！'
  else if Pos( 'is not a valid value for', E.Message ) <> 0 then
  begin
    E.Message := copy(E.Message, pos(' ''', E.Message), pos('''.', E.Message) - pos(' ''', E.Message) + 1) +
      '输入无效，输入范围是 ' + copy(E.Message, pos('range is ', E.Message) + 9, length(E.Message)) + '.';
    E.Message := StringReplace(E.Message, ' to ', ' 至 ',[rfReplaceAll, rfIgnoreCase]);
  end;
  Application.MessageBox(Pchar(E.Message), '系统提示', MB_OK + MB_ICONWARNING);
end;

{-Other 其它过程-}

//labOpenAppButton.DblClick
procedure TfrmComMain.labOpenAppButtonDblClick(Sender: TObject);
begin
  AppPath.Text := ExtractFilePath(Application.ExeName);
  frmMain.AppPnl.Visible := not frmMain.AppPnl.Visible;
end;

//SetMenuEnabled
procedure TfrmComMain.SetMenuEnabled(mnuTmp: TMenuItem);
var
  i: integer;
begin
  if mnuTmp.Count = 0 then
    mnuTmp.Visible := mnuTmp.Tag = 0
  else
    for i := 0 to mnuTmp.Count - 1 do
      SetMenuEnabled(mnuTmp.Items[i]);
end;

//MenuPopedom
procedure TfrmComMain.MenuPopedom;
var
  i: integer;
begin
  if UpperCase(pstrUserCode) = 'SYS' then exit;
  with Data.Tmpl do
  begin
    Close;
    CommandText := 'select * from AppGroupMenu ' +
      'where gName = ''' + pstrUserGroup + '''';
    Open;
    for i := 0 to self.ComponentCount - 1 do
      if (self.Components[i] is TMenuItem) and
        (UpperCase(Copy(self.Components[i].Name, 1, 3)) <> 'PMN') and
        (TMenuItem(self.Components[i]).Count = 0) and
        (TMenuItem(self.Components[i]).Caption <> '-')
        then
        TMenuItem(self.Components[i]).Visible := Locate('mName', self.Components[i].Name, []);
  end;
  mmuPrintSet.Visible     := true;
  mnuChangUser.Visible    := true;
  mnuExit.Visible         := true;
  mnuToolBar.Visible      := true;
  mnuStatusBar.Visible    := true;
  mnuCascade.Visible      := true;
  mnuHorizontally.Visible := true;
  mnuMinAll.Visible       := true;
  mnuCloseAll.Visible     := true;
  mnuCalendar.Visible     := true;
  mnuCalculator.Visible   := true;