TComboBox with Image in Firemonkey - delphi

I have added a TImage to the style of TListBoxItem.
If I add to a TListBox, it works. If I add to a TComboBox, it doesn't works. I can't even change the height if the item in a TComboBox.
Here my sample code:
procedure TMainForm.FormCreate(Sender: TObject);
const
BitmapFile : String = 'F:\testimage.png';
var
ItemText : TText;
ItemImage : TImage;
ListBoxItem : TListBoxItem;
button : TButton;
begin
ListBoxItem := TListBoxItem.Create(nil);
ListBoxItem.Parent := CBoxHeadMenuLanguage;
ListBoxItem.StyleLookup := 'ListBoxItemIconStyle';
ListBoxItem.Height := 50; //just for test
ItemText := ListBoxItem.FindStyleResource('text') as TText;
if Assigned(ItemText) then ItemText.Text := 'Hello World!';
ItemImage := ListBoxItem.FindStyleResource('image') as TImage;
if Assigned(ItemImage) then If FileExists(BitmapFile) Then ItemImage.Bitmap.LoadFromFile(BitmapFile);
end;

You really shouldn't be doing styling stuff in FormCreate since styles are applied on an as-needed basis and can be removed and reapplied at any time.
Instead you'll need to use either OnApplyStyleLookup event or the ApplyStyle method. I recommend subclassing TListBox and using the latter and add a property to store the bitmap.
An outline class declaration would be:
type TBitmapLBItem = class(TListBoxItem)
private
FBitmap: TBitmap;
protected
procedure ApplyStyle;override;
public
property Bitmap: TBitmap read FBitmap write SetBitmap;
end;
Use FindStyleResource etc both in ApplyStyle and SetBitmap (or create a shared method to do it).
And in FormCreate create items of your new class and set the Bitmap properties as appropriate.
As for the height problem, try setting the ItemHeight property of the combo box. If you want a variety of heights within the list you're probably out of luck.

Related

Update corresponding label depending on which combobox fired the event

I have a program with n ComboBoxes and n Labels and I want to update the corresponding Label depending on the selection from the adjacent ComboBox i.e ComboBox2 would update Label2.
I am using the same event handler for every ComboBox and currently checking if Combobox1 or Combobox2 has fired the event handler. Is there a way to use the ItemIndex of the ComboBox passed to the procedure, such as Sender.ItemIndex? This is not currently an option and gives the error 'TObject' does not contain a member named 'ItemIndex'.
procedure TForm2.ComboBoxChange(Sender: TObject);
begin
if Sender = ComboBox1 then
Label1.Caption := ComboBox1.Items.Strings[ComboBox1.ItemIndex]
else
Label2.Caption := ComboBox2.Items.Strings[ComboBox2.ItemIndex];
end;
This code has the desired behavior but is obviously not scale-able.
Every component has a Tag property inherited from TComponent, where the Tag is a pointer-sized integer. As such, you can store each TLabel pointer directly in the corresponding TComboBox.Tag, eg:
procedure TForm2.FormCreate(Sender: TObject);
begin
ComboBox1.Tag := NativeInt(Label1);
ComboBox2.Tag := NativeInt(Label2);
end;
This way, ComboBoxChange() can then directly access the TLabel of the changed TComboBox, eg:
procedure TForm2.ComboBoxChange(Sender: TObject);
var
CB: TComboBox;
begin
CB := TComboBox(Sender);
if CB.Tag <> 0 then
TLabel(CB.Tag).Caption := CB.Items.Strings[CB.ItemIndex];
end;
Option 1
This is the most robust one.
Let your form have private members
private
FControlPairs: TArray<TPair<TComboBox, TLabel>>;
procedure InitControlPairs;
and call InitControlPairs when the form is created (either in its constructor, or in its OnCreate handler):
procedure TForm1.InitControlPairs;
begin
FControlPairs :=
[
TPair<TComboBox, TLabel>.Create(ComboBox1, Label1),
TPair<TComboBox, TLabel>.Create(ComboBox2, Label2),
TPair<TComboBox, TLabel>.Create(ComboBox3, Label3)
]
end;
You need to add the controls to this array manually. That's the downside of this approach. But you only need to do this once, right here. Then everything else can be done automagically.
Now, this is where it gets really nice: Let all your comboboxes share this OnChange handler:
procedure TForm1.ComboBoxChanged(Sender: TObject);
var
i: Integer;
begin
for i := 0 to High(FControlPairs) do
if FControlPairs[i].Key = Sender then
FControlPairs[i].Value.Caption := FControlPairs[i].Key.Text;
end;
Option 2
Forget about any private fields. Now instead make sure that each pair has a unique Tag. So the first combo box and label both have Tag = 1, the second pair has Tag = 2, and so on. Then you can do simply
procedure TForm1.ComboBoxChanged(Sender: TObject);
var
TargetTag: Integer;
CB: TComboBox;
i: Integer;
begin
if Sender is TComboBox then
begin
CB := TComboBox(Sender);
TargetTag := CB.Tag;
for i := 0 to ControlCount - 1 do
if (Controls[i].Tag = TargetTag) and (Controls[i] is TLabel) then
begin
TLabel(Controls[i]).Caption := CB.Text;
Break;
end;
end;
end;
as the shared combo-box event handler. The downside here is that you must be sure that you control the Tag properties of all your controls on the form (at least with the same parent as your labels). Also, they must all have the same parent control.

