?? neoform.pas
字號(hào):
unit NeoForm;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
ExtCtrls, StdCtrls, ImgList, ToolWin, ComCtrls, Menus, Buttons;
type
TWhichBorder = (wbTop, wbLeft, wbRight, wbBottom, wbLeftTop, wbLeftBottom, wbRightTop,
wbRightBottom, wbNone);
TzypNeoBorderIcons = array[1..3] of Boolean;
TGBKPForm = class(TForm)
ImageTop: TImage;
ImageLeft: TImage;
ImageLeftTop: TImage;
ImageRightTop: TImage;
ImageRight: TImage;
ImageBottom: TImage;
LabelCaption: TLabel;
ImageIcon: TImage;
PanelBkGnd: TPanel;
ImageMax: TImage;
ImageMin: TImage;
ImageNormal: TImage;
ImageClose: TImage;
ImageDeactiveLeftTop: TImage;
ImageDeactiveTop: TImage;
ImageDeactiveRightTop: TImage;
ImageActiveTop: TImage;
ImageActiveLeftTop: TImage;
ImageActiveRightTop: TImage;
ImageActiveMenubar: TImage;
ImageDeactiveMenubar: TImage;
ImageLeftBottom: TImage;
ImageRightBottom: TImage;
CoolBar: TCoolBar;
procedure FormCreate(Sender: TObject);
procedure FormResize(Sender: TObject);
procedure ImageCloseClick(Sender: TObject);
procedure ImageMinClick(Sender: TObject);
procedure ImageNormalClick(Sender: TObject);
procedure ImageMaxClick(Sender: TObject);
procedure ImageTopDblClick(Sender: TObject);
procedure SetCanResize(value: Boolean);
function GetcanResize: Boolean;
procedure SetBorderIcons;
procedure ImageTopMouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure ImageTopMouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure ImageTopMouseMove(Sender: TObject; Shift: TShiftState;
X, Y: Integer);
procedure ImageIconDblClick(Sender: TObject);
procedure FormCanResize(Sender: TObject; var NewWidth,
NewHeight: Integer; var Resize: Boolean);
procedure CoolBarClick(Sender: TObject);
private
{ Private declarations }
FCanResize, FisDown: Boolean;
FDetax, FDetaY: Integer;
FP, FOldP: TPoint;
FzypNeoBorderIcons: TZypNeoBorderIcons;
public
{ Public declarations }
protected
procedure WndProc(var Msg: TMessage); override;
procedure WMNCHitTest(var Msg: TWMNCHitTest); message WM_NCHITTEST;
end;
var
GBKPForm: TGBKPForm;
cMaxWidth: Word = 800; //1024;//
cMaxHeight: Word = 600; //896;//
implementation
{$R *.DFM}
const
cTopHeight = 50;
cRightTopWidth = 97;
cLeftWidth = 10;
cRightWidth = 10;
cBottomHeight = 12;
//cMaxWidth =1024;//800;//
//cMaxHeight =896;//600;//
cMinWidth = 300;
cMinHeight = 200;
cPenWidth = 3;
cIconTop = 6;
procedure TGBKPForm.WMNCHitTest(var Msg: TWMNCHitTest);
var
pt: TPoint;
begin
if (GetCanReSize = False) or (WindowState <> wsNormal) then
begin
inherited;
exit;
end;
pt := Point(Msg.xPos, Msg.yPos);
pt := ScreenToClient(pt);
if (pt.x < 5) and (pt.y < 5) then Msg.Result := htTopLeft
else if (pt.x > width - 5) and (pt.y < 5) then Msg.Result := htTopRight
else if (pt.x > width - 5) and (pt.y > height - 5) then Msg.Result := htBottomRight
else if (pt.x < 5) and (pt.y > height - 5) then Msg.Result := htBottomLeft
else if (pt.x < 5) then Msg.Result := htLeft
else if (pt.y < 5) then Msg.Result := htTop
else if (pt.x > width - 5) then Msg.Result := htRight
else if (pt.y > height - 5) then Msg.Result := htBottom
else inherited;
end;
procedure TGBKPForm.SetBorderIcons;
begin
case BorderStyle of
bsToolWindow,
bsSizeToolWin,
bsDialog:
begin
FzypNeoBorderIcons[1] := True;
FzypNeoBorderIcons[2] := False; // True ;
FzypNeoBorderIcons[3] := False; //True;
ImageIcon.Visible := False;
ImageIcon.Enabled := False;
end;
bsNone: //雖然設(shè)為bsNone,但是仍然有Caption欄,如果連Caption欄都不想要的話,
begin //老兄,我勸你還是不要用我的這個(gè)Form了。
FzypNeoBorderIcons[1] := False;
FzypNeoBorderIcons[2] := False;
FzypNeoBorderIcons[3] := False;
ImageIcon.Visible := False; ImageIcon.Enabled := False;
end;
else
FzypNeoBorderIcons[1] := True;
FzypNeoBorderIcons[2] := True;
FzypNeoBorderIcons[3] := True;
ImageIcon.Visible := True;
ImageIcon.Enabled := True;
end;
if biSystemMenu in BorderIcons then
begin
FzypNeoBorderIcons[1] := FzypNeoBorderIcons[1] and True;
FzypNeoBorderIcons[2] := FzypNeoBorderIcons[2] and True;
FzypNeoBorderIcons[3] := FzypNeoBorderIcons[3] and True;
ImageIcon.Visible := ImageIcon.Visible and True;
ImageIcon.Enabled := ImageIcon.Enabled and True;
end
else
begin
FzypNeoBorderIcons[1] := FzypNeoBorderIcons[1] and False;
FzypNeoBorderIcons[2] := FzypNeoBorderIcons[2] and False;
FzypNeoBorderIcons[3] := FzypNeoBorderIcons[3] and False;
ImageIcon.Visible := ImageIcon.Visible and False;
ImageIcon.Enabled := ImageIcon.Enabled and False;
end;
if biMinimize in BorderIcons then
begin
FzypNeoBorderIcons[3] := FzypNeoBorderIcons[3] and True;
end
else
begin
FzypNeoBorderIcons[3] := FzypNeoBorderIcons[3] and False;
end;
if biMaximize in BorderIcons then
begin
FzypNeoBorderIcons[2] := FzypNeoBorderIcons[2] and True;
end
else
begin
FzypNeoBorderIcons[2] := FzypNeoBorderIcons[2] and False;
end;
ImageClose.Visible := FzypNeoBorderIcons[1];
ImageClose.Enabled := FzypNeoBorderIcons[1];
ImageMax.Visible := FzypNeoBorderIcons[2];
ImageMax.Enabled := FzypNeoBorderIcons[2];
ImageMin.Visible := FzypNeoBorderIcons[3];
ImageMin.Enabled := FzypNeoBorderIcons[3];
end;
procedure TGBKPForm.SetCanResize(value: Boolean);
begin
if FCanResize <> value then FCanResize := value;
end;
function TGBKPForm.GetcanResize;
begin
Result := FCanResize;
end;
procedure TGBKPForm.WndProc(var Msg: TMessage);
begin
inherited WndProc(Msg);
if Msg.Msg = WM_ACTIVATE then
begin
case Msg.WParamLo of
WA_ACTIVE, WA_CLICKACTIVE:
begin
ImageTop.Picture := ImageActiveTop.Picture;
ImageLeftTop.Picture := ImageActiveLeftTop.Picture;
ImageRightTop.Picture := ImageActiveRightTop.Picture;
//Coolbar.Bitmap := ImageActiveMenubar.Picture.Bitmap;
end;
WA_INACTIVE:
begin
ImageLeftTop.Picture := ImageDeactiveLeftTop.Picture;
ImageTop.Picture := ImageDeactiveTop.Picture;
ImageRightTop.Picture := ImageDeactiveRightTop.Picture;
// CoolBar.Bitmap := ImageDeactiveMenuBar.Picture.Bitmap;
end;
end;
end;
end;
procedure TGBKPForm.FormCreate(Sender: TObject);
begin
cMaxWidth := screen.width; //
cMaxHeight := screen.Height; //
{ CASE GetDeviceCaps(GetDC(GBKPForm.Handle),HORZRES) of
640 : //對(duì)640×480分辨率進(jìn)行處理的代碼;
800 : //對(duì)800×600分辨率進(jìn)行處理的代碼;
1024: //對(duì)1024×768分辨率進(jìn)行處理的代碼;
1280: //對(duì)1280×1024分辨率進(jìn)行處理的代碼; }
PanelBKGND.Color := TColor($00CFCFCF);
//因?yàn)镻anelBGNND是應(yīng)用程序的所有控件的平臺(tái),因此它的大小應(yīng)決定窗體的大小
Width := PanelBKGND.Width + cLeftWidth + cRightWidth;
Height := PanelBKGND.Height + cTopHeight + cBottomHeight - 2;
LabelCaption.Caption := Caption;
SetBorderIcons;
if (BorderStyle = bsSizeable) or (BorderStyle = bsSizeToolWin) then //窗體是否允許改變大小
begin
SetCanResize(True);
end
else
begin
SetCanResize(False);
end;
BorderStyle := bsNone;
if Assigned(Menu) then
begin
// CoolBar.Visible := True;
//Menubar.Menu:=Menu;
//toolbar.Menu:=Menu;
Menu := nil;
end
else
begin
//Coolbar.Visible := False;
end;
FormResize(Sender);
end;
procedure TGBKPForm.FormResize(Sender: TObject);
var
i: Integer;
begin
ImageTop.Left := 0;
ImageTop.Top := 0;
ImageTop.Width := ClientWidth;
ImageBottom.Width := ClientWidth;
ImageBottom.Top := ClientHeight - cBottomHeight;
ImageLeft.Height := ClientHeight;
ImageRight.Height := ClientHeight;
ImageRight.Left := ClientWidth - cRightWidth;
ImageLeftBottom.left := 0;
ImageLeftBottom.Top := ClientHeight - cBottomHeight;
ImageRightBottom.Top := ClientHeight - cBottomHeight;
ImageRightBottom.Left := ClientWidth - cRightWidth;
ImageRightTop.Left := ClientWidth - cRightTopWidth;
ImageRightTop.top := 0;
ImageLeftTop.Left := 0;
ImageLeftTop.Top := 0;
PanelBKGND.Left := cLeftWidth;
PanelBKGND.Top := cTopHeight;
PanelBKGND.Width := ClientWidth - cLeftWidth - cRightWidth;
PanelBKGND.Height := ClientHeight - cTopHeight - cBottomHeight + 2;
ImageMin.top := cIconTop;
ImageMax.top := cIconTop;
ImageNormal.Top := cIconTop;
ImageClose.top := cIconTop;
i := 1;
if FzypNeoBorderIcons[1] then
begin
ImageClose.Left := Width - 3 - i * 17 - 2;
Inc(i);
end;
if FzypNeoBorderIcons[2] then
begin
ImageMax.Left := Width - 3 - i * 17 - 2;
ImageNormal.Left := ImageMax.Left;
Inc(i);
end;
if FzypNeoBorderIcons[3] then
begin
ImageMin.Left := Width - 3 - i * 17 - 2;
end;
//MenuBar.Width:=ImageRightTop.Left-MenuBar.Left;
//toolbar.Width:=ImageRightTop.Left-toolbar.Left;
if FzypNeoBorderIcons[2] then
if WindowState = wsMaximized then
begin
ImageNormal.Enabled := True;
ImageNormal.Visible := True;
ImageMax.Enabled := False;
ImageMax.Visible := False;
end
else
begin
ImageNormal.Enabled := False;
ImageNormal.Visible := False;
ImageMax.Enabled := True;
Imagemax.Visible := True;
end;
end;
procedure TGBKPForm.ImageCloseClick(Sender: TObject);
begin
Close;
end;
procedure TGBKPForm.ImageMinClick(Sender: TObject);
begin
if Application.MainForm = Self then
Application.Minimize //Change here!!!
else
WindowState := wsMinimized;
end;
procedure TGBKPForm.ImageNormalClick(Sender: TObject);
begin
WindowState := wsNormal;
end;
procedure TGBKPForm.ImageMaxClick(Sender: TObject);
begin
WindowState := wsMaximized;
end;
procedure TGBKPForm.ImageTopDblClick(Sender: TObject);
begin
if WindowState <> wsMaximized then
WindowState := wsMaximized
else
WindowState := wsNormal;
end;
procedure TGBKPForm.ImageTopMouseDown(Sender: TObject;
Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
FisDown := True;
GetCursorPos(FOldP);
end;
procedure TGBKPForm.ImageTopMouseMove(Sender: TObject; Shift: TShiftState;
X, Y: Integer);
begin
if not FisDown then exit;
GetCursorPos(Fp);
FDetaX := Fp.x - Foldp.x;
FDetaY := FP.y - FOldP.y;
SetBounds(Left + FDetaX, Top + FDetaY, Width, Height);
GetCursorPos(FOldP);
end;
procedure TGBKPForm.ImageTopMouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
FisDown := false;
end;
procedure TGBKPForm.ImageIconDblClick(Sender: TObject);
begin
Close;
end;
procedure TGBKPForm.FormCanResize(Sender: TObject; var NewWidth,
NewHeight: Integer; var Resize: Boolean);
begin
if NewWidth >= cMaxWidth then NewWidth := cMaxWidth;
if NewWidth <= cMinWidth then NewWidth := cMinWidth;
if NewHeight >= cMaxHeight then NewHeight := cMaxHeight;
if NewHeight <= cMinHeight then NewHeight := cMinHeight;
end;
procedure TGBKPForm.CoolBarClick(Sender: TObject);
begin
ShowMessage(Sender.ClassName);
end;
end.
?? 快捷鍵說(shuō)明
復(fù)制代碼
Ctrl + C
搜索代碼
Ctrl + F
全屏模式
F11
切換主題
Ctrl + Shift + D
顯示快捷鍵
?
增大字號(hào)
Ctrl + =
減小字號(hào)
Ctrl + -