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

Zyablik3000

Пользователи
 Профиль  Обзор контента

  • Постов

    22

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

  • Посещение

  • Победитель дней

    1

 Тип контента 

Сообщения, опубликованные Zyablik3000

    Нарисовать на канве ID2D1RenderTarget (ID2D1Bitmap)

    в Канва

    Опубликовано

    Здравствуйте!

    Отвечу сам себе))

    Переписал компонент с использованием функционала Firemonkey.

    Спасибо за наличие Canvas.ClearRect()

    Приложил *.pas, вдруг кому пригодится))

    Хотя есть нерешенные проблемы, но о них задам вопросы в других постах.

    Однако вопрос про рисование на канве ID2D1RenderTarget остается открытым (хотя-бы с целью повышения образованности).

     

    FMXProgress.7z

    Нарисовать на канве ID2D1RenderTarget (ID2D1Bitmap)

    в Канва

    Опубликовано · Изменено пользователем Zyablik3000

    Здравствуйте!

    Есть самописный компонент - индикатор загрузки написанныый под VCL с использованием Direct2D. 

    TD2DProgressBar = class(TCustomControl)
    FRenderTarget: ID2D1RenderTarget;

FD2DFactory.CreateWicBitmapRenderTarget(FWicBitmap, RenderTargetProp, FRenderTarget);
    FInteropTarget := FRenderTarget as ID2D1GdiInteropRenderTarget;

    Вся отрисовка происходит на FRenderTarget.

    Затем беру 

    FInteropTarget.GetDC(D2D1_DC_INITIALIZE_MODE_COPY, FRenderDC);

    и вывожу на поверхность функцией
      

    procedure TD2DProgressBar.UpdateWindow(sourceDC : HDC);
var
  info : TUpdateLayeredWindowInfo;
begin
  ZeroMemory(@info, sizeof(info));
  with info do begin
    cbSize  := sizeof(TUpdateLayeredWindowInfo);
    pptSrc  := @FSourcePosition;
    pptDst  := @FWindowPosition;
    psize   := @FWndSize;
    pblend  := @FBlend;
    dwFlags := ULW_ALPHA;
  end;
  info.hdcSrc := SourceDC;

  if not UpdateLayeredWindowIndirect(handle, @info) then
  begin
    RaiseLastOSError();
  end

end;

    Но это только под VCL.

    В Firemonkey не нашел способа комбинировать градиенты и/или нарисовать арку градиентом (саму линию арки а не залить сектор) или комбинацией градиентов.

     

    Как вывести этот FRenderTarget на канву Firemonkey-контрола?

    Самая большая проблема в том, что компонент полупрозрачный, и вариант с переливом через Vcl.Graphics.TBitmap и MemoryStream не дает нужного результата.
      

    MS:=TMemoryStream.Create;

Blend.BlendOp            := AC_SRC_OVER;
Blend.BlendFlags         := 0;
Blend.AlphaFormat        := AC_SRC_NO_PREMULT_ALPHA;
Blend.SourceConstantAlpha:= 255; // // Уровень прозрачности


Res:=Winapi.Windows.AlphaBlend(VCLBitmap.Canvas.Handle, 0, 0, VCLBitmap.Width, VCLBitmap.Height,
                                                              FRenderDC, 0, 0, VCLBitmap.Width, VCLBitmap.Height, Blend);
  {или эта функция

StretchBlt(bm.Canvas.Handle, 0, 0, VCLBitmap.Width, VCLBitmap.Height,
                      FRenderDC, 0, 0, VCLBitmap.Width, VCLBitmap.Height, SRCCOPY); }

VCLBitmap.SaveToStream(MS);

FFMXBitmap.SetSize(TSize.Create(VCLBitmap.Width, VCLBitmap.Height));
FFMXBitmap.LoadFromStream(MS);
FreeAndNil(MS);

     

    В Blend пробовал разные комбинации BlendOp и AlphaFormat.

    Хелп плизз!

    Во вложении компонент под VCL. ( Может кому пригодится)) )

    D2DProgressbar.zip

    D2DProgressBarImage.jpg

    Компонент - наследник TPresentedScrollBox

    в TScrollBox

    Опубликовано

    Всем спасибо) Решение нашел сам.

    Прочитав http://yaroslavbrovin.ru/new-approach-of-development-of-firemonkey-control-control-model-presentation-part-1-ru/  и другие материалы с этой странички (к слову: жутко полезная информация) перекрыл в своем компоненте функцию

    function DefinePresentationName: string; override; 

    function TScrBox.DefinePresentationName: string;
begin
  Result:='PresentedScrollBox-style';
end;

    Дело оказалось в том, что не загружалась презентация для моего компонента (а модель создавалась), точнее пыталась загрузиться презентация 'ScrBox-style', прокси для которой не зарегистрирован. Ведь имя презентации формировалось как 'Имя класса' + '-style'

    Но этого оказалось недостаточно. Еще понадобилось задать свойство StyleLookup:='scrollboxstyle'; т.к. скроллбары и прочие контролы берутся из стиля TStyledCustomScrollBox'а, который описан в FMX.ScrollBox.Style.

    Надеюсь кому-то поможет, и этот кто-то не будет как я тратить на решение этой задачи три дня жизни.

     

    Test.7z

    Компонент - наследник TPresentedScrollBox

    в TScrollBox

    Опубликовано · Изменено пользователем Zyablik3000
    Знаки припинания

    Как нечего? А TPanel? У неё же parent:=scrollbox.

    Если не наследовать, а просто бросить на форму TPresentedScrollBox и задать contentsize и autocalculatecontentsize=false, то все норм. И скроллбары и скроллинг есть.

    Компонент - наследник TPresentedScrollBox

    в TScrollBox

    Опубликовано

    Здравствуйте!

    Есть такой код:

      

    unit Unit2;

interface

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

type
  TScrBox = class(TPresentedScrollBox)
    public
	constructor Create(AOwner: TComponent); override;	
      procedure Paint; override;
  end;

  TForm2 = class(TForm)
    Button1: TButton;
    procedure Button1Click(Sender: TObject);
  private
    { Private declarations }
    FContentChange: TNotifyEvent;
  public
    { Public declarations }
  end;

var
  Form2: TForm2;

implementation

{$R *.fmx}

{ TScrBox }

constructor TScrBox.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
end;

procedure TScrBox.Paint;
begin
  inherited;
  Canvas.DrawDashRect(LocalRect, 0, 0, AllCorners, 1, TAlphaColorRec.Red);
end;

procedure TForm2.Button1Click(Sender: TObject);
var
  ScrBox: TScrBox;
  Pnl: TPanel;
begin
  ScrBox:=TScrBox.Create(Self);
  ScrBox.Parent:=Self;
  ScrBox.AutoCalculateContentSize:=False;
  ScrBox.ContentSize.Width:=1000;
  ScrBox.ContentSize.Height:=1000;
  Pnl:=TPanel.Create(ScrBox);
  Pnl.Parent:=ScrBox;
  Pnl.Position.X:=10;
  Pnl.Position.Y:=10;
end;

end.

    Однако, вопреки ожиданиям, при клике на Button1 получаю

    PresentedScrollBox.jpg.baff81745fca224c135b06b0cb56ef7e.jpg

    Ни скроллбаров, ни панельки внутри ScrBox.

    Подскажите, что не так? Как правильно унаследоваться от TPresentedScrollBox?

    Передача параметра программе

    в Приложение и формы

    Опубликовано · Изменено пользователем Zyablik3000
    добавил абзац

    Я не об этом. Я о том что указатель на передаваемые данные, который помещается в поле lpData, ссылался на абракадабру.

    Причём такое поведение наблюдалось при пересылке из FMX в VCL.

    Передача параметра программе

    в Приложение и формы

    Опубликовано

    В 02.03.2018 в 16:13, OnePeople сказал:

    Да мне главное чтобы приходило, а оно вообще не приходит т.к. ShowMessage('Получено сообщение от другой копии'); не отрабатывает

    Недавно столкнулся с аналогичной проблемой, только отправителем был FMX а получателем VCL. Сообщение не приходило потому что была криво заполнена структура TCopyDataStruct, а именно lpData:Pointer. Компилятор при этом не ругался (подозреваю что происходил какой то AV, но делал это молча). К сожалению под рукой нет кода для примера, но когда исправил данные, сообщение начало приходить. Надеюсь кому-то помог.

    Drag&drop вешает приложение и IDE.

    в Приложение и формы

    Опубликовано · Изменено пользователем Zyablik3000

    Здравствуйте!

    Если при перетаскивани контрола вывести мышь за пределы формы, то приложение и IDE зависает. Помогает только снять задачу в Диспетчере задач. После снятия задачи IDE начинает реагировать. Пробовал на разных проектах, в том числе и на экзампле с embarcadero. Подскажите, пожалуйста, что это и как с этим бороться?

    Эффект наблюдается если курсор перемещается за пределы формы и попадает на окно IDE из которого было запущено приложение.

    Получение хэндла главной формы приложения из другой программы

    в Приложение и формы

    Опубликовано · Изменено пользователем Zyablik3000

    Здравствуйте!

    Есть VCL приложение с кодом: 

    function GetWindow(Handle: Cardinal; LParam: longint): bool;
begin
  Result:= true;
  WindowList.Add(Pointer(Handle));
end;

function TFileOperationsThread.GetHandles(ThreadID: Cardinal): Cardinal;
var
  i: integer;
  hnd : Cardinal;
  cpid : DWord;
begin
  Result:=0;
  WindowList := TList.Create;
  EnumWindows (@GetWindow, 0);
  for i := 0 to WindowList.Count - 1 do
  begin
    hnd := HWND(WindowList[i]);
    GetWindowThreadProcessID (hnd, @cpid);
    if ThreadID = CPID then
    begin
      Result := hnd;
      WindowList.Free;
      Exit;
    end;
  end;
  WindowList.Free;
end;

procedure TFileOperationsThread.Execute;
var
  SEInfo: TShellExecuteInfo;
  StartInfo: TStartupInfo;
  ProcInfo: _PROCESS_INFORMATION;
  AppHandle: THandle;
begin
  StartInfo.cb:=SizeOf( StartupInfo);
  StartInfo.dwFlags:=STARTF_USESHOWWINDOW;
  StartInfo.wShowWindow:=SW_SHOW;
  if FileExists(FFileInfo.FullFileName) then
  begin
    if CreateProcess(PChar(FFileInfo.FullFileName),
                     PChar(FFileInfo.FullFileName),
                     nil,
                     nil,
                     False,
                     NORMAL_PRIORITY_CLASS,
                     nil,
                     nil,
                     StartInfo,
                     ProcInfo) then
    begin
      WaitForInputIdle(ProcInfo.hProcess, INFINITE);
      AppHandle:=GetHandles(ProcInfo.dwProcessId)
      SendMessage(FFormHandle, WM_NEED_CHANGE_STATE, WPARAM(AppHandle), SMP_WINDOW_HANDLE);
      CloseHandle(ProcInfo.hProcess);
      CloseHandle(ProcInfo.hThread);
    end;
  end;
end;

    Код нормально запускает приложение написанное на Firemonkey.

    Но функция GetHandles возвращает некое число, которое НЕ равно ни ApplicationHWND, ни FormToHWND(Self) firemonkey приложения.

    Функция WaitForInputIdle возвращает 0.

    Проблема решается заменой WaitForInputIdle(ProcInfo.hProcess, INFINITE); на Sleep(500); В AppHandle получаю значение равное FormToHWND(Self) firemonkey приложения.

    А теперь вопрос: Подскажите плиз как получить Виндовый хендл главной формы Firemonkey-приложения после его запуска и что это за неизвестное число, которое получаю в AppHandle:=GetHandles(ProcInfo.dwProcessId).

    Не хочется использовать FindWindow.

     

    Вписать TRectangle в ScrollContent TPresentedScrollBox'а

    в TScrollBox

    Опубликовано

    Проверил. Не работает. если 

    (Parent is TControl)

    то берутся не размеры ScrollContent, а размеры PresentedScrollBox без скроллбаров (картинка ниже).

    ScrollBox.png.10aa0fa5fad40639d1969cb6c61acad5.png

    Это не измененный стиль. Это Paint.

    Стиль дефолтный, не менялся. В дефолтном стиле content: TLayer. Написал (хоть это и бредом попахивает) 

    (Parent is TLayer)

    результата нет.

    Вписать TRectangle в ScrollContent TPresentedScrollBox'а

    в TScrollBox

    Опубликовано

    Здравствуйте!

    Есть TPresentedScrollBox с AutoCalculateContentSize:=False и ContentSize.Height:=10000 ContentSize.Width:=10000 и свой компонент наследник TRectangle в котором перекрыт ParentChanged 

    procedure TMyComponent.ParentChanged;
var
  str: string;
begin
  inherited ParentChanged;
  if Assigned(Self.Parent) then
  begin
    Self.Position.X:=Self.ParentControl.Position.X+Self.ParentControl.Padding.Left;
    Self.Position.Y:=Self.ParentControl.Position.Y+Self.ParentControl.Padding.Top;
    str:=Parent.ClassName;
    if (Parent is TScrollContent) then
    begin
      Self.Width:=(Parent as TScrollContent).Width-Self.ParentControl.Padding.Right;
      Self.Height:=(Parent as TScrollContent).Height-Self.ParentControl.Padding.Bottom;
    end
    else
    begin
      Self.Width:=Self.ParentControl.Width-Self.ParentControl.Padding.Right;
      Self.Height:=Self.ParentControl.Height-Self.ParentControl.Padding.Bottom;
    end;
    Self.RecalcAbsolute;
  end;
end;

    Проблема в том, что в переменной str получаю 'TScrollContent', однако (Parent is TScrollContent) почему то всегда False и строки 

    Self.Width:=(Parent as TScrollContent).Width-Self.ParentControl.Padding.Right;
Self.Height:=(Parent as TScrollContent).Height-Self.ParentControl.Padding.Bottom;

    никогда не выполняются.

    Приведение типов в лоб без условия дает ошибку 'Invalid class typecast'

    Как вписать в этот TScrollContent размером (0, 0, 10000, 10000) TRectangle?

     

    Как отловить изменение положения контрола

    в Положение, размеры, выравнивание

    Опубликовано

    Координаты родителя не меняются.

    Родитель это TRectangle большого размера который лежит на TPresentedScrollBox. Как лист в MS Visio.

    4 часа назад, krapotkin сказал:

    значит есть и возможность все остальное приводить

    Вы имеете введу приводить от координат формы через всю иерархию? А если вложенность больше?

    Может быть я стараюсь сделать излишне универсально.

    Как отловить изменение положения контрола

    в Положение, размеры, выравнивание

    Опубликовано

    Спасибо Alex7wrt и mmover.

    Перехват события изменения положения отработал на ура?

    Можно было попробовать писать свой обработчик, но

    29 минут назад, Alex7wrt сказал:

    Для этого в тех методах, которые вызывают изменение положения контрола

    знать бы еще все эти методы.

    Но все равно спасибо за идею?

    Как отловить изменение положения контрола

    в Положение, размеры, выравнивание

    Опубликовано

    9 минут назад, krapotkin сказал:

    в зависимости от каких-то событий менять им position, color и все что угодно

    Так мне и нужно событие изменения позиции (если оно существует). И в нем считать все что нужно.

    Если, скажем я напишу 

    MyComponent.Height:=Random(1000);

    то отработает 

    procedure Resize; override;

    моего компонента. И тут можно отреагировать на измнение размера.

    Вопрос в том, есть ли аналогичная процедура для реакции на 

    MyComponent.Position.X:=Random(1000);

    Как отловить изменение положения контрола

    в Положение, размеры, выравнивание

    Опубликовано

    Таймер - самый очевидный вариант.

    А если без таймера? Это же лишняя нагрузка. Планируется 200-300 компонентов на форме держать. А это 200-300 "лишних" таймеров.

    Может есть какая-нибудь стандартная процедура похожая на DoResize?

    Как отловить изменение положения контрола

    в Положение, размеры, выравнивание

    Опубликовано

    Здравствуйте!

    Создаю компонент. Для компонента рассчитывается три точки TPointF в координатах родителя (одна по левому краю, одна в центре, одна по правому краю)ж

    Есть код 

    MyComponent:=TMyComponent.Create(Self);
MyComponent.Position.X:=Random(1000);
MyComponent.Position.Y:=Random(1000);
MyComponent.Parent:=(Self);

    Вопрос: можно ли отловить изменение Position чтобы там рассчитывать положение нужных мне трех точек.

    Понятно что можно сделать какой-нибудь MyComponent.CalcPoints где рассчитывать положение точек  и вызывать после каждого изменения положения компонента в программе, но хочется делать расчеты внутри компонента.

     

    TAnimationfloat некоректно работает с Texpander

    в TFloatAnimation

    Опубликовано

    Здравствуйте!

    Есть такая же проблема. StartFromCurrent = false. Пробовал разные значения StartValue/StopValue.

    При этом если ту же FloatAnimation2 перетянуть на TPanel то все работает.

    Аналогичная проблема наблюдается в созданном мной компоненте.

    Ткните носом, пожалуйста!

    Expander.thumb.jpg.15d7d57776717f0a44187a5bb123a8ad.jpg 

    procedure TForm2.Button1Click(Sender: TObject);
begin
  FloatAnimation2.Start;
end;

     

    OnMouseEnter срабатывает при каждом перемещении мыши по контролу

    в Мышь

    Опубликовано

    Здравствуйте! 

    procedure TForm3.Panel1MouseEnter(Sender: TObject);
begin
  ShowMessage('asdasd');
end;

    Этот код срабатывает при каждом перемещении мыши по панели.

    Проблема в том, что при этом срабатывает и событие MouseLeave.

    Проверял на чистом проекте.

    Как победить?

×
×
  • Создать...