Гость
Целевая тема:
Создать новую тему:
Автор:
Форумы / Delphi [игнор отключен] [закрыт для гостей] / самописный кэпшн / 25 сообщений из 26, страница 1 из 2
19.02.2021, 10:08
    #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
19.02.2021, 11:12
    #40047036
Kazantsev Alexey
Участник
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
самописный кэпшн
alisssa,

Убери панель, которая, судя по всему, играет роль заголовка.
...
Рейтинг: 0 / 0
19.02.2021, 13:44
    #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
19.02.2021, 13:46
    #40047123
Kazantsev Alexey
Участник
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
самописный кэпшн
alisssa
Стандартный кэпшн с кнопками на месте

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

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


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

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

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

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


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

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

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

Огненный обезьян настолько кривой, что у него даже bsNone не работает?
Posted via ActualForum NNTP Server 1.5
...
Рейтинг: 0 / 0
19.02.2021, 16:39
    #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
19.02.2021, 17:01
    #40047228
alisssa
Гость
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
самописный кэпшн
Dimitry Sibiryakov

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

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


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

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

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

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

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


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

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



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

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


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

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

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

4 Темы и стили не предлагать уже есть негативный опыт
...
Рейтинг: 0 / 0
19.02.2021, 17:31
    #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
19.02.2021, 17:34
    #40047261
Dimitry Sibiryakov
Участник
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
самописный кэпшн
alisssaда если bsNone то не работает Aero Snap

Потому что, судя по коду в стартовом посте, перетаскивание этого окна сделано каким-то
хаком вместо обработки WM_NCHITTEST.
Posted via ActualForum NNTP Server 1.5
...
Рейтинг: 0 / 0
19.02.2021, 17:35
    #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
19.02.2021, 17:40
    #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
19.02.2021, 17:51
    #40047267
inbox
Гость
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
самописный кэпшн
Kazantsev Alexey
Вот так работает:


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

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


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

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

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

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


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


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


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


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

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


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