Добро пожаловать в форум, Guest  >>   Войти | Регистрация | Поиск | Правила | В избранное | Подписаться
Все форумы / Delphi Новый топик    Ответить
Топик располагается на нескольких страницах: [1] 2   вперед  Ctrl      все
 самописный кэпшн  [new]
alisssa
Member

Откуда:
Сообщений: 13
Есть старенькое приложение в котором по т\з заказчика предыдущий прогер не от хорошей жизни убрал загаловок и границы и сделал самописный кэпшн

+
unit Unit1;

interface

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

type
  TForm1 = class(TForm)
    Panel1: TPanel;
    procedure Panel1MouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
  private
    { Private declarations }
    procedure WMNCCalcSize(var Msg: TWMNCCalcSize); message WM_NCCALCSIZE;
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

const
  WM_SYSCOMMAND = $0112;

implementation

{$R *.dfm}

procedure TForm1.WMNCCalcSize(var Msg: TWMNCCalcSize);
begin
  Msg.Msg := WM_NULL;
  inherited;
end;

procedure TForm1.Panel1MouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  if Button = mbLeft then
    begin
      ReleaseCapture;
      SendMessage(Self.Handle, WM_SYSCOMMAND, SC_MOVE + HTCAPTION, 0);
    end;
end;

end.


Картинка с другого сайта.


И б-г судья и заказчику и исполнителю однако все работает и заказчик был счастлив все эти годы
Но теперь оно перешло мне и в свете будующего перехода на мобайл попросили для начала настольного клиента перевести на ФМХ с которым у меня вобще любви ни разу не было
И я спотыкаюсь на первом же шаге

+
unit Unit1;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Types, System.UITypes,
  System.Classes, System.Variants, FMX.Types, FMX.Controls, FMX.Platform.Win,
  FMX.Forms, FMX.Graphics, FMX.Dialogs, FMX.Controls.Presentation, FMX.StdCtrls;

type
  TForm1 = class(TForm)
    Panel1: TPanel;
    procedure Panel1MouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Single);
  private
    { Private declarations }
    procedure WMNCCalcSize(var Msg: TWMNCCalcSize); message WM_NCCALCSIZE;
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

const
  WM_SYSCOMMAND = $0112;

implementation

{$R *.fmx}

procedure TForm1.WMNCCalcSize(var Msg: TWMNCCalcSize);
begin
  Msg.Msg := WM_NULL;
  inherited;
end;

procedure TForm1.Panel1MouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Single);
begin
  if Button = TMouseButton.mbLeft then
    begin
      ReleaseCapture;
      SendMessage(FmxHandleToHWND(Self.Handle), WM_SYSCOMMAND, SC_MOVE + HTCAPTION, 0);
    end;
end;

end.


Картинка с другого сайта.


как видно кэпшн не исчезает на ФМХ



Использовать темы и стили нельзя
Про тень от окна уже предупредил заказчика что возможно потеряется в процесе миграции на ФМХ
Нужно сохранить именно такой вид как на старом и чтобы _обязательно_ подержка Snap Aero, это когда окно за кэпшн к границе дисплея подводишь и оно само подсказывает будующую позицию
Весь остальной код переписываю норм но с этой задачкей не могу совлодать уже пятый день

прошу помощи

Сообщение было отредактировано: 19 фев 21, 10:04
19 фев 21, 10:08    [22283279]     Ответить | Цитировать Сообщить модератору
 Re: самописный кэпшн  [new]
Kazantsev Alexey
Member

Откуда:
Сообщений: 4987
alisssa,

Убери панель, которая, судя по всему, играет роль заголовка.
19 фев 21, 11:12    [22283321]     Ответить | Цитировать Сообщить модератору
 Re: самописный кэпшн  [new]
alisssa
Member

Откуда:
Сообщений: 13
Kazantsev Alexey
alisssa,

Убери панель, которая, судя по всему, играет роль заголовка.


спорить не буду хорошо