Delphi - how to address a tool in after running the program

I want to know if there is a way to address a tool which I put in my form after the program is executed? For example:
Suppose there are 100 label components in a form and you put an edit box in your form and ask the user to enter a number in the edit. When the number is written in the edit, the label with the same number will change the font colour.
But you cannot code it before running the program and need sth like this:
Label[strtoint(edit1.text)].color:=clblue;
But as you know this code does not work. What should I write to do what I want?
Yes, you can do something like you demonstrate, you just need to store the form’s controls into some type of array or list.
Sorry, I currently do not have access to my Delphi IDE, but I think I can give you an overview to what you need to do. I will also provide a link that better demonstrate the concept.
Here are the steps:
First ensure your controls have a consistent naming format that includes an index number in the name.
Example: Label1, Label2, . . . .
Next you need to store the controls into some type of an array or TList.
Example:
Var
ControlList : TList
. . . .
ControlList := TList.Create;
. . . .
{ Load the controls into the list after they been created }
ControlList.Add (Label1)
ControlList.Add (Label2)
ControlList.Add (Label3)
Here an alternatives to adding the Labels to the list manually.
for I := 1 to 3 do
begin
ControlList.Add(TLabel(FindComponent('Label'+IntToStr(I)));
end;
Now designate some event handler where you will put the code to update the label. This handler routine will first convert the user inputted value to an integer. Them use that value as an index to the control array. Once you have the label designated to be updated, set whatever properties you like.
idx := StrToInt(InputBox.Text);
lbl := TLabel( ControlList[idx])
. . . .
lbl.Color := clBlue;
Check out this link Control Arrays in Delphi for a more detailed description.
-- Update --
Although my previous answer would work, Remy Lebeau comment give me an idea to a better approach. You do not need to store the controls in an array or list, just use the Findcomponent() command to locate the control. Below are two examples demonstrating this concept.
Example using an Edit box OnKeyPress event:
procedure TForm1.Edit1KeyPress(Sender: TObject; var Key: Char);
var
LabelControl : TLabel;
begin
if ord(Key) = VK_RETURN then
begin
LabelControl := TLabel(FindComponent('Label'+Edit1.Text));
if (LabelControl <> nil) then
LabelControl.Color := clblue;
Key := #0; // prevent continue processing of the WM_CHAR message
end;
end;
Another example using a Button's OnClick event:
procedure TForm1.Button1Click(Sender: TObject);
var
LabelControl : TLabel;
begin
LabelControl := TLabel(FindComponent('Label'+Edit1.Text));
if (LabelControl <> nil) then
begin
LabelControl.Color := clBlue;
end;
end;
Things to note about the code:
In the first example, for the label to be updated, the user must press the enter key after inputting the desired label number.
In the second example, the user must press a button after entering
the number of the label to be updated.
In In both examples, invalid responses are ignored.
As I understand you right, all the Labels already contain a number in their caption.
Then, you could use the Controls array, that already exists in TForm, which contains all controls that belong to the form:
type
TForm1 = class(TForm)
Label1: TLabel;
Label2: TLabel;
Label3: TLabel;
Label4: TLabel;
// ...
Edit1: TEdit;
procedure Edit1Change(Sender: TObject);
private
public
end;
// ...
{ uses
System.RegularExpressions;
}
// ...
procedure TForm1.Edit1Change(Sender: TObject);
{
// if aLabel.Name instead of aLabel.Caption
// will work for Label1, Label2, Label3, Label4 ...
function TryNameToInt(AName: string; var ANumber: Integer): boolean;
var
aRegEx: TRegEx;
aMatch: TMatch;
aStr: string;
begin
aStr := '';
ANumber := -1;
aRegEx:= TRegEx.Create('[A-Za-z_]+([0-9]+)');
aMatch:= aRegEx.Match(AName);
if aMatch.Success then begin
aStr := aMatch.Groups.Item[1].Value;
end;
Result := TryStrToInt(aStr, ANumber);
end;}
var
aControl: TControl;
aLabel: TLabel;
aNumberEdit: Integer;
aNumberLabel: Integer;
aIdx: Integer;
begin
if TryStrToInt(Edit1.Text, aNumberEdit) then begin
for aIdx := 0 to ControlCount - 1 do begin // Controls is the list of all Controls in the form, ControlCount is the length of this list
aControl := Controls[aIdx];
if aControl is TLabel then begin // this gets only TLabel controls
aLabel := TLabel(aControl);
if TryStrToInt(aLabel.Caption, aNumberLabel)
{or TryNameToInt(aLabel.Name, aNumberLabel)} then begin
if aNumberLabel = aNumberEdit then begin
aLabel.Font.Color := clBlue;
end
else begin
aLabel.Font.Color := clWindowText; // if needed
end;
end;
end;
end;
end;
end;
You can use FindComponent function to do that:
Here I dropped a TButton and TEdit on form, you type the Label number you want to change the font color in Edit and then press the Button. Write this code in OnClick event for the Button:
Var
mColor: TColor;
mLabel: Tlabel;
begin
mColor := clGreen;
mLabel := FindComponent('Label' + Edit1.Text) as TLabel;
if mLabel <> nil then
mLabel.Font.Color := mColor;
end;
or if you don't want to press the Button and want it as you type in Edit, you have to write the code in OnChange event for Edit.

Get TextSettings.Font.Style property with GetObjectProp using Delphi Tokyo 10.2

I'm using Delphi's GetObjectProp function to get the properties of the form components, I get all the properties of several components, but I can not get the TextSettings.Font.Style (Bold, Italic, ...) property of components like TLabel for example. I need to know if the component text is bold or italic. The procedure I am working on trying to get these properties follows below:
procedure Tfrm1.aoClicarComponente(Sender: TObject);
var
TextSettings: TTextSettings;
Fonte: TFont;
Estilo: TFontStyle;
Componente_cc: TControl;
begin
Componente_cc := TControl(Label1);
if IsPublishedProp(Componente_cc, 'TextSettings') then
begin
TextSettings := GetObjectProp(Componente_cc, 'TextSettings') as TTextSettings;
if Assigned(TextSettings) then
Fonte := GetObjectProp(TextSettings, 'Font') as TFont;
if Assigned(Fonte) then
Estilo := GetObjectProp(Fonte, 'Style') as TFontStyle; // <-- error in this line
if Assigned(Estilo) then
Edit1.text := GetPropValue(Estilo, 'fsBold', true);
end
end;
The error displayed on the line where I marked above is.
[dcc64 Error] uPrincipal.pas(1350): E2015 Operator not applicable to this operand type
What am I doing wrong?
GetObjectProp(Fonte, 'Style') will not work since Style is not an object-based property to begin with, it is a Set-based property. And GetPropValue(Estilo, 'fsBold', true) is just plain wrong (not that you would get far enough to call it anyway), because fsBold is not a property, it is a member of the TFontStyle enum. To retreive the Style property value, you would have to use GetOrdProp(Fonte, 'Style'), GetSetProp(Fonte, 'Style'), or GetPropValue(Fonte, 'Style') instead (as an integer, string, or variant, respectively).
That being said, once you have retrieved the TextSettings object, you don't need to use RTTI at all to access its Font.Style property, just access the property directly.
Try this instead:
procedure Tfrm1.aoClicarComponente(Sender: TObject);
var
Componente_cc: TControl;
TextSettings: TTextSettings;
begin
Componente_cc := ...;
if IsPublishedProp(Componente_cc, 'TextSettings') then
begin
TextSettings := GetObjectProp(Componente_cc, 'TextSettings') as TTextSettings;
Edit1.Text := BoolToStr(TFontStyle.fsBold in TextSettings.Font.Style, true);
end;
end;
A better (and preferred) solution is to not use RTTI at all. FMX classes that have a TextSettings property also implement the ITextSettings interface for exactly this situation, eg:
procedure Tfrm1.aoClicarComponente(Sender: TObject);
var
Componente_cc: TControl;
Settings: ITextSettings;
begin
Componente_cc := ...;
if Supports(Componente_cc, ITextSettings, Settings) then
begin
Edit1.Text := BoolToStr(TFontStyle.fsBold in Settings.TextSettings.Font.Style, true);
end;
end;
Read Embarcadero's documentation for more details:
Setting Text Parameters in FireMonkey

Refer to an object instance and free it

If I create multiple TButton objects with this routine:
procedure CreateButton;
begin
Btn := TButton.Create(nil);
end;
Then, how can I refer to a specific object instance to free it using another method like:
procedure FreeButton;
begin
Btn[0].Free; //???
end;
Of course, this does not compile, but I think the question is clear: How do I declare Btn? And how do I free multiple instances?
It doesn't make much sense to create a TButton anywhere that isn't part of a form (which your code does).
With that being said, in order to refer to it later to free it, you need to store a reference to it somewhere.
Since you're referring to "multiple buttons" and using array code in your delete routine, I think you're probably wanting to track an array of buttons. Here's an example of doing just that:
type
TForm1 = class(TForm)
procedure FormCreate(Sender: TObject); // Add via Object Inspector Events tab
private
{ Private declarations }
// Add these yourself
BtnArray: array of TButton;
procedure CreateButtons(const NumBtns: Integer);
procedure DeleteBtn(BtnToDel: TButton);
procedure BtnClicked(Sender: TObject);
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
procedure TForm1.DeleteBtn(BtnToDel: TButton);
var
i: Integer;
begin
// Check each button in the array to see if it's BtnToDel. If so,
// remove it and set the array entry to nil so it can't be deleted
// again.
for i := Low(BtnArray) to High(BtnArray) do
begin
if BtnArray[i] = BtnToDel then
begin
FreeAndNil(BtnArray[i]);
Break;
end;
end;
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
// Create 10 buttons on the form
CreateButtons(10);
end;
// Called when each button is clicked. Assigned in CreateButtons() below
procedure TForm1.BtnClicked(Sender: TObject);
begin
// Delete the button clicked
if (Sender is TButton) then
DeleteBtn(TButton(Sender));
end;
procedure TForm1.CreateButtons(const NumBtns: Integer);
var
i: Integer;
begin
// Allocate storage for the indicated number of buttons
SetLength(BtnArray, NumBtns);
// For each available array item
for i := Low(BtnArray) to High(BtnArray) do
begin
BtnArray[i] := TButton.Create(nil); // Create a button
BtnArray[i].Parent := Self; // Tell it where to display
BtnArray[i].Top := i * (BtnArray[i].Height + 2); // Set the top edge so they show
BtnArray[i].Name := Format('BtnArray%d', [i]); // Give it a name (not needed)
BtnArray[i].Caption := Format('Btn %d', [i]); // Set a caption for it
BtnArray[i].OnClick := BtnClicked; // Assign the OnClick event
end;
end;
If you put this code in a new blank VCL forms application and run it, you'll see 10 buttons ('Btn 0throughBtn 9`) on a form. Clicking on a button will remove it from the form (and the array).

Delphi. Remove a border of TabSheet of PageControl

Is it possible to remove a border of TabSheet (~4px)? I am using PageControl as a switch-panel instead of frames, windows etc. I want everything will be straight.
unit Unit1;
interface
uses
...,
CommCtrl;
type
TPageControl = class(ComCtrls.TPageControl)
private
procedure TCMAdjustRect(var Msg: TMessage); message TCM_ADJUSTRECT;
end;
TForm1 = class(TForm)
...
end;
...
procedure TPageControl.TCMAdjustRect(var Msg: TMessage);
begin
inherited;
if Msg.WParam = 0 then
InflateRect(PRect(Msg.LParam)^, 4, 4)
else
InflateRect(PRect(Msg.LParam)^, -4, -4);
end;
...
end.
If you don't mind using third-party tools then the easiest solution would probably be to use TjvPageControl from JVCL. It has ClientBorderWidth property which you are looking for.
An alternative is to use a TTabSet with a TPageControl: In the onCreate event of the form, place this code to hide the tab.
procedure TMainForm.FormCreate(Sender: TObject);
var
I : Integer;
begin
for I := 0 to Pred(PageControl1.PageCount) do
PageControl1.Pages[I].TabVisible := False;
PageControl1.Style := tsFlatButtons;
PageControl1.ActivePageIndex := 0;
TabSet1.Style := tsModernPopout;
TabSet1.SelectedColor := clMoneyGreen;
TabSet1.UnselectedColor := clGradientActiveCaption;
TabSet1.SelectedColor := clGradientActiveCaption;
end;
procedure TMainForm.TabSet1Change(Sender: TObject; NewTab: Integer;
var AllowChange: Boolean);
begin
PageControl1.ActivePageIndex := NewTab;
end;
nowadays, that is the answer. No need any code hacks Probably you use themes, if not, you should use that technology:
Project Options > Application> Appearance
Check on one of them as Default Style) than :
Tools > Bitmap Style Designer > Open Style
Navigate your vsf style file
(probably right here
"C:\Users\Public\Documents\Embarcadero\Studio[VERSION]\Styles
Now In Bitmap Style Designer.. navigate to:
Objects > Tabs > Frame > Bitmap
Click [...] three dot button of Bitmap In Inspector
Zoom to 800%
Pan/Scroll and Focus on to bitmap rectangle range.
Right Mouse Click to change Upper-Left, Left Mouse Click to change Lower-Right
region.
(so select inner rectangle to eliminate border bitmap
now you have borderless page controls)

Resources