Aptyp

@krapotkin 

procedure TCommonCustomForm.SetFormStyle(const Value: TFormStyle);
...
begin
...
  Screen.RemoveForm(self);
...
  Screen.AddForm(self);
...
end;

Решил задачу таким способом:

   if ( uMsg = WM_ACTIVATEAPP )and( fModal.Visible ) then
    SetWindowPos(FormToHWND(fModal), IfThen( wParam = 1, HWND_TOPMOST, HWND_NOTOPMOST ),
      Left, Top, Width, Height, SWP_NOACTIVATE or SWP_NOMOVE or SWP_NOSIZE );

Таким образом модальное окно (которое на самом деле не модальное) находиться всегда сверху, когда приложение активно. Когда приложение теряет фокус, окно теряет свой статус нахождения сверху, но остаётся прорисованным сверху главной формы. При всём при этом главная форма так же остаётся доступной для работы, в отличие от ShowModal.

@OnePeople Забыл уточнить, что основная форма должна оставаться активной

Если в FireMonkey поставить FormStyle в значение StayOnTop, то форма будет над всеми окнами системы, а мне надо чтобы она оставалась только лишь над главной, но пряталась под окнами других программ. Чтобы я не пробовал – ничего нормального не выходит.

@Dmitry_4501 в том то и дело, что не будет. Я прямо в моей функции WindowProc писал условие и рисовал. Причём обрабатывал не только WM_NCPAINT, но и WM_PAINT и многое другое, что хоть как-то может быть с этим связано. В FireMonkey это стабильно не работает. Иногда рисует, иногда нет. По крайней мере в моём случае, когда форма Acrylic и к ней применяется стиль.

    if uMsg = WM_NCPAINT then
      begin
      	...
      end;

А теперь что касается изначального вопроса: к сожалению мне не удалось нормально рисовать на неклиентской части формы в FireMoneky. Поэтому я убираю клиентскую часть выставляя в стилях ширину боковых границ и высоту нижней границы и заголовка равные 0. То есть BorderStyle остаётся Sizeable, но границ просто не видно. Делаю свои кнопки формы (закрыть, развернуть...), похожие по стилю в Windows с обработчиками, что выше в сообщении, а изменение размеров окна беру из примера @Dmitry_4501, в итоге выходит такой код:

type PWMNCHitTest = ^TWMNCHitTest;

if uMsg = WM_NCHITTEST then
  begin
    const EdgeWidth = 6;
    var NCHitTest: PWMNCHitTest := PWMNCHitTest(lParam);
    var xPos := LOWORD(lParam);
    var yPos := HIWORD(lParam);
    var Pos: TPointF := Self.ScreenToClient(TPointF.Create(xPos, yPos));

    Result := 0;
    if Pos.X <= EdgeWidth then
      begin
        if Pos.Y <= EdgeWidth then
          Result := HTTOPLEFT
        else if Pos.Y >= Self.ClientHeight - EdgeWidth then
          Result := HTBOTTOMLEFT
        else
          Result := HTLEFT;
      end
    else if Pos.X >= Self.ClientWidth - EdgeWidth then
      begin
        if Pos.Y <= EdgeWidth then
          Result := HTTOPRIGHT
        else if Pos.Y >= Self.ClientHeight - EdgeWidth then
          Result := HTBOTTOMRIGHT
        else
          Result := HTRIGHT;
      end
    else if Pos.Y <= EdgeWidth then
      Result := HTTOP
    else if Pos.Y >= Self.ClientHeight - EdgeWidth then
      Result := HTBOTTOM;

    Prevent := Result <> 0;
  end;

Ну и стоит учесть, что в Firemonkey так просто не обработаешь сообщения окна. Надо делать некий костыль для формы в виде кода:

type
  TMainForm = class(TForm)
    private
      FOldWndProc: LONG_PTR;
    protected
      procedure CreateHandle; override;
      procedure DestroyHandle; override;
  end;

...