Вот вариант без панели

unit Unit1;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Types, System.UITypes,
  System.Classes, System.Variants, FMX.Types, FMX.Controls, FMX.Platform.Win,
  FMX.Forms, FMX.Graphics, FMX.Dialogs;

type
  TForm1 = class(TForm)
    procedure FormMouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Single);
  private
    { Private declarations }
    procedure WMNCCalcSize(var Msg: TWMNCCalcSize); message WM_NCCALCSIZE;
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

const
  WM_SYSCOMMAND = $0112;

implementation

{$R *.fmx}

procedure TForm1.WMNCCalcSize(var Msg: TWMNCCalcSize);
begin
  Msg.Msg := WM_NULL;
  inherited;
end;

procedure TForm1.FormMouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Single);
begin
  if Button = TMouseButton.mbLeft then
    begin
      ReleaseCapture;
      SendMessage(FmxHandleToHWND(Self.Handle), WM_SYSCOMMAND, SC_MOVE + HTCAPTION, 0);
    end;
end;

end.





Стандартный кэпшн с кнопками на месте

К сообщению приложен файл. Размер - 5Kb
19 фев 21, 13:44    [22283475]     Ответить | Цитировать Сообщить модератору
 Re: самописный кэпшн  [new]
Kazantsev Alexey
Member

Откуда:
Сообщений: 4987
alisssa
Стандартный кэпшн с кнопками на месте

Блин, я подумал, что нужно от нестандартного заголовка избавиться :)
19 фев 21, 13:46    [22283483]     Ответить | Цитировать Сообщить модератору
 Re: самописный кэпшн  [new]
alisssa
Member

Откуда:
Сообщений: 13
Kazantsev Alexey
alisssa
Стандартный кэпшн с кнопками на месте

Блин, я подумал, что нужно от нестандартного заголовка избавиться :)


нет нужно как раз от стандартного избавится

На ВЦЛ это легко и непринуждено делается и даже несказывается на тенях и поведении Aero Snap

А на ФМХ такого эфекта добиться никак не получается
19 фев 21, 13:49    [22283487]     Ответить | Цитировать Сообщить модератору
 Re: самописный кэпшн  [new]
white_nigger
Member

Откуда: Тула
Сообщений: 2469
alisssa
Kazantsev Alexey
пропущено...

Блин, я подумал, что нужно от нестандартного заголовка избавиться :)


нет нужно как раз от стандартного избавится

На ВЦЛ это легко и непринуждено делается и даже несказывается на тенях и поведении Aero Snap

А на ФМХ такого эфекта добиться никак не получается
Времени вагон? Остальное уже все работает? Оставь системное - ничего не сломается. Можешь кнопки лишние спрятать
19 фев 21, 16:16    [22283577]     Ответить | Цитировать Сообщить модератору
 Re: самописный кэпшн  [new]
Dimitry Sibiryakov
Member

Откуда:
Сообщений: 52445

alisssa
А на ФМХ такого эфекта добиться никак не получается

Огненный обезьян настолько кривой, что у него даже bsNone не работает?

Posted via ActualForum NNTP Server 1.5

19 фев 21, 16:20    [22283579]     Ответить | Цитировать Сообщить модератору
 Re: самописный кэпшн  [new]
inbox
Member [заблокирован]

Откуда:
Сообщений: 17
Dimitry Sibiryakov

alisssa
А на ФМХ такого эфекта добиться никак не получается

Огненный обезьян настолько кривой, что у него даже bsNone не работает?


Это недопрограммисты налетели в программирование, а + б не могут сложить!

+
unit Unit1;

interface

uses
  System.SysUtils, System.Types, System.UITypes, System.Classes,
  System.Variants,
  FMX.Types, FMX.Controls, FMX.Forms, FMX.Graphics, FMX.Dialogs, FMX.StdCtrls,
  FMX.Controls.Presentation;

