Search code examples
delphifiremonkey

Artifacts in frames FireMonkey Delphi


I am using RAD 11.2 to make an application on FireMoneky. I use frames in my application, and when I load them, a border appears on my buttons, tables, and other elements that are not in the styles.

As an example:

The problem occurs on almost all components that are in the frame until I either switch the tab or resize the form. Moreover, their behavior is sometimes not at all adequate, for example, the table that is shown in the second image in a normal state sometimes begins to produce a lot of cells, as soon as you click on any of them, it comes back to normal.

I tried to do a repaint of components, forms, frames, but it didn't help. In fact, it felt like it didn't react at all.

The code of the main form where the frame is loaded:

unit UMain;

interface

uses
  System.SysUtils, System.Types, System.UITypes, System.Classes, System.Variants,
  FMX.Types, FMX.Controls, FMX.Forms, FMX.Graphics, FMX.Dialogs, FMX.Objects,
  System.ImageList, FMX.ImgList, FMX.Controls.Presentation, FMX.StdCtrls,
  FMX.TabControl, FMX.Layouts, FMX.Calendar, FMX.Maps, FMX.TreeView;

type
  TacFrame = class of TFrame;

  TForm1 = class(TForm)
    RContainer: TRectangle;
    RMenu: TRectangle;
    blue_pit: TBrushObject;
    RInsideContainer: TRectangle;
    BExit: TCornerButton;
    CornerButton2: TCornerButton;
    BObjects: TCornerButton;
    ImageList1: TImageList;
    StyleBook1: TStyleBook;
    brush_pink: TBrushObject;
    ver_ter: TBrushObject;
    Oreng: TBrushObject;
    Gris: TBrushObject;
    RHeader: TRectangle;
    RUserInfo: TRectangle;
    CAvatar: TCircle;
    RUsername: TRectangle;
    TUsername: TText;
    MapView1: TMapView;

    procedure BExitClick(Sender: TObject);
    procedure ButtonClick(Sender: TObject);

    procedure RectResize(Sender:TObject; Revert: Boolean = False);
    procedure CAvatarMouseEnter(Sender: TObject);
    procedure CAvatarMouseLeave(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure RMenuMouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Single);
    procedure Text4Resize(Sender: TObject);
  private
    FActiveRect: TRectangle;
    procedure OpenFrame(btn : TButton);
    { Private declarations }
  public
    { Public declarations }
  end;

  TCmpData = record
    Caption: string;
    FrameType: TacFrame;
    RectName: string;
  end;

  TCmpsArray = array [0..6] of TCmpData;

var
  Form1: TForm1;
  ActiveMenuRect: TRectangle;
  CurrentWorkFrame: TFrame;

implementation

uses UObjects,USystems,UDashboard,USettings,UWelcome,UJournals,UUpdates;
{$R *.fmx}
{$R *.Windows.fmx MSWINDOWS}
{$R *.iPhone47in.fmx IOS}
{$R *.SSW3.fmx ANDROID}
{$R *.Surface.fmx MSWINDOWS}

procedure TForm1.ButtonClick(Sender: TObject);
begin
  if Assigned(ActiveMenuRect) then ActiveMenuRect.Visible:=False;
  OpenFrame(TButton(Sender));
  RectResize(ActiveMenuRect);
end;

procedure TForm1.CAvatarMouseEnter(Sender: TObject);
var this: TCircle;
begin
  this:=TCircle(Sender);

end;

procedure TForm1.CAvatarMouseLeave(Sender: TObject);
var this: TCircle;
begin
  this:=TCircle(Sender);
end;

procedure TForm1.BExitClick(Sender: TObject);
begin
  Application.Terminate;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
   TUsername.Text:='Зубенко Михаил Петрович';
   RUsername.Width:= TUsername.Text.Length+TUsername.Width+RUsername.Width;
end;

const
  Cmps: TCmpsArray = (
     (Caption: 'Объекты';    // 0
     FrameType: TFObjects;
     RectName: 'RObjectsHint'),

     (Caption: 'Системы';    // 1
     FrameType: TSystems;
     RectName: 'RSystemsHint'),

     (Caption: 'Журналы';    // 2
     FrameType: TJournals;
     RectName: 'RJournalsHint'),

     (Caption: 'Дашбоард';   // 3
     FrameType: TDashboard;
     RectName: 'RStatisticHint'),

     (Caption: 'Обновления';   // 4
     FrameType: TUpdates;
     RectName: 'RStatisticHint'),

     (Caption: 'Настройки';    // 5
     FrameType: TSettings;
     RectName: 'RObjectsHint'),

     (Caption: 'Приветствие'; // 6
     FrameType: TWelcome;
     RectName: 'RObjectsHint')

     );

procedure TForm1.OpenFrame(btn : TButton);
var
  OldFrame: TFrame;
  i: integer;
begin


 if not (CurrentWorkFrame is Cmps[Btn.Tag].FrameType) then
  OldFrame := CurrentWorkFrame;

  if OldFrame <> nil then begin
    FreeAndNil(OldFrame);
  end;

  CurrentWorkFrame := Cmps[Btn.Tag].FrameType.Create(Application);
  CurrentWorkFrame.Parent:=RInsideContainer;

end;

procedure TForm1.RMenuMouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Single);
begin
  self.StartWindowDrag;
end;

procedure TForm1.RectResize(Sender: TObject; Revert: Boolean);
var this: TRectangle;
    i: integer;
begin
  if Assigned(Sender) then begin
   this:=TRectangle(Sender);
    if Revert = False then
     this.AnimateFloat('Opacity', 1, 0.5)
    else
      this.AnimateFloat('Opacity', 0, 0.15)
  end;
end;


procedure TForm1.Text4Resize(Sender: TObject);
var this: TText;
begin
  this:=TText(Sender);
  if this.Width<190 then
  begin
   this.AnimateFloat('Opacity', 0, 0.5)
  end
  else
    this.AnimateFloat('Opacity', 1, 0.5)
end;

end.

The Frame Code:

unit UObjects;

interface

uses
  System.SysUtils, System.Types, System.UITypes, System.Classes, System.Variants, 
  FMX.Types, FMX.Graphics, FMX.Controls, FMX.Forms, FMX.Dialogs, FMX.StdCtrls,
  FMX.Objects, FMX.Layouts, FMX.TreeView, FMX.Controls.Presentation,
  FMX.Memo.Types, FMX.ScrollBox, FMX.Memo, FMX.Edit, System.ImageList,
  FMX.ImgList;

type
  TFObjects = class(TFrame)
    GPanelObjects: TGridPanelLayout;
    RObjectContainer: TRectangle;
    GMain: TGridPanelLayout;
    GContainer: TGridPanelLayout;
    GDoSomthing: TGridPanelLayout;
    DoSomething_1: TRectangle;
    GridPanelLayout1: TGridPanelLayout;
    Text: TText;
    ImageList1: TImageList;
    GridPanelLayout2: TGridPanelLayout;
    Image1: TImage;
    GridPanelLayout3: TGridPanelLayout;
    DoSomthingRect_Text_1: TRectangle;
    Circle1: TCircle;
    DoSomthingRect_Text_2: TRectangle;
    Circle2: TCircle;
    DoSomthingRect_Text_3: TRectangle;
    Circle3: TCircle;
    DoSomthingRect_Text_4: TRectangle;
    Circle4: TCircle;
    Rectangle1: TRectangle;
    Rectangle6: TRectangle;
    Rectangle11: TRectangle;
    CornerButton2: TCornerButton;
    CornerButton3: TCornerButton;
    CornerButton1: TCornerButton;
    CornerButton4: TCornerButton;
    procedure CornerButton1MouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Single);
    procedure watch_info_objMouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Single);
  private
    { Private declarations }
  public
    { Public declarations }
  end;


implementation

{$R *.fmx}

procedure TFObjects.CornerButton1MouseMove(Sender: TObject; Shift: TShiftState;
  X, Y: Single);
var this: TCornerButton;
begin
  this:=TCornerButton(Sender);
end;

procedure TFObjects.watch_info_objMouseMove(Sender: TObject; Shift: TShiftState;
  X, Y: Single);
begin
//  watch_info_obj
end;

end.

Style:

