📄 main.~pas
字号:
unit main;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, ExtCtrls, Menus, ComCtrls, ToolWin, Buttons, StdCtrls, AppEvnts,
LabelButton, TradeImage, MaskImageButton, MoveImageButton, TrayBarIcon,
ImgList, HemisphereButton;
type
Tfrm_main = class(TForm)
palUp: TPanel;
palLeftUp: TPanel;
imgLeftUp: TImage;
palRightUp: TPanel;
imgRightUp: TImage;
palUpMid: TPanel;
imgCaption: TImage;
palDown: TPanel;
imgLeftDown: TImage;
imgRightDown: TImage;
imgDownMin: TImage;
palLeft: TPanel;
palRight: TPanel;
imgRight: TImage;
imgCloseButton: TImage;
imgMinButton: TImage;
imgSizeButton: TImage;
imgMaxButton: TImage;
imgRestoreButton: TImage;
imgSysIcon: TImage;
popSystemMenu: TPopupMenu;
N_Restore: TMenuItem;
N_Max: TMenuItem;
N_Min: TMenuItem;
N_Move: TMenuItem;
N_Size: TMenuItem;
N_Speater: TMenuItem;
N_Close: TMenuItem;
palClient: TPanel;
lbCaption: TLabel;
CoolBarMenu: TCoolBar;
ToolBarMenu: TToolBar;
imgLeft: TImage;
imgColorLeftUp: TImage;
imgGrayCaption: TImage;
imgGrayMenuBar: TImage;
imgGrayRightUp: TImage;
imgColorCaption: TImage;
imgGrayLeftUp: TImage;
imgColorRightUp: TImage;
imgRightUp1: TImage;
imgLeftUp1: TImage;
imgColorMenubar: TImage;
Menu1: 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;
N15: TMenuItem;
N16: TMenuItem;
N17: TMenuItem;
N18: TMenuItem;
ztl: TStatusBar;
N19: TMenuItem;
N20: TMenuItem;
N21: TMenuItem;
N22: TMenuItem;
N23: TMenuItem;
b_vip: TMaskImgBtn;
blabel_vip: TLabelBtn;
b_vcdgl: TMaskImgBtn;
LabelBtn2: TLabelBtn;
b_vcdcz: TMaskImgBtn;
b_vcdhz: TMaskImgBtn;
LabelBtn3: TLabelBtn;
LabelBtn4: TLabelBtn;
b_vcdcx: TMaskImgBtn;
blabel_vcdcx: TLabelBtn;
bLabel_cash: TLabelBtn;
b_cash: TMaskImgBtn;
blabel_vippass: TLabelBtn;
b_vippass: TMaskImgBtn;
blabel_qk: TLabelBtn;
b_qk: TMaskImgBtn;
procedure imgMinButtonClick(Sender: TObject);
procedure imgSizeButtonClick(Sender: TObject);
procedure imgCloseButtonClick(Sender: TObject);
procedure imgCaptionMouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure imgCaptionMouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
procedure imgCaptionMouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure FormCreate(Sender: TObject);
procedure imgSysIconMouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure popSystemMenuPopup(Sender: TObject);
procedure N_SizeClick(Sender: TObject);
procedure N_MoveClick(Sender: TObject);
procedure FormShow(Sender: TObject);
procedure N18Click(Sender: TObject);
procedure N2Click(Sender: TObject);
procedure FormActivate(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure N3Click(Sender: TObject);
procedure b_vipClick(Sender: TObject);
procedure b_vcdglClick(Sender: TObject);
procedure b_vcdczClick(Sender: TObject);
procedure b_vcdhzClick(Sender: TObject);
procedure b_vcdcxClick(Sender: TObject);
procedure bLabel_cashClick(Sender: TObject);
procedure b_vippassClick(Sender: TObject);
procedure MaskImgBtn1Click(Sender: TObject);
procedure b_qkClick(Sender: TObject);
procedure N17Click(Sender: TObject);
private
{ Private declarations }
canmove:boolean;
curPoint:TPoint;
oldPoint:TPoint;
Canvas:TCanvas;
protected
procedure CreateParams(var Params:TCreateParams);override;
procedure WMActivate(var Msg:TWMACTIVATE); message WM_ACTIVATE;
public
{ Public declarations }
end;
var
frm_main: Tfrm_main;
implementation
uses publicvar, datam, dw, zzy, long, lb, hygl, vcdgl, vcdcz, vcdhz, vcdcx,
cash, passyz, passnull, qkcl, about;
{$R *.dfm}
procedure Tfrm_main.CreateParams(var Params:TCreateParams);
begin
inherited CreateParams(Params);
if BorderStyle<>bsNone then
Params.Style :=WS_THICKFRAME or WS_POPUP or WS_BORDER;
end;
procedure Tfrm_main.imgMinButtonClick(Sender: TObject);
begin
if Application.MainForm =self then
Application.Minimize
else
DefWindowProc(Handle, WM_SYSCOMMAND, SC_MINIMIZE, 0);
end;
procedure Tfrm_main.imgSizeButtonClick(Sender: TObject);
begin
if self.WindowState = wsNormal then
begin
DefWindowProc(Handle, WM_SYSCOMMAND, SC_MAXIMIZE, 0);
imgSizeButton.Picture :=imgRestoreButton.Picture;
end
else
begin
DefWindowProc(Handle, WM_SYSCOMMAND, SC_RESTORE, 0);
imgSizeButton.Picture :=imgMaxButton.Picture;
end;
end;
procedure Tfrm_main.imgCloseButtonClick(Sender: TObject);
begin
DefWindowProc(Handle, WM_SYSCOMMAND, SC_CLOSE, 0);
end;
procedure Tfrm_main.imgCaptionMouseDown(Sender: TObject;
Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
if (Button=mbLeft)and(ssLeft in Shift)then
begin
canmove:=true;
Canvas:=TCanvas.Create;
with Canvas do
begin
pen.Style :=psdot;
brush.Style :=bsClear;
pen.Width :=2;
Pen.Mode :=pmNotXor;
Handle :=GetDC(0);
Rectangle(left,top,Left+width,top+height);
curPoint.X :=X;
curPoint.Y :=Y;
oldPoint.X :=Left;
oldPoint.Y :=Top;
end; //end with
end; //end if
end;
procedure Tfrm_main.imgCaptionMouseMove(Sender: TObject;
Shift: TShiftState; X, Y: Integer);
begin
if not canmove then exit;
with Canvas do
begin
Rectangle(oldPoint.x,oldPoint.y,oldPoint.x+Width,oldPoint.y+Height);
oldPoint.x :=Left +X-curPoint.x;
oldPoint.y :=Top +Y-curPoint.y;
Rectangle(oldPoint.x,oldPoint.y,oldPoint.x+Width,oldPoint.y+Height);
end;
end;
procedure Tfrm_main.imgCaptionMouseUp(Sender: TObject;
Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
if not canmove then exit;
with Canvas do
begin
Rectangle(oldPoint.x,oldPoint.y,oldPoint.x+Width,oldPoint.y+Height);
Left :=oldPoint.x;
Top :=oldPoint.y;
Free;
end;
canmove:=not canmove;
end;
procedure Tfrm_main.FormCreate(Sender: TObject);
begin
lbCaption.Caption :=Caption;
//frm_long:=tfrm_long.create(application);
//frm_long.showmodal;
end;
procedure Tfrm_main.imgSysIconMouseDown(Sender: TObject;
Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
PopSystemMenu.Popup(Left+ImgSysIcon.Left,Top+ImgSysIcon.Top+ImgSysIcon.Height);
end;
procedure Tfrm_main.popSystemMenuPopup(Sender: TObject);
begin
N_Restore.Enabled :=imgSizeButton.Visible and (WindowState =wsMaximized);
N_Max.Enabled :=imgSizeButton.Visible and (WindowState =wsNormal);
N_Size.Enabled :=imgSizeButton.Visible ;
end;
procedure Tfrm_main.N_SizeClick(Sender: TObject);
begin
DefWindowProc(Handle, WM_SYSCOMMAND, SC_SIZE, 0);
end;
procedure Tfrm_main.N_MoveClick(Sender: TObject);
begin
DefWindowProc(Handle, WM_SYSCOMMAND, SC_MOVE, 0);
end;
procedure Tfrm_main.FormShow(Sender: TObject);
begin
if WindowState=wsNormal then
imgSizeButton.Picture.Bitmap :=imgMaxButton.Picture.Bitmap
else if WindowState=wsMaximized then
imgSizeButton.Picture.Bitmap :=imgRestoreButton.Picture.Bitmap
end;
procedure Tfrm_main.WMActivate(var Msg: TWMACTIVATE);
begin
if (Msg.Active =WA_ACTIVE) or (Msg.Active =WA_CLICKACTIVE) then
begin
imgCaption.Picture.Bitmap :=imgColorCaption.Picture.Bitmap;
imgLeftUp1.Picture.Bitmap :=imgColorLeftUp.Picture.Bitmap;
imgRightUp1.Picture.Bitmap :=imgColorRightUp.Picture.Bitmap;
coolBarMenu.Bitmap :=imgColorMenubar.Picture.Bitmap;
end
else begin
imgCaption.Picture.Bitmap :=imgGrayCaption.Picture.Bitmap;
imgLeftUp1.Picture.Bitmap :=imgGrayLeftUp.Picture.Bitmap;
imgRightUp1.Picture.Bitmap :=imgGrayRightUp.Picture.Bitmap;
coolBarMenu.Bitmap :=imgGrayMenubar.Picture.Bitmap;
end;
end;
procedure Tfrm_main.N18Click(Sender: TObject);
begin
frm_dw:=tfrm_dw.create(application);
frm_dw.showmodal;
end;
procedure Tfrm_main.N2Click(Sender: TObject);
begin
frm_zzy:=tfrm_zzy.create(application);
frm_zzy.showmodal;
end;
procedure Tfrm_main.FormActivate(Sender: TObject);
begin
ztl.Panels[1].Text:=datetostr(date())+'|'+zzyname;
dm.ADO_dw.Open;
dm.ado_dw.First;
dwname:=dm.ado_dw.FieldByName('名称').asstring;
ztl.Panels[0].Text:='单位名称:'+dwname;
dm.ADO_dw.Close;
end;
procedure Tfrm_main.FormClose(Sender: TObject; var Action: TCloseAction);
begin
frm_long.Close;
release;
end;
procedure Tfrm_main.N3Click(Sender: TObject);
begin
frm_lb:=tfrm_lb.create(application);
frm_lb.showmodal;
end;
procedure Tfrm_main.b_vipClick(Sender: TObject);
begin
frm_hygl:=tfrm_hygl.create(application);
frm_hygl.showmodal;
end;
procedure Tfrm_main.b_vcdglClick(Sender: TObject);
begin
frm_vcdgl:=tfrm_vcdgl.create(application);
frm_vcdgl.showmodal;
end;
procedure Tfrm_main.b_vcdczClick(Sender: TObject);
begin
frm_vcdcz:=tfrm_vcdcz.create(application);
frm_vcdcz.showmodal;
end;
procedure Tfrm_main.b_vcdhzClick(Sender: TObject);
begin
frm_vcdhz:=tfrm_vcdhz.create(application);
frm_vcdhz.showmodal;
end;
procedure Tfrm_main.b_vcdcxClick(Sender: TObject);
begin
frm_vcdcx:=tfrm_vcdcx.create(application);
frm_vcdcx.showmodal;
end;
procedure Tfrm_main.bLabel_cashClick(Sender: TObject);
begin
frm_cash:=tfrm_cash.create(application);
frm_cash.showmodal;
end;
procedure Tfrm_main.b_vippassClick(Sender: TObject);
begin
frm_pass:=tfrm_pass.create(application);
frm_pass.showmodal;
end;
procedure Tfrm_main.MaskImgBtn1Click(Sender: TObject);
begin
frm_pass:=tfrm_pass.create(application);
frm_pass.showmodal;
end;
procedure Tfrm_main.b_qkClick(Sender: TObject);
begin
frm_qkcl:=tfrm_qkcl.create(application);
frm_qkcl.showmodal;
end;
procedure Tfrm_main.N17Click(Sender: TObject);
begin
frm_about:=tfrm_about.create(application);
frm_about.showmodal;
end;
end.
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -