首页 / 知识

使Delphi应用程序完全全屏的最佳方法是什么？

2023-04-12 09:58:00

What is the best way to make a Delphi Application completely full screen?

使delphi应用程序(此处为win32的delphi 2007)完全全屏显示，删除应用程序边框并覆盖Windows任务栏的最佳方法是什么？

我正在寻找类似于当您按下F11时IE所做的事情。

我希望这是用户的运行时选项，而不是我自己的设计时间决定。

如已接受答案中所述

1	BorderStyle := bsNone;

是这样做的一部分。奇怪的是，使用该行时，我一直收到E2010 Incompatible types: 'TFormBorderStyle' and 'TBackGroundSymbol'错误(另一种类型定义了bsNone)。

为了克服这个问题，我不得不使用：

1	BorderStyle := Forms.bsNone;

好吧，这一直对我有用。似乎更简单...

1
2
3
4
5

procedure TForm52.Button1Click(Sender: TObject);
begin
BorderStyle := bsNone;
WindowState := wsMaximized;
end;

Google搜索提供了以下其他方法：

(尽管我认为我会先尝试罗迪的方法)

手动填充屏幕(来自：关于Delphi)

1
2
3
4
5
6
7
8
9
10

procedure TSomeForm.FormShow(Sender: TObject) ;
var
r : TRect;
begin
Borderstyle := bsNone;
SystemParametersInfo
(SPI_GETWORKAREA, 0, @r,0) ;
SetBounds
(r.Left, r.Top, r.Right-r.Left, r.Bottom-r.Top) ;
end;

Roddy的主题变化

1
2
3
4
5
6

FormStyle := fsStayOnTop;
BorderStyle := bsNone;
Left := 0;
Top := 0;
Width := Screen.Width;
Height := Screen.Height;

WinAPI方式(来自TeamB的Peter Under)

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32

private // in form declaration
Procedure WMGetMinMaxInfo(Var msg: TWMGetMinMaxInfo);
message WM_GETMINMAXINFO;

Procedure TForm1.WMGetMinMaxInfo(Var msg: TWMGetMinMaxInfo);
Begin
inherited;
With msg.MinMaxInfo^.ptMaxTrackSize Do Begin
X := GetDeviceCaps( Canvas.handle, HORZRES ) + (Width - ClientWidth);
Y := GetDeviceCaps( Canvas.handle, VERTRES ) + (Height - ClientHeight
);
End;
End;

procedure TForm1.Button2Click(Sender: TObject);
Const
Rect: TRect = (Left:0; Top:0; Right:0; Bottom:0);
FullScreen: Boolean = False;
begin
FullScreen := not FullScreen;
If FullScreen Then Begin
Rect := BoundsRect;
SetBounds(
Left - ClientOrigin.X,
Top - ClientOrigin.Y,
GetDeviceCaps( Canvas.handle, HORZRES ) + (Width - ClientWidth),
GetDeviceCaps( Canvas.handle, VERTRES ) + (Height - ClientHeight ));
// Label2.caption := IntToStr(GetDeviceCaps( Canvas.handle, VERTRES ));
End
Else
BoundsRect := Rect;
end;

将如下代码放入onShow事件的表单中：

1	WindowState:=wsMaximized;

然后到OnCanResize：

1 2	if (newwidth<width) and (newheight<height) then Resize:=false;

最大化表单并隐藏标题栏。最大化行是从内存完成的，但是我很确定WindowState是您想要的属性。

也有这篇文章，但是对我来说似乎太复杂了。

1
2
3
4
5
6
7
8

procedure TForm1.FormCreate(Sender: TObject) ;
begin
//maximize the window
WindowState := wsMaximized;
//hide the title bar
SetWindowLong(Handle,GWL_STYLE,GetWindowLong(Handle,GWL_STYLE) and not WS_CAPTION);
ClientHeight := Height;
end;

编辑：这是一个完整的示例，带有"全屏"和"还原"选项。为了最大程度地清晰起见，我将不同部分分成了一些小程序，因此可以将其压缩成几行。

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120

unit Unit1;

interface

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls;

type
TForm1 = class(TForm)
btnGoFullScreen: TButton;
btnNotFullScreen: TButton;
btnShowTitleBar: TButton;
btnHideTitleBar: TButton;
btnQuit: TButton;
procedure btnGoFullScreenClick(Sender: TObject);
procedure btnShowTitleBarClick(Sender: TObject);
procedure btnHideTitleBarClick(Sender: TObject);
procedure btnNotFullScreenClick(Sender: TObject);
procedure btnQuitClick(Sender: TObject);
private
SavedLeft : integer;
SavedTop : integer;
SavedWidth : integer;
SavedHeight : integer;
SavedWindowState : TWindowState;
procedure FullScreen;
procedure NotFullScreen;
procedure SavePosition;
procedure HideTitleBar;
procedure ShowTitleBar;
procedure RestorePosition;
procedure MaximizeWindow;
public
{ Public declarations }
end;

var
Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.btnQuitClick(Sender: TObject);
begin
Application.Terminate;
end;

procedure TForm1.btnGoFullScreenClick(Sender: TObject);
begin
FullScreen;
end;

procedure TForm1.btnNotFullScreenClick(Sender: TObject);
begin
NotFullScreen;
end;

procedure TForm1.btnShowTitleBarClick(Sender: TObject);
begin
ShowTitleBar;
end;

