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

📄 ufrmmaim.pas

📁 水电管理系统,介绍了水电管理系统的基本结构和基本功能,对进行这方面的开发人员有一定帮助
💻 PAS
字号:
unit ufrmMaim;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms,
  ComCtrls, ExtCtrls, ToolWin, Buttons, Menus, ImgList, XPMenu, UCommon,
  DBCtrls, MyNavEh;

type
  TfrmMaim = class(TForm)
    ControlBar1: TControlBar;
    StatusBar: TStatusBar;
    ToolBar1: TToolBar;
    SpeedButton1: TSpeedButton;
    SpeedButton2: TSpeedButton;
    SpeedButton3: TSpeedButton;
    ToolBar2: TToolBar;
    MainMenu1: TMainMenu;
    N1: TMenuItem;
    N2: TMenuItem;
    N3: TMenuItem;
    N4: TMenuItem;
    N5: TMenuItem;
    N6: TMenuItem;
    N7: TMenuItem;
    N8: TMenuItem;
    N9: TMenuItem;
    N10: TMenuItem;
    N11: TMenuItem;
    N12: TMenuItem;
    N13: TMenuItem;
    N14: TMenuItem;
    N15: TMenuItem;
    N16: TMenuItem;
    N17: TMenuItem;
    N18: TMenuItem;
    N19: TMenuItem;
    N21: TMenuItem;
    N22: TMenuItem;
    N23: TMenuItem;
    N24: TMenuItem;
    Image1: TImage;
    Timer1: TTimer;
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure FormDestroy(Sender: TObject);
    procedure N4Click(Sender: TObject);
    procedure SpeedButton3Click(Sender: TObject);
    procedure SpeedButton2Click(Sender: TObject);
    procedure SpeedButton4Click(Sender: TObject);
    procedure N16Click(Sender: TObject);
    procedure N24Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure N6Click(Sender: TObject);
    procedure N7Click(Sender: TObject);
    procedure N17Click(Sender: TObject);
    procedure N18Click(Sender: TObject);
    procedure N13Click(Sender: TObject);
    procedure N19Click(Sender: TObject);
    procedure N2Click(Sender: TObject);
    procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
    procedure Timer1Timer(Sender: TObject);
  private
    { Private declarations }
    DisPos: Integer;
    SysInfo: String;
    fClientInstance: TFarProc;
    fPrevClientProc: TFarProc;
    procedure ClientWndProc(var Message: TMessage);  //填充桌面

    Procedure ShowStatus(strStatu: String);
    Procedure ShowForm(subForm: TForm; strStatu: String);
  public
    { Public declarations }
  end;

var
  frmMaim: TfrmMaim;

implementation

uses ufrmAbout, ufrmMeter, ufrmWorkshop, ufrmCnfgPara, ufrmMeterSort,
  ufrmPrice, ufrmReport, ufrmTakeMeter, uLogin;

{$R *.DFM}

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

procedure TfrmMaim.FormDestroy(Sender: TObject);
begin
  Sdgl.Free;
  frmMaim := nil;
end;

procedure TfrmMaim.N4Click(Sender: TObject);
begin
  //ShowForm(frmAbout, '关于...');
  if not Assigned(frmAbout) Then
    frmAbout := TfrmAbout.Create(Self);
  frmAbout.ShowModal;
  ShowStatus('关于...'); 
end;

procedure TfrmMaim.SpeedButton3Click(Sender: TObject);
var
  iChildFormCount: Integer;
begin
  for iChildFormCount := 0 to MDIChildCount - 1 do
    MDIChildren[iChildFormCount].Close;
end;

procedure TfrmMaim.SpeedButton2Click(Sender: TObject);
begin
  if MDIChildCount <> 0 then
    ActiveMDIChild.Close;
end;

procedure TfrmMaim.SpeedButton4Click(Sender: TObject);
begin
  if not Assigned(frmMeter) then
    frmMeter := TfrmMeter.Create(Self);
  frmMeter.Show;
  ShowStatus('编号维护');
end;

procedure TfrmMaim.N16Click(Sender: TObject);
begin
  if not Assigned(frmWorkshop) then
    frmWorkshop := TfrmWorkshop.Create(Self);
  frmWorkshop.show;

  ShowStatus('车间班组信息维护');
end;

procedure TfrmMaim.ShowStatus(strStatu: String);
begin
  StatusBar.Panels[0].Text := strStatu;
  StatusBar.Refresh;
