📄 ufrmmaim.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 + -