object TStyleContainer
  object TLayout
    StyleName = 'CornerButton1Style1'
    Align = Center
    Size.Width = 81.000000000000000000
    Size.Height = 55.000000000000000000
    Size.PlatformDefault = False
    Visible = False
    TabOrder = 93
    object TRectangle
      StyleName = 'background'
      Align = Contents
      Fill.Color = x00FFFFFF
      Locked = True
      HitTest = False
      Size.Width = 81.000000000000000000
      Size.Height = 55.000000000000000000
      Size.PlatformDefault = False
      Stroke.Kind = None
      object TInnerGlowEffect
        Softness = 0.400000005960464500
        GlowColor = xFF4F4848
        Opacity = 0.899999976158142100
        Trigger = 'IsPressed=true'
        Enabled = False
      end
      object TColorAnimation
        StyleName = 'ColorAnimation1Style'
        Duration = 0.200000002980232200
        Inverse = True
        PropertyName = 'Fill.Color'
        StartValue = x00FFFFFF
        StopValue = x961E6CAC
        Trigger = 'IsMouseOver=true'
        TriggerInverse = 'IsMouseOver=false'
      end
    end
    object TGlyph
      StyleName = 'glyphstyle'
      Margins.Left = 2.000000000000000000
      Margins.Top = 4.000000000000000000
      Margins.Right = 2.000000000000000000
      Margins.Bottom = 2.000000000000000000
      Align = Center
      Size.Width = 40.000000000000000000
      Size.Height = 40.000000000000000000
      Size.PlatformDefault = False
    end
    object TText
      StyleName = 'text'
      Align = Client
      Locked = True
      HitTest = False
      Margins.Left = 5.000000000000000000
      Margins.Top = 2.000000000000000000
      Margins.Right = 5.000000000000000000
      Margins.Bottom = 2.000000000000000000
      Size.Width = 71.000000000000000000
      Size.Height = 51.000000000000000000
      Size.PlatformDefault = False
      TextSettings.WordWrap = False
    end
  end
  object TLayout
    StyleName = 'CornerButton7Style1'
    Align = Center
    Size.Width = 220.000000000000000000
    Size.Height = 55.000000000000000000
    Size.PlatformDefault = False
    Visible = False
    TabOrder = 91
    object TRectangle
      StyleName = 'background'
      Align = Contents
      Fill.Color = x00E0E0E0
      Locked = True
      HitTest = False
      Size.Width = 220.000000000000000000
      Size.Height = 55.000000000000000000
      Size.PlatformDefault = False
      Stroke.Kind = None
      object TInnerGlowEffect
        Softness = 0.400000005960464500
        GlowColor = xFF4F4848
        Opacity = 0.899999976158142100
        Trigger = 'IsPressed=true'
        Enabled = False
      end
      object TColorAnimation
        StyleName = 'ColorAnimation1Style'
        Duration = 0.200000002980232200
        PropertyName = 'Fill.Color'
        StartValue = claNull
        StopValue = xFFA7A7A7
      end
    end
    object TGlyph
      StyleName = 'glyphstyle'
      Margins.Left = 2.000000000000000000
      Margins.Top = 4.000000000000000000
      Margins.Right = 2.000000000000000000
      Margins.Bottom = 2.000000000000000000
      Align = Left
      Size.Width = 16.000000000000000000
      Size.Height = 16.000000000000000000
      Size.PlatformDefault = False
    end
    object TText
      StyleName = 'text'
      Align = Client
      Locked = True
      HitTest = False
      Margins.Left = 5.000000000000000000
      Margins.Top = 2.000000000000000000
      Margins.Right = 5.000000000000000000
      Margins.Bottom = 2.000000000000000000
      Size.Width = 210.000000000000000000
      Size.Height = 51.000000000000000000
      Size.PlatformDefault = False
      TextSettings.FontColor = xFF5D5C5C
      TextSettings.WordWrap = False
    end
  end
  object TLayout
    StyleName = 'CButtonBlue'
    Align = Center
    Size.Width = 82.000000000000000000
    Size.Height = 49.000000000000000000
    Size.PlatformDefault = False
    Visible = False
    TabOrder = 92
    object TRectangle
      StyleName = 'background'
      Align = Contents
      Fill.Color = x00FFFFFF
      Locked = True
      HitTest = False
      Size.Width = 82.000000000000000000
      Size.Height = 49.000000000000000000
      Size.PlatformDefault = False
      Stroke.Kind = None
      object TColorAnimation
        StyleName = 'ColorAnimation1Style'
        Duration = 0.200000002980232200
        Inverse = True
        PropertyName = 'Fill.Color'
        StartValue = x00FFFFFF
        StopValue = x961E6CAC
        Trigger = 'IsMouseOver=true'
        TriggerInverse = 'IsMouseOver=false'
      end
    end
    object TText
      StyleName = 'text'
      Align = Client
      Locked = True
      HitTest = False
      Margins.Left = 5.000000000000000000
      Margins.Top = 2.000000000000000000
      Margins.Right = 5.000000000000000000
      Margins.Bottom = 2.000000000000000000
      Size.Width = 72.000000000000000000
      Size.Height = 45.000000000000000000
      Size.PlatformDefault = False
      Text = 'Text'
    end
    object TGlyph
      StyleName = 'glyphstyle'
      Margins.Top = 4.000000000000000000
      Margins.Right = 2.000000000000000000
      Margins.Bottom = 2.000000000000000000
      Align = MostLeft
      Position.Y = 4.000000000000000000
      Size.Width = 39.000000000000000000
      Size.Height = 43.000000000000000000
      Size.PlatformDefault = False
    end
  end
end

Solution

  • Using 10.4.2 and running your example program, I reproduced the problem that I believe that you are describing, on the three buttons in the frame.

    I couldn't find what was causing it, and like you I tried Repaint and a few other things.

    However, I did find a workaround. Your example had the frame's Align:=TAlignLayout.Client; after putting in its container (RInsideContainer). As long as that is always the case, the following should work without unwanted side effects.

    Just before the end of the .OpenFrame method, I added the following lines:

      CurrentWorkFrame.Width:=CurrentWorkFrame.Width+1;
      Application.ProcessMessages;
      CurrentWorkFrame.Width:=CurrentWorkFrame.Width-1; 
    

    It seems that even though the Align prevents the size from changing, it does trigger some sort of repaint that removes the button's borders before they are seen.