procedure TForm1.btnHideTitleBarClick(Sender: TObject);
begin
HideTitleBar;
end;

procedure TForm1.FullScreen;
begin
SavePosition;
HideTitleBar;
MaximizeWindow;
end;

procedure TForm1.HideTitleBar;
begin
SetWindowLong(Handle,GWL_STYLE,GetWindowLong(Handle,GWL_STYLE) and not WS_CAPTION);
ClientHeight := Height;
end;

procedure TForm1.MaximizeWindow;
begin
WindowState := wsMaximized;
end;

procedure TForm1.NotFullScreen;
begin
RestorePosition;
ShowTitleBar;
end;

procedure TForm1.RestorePosition;
begin
//this proc uses what we saved in"SavePosition"
WindowState := SavedWindowState;
Top := SavedTop;
Left := SavedLeft;
Width := SavedWidth;
Height := SavedHeight;
end;

procedure TForm1.SavePosition;
begin
SavedLeft := Left;
SavedHeight := Height;
SavedTop := Top;
SavedWidth := Width;
SavedWindowState := WindowState;
end;

procedure TForm1.ShowTitleBar;
begin
SetWindowLong(Handle,gwl_Style,GetWindowLong(Handle,gwl_Style) or ws_Caption or ws_border);
Height := Height + GetSystemMetrics(SM_CYCAPTION);
Refresh;
end;

end.

像MDI应用程序一样，如何在Mainform中约束子表单，却没有麻烦！ (注意：此页面上的答复帮助我完成了此工作，因此这就是我在此处发布解决方案的原因)

1
2
3
4
5

private
{ Private declarations }
StickyAt: Word;
procedure WMWINDOWPOSCHANGING(Var Msg: TWMWINDOWPOSCHANGING); Message M_WINDOWPOSCHANGING;
Procedure WMGetMinMaxInfo(Var msg: TWMGetMinMaxInfo); message WM_GETMINMAXINFO;

后来...

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33

procedure TForm2.WMWINDOWPOSCHANGING(var Msg: TWMWINDOWPOSCHANGING);
var
A, B: Integer;
iFrameSize: Integer;
iCaptionHeight: Integer;
iMenuHeight: Integer;
begin

iFrameSize := GetSystemMetrics(SM_CYFIXEDFRAME);
iCaptionHeight := GetSystemMetrics(SM_CYCAPTION);
iMenuHeight := GetSystemMetrics(SM_CYMENU);

// inside the Mainform client area
A := Application.MainForm.Left + iFrameSize;
B := Application.MainForm.Top + iFrameSize + iCaptionHeight + iMenuHeight;

with Msg.WindowPos^ do
begin

if x <= A + StickyAt then
x := A;

if x + cx >= A + Application.MainForm.ClientWidth - StickyAt then
x := (A + Application.MainForm.ClientWidth) - cx + 1;

if y <= B + StickyAt then
y := B;

if y + cy >= B + Application.MainForm.ClientHeight - StickyAt then
y := (B + Application.MainForm.ClientHeight) - cy + 1;

end;
end;

还有更多...

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30

Procedure TForm2.WMGetMinMaxInfo(Var msg: TWMGetMinMaxInfo);
var
iFrameSize: Integer;
iCaptionHeight: Integer;
iMenuHeight: Integer;
Begin
inherited;
iFrameSize := GetSystemMetrics(SM_CYFIXEDFRAME);
iCaptionHeight := GetSystemMetrics(SM_CYCAPTION);
iMenuHeight := GetSystemMetrics(SM_CYMENU);
With msg.MinMaxInfo^.ptMaxPosition Do
begin
// position of top when maximised
X := Application.MainForm.Left + iFrameSize + 1;
Y := Application.MainForm.Top + iFrameSize + iCaptionHeight + iMenuHeight + 1;
end;
With msg.MinMaxInfo^.ptMaxSize Do
Begin
// width and height when maximized
X := Application.MainForm.ClientWidth;
Y := Application.MainForm.ClientHeight;
End;
With msg.MinMaxInfo^.ptMaxTrackSize Do
Begin
// maximum size when maximised
X := Application.MainForm.ClientWidth;
Y := Application.MainForm.ClientHeight;
End;
// to do: minimum size (maybe)
End;

就我而言，唯一可行的解??决方案是：

1
2
3
4
5

procedure TFormHelper.FullScreenMode;
begin
BorderStyle := bsNone;
ShowWindowAsync(Handle, SW_MAXIMIZE);
end;

嗯看一下响应，我似乎还记得大约在八年前编写游戏时所涉及的内容。为了简化调试，我使用普通的Delphi表单的设备上下文作为全屏显示的源。

关键是，DirectX能够全屏运行任何设备上下文-包括表单分配的内容。

因此，要为应用程序提供"真正的"全屏功能，请跟踪Delphi的DirectX库，它可能包含您开箱即用的内容。

您需要确保窗体位置为poDefaultPosOnly。

1
2
3
4
5
6
7

Form1.Position := poDefaultPosOnly;
Form1.FormStyle := fsStayOnTop;
Form1.BorderStyle := bsNone;
Form1.Left := 0;
Form1.Top := 0;
Form1.Width := Screen.Width;
Form1.Height := Screen.Height;

经过测试，可以在Win7 x64上运行。

尝试：