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

问题描述 投票：0回答：10

使 Delphi 应用程序（Delphi 2007 for Win32）完全全屏、删除应用程序边框并覆盖 Windows 任务栏的最佳方法是什么？

我正在寻找类似于 Internet Explorer (IE) 在按 F11 时执行的操作。

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

正如已接受的答案中提到的

BorderStyle := bsNone;

是实现这一目标的一部分。奇怪的是，我在使用该行时不断收到 

E2010 Incompatible types: 'TFormBorderStyle' and 'TBackGroundSymbol'
错误（另一种类型定义了 
bsNone
）。

为了克服这个问题，我必须使用：

BorderStyle := Forms.bsNone;
delphi fullscreen vcl delphi-2007
10个回答
30
投票

嗯，这一直对我有用。看起来简单一点...

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

Google 搜索发现了以下附加方法：

（虽然我想我会先尝试罗迪的方法）

手动填充屏幕（来自：关于Delphi）

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;

罗迪主题变奏

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

WinAPI 方式（来自 TeamB 的 Peter Below）

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;
3
投票

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

还有this文章，但对我来说似乎太复杂了。

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;

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

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.
2
投票

将这样的代码放入表单onShow事件中：

  WindowState:=wsMaximized;

还有 OnCanResize 这个：

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

如何像 MDI 应用程序一样约束 Mainform 中的子表单，但又不会令人头疼！ （注意：此页面上的回复帮助我完成了这项工作，所以这就是我在这里发布我的解决方案的原因）

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

稍后...

    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;

还有更多...

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
投票

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

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

您需要确保表单位置为 poDefaultPosOnly。

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 上运行。

0
投票

尝试：

Align = alClient    
FormStyle = fsStayOnTop

这始终与主显示器对齐；

0
投票

嗯。看着这些回复，我似乎记得大约 8 年前我编写游戏代码时处理过这个问题。为了使调试更容易，我使用普通 Delphi 表单的设备上下文作为全屏显示的源。

重点是，DirectX 能够全屏运行任何设备上下文 - 包括由表单分配的设备上下文。

因此，要为应用程序提供“真正的”全屏功能，请查找 Delphi 的 DirectX 库，它可能会包含您开箱即用所需的内容。

0
投票

VCL

以下是进入全屏和退出全屏的两个按钮单击事件：

procedure TForm1.GoFullScreen(Sender: TObject);
begin
  BorderStyle := bsNone;
  WindowState := wsMaximized;
end;

procedure TForm1.ExitFullScreen(Sender: TObject);
begin
  BorderStyle := bsSizable;
  WindowState := wsNormal;
end;

FMX

对于那些希望在 FireMonkey (FMX) 中做同样事情的人。更改 

BorderStyle
和 
WindowState
的 VCL 方法在 FMX 中会起作用，但正确的方法是在 FMX 中使用表单上的 
FullScreen
属性：

procedure TForm1.GoFullScreen(Sender: TObject);
begin
  FullScreen := True;
end;

procedure TForm1.ExitFullScreen(Sender: TObject);
begin
  FullScreen := False;
end;
最新问题
© www.soinside.com 2019 - 2024. All rights reserved.