powered by simpleCommunicator - 2.0.61     © 2026 Programmizd 02
Целевая тема:
Создать новую тему:
Автор:
Закрыть
Цитировать
Форумы / Delphi [игнор отключен] [закрыт для гостей] / самописный кэпшн
25 сообщений из 26, страница 1 из 2
самописный кэпшн
    #40047004
alisssa
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Гость
Есть старенькое приложение в котором по т\з заказчика предыдущий прогер не от хорошей жизни убрал загаловок и границы и сделал самописный кэпшн

Код: pascal
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.
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.






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

Код: pascal
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.
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, это когда окно за кэпшн к границе дисплея подводишь и оно само подсказывает будующую позицию
Весь остальной код переписываю норм но с этой задачкей не могу совлодать уже пятый день

прошу помощи
...
Рейтинг: 0 / 0
самописный кэпшн
    #40047036
Kazantsev Alexey
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
alisssa,

Убери панель, которая, судя по всему, играет роль заголовка.
...
Рейтинг: 0 / 0
самописный кэпшн
    #40047119
alisssa
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Гость
Kazantsev Alexey
alisssa,

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


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

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

Код: pascal
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.
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.






Стандартный кэпшн с кнопками на месте
...
Рейтинг: 0 / 0
самописный кэпшн
    #40047123
Kazantsev Alexey
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
alisssa
Стандартный кэпшн с кнопками на месте

Блин, я подумал, что нужно от нестандартного заголовка избавиться :)
...
Рейтинг: 0 / 0
самописный кэпшн
    #40047127
alisssa
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Гость
Kazantsev Alexey
alisssa
Стандартный кэпшн с кнопками на месте

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


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

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

А на ФМХ такого эфекта добиться никак не получается
...
Рейтинг: 0 / 0
самописный кэпшн
    #40047200
white_nigger
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
alisssa
Kazantsev Alexey
пропущено...

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


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

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

А на ФМХ такого эфекта добиться никак не получается
Времени вагон? Остальное уже все работает? Оставь системное - ничего не сломается. Можешь кнопки лишние спрятать
...
Рейтинг: 0 / 0
самописный кэпшн
    #40047201
Dimitry Sibiryakov
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
alisssaА на ФМХ такого эфекта добиться никак не получается

Огненный обезьян настолько кривой, что у него даже bsNone не работает?
Posted via ActualForum NNTP Server 1.5
...
Рейтинг: 0 / 0
самописный кэпшн
    #40047209
inbox
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Гость
Dimitry Sibiryakov

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

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


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

Код: pascal
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.
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.

...
Рейтинг: 0 / 0
самописный кэпшн
    #40047228
alisssa
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Гость
Dimitry Sibiryakov

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

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


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

В этомто и проблема
...
Рейтинг: 0 / 0
самописный кэпшн
    #40047236
alisssa
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Гость
inbox
Dimitry Sibiryakov

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

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


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

Код: pascal
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.
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;
...
Рейтинг: 0 / 0
самописный кэпшн
    #40047242
alisssa
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Гость
Что такое Aero Snap

YouTube Video
...
Рейтинг: 0 / 0
самописный кэпшн
    #40047245
asutp2
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
alisssa,

а почему нельзя использовать темы и стили? Ведь это решило бы проблему с заголовком на раз
Насчет snap aero - так вроде в fmx также работает??? по крайней мере в win10 + delphi 10.4.1
...
Рейтинг: 0 / 0
самописный кэпшн
    #40047248
alisssa
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Гость
asutp2
alisssa,

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


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

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



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

Общение с причалом не помогло
...
Рейтинг: 0 / 0
самописный кэпшн
    #40047254
alisssa
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Гость
Еще раз т\з озвучу а то начинается хождение по кругу и непонятки


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

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

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

4 Темы и стили не предлагать уже есть негативный опыт
...
Рейтинг: 0 / 0
самописный кэпшн
    #40047258
Kazantsev Alexey
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
Вот так работает:
fmx:
Код: pascal
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.
14.
15.
16.
17.
18.
19.
20.
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:
Код: pascal
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.
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.
...
Рейтинг: 0 / 0
самописный кэпшн
    #40047261
Dimitry Sibiryakov
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
alisssaда если bsNone то не работает Aero Snap

Потому что, судя по коду в стартовом посте, перетаскивание этого окна сделано каким-то
хаком вместо обработки WM_NCHITTEST.
Posted via ActualForum NNTP Server 1.5
...
Рейтинг: 0 / 0
самописный кэпшн
    #40047262
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
...
Рейтинг: 0 / 0
самописный кэпшн
    #40047265
alisssa
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Гость
Kazantsev Alexey
Вот так работает:
fmx:
Код: pascal
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.
14.
15.
16.
17.
18.
19.
20.
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:
Код: pascal
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.
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.




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

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



Только пожалуста не подумайте что я наглая, но можно както пиксельную границу по бокам и снизу убрать или она нужна для изменения размеров окна?
...
Рейтинг: 0 / 0
самописный кэпшн
    #40047267
inbox
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Гость
Kazantsev Alexey
Вот так работает:


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

Studio\20.0\source\fmx\FMX.Forms.Border.Win.pas
...
Рейтинг: 0 / 0
самописный кэпшн
    #40047268
asutp2
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
alisssa
Еще раз т\з озвучу а то начинается хождение по кругу и непонятки


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

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

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

4 Темы и стили не предлагать уже есть негативный опыт
А на какой версии делфи работаете? Судя по иконке, на 10.4.1?
...
Рейтинг: 0 / 0
самописный кэпшн
    #40047271
alisssa
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Гость
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
...
Рейтинг: 0 / 0
самописный кэпшн
    #40047272
alisssa
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Гость
asutp2
А на какой версии делфи работаете? Судя по иконке, на 10.4.1?


Ойтолько не говорите что с ней чтото не так
...
Рейтинг: 0 / 0
самописный кэпшн
    #40047275
asutp2
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
alisssa
asutp2
А на какой версии делфи работаете? Судя по иконке, на 10.4.1?


Ойтолько не говорите что с ней чтото не так
Не, наоборот, как раз в 10.4.1 всё работает практически хорошо. Включая нелюбимые вами стили :-)
...
Рейтинг: 0 / 0
самописный кэпшн
    #40047279
alisssa
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Гость
asutp2
alisssa
пропущено...


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


Стили прекрасны, но на некоторых ВМ в серверах заказчика они сильно глючат
Поэтому тут я ничего не решаю к сожаленю
...
Рейтинг: 0 / 0
самописный кэпшн
    #40047293
Kazantsev Alexey
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
alisssa
можно както пиксельную границу по бокам и снизу убрать или она нужна для изменения размеров окна?

У формы BorderStyle установить в SizeToolWin. Получится, примерно, так:
...
Рейтинг: 0 / 0
25 сообщений из 26, страница 1 из 2
Форумы / Delphi [игнор отключен] [закрыт для гостей] / самописный кэпшн
Найденые пользователи ...
Разблокировать пользователей ...
Читали форум (0):
Пользователи онлайн (0):
x
x
Закрыть


Просмотр
0 / 0
Close
Debug Console [Select Text]