Может переопределить процедуру CreateParam, позвольте мне еще иметь полный доступ к WS_SYSMENU?

Question

Полный исходный код можно найти здесь:http://www.eyeclaxton.com/download/delphi/skinproject.zip.

Я пытаюсь создать форму с кожей без «подписи или границ», но все же оставляя меня с полным доступом к системному меню (т. Е. Перемещение, минимизировать, максимизировать, восстановить и размер). Я могу добиться всех предметов меню, переопределяя процедуру CreateParams с помощью WS_SYSMENU, WS_MAXIMIZEBOX, WS_MINIMIZEBIZEBOX. Использование WS_Sizebox дает мне доступ к команде меню «Размер», но рисует границу, которую я не хочу. Я включил полный (Delphi 7) пример в ссылке выше. Если требуется дополнительная информация, пожалуйста, не стесняйтесь спрашивать.

procedure TMainFrm.CreateParams(var Params: TCreateParams);
begin
  FormStyle := fsNormal;
  try
    if (BorderIcons <> []) then BorderIcons := [];
    if (BorderStyle <> bsNone) then BorderStyle := bsNone;

    inherited CreateParams(Params);
    Params.ExStyle := (Params.ExStyle and (not WS_EX_WINDOWEDGE)
      and (not WS_EX_STATICEDGE) and (not WS_EX_DLGMODALFRAME) and (not WS_EX_CLIENTEDGE));
    Params.Style := (Params.Style and (not WS_CAPTION) and (not DS_MODALFRAME)
      and (not WS_DLGFRAME) and (not WS_THICKFRAME));
    Params.Style := (Params.Style or WS_SYSMENU or WS_MAXIMIZEBOX or WS_MINIMIZEBOX or WS_SIZEBOX);
  finally
    Position := poScreenCenter;
  end;
end;

РЕШЕНИЕ:

unit WndProcUnit;

interface

uses
  Windows, Messages, Classes, Controls, Forms, SysUtils;

type
  EWndProc = class(Exception);

  TWndProcMessages = class(TComponent)
  private
    { Private declarations }
    FOwnerWndProc: TFarProc;
    FNewWndProc: TFarProc;
  protected
    { Protected declarations }
    procedure WndProc(var theMessage: TMessage); virtual;
  public
    { Public declarations }
    constructor Create(theOwner: TComponent); override;
    destructor Destroy(); override;
    procedure DefaultHandler(var theMessage); override;
  end;

  TWndProc = class(TWndProcMessages)
  private
    { Private declarations }
  protected
    { Protected declarations }
    procedure Loaded(); override;
  public
    { Public declarations }
    constructor Create(theOwner: TComponent); override;
    destructor Destroy(); override;
  published
    { Published declarations }
  end;

implementation

{ TWndProcMessages }
constructor TWndProcMessages.Create(theOwner: TComponent);
var
  X, I: Integer;
begin
  inherited Create(theOwner);
  if (not (Owner is TForm)) then
    raise EWndProc.Create('TWndProc parent must be a form!');

  I := 0;
  for X := 0 to (Owner.ComponentCount - 1) do
  begin
    if (Owner.Components[X] is TWndProc) then Inc(I);
    if (I > 1) then Break;
  end;

  if (I > 1) then
  begin
    raise EWndProc.Create('The form already contains a TWndProc!');
  end
  else begin
    FOwnerWndProc := TFarProc(GetWindowLong((Owner as TForm).Handle, GWL_WNDPROC));
    FNewWndProc := Classes.MakeObjectInstance(WndProc);
    if (not (csDesigning in ComponentState)) then
      SetWindowLong((Owner as TForm).Handle, GWL_WNDPROC, LongInt(FNewWndProc));
  end;
end;

destructor TWndProcMessages.Destroy();
begin
  if Assigned(FNewWndProc) then
  try
    Classes.FreeObjectInstance(FNewWndProc);
  finally
    if (Pointer(FNewWndProc) <> nil) then Pointer(FNewWndProc) := nil;
  end;
  if Assigned(FOwnerWndProc) then Pointer(FOwnerWndProc) := nil;

  inherited Destroy();
end;

procedure TWndProcMessages.DefaultHandler(var theMessage);
begin
  if ((Owner as TForm).Handle <> 0) then
  begin
    case TMessage(theMessage).Msg of
      WM_DESTROY:
        SetWindowLong((Owner as TForm).Handle, GWL_WNDPROC, LongInt(FOwnerWndProc));
      WM_INITMENU:
        EnableMenuItem(TMessage(theMessage).WParam, SC_SIZE, MF_BYCOMMAND or MF_ENABLED);
    else
      with TMessage(theMessage) do
        Result := CallWindowProc(FOwnerWndProc, (Owner as TForm).Handle, Msg, WParam, LParam);
    end;
  end
  else
    inherited DefaultHandler(theMessage);
end;

procedure TWndProcMessages.WndProc(var theMessage: TMessage);
begin
  Dispatch(theMessage);
end;

{ TWndProc }
constructor TWndProc.Create(theOwner: TComponent);
begin
  inherited Create(theOwner);
end;

destructor TWndProc.Destroy();
begin
  inherited Destroy();
end;

procedure TWndProc.Loaded();
begin
  inherited Loaded();
  if (not (csDesigning in ComponentState)) then
    GetSystemMenu((Owner as TForm).Handle, False);
end;

end.

Полный «Обновленный» исходный код можно найти здесь:http://www.eyeclaxton.com/download/delphi/skinproject.zip.

Answer 1

Вместо того, чтобы иметь форму или подвижную форму и подставку и подпись все в клиентской области, правильный способ сделать это, чтобы справиться WM_NCPAINT и нарисуйте свою подписи и границу в не клиентской области. Тогда вам не придется использовать Недокументированное сообщение Чтобы показать системное меню в окне «меньшего размера заголовков» или попробуйте установить пункт меню «Size», включенный в окно без калибровочной границы.

Во всяком случае, если вы хотите быстрый обходной путь, включите товар самостоятельно:

type
  TMainFrm = class(TForm)
    [...]
    procedure FormCreate(Sender: TObject);
  private
    procedure WmInitMenuPopup(var Msg: TWMInitMenuPopup); message WM_INITMENUPOPUP;
    [...]

procedure TMainFrm.FormCreate(Sender: TObject);
begin
  GetSystemMenu(Handle, False);  // force a copy of the system menu
  [...]
end;

procedure TMainFrm.WmInitMenuPopup(var Msg: TWMInitMenuPopup);
begin
  inherited;
  if Msg.SystemMenu then
    EnableMenuItem(Msg.MenuPopup, SC_SIZE, MF_BYCOMMAND or MF_ENABLED);
end;

PS:

• В образце кода в вопросе, вы исключаете WS_THICKFRAME, но в том числе WS_SIZEBOX. Отказ Они на самом деле, тот же флаг.

• У вас есть немного странной попытки, наконец в вашем CreateParams. Отказ Позиционирование формы не имело ничего общего с предыдущим кодом, вы можете поставить оператор «Position: =» незадолго до или после настройки «FormStyle» и отбросьте попытку.