Using Delphi 10.4.2, I am adding an in-place editor for the text property of a custom TreeViewItem of a TTreeView in FMX, similar to the way the VCL version works. After failing to accomplish this in simple code, I decided to try my hand at accomplishing it using FMX Styles. Below is the code for my test project, along with the text of the StyleBook.
This is my first attempt at working with styles and it appears to work the way I expected it to in Windows. But I was wondering if this is the correct way to use styles, or am I missing something and/or using the styles feature wrong in some way?
Added...Or maybe a better question would be Is this the best way to access the "editor" object I added to the default TTreeViewItem style?
Note: For the style, I used the "Edit Custom Style" option for a TTreeViewItems, and simply added a TEdit to it and made it invisible by default. When you double click a node, the logic makes the TEdit visible and sets it text property to that of the Node. When you change the TEdit text and press Return, the TEdit is set to invisible again and the TEdit text is copied to the node text property. I plan on using this same component for Android and Apple versions of my program, but have not tested or worked on that yet. My assumption is that I will need to add the platforms to the StyleBook for the TreeViewItem, but the basic logic should work the same as Windows.
unit Unit1;
interface
uses System.SysUtils, System.Classes, System.UITypes, FMX.Forms, FMX.TreeView, FMX.Controls, FMX.Edit, FMX.Types,
FMX.Layouts;
type
TForm1 = class(TForm)
TreeView1: TTreeView;
StyleBook1: TStyleBook;
procedure FormShow(Sender: TObject);
private
public
end;
var
Form1: TForm1;
implementation
{$R *.fmx}
type
TVLinkTreeViewItem = class(TTreeViewItem)
private
fData: string;
procedure TreeViewItem1DblClick(Sender: TObject);
procedure EditorExit(Sender: TObject);
procedure EditorKeyUp(Sender: TObject; var Key: Word; var KeyChar: Char; Shift: TShiftState);
procedure ApplyStyle; override;
public
property Data: string read fData write fData;
constructor Create(AOwner: TComponent); override;
end;
procedure TForm1.FormShow(Sender: TObject);
var
I, c: Integer;
vNode1,
vNode2: TVLinkTreeViewItem;
begin
TreeView1.BeginUpdate;
TreeView1.Clear;
for I := 0 to 4 do
begin
vNode1 := TVLinkTreeViewItem.Create(TreeView1);
vNode1.Text := 'Level 1 - '+ IntToStr(I);
vNode1.Data := vNode1.Name;
TreeView1.AddObject(vNode1);
for c := 0 to 4 do
begin
vNode2 := TVLinkTreeViewItem.Create(vNode1);
vNode2.Text := 'Level 2 - '+ IntToStr(c);
vNode2.Data := vNode2.Name;
vNode1.AddObject(vNode2);
end;
end;
TreeView1.ExpandAll;
treeView1.EndUpdate;
end;
{ TVLinkTreeViewItem }
constructor TVLinkTreeViewItem.Create(AOwner: TComponent);
begin
inherited;
self.StyleLookup := 'VLinkTreeViewItemStyle';
self.ApplyStyleLookup;
fData := '';
end;
procedure TVLinkTreeViewItem.ApplyStyle;
var
vEditor: TEdit;
begin
inherited;
//need to get Editor each time needed. Not sure why,
//but doesn't work when trying to set a component variable called fEditor here,
//then have the OnXXXX routines use fEditor, instead of finding the editor themselves
vEditor:= FindStyleResource('Editor') as TEdit;
if Assigned(vEditor) then
begin
vEditor.OnKeyDown := EditorKeyUp;
OnDblClick := TreeViewItem1DblClick;
vEditor.OnExit := EditorExit;
end;
end;
procedure TVLinkTreeViewItem.TreeViewItem1DblClick(Sender: TObject);
var
vEditor: TEdit;
begin
//need to get Editor each time needed. Not sure why,
//but doesn't work when trying to set a component variable called fEditor in ApplyStyle.
vEditor:= FindStyleResource('Editor') as TEdit;
if assigned(vEditor) then
begin
vEditor.Visible := true;
vEditor.Text := Text;
vEditor.SetFocus;
vEditor.SelectAll;
end;
end;
procedure TVLinkTreeViewItem.EditorKeyUp(Sender: TObject; var Key: Word; var KeyChar: Char; Shift: TShiftState);
var
vEditor: TEdit;
begin
inherited;
//need to get Editor each time needed. Not sure why,
//but doesn't work when trying to set a component variable called fEditor in ApplyStyle.
vEditor:= FindStyleResource('Editor') as TEdit;
if not assigned(vEditor) then
exit;
if Key = vkReturn then
begin
Text := vEditor.Text;
vEditor.Visible := false;
end
else if Key in [vkEscape, vkCancel, vkTab, vkHardwareBack] then
begin
vEditor.Visible := false;
end;
end;
procedure TVLinkTreeViewItem.EditorExit(Sender: TObject);
var
vEditor: TEdit;
begin
//need to get Editor each time needed. Not sure why,
//but doesn't work when trying to set a component variable called fEditor in ApplyStyle.
vEditor:= FindStyleResource('Editor') as TEdit;
if Assigned(vEditor) then
vEditor.Visible := false;
end;
end.
object Form1: TForm1
Left = 0
Top = 0
Caption = 'Form1'
ClientHeight = 500
ClientWidth = 640
StyleBook = StyleBook1
FormFactor.Width = 320
FormFactor.Height = 480
FormFactor.Devices = [Desktop]
OnShow = FormShow
DesignerMasterStyle = 0
object TreeView1: TTreeView
Align = Left
Size.Width = 269.000000000000000000
Size.Height = 500.000000000000000000
Size.PlatformDefault = False
TabOrder = 0
Viewport.Width = 265.000000000000000000
Viewport.Height = 496.000000000000000000
end
object StyleBook1: TStyleBook
Styles = <
item
end
item
Platform = 'Windows 10 Desktop'
ResourcesBin = {
464D585F5354594C4520322E35010616564C696E6B5472656556696577497465
6D5374796C650395050631564C696E6B54726565566965774974656D5374796C
657472656576696577657870616E646572627574746F6E7374796C6503E10306
23564C696E6B54726565566965774974656D5374796C65436865636B426F7853
74796C6503E40B005450463007544C61796F757400095374796C654E616D6506
16564C696E6B54726565566965774974656D5374796C6505416C69676E070643
656E7465720A53697A652E576964746805000000000000808407400B53697A65
2E4865696768740500000000000000A003401453697A652E506C6174666F726D
44656661756C7408085461624F726465720236000C545370656564427574746F
6E00095374796C654E616D650606627574746F6E05416C69676E07044C656674
0C4D617267696E732E4C6566740500000000000000C000400B4D617267696E73
2E546F700500000000000000C000400D4D617267696E732E5269676874050000
0000000000C000400E4D617267696E732E426F74746F6D0500000000000000C0
00400A506F736974696F6E2E580500000000000000C000400A506F736974696F
6E2E590500000000000000C000400A53697A652E576964746805000000000000
00F002400B53697A652E4865696768740500000000000000E002401453697A65
2E506C6174666F726D44656661756C74080B5374796C654C6F6F6B7570063156
4C696E6B54726565566965774974656D5374796C657472656576696577657870
616E646572627574746F6E7374796C65000007544C61796F75740005416C6967
6E0708436F6E74656E74730C4D617267696E732E4C6566740500000000000000
A003400A53697A652E57696474680500000000000000F506400B53697A652E48
65696768740500000000000000A003401453697A652E506C6174666F726D4465
6661756C7408000954436865636B426F7800095374796C654E616D6506056368
65636B05416C69676E07044C6566740843616E466F637573081244697361626C
65466F637573456666656374090A53697A652E57696474680500000000000000
A003400B53697A652E4865696768740500000000000000A003401453697A652E
506C6174666F726D44656661756C74080B5374796C654C6F6F6B75700623564C
696E6B54726565566965774974656D5374796C65436865636B426F785374796C
6500000654476C79706800095374796C654E616D65060A676C7970687374796C
650C4D617267696E732E4C65667405000000000000008000400B4D617267696E
732E546F70050000000000000080FF3F0D4D617267696E732E52696768740500
0000000000008000400E4D617267696E732E426F74746F6D0500000000000000
80FF3F05416C69676E07044C6566740A53697A652E5769647468050000000000
00008003400B53697A652E48656967687405000000000000008003401453697A
652E506C6174666F726D44656661756C7408000016544163746976655374796C
65546578744F626A65637400095374796C654E616D6506047465787405416C69
676E0706436C69656E74064C6F636B6564090A53697A652E5769647468050000
0000000000E106400B53697A652E4865696768740500000000000000A0034014
53697A652E506C6174666F726D44656661756C74080454657874060454657874
155465787453657474696E67732E576F72645772617008165465787453657474
696E67732E486F727A416C69676E07074C656164696E670D536861646F775669
7369626C65080D41637469766554726967676572070853656C65637465640B41
6374697665436F6C6F720708636C61426C61636B000005544564697400095374
796C654E616D650606456469746F7219546F7563682E496E7465726163746976
6547657374757265730B074C6F6E6754617009446F75626C655461700005416C
69676E0706436C69656E740B5374796C654C6F6F6B7570060965646974737479
6C65085461624F7264657202000A53697A652E57696474680500000000000000
E106400B53697A652E4865696768740500000000000000A003401453697A652E
506C6174666F726D44656661756C74080756697369626C650800000000545046
3007544C61796F757400095374796C654E616D650631564C696E6B5472656556
6965774974656D5374796C657472656576696577657870616E64657262757474
6F6E7374796C6505416C69676E070643656E7465720B4D617267696E732E546F
70050000000000000080FF3F0A53697A652E5769647468050000000000008084
07400B53697A652E4865696768740500000000000000A003401453697A652E50
6C6174666F726D44656661756C74080756697369626C6508085461624F726465
720237000554506174680005416C69676E070643656E74657209446174612E50
6174680A400000000500000000000000D36D3F431BEF4843010000001749E043
BA09E54301000000D36D3F43C73B344401000000D36D3F431BEF484303000000
D36D3F431BEF48430A46696C6C2E436F6C6F720708636C61426C61636B064C6F
636B6564090748697454657374080A53697A652E576964746805000000000000
00E001400B53697A652E4865696768740500000000000000E001401453697A65
2E506C6174666F726D44656661756C74080B5374726F6B652E4B696E6407044E
6F6E65000F54466C6F6174416E696D6174696F6E00084475726174696F6E0500
0000000017B7D1F13F0C50726F70657274794E616D6506074F7061636974790A
537461727456616C756505000000000000000000000953746F7056616C756505
0000000000000080FF3F075472696767657206104973457870616E6465643D66
616C73650E54726967676572496E7665727365060F4973457870616E6465643D
747275650000000554506174680005416C69676E070643656E74657209446174
612E506174680A400000000500000000000000CB11CF4379E93C4301000000CB
11CF4396230A44010000007DBF1E4296230A4401000000CB11CF4379E93C4303
000000CB11CF4379E93C430A46696C6C2E436F6C6F720708636C61426C61636B
064C6F636B656409074869745465737408074F70616369747905000000000000
000000000A53697A652E57696474680500000000000000E001400B53697A652E
4865696768740500000000000000E001401453697A652E506C6174666F726D44
656661756C74080B5374726F6B652E4B696E6407044E6F6E65000F54466C6F61
74416E696D6174696F6E00084475726174696F6E05000000000017B7D1F13F0C
50726F70657274794E616D6506074F7061636974790A537461727456616C7565
05000000000000000000000953746F7056616C7565050000000000000080FF3F
0754726967676572060F4973457870616E6465643D747275650E547269676765
72496E766572736506104973457870616E6465643D66616C7365000000005450
463007544C61796F757400095374796C654E616D650623564C696E6B54726565
566965774974656D5374796C65436865636B426F785374796C6505416C69676E
070643656E7465720A53697A652E576964746805000000000000808407400B53
697A652E4865696768740500000000000000A003401453697A652E506C617466
6F726D44656661756C74080756697369626C6508085461624F72646572021200
07544C61796F75740005416C69676E07044C6566740A53697A652E5769647468
05000000000000009003400B53697A652E4865696768740500000000000000A0
03401453697A652E506C6174666F726D44656661756C7408001154436865636B
5374796C654F626A65637400095374796C654E616D65060A6261636B67726F75
6E6405416C69676E070643656E746572074361704D6F6465070454696C65064C
6F636B6564090C536F757263654C6F6F6B7570061B57696E646F777320313020
4465736B746F707374796C652E706E670A53697A652E57696474680500000000
000000D002400B53697A652E4865696768740500000000000000D00240145369
7A652E506C6174666F726D44656661756C740808577261704D6F646507064365
6E7465720D416374697665547269676765720707436865636B65640A41637469
76654C696E6B0E010F536F75726365526563742E4C6566740500000000000000
F803400E536F75726365526563742E546F70050000000000000092064010536F
75726365526563742E52696768740500000000000000B0044011536F75726365
526563742E426F74746F6D05000000000000009F06400001055363616C650500
000000000000C0FF3F0F536F75726365526563742E4C65667405000000000000
00B804400E536F75726365526563742E546F700500000000000000DB06401053
6F75726365526563742E5269676874050000000000000082054011536F757263
65526563742E426F74746F6D0500000000000000EE06400001055363616C6505
000000000000008000400F536F75726365526563742E4C656674050000000000
0000F804400E536F75726365526563742E546F70050000000000000092074010
536F75726365526563742E52696768740500000000000000B0054011536F7572
6365526563742E426F74746F6D05000000000000009F074000000A536F757263
654C696E6B0E010F536F75726365526563742E4C6566740500000000000000C0
00400E536F75726365526563742E546F70050000000000000092064010536F75
726365526563742E5269676874050000000000000080034011536F7572636552
6563742E426F74746F6D05000000000000009F06400001055363616C65050000
0000000000C0FF3F0F536F75726365526563742E4C6566740500000000000000
8001400E536F75726365526563742E546F700500000000000000DB064010536F
75726365526563742E52696768740500000000000000B8034011536F75726365
526563742E426F74746F6D0500000000000000EE06400001055363616C650500
0000000000008000400F536F75726365526563742E4C65667405000000000000
00C001400E536F75726365526563742E546F7005000000000000009207401053
6F75726365526563742E5269676874050000000000000080044011536F757263
65526563742E426F74746F6D05000000000000009F0740000007486F744C696E
6B0E010F536F75726365526563742E4C65667405000000000000008803400E53
6F75726365526563742E546F70050000000000000092064010536F7572636552
6563742E52696768740500000000000000F0034011536F75726365526563742E
426F74746F6D05000000000000009F06400001055363616C6505000000000000
00C0FF3F0F536F75726365526563742E4C6566740500000000000000C803400E
536F75726365526563742E546F700500000000000000DB064010536F75726365
526563742E52696768740500000000000000B0044011536F7572636552656374
2E426F74746F6D0500000000000000EE06400001055363616C65050000000000
00008000400F536F75726365526563742E4C6566740500000000000000880440
0E536F75726365526563742E546F70050000000000000092074010536F757263
65526563742E52696768740500000000000000F0044011536F75726365526563
742E426F74746F6D05000000000000009F074000000D416374697665486F744C
696E6B0E010F536F75726365526563742E4C6566740500000000000000B40440
0E536F75726365526563742E546F70050000000000000092064010536F757263
65526563742E52696768740500000000000000E8044011536F75726365526563
742E426F74746F6D05000000000000009F06400001055363616C650500000000
000000C0FF3F0F536F75726365526563742E4C65667405000000000000008605
400E536F75726365526563742E546F700500000000000000DB064010536F7572
6365526563742E52696768740500000000000000AC054011536F757263655265
63742E426F74746F6D0500000000000000EE06400001055363616C6505000000
000000008000400F536F75726365526563742E4C6566740500000000000000B4
05400E536F75726365526563742E546F70050000000000000092074010536F75
726365526563742E52696768740500000000000000E8054011536F7572636552
6563742E426F74746F6D05000000000000009F074000000B466F63757365644C
696E6B0E010F536F75726365526563742E4C6566740500000000000000880340
0E536F75726365526563742E546F70050000000000000092064010536F757263
65526563742E52696768740500000000000000F0034011536F75726365526563
742E426F74746F6D05000000000000009F06400001055363616C650500000000
000000C0FF3F0F536F75726365526563742E4C6566740500000000000000C803
400E536F75726365526563742E546F700500000000000000DB064010536F7572
6365526563742E52696768740500000000000000B0044011536F757263655265
63742E426F74746F6D0500000000000000EE06400001055363616C6505000000
000000008000400F536F75726365526563742E4C656674050000000000000088
04400E536F75726365526563742E546F70050000000000000092074010536F75
726365526563742E52696768740500000000000000F0044011536F7572636552
6563742E426F74746F6D05000000000000009F0740000011416374697665466F
63757365644C696E6B0E010F536F75726365526563742E4C6566740500000000
000000B404400E536F75726365526563742E546F700500000000000000920640
10536F75726365526563742E52696768740500000000000000E8044011536F75
726365526563742E426F74746F6D05000000000000009F06400001055363616C
650500000000000000C0FF3F0F536F75726365526563742E4C65667405000000
000000008605400E536F75726365526563742E546F700500000000000000DB06
4010536F75726365526563742E52696768740500000000000000AC054011536F
75726365526563742E426F74746F6D0500000000000000EE0640000105536361
6C6505000000000000008000400F536F75726365526563742E4C656674050000
0000000000B405400E536F75726365526563742E546F70050000000000000092
074010536F75726365526563742E52696768740500000000000000E805401153
6F75726365526563742E426F74746F6D05000000000000009F07400000000000
1654427574746F6E5374796C65546578744F626A65637400095374796C654E61
6D6506047465787405416C69676E0706436C69656E74064C6F636B6564090C4D
617267696E732E4C6566740500000000000000C000400A53697A652E57696474
680500000000000000F406400B53697A652E4865696768740500000000000000
A003401453697A652E506C6174666F726D44656661756C74080D536861646F77
56697369626C650808486F74436F6C6F720708636C61426C61636B0C466F6375
736564436F6C6F720708636C61426C61636B0B4E6F726D616C436F6C6F720708
636C61426C61636B0C50726573736564436F6C6F720708636C61426C61636B00
0000}
end>
Left = 116
Top = 150
end
end
object TStyleContainer
object TLayout
StyleName = 'VLinkTreeViewItemStyle'
Align = Center
Size.Width = 265.000000000000000000
Size.Height = 20.000000000000000000
Size.PlatformDefault = False
Visible = False
TabOrder = 52
object TSpeedButton
StyleName = 'button'
Align = Left
Margins.Left = 3.000000000000000000
Margins.Top = 3.000000000000000000
Margins.Right = 3.000000000000000000
Margins.Bottom = 3.000000000000000000
Position.X = 3.000000000000000000
Position.Y = 3.000000000000000000
Size.Width = 15.000000000000000000
Size.Height = 14.000000000000000000
Size.PlatformDefault = False
StyleLookup = 'VLinkTreeViewItemStyletreeviewexpanderbuttonstyle'
end
object TLayout
Align = Contents
Margins.Left = 20.000000000000000000
Size.Width = 245.000000000000000000
Size.Height = 20.000000000000000000
Size.PlatformDefault = False
object TCheckBox
StyleName = 'check'
Align = Left
CanFocus = False
DisableFocusEffect = True
Size.Width = 20.000000000000000000
Size.Height = 20.000000000000000000
Size.PlatformDefault = False
StyleLookup = 'VLinkTreeViewItemStyleCheckBoxStyle'
end
object TGlyph
StyleName = 'glyphstyle'
Margins.Left = 2.000000000000000000
Margins.Top = 1.000000000000000000
Margins.Right = 2.000000000000000000
Margins.Bottom = 1.000000000000000000
Align = Left
Size.Width = 16.000000000000000000
Size.Height = 16.000000000000000000
Size.PlatformDefault = False
end
object TActiveStyleTextObject
StyleName = 'text'
Align = Client
Locked = True
Size.Width = 225.000000000000000000
Size.Height = 20.000000000000000000
Size.PlatformDefault = False
Text = 'Text'
TextSettings.WordWrap = False
TextSettings.HorzAlign = Leading
ShadowVisible = False
ActiveTrigger = Selected
ActiveColor = claBlack
end
object TEdit
StyleName = 'Editor'
Touch.InteractiveGestures = [LongTap, DoubleTap]
Align = Client
StyleLookup = 'editstyle'
TabOrder = 0
Size.Width = 225.000000000000000000
Size.Height = 20.000000000000000000
Size.PlatformDefault = False
Visible = False
end
end
end
object TLayout
StyleName = 'VLinkTreeViewItemStyletreeviewexpanderbuttonstyle'
Align = Center
Margins.Top = 1.000000000000000000
Size.Width = 265.000000000000000000
Size.Height = 20.000000000000000000
Size.PlatformDefault = False
Visible = False
TabOrder = 54
object TPath
Align = Center
Data.Path = {
0500000000000000D36D3F431BEF4843010000001749E043BA09E54301000000
D36D3F43C73B344401000000D36D3F431BEF484303000000D36D3F431BEF4843}
Fill.Color = claBlack
Locked = True
HitTest = False
Size.Width = 7.000000000000000000
Size.Height = 7.000000000000000000
Size.PlatformDefault = False
Stroke.Kind = None
object TFloatAnimation
Duration = 0.000099999997473788
PropertyName = 'Opacity'
StartValue = 0.000000000000000000
StopValue = 1.000000000000000000
Trigger = 'IsExpanded=false'
TriggerInverse = 'IsExpanded=true'
end
end
object TPath
Align = Center
Data.Path = {
0500000000000000CB11CF4379E93C4301000000CB11CF4396230A4401000000
7DBF1E4296230A4401000000CB11CF4379E93C4303000000CB11CF4379E93C43}
Fill.Color = claBlack
Locked = True
HitTest = False
Opacity = 0.000000000000000000
Size.Width = 7.000000000000000000
Size.Height = 7.000000000000000000
Size.PlatformDefault = False
Stroke.Kind = None
object TFloatAnimation
Duration = 0.000099999997473788
PropertyName = 'Opacity'
StartValue = 0.000000000000000000
StopValue = 1.000000000000000000
Trigger = 'IsExpanded=true'
TriggerInverse = 'IsExpanded=false'
end
end
end
object TLayout
StyleName = 'VLinkTreeViewItemStyleCheckBoxStyle'
Align = Center
Size.Width = 265.000000000000000000
Size.Height = 20.000000000000000000
Size.PlatformDefault = False
Visible = False
TabOrder = 18
object TLayout
Align = Left
Size.Width = 18.000000000000000000
Size.Height = 20.000000000000000000
Size.PlatformDefault = False
object TCheckStyleObject
StyleName = 'background'
Align = Center
CapMode = Tile
Locked = True
SourceLookup = 'Windows 10 Desktopstyle.png'
Size.Width = 13.000000000000000000
Size.Height = 13.000000000000000000
Size.PlatformDefault = False
WrapMode = Center
ActiveTrigger = Checked
ActiveLink = <
item
SourceRect.Left = 31.000000000000000000
SourceRect.Top = 146.000000000000000000
SourceRect.Right = 44.000000000000000000
SourceRect.Bottom = 159.000000000000000000
end
item
Scale = 1.500000000000000000
SourceRect.Left = 46.000000000000000000
SourceRect.Top = 219.000000000000000000
SourceRect.Right = 65.000000000000000000
SourceRect.Bottom = 238.000000000000000000
end
item
Scale = 2.000000000000000000
SourceRect.Left = 62.000000000000000000
SourceRect.Top = 292.000000000000000000
SourceRect.Right = 88.000000000000000000
SourceRect.Bottom = 318.000000000000000000
end>
SourceLink = <
item
SourceRect.Left = 3.000000000000000000
SourceRect.Top = 146.000000000000000000
SourceRect.Right = 16.000000000000000000
SourceRect.Bottom = 159.000000000000000000
end
item
Scale = 1.500000000000000000
SourceRect.Left = 4.000000000000000000
SourceRect.Top = 219.000000000000000000
SourceRect.Right = 23.000000000000000000
SourceRect.Bottom = 238.000000000000000000
end
item
Scale = 2.000000000000000000
SourceRect.Left = 6.000000000000000000
SourceRect.Top = 292.000000000000000000
SourceRect.Right = 32.000000000000000000
SourceRect.Bottom = 318.000000000000000000
end>
HotLink = <
item
SourceRect.Left = 17.000000000000000000
SourceRect.Top = 146.000000000000000000
SourceRect.Right = 30.000000000000000000
SourceRect.Bottom = 159.000000000000000000
end
item
Scale = 1.500000000000000000
SourceRect.Left = 25.000000000000000000
SourceRect.Top = 219.000000000000000000
SourceRect.Right = 44.000000000000000000
SourceRect.Bottom = 238.000000000000000000
end
item
Scale = 2.000000000000000000
SourceRect.Left = 34.000000000000000000
SourceRect.Top = 292.000000000000000000
SourceRect.Right = 60.000000000000000000
SourceRect.Bottom = 318.000000000000000000
end>
ActiveHotLink = <
item
SourceRect.Left = 45.000000000000000000
SourceRect.Top = 146.000000000000000000
SourceRect.Right = 58.000000000000000000
SourceRect.Bottom = 159.000000000000000000
end
item
Scale = 1.500000000000000000
SourceRect.Left = 67.000000000000000000
SourceRect.Top = 219.000000000000000000
SourceRect.Right = 86.000000000000000000
SourceRect.Bottom = 238.000000000000000000
end
item
Scale = 2.000000000000000000
SourceRect.Left = 90.000000000000000000
SourceRect.Top = 292.000000000000000000
SourceRect.Right = 116.000000000000000000
SourceRect.Bottom = 318.000000000000000000
end>
FocusedLink = <
item
SourceRect.Left = 17.000000000000000000
SourceRect.Top = 146.000000000000000000
SourceRect.Right = 30.000000000000000000
SourceRect.Bottom = 159.000000000000000000
end
item
Scale = 1.500000000000000000
SourceRect.Left = 25.000000000000000000
SourceRect.Top = 219.000000000000000000
SourceRect.Right = 44.000000000000000000
SourceRect.Bottom = 238.000000000000000000
end
item
Scale = 2.000000000000000000
SourceRect.Left = 34.000000000000000000
SourceRect.Top = 292.000000000000000000
SourceRect.Right = 60.000000000000000000
SourceRect.Bottom = 318.000000000000000000
end>
ActiveFocusedLink = <
item
SourceRect.Left = 45.000000000000000000
SourceRect.Top = 146.000000000000000000
SourceRect.Right = 58.000000000000000000
SourceRect.Bottom = 159.000000000000000000
end
item
Scale = 1.500000000000000000
SourceRect.Left = 67.000000000000000000
SourceRect.Top = 219.000000000000000000
SourceRect.Right = 86.000000000000000000
SourceRect.Bottom = 238.000000000000000000
end
item
Scale = 2.000000000000000000
SourceRect.Left = 90.000000000000000000
SourceRect.Top = 292.000000000000000000
SourceRect.Right = 116.000000000000000000
SourceRect.Bottom = 318.000000000000000000
end>
end
end
object TButtonStyleTextObject
StyleName = 'text'
Align = Client
Locked = True
Margins.Left = 3.000000000000000000
Size.Width = 244.000000000000000000
Size.Height = 20.000000000000000000
Size.PlatformDefault = False
ShadowVisible = False
HotColor = claBlack
FocusedColor = claBlack
NormalColor = claBlack
PressedColor = claBlack
end
end
end
Related
I have the following problem with using a custom style with a FMX TListBoxItem.
In the following code below, I have created four new styles to use in a TListBoxItem. All four styles show a box (TRectangle) with or without an X (TPath) in it and a TText to the right of it. In two of the styles, I show the X and the other two I don't. One style shows a green box with an X and text that is black and bold. One shows a empty box with just black text. The other two show the same thing but the boxes and the text are red, with the text for the one with the X in the box being bold.
In the program, I have a listbox with four listboxitems added during designtime to show the four different styles. I also have a button that will create an additional four listboxitems with code during runtime which also display the four different styles. All this works, except on one detail. The two red listboxitems that are created during runtime do not use the red font color. You can see this in the following image. ListboxItem1 and ListboxItem2 were created as designtime and are displayed with red text. "Item #1" and "Item #2" are displayed with black text but should be red. Note: "Item #2" does show the bold text correctly.
What am I missing when creating the Listboxitems during runtime that is keeping the red text from showing correctly?
Here's the code, form and styles I am using.
unit Unit3;
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.StdCtrls, FMX.ListBox, FMX.Layouts,
FMX.ListView.Types, FMX.ListView.Appearances, FMX.ListView.Adapters.Base,
FMX.ListView;
type
TForm3 = class(TForm)
lbxEquipment: TListBox;
ListBoxItem1: TListBoxItem;
btnAdd: TButton;
StyleBook1: TStyleBook;
ListBoxItem2: TListBoxItem;
Button2: TButton;
ListBoxItem3: TListBoxItem;
ListBoxItem4: TListBoxItem;
procedure btnAddClick(Sender: TObject);
procedure Button2Click(Sender: TObject);
private
public
end;
var
Form3: TForm3;
implementation
{$R *.fmx}
uses System.Rtti, FMX.Objects;
var
i: integer = 1;
cnt: integer = 1;
fColor: TAlphaColor;
bColor: TAlphaColor;
procedure TForm3.btnAddClick(Sender: TObject);
var
s: string;
vItem: TListBoxItem;
c: integer;
begin
for c := cnt to (cnt + 3) do
begin
s := 'Item #' + IntToStr(c);
vItem := TListBoxItem.Create(lbxEquipment);
vItem.Parent := lbxEquipment;
vItem.StyledSettings := vItem.StyledSettings - [TStyledSetting.FontColor];
case I of
1: vItem.StyleLookup := 'EquipItemRedOffStyle';
2: vItem.StyleLookup := 'EquipItemRedOnStyle';
3: vItem.StyleLookup := 'EquipItemOffStyle';
else
vItem.StyleLookup := 'EquipItemOnStyle';
end;
vItem.Text := s;
Inc(i);
if I > 3 then
I := 0;
end;
cnt := c + 1;
end;
procedure TForm3.Button2Click(Sender: TObject);
begin
lbxEquipment.Clear;
end;
end.
object Form3: TForm3
Left = 0
Top = 0
ActiveControl = lbxEquipment
Caption = 'Form3'
ClientHeight = 284
ClientWidth = 324
StyleBook = StyleBook1
FormFactor.Width = 320
FormFactor.Height = 480
FormFactor.Devices = [Desktop]
DesignerMasterStyle = 0
object lbxEquipment: TListBox
Anchors = [akLeft, akTop, akRight, akBottom]
Position.X = 24.000000000000000000
Position.Y = 104.000000000000000000
Size.Width = 281.000000000000000000
Size.Height = 157.000000000000000000
Size.PlatformDefault = False
TabOrder = 0
Columns = 2
DisableFocusEffect = True
ItemIndex = 0
DefaultItemStyles.ItemStyle = ''
DefaultItemStyles.GroupHeaderStyle = ''
DefaultItemStyles.GroupFooterStyle = ''
ShowCheckboxes = True
Viewport.Width = 277.000000000000000000
Viewport.Height = 153.000000000000000000
object ListBoxItem1: TListBoxItem
IsSelected = True
StyleLookup = 'EquipItemRedOffStyle'
TabOrder = 0
Text = 'ListBoxItem1'
end
object ListBoxItem2: TListBoxItem
Position.X = 138.000000000000000000
StyleLookup = 'EquipItemRedOnStyle'
TabOrder = 1
Text = 'ListBoxItem2'
end
object ListBoxItem3: TListBoxItem
Position.Y = 19.000000000000000000
StyleLookup = 'EquipItemOffStyle'
TabOrder = 2
Text = 'ListBoxItem3'
end
object ListBoxItem4: TListBoxItem
Position.X = 138.000000000000000000
Position.Y = 19.000000000000000000
StyleLookup = 'EquipItemOnStyle'
TabOrder = 3
Text = 'ListBoxItem4'
end
end
object btnAdd: TButton
Position.X = 24.000000000000000000
Position.Y = 64.000000000000000000
TabOrder = 1
Text = 'Add'
OnClick = btnAddClick
end
object StyleBook1: TStyleBook
Styles = <
item
end
item
Platform = 'Windows 10 Desktop'
ResourcesBin = {
464D585F5354594C4520322E3501061145717569704974656D4F66665374796C
6503B204061345717569704974656D5265644F6E5374796C6503FD0406104571
7569704974656D4F6E5374796C6503DF04061445717569704974656D5265644F
66665374796C6503E304005450463007544C61796F757400095374796C654E61
6D65061145717569704974656D4F66665374796C6505416C69676E070643656E
7465720A53697A652E57696474680500000000000000C406400B53697A652E48
656967687405000000000000009803401453697A652E506C6174666F726D4465
6661756C7408085461624F7264657202250016544163746976655374796C6554
6578744F626A65637400095374796C654E616D6506047465787405416C69676E
0706436C69656E740C4D617267696E732E4C6566740500000000000000C00040
0B4D617267696E732E546F70050000000000000080FF3F0D4D617267696E732E
52696768740500000000000000C000400E4D617267696E732E426F74746F6D05
0000000000000080FF3F0A53697A652E57696474680500000000000000AC0640
0B53697A652E48656967687405000000000000008803401453697A652E506C61
74666F726D44656661756C740804546578740604546578741554657874536574
74696E67732E576F72645772617008165465787453657474696E67732E486F72
7A416C69676E07074C656164696E670D536861646F7756697369626C65080D41
637469766554726967676572070853656C65637465640B416374697665436F6C
6F720708636C61426C61636B000007544C61796F75740005416C69676E07044C
656674064C6F636B6564090A53697A652E576964746805000000000000009003
400B53697A652E48656967687405000000000000009803401453697A652E506C
6174666F726D44656661756C7408085461624F726465720200000A5452656374
616E676C6500095374796C654E616D65060965717569706261636B05416C6967
6E0706436C69656E74064C6F636B6564090748697454657374080C4D61726769
6E732E4C65667405000000000000008000400B4D617267696E732E546F700500
0000000000008000400D4D617267696E732E5269676874050000000000000080
00400E4D617267696E732E426F74746F6D05000000000000008000400A53697A
652E57696474680500000000000000E002400B53697A652E4865696768740500
000000000000F002401453697A652E506C6174666F726D44656661756C740807
5852616469757305000000000000008000400759526164697573050000000000
00008000400005545061746800095374796C654E616D65060A65717569706368
65636B05416C69676E0706436C69656E7409446174612E506174680A34000000
04000000000000000000000000000000010000000000803F0000803F00000000
000000000000803F010000000000803F00000000064C6F636B65640907486974
54657374080C4D617267696E732E4C656674050000000000000080FF3F0B4D61
7267696E732E546F70050000000000000080FF3F0D4D617267696E732E526967
6874050000000000000080FF3F0E4D617267696E732E426F74746F6D05000000
0000000080FF3F0A53697A652E57696474680500000000000000C002400B5369
7A652E4865696768740500000000000000D002401453697A652E506C6174666F
726D44656661756C74080B5374726F6B652E4B696E6407044E6F6E6510537472
6F6B652E546869636B6E65737305000000000000008000400000000000545046
3007544C61796F757400095374796C654E616D65061345717569704974656D52
65644F6E5374796C6505416C69676E070643656E7465720A53697A652E576964
74680500000000000000C406400B53697A652E48656967687405000000000000
009803401453697A652E506C6174666F726D44656661756C7408075669736962
6C6508085461624F7264657202240016544163746976655374796C6554657874
4F626A65637400095374796C654E616D6506047465787405416C69676E070643
6C69656E740C4D617267696E732E4C6566740500000000000000C000400B4D61
7267696E732E546F70050000000000000080FF3F0D4D617267696E732E526967
68740500000000000000C000400E4D617267696E732E426F74746F6D05000000
0000000080FF3F0A53697A652E57696474680500000000000000AC06400B5369
7A652E48656967687405000000000000008803401453697A652E506C6174666F
726D44656661756C74081A5465787453657474696E67732E466F6E742E537479
6C654578740A0D00000000070000000000000004000000165465787453657474
696E67732E466F6E74436F6C6F720706636C6152656415546578745365747469
6E67732E576F72645772617008165465787453657474696E67732E486F727A41
6C69676E07074C656164696E670D536861646F7756697369626C65080D416374
69766554726967676572070853656C65637465640B416374697665436F6C6F72
0706636C61526564000007544C61796F75740005416C69676E07044C65667406
4C6F636B6564090A53697A652E576964746805000000000000009003400B5369
7A652E48656967687405000000000000009803401453697A652E506C6174666F
726D44656661756C7408085461624F726465720200000A5452656374616E676C
6500095374796C654E616D65060965717569706261636B05416C69676E070643
6C69656E740A46696C6C2E436F6C6F720706636C61526564064C6F636B656409
0748697454657374080C4D617267696E732E4C65667405000000000000008000
400B4D617267696E732E546F7005000000000000008000400D4D617267696E73
2E526967687405000000000000008000400E4D617267696E732E426F74746F6D
05000000000000008000400A53697A652E57696474680500000000000000E002
400B53697A652E4865696768740500000000000000F002401453697A652E506C
6174666F726D44656661756C7408075852616469757305000000000000008000
4007595261646975730500000000000000800040000554506174680009537479
6C654E616D65060A6571756970636865636B05416C69676E0706436C69656E74
09446174612E506174680A340000000400000000000000000000000000000001
0000000000803F0000803F00000000000000000000803F010000000000803F00
000000064C6F636B6564090748697454657374080C4D617267696E732E4C6566
74050000000000000080FF3F0B4D617267696E732E546F700500000000000000
80FF3F0D4D617267696E732E5269676874050000000000000080FF3F0E4D6172
67696E732E426F74746F6D050000000000000080FF3F0A53697A652E57696474
680500000000000000C002400B53697A652E4865696768740500000000000000
D002401453697A652E506C6174666F726D44656661756C7408105374726F6B65
2E546869636B6E65737305000000000000008000400000000000545046300754
4C61796F757400095374796C654E616D65061045717569704974656D4F6E5374
796C6505416C69676E070643656E7465720A53697A652E576964746805000000
00000000C406400B53697A652E48656967687405000000000000009803401453
697A652E506C6174666F726D44656661756C74080756697369626C6508085461
624F7264657202220016544163746976655374796C65546578744F626A656374
00095374796C654E616D6506047465787405416C69676E0706436C69656E740C
4D617267696E732E4C6566740500000000000000C000400B4D617267696E732E
546F70050000000000000080FF3F0D4D617267696E732E526967687405000000
00000000C000400E4D617267696E732E426F74746F6D050000000000000080FF
3F0A53697A652E57696474680500000000000000AC06400B53697A652E486569
67687405000000000000008803401453697A652E506C6174666F726D44656661
756C74081A5465787453657474696E67732E466F6E742E5374796C654578740A
0D00000000070000000000000004000000155465787453657474696E67732E57
6F72645772617008165465787453657474696E67732E486F727A416C69676E07
074C656164696E670D536861646F7756697369626C65080D4163746976655472
6967676572070853656C65637465640B416374697665436F6C6F720708636C61
426C61636B000007544C61796F75740005416C69676E07044C656674064C6F63
6B6564090A53697A652E576964746805000000000000009003400B53697A652E
48656967687405000000000000009803401453697A652E506C6174666F726D44
656661756C7408085461624F726465720200000A5452656374616E676C650009
5374796C654E616D65060965717569706261636B05416C69676E0706436C6965
6E740A46696C6C2E436F6C6F720708636C61477265656E064C6F636B65640907
48697454657374080C4D617267696E732E4C6566740500000000000000800040
0B4D617267696E732E546F7005000000000000008000400D4D617267696E732E
526967687405000000000000008000400E4D617267696E732E426F74746F6D05
000000000000008000400A53697A652E57696474680500000000000000E00240
0B53697A652E4865696768740500000000000000F002401453697A652E506C61
74666F726D44656661756C740807585261646975730500000000000000800040
075952616469757305000000000000008000400005545061746800095374796C
654E616D65060A6571756970636865636B05416C69676E0706436C69656E7409
446174612E506174680A34000000040000000000000000000000000000000100
00000000803F0000803F00000000000000000000803F010000000000803F0000
0000064C6F636B6564090748697454657374080C4D617267696E732E4C656674
050000000000000080FF3F0B4D617267696E732E546F70050000000000000080
FF3F0D4D617267696E732E5269676874050000000000000080FF3F0E4D617267
696E732E426F74746F6D050000000000000080FF3F0A53697A652E5769647468
0500000000000000C002400B53697A652E4865696768740500000000000000D0
02401453697A652E506C6174666F726D44656661756C7408105374726F6B652E
546869636B6E657373050000000000000080004000000000005450463007544C
61796F757400095374796C654E616D65061445717569704974656D5265644F66
665374796C6505416C69676E070643656E7465720A53697A652E576964746805
00000000000000C406400B53697A652E48656967687405000000000000009803
401453697A652E506C6174666F726D44656661756C74080756697369626C6508
085461624F7264657202230016544163746976655374796C65546578744F626A
65637400095374796C654E616D6506047465787405416C69676E0706436C6965
6E740C4D617267696E732E4C6566740500000000000000C000400B4D61726769
6E732E546F70050000000000000080FF3F0D4D617267696E732E526967687405
00000000000000C000400E4D617267696E732E426F74746F6D05000000000000
0080FF3F0A53697A652E57696474680500000000000000AC06400B53697A652E
48656967687405000000000000008803401453697A652E506C6174666F726D44
656661756C7408165465787453657474696E67732E466F6E74436F6C6F720706
636C61526564155465787453657474696E67732E576F72645772617008165465
787453657474696E67732E486F727A416C69676E07074C656164696E670D5368
61646F7756697369626C65080D41637469766554726967676572070853656C65
637465640B416374697665436F6C6F720706636C61526564000007544C61796F
75740005416C69676E07044C656674064C6F636B6564090A53697A652E576964
746805000000000000009003400B53697A652E48656967687405000000000000
009803401453697A652E506C6174666F726D44656661756C7408085461624F72
6465720200000A5452656374616E676C6500095374796C654E616D6506096571
7569706261636B05416C69676E0706436C69656E740A46696C6C2E436F6C6F72
0706636C61526564064C6F636B6564090748697454657374080C4D617267696E
732E4C65667405000000000000008000400B4D617267696E732E546F70050000
00000000008000400D4D617267696E732E526967687405000000000000008000
400E4D617267696E732E426F74746F6D05000000000000008000400A53697A65
2E57696474680500000000000000E002400B53697A652E486569676874050000
0000000000F002401453697A652E506C6174666F726D44656661756C74080758
5261646975730500000000000000800040075952616469757305000000000000
008000400005545061746800095374796C654E616D65060A6571756970636865
636B05416C69676E0706436C69656E7409446174612E506174680A3400000004
000000000000000000000000000000010000000000803F0000803F0000000000
0000000000803F010000000000803F00000000064C6F636B6564090748697454
657374080C4D617267696E732E4C656674050000000000000080FF3F0B4D6172
67696E732E546F70050000000000000080FF3F0D4D617267696E732E52696768
74050000000000000080FF3F0E4D617267696E732E426F74746F6D0500000000
00000080FF3F0A53697A652E57696474680500000000000000C002400B53697A
652E4865696768740500000000000000D002401453697A652E506C6174666F72
6D44656661756C74080B5374726F6B652E4B696E6407044E6F6E65105374726F
6B652E546869636B6E65737305000000000000008000400000000000}
end>
Left = 136
Top = 16
end
object Button2: TButton
Position.X = 200.000000000000000000
Position.Y = 64.000000000000000000
TabOrder = 5
Text = 'Clear'
OnClick = Button2Click
end
end
object TStyleContainer
object TLayout
StyleName = 'EquipItemOffStyle'
Align = Center
Size.Width = 196.000000000000000000
Size.Height = 19.000000000000000000
Size.PlatformDefault = False
Visible = False
TabOrder = 37
object TActiveStyleTextObject
StyleName = 'text'
Align = Client
Margins.Left = 3.000000000000000000
Margins.Top = 1.000000000000000000
Margins.Right = 3.000000000000000000
Margins.Bottom = 1.000000000000000000
Size.Width = 172.000000000000000000
Size.Height = 17.000000000000000000
Size.PlatformDefault = False
Text = 'Text'
TextSettings.WordWrap = False
TextSettings.HorzAlign = Leading
ShadowVisible = False
ActiveTrigger = Selected
ActiveColor = claBlack
end
object TLayout
Align = Left
Locked = True
Size.Width = 18.000000000000000000
Size.Height = 19.000000000000000000
Size.PlatformDefault = False
TabOrder = 0
object TRectangle
StyleName = 'equipback'
Align = Client
Locked = True
HitTest = False
Margins.Left = 2.000000000000000000
Margins.Top = 2.000000000000000000
Margins.Right = 2.000000000000000000
Margins.Bottom = 2.000000000000000000
Size.Width = 14.000000000000000000
Size.Height = 15.000000000000000000
Size.PlatformDefault = False
XRadius = 2.000000000000000000
YRadius = 2.000000000000000000
object TPath
StyleName = 'equipcheck'
Align = Client
Data.Path = {
04000000000000000000000000000000010000000000803F0000803F00000000
000000000000803F010000000000803F00000000}
Locked = True
HitTest = False
Margins.Left = 1.000000000000000000
Margins.Top = 1.000000000000000000
Margins.Right = 1.000000000000000000
Margins.Bottom = 1.000000000000000000
Size.Width = 12.000000000000000000
Size.Height = 13.000000000000000000
Size.PlatformDefault = False
Stroke.Kind = None
Stroke.Thickness = 2.000000000000000000
end
end
end
end
object TLayout
StyleName = 'EquipItemRedOnStyle'
Align = Center
Size.Width = 196.000000000000000000
Size.Height = 19.000000000000000000
Size.PlatformDefault = False
Visible = False
TabOrder = 36
object TActiveStyleTextObject
StyleName = 'text'
Align = Client
Margins.Left = 3.000000000000000000
Margins.Top = 1.000000000000000000
Margins.Right = 3.000000000000000000
Margins.Bottom = 1.000000000000000000
Size.Width = 172.000000000000000000
Size.Height = 17.000000000000000000
Size.PlatformDefault = False
TextSettings.Font.StyleExt = {00070000000000000004000000}
TextSettings.FontColor = claRed
TextSettings.WordWrap = False
TextSettings.HorzAlign = Leading
ShadowVisible = False
ActiveTrigger = Selected
ActiveColor = claRed
end
object TLayout
Align = Left
Locked = True
Size.Width = 18.000000000000000000
Size.Height = 19.000000000000000000
Size.PlatformDefault = False
TabOrder = 0
object TRectangle
StyleName = 'equipback'
Align = Client
Fill.Color = claRed
Locked = True
HitTest = False
Margins.Left = 2.000000000000000000
Margins.Top = 2.000000000000000000
Margins.Right = 2.000000000000000000
Margins.Bottom = 2.000000000000000000
Size.Width = 14.000000000000000000
Size.Height = 15.000000000000000000
Size.PlatformDefault = False
XRadius = 2.000000000000000000
YRadius = 2.000000000000000000
object TPath
StyleName = 'equipcheck'
Align = Client
Data.Path = {
04000000000000000000000000000000010000000000803F0000803F00000000
000000000000803F010000000000803F00000000}
Locked = True
HitTest = False
Margins.Left = 1.000000000000000000
Margins.Top = 1.000000000000000000
Margins.Right = 1.000000000000000000
Margins.Bottom = 1.000000000000000000
Size.Width = 12.000000000000000000
Size.Height = 13.000000000000000000
Size.PlatformDefault = False
Stroke.Thickness = 2.000000000000000000
end
end
end
end
object TLayout
StyleName = 'EquipItemOnStyle'
Align = Center
Size.Width = 196.000000000000000000
Size.Height = 19.000000000000000000
Size.PlatformDefault = False
Visible = False
TabOrder = 34
object TActiveStyleTextObject
StyleName = 'text'
Align = Client
Margins.Left = 3.000000000000000000
Margins.Top = 1.000000000000000000
Margins.Right = 3.000000000000000000
Margins.Bottom = 1.000000000000000000
Size.Width = 172.000000000000000000
Size.Height = 17.000000000000000000
Size.PlatformDefault = False
TextSettings.Font.StyleExt = {00070000000000000004000000}
TextSettings.WordWrap = False
TextSettings.HorzAlign = Leading
ShadowVisible = False
ActiveTrigger = Selected
ActiveColor = claBlack
end
object TLayout
Align = Left
Locked = True
Size.Width = 18.000000000000000000
Size.Height = 19.000000000000000000
Size.PlatformDefault = False
TabOrder = 0
object TRectangle
StyleName = 'equipback'
Align = Client
Fill.Color = claGreen
Locked = True
HitTest = False
Margins.Left = 2.000000000000000000
Margins.Top = 2.000000000000000000
Margins.Right = 2.000000000000000000
Margins.Bottom = 2.000000000000000000
Size.Width = 14.000000000000000000
Size.Height = 15.000000000000000000
Size.PlatformDefault = False
XRadius = 2.000000000000000000
YRadius = 2.000000000000000000
object TPath
StyleName = 'equipcheck'
Align = Client
Data.Path = {
04000000000000000000000000000000010000000000803F0000803F00000000
000000000000803F010000000000803F00000000}
Locked = True
HitTest = False
Margins.Left = 1.000000000000000000
Margins.Top = 1.000000000000000000
Margins.Right = 1.000000000000000000
Margins.Bottom = 1.000000000000000000
Size.Width = 12.000000000000000000
Size.Height = 13.000000000000000000
Size.PlatformDefault = False
Stroke.Thickness = 2.000000000000000000
end
end
end
end
object TLayout
StyleName = 'EquipItemRedOffStyle'
Align = Center
Size.Width = 196.000000000000000000
Size.Height = 19.000000000000000000
Size.PlatformDefault = False
Visible = False
TabOrder = 35
object TActiveStyleTextObject
StyleName = 'text'
Align = Client
Margins.Left = 3.000000000000000000
Margins.Top = 1.000000000000000000
Margins.Right = 3.000000000000000000
Margins.Bottom = 1.000000000000000000
Size.Width = 172.000000000000000000
Size.Height = 17.000000000000000000
Size.PlatformDefault = False
TextSettings.FontColor = claRed
TextSettings.WordWrap = False
TextSettings.HorzAlign = Leading
ShadowVisible = False
ActiveTrigger = Selected
ActiveColor = claRed
end
object TLayout
Align = Left
Locked = True
Size.Width = 18.000000000000000000
Size.Height = 19.000000000000000000
Size.PlatformDefault = False
TabOrder = 0
object TRectangle
StyleName = 'equipback'
Align = Client
Fill.Color = claRed
Locked = True
HitTest = False
Margins.Left = 2.000000000000000000
Margins.Top = 2.000000000000000000
Margins.Right = 2.000000000000000000
Margins.Bottom = 2.000000000000000000
Size.Width = 14.000000000000000000
Size.Height = 15.000000000000000000
Size.PlatformDefault = False
XRadius = 2.000000000000000000
YRadius = 2.000000000000000000
object TPath
StyleName = 'equipcheck'
Align = Client
Data.Path = {
04000000000000000000000000000000010000000000803F0000803F00000000
000000000000803F010000000000803F00000000}
Locked = True
HitTest = False
Margins.Left = 1.000000000000000000
Margins.Top = 1.000000000000000000
Margins.Right = 1.000000000000000000
Margins.Bottom = 1.000000000000000000
Size.Width = 12.000000000000000000
Size.Height = 13.000000000000000000
Size.PlatformDefault = False
Stroke.Kind = None
Stroke.Thickness = 2.000000000000000000
end
end
end
end
end
four```
Remove the line
vItem.StyledSettings := vItem.StyledSettings - [TStyledSetting.FontColor];
Your text is red in the style, but you're telling it to ignore the font colour of the style!
Below are the sources to a very simple FMX component that simply inherits from a TCustomEdit but with a different Style. What I am going for is to have two buttons on the Windows version of the component and no buttons on the Android component.
When I compile the sources before and run a program with the component, both devices show the components as expected. Windows shows the two buttons, Android doesn't display the buttons.
My problem is, during design time in the IDE, setting the "Style" drop down to Android, the component is displayed using the Windows version. If I "edit the default style" when the Android style is selected, it shows the Edit "background" with a sourcelookup of "Windows 10 Desktopstyle.png", not "AndroidL Lightstyle.png" but also includes the buttons with a sourcelookup of "AndroidL Lightstyle.png".
My assumption is I am missing something is my component design that tells the IDE which version of style to use. Any idea what that is? FYI: this is a very simple component that shows the problem. My more complicated component has the same problem.
unit RHEdit;
interface
uses
System.SysUtils, System.Classes, FMX.Types, FMX.Controls, FMX.Controls.Presentation, FMX.Edit, FMX.Controls.Model;
type
TRHEdit = class(TCustomEdit)
private
{ Private declarations }
protected
function GetStyleObject(const Clone: Boolean): TFmxObject; override;
function DefinePresentationName: string; override;
public
{ Public declarations }
published
property Text;
end;
procedure Register;
implementation
{$IFDEF ANDROID}
{$R RHEdit_android.res}
{$ENDIF}
{$IFDEF MSWINDOWS}
{$R RHEdit_win.res}
{$ENDIF}
uses System.Types, FMX.Styles;
procedure Register;
begin
RegisterComponents('Samples', [TRHEdit]);
end;
{ TRHEdit }
function TRHEdit.DefinePresentationName: string;
begin
Result := 'RHEdit-' + GetPresentationSuffix;
end;
function TRHEdit.GetStyleObject(const Clone: Boolean): TFmxObject;
var
style: string;
begin
style := 'rheditstyle';
if (StyleLookup = '') then
Result:= TStyleStreaming.LoadFromResource(HInstance, Style, RT_RCDATA)
else
Result := inherited GetStyleObject(Clone);
end;
end.
RHEdit_android.rc
RHEditStyle RCDATA "RHEdit_android.style"
RHEdit_win.rc
RHEditStyle RCDATA "RHEdit_win.style"
RHEdit_android.style
object TLayout
StyleName = 'rheditstyle'
TabOrder = 12
FixedHeight = 32
object TActiveStyleObject
StyleName = 'background'
Align = Contents
SourceLookup = 'AndroidL Lightstyle.png'
ActiveTrigger = Focused
ActiveLink = <
item
CapInsets.Left = 4.000000000000000000
CapInsets.Right = 4.000000000000000000
SourceRect.Left = 94.000000000000000000
SourceRect.Top = 63.000000000000000000
SourceRect.Right = 127.000000000000000000
SourceRect.Bottom = 95.000000000000000000
end
item
CapInsets.Left = 6.000000000000000000
CapInsets.Right = 6.000000000000000000
Scale = 1.500000000000000000
SourceRect.Left = 157.000000000000000000
SourceRect.Top = 95.000000000000000000
SourceRect.Right = 206.000000000000000000
SourceRect.Bottom = 143.000000000000000000
end
item
CapInsets.Left = 8.000000000000000000
CapInsets.Right = 8.000000000000000000
Scale = 2.000000000000000000
SourceRect.Left = 187.000000000000000000
SourceRect.Top = 122.000000000000000000
SourceRect.Right = 253.000000000000000000
SourceRect.Bottom = 186.000000000000000000
end
item
CapInsets.Left = 12.000000000000000000
CapInsets.Right = 12.000000000000000000
Scale = 3.000000000000000000
SourceRect.Left = 337.000000000000000000
SourceRect.Top = 190.000000000000000000
SourceRect.Right = 436.000000000000000000
SourceRect.Bottom = 286.000000000000000000
end>
SourceLink = <
item
CapInsets.Left = 4.000000000000000000
CapInsets.Right = 4.000000000000000000
SourceRect.Left = 94.000000000000000000
SourceRect.Top = 30.000000000000000000
SourceRect.Right = 127.000000000000000000
SourceRect.Bottom = 62.000000000000000000
end
item
CapInsets.Left = 6.000000000000000000
CapInsets.Right = 6.000000000000000000
Scale = 1.500000000000000000
SourceRect.Left = 157.000000000000000000
SourceRect.Top = 45.000000000000000000
SourceRect.Right = 206.000000000000000000
SourceRect.Bottom = 93.000000000000000000
end
item
CapInsets.Left = 8.000000000000000000
CapInsets.Right = 8.000000000000000000
Scale = 2.000000000000000000
SourceRect.Left = 187.000000000000000000
SourceRect.Top = 57.000000000000000000
SourceRect.Right = 253.000000000000000000
SourceRect.Bottom = 121.000000000000000000
end
item
CapInsets.Left = 12.000000000000000000
CapInsets.Right = 12.000000000000000000
Scale = 3.000000000000000000
SourceRect.Left = 337.000000000000000000
SourceRect.Top = 93.000000000000000000
SourceRect.Right = 436.000000000000000000
SourceRect.Bottom = 189.000000000000000000
end>
TouchAnimation.Link = <>
end
object TLayout
StyleName = 'content'
Align = Client
Locked = True
Margins.Left = 32.000000000000000000
Margins.Top = 4.000000000000000000
Margins.Right = 32.000000000000000000
Margins.Bottom = 4.000000000000000000
Size.Width = 0.000000000000000000
Size.Height = 42.000000000000000000
Size.PlatformDefault = False
end
object TColorObject
StyleName = 'caretcolor'
Color = xFF222222
end
object TBrushObject
StyleName = 'foreground'
Brush.Color = xFF222222
end
object TBrushObject
StyleName = 'selection'
Brush.Color = x7F33B5E5
end
object TFontObject
StyleName = 'font'
Font.Size = 18.000000000000000000
end
end
RHEdit_win.style
object TLayout
StyleName = 'rheditstyle'
TabOrder = 16
object TActiveStyleObject
StyleName = 'background'
Align = Contents
SourceLookup = 'Windows 10 Desktopstyle.png'
ActiveTrigger = Focused
ActiveLink = <
item
CapInsets.Left = 7.000000000000000000
CapInsets.Top = 7.000000000000000000
CapInsets.Right = 7.000000000000000000
CapInsets.Bottom = 7.000000000000000000
SourceRect.Left = 266.000000000000000000
SourceRect.Top = 81.000000000000000000
SourceRect.Right = 305.000000000000000000
SourceRect.Bottom = 110.000000000000000000
end
item
CapInsets.Left = 10.000000000000000000
CapInsets.Top = 10.000000000000000000
CapInsets.Right = 10.000000000000000000
CapInsets.Bottom = 10.000000000000000000
Scale = 1.500000000000000000
SourceRect.Left = 399.000000000000000000
SourceRect.Top = 121.000000000000000000
SourceRect.Right = 457.000000000000000000
SourceRect.Bottom = 165.000000000000000000
end
item
CapInsets.Left = 14.000000000000000000
CapInsets.Top = 14.000000000000000000
CapInsets.Right = 14.000000000000000000
CapInsets.Bottom = 14.000000000000000000
Scale = 2.000000000000000000
SourceRect.Left = 532.000000000000000000
SourceRect.Top = 162.000000000000000000
SourceRect.Right = 610.000000000000000000
SourceRect.Bottom = 220.000000000000000000
end>
SourceLink = <
item
CapInsets.Left = 7.000000000000000000
CapInsets.Top = 7.000000000000000000
CapInsets.Right = 7.000000000000000000
CapInsets.Bottom = 7.000000000000000000
SourceRect.Left = 225.000000000000000000
SourceRect.Top = 81.000000000000000000
SourceRect.Right = 264.000000000000000000
SourceRect.Bottom = 110.000000000000000000
end
item
CapInsets.Left = 10.000000000000000000
CapInsets.Top = 10.000000000000000000
CapInsets.Right = 10.000000000000000000
CapInsets.Bottom = 10.000000000000000000
Scale = 1.500000000000000000
SourceRect.Left = 337.000000000000000000
SourceRect.Top = 121.000000000000000000
SourceRect.Right = 396.000000000000000000
SourceRect.Bottom = 165.000000000000000000
end
item
CapInsets.Left = 14.000000000000000000
CapInsets.Top = 14.000000000000000000
CapInsets.Right = 14.000000000000000000
CapInsets.Bottom = 14.000000000000000000
Scale = 2.000000000000000000
SourceRect.Left = 450.000000000000000000
SourceRect.Top = 162.000000000000000000
SourceRect.Right = 528.000000000000000000
SourceRect.Bottom = 220.000000000000000000
end>
TouchAnimation.Link = <>
end
object TLayout
StyleName = 'content'
Align = Client
Locked = True
Margins.Left = 21.000000000000000000
Margins.Top = 4.000000000000000000
Margins.Right = 21.000000000000000000
Margins.Bottom = 4.000000000000000000
Size.Width = 0.000000000000000000
Size.Height = 42.000000000000000000
Size.PlatformDefault = False
end
object TButton
StyleName = 'minusbutton'
Align = Left
CanFocus = False
Cursor = crArrow
Margins.Left = 2.000000000000000000
Margins.Top = 2.000000000000000000
Margins.Right = 2.000000000000000000
Margins.Bottom = 2.000000000000000000
Position.X = 2.000000000000000000
Position.Y = 2.000000000000000000
Size.Width = 20.000000000000000000
Size.Height = 46.000000000000000000
Size.PlatformDefault = False
StyleLookup = 'spinbottombutton'
end
object TButton
StyleName = 'plusbutton'
Align = Right
CanFocus = False
Cursor = crArrow
Margins.Left = 2.000000000000000000
Margins.Top = 2.000000000000000000
Margins.Right = 2.000000000000000000
Margins.Bottom = 2.000000000000000000
Position.X = 28.000000000000000000
Position.Y = 2.000000000000000000
Size.Width = 20.000000000000000000
Size.Height = 46.000000000000000000
Size.PlatformDefault = False
StyleLookup = 'spintopbutton'
end
object TBrushObject
StyleName = 'foreground'
Brush.Color = claBlack
end
object TBrushObject
StyleName = 'selection'
Brush.Color = x7F2A96FF
end
object TFontObject
StyleName = 'font'
end
end
end
I have a TListView livebinded with TFDMemTable. I also have a TButton that adds the item on the TFDMemTable which obviously shown in the TListView after adding the item. The TListView is located in one of the TTabItem of TTabControl.
My problem is, when I changed the tab at runtime and go back to TListView tab to add more item, the previously shown data will become empty after adding more item.
I can confirm that the data in the TFDMemTable are still intact including the newly added ones.
I suspect the livebinding needs to be refreshed in order to get all the data back to TListView.
Does anyone have any idea on how to refresh the livebinding at runtime?
P.S. I hope the above explains my issue clearly. Otherwise, please let me know if you need more details.
UPDATE 1: MINIMUM REPRODUCIBLE EXAMPLE
Here's the least that I can do for the MRE, not the exact scenario of my case but should be the same issue. You will come to notice after adding list on the TabItem2 and you go back to TabItem1 to add more item on the lists, the existing detail on the list will be gone.
FMX Procedure
unit TabbedFormwithNavigation;
interface
uses
System.SysUtils, System.Types, System.UITypes, System.Classes, System.Variants,
FMX.Types, FMX.Controls, FMX.Forms, FMX.Graphics, FMX.Dialogs, FMX.TabControl, FMX.StdCtrls, FMX.Controls.Presentation,
FMX.Gestures, System.Actions, FMX.ActnList, FMX.ListView.Types,
FMX.ListView.Appearances, FMX.ListView.Adapters.Base, REST.Types,
FireDAC.Stan.Intf, FireDAC.Stan.Option, FireDAC.Stan.Param,
FireDAC.Stan.Error, FireDAC.DatS, FireDAC.Phys.Intf, FireDAC.DApt.Intf,
System.Rtti, System.Bindings.Outputs, Fmx.Bind.Editors, Data.Bind.EngExt,
Fmx.Bind.DBEngExt, Data.Bind.Components, Data.Bind.DBScope, Data.DB,
FireDAC.Comp.DataSet, FireDAC.Comp.Client, REST.Response.Adapter, REST.Client,
Data.Bind.ObjectScope, FMX.ListView;
type
TTabbedwithNavigationForm = class(TForm)
TabControl1: TTabControl;
TabItem1: TTabItem;
TabItem2: TTabItem;
GestureManager1: TGestureManager;
ActionList1: TActionList;
NextTabAction1: TNextTabAction;
PreviousTabAction1: TPreviousTabAction;
lsv1: TListView;
rsc1: TRESTClient;
rsq1: TRESTRequest;
rsp1: TRESTResponse;
rsd1: TRESTResponseDataSetAdapter;
mtb1: TFDMemTable;
bdr1: TBindSourceDB;
bdl1: TBindingsList;
lsv2: TListView;
rsc2: TRESTClient;
rsq2: TRESTRequest;
rsp2: TRESTResponse;
rsd2: TRESTResponseDataSetAdapter;
mtb2: TFDMemTable;
bdr2: TBindSourceDB;
lcf1: TLinkListControlToField;
btn1: TButton;
lsv3: TListView;
mtb3: TFDMemTable;
strngfldmtb3brandname: TStringField;
strngfldmtb3brand: TStringField;
bdr3: TBindSourceDB;
lcf3: TLinkListControlToField;
lcf2: TLinkListControlToField;
pnl1: TPanel;
lbl1: TLabel;
pnl2: TPanel;
lbl2: TLabel;
pnl3: TPanel;
lbl3: TLabel;
procedure GestureDone(Sender: TObject; const EventInfo: TGestureEventInfo; var Handled: Boolean);
procedure FormCreate(Sender: TObject);
procedure FormKeyUp(Sender: TObject; var Key: Word; var KeyChar: Char; Shift: TShiftState);
procedure lsv1ItemClick(const Sender: TObject; const AItem: TListViewItem);
procedure btn1Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
TabbedwithNavigationForm: TTabbedwithNavigationForm;
implementation
{$R *.fmx}
procedure TTabbedwithNavigationForm.btn1Click(Sender: TObject);
var
brandname : string;
begin
brandname := mtb2.Lookup('name', lsv2.Items[lsv2.ItemIndex].Text, 'name');
// ShowMessage(lsv2.Items[lsv2.ItemIndex].Text);
if mtb3.Locate('brandname', brandname, []) = False then
begin
mtb3.DisableControls;
mtb3.Append;
mtb3.FieldByName('brandname').AsString := brandname;
mtb3.EnableControls;
mtb3.Post;
end;
end;
procedure TTabbedwithNavigationForm.FormCreate(Sender: TObject);
begin
{ This defines the default active tab at runtime }
TabControl1.ActiveTab := TabItem1;
rsq1.Execute;
end;
procedure TTabbedwithNavigationForm.FormKeyUp(Sender: TObject; var Key: Word; var KeyChar: Char; Shift: TShiftState);
begin
if Key = vkHardwareBack then
begin
if (TabControl1.ActiveTab = TabItem1) then
begin
Key := 0;
end;
end;
end;
procedure TTabbedwithNavigationForm.GestureDone(Sender: TObject; const EventInfo: TGestureEventInfo; var Handled: Boolean);
begin
case EventInfo.GestureID of
sgiLeft:
begin
if TabControl1.ActiveTab <> TabControl1.Tabs[TabControl1.TabCount - 1] then
TabControl1.ActiveTab := TabControl1.Tabs[TabControl1.TabIndex + 1];
Handled := True;
end;
sgiRight:
begin
if TabControl1.ActiveTab <> TabControl1.Tabs[0] then
TabControl1.ActiveTab := TabControl1.Tabs[TabControl1.TabIndex - 1];
Handled := True;
end;
end;
end;
procedure TTabbedwithNavigationForm.lsv1ItemClick(const Sender: TObject;
const AItem: TListViewItem);
var
SearchItem : String;
begin
//place the equivalent api for the meta click
SearchItem := lsv1.Items[lsv1.ItemIndex].Text;
rsc2.BaseURL := 'https://nm5c906csg.execute-api.ap-southeast-1.amazonaws.com/v0/dbqueries?search-item=' + SearchItem;
//execute api request for the searches
rsq2.Execute;
TabControl1.TabIndex := 1;
end;
end.
FMX File
object TabbedwithNavigationForm: TTabbedwithNavigationForm
Left = 0
Top = 0
Caption = 'Form56'
ClientHeight = 596
ClientWidth = 405
FormFactor.Width = 320
FormFactor.Height = 480
FormFactor.Devices = [Desktop]
OnCreate = FormCreate
OnKeyUp = FormKeyUp
DesignerMasterStyle = 0
object TabControl1: TTabControl
Touch.GestureManager = GestureManager1
OnGesture = GestureDone
Align = Client
FullSize = True
Size.Width = 405.000000000000000000
Size.Height = 596.000000000000000000
Size.PlatformDefault = False
TabHeight = 49.000000000000000000
TabIndex = 1
TabOrder = 0
TabPosition = PlatformDefault
Sizes = (
405s
547s
405s
547s)
object TabItem1: TTabItem
CustomIcon = <
item
end>
IsSelected = False
Size.Width = 201.000000000000000000
Size.Height = 49.000000000000000000
Size.PlatformDefault = False
StyleLookup = 'tabitemfavorites'
TabOrder = 0
Text = 'TabItem1'
ExplicitSize.cx = 101.000000000000000000
ExplicitSize.cy = 49.000000000000000000
object lsv1: TListView
ItemAppearanceClassName = 'TListItemAppearance'
ItemEditAppearanceClassName = 'TListItemShowCheckAppearance'
HeaderAppearanceClassName = 'TListHeaderObjects'
FooterAppearanceClassName = 'TListHeaderObjects'
ItemIndex = 0
Align = Client
Size.Width = 405.000000000000000000
Size.Height = 487.000000000000000000
Size.PlatformDefault = False
TabOrder = 0
OnItemClick = lsv1ItemClick
end
object pnl1: TPanel
Align = Top
Size.Width = 405.000000000000000000
Size.Height = 60.000000000000000000
Size.PlatformDefault = False
TabOrder = 1
object lbl1: TLabel
Align = Client
StyledSettings = [Family, FontColor]
Margins.Left = 60.000000000000000000
Margins.Right = 60.000000000000000000
Size.Width = 285.000000000000000000
Size.Height = 60.000000000000000000
Size.PlatformDefault = False
TextSettings.Font.Size = 14.000000000000000000
TextSettings.Font.StyleExt = {00070000000000000004000000}
TextSettings.HorzAlign = Center
Text = 'Please select an item here to filter out items for TabItem2.'
TabOrder = 0
end
end
end
object TabItem2: TTabItem
CustomIcon = <
item
end>
IsSelected = True
Size.Width = 202.000000000000000000
Size.Height = 49.000000000000000000
Size.PlatformDefault = False
StyleLookup = 'tabitemcontacts'
TabOrder = 0
Text = 'TabItem2'
ExplicitSize.cx = 102.000000000000000000
ExplicitSize.cy = 49.000000000000000000
object lsv2: TListView
ItemAppearanceClassName = 'TImageListItemBottomDetailAppearance'
ItemEditAppearanceClassName = 'TImageListItemBottomDetailShowCheckAppearance'
HeaderAppearanceClassName = 'TListHeaderObjects'
FooterAppearanceClassName = 'TListHeaderObjects'
ItemIndex = 0
Align = Top
Position.Y = 60.000000000000000000
Size.Width = 405.000000000000000000
Size.Height = 221.000000000000000000
Size.PlatformDefault = False
TabOrder = 0
end
object btn1: TButton
Align = Top
StyledSettings = [Family, FontColor]
Position.Y = 281.000000000000000000
Size.Width = 405.000000000000000000
Size.Height = 40.000000000000000000
Size.PlatformDefault = False
TabOrder = 1
Text = 'SELECT'
TextSettings.Font.Size = 14.000000000000000000
TextSettings.Font.StyleExt = {00070000000000000004000000}
OnClick = btn1Click
end
object lsv3: TListView
ItemAppearanceClassName = 'TImageListItemBottomDetailAppearance'
ItemEditAppearanceClassName = 'TImageListItemBottomDetailShowCheckAppearance'
HeaderAppearanceClassName = 'TListHeaderObjects'
FooterAppearanceClassName = 'TListHeaderObjects'
Align = Client
Size.Width = 405.000000000000000000
Size.Height = 166.000000000000000000
Size.PlatformDefault = False
TabOrder = 2
end
object pnl2: TPanel
Align = Top
Size.Width = 405.000000000000000000
Size.Height = 60.000000000000000000
Size.PlatformDefault = False
TabOrder = 3
object lbl2: TLabel
Align = Client
StyledSettings = [Family, FontColor]
Margins.Left = 30.000000000000000000
Margins.Right = 30.000000000000000000
Size.Width = 345.000000000000000000
Size.Height = 60.000000000000000000
Size.PlatformDefault = False
TextSettings.Font.Size = 14.000000000000000000
TextSettings.Font.StyleExt = {00070000000000000004000000}
TextSettings.HorzAlign = Center
Text =
'Select an item below then click the "SELECT" button to list down' +
' the items selected.'
TabOrder = 0
end
end
object pnl3: TPanel
Align = Bottom
Position.Y = 487.000000000000000000
Size.Width = 405.000000000000000000
Size.Height = 60.000000000000000000
Size.PlatformDefault = False
TabOrder = 4
object lbl3: TLabel
Align = Client
StyledSettings = [Family]
Size.Width = 405.000000000000000000
Size.Height = 60.000000000000000000
Size.PlatformDefault = False
TextSettings.Font.StyleExt = {00070000000000000004000000}
TextSettings.FontColor = claRed
TextSettings.HorzAlign = Center
Text =
'The error comes when you go back to TabItem1 and select another ' +
'item, the existing details on the list will be gone.'
TabOrder = 0
end
end
end
end
object GestureManager1: TGestureManager
Sensitivity = 80.000000000000000000
Left = 48
Top = 185
GestureData = <
item
Control = TabControl1
Collection = <
item
GestureID = sgiLeft
end
item
GestureID = sgiRight
end>
end>
end
object ActionList1: TActionList
Left = 48
Top = 120
object NextTabAction1: TNextTabAction
Category = 'Tab'
end
object PreviousTabAction1: TPreviousTabAction
Category = 'Tab'
end
end
object rsc1: TRESTClient
Accept = 'application/json, text/plain; q=0.9, text/html;q=0.8,'
AcceptCharset = 'utf-8, *;q=0.8'
BaseURL =
'https://bs3winlz02.execute-api.ap-southeast-1.amazonaws.com/v0/d' +
'bqueries'
Params = <>
Left = 136
Top = 120
end
object rsq1: TRESTRequest
Client = rsc1
Params = <>
Response = rsp1
SynchronizedEvents = False
Left = 136
Top = 184
end
object rsp1: TRESTResponse
ContentType = 'application/json'
Left = 136
Top = 248
end
object rsd1: TRESTResponseDataSetAdapter
Active = True
Dataset = mtb1
FieldDefs = <>
Response = rsp1
Left = 136
Top = 312
end
object mtb1: TFDMemTable
Active = True
FieldDefs = <
item
Name = 'meta'
DataType = ftWideString
Size = 255
end>
IndexDefs = <>
FetchOptions.AssignedValues = [evMode]
FetchOptions.Mode = fmAll
ResourceOptions.AssignedValues = [rvSilentMode]
ResourceOptions.SilentMode = True
UpdateOptions.AssignedValues = [uvCheckRequired, uvAutoCommitUpdates]
UpdateOptions.CheckRequired = False
UpdateOptions.AutoCommitUpdates = True
StoreDefs = True
Left = 136
Top = 376
end
object bdr1: TBindSourceDB
DataSet = mtb1
ScopeMappings = <>
Left = 136
Top = 440
end
object bdl1: TBindingsList
Methods = <>
OutputConverters = <>
Left = 20
Top = 5
object lcf1: TLinkListControlToField
Category = 'Quick Bindings'
DataSource = bdr1
FieldName = 'meta'
Control = lsv1
FillExpressions = <>
FillHeaderExpressions = <>
FillBreakGroups = <>
end
object lcf3: TLinkListControlToField
Category = 'Quick Bindings'
DataSource = bdr3
FieldName = 'brandname'
Control = lsv3
FillExpressions = <
item
SourceMemberName = 'brand'
ControlMemberName = 'Detail'
end>
FillHeaderExpressions = <>
FillBreakGroups = <>
end
object lcf2: TLinkListControlToField
Category = 'Quick Bindings'
DataSource = bdr2
FieldName = 'name'
Control = lsv2
FillExpressions = <
item
SourceMemberName = 'brand'
ControlMemberName = 'Detail'
end>
FillHeaderExpressions = <>
FillBreakGroups = <>
end
end
object rsc2: TRESTClient
Accept = 'application/json, text/plain; q=0.9, text/html;q=0.8,'
AcceptCharset = 'utf-8, *;q=0.8'
BaseURL =
'https://nm5c906csg.execute-api.ap-southeast-1.amazonaws.com/v0/d' +
'bqueries?search-item=sage'
Params = <>
Left = 200
Top = 120
end
object rsq2: TRESTRequest
Client = rsc2
Params = <>
Response = rsp2
SynchronizedEvents = False
Left = 200
Top = 184
end
object rsp2: TRESTResponse
ContentType = 'application/json'
Left = 200
Top = 248
end
object rsd2: TRESTResponseDataSetAdapter
Active = True
Dataset = mtb2
FieldDefs = <>
Response = rsp2
Left = 200
Top = 312
end
object mtb2: TFDMemTable
Active = True
FieldDefs = <
item
Name = 'brand'
DataType = ftWideString
Size = 255
end
item
Name = 'name'
DataType = ftWideString
Size = 255
end
item
Name = 'description'
DataType = ftWideString
Size = 255
end>
IndexDefs = <>
FetchOptions.AssignedValues = [evMode]
FetchOptions.Mode = fmAll
ResourceOptions.AssignedValues = [rvSilentMode]
ResourceOptions.SilentMode = True
UpdateOptions.AssignedValues = [uvCheckRequired, uvAutoCommitUpdates]
UpdateOptions.CheckRequired = False
UpdateOptions.AutoCommitUpdates = True
StoreDefs = True
Left = 200
Top = 376
end
object bdr2: TBindSourceDB
DataSet = mtb2
ScopeMappings = <>
Left = 200
Top = 440
end
object mtb3: TFDMemTable
Active = True
FetchOptions.AssignedValues = [evMode]
FetchOptions.Mode = fmAll
ResourceOptions.AssignedValues = [rvSilentMode]
ResourceOptions.SilentMode = True
UpdateOptions.AssignedValues = [uvCheckRequired, uvAutoCommitUpdates]
UpdateOptions.CheckRequired = False
UpdateOptions.AutoCommitUpdates = True
Left = 264
Top = 376
object strngfldmtb3brandname: TStringField
FieldName = 'brandname'
Size = 200
end
object strngfldmtb3brand: TStringField
FieldKind = fkLookup
FieldName = 'brand'
LookupDataSet = mtb2
LookupKeyFields = 'name'
LookupResultField = 'brand'
KeyFields = 'brandname'
Size = 200
Lookup = True
end
end
object bdr3: TBindSourceDB
DataSet = mtb3
ScopeMappings = <>
Left = 264
Top = 440
end
end
The error lies on the LookUp field I created in the FDMemTable (mtb3). I avoided those. Instead, I create a normal data field and directly took the data from TListView (lsv2) as shown below:
FMX Procedure
procedure TTabbedwithNavigationForm.btn1Click(Sender: TObject);
var
brandname, brand : string;
begin
brandname := mtb2.Lookup('name', lsv2.Items[lsv2.ItemIndex].Text, 'name');
brand := mtb2.Lookup('name', lsv2.Items[lsv2.ItemIndex].Text, 'brand');
if mtb3.Locate('brandname', brandname, []) = False then
begin
mtb3.DisableControls;
mtb3.Append;
mtb3.FieldByName('brandname').AsString := brandname;
mtb3.FieldByName('brand').AsString := brand; //manually coded instead of lookup field in the fdmemtable (mtb3)
mtb3.EnableControls;
mtb3.Post;
end;
end;
FMX File
object mtb3: TFDMemTable
Active = True
FieldDefs = <
item
Name = 'brandname'
DataType = ftString
Size = 200
end
item
Name = 'brand'
DataType = ftString // defined as data instead of lookup
Size = 100
end>
IndexDefs = <>
FetchOptions.AssignedValues = [evMode]
FetchOptions.Mode = fmAll
ResourceOptions.AssignedValues = [rvSilentMode]
ResourceOptions.SilentMode = True
UpdateOptions.AssignedValues = [uvCheckRequired, uvAutoCommitUpdates]
UpdateOptions.CheckRequired = False
UpdateOptions.AutoCommitUpdates = True
StoreDefs = True
Left = 264
Top = 376
object strngfldmtb3brandname: TStringField
FieldName = 'brandname'
Size = 200
end
object strngfldmtb3brand: TStringField
FieldName = 'brand'
Size = 100
end
end
I have a doubt. I have created a Frame in firemonkey and added 2 buttons, then inside MainForm I added this Frame.
Frame.Align = Scale
In the MainForm the Object Frame.Align = Client
When I compile and resize the Form, the Frame does not scale.
Is this a normal question or a bug?
object Form1: TForm1
Left = 0
Top = 0
Caption = 'Form1'
ClientHeight = 481
ClientWidth = 627
FormFactor.Width = 320
FormFactor.Height = 480
FormFactor.Devices = [Desktop]
DesignerMasterStyle = 0
inline Frame21: TFrame2
Align = Scale
Position.Y = -3.000000000000000000
Size.Width = 887.000000000000000000
Size.Height = 653.000000000000000000
Size.PlatformDefault = False
end
end
object Frame2: TFrame2
Align = Scale
Size.Width = 526.000000000000000000
Size.Height = 395.000000000000000000
Size.PlatformDefault = False
object Button1: TButton
Position.X = 80.000000000000000000
Position.Y = 40.000000000000000000
TabOrder = 0
Text = 'Button1'
end
object Button2: TButton
Position.X = 144.000000000000000000
Position.Y = 144.000000000000000000
TabOrder = 1
Text = 'Button2'
end
object Button3: TButton
Position.X = 240.000000000000000000
Position.Y = 256.000000000000000000
TabOrder = 2
Text = 'Button3'
end
end
No, there is no bug with Align = Scale in a frame. You seem to have only the frame itself aligned with Scale.
If you want the components on the frame also to scale, you need to assign their Align property as well.
Here's my form
object Form22: TForm22
Left = 0
Top = 0
Caption = 'Form22'
ClientHeight = 200
ClientWidth = 350
FormFactor.Width = 320
FormFactor.Height = 480
FormFactor.Devices = [Desktop]
DesignerMasterStyle = 0
inline Frame221: TFrame22
Align = Scale
Position.X = 16.000000000000000000
Position.Y = 14.000000000000000000
Size.Width = 320.000000000000000000
Size.Height = 171.000000000000000000
Size.PlatformDefault = False
TabOrder = 1
inherited Label1: TLabel
Position.X = 16.000000000000000000
Position.Y = 24.000000000000000000
end
inherited Button1: TButton
Position.Y = 48.857139587402340000
Size.Height = 19.193893432617190000
Size.PlatformDefault = False
end
inherited Button2: TButton
Position.Y = 48.857139587402340000
Size.Height = 19.193893432617190000
Size.PlatformDefault = False
end
inherited Rectangle1: TRectangle
Position.Y = 76.775512695312500000
Size.Height = 77.647918701171880000
end
end
end
And the frame
object Frame22: TFrame22
Align = Scale
Size.Width = 320.000000000000000000
Size.Height = 196.000000000000000000
Size.PlatformDefault = False
TabOrder = 0
object Label1: TLabel
Position.X = 32.000000000000000000
Position.Y = 32.000000000000000000
Text = 'Frame here!'
end
object Button1: TButton
Align = Scale
Position.X = 16.000000000000000000
Position.Y = 56.000000000000000000
TabOrder = 1
Text = 'Button1'
end
object Button2: TButton
Align = Scale
Position.X = 216.000000000000000000
Position.Y = 56.000000000000000000
TabOrder = 2
Text = 'Button2'
end
object Rectangle1: TRectangle
Align = Scale
Position.X = 16.000000000000000000
Position.Y = 88.000000000000000000
Size.Width = 281.000000000000000000
Size.Height = 89.000000000000000000
Size.PlatformDefault = False
end
end
Note that all components (except the TLabel) have their Align property set to Scale.
In Firemonkey, message dialogs have changed in Delphi 10.1 Berlin, and MessageDlg has been deprecated in favor to use the new dialog services. However, in any case, I would like to bypass any system dialogs (at least for messages) and use my own synchronous in-form dialog instead.
I managed to write a single form to accomplish this, and it works. However, it's extremely sloppy, specifically the method of how it waits. I don't want to use a callback procedure, so I want my own version of MessageDlg to instead wait for a response from the user, just like regular modal dialogs. (Actually, I call mine MsgPrompt.)
In particular, I need to do something else at this spot:
while not F.FDone do begin
Application.ProcessMessages;
Sleep(50);
end;
... for obvious reasons.
One example of why I don't want (and can't use) a callback procedure, is because I need to use it in the main form's OnCloseQuery, and prompt the user if they're sure they want to close. It would be impossible to make that work, because the OnCloseQuery event handler would exit before the user made a choice
How should I appropriately wait for this input synchronously (mimicking a modal dialog) without blocking the main UI thread and hindering its responsiveness?
Custom dialog unit - please refer to where I say HORRIBLE, HORRIBLE DESIGN:
unit uDialog;
interface
uses
System.SysUtils, System.Types, System.UITypes, System.Classes, System.Variants,
FMX.Types, FMX.Controls, FMX.Forms, FMX.Graphics, FMX.Dialogs, FMX.StdCtrls,
FMX.Controls.Presentation, FMX.Layouts, System.ImageList, FMX.ImgList;
type
TDialogForm = class(TForm)
DialogLayout: TLayout;
DimPanel: TPanel;
DialogPanel: TPanel;
ButtonPanel: TPanel;
btnYes: TButton;
btnNo: TButton;
btnOK: TButton;
btnCancel: TButton;
btnAbort: TButton;
btnRetry: TButton;
btnIgnore: TButton;
btnAll: TButton;
btnNoToAll: TButton;
btnYesToAll: TButton;
btnHelp: TButton;
btnClose: TButton;
DialogLabel: TLabel;
imgError: TImageControl;
imgInfo: TImageControl;
imgConfirm: TImageControl;
imgWarn: TImageControl;
procedure FormCreate(Sender: TObject);
procedure DialogButtonClick(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
private
FCloseDialogProc: TInputCloseDialogProc;
FDone: Boolean;
procedure ShowButtons(const AButtons: TMsgDlgButtons);
procedure ShowIcon(const ADialogType: TMsgDlgType);
procedure SetDefaultButton(const ABtn: TMsgDlgBtn);
public
end;
var
DialogForm: TDialogForm;
procedure SetDialogDefaultParent(AValue: TFmxObject);
function MsgPrompt(const AMessage: string;
const ADialogType: TMsgDlgType; const AButtons: TMsgDlgButtons;
const ADefaultButton: TMsgDlgBtn): TModalResult;
procedure MessageDlg(const AMessage: string;
const ADialogType: TMsgDlgType; const AButtons: TMsgDlgButtons;
const ADefaultButton: TMsgDlgBtn; const ACloseDialogProc: TInputCloseDialogProc);
implementation
{$R *.fmx}
var
_DefaultParent: TFmxObject;
procedure SetDialogDefaultParent(AValue: TFmxObject);
begin
_DefaultParent:= AValue;
end;
function MsgPrompt(const AMessage: string;
const ADialogType: TMsgDlgType; const AButtons: TMsgDlgButtons;
const ADefaultButton: TMsgDlgBtn): TModalResult;
var
R: TModalResult;
begin
MessageDlg(AMessage,
ADialogType,
AButtons,
ADefaultButton,
procedure(const AResult: TModalResult)
begin
R:= AResult;
end);
Result:= R;
end;
procedure MessageDlg(const AMessage: string;
const ADialogType: TMsgDlgType; const AButtons: TMsgDlgButtons;
const ADefaultButton: TMsgDlgBtn; const ACloseDialogProc: TInputCloseDialogProc);
var
F: TDialogForm;
begin
F:= TDialogForm.Create(nil);
try
//TODO: Move these assignments into the form itself, perhaps its constructor.
F.FCloseDialogProc:= ACloseDialogProc;
F.DialogLabel.Text:= AMessage;
F.ShowButtons(AButtons);
F.ShowIcon(ADialogType);
F.DialogLayout.Parent:= _DefaultParent;
F.SetDefaultButton(ADefaultButton);
//TODO: Use another method!!!!!!!
while not F.FDone do begin // <---- HORRIBLE, HORRIBLE DESIGN.
Application.ProcessMessages;
Sleep(50);
end;
finally
F.Close;
end;
end;
{ TDialogForm }
procedure TDialogForm.FormCreate(Sender: TObject);
begin
DialogLayout.Align:= TAlignLayout.Client;
DimPanel.Align:= TAlignLayout.Client;
DialogLabel.Text:= '';
end;
procedure TDialogForm.FormClose(Sender: TObject; var Action: TCloseAction);
begin
Action:= TCloseAction.caFree;
end;
procedure TDialogForm.DialogButtonClick(Sender: TObject);
var
B: TButton;
R: TModalResult;
begin
DialogLayout.Visible:= False;
B:= TButton(Sender);
case B.Tag of
0: R:= mrYes;
1: R:= mrNo;
2: R:= mrOK;
3: R:= mrCancel;
4: R:= mrAbort;
5: R:= mrRetry;
6: R:= mrIgnore;
7: R:= mrAll;
8: R:= mrNoToAll;
9: R:= mrYesToAll;
10: R:= mrHelp;
11: R:= mrClose;
else R:= mrOK;
end;
FCloseDialogProc(R);
FDone:= True;
end;
procedure TDialogForm.ShowIcon(const ADialogType: TMsgDlgType);
begin
case ADialogType of
TMsgDlgType.mtWarning: imgWarn.Visible:= True;
TMsgDlgType.mtError: imgError.Visible:= True;
TMsgDlgType.mtInformation: imgInfo.Visible:= True;
TMsgDlgType.mtConfirmation: imgConfirm.Visible:= True;
TMsgDlgType.mtCustom: ; //TODO
end;
end;
procedure TDialogForm.SetDefaultButton(const ABtn: TMsgDlgBtn);
var
B: TButton;
begin
B:= nil;
case ABtn of
TMsgDlgBtn.mbYes: B:= btnYes;
TMsgDlgBtn.mbNo: B:= btnNo;
TMsgDlgBtn.mbOK: B:= btnOK;
TMsgDlgBtn.mbCancel: B:= btnCancel;
TMsgDlgBtn.mbAbort: B:= btnAbort;
TMsgDlgBtn.mbRetry: B:= btnRetry;
TMsgDlgBtn.mbIgnore: B:= btnIgnore;
TMsgDlgBtn.mbAll: B:= btnAll;
TMsgDlgBtn.mbNoToAll: B:= btnNoToAll;
TMsgDlgBtn.mbYesToAll: B:= btnYesToAll;
TMsgDlgBtn.mbHelp: B:= btnHelp;
TMsgDlgBtn.mbClose: B:= btnClose;
end;
if Assigned(B) then
if B.Visible then
if B.CanFocus then
B.SetFocus;
end;
procedure TDialogForm.ShowButtons(const AButtons: TMsgDlgButtons);
begin
if TMsgDlgBtn.mbYes in AButtons then begin
btnYes.Visible:= True;
end;
if TMsgDlgBtn.mbNo in AButtons then begin
btnNo.Visible:= True;
end;
if TMsgDlgBtn.mbOK in AButtons then begin
btnOK.Visible:= True;
end;
if TMsgDlgBtn.mbCancel in AButtons then begin
btnCancel.Visible:= True;
end;
if TMsgDlgBtn.mbAbort in AButtons then begin
btnAbort.Visible:= True;
end;
if TMsgDlgBtn.mbRetry in AButtons then begin
btnRetry.Visible:= True;
end;
if TMsgDlgBtn.mbIgnore in AButtons then begin
btnIgnore.Visible:= True;
end;
if TMsgDlgBtn.mbAll in AButtons then begin
btnAll.Visible:= True;
end;
if TMsgDlgBtn.mbNoToAll in AButtons then begin
btnNoToAll.Visible:= True;
end;
if TMsgDlgBtn.mbYesToAll in AButtons then begin
btnYesToAll.Visible:= True;
end;
if TMsgDlgBtn.mbHelp in AButtons then begin
btnHelp.Visible:= True;
end;
if TMsgDlgBtn.mbClose in AButtons then begin
btnClose.Visible:= True;
end;
end;
end.
Custom dialog FMX (NOTE: Image data is removed to spare space):
object DialogForm: TDialogForm
Left = 0
Top = 0
Caption = 'Form2'
ClientHeight = 574
ClientWidth = 503
FormFactor.Width = 320
FormFactor.Height = 480
FormFactor.Devices = [Desktop]
OnCreate = FormCreate
OnClose = FormClose
DesignerMasterStyle = 0
object DialogLayout: TLayout
Align = Top
Size.Width = 503.000000000000000000
Size.Height = 529.000000000000000000
Size.PlatformDefault = False
TabOrder = 0
object DimPanel: TPanel
Align = Top
Opacity = 0.860000014305114800
Size.Width = 503.000000000000000000
Size.Height = 489.000000000000000000
Size.PlatformDefault = False
TabOrder = 1
object DialogPanel: TPanel
Anchors = [akLeft, akTop, akRight, akBottom]
Position.X = 40.000000000000000000
Position.Y = 40.000000000000000000
Size.Width = 425.000000000000000000
Size.Height = 401.000000000000000000
Size.PlatformDefault = False
StyleLookup = 'DialogPanelStyle1'
TabOrder = 0
object ButtonPanel: TPanel
Align = Bottom
Margins.Left = 3.000000000000000000
Margins.Top = 3.000000000000000000
Margins.Right = 3.000000000000000000
Margins.Bottom = 3.000000000000000000
Position.X = 3.000000000000000000
Position.Y = 355.000000000000000000
Size.Width = 419.000000000000000000
Size.Height = 43.000000000000000000
Size.PlatformDefault = False
StyleLookup = 'Panel2Style1'
TabOrder = 0
object btnYes: TButton
Align = Right
Cursor = crHandPoint
Margins.Left = 2.000000000000000000
Margins.Top = 2.000000000000000000
Margins.Right = 2.000000000000000000
Margins.Bottom = 2.000000000000000000
Position.X = 62.000000000000000000
Position.Y = 2.000000000000000000
Size.Width = 80.000000000000000000
Size.Height = 47.000000000000000000
Size.PlatformDefault = False
TabOrder = 0
Text = 'Yes'
Visible = False
OnClick = DialogButtonClick
end
object btnNo: TButton
Tag = 1
Align = Right
Cursor = crHandPoint
Margins.Left = 2.000000000000000000
Margins.Top = 2.000000000000000000
Margins.Right = 2.000000000000000000
Margins.Bottom = 2.000000000000000000
Position.X = -274.000000000000000000
Position.Y = 2.000000000000000000
Size.Width = 80.000000000000000000
Size.Height = 47.000000000000000000
Size.PlatformDefault = False
TabOrder = 1
Text = 'No'
Visible = False
OnClick = DialogButtonClick
end
object btnOK: TButton
Tag = 2
Align = Right
Cursor = crHandPoint
Margins.Left = 2.000000000000000000
Margins.Top = 2.000000000000000000
Margins.Right = 2.000000000000000000
Margins.Bottom = 2.000000000000000000
Position.X = 241.000000000000000000
Position.Y = 2.000000000000000000
Size.Width = 80.000000000000000000
Size.Height = 47.000000000000000000
Size.PlatformDefault = False
TabOrder = 2
Text = 'OK'
Visible = False
OnClick = DialogButtonClick
end
object btnCancel: TButton
Tag = 3
Align = Right
Cursor = crHandPoint
Margins.Left = 2.000000000000000000
Margins.Top = 2.000000000000000000
Margins.Right = 2.000000000000000000
Margins.Bottom = 2.000000000000000000
Position.X = -610.000000000000000000
Position.Y = 2.000000000000000000
Size.Width = 80.000000000000000000
Size.Height = 47.000000000000000000
Size.PlatformDefault = False
TabOrder = 3
Text = 'Cancel'
Visible = False
OnClick = DialogButtonClick
end
object btnAbort: TButton
Tag = 4
Align = Right
Cursor = crHandPoint
Margins.Left = 2.000000000000000000
Margins.Top = 2.000000000000000000
Margins.Right = 2.000000000000000000
Margins.Bottom = 2.000000000000000000
Position.X = -778.000000000000000000
Position.Y = 2.000000000000000000
Size.Width = 80.000000000000000000
Size.Height = 47.000000000000000000
Size.PlatformDefault = False
TabOrder = 4
Text = 'Abort'
Visible = False
OnClick = DialogButtonClick
end
object btnRetry: TButton
Tag = 5
Align = Right
Cursor = crHandPoint
Margins.Left = 2.000000000000000000
Margins.Top = 2.000000000000000000
Margins.Right = 2.000000000000000000
Margins.Bottom = 2.000000000000000000
Position.X = 62.000000000000000000
Position.Y = 2.000000000000000000
Size.Width = 80.000000000000000000
Size.Height = 47.000000000000000000
Size.PlatformDefault = False
TabOrder = 5
Text = 'Retry'
Visible = False
OnClick = DialogButtonClick
end
object btnIgnore: TButton
Tag = 6
Align = Right
Cursor = crHandPoint
Margins.Left = 2.000000000000000000
Margins.Top = 2.000000000000000000
Margins.Right = 2.000000000000000000
Margins.Bottom = 2.000000000000000000
Position.X = 241.000000000000000000
Position.Y = 2.000000000000000000
Size.Width = 80.000000000000000000
Size.Height = 47.000000000000000000
Size.PlatformDefault = False
TabOrder = 6
Text = 'Ignore'
Visible = False
OnClick = DialogButtonClick
end
object btnAll: TButton
Tag = 7
Align = Right
Cursor = crHandPoint
Margins.Left = 2.000000000000000000
Margins.Top = 2.000000000000000000
Margins.Right = 2.000000000000000000
Margins.Bottom = 2.000000000000000000
Position.X = -694.000000000000000000
Position.Y = 2.000000000000000000
Size.Width = 80.000000000000000000
Size.Height = 47.000000000000000000
Size.PlatformDefault = False
TabOrder = 7
Text = 'All'
Visible = False
OnClick = DialogButtonClick
end
object btnNoToAll: TButton
Tag = 8
Align = Right
Cursor = crHandPoint
Margins.Left = 2.000000000000000000
Margins.Top = 2.000000000000000000
Margins.Right = 2.000000000000000000
Margins.Bottom = 2.000000000000000000
Position.X = -22.000000000000000000
Position.Y = 2.000000000000000000
Size.Width = 80.000000000000000000
Size.Height = 47.000000000000000000
Size.PlatformDefault = False
TabOrder = 8
Text = 'No to All'
Visible = False
OnClick = DialogButtonClick
end
object btnYesToAll: TButton
Tag = 9
Align = Right
Cursor = crHandPoint
Margins.Left = 2.000000000000000000
Margins.Top = 2.000000000000000000
Margins.Right = 2.000000000000000000
Margins.Bottom = 2.000000000000000000
Position.X = 241.000000000000000000
Position.Y = 2.000000000000000000
Size.Width = 80.000000000000000000
Size.Height = 47.000000000000000000
Size.PlatformDefault = False
TabOrder = 9
Text = 'Yes to All'
Visible = False
OnClick = DialogButtonClick
end
object btnHelp: TButton
Tag = 10
Align = Right
Cursor = crHandPoint
Margins.Left = 2.000000000000000000
Margins.Top = 2.000000000000000000
Margins.Right = 2.000000000000000000
Margins.Bottom = 2.000000000000000000
Position.X = -358.000000000000000000
Position.Y = 2.000000000000000000
Size.Width = 80.000000000000000000
Size.Height = 47.000000000000000000
Size.PlatformDefault = False
TabOrder = 10
Text = 'Help'
Visible = False
OnClick = DialogButtonClick
end
object btnClose: TButton
Tag = 11
Align = Right
Cursor = crHandPoint
Margins.Left = 2.000000000000000000
Margins.Top = 2.000000000000000000
Margins.Right = 2.000000000000000000
Margins.Bottom = 2.000000000000000000
Position.X = -526.000000000000000000
Position.Y = 2.000000000000000000
Size.Width = 80.000000000000000000
Size.Height = 47.000000000000000000
Size.PlatformDefault = False
TabOrder = 11
Text = 'Close'
Visible = False
OnClick = DialogButtonClick
end
end
object DialogLabel: TLabel
Align = Client
StyledSettings = [Family, Style, FontColor]
Margins.Left = 5.000000000000000000
Margins.Top = 5.000000000000000000
Margins.Right = 5.000000000000000000
Margins.Bottom = 5.000000000000000000
Size.Width = 415.000000000000000000
Size.Height = 342.000000000000000000
Size.PlatformDefault = False
TextSettings.Font.Size = 18.000000000000000000
TextSettings.HorzAlign = Center
Text = 'DialogLabel'
end
object imgError: TImageControl
Align = Top
Bitmap.PNG = {}
Margins.Left = 5.000000000000000000
Margins.Top = 5.000000000000000000
Margins.Right = 5.000000000000000000
Margins.Bottom = 5.000000000000000000
Size.Width = 303.000000000000000000
Size.Height = 120.000000000000000000
Size.PlatformDefault = False
TabOrder = 4
Visible = False
end
object imgInfo: TImageControl
Align = Top
Bitmap.PNG = {}
Margins.Left = 5.000000000000000000
Margins.Top = 5.000000000000000000
Margins.Right = 5.000000000000000000
Margins.Bottom = 5.000000000000000000
Position.Y = 49.000000000000000000
Size.Width = 303.000000000000000000
Size.Height = 120.000000000000000000
Size.PlatformDefault = False
TabOrder = 3
Visible = False
end
object imgConfirm: TImageControl
Align = Top
Bitmap.PNG = {}
Margins.Left = 5.000000000000000000
Margins.Top = 5.000000000000000000
Margins.Right = 5.000000000000000000
Margins.Bottom = 5.000000000000000000
Position.Y = 98.000000000000000000
Size.Width = 303.000000000000000000
Size.Height = 120.000000000000000000
Size.PlatformDefault = False
TabOrder = 2
Visible = False
end
object imgWarn: TImageControl
Align = Top
Bitmap.PNG = {}
Margins.Left = 5.000000000000000000
Margins.Top = 5.000000000000000000
Margins.Right = 5.000000000000000000
Margins.Bottom = 5.000000000000000000
Position.Y = 147.000000000000000000
Size.Width = 303.000000000000000000
Size.Height = 120.000000000000000000
Size.PlatformDefault = False
TabOrder = 1
Visible = False
end
end
end
end
end
In the main form's OnCreate event handler, to instruct where to embed these dialogs:
SetDialogDefaultParent(Self);
Usage:
case MsgPrompt('This is a sample message.', TMsgDlgType.mtInformation,
[TMsgDlgBtn.mbYes, TMsgDlgBtn.mbNo], TMsgDlgBtn.mbNo) of
mrYes: begin
//
end;
else begin
//
end;
end;
yes of course doing
while not F.FDone do begin // <---- HORRIBLE, HORRIBLE DESIGN.
Application.ProcessMessages;
Sleep(50);
end;
if totally horrible of the horrible
What i do me, in a very very simple way is :
create a transparent overlay (a simple transparent trectangle) that will catch all mouse event. put this trectangle on the top of your form so all input will be deactivated for mouse event, then construct on the top of this overlay your dialog. in this way the dialog behave like blocking your app. Off course you need to code like javascript and pass to the dialog a reference to a procedure to call on completion and will continue to execute the code
{**************************************************************}
procedure TMyApp_MainForm.ShowPopupDialog(const aTitle: String;
const aSubTitle: String;
const aBody: Tcontrol;
const aButtons: TMsgDlgButtons;
const aDialogCloseProc: TMyApp_PopupDialogCloseProc;
const aAffineRatio: Single = 1);
var aLabel: TALText;
aRectangle: TALRectangle;
aMainPanel: TALrectangle;
aTitleHeight: Single;
aButtonsHeight: Single;
aButton: TMsgDlgBtn;
begin
//free previously created popup (in case)
PopupDialogCloseClick(nil);
//--create the fPopupDialog rect
fPopupDialog := TALRectangle.Create(self);
fPopupDialog.Parent := self;
fPopupDialog.BeginUpdate;
try
//init fPopupDialog
fPopupDialog.Position.Point := TpointF.Create(0,0);
fPopupDialog.Size.Size := TpointF.Create(MyApp_mainForm.clientWidth, MyApp_mainForm.ClientHeight);
fPopupDialog.Anchors := [TAnchorKind.akLeft, TAnchorKind.akTop, TAnchorKind.akRight, TAnchorKind.akBottom];
TALRectangle(fPopupDialog).Fill.Color := $64000000;
TALRectangle(fPopupDialog).Stroke.Kind := TbrushKind.none;
fPopupDialog.OnClick := PopupDialogCloseClick;
//--create the background
aMainPanel := TALRectangle.Create(fPopupDialog);
aMainPanel.Parent := fPopupDialog;
aMainPanel.Fill.Color := $ffffffff;
aMainPanel.Stroke.Kind := TbrushKind.none;
aMainPanel.width := aBody.width; // abody.width must have been correctly setuped
//--create the title
if aTitle <> '' then begin
aLabel := TALText.Create(aMainPanel);
aLabel.Parent := aMainPanel;
aLabel.TextSettings.Font.Style := [TFontStyle.fsBold];
aLabel.TextSettings.Font.Family := MyApp_GetFontFamily('sans-serif', aLabel.TextSettings.Font.Style);
aLabel.TextSettings.Font.size := ALAlignDimensionToPixelRound(20 * aAffineRatio * fAffineDimensionRatio, ScreenScale);
aLabel.TextSettings.FontColor := $FF333844;
aLabel.Height := ALAlignDimensionToPixelRound(50 * aAffineRatio * fAffineDimensionRatio, ScreenScale);
aLabel.TextSettings.VertAlign := TTextAlign.Trailing;
aLabel.Margins.Left := ALAlignDimensionToPixelRound(24 * aAffineRatio * fAffineDimensionRatio, ScreenScale);
aLabel.Margins.right := ALAlignDimensionToPixelRound(20 * aAffineRatio * fAffineDimensionRatio, ScreenScale);
if aSubTitle = '' then aLabel.Margins.bottom := ALAlignDimensionToPixelRound(20 * aAffineRatio * fAffineDimensionRatio, ScreenScale)
else aLabel.Margins.bottom := ALAlignDimensionToPixelRound(3 * aAffineRatio * fAffineDimensionRatio, ScreenScale);
aLabel.TextIsHtml := True;
aLabel.Text := aTitle;
aLabel.Position.Y := 0;
aLabel.Align := TalignLayout.Top;
aTitleHeight := aLabel.Height + aLabel.Margins.top + aLabel.Margins.bottom;
if aSubTitle <> '' then begin
aLabel := TALText.Create(aMainPanel);
aLabel.Parent := aMainPanel;
aLabel.TextSettings.Font.Style := [];
aLabel.TextSettings.Font.Family := MyApp_GetFontFamily('sans-serif-light', aLabel.TextSettings.Font.Style);
aLabel.TextSettings.Font.size := ALAlignDimensionToPixelRound(17 * aAffineRatio * fAffineDimensionRatio, ScreenScale);
aLabel.TextSettings.FontColor := $FF333844;
aLabel.Height := ALAlignDimensionToPixelRound(25 * aAffineRatio * fAffineDimensionRatio, ScreenScale);
aLabel.TextSettings.VertAlign := TTextAlign.Leading;
aLabel.Margins.Left := ALAlignDimensionToPixelRound(24 * aAffineRatio * fAffineDimensionRatio, ScreenScale);
aLabel.Margins.right := ALAlignDimensionToPixelRound(20 * aAffineRatio * fAffineDimensionRatio, ScreenScale);
aLabel.Margins.bottom := ALAlignDimensionToPixelRound(12 * aAffineRatio * fAffineDimensionRatio, ScreenScale);
aLabel.TextIsHtml := True;
aLabel.Text := aSubTitle;
aLabel.Position.Y := aTitleHeight + 1;
aLabel.Align := TalignLayout.Top;
aTitleHeight := aTitleHeight + aLabel.Height + aLabel.Margins.top + aLabel.Margins.bottom;
end;
end
else aTitleHeight := 0;
//--create the content
if assigned(aBody.Owner) then aBody.Owner.RemoveComponent(aBody);
aMainPanel.InsertComponent(aBody);
aBody.Parent := aMainPanel;
aBody.Position.Y := aTitleHeight + 1;
aBody.Align := TALignLayout.top;
//--create the buttons
if aButtons <> [] then begin
aRectangle := TALRectangle.Create(aMainPanel);
aRectangle.Parent := aMainPanel;
aRectangle.width := aBody.width;
aRectangle.Padding.Right := ALAlignDimensionToPixelRound(20 * aAffineRatio * fAffineDimensionRatio, ScreenScale);
aButtonsHeight := ALAlignDimensionToPixelRound(60 * aAffineRatio * fAffineDimensionRatio, ScreenScale);
aRectangle.Height := aButtonsHeight;
arectangle.Fill.color := $fffafafa;
aRectangle.Sides := [TSide.Top];
aRectangle.Stroke.Color := $FFE9E9E9;
for aButton in aButtons do begin
aLabel := TALText.Create(aRectangle);
aLabel.Parent := aRectangle;
aLabel.TextSettings.Font.Style := [];
aLabel.TextSettings.Font.Family := MyApp_GetFontFamily('sans-serif', aLabel.TextSettings.Font.Style);
aLabel.TextSettings.Font.size := ALAlignDimensionToPixelRound(17 * aAffineRatio * fAffineDimensionRatio, ScreenScale);
aLabel.TextSettings.FontColor := $FF398dac;
aLabel.AutoSize := true;
aLabel.Margins.Left := ALAlignDimensionToPixelRound(20 * aAffineRatio * fAffineDimensionRatio, ScreenScale);
aLabel.Margins.right := ALAlignDimensionToPixelRound(20 * aAffineRatio * fAffineDimensionRatio, ScreenScale);
aLabel.TouchTargetExpansion.Left := ALAlignDimensionToPixelRound(20 * aAffineRatio * fAffineDimensionRatio, ScreenScale);
aLabel.TouchTargetExpansion.right := ALAlignDimensionToPixelRound(20 * aAffineRatio * fAffineDimensionRatio, ScreenScale);
Alabel.HitTest := true;
aLabel.Cursor := CrHandPoint;
aLabel.OnMouseDown := TMyApp_ProcOfObjectWrapper.OnTouchEffect1MouseDownMaxViaTagFloat;
if aButton = TMsgDlgBtn.mbCancel then begin
aLabel.Text := UpperCase(MyApp_translate('_Cancel'));
aLabel.Tag := mrCancel;
aLabel.Position.x := 0;
end
else if aButton = TMsgDlgBtn.mbYes then begin
aLabel.Text := UpperCase(MyApp_translate('_Yes'));
aLabel.Tag := mrYes;
aLabel.Position.x := aRectangle.Width;
end
else if aButton = TMsgDlgBtn.mbOk then begin
aLabel.Text := UpperCase(MyApp_translate('_OK'));
aLabel.Tag := mrOK;
aLabel.Position.x := aRectangle.Width;
end;
aLabel.TagFloat := aButtonsHeight;
aLabel.onclick := PopupDialogBtnClick;
aLabel.Align := TalignLayout.right;
end;
aRectangle.Position.Y := aTitleHeight + aBody.height + 1;
aRectangle.Align := TALignLayout.top;
end
else aButtonsHeight := 0;
finally
ALLockTexts(fPopupDialog);
try
fPopupDialog.EndUpdate;
finally
ALUnLockTexts(fPopupDialog);
end;
end;
//create the bufbitmap
ALFmxMakeBufBitmaps(aMainPanel); // << this not really for the text that already made their bufbitmap in ALUnLockTexts for for images
if aTitleHeight + aButtonsHeight + aBody.Height + aBody.margins.top + aBody.margins.bottom > (Clientheight / 100) * 94 then aBody.Height := ((Clientheight / 100) * 94) - aTitleHeight - aButtonsHeight - aBody.margins.top - aBody.margins.bottom;
aMainPanel.height := aTitleHeight + aButtonsHeight + aBody.Height + aBody.margins.top + aBody.margins.bottom; // << because aBody.Height was probably updated in ALUnLockTexts(fPopupDialog);
aMainPanel.Align := TalignLayout.center;
//--create the shadow effect
aMainPanel.shadow.enabled := true;
aMainPanel.shadow.Shadowcolor := $3C000000;
aMainPanel.shadow.blur := 8 * affinedimensionRatio;
//show the popup
fPopupDialogCloseProc := ADialogCloseProc;
fPopupDialog.Visible := True;
fPopupDialog.BringToFront;
//close popup loading (if any)
closePopupLoading
end;
Your problem is that you want to use it in the CloseQuery event. You can set CanClose:=false then it will fall through and you can use any kind of normal dialog box.
This works on Android. If user clicks off of Dialog box so it disappears, it defaults to No
Uses FMX.DialogService.Async;
procedure TForm2.Button1Click(Sender: TObject);
begin
close;
end;
procedure TForm2.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
begin
if not GlobalQuit then
begin
CanClose:=false;
TDialogServiceAsync.MessageDialog(
'Quit?',
TMsgDlgType.mtConfirmation,
[TMsgDlgBtn.mbYes,TMsgDlgBtn.mbNo],
TMsgDlgBtn.mbNo,
0,
procedure(const AResult:TModalResult)
begin
if AResult = mrYes then
begin
GlobalQuit := true;
Close; // will go to CloseQuery again
end
else
GlobalQuit := false;
end
);
end;
end;