type
  TForm1 = class(TForm)
    Panel1: TPanel;
    Label1: TLabel;
    procedure FormCreate(Sender: TObject);
    procedure Panel1MouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Single);
    procedure Panel1MouseUp(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Single);
    procedure Panel1MouseMove(Sender: TObject; Shift: TShiftState;
      X, Y: Single);
  private
    { Private declarations }
  public
    { Public declarations }
    ISClick: Boolean;
    PanelUpX, PanelUpY: Integer;
  end;

var
  Form2: TForm1;

implementation

{$R *.fmx}

procedure TForm1.FormCreate(Sender: TObject);
begin
  Form2.BorderStyle := TFmxFormBorderStyle.None;

  ISClick := false;
end;

procedure TForm1.Panel1MouseMove(Sender: TObject; Shift: TShiftState;
  X, Y: Single);
begin
  if ISClick then
    Self.SetBounds((Self.Left + Trunc(X)) - PanelUpX, (Self.Top + Trunc(Y)) -
      PanelUpY, Self.Width, Self.Height);
end;

procedure TForm1.Panel1MouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Single);
begin
  ISClick := true;

  PanelUpX := Trunc(X);
  PanelUpY := Trunc(Y);
end;

procedure TForm1.Panel1MouseUp(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Single);
begin
  PanelUpX := -1;
  PanelUpY := -1;
  ISClick := false;
end;

end.


Сообщение было отредактировано: 19 фев 21, 16:33
19 фев 21, 16:39    [22283592]     Ответить | Цитировать Сообщить модератору
 Re: самописный кэпшн  [new]
alisssa
Member

Откуда:
Сообщений: 13
Dimitry Sibiryakov

alisssa
А на ФМХ такого эфекта добиться никак не получается

Огненный обезьян настолько кривой, что у него даже bsNone не работает?


да если bsNone то не работает Aero Snap

В этомто и проблема
19 фев 21, 17:01    [22283616]     Ответить | Цитировать Сообщить модератору
 Re: самописный кэпшн  [new]
alisssa
Member

Откуда:
Сообщений: 13
inbox
Dimitry Sibiryakov

пропущено...

Огненный обезьян настолько кривой, что у него даже bsNone не работает?


Это недопрограммисты налетели в программирование, а + б не могут сложить!

+
unit Unit1;

interface

uses
  System.SysUtils, System.Types, System.UITypes, System.Classes,
  System.Variants,
  FMX.Types, FMX.Controls, FMX.Forms, FMX.Graphics, FMX.Dialogs, FMX.StdCtrls,
  FMX.Controls.Presentation;

type
  TForm1 = class(TForm)
    Panel1: TPanel;
    Label1: TLabel;
    procedure FormCreate(Sender: TObject);
    procedure Panel1MouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Single);
    procedure Panel1MouseUp(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Single);
    procedure Panel1MouseMove(Sender: TObject; Shift: TShiftState;
      X, Y: Single);
  private
    { Private declarations }
  public
    { Public declarations }
    ISClick: Boolean;
    PanelUpX, PanelUpY: Integer;
  end;

var
  Form2: TForm1;

implementation

{$R *.fmx}

procedure TForm1.FormCreate(Sender: TObject);
begin
  Form2.BorderStyle := TFmxFormBorderStyle.None;

  ISClick := false;
end;

procedure TForm1.Panel1MouseMove(Sender: TObject; Shift: TShiftState;
  X, Y: Single);
begin
  if ISClick then
    Self.SetBounds((Self.Left + Trunc(X)) - PanelUpX, (Self.Top + Trunc(Y)) -
      PanelUpY, Self.Width, Self.Height);
end;

procedure TForm1.Panel1MouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Single);
begin
  ISClick := true;

  PanelUpX := Trunc(X);
  PanelUpY := Trunc(Y);
end;

procedure TForm1.Panel1MouseUp(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Single);
begin
  PanelUpX := -1;
  PanelUpY := -1;
  ISClick := false;
end;

end.


