⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 mainform.pas

📁 服务信息管理系统
💻 PAS
字号:
unit mainform;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  ComCtrls, ToolWin, ImgList, Menus, Shellapi, StdCtrls, Db, DBTables, jpeg, ExtCtrls,
  Grids, DBGrids, XPMenu, fcStatusBar;
const
  CM_RESTORE = WM_USER + $1000;

type
  TSysForm = class(TForm)
    MainMenu: TMainMenu;
    meufile: TMenuItem;
    Meudhzx: TMenuItem;
    N4: TMenuItem;
    meukfzx: TMenuItem;
    N5: TMenuItem;
    meuswzx: TMenuItem;
    N6: TMenuItem;
    meujlcx: TMenuItem;
    N7: TMenuItem;
    meuexit: TMenuItem;
    meuEdit: TMenuItem;
    Undo1: TMenuItem;
    Repeatcommand1: TMenuItem;
    N3: TMenuItem;
    Cut1: TMenuItem;
    Copy1: TMenuItem;
    Paste1: TMenuItem;
    PasteSpecial1: TMenuItem;
    A1: TMenuItem;
    N2: TMenuItem;
    L1: TMenuItem;
    meuTool: TMenuItem;
    meuInit: TMenuItem;
    meusydwxx: TMenuItem;
    meukhzlxx: TMenuItem;
    meubmml: TMenuItem;
    meuygml: TMenuItem;
    meufwlxml: TMenuItem;
    meukhlxml: TMenuItem;
    N8: TMenuItem;
    meuyhzczx: TMenuItem;
    meuyhcssz: TMenuItem;
    meuWindow: TMenuItem;
    mnuWindowTool: TMenuItem;
    mnuWindowstatus: TMenuItem;
    N9: TMenuItem;
    D1: TMenuItem;
    S1: TMenuItem;
    C1: TMenuItem;
    P1: TMenuItem;
    meuHelp: TMenuItem;
    Contents1: TMenuItem;
    N1: TMenuItem;
    MnuAbout: TMenuItem;
    ImageList: TImageList;
    fwxxglDb: TDatabase;
    N11: TMenuItem;
    N12: TMenuItem;
    N13: TMenuItem;
    N14: TMenuItem;
    N15: TMenuItem;
    N16: TMenuItem;
    N17: TMenuItem;
    N18: TMenuItem;
    E1: TMenuItem;
    N19: TMenuItem;
    czyqxQuery: TQuery;
    XPMenu1: TXPMenu;
    mainStatusBar: TfcStatusBar;
    Menufwdjb: TMenuItem;
    C2: TMenuItem;
    N10: TMenuItem;
    B1: TMenuItem;
    C3: TMenuItem;
    D2: TMenuItem;
    E2: TMenuItem;
    fwltjMenu: TMenuItem;
    procedure ToolButton8Click(Sender: TObject);
    procedure meuexitClick(Sender: TObject);
    procedure meusydwxxClick(Sender: TObject);
    procedure mnuWindowToolClick(Sender: TObject);
    procedure mnuWindowstatusClick(Sender: TObject);
    procedure meubmmlClick(Sender: TObject);
    procedure meukhzlxxClick(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure meuygmlClick(Sender: TObject);
    procedure D1Click(Sender: TObject);
    procedure S1Click(Sender: TObject);
    procedure C1Click(Sender: TObject);
    procedure P1Click(Sender: TObject);
    procedure Q1Click(Sender: TObject);
    procedure A2Click(Sender: TObject);
    procedure FormActivate(Sender: TObject);
    procedure N13Click(Sender: TObject);
    procedure meuyhcsszClick(Sender: TObject);
    procedure meuyhzczxClick(Sender: TObject);
    procedure FormShow(Sender: TObject);
    procedure N12Click(Sender: TObject);
    procedure N11Click(Sender: TObject);
    procedure MnuAboutClick(Sender: TObject);
    procedure N16Click(Sender: TObject);
    procedure N17Click(Sender: TObject);
    procedure N18Click(Sender: TObject);
    procedure FormResize(Sender: TObject);
    procedure meufwlxmlClick(Sender: TObject);
    procedure MenufwdjbClick(Sender: TObject);
    procedure Contents1Click(Sender: TObject);
    procedure fwltjMenuClick(Sender: TObject);
    procedure Undo1Click(Sender: TObject);
  private
    { Private declarations }
    function GetExePath: string; //取得系统路径函数
  public
    { Public declarations }
    function GetCzyqx(Tczybh: string; Tqxbh: string; Tqxjb: string): string; //取得操作员权限函数
    //Tczybh 操作员编号,Tqxbh 权限编号,Tqxjb 权限级别
    function StrLike(str1: string; Str2: string): Boolean; //判断一个字符串是否在另一个字符串中的函数
    procedure CreateParams(var Params: TCreateParams); override;
    procedure RestoreRequest(var message: TMessage); message CM_RESTORE;
  end;

var
  SysForm: TSysForm;
  sys_czyqx: string; //操作员权限
  sys_czyxm: string; //操作员姓名
  sys_czybh: string; //操作员编号
  sys_path: string; //系统所在路径
  sys_date: string; //系统日期
  LoginFlag: Boolean;
  sys_bmpath, sys_report: string; //系统图片所在路径
  selectdate1, selectdate2: TDateTime; //此两个变量为全局使用,目的是从一个时间选择模块中得到选择的时间
  selecttext1, selecttext2, selecttext3, selecttext4: string; //此四个变量为全局使用,目的是从一个选择模块中得到选择的内容
  selectboolean: Boolean; //为全局使用,目的是从一个选择模块中得到是否进行了选择

implementation
uses Desktop, sydwxx, bmmlgl, khzlxx, ygdagl, login, startface, dhsl, scpgd,
  xtcssz, yhzczx, yhgnqxsz, fwdjb, fwrbb, about, ghczy, ghkl, ghxtsj,
  fwlxml, khhfb, fwltj, tjxz, bxpzlr;
{$R *.DFM}

// ============================参见 ST.DPR ==
// Override Default RegisterClass Parameters
// =========================================

procedure TSysForm.CreateParams(var Params: TCreateParams);
begin
  inherited CreateParams(Params);
  Params.WinClassName := 'StoreSystemfwxxglxt';
end;

// ===============================================
// Handle CM_RESTORE Message (Restore Application)
// ===============================================

procedure TSysForm.RestoreRequest(var message: TMessage);
begin
  if IsIconic(Application.Handle) = TRUE then
    Application.Restore
  else
    Application.BringToFront;
end;
// ===============================================

procedure TSysForm.ToolButton8Click(Sender: TObject);
begin
  Close;
end;

procedure TSysForm.meuexitClick(Sender: TObject);
begin
  Close;
end;

procedure TSysForm.meusydwxxClick(Sender: TObject);
var
  SydwChild: Tsydxxform;
begin
  SydwChild := Tsydxxform.Create(Application);
  SydwChild.Show;
end;

procedure TSysForm.mnuWindowToolClick(Sender: TObject);
begin
  mnuWindowTool.Checked := not mnuWindowTool.Checked;
  desktopform.mainToolBar.Visible := mnuWindowTool.Checked;
  desktopform.mainCoolBar.Visible := mnuWindowTool.Checked;
end;

procedure TSysForm.mnuWindowstatusClick(Sender: TObject);
begin
  mnuWindowstatus.checked := not mnuWindowstatus.checked;
  mainstatusbar.visible := mnuWindowstatus.checked;
end;

procedure TSysForm.meubmmlClick(Sender: TObject);
begin
  if Bmmlform = nil then Bmmlform := Tbmmlform.Create(SysForm);
  Bmmlform.Show;
end;

procedure TSysForm.meukhzlxxClick(Sender: TObject);
begin
  if frmkhzl = nil then frmkhzl := Tfrmkhzl.Create(SysForm);
  frmkhzl.show;
end;

procedure TSysForm.FormCreate(Sender: TObject);
begin
  try
    fwxxgldb.LoginPrompt := False;
    fwxxgldb.Close;
    fwxxgldb.DatabaseName := 'fwxxgl';
    fwxxgldb.Params.Values['ODBC DSN'] := 'fwxxgl_ODBC';
    fwxxgldb.Params.Values['DriverName'] := 'Microsoft Access Driver (*.mdb)';
    fwxxgldb.Params.Values['OPEN MODE'] := 'READ/WRITE';
    fwxxgldb.Params.Values['User Name'] := 'admin';
    fwxxgldb.Params.Values['Password'] := '000000';
    fwxxgldb.Open;
  except
    MessageBox(handle, '数据库联接失败,请检查系统配置或网线和服务器是否正常。', pchar('提示信息'), mb_IconWarning + mb_OK);
    Application.Terminate;
  end;
  loginform := Tloginform.Create(Application);
  Splashform.Hide;
  Splashform.Free;
  loginform.SHOWMODAL;
  if LoginFlag = True then
    begin
      mainstatusbar.Panels[1].text := '操作员:' + sys_czyxm;
      mainstatusbar.Panels[4].text := sys_date;
    end
  else
    begin
      Application.Terminate;
    end;
end;

procedure TSysForm.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  if MessageBox(handle, '确定要退出本系统吗?', pchar('提示信息'), mb_IconQuestion + mb_YesNo) = mrNO then
    begin
      Action := caNone
    end
  else
    begin
      Action := caFree;
      fwxxgldb.Connected := False;
      fwxxgldb.Close;
    end;
end;

procedure TSysForm.meuygmlClick(Sender: TObject);
begin
  if frmygdagl = nil then frmygdagl := Tfrmygdagl.Create(SysForm);
  frmygdagl.Show;
end;

procedure TSysForm.D1Click(Sender: TObject);
begin
  Cascade;
end;

procedure TSysForm.S1Click(Sender: TObject);
begin
  TileMode := tbHorizontal;
  Tile;
end;

procedure TSysForm.C1Click(Sender: TObject);
begin
  TileMode := tbVertical;
  Tile;
end;

procedure TSysForm.P1Click(Sender: TObject);
begin
  ArrangeIcons;
end;

procedure TSysForm.Q1Click(Sender: TObject);
begin
  ActiveMDIChild.Close;
end;

procedure TSysForm.A2Click(Sender: TObject);
var i: Integer;
begin
  for i := MDIChildCount - 1 downto 0 do MDIChildren[i].Close;
end;

procedure TSysForm.FormActivate(Sender: TObject);
begin
  if desktopform = nil then desktopform := Tdesktopform.Create(sysform);
  desktopform.Show;
  desktopform.mainToolBar.Visible := mnuWindowTool.Checked;
  desktopform.mainCoolBar.Visible := mnuWindowTool.Checked;
end;

procedure TSysForm.N13Click(Sender: TObject);
begin
  if frmdhsl = nil then frmdhsl := Tfrmdhsl.Create(sysform);
  frmdhsl.show;
end;

procedure TSysForm.meuyhcsszClick(Sender: TObject);
begin
  if frmxtcssz = nil then frmxtcssz := Tfrmxtcssz.Create(SysForm);
  frmxtcssz.Show;
end;

procedure TSysForm.meuyhzczxClick(Sender: TObject);
begin
  if frmyhzczx = nil then frmyhzczx := Tfrmyhzczx.Create(sysform);
  frmyhzczx.show;
end;

procedure TSysForm.FormShow(Sender: TObject);
begin
  sys_path := GetExePath;
  sys_bmpath := GetExePath + 'Graphics\';
  sys_report := GetExePath + 'Reports\';
  Mainstatusbar.Panels[0].Width := Inttostr(Self.width - 340);
end;

procedure TSysForm.N12Click(Sender: TObject);
var
  lsbl_cxlj: string;
begin
  lsbl_cxlj := sys_path + 'Calendar.exe';
  ShellExecute(handle, 'open', Pchar(lsbl_cxlj), '', '', sw_shownormal);
end;

procedure TSysForm.N11Click(Sender: TObject);
var
  lsbl_cxlj: string;
begin
  lsbl_cxlj := sys_path + 'Calc.exe';
  ShellExecute(handle, 'open', Pchar(lsbl_cxlj), '', '', sw_shownormal);
end;

function TSysForm.GetExePath: string;
var
  lsbl_x, lsbl_y: integer;
begin
  lsbl_y := 0;
  Result := Application.ExeName;
  for lsbl_x := 1 to length(Result) do
    if Result[lsbl_x] = '\' then
      lsbl_y := lsbl_x;
  Result := copy(Result, 1, lsbl_y);
end;

function TSysForm.GetCzyqx(Tczybh: string; Tqxbh: string; Tqxjb: string): string;
var
  lsbl_czqx: string;
  lsbl_length: string;
begin
  lsbl_czqx := '';
  czyqxQuery.Close;
  czyqxQuery.SQL.Clear;
  if Trim(Tczybh) <> '' then
    begin
      if Trim(Tqxbh) = '' then
        begin
          czyqxQuery.SQL.Add('Select czy_sfxz from czyqxk');
          czyqxQuery.SQL.Add('where czy_bh=:lsbl_czybh and czy_qxjb=:lsbl_qxjb');
          czyqxQuery.ParamByName('lsbl_czybh').AsString := Tczybh;
          czyqxQuery.ParamByName('lsbl_qxjb').AsString := Tqxjb;
        end
      else
        begin
          lsbl_length := inttostr(Length(Tqxbh));
          czyqxQuery.SQL.Add('Select czy_sfxz from czyqxk');
          czyqxQuery.SQL.Add('where czy_bh=:lsbl_czybh and Left(czy_qxxmbh,' + lsbl_length + ')=:lsbl_qxbh and czy_qxjb=:lsbl_qxjb');
          czyqxQuery.ParamByName('lsbl_czybh').AsString := Tczybh;
          czyqxQuery.ParamByName('lsbl_qxbh').AsString := Tqxbh;
          czyqxQuery.ParamByName('lsbl_qxjb').AsString := Tqxjb;
        end;
      czyqxQuery.Prepare;
      czyqxQuery.Open;
      with czyqxQuery do
        begin
          First;
          while not eof do
            begin
              if FieldValues['czy_sfxz'] = True then
                begin
                  lsbl_czqx := lsbl_czqx + '1';
                end
              else
                begin
                  lsbl_czqx := lsbl_czqx + '0';
                end;
              next;
            end;
        end;
      czyqxQuery.Close;
      result := lsbl_czqx;
    end
  else
    begin
      Result := '';
    end;
end;

procedure TSysForm.MnuAboutClick(Sender: TObject);
begin
  frmabout := Tfrmabout.Create(Self);
  frmabout.Showmodal;
end;

function TsysForm.StrLike(str1: string; Str2: string): Boolean;
begin
  if Pos(str1, str2) <> 0 then
    result := True
  else
    result := False
end;

procedure TSysForm.N16Click(Sender: TObject);
begin
  frmghczy := Tfrmghczy.Create(Self);
  frmghczy.showmodal;
end;

procedure TSysForm.N17Click(Sender: TObject);
begin
  frmghkl := Tfrmghkl.Create(Self);
  frmghkl.showmodal;
end;

procedure TSysForm.N18Click(Sender: TObject);
begin
  frmghxtrq := Tfrmghxtrq.Create(Self);
  frmghxtrq.showmodal;
end;

procedure TSysForm.FormResize(Sender: TObject);
begin
  Mainstatusbar.Panels[0].Width := Inttostr(Self.width - 340);
  Desktopform.Top := 0;
  Desktopform.Left := 0;
  Desktopform.Height := self.Height - 69;
  Desktopform.Width := self.Width - 12;
end;

procedure TSysForm.meufwlxmlClick(Sender: TObject);
begin
  if frmfwlxml = nil then frmfwlxml := Tfrmfwlxml.Create(SysForm);
  frmfwlxml.Show;
end;

procedure TSysForm.MenufwdjbClick(Sender: TObject);
begin
  if frmfwdjb = nil then frmfwdjb := Tfrmfwdjb.Create(SysForm);
  frmfwdjb.Show;
end;

procedure TSysForm.Contents1Click(Sender: TObject);
begin
  if frmkhhfb = nil then frmkhhfb := Tfrmkhhfb.Create(SysForm);
  frmkhhfb.Show;
end;

procedure TSysForm.fwltjMenuClick(Sender: TObject);
begin
  selectboolean := False;
  selecttext1 := '';
  selecttext2 := '';
  if frmtjxz = nil then frmtjxz := Tfrmtjxz.Create(Sysform);
  frmtjxz.DateTP1.Date := Now;
  frmtjxz.DateTP2.Date := Now;
  frmtjxz.ShowModal;
  if selectboolean = True then
    begin
      if frmfwltj = nil then
        begin
          frmfwltj := Tfrmfwltj.Create(SysForm);
          fwltj_date1 := selectdate1;
          fwltj_date2 := selectdate2;
          fwltj_bmbh := selecttext1 + '%';
          fwltj_bmmc := selecttext2;
          frmfwltj.Label5.Caption := Datetostr(fwltj_date1) + ' 至 ' + Datetostr(fwltj_date2);
          if fwltj_bmmc <> '' then
            begin
              frmfwltj.Label3.Visible := True;
              frmfwltj.Label4.Visible := True;
              frmfwltj.Label4.Caption := fwltj_bmmc;
            end;
          frmfwltj.Show;
          frmfwltj.Update;
          frmfwltj.datatj();
        end;
    end;
end;

procedure TSysForm.Undo1Click(Sender: TObject);
begin
  if frmbxpzlr = nil then frmbxpzlr := Tfrmbxpzlr.Create(SysForm);
  frmbxpzlr.show;
end;

end.

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -