Перейти к содержанию
Fire Monkey от А до Я

Aptyp

Пользователи
  • Постов

    13
  • Зарегистрирован

  • Посещение

Посетители профиля

Блок последних пользователей отключён и не показывается другим пользователям.

  1. @krapotkin Редактирование свойства FormStyle между StayOnTop и Normal – не подходит, так как форма в этот момент прыгает. Видимо из-за того что в коде класса формы вызываются данные методы: procedure TCommonCustomForm.SetFormStyle(const Value: TFormStyle); ... begin ... Screen.RemoveForm(self); ... Screen.AddForm(self); ... end;
  2. Решил задачу таким способом: 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.
  3. @OnePeople Забыл уточнить, что основная форма должна оставаться активной
  4. Если в FireMonkey поставить FormStyle в значение StayOnTop, то форма будет над всеми окнами системы, а мне надо чтобы она оставалась только лишь над главной, но пряталась под окнами других программ. Чтобы я не пробовал – ничего нормального не выходит.
  5. @Dmitry_4501 в том то и дело, что не будет. Я прямо в моей функции WindowProc писал условие и рисовал. Причём обрабатывал не только WM_NCPAINT, но и WM_PAINT и многое другое, что хоть как-то может быть с этим связано. В FireMonkey это стабильно не работает. Иногда рисует, иногда нет. По крайней мере в моём случае, когда форма Acrylic и к ней применяется стиль. if uMsg = WM_NCPAINT then begin ... end;
  6. А теперь что касается изначального вопроса: к сожалению мне не удалось нормально рисовать на неклиентской части формы в 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 платформы.
  7. @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;
  8. @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 и наличии нескольких мониторов форма появляется между экранами, а не в центе одного из них. Я это сам обнаружил только, когда подключил себе второй монитор.
  9. В общем рисовать как оказалось на неклиентской части формы вообще не проблема. Но я делаю форму 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, но оно не стабильно работает в данном случае и бывает, когда картинка стирается и не рисуется, пока не наступит надобность перерисовать клиентскую часть формы.
  10. Не лучший вариант, так как теряется нормальная возможность изменять размер окна и перемещение с привязкой к краям экрана, когда система предлагает развернуть экран на пол экрана или в угол поместить
  11. Здравствуйте. Есть ли какая-либо возможность в Firemonkey для Windows поместить компонент или хотя бы рисовать на неклиентской части формы, а именно на TitleBar? В VCL для этого даже компонент отдельный сделали TTitleBarPanel. Перерыл весь Google и нечего вообще по теме не нашёл.
  12. Aptyp

    Артефакты вокруг текста

    На моём Samsung Note 5 вокруг букв проглядываются линии. Причём пробовал 3 различных разрешения экрана, ничего не меняется. У друга на Xiaomi Redmi 4x такого не наблюдается. Что это может быть?
  13. В приложении: 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 не вызывается что бы я не делал. Может я что-то не так делаю?
×
×
  • Создать...