Спасибо за попытку помощи и оскорбления конечно, но ты бы почитал т\з сначала чтобы время свое сэкономить и не ругатся на меня

Отключение TFmxFormBorderStyle.None отключает у окна не только кэпшн, но и Aero Snap

А вот в версии для ВЦЛ этого эфекта нет в отличии от ФМХ, на ВЦЛ все работает и без bsNone, через Msg.Msg := WM_NULL;

Сообщение было отредактировано: 19 фев 21, 17:03
19 фев 21, 17:04    [22283624]     Ответить | Цитировать Сообщить модератору
 Re: самописный кэпшн  [new]
alisssa
Member

Откуда:
Сообщений: 13
Что такое Aero Snap



Сообщение было отредактировано: 19 фев 21, 17:01
19 фев 21, 17:08    [22283630]     Ответить | Цитировать Сообщить модератору
 Re: самописный кэпшн  [new]
asutp2
Member

Откуда: Тюмень
Сообщений: 729
alisssa,

а почему нельзя использовать темы и стили? Ведь это решило бы проблему с заголовком на раз
Насчет snap aero - так вроде в fmx также работает??? по крайней мере в win10 + delphi 10.4.1
19 фев 21, 17:12    [22283633]     Ответить | Цитировать Сообщить модератору
 Re: самописный кэпшн  [new]
alisssa
Member

Откуда:
Сообщений: 13
asutp2
alisssa,

а почему нельзя использовать темы и стили? Ведь это решило бы проблему с заголовком на раз
Насчет snap aero - так вроде в fmx также работает??? по крайней мере в win10 + delphi 10.4.1


<вроде в fmx также работает>

Код в первом сообщении проверь лично чтобы вслух не гадать
Системный стандартный кэпшн не отключается



Темы и стили тормозят и глючат на части железа и в ВМ
Поэтому решено было обойтись нативом там где это возможно

Общение с причалом не помогло
19 фев 21, 17:18    [22283636]     Ответить | Цитировать Сообщить модератору
 Re: самописный кэпшн  [new]
alisssa
Member

Откуда:
Сообщений: 13
Еще раз т\з озвучу а то начинается хождение по кругу и непонятки


1 В ФМХ нужно отключить системный стандартный кэпшн у окна, но сохранить при этом Aero Snap

2 В ВЦЛ это работает замечательно <в первом сообщении пруф>

3 При любых манипуляциях с кнопками или границами формы в ФМХ вырубается и Aero Snap

4 Темы и стили не предлагать уже есть негативный опыт
19 фев 21, 17:25    [22283644]     Ответить | Цитировать Сообщить модератору
 Re: самописный кэпшн  [new]
Kazantsev Alexey
Member

Откуда:
Сообщений: 4987
Вот так работает:
fmx:
object Form1: TForm1
  Left = 0
  Top = 0
  Caption = 'Form1'
  ClientHeight = 520
  ClientWidth = 454
  FormFactor.Width = 320
  FormFactor.Height = 480
  FormFactor.Devices = [Desktop]
  DesignerMasterStyle = 0
  object Rectangle1: TRectangle
    Align = Top
    Fill.Color = xFF5F8DF5
    Sides = [Top]
    Size.Width = 454.000000000000000000
    Size.Height = 41.000000000000000000
    Size.PlatformDefault = False
    OnMouseDown = Rectangle1MouseDown
  end
end

pas:
unit Unit1;

interface

uses
  System.SysUtils, System.Types, System.UITypes, System.Classes, System.Variants,
  FMX.Types, FMX.Controls, FMX.Forms, FMX.Graphics, FMX.Dialogs, FMX.Objects,
  FMX.Controls.Presentation, FMX.StdCtrls;

type
  TForm1 = class(TForm)
    Rectangle1: TRectangle;
    procedure Rectangle1MouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Single);
   private
    FOldWndProc : Pointer;
   protected
    Procedure CreateHandle; Override;
    Procedure DestroyHandle; Override;
  end;

