Создать форму без полей без потери команд Windows - PullRequest
0 голосов
/ 12 февраля 2019

Я изменил свою форму на форму без полей, я просто изменил свойство BorderStyle на bsNone, но теперь мое приложение теряет привязку Windows и некоторые команды, такие как

WIN +↑ (выровнять форму клиента)
WIN + ↓ (свернуть форму)
WIN + → (выровнять форму справа)
WIN + ← (выровнять форму слева)

Я пытался установить BorderStyle: bsSizeable и использовать приведенный ниже код внутри FormCreate, но это не сработало:

procedure TfrmBase.FormCreate(Sender: TObject);
begin
  SetWindowLong(Handle
               ,GWL_STYLE
               ,GetWindowLong(Handle, GWL_STYLE)
                AND (NOT WS_CAPTION)
                AND (NOT WS_THICKFRAME)
               );


  Refresh;
  FormColor := oLauncher.oCor;
end;

В результате:

My form

Изображение выше - то, что я хочу, но команды Windows, которые я уже упоминал, не работают

Есть какой-либо способ установить BorderStyle: bsNoneи не потеряете эти команды?

EDITED

Если я использую WS_THICKFRAME, моя форма возвращает небольшую верхнюю границу, и команды Windows работают хорошо, но яне хочу эту верхнюю границу.

My form2

EDITED 2

Я получил очень близко к ожидаемомурезультат, но есть горитЭта проблема еще не решена ...

Я положил это на свой FormCreate

SetWindowLong(Handle
             ,GWL_STYLE
             ,GetWindowLong(Handle, GWL_STYLE)
              AND (NOT WS_CAPTION)
              );

И я создаю метод

private
   procedure WmNCCalcSize(var Msg: TWMNCCalcSize); message WM_NCCALCSIZE;

, а затем

procedure TfrmBase.WmNCCalcSize(var Msg: TWMNCCalcSize);
begin
  inherited;
  if Msg.CalcValidRects then
  begin
    InflateRect(Msg.CalcSize_Params.rgrc[0], 0, 6);
    Msg.Result := 0;
  end;
end;

Я получил этот метод здесь

Теперь граница исчезла, но когда моя Форма теряет фокус, верхняя / нижняя граница отображается снова....

Как мне избежать этого?

enter image description here


решено

Я оставил границу как BorderStyle: bsSizeable, затем я сделал это:

private
  procedure WmNCCalcSize(var Msg: TWMNCCalcSize); message WM_NCCALCSIZE;
[...]
procedure TfrmBase.WmNCCalcSize(var Msg: TWMNCCalcSize);
var
  R: TRect;
begin
  if not Msg.CalcValidRects then
    R := PRect(Msg.CalcSize_Params)^;
  inherited;
  if Msg.CalcValidRects then
    Msg.CalcSize_Params.rgrc0 := Msg.CalcSize_Params.rgrc1
  else
    PRect(Msg.CalcSize_Params)^ := R;

  Msg.Result := 0;
end;

procedure TfrmBase.FormCreate(Sender: TObject);
begin
  BorderStyle := bsNone;
  SetWindowLong(Handle
               ,GWL_STYLE
               ,WS_CLIPCHILDREN or WS_OVERLAPPEDWINDOW
               );
end;

procedure TfrmBase.FormShow(Sender: TObject);
begin
  Width := (Width - 1);
end;

Решение на GitHUB

Я создал репозиторий здесь

1 Ответ

0 голосов
/ 13 февраля 2019

Некоторые команды, на которые вы ссылаетесь, являются системными командами, относящимися к размеру окна.Для этого требуется толстая рамка, без которой «WIN + right» и «WIN + left» не будут работать.Кроме того, для работы команд WIN + up / down вам понадобятся окна минимизации и окна максимизации.

Лучше всего начинать с нуля и включать нужные стили, иначе VCL может помешать.Если существует возможность воссоздания вашей формы, поместите стиль в переопределение CreateWnd.

procedure TForm1.FormCreate(Sender: TObject);
begin
  BorderStyle := bsNone;
  SetWindowLong(Handle, GWL_STYLE, WS_CLIPCHILDREN or WS_OVERLAPPEDWINDOW);
end;

Тогда есть кадр, который вы не хотите.В редактировании вопроса вы раздуваете прямоугольник клиента, чтобы избавиться от него.Не угадывайте ширину / высоту кадра, сделайте это, как показано ниже.

procedure TForm1.WMNCCalcSize(var Message: TWMNCCalcSize);
var
  R: TRect;
begin
  if not Message.CalcValidRects then
    R := PRect(Message.CalcSize_Params)^;
  inherited;
  if Message.CalcValidRects then
    Message.CalcSize_Params.rgrc0 := Message.CalcSize_Params.rgrc1
  else
    PRect(Message.CalcSize_Params)^ := R;
  Message.Result := 0;
end;

Чтение документации для сообщения является обязательным в данный момент, параметры имеют разные значения в разныхэтапы и т.д ..

Вышесказанное оставляет окно без какой-либо не клиентской области вообще.Клиентский прямоугольник равен прямоугольнику окна.Хотя заголовок не отображается, вы можете активировать системное меню, нажав Alt + Пробел.Проблема в том, что система настаивает на том, чтобы активировать рисунокТеперь он рисует рамку в клиентской области !!

Избавьтесь от нее, перехватив WM_NCACTIVATE, вам также нужно нарисовать свой заголовок в соответствии со статусом активации:

procedure TForm1.WMNCActivate(var Message: TWMNCActivate);
begin
  if Message.Active then
    // draw active caption
  else
    // draw incactive caption

  // don't call inherited
end;

Возможно, вам придется иметь дело с некоторыми глюками, запутывание с окном имеет последствия.В моем тесте свернутая форма не имеет ассоциированного значка, например, в диалоговом окне alt + tab.

Ниже приведен мой тестовый блок в полном объеме.

unit Unit1;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants,
  System.Classes, Vcl.Graphics, Vcl.Controls, Vcl.Forms, Vcl.Dialogs;

type
  TForm1 = class(TForm)
    procedure FormCreate(Sender: TObject);
  protected
    procedure WMNCActivate(var Message: TWMNCActivate); message WM_NCACTIVATE;
    procedure WMNCCalcSize(var Message: TWMNCCalcSize); message WM_NCCALCSIZE;
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.FormCreate(Sender: TObject);
begin
  BorderStyle := bsNone;
  SetWindowLong(Handle, GWL_STYLE, WS_CLIPCHILDREN or WS_OVERLAPPEDWINDOW);
end;

procedure TForm1.WMNCActivate(var Message: TWMNCActivate);
begin
  if Message.Active then
    // draw active caption
  else
    // draw incactive caption

  // don't call inherited
end;

procedure TForm1.WMNCCalcSize(var Message: TWMNCCalcSize);
var
  R: TRect;
begin
  if not Message.CalcValidRects then
    R := PRect(Message.CalcSize_Params)^;
  inherited;
  if Message.CalcValidRects then
    Message.CalcSize_Params.rgrc0 := Message.CalcSize_Params.rgrc1
  else
    PRect(Message.CalcSize_Params)^ := R;
  Message.Result := 0;
end;

end.
...