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

Zyablik3000

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

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

  • Посещение

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

    1

Zyablik3000 стал победителем дня 8 ноября 2020

Zyablik3000 имел наиболее популярный контент!

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

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

  1. Здравствуйте! Отвечу сам себе)) Переписал компонент с использованием функционала Firemonkey. Спасибо за наличие Canvas.ClearRect() Приложил *.pas, вдруг кому пригодится)) Хотя есть нерешенные проблемы, но о них задам вопросы в других постах. Однако вопрос про рисование на канве ID2D1RenderTarget остается открытым (хотя-бы с целью повышения образованности). FMXProgress.7z
  2. Здравствуйте! Есть самописный компонент - индикатор загрузки написанныый под 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
  3. Всем спасибо) Решение нашел сам. Прочитав 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
  4. Как нечего? А TPanel? У неё же parent:=scrollbox. Если не наследовать, а просто бросить на форму TPresentedScrollBox и задать contentsize и autocalculatecontentsize=false, то все норм. И скроллбары и скроллинг есть.
  5. Здравствуйте! Есть такой код: 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 получаю Ни скроллбаров, ни панельки внутри ScrBox. Подскажите, что не так? Как правильно унаследоваться от TPresentedScrollBox?
  6. Я не об этом. Я о том что указатель на передаваемые данные, который помещается в поле lpData, ссылался на абракадабру. Причём такое поведение наблюдалось при пересылке из FMX в VCL.
  7. Недавно столкнулся с аналогичной проблемой, только отправителем был FMX а получателем VCL. Сообщение не приходило потому что была криво заполнена структура TCopyDataStruct, а именно lpData:Pointer. Компилятор при этом не ругался (подозреваю что происходил какой то AV, но делал это молча). К сожалению под рукой нет кода для примера, но когда исправил данные, сообщение начало приходить. Надеюсь кому-то помог.
  8. Здравствуйте! Если при перетаскивани контрола вывести мышь за пределы формы, то приложение и IDE зависает. Помогает только снять задачу в Диспетчере задач. После снятия задачи IDE начинает реагировать. Пробовал на разных проектах, в том числе и на экзампле с embarcadero. Подскажите, пожалуйста, что это и как с этим бороться? Эффект наблюдается если курсор перемещается за пределы формы и попадает на окно IDE из которого было запущено приложение.
  9. Здравствуйте! Есть 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.
  10. Да да. Век учись... То что надо. Спасибо.
  11. Проверил. Не работает. если (Parent is TControl) то берутся не размеры ScrollContent, а размеры PresentedScrollBox без скроллбаров (картинка ниже). Это не измененный стиль. Это Paint. Стиль дефолтный, не менялся. В дефолтном стиле content: TLayer. Написал (хоть это и бредом попахивает) (Parent is TLayer) результата нет.
  12. Здравствуйте! Есть 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?
  13. Спасибо!!! Да, это свой компонент. Перекрыв TControl.DoAbsoluteChanged желаемого эффекта не получил. Помогло перекрытие procedure TMyComponent.RecalcAbsolute; begin inherited RecalcAbsolute; { мой код... } end;
  14. Координаты родителя не меняются. Родитель это TRectangle большого размера который лежит на TPresentedScrollBox. Как лист в MS Visio. Вы имеете введу приводить от координат формы через всю иерархию? А если вложенность больше? Может быть я стараюсь сделать излишне универсально.
×
×
  • Создать...