var
  Form1: TForm1;

implementation
uses
 Winapi.Windows,
 Winapi.Messages,
 FMX.Platform.Win;
{$R *.fmx}

{ TForm1 }

type
 TWndProc = function(hwnd: HWND; uMsg: UINT; wParam: WPARAM; lParam: LPARAM): LRESULT; stdcall;

function WndProc(hwnd: HWND; uMsg: UINT; wParam: WPARAM; lParam: LPARAM): LRESULT; stdcall;
begin

 case uMsg of

  WM_NCCALCSIZE : if wParam = 1 then
                   begin
                    Inc(PNCCalcSizeParams(lParam).rgrc[0].Left, GetSystemMetrics(SM_CXBORDER) + GetSystemMetrics(SM_CXSIZEFRAME) - 1);
                    Dec(PNCCalcSizeParams(lParam).rgrc[0].Right, GetSystemMetrics(SM_CXBORDER) + GetSystemMetrics(SM_CXSIZEFRAME) - 1);
                    Dec(PNCCalcSizeParams(lParam).rgrc[0].Bottom, GetSystemMetrics(SM_CYBORDER) + GetSystemMetrics(SM_CYSIZEFRAME) - 1);
                    result := 0;
                   end
                  else
                   result := DefWindowProc(hwnd, uMsg, wParam, lParam);

 else

  Result := TWndProc(TForm1(FindWindow(hwnd)).FOldWndProc)(hwnd, uMsg, wParam, lParam);

 end;

end;

procedure TForm1.CreateHandle;
begin
 inherited;
 FOldWndProc := Pointer(GetWindowLongPtr(TWinWindowHandle(Handle).Wnd, GWL_WNDPROC));
 SetWindowLongPtr(TWinWindowHandle(Handle).Wnd, GWL_WNDPROC, NativeInt(@WndProc));
end;

procedure TForm1.DestroyHandle;
begin
 SetWindowLongPtr(TWinWindowHandle(Handle).Wnd, GWL_WNDPROC, NativeInt(FOldWndProc));
 inherited;
end;

procedure TForm1.Rectangle1MouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Single);
begin
  if Button = TMouseButton.mbLeft then
    begin
      ReleaseCapture;
      SendMessage(TWinWindowHandle(Handle).Wnd, WM_SYSCOMMAND, SC_MOVE + HTCAPTION, 0);
    end;
end;

end.
19 фев 21, 17:31    [22283650]     Ответить | Цитировать Сообщить модератору
 Re: самописный кэпшн  [new]
Dimitry Sibiryakov
Member

Откуда:
Сообщений: 52445

alisssa
да если bsNone то не работает Aero Snap

Потому что, судя по коду в стартовом посте, перетаскивание этого окна сделано каким-то
хаком вместо обработки WM_NCHITTEST.

Posted via ActualForum NNTP Server 1.5

19 фев 21, 17:34    [22283654]     Ответить | Цитировать Сообщить модератору
 Re: самописный кэпшн  [new]
Leonid Kudryavtsev
Member

Откуда:
Сообщений: 9431
alisssa

да если bsNone то не работает Aero Snap

В этомто и проблема

Delphi под рукой нет, но есть гугл. Первая же обсуждение про Aero Snap на MSDN

Borderless Window With Aero Snap Feature
https://social.msdn.microsoft.com/Forums/en-US/25b44cba-de6e-4e1e-90f5-d1018bddb189/borderless-window-with-aero-snap-feature?forum=winforms

Aero Snap effect for form with FormBorderStyle = None
https://www.codeproject.com/Questions/570233/AeroplusSnappluseffectplusforplusformpluspluswithp
19 фев 21, 17:35    [22283656]     Ответить | Цитировать Сообщить модератору
 Re: самописный кэпшн  [new]
alisssa
Member