end;

procedure TfrmMaim.N24Click(Sender: TObject);
begin
  if not Assigned(frmCnfgPara) then
    frmCnfgPara := TfrmCnfgPara.Create(Self);
  frmCnfgPara.ShowModal;

  ShowStatus('系统参数配置!');
end;

procedure TfrmMaim.FormCreate(Sender: TObject);
begin
  Sdgl := TSDMg.Create;

  //todo 填充桌面
  FClientInstance := MakeObjectInstance(ClientWndProc);
  FPrevClientProc := Pointer(GetWindowLong(ClientHandle, GWL_WNDPROC));
  SetWindowLong(ClientHandle, GWL_WNDPROC, LongInt(FClientInstance));
  //End

  SysInfo := StringOfChar(' ', 20) + '欢迎使用《水电管理系统》  版本:V0.0.1 Beta     软件制作: whqcfp  (C) 2003-2005' + StringOfChar(' ', 20);
  StatusBar.Panels[1].Text := '使用单位:' + Sdgl.CurUnitName;
end;

procedure TfrmMaim.N6Click(Sender: TObject);
begin
  N6.Checked := not N6.Checked;
  ControlBar1.Visible := not ControlBar1.Visible;
end;

procedure TfrmMaim.N7Click(Sender: TObject);
begin
  N7.Checked := not N7.Checked;
  StatusBar.Visible := not StatusBar.Visible;
end;

procedure TfrmMaim.N17Click(Sender: TObject);
begin
  if not Assigned(frmMeterSort) then
    frmMeterSort := TfrmMeterSort.Create(Self);
  frmMeterSort.Show;
  ShowStatus('类型维护');
end;

procedure TfrmMaim.ShowForm(subForm: TForm; strStatu: String);
begin
  if not Assigned(subForm) then
    subForm :=  Create(Self);
  subForm.Show;
  ShowStatus(strStatu);
end;

procedure TfrmMaim.N18Click(Sender: TObject);
begin
  if not Assigned(frmPrice) then
    frmPrice := TfrmPrice.Create(Self);
  frmPrice.Show;
  ShowStatus('单价维护');
end;

procedure TfrmMaim.ClientWndProc(var Message: TMessage);
var
  Dc: hDC;
  Row: Integer;
  Col: Integer;
begin
  with Message do
    case Msg of
      WM_ERASEBKGND:
        begin
          Dc := TWMEraseBkGnd(Message).Dc;
          for Row := 0 to ClientHeight div Image1.Picture.Height do
            for Col := 0 to ClientWidth div Image1.Picture.Width do
              BitBlt(Dc,
                Col * Image1.Picture.Width,
                Row * Image1.Picture.Height,
                Image1.Picture.Width,
                Image1.Picture.Height,
                Image1.Picture.Bitmap.Canvas.Handle,
                0,
                0,
                SRCCOPY
                );
          Result := 1;
        end;
    else
      Result := CallWindowProc(FPrevClientProc,
        ClientHandle,
        Msg,
        wParam,
        lParam
        );
    end;
end;

procedure TfrmMaim.N13Click(Sender: TObject);
begin
  if not Assigned(frmReport) then
    frmReport := TfrmReport.Create(Self);
  frmReport.Show;
  ShowStatus('报表管理');
end;

procedure TfrmMaim.N19Click(Sender: TObject);
begin
  if not Assigned(frmTakeMeter) then
    frmTakeMeter := TfrmTakeMeter.Create(Self);
  frmTakeMeter.Show;
  ShowStatus('连续式抄表');
end;

procedure TfrmMaim.N2Click(Sender: TObject);
begin
  Close;
end;

procedure TfrmMaim.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
begin
  if MessageBox(Handle, '确定要退出本系统吗?', '退出提示',
                MB_YESNO or MB_ICONINFORMATION) = IDYes then
    CanClose := True
  else
    CanClose := False;
end;

procedure TfrmMaim.Timer1Timer(Sender: TObject);
begin
  //todo  动态显示信息
  StatusBar.Panels[2].Text := Copy(SysInfo, DisPos * 2 + 1, Length(SysInfo));
  Inc(DisPos);
  if DisPos * 2 + 1 > Length(SysInfo) - 1 then
    DisPos := 0;
end;

end.

⌨️ 快捷键说明

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