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

mmover

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

  • Постов

    26

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

  • Посещение

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

    6

 Тип контента 

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

    Прозрачность TImage's, наложение...

    в Графика

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

    Не совсем понятно что именно нужно. Если просто установить прозрачность для TImage, то у него есть свойство
    Opacity. Если необходимо работать именно с Bitmap, то можно попробовать так:
      ...
      M.SetPixel(x, y, PremultiplyAlpha(CurrentPixelColor));

     

    Рамка вокруг объекта/текста/изображения

    в Графика

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

    Я имел ввиду исходные коды FMX.
    А примеров в сети можно много найти (например вот первые попавшиеся - www.fmxexpress.com, www.fmxuniversity.com )
    Если под логикой слоев подразумевается работа с прозрачностью, то с эти проблем нет.

     

    Как перерисовать скролл?

    в TGrid

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

    Если я правильно понял задачу, то так : 

    procedure TForm2.VScrollPaint(Sender: TObject; Canvas: TCanvas; const ARect: TRectF);
begin
 Canvas.Fill.Color := TAlphaColors.Red;
 Canvas.FillRect(ARect,0,0,[],1);
end;

procedure TForm2.FormShow(Sender: TObject);
begin
 Grid1.StylesData['vscrollbar.OnPaint'] :=  TValue.From<TOnPaintEvent>(VScrollPaint);
end;

     

    [Windows] Сворачивание приложение

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

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

    Я в свое время тоже над этим бился...

    Вот такая конструкция получилась (Delphi 10.2.3): 

    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.Platform.Win,
  FMX.Platform,
  Winapi.Windows,
  Winapi.Messages,
  FMX.Memo;

type
  TForm1 = class(TForm)
  private
  type
    TShowAction = (saNone, saNormal, saMinimize, saMaximize);
  protected
    procedure CreateHandle; override;
  private
    AppIsActive : Boolean;
    FOldFMXWndProc : TFNWndProc;
    FNewFMXWndProc : Pointer;
    FShowAction: TShowAction;
    procedure FMXFormWndProc(var Msg: Winapi.Messages.TMessage);
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.fmx}

procedure TForm1.CreateHandle;
var
 H : HWND;
begin
 inherited CreateHandle;
 H := FormToHWND(Self);
 FOldFMXWndProc := TFNWndProc(GetWindowLong(H, GWL_WNDPROC));
 FNewFMXWndProc := MakeObjectInstance(FMXFormWndProc);
 SetWindowLong(H, GWL_WNDPROC, NativeInt(FNewFMXWndProc));
end ;

procedure TForm1.FMXFormWndProc(var Msg: Winapi.Messages.TMessage);
begin
  case Msg.Msg of

    WM_SHOWWINDOW :
    begin
      case TWMShowWindow(Msg).Status of
        SW_PARENTCLOSING:
          if FShowAction = saNone then
          begin
            if IsIconic(FormToHWND(Self)) then
              FShowAction := saMinimize
                else
              if IsZoomed(FormToHWND(Self)) then
                FShowAction := saMaximize
              else
                FShowAction := saNormal;

                TThread.CurrentThread.ForceQueue(nil,
                  procedure
                  begin
                   SendMessage(FormToHWND(Self),WM_SYSCOMMAND, SC_MINIMIZE,0);
                   WindowState := TWindowState.wsMinimized;
                  end);

          end;
        SW_PARENTOPENING:
          if FShowAction <> saNone then
          begin
              if FShowAction = saMaximize then
                WindowState := TWindowState.wsMaximized
               else
              if FShowAction = saNormal then
                 WindowState := TWindowState.wsNormal;
            FShowAction := saNone;
            exit;
          end;
      end;
    end;

    WM_NCACTIVATE :
    begin
      if (Msg.WParam = 0) then
        Msg.WParam := Byte(AppIsActive);
    end;
   end;

  Msg.Result := CallWindowProc(FOldFMXWndProc, FormToHWND(Self), Msg.Msg, Msg.WParam, Msg.LParam);

  case Msg.Msg of
    WM_ACTIVATEAPP :
    begin
     AppIsActive := Msg.WParam = 1 ;
    end ;
  end;

end;


end.

     

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

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

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

    Можно перехватить событие изменения позиции. Только обязательно нужно сохранить предыдущий обработчик для его принудительного вызова.

    Вот грубый пример  : 

    var
  SavePositionOnChange : TNotifyEvent;

procedure TForm2.FormShow(Sender: TObject);
begin
 SavePositionOnChange := Button4.Position.OnChange ;
 Button4.Position.OnChange := ButtonPositionChange;