Откуда:
Сообщений: 13
Kazantsev Alexey
Вот так работает:
fmx:
object Form1: TForm1
  Left = 0
  Top = 0
  Caption = 'Form1'
  ClientHeight = 520
  ClientWidth = 454
  FormFactor.Width = 320
  FormFactor.Height = 480
  FormFactor.Devices = [Desktop]
  DesignerMasterStyle = 0
  object Rectangle1: TRectangle
    Align = Top
    Fill.Color = xFF5F8DF5
    Sides = [Top]
    Size.Width = 454.000000000000000000
    Size.Height = 41.000000000000000000
    Size.PlatformDefault = False
    OnMouseDown = Rectangle1MouseDown
  end
end

pas:
unit Unit1;

interface

uses
  System.SysUtils, System.Types, System.UITypes, System.Classes, System.Variants,
  FMX.Types, FMX.Controls, FMX.Forms, FMX.Graphics, FMX.Dialogs, FMX.Objects,
  FMX.Controls.Presentation, FMX.StdCtrls;

type
  TForm1 = class(TForm)
    Rectangle1: TRectangle;
    procedure Rectangle1MouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Single);
   private
    FOldWndProc : Pointer;
   protected
    Procedure CreateHandle; Override;
    Procedure DestroyHandle; Override;
  end;

var
  Form1: TForm1;

implementation
uses
 Winapi.Windows,
 Winapi.Messages,
 FMX.Platform.Win;
{$R *.fmx}

{ TForm1 }

type
 TWndProc = function(hwnd: HWND; uMsg: UINT; wParam: WPARAM; lParam: LPARAM): LRESULT; stdcall;

function WndProc(hwnd: HWND; uMsg: UINT; wParam: WPARAM; lParam: LPARAM): LRESULT; stdcall;
begin

 case uMsg of

  WM_NCCALCSIZE : if wParam = 1 then
                   begin
                    Inc(PNCCalcSizeParams(lParam).rgrc[0].Left, GetSystemMetrics(SM_CXBORDER) + GetSystemMetrics(SM_CXSIZEFRAME) - 1);
                    Dec(PNCCalcSizeParams(lParam).rgrc[0].Right, GetSystemMetrics(SM_CXBORDER) + GetSystemMetrics(SM_CXSIZEFRAME) - 1);
                    Dec(PNCCalcSizeParams(lParam).rgrc[0].Bottom, GetSystemMetrics(SM_CYBORDER) + GetSystemMetrics(SM_CYSIZEFRAME) - 1);
                    result := 0;
                   end
                  else
                   result := DefWindowProc(hwnd, uMsg, wParam, lParam);

 else

  Result := TWndProc(TForm1(FindWindow(hwnd)).FOldWndProc)(hwnd, uMsg, wParam, lParam);

 end;

end;

procedure TForm1.CreateHandle;
begin
 inherited;
 FOldWndProc := Pointer(GetWindowLongPtr(TWinWindowHandle(Handle).Wnd, GWL_WNDPROC));
 SetWindowLongPtr(TWinWindowHandle(Handle).Wnd, GWL_WNDPROC, NativeInt(@WndProc));
end;

procedure TForm1.DestroyHandle;
begin
 SetWindowLongPtr(TWinWindowHandle(Handle).Wnd, GWL_WNDPROC, NativeInt(FOldWndProc));
 inherited;
end;

procedure TForm1.Rectangle1MouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Single);
begin
  if Button = TMouseButton.mbLeft then
    begin
      ReleaseCapture;
      SendMessage(TWinWindowHandle(Handle).Wnd, WM_SYSCOMMAND, SC_MOVE + HTCAPTION, 0);
    end;
end;

end.



гениально!
то что нужно!

Алексей большое спасибо, выручили!!!



Только пожалуста не подумайте что я наглая, но можно както пиксельную границу по бокам и снизу убрать или она нужна для изменения размеров окна?

К сообщению приложен файл. Размер - 1Kb
19 фев 21, 17:40    [22283660]     Ответить | Цитировать Сообщить модератору
 Re: самописный кэпшн  [new]