procedure TMainForm.CreateHandle;
  function WindowProc(hwnd: HWND; uMsg: UINT; wParam: WPARAM; lParam: LPARAM): LRESULT; stdcall;
  var
    frm: TCommonCustomForm;
    Prevent: Boolean;
  begin
    frm := FMX.Platform.Win.FindWindow(hwnd);
    Assert(frm.InheritsFrom(TForm));
    Prevent := False;

    if uMsg = WM_NCHITTEST then
      begin
      	...
      end;

    if not Prevent then
      Result := CallWindowProc(Ptr(TForm(frm).FOldWndProc), hwnd, uMsg, WParam, lParam);
  end;
begin
  inherited CreateHandle;
  FOldWndProc := GetWindowLongPtr(FormToHWND(Self), GWL_WNDPROC);
  SetWindowLongPtr(FormToHWND(Self), GWL_WNDPROC, NativeInt(@WindowProc));
end;

procedure TMainForm.DestroyHandle;
begin
  Assert( FormToHWND(Self) <> 0 );
  SetWindowLongPtr(FormToHWND(Self), GWL_WNDPROC, FOldWndProc);
  inherited DestroyHandle;
end;

Конечно же всё это только для Windows платформы.

@Tumaso @Martifan прошу перестать мусорить в теме. Хотя я вынужден согласиться с @Tumaso , так как изначальное сообщение от @Martifan действительно не несёт никакой полезной информации в данной теме, так ещё и отчасти содержит неверную информацию.

@Dmitry_4501 дабы нормально работала минимизация пришлось дописать ещё

Form.Visible := False;

Иначе форма сворачивается не на панель задач, а в левый угол подобно MDI окну.

В итоге для FireMonkey вышел такой код:

procedure TMainForm.bCloseClick(Sender: TObject);
begin
  PostMessage(FormToHWND(Self), WM_SYSCOMMAND, SC_CLOSE, 0);
end;

procedure TMainForm.bWindowStateClick(Sender: TObject);
begin
  if WindowState = TWindowState.wsNormal then
    PostMessage(FormToHWND(Self), WM_SYSCOMMAND, SC_MAXIMIZE, 0)
  else
    PostMessage(FormToHWND(Self), WM_SYSCOMMAND, SC_RESTORE, 0);
end;

procedure TMainForm.bMinimizeClick(Sender: TObject);
begin
  PostMessage(FormToHWND(Self), WM_SYSCOMMAND, SC_MINIMIZE, 0);
  Visible := False;
end;

@Dmitry_4501 Спасибо, очень классный пример. Те пункты, которые не получились – это уже не столь важно.

Но есть одна проблема, то ли я дурак, то ли лыжи не едут, но FireMonkey вообще никак не реагирует на следующие команды:
 

SendMessage(FormToHWND(Self), WM_SYSCOMMAND, SC_CLOSE, 0);

SendMessage(FormToHWND(Self), WM_SYSCOMMAND, SC_MINIMIZE, 0);

SendMessage(FormToHWND(Self), WM_SYSCOMMAND, SC_MAXIMIZE, 0);

SendMessage(FormToHWND(Self), WM_SYSCOMMAND, SC_RESTORE, 0);

При этом команда перемещения отрабатывает штатно:

SendMessage(FormToHWND(Self), WM_SYSCOMMAND, $F012, 0);

P.S. Рекомендую Position всегда ставить poScreenCenter. Так как при poDesktopCenter и наличии нескольких мониторов форма появляется между экранами, а не в центе одного из них. Я это сам обнаружил только, когда подключил себе второй монитор.

В общем рисовать как оказалось на неклиентской части формы вообще не проблема. Но я делаю форму Acrylic (Полупрозрачную с размытым фоном), и вот тут появляются проблемы. Если рисовать обычным способом, как на Canvas, то цвет получается тоже полупрозрачный. Путём экспериментов выяснил, что относительно нормально рисуется таким методом:

uses Winapi.Windows;

BitBlt( GetWindowDC( WindowHandleToPlatform( Form.Handle ).Wnd ), 0, 0, BitMap.Width, BitMap.Height, BitMap.Canvas.Handle, 0, 0, cmMergePaint );

В обычном случае последний аргумент должен быть cmSrcCopy, но с ним тоже получается полупрозрачная картинка. Помогает только cmMergePaint, НО! таким способом рисуется картинка с инвертированными цветами. То есть перед таким рисованием нужно её самому инвертировать.