end;

procedure TForm2.ButtonPositionChange(Sender: TObject);
begin
  {
  делаем что нужно ....
  }
 if Assigned(SavePositionOnChange) then
    SavePositionOnChange(Sender)
end;

     

    Сортировка элементов Скроллбокса

    в TScrollBox

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

    Пришел на ум такой вариант : 

    procedure TForm2.FormShow(Sender: TObject);
var
 i : Integer;
 B : TButton ;
begin
 ScrollBox1.BeginUpdate;
 for i := 1 to 10 do
 begin
   B := TButton.Create(Self) ;
   B.Parent := ScrollBox1;
   B.Height := 50;
   B.Align := TAlignLayout.Top ;
   B.Tag := Random(50);
   B.Text := 'Button '+IntToStr(B.Tag);
 end;
 ScrollBox1.EndUpdate;
end;

procedure TForm2.ButtonSortClick(Sender: TObject);
var
 L : TList<Tcontrol>;
 i : Integer;
begin
 L := TList<Tcontrol>.Create;
 for i := 0 to ScrollBox1.Content.ControlsCount-1 do
  L.Add(ScrollBox1.Content.Controls[i]);

 L.Sort(TComparer<TControl>.Construct(
    function(const Left, Right: TControl) : Integer
    begin
      Result := CompareValue(Left.Tag,Right.Tag);
    end));

 for i := 0 to L.Count-1 do
 begin
  L[i].Align := TAlignLayout.None;
  L[i].Position.Y := i* L[i].Height;
  L[i].Align := TAlignLayout.Top;
 end;
 ScrollBox1.RealignContent;
 L.Free;
end;

     

    Ручная анимация прокрутки списка

    в TListBox

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

    Вот, накидал класс который может помочь.

    unit UAnimHelper;

    interface
    uses
      System.Classes,
      System.SysUtils,
      FMX.Types;

    type
      TAnimateStep = reference to procedure(Value : Single);

      TAnimateHelper = class
      private
      type
        TAniInst = class(TFmxObject)
        private
          FValue : Single;
          FStepProc : TAnimateStep;
          FStopProc : TProc;
          procedure SetValue(Value : Single);
          procedure DoAniFinished(Sender: TObject);
        public
          constructor Create(AStepProc : TAnimateStep;
                             AStopProc : TProc);
        published
          property Value : Single read FValue write SetValue;
        end;
      public
        class procedure DoAnimate(Root : IRoot; // без указания формы анимация работать не будет
                                  Duration, FromValue, ToValue : Single;
                                  AType: TAnimationType;
                                  AInterpolation: TInterpolationType;
                                  StepProc : TAnimateStep;
                                  StopProc : TProc = nil);
      end;

    implementation

    uses FMX.Ani;

    constructor TAnimateHelper.TAniInst.Create(AStepProc : TAnimateStep;
                            AStopProc : TProc);
    begin
     inherited Create(nil);
     FStepProc := AStepProc;
     FStopProc := AStopProc;
    end;

    procedure TAnimateHelper.TAniInst.SetValue(Value : Single);
    begin
     if Assigned(FStepProc) then
       FStepProc(Value);
    end;

    procedure TAnimateHelper.TAniInst.DoAniFinished(Sender: TObject);
    begin
     if Assigned(FStopProc) then
       FStopProc();

      TThread.ForceQueue(nil, procedure
      begin
        TAnimation(Sender).TagObject.DisposeOf;
      end);
    end;

    class procedure TAnimateHelper.DoAnimate(Root : IRoot;
                              Duration, FromValue, ToValue : Single;
                              AType: TAnimationType;
                              AInterpolation: TInterpolationType;
                              StepProc : TAnimateStep;
                              StopProc : TProc = nil);
    var
     AniInst : TAniInst;
     Animation: TFloatAnimation;
    begin
     AniInst := TAniInst.Create(StepProc,StopProc);
     AniInst.FValue := FromValue;

     Animation := TFloatAnimation.Create(nil);
     Animation.TagObject := AniInst;
     Animation.Parent := AniInst;
     Animation.SetRoot(Root);
     Animation.AnimationType := AType;
     Animation.Interpolation := AInterpolation;
     Animation.OnFinish := AniInst.DoAniFinished;
     Animation.Duration := Duration;
     Animation.PropertyName := 'Value';
     Animation.StartFromCurrent := True;
     Animation.StopValue := ToValue;
     Animation.Start;
    end;

    end.

     

    Пример использования :

    procedure TForm1.Button3Click(Sender: TObject);
    begin
     TAnimateHelper.DoAnimate(Self, 1.2, ListBox1.ViewportPosition.Y , 400,
                              TAnimationType.&In,
                              TInterpolationType.Circular,
                              procedure(Value : Single)
                              begin
                                ListBox1.ViewportPosition := PointF(0,Value);
                              end);
    end;

     

     

    Окончание скроллинга в ListBox

    в События

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

    Стандартным способом никак (или я плохо искал)

    Получилось не очень,  но работает.

    (на форме только два ListBox-а)

    .........

    type
      THackListBox = class(TListBox)
      public
        property VScrollBar;
      end;
      THackScrollBar = class(TScrollBar)
      public
        property Track;
      end;

    procedure TForm1.FormShow(Sender: TObject);
    var
     i : Integer ;
    begin
     for i := 0 to 50 do
       ListBox1.Items.Add('Item '+ IntToStr(i));
     for i := 0 to 50 do
       ListBox2.Items.Add('Item '+ IntToStr(i));

     ListBox1.OnVScrollChange := ListBoxVScrollChange;
     ListBox2.OnVScrollChange := ListBoxVScrollChange;
    end;

    procedure TForm1.EndScrollListBox(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Single);
    var
     ListB : TCustomListBox;
     C : TFmxObject;
    begin
     if Sender is TThumb then
     if TThumb(Sender).IsPressed then
     begin
       ListB := nil;
       C := TFmxObject(Sender);
       while C <> nil do
       begin
         C := C.Parent;
         if (C <> nil) and (C is TCustomListBox) then
         begin
           ListB := C as TCustomListBox;
           break;
         end;
       end;

       if ListB <> nil then
         ShowMessage('End tracking scroll Listbox. Name : '+ ListB.Name);
     end;
    end;


    procedure TForm1.ListBoxVScrollChange(Sender: TObject);
    begin
     if Sender is TListBox then
     if not Assigned(THackScrollBar(THackListBox(Sender).VScrollBar).Track.Thumb.OnMouseUp) then
       THackScrollBar(THackListBox(Sender).VScrollBar).Track.Thumb.OnMouseUp := EndScrollListBox;
    end;

     

    Узнать дату Android приложения

    в Android

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

    Как то так :

    ....
    var
      PackageInfo: JPackageInfo;
      PackageManager: JPackageManager;
      Activity: JActivity;
    begin
      Activity := TJNativeActivity.Wrap(PANativeActivity(System.DelphiActivity)^.clazz);
      PackageManager := Activity.getPackageManager;
      PackageInfo := PackageManager.getPackageInfo(Activity.getPackageName, TJPackageManager.JavaClass.GET_CONFIGURATIONS);
      Result :=  PackageInfo.lastUpdateTime;
    end;

    TTextSettings неразвёртвовается

    в Прочие вопросы

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

    Примерно так: 

    interface