inbox
Member [заблокирован]

Откуда:
Сообщений: 17
Kazantsev Alexey
Вот так работает:


Это всё реализовано в файлике

Studio\20.0\source\fmx\FMX.Forms.Border.Win.pas
19 фев 21, 17:51    [22283663]     Ответить | Цитировать Сообщить модератору
 Re: самописный кэпшн  [new]
asutp2
Member

Откуда: Тюмень
Сообщений: 729
alisssa
Еще раз т\з озвучу а то начинается хождение по кругу и непонятки


1 В ФМХ нужно отключить системный стандартный кэпшн у окна, но сохранить при этом Aero Snap

2 В ВЦЛ это работает замечательно <в первом сообщении пруф>

3 При любых манипуляциях с кнопками или границами формы в ФМХ вырубается и Aero Snap

4 Темы и стили не предлагать уже есть негативный опыт
А на какой версии делфи работаете? Судя по иконке, на 10.4.1?

Сообщение было отредактировано: 19 фев 21, 17:46
19 фев 21, 17:52    [22283664]     Ответить | Цитировать Сообщить модератору
 Re: самописный кэпшн  [new]
alisssa
Member

Откуда:
Сообщений: 13
Leonid Kudryavtsev
alisssa

да если bsNone то не работает Aero Snap

В этомто и проблема

Delphi под рукой нет, но есть гугл. Первая же обсуждение про Aero Snap на MSDN

Borderless Window With Aero Snap Feature
https://social.msdn.microsoft.com/Forums/en-US/25b44cba-de6e-4e1e-90f5-d1018bddb189/borderless-window-with-aero-snap-feature?forum=winforms

Aero Snap effect for form with FormBorderStyle = None
https://www.codeproject.com/Questions/570233/AeroplusSnappluseffectplusforplusformpluspluswithp


Класно, спасибо, но у меня Windows Forms под рукой нет только Delphi
19 фев 21, 17:56    [22283667]     Ответить | Цитировать Сообщить модератору
 Re: самописный кэпшн  [new]
alisssa
Member

Откуда:
Сообщений: 13
asutp2
А на какой версии делфи работаете? Судя по иконке, на 10.4.1?


Ойтолько не говорите что с ней чтото не так
19 фев 21, 17:58    [22283668]     Ответить | Цитировать Сообщить модератору
 Re: самописный кэпшн  [new]
asutp2
Member

Откуда: Тюмень
Сообщений: 729
alisssa
asutp2
А на какой версии делфи работаете? Судя по иконке, на 10.4.1?


Ойтолько не говорите что с ней чтото не так
Не, наоборот, как раз в 10.4.1 всё работает практически хорошо. Включая нелюбимые вами стили :-)
19 фев 21, 18:05    [22283672]     Ответить | Цитировать Сообщить модератору
 Re: самописный кэпшн  [new]
alisssa
Member

Откуда:
Сообщений: 13
asutp2
alisssa
пропущено...


Ойтолько не говорите что с ней чтото не так
Не, наоборот, как раз в 10.4.1 всё работает практически хорошо. Включая нелюбимые вами стили :-)


Стили прекрасны, но на некоторых ВМ в серверах заказчика они сильно глючат
Поэтому тут я ничего не решаю к сожаленю
19 фев 21, 18:11    [22283680]     Ответить | Цитировать Сообщить модератору
 Re: самописный кэпшн  [new]
Kazantsev Alexey
Member

Откуда:
Сообщений: 4987
alisssa
можно както пиксельную границу по бокам и снизу убрать или она нужна для изменения размеров окна?

У формы BorderStyle установить в SizeToolWin. Получится, примерно, так:
Картинка с другого сайта.
19 фев 21, 19:10    [22283714]     Ответить | Цитировать Сообщить модератору
Топик располагается на нескольких страницах: [1] 2   вперед  Ctrl      все
Все форумы / Delphi Ответить