Следующий шаг – это рисовать png картинку, так как редко надо рисовать просто непрозрачную прямоугольную картинку. С 32-битным TBitMap у меня пока что-то не получилось, а вот TPngImage вполне хорошо рисуется.

uses FMX.Platform.Win, Winapi.Windows, Vcl.Graphics, Vcl.Imaging.pngimage;

function TForm1.WinHandle: HWND;
begin
  Result := WindowHandleToPlatform( Self.Handle ).Wnd;
end;

procedure TForm1.FormPaint(Sender: TObject; Canvas: TCanvas; const ARect: TRectF);
var
  ACanvas: Vcl.Graphics.TCanvas;
  png: TPngImage;
begin
  ACanvas := Vcl.Graphics.TCanvas.Create;
  ACanvas.Handle := GetWindowDC(Self.WinHandle);
  png := TPngImage.Create;
  png.LoadFromFile('C:\Image.png');
  try
    PatBlt( ACanvas.Handle, 0, 0, png.Width, png.Height, cmBlackness );
    png.Draw( ACanvas, Rect( 0, 0, png.Width, png.Height ) );
  finally
    ReleaseDC(Self.WinHandle, ACanvas.Handle);
    ACanvas.Handle := 0;
    ACanvas.DisposeOf;
    png.DisposeOf;
  end;
end;

Но и тут есть подводные камни. Метод TPngImage.Draw, если заглянуть в его код становится понятно, что рисует он поверх того, что уже нарисовано и картина накладывается одна на другую быстро теряя прозрачность полупрозрачных пикселей. Поэтому перед её рисованием нужно стереть, что было до этого, с чем отлично справляется функция Winapi.Windows.PatBlt. Но таким образом появляется мерцание.

А так же я ещё не нашёл, как отловить в FireMonkey отловить у формы событие WM_NCPAINT. Пока что навесил рисование на событие формы OnPaint, но оно не стабильно работает в данном случае и бывает, когда картинка стирается и не рисуется, пока не наступит надобность перерисовать клиентскую часть формы.

В 28.07.2023 в 10:41, OnePeople сказал:

Или просто сделайте borderstyle формы none. И сами сделайте рамки, кнопки закрыть, свернуть и т.д.

Не лучший вариант, так как теряется нормальная возможность изменять размер окна и перемещение с привязкой к краям экрана, когда система предлагает развернуть экран на пол экрана или в угол поместить

Здравствуйте. Есть ли какая-либо возможность в Firemonkey для Windows поместить компонент или хотя бы рисовать на неклиентской части формы, а именно на TitleBar? В VCL для этого даже компонент отдельный сделали TTitleBarPanel. Перерыл весь Google и нечего вообще по теме не нашёл.

На моём Samsung Note 5 вокруг букв проглядываются линии. Причём пробовал 3 различных разрешения экрана, ничего не меняется. У друга на Xiaomi Redmi 4x такого не наблюдается.

Что это может быть?

В приложении:

    procedure TForm7.Button1Click(Sender: TObject);
    var AIntent: JIntent;
        AServiceName: string;
    begin
      AIntent := TJIntent.Create;
      AServiceName := 'com.embarcadero.services.Service';
      AIntent.setClassName( TAndroidHelper.Context.getPackageName(), TAndroidHelper.StringToJString( AServiceName ) );
      AIntent.putExtra( TAndroidHelper.StringToJString( 'Code' ), 0 );
      AIntent.putExtra( TAndroidHelper.StringToJString( 'Data' ), TAndroidHelper.StringToJString( 'DataString' ) );
      TAndroidHelper.Activity.startService( AIntent );
    end;

В сервисе:

    procedure TDM.AndroidIntentServiceCreate(Sender: TObject);
    begin
      Toast( 'Create' );
    end;
    
    procedure TDM.AndroidIntentServiceHandleIntent(const Sender: TObject;
      const AnIntent: JIntent);
    begin
      Toast( 'HandleIntent' );
    end;

Сообщение 'Create' показывается, а 'HandleIntent' нет. OnCreate срабатывает, но onHandleIntent не вызывается что бы я не делал. Может я что-то не так делаю?