uses
  System.SysUtils, System.Types, System.UITypes, System.Classes, System.Variants,
  FMX.Types, FMX.Controls, FMX.Forms, FMX.Graphics;

type
  TMyLabel = class(TControl)
  private
    FFontTextSettingInfo: TTextSettingsInfo;
    function GetTextSettings: TTextSettings;
    procedure SetTextSettings(const Value: TTextSettings);
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
  published
    property LabelFont: TTextSettings read GetTextSettings write SetTextSettings;
  end;


implementation

type
  TMyTextSettings = class (TTextSettingsInfo.TCustomTextSettings)
  public
    constructor Create(const AOwner: TPersistent); override;
  published
    property Font;
    property FontColor;
    property HorzAlign;
    property VertAlign;
//    можно убрать ненужные свойства
//    property WordWrap default True;
//    property Trimming default TTextTrimming.Character;
  end;

constructor TMyTextSettings.Create(const AOwner: TPersistent);
begin
  inherited;
  WordWrap := False;
  Trimming := TTextTrimming.Character;
end;

constructor TMyLabel.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FFontTextSettingInfo := TTextSettingsInfo.Create(Self,TMyTextSettings);
//  FFontTextSettingInfo.TextSettings.FontColor := TAlphaColors.Black;
//  FFontTextSettingInfo.TextSettings.OnChanged := FontChanged;
end;

destructor TMyLabel.Destroy;
begin
  FFontTextSettingInfo.Free;
  inherited Destroy;
end;

function TMyLabel.GetTextSettings: TTextSettings;
begin
  Result := FFontTextSettingInfo.TextSettings;
end;

procedure TMyLabel.SetTextSettings(const Value: TTextSettings);
begin
  FFontTextSettingInfo.TextSettings.Assign(Value);
end;

end.

     

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