Focus TEdit on a Dynamically loaded Embedded Form Firemonkey - delphi

I have a application which load plugins that are in the form of bpls. Each plugin contains a form to be embedded into another package called CoreInf (form name ManageF) which is just the base gui of the application that contains a TTabcontrol known as MTabcontrol1. Here basically what happens
A list of plugins are dynamically loaded at runtime in sequential order to layout the interface. It loads the plugins based on the interface IPluginFrame(Shared.bpl) . If it contains the interface it then tries to create a new tab in MTabcontrol1 and embedded the form. What im trying to do is make a dynamically created speedbutton onClick focus a TEdit box on a specific ebedded form but it keeps coming up as access violation errors.
Shared.bpl that contains the interface
unit PluginIntf;
interface
uses
FMX.Types, FMX.Controls;
type
IPluginFrame = interface
['{3B4943DB-951B-411B-8726-03BF1688542F}']
function GetBaseControl: TControl;
end;
implementation
end.
Form and Button that is to be ebedded into the interface
InventoryInf.pas has the form to be embeeded
var
InventoryF: TInventoryF;
implementation
{$R *.fmx}
function TInventoryF.GetBaseControl: TControl;
begin
Result := InvenLayout; //<---- This is a a TLayout which align
//to client this is the parent of every item on form
end;
//Below is the on click event for the TSpeedButton invBtn
//Which looks for the embedded form that is embedded
//in MTabcontrol1 as a TTabitem that has the name InventoryF
procedure TInventoryF.Look4Tabitem(Sender: TObject);
var
o : TTabitem;
s :TEdit;
begin
o := TTabitem(ManageF.MTabcontrol1.FindComponent('InventoryF'));
ManageF.MTabcontrol1.ActiveTab := o;
s := TEdit(ManageF.MTabcontrol1.FindComponent('VendorF').FindComponent('SearchEdit1')); <-- Dont think it actually found the TEdit
s.Setfocus; <------------------ Not focusing giving access violtaion error
with DataConModule1.InventoryQuery do
...
end;
TSpeedButton invBtn that is injected into Panel to the side
unit InjectedInvBtn;
interface
implementation
uses
FMX.Types, InventoryInf, FMX.Controls, FMX.Forms, InjectedControlsHelper, FMX.StdCtrls,
ManageInf;
var
SysBtn: TSpeedButton;
initialization
SysBtn := TInjectedControl<TSpeedButton>.Create;
SysBtn.Align := TAlignLayout.Top;
SysBtn.Name := 'invBtn';
SysBtn.Text := 'INVENTORY';
ManageF.MenuPanel.AddObject(SysBtn);
SysBtn.OnClick := InventoryF.Look4Tabitem;
end.
**ManageF Showing how it loads the forms into tabs MTabControl1 **
uses Shared;
function IsPluginFrameClass(AType: TRttiType; var AFormClass: TCustomFormClass): Boolean;
var
LClass: TClass;
begin
if not (AType is TRttiInstanceType) then Exit(False);
LClass := TRttiInstanceType(AType).MetaclassType;
Result := LClass.InheritsFrom(TCustomForm) and Supports(LClass, IPluginFrame);
if Result then
AFormClass := TCustomFormClass(LClass);
end;
function TSettingsF.LoadPluginTabs(const AFileName: string): HMODULE;
var
Context: TRttiContext;
Frame: TCustomForm;
FrameClass: TCustomFormClass;
LType: TRttiType;
Package: TRttiPackage;
Tab: TTabItem;
// Statusbar: TTabItem;
//Butz: TButton;
begin
Result := LoadPlugin(AFileName);
try
{ Cycle through the RTTI system's packages list to find the one we've just loaded. }
for Package in Context.GetPackages do
if Package.Handle = Result then
begin
{ Cycle through the package's types looking for implementors of the
IPluginFrameinterface defined in the shared package. }
for LType in Package.GetTypes do
if IsPluginFrameClass(LType, FrameClass) then
begin
{ For each frame, create a new tab to host its contents. In the case of
a VCL application, we could require an actual TFrame object, or failing
that, embed the form directly. FireMonkey has neither frames proper nor
supports embedded forms, so instead we ask the implementing form to
nominate a base control that will get embedded. }
Tab := TTabItem.Create(ManageF.MTabcontrol1);
Frame := FrameClass.Create(Tab);
Tab.Text := ' ' + Frame.Caption;
Tab.Name := Frame.Name;
MyTablist.Add(Tab);
(Frame as IPluginFrame).GetBaseControl.Parent := Tab;
{ Associate the tab with the plugin - since it owns the 'frame' form,
and that form owns its own components, freeing the tab will have the
effect of freeing all the actual plugin objects too. }
RegisterPluginComponent(Result, Tab);
ManageF.MTabcontrol1.AddObject(Tab);
Tab.Width := Tab.Canvas.TextWidth(Tab.Text + 'w');
end;
if IsStatusFrameClass(LType, FrameClass) then
begin
....
{ Associate the tab with the plugin - since it owns the 'frame' form,
and that form owns its own components, freeing the tab will have the
effect of freeing all the` actual plugin objects too. }
// RegisterPluginComponent(Result, Statusbar);
// ManageF.StatusMenuPanel1.AddObject(Statusbar);
//Statusbar.Width := Statusbar.Canvas.TextWidth(Statusbar.Name + 'w');
end;
Break;
end;
except
UnloadPlugin(Result);
raise;
end;
end;
Hope i illustrated the problem properly. Please Help =(

Found a work around by looping through the components of the Tcustomform that is embedded. Here is what i did.
instead of TEdit i used a tms edit box TTMSFMXSearchEdit
procedure TVendorF.focuscheck;
var
i: integer;
j: integer;
Fieldname: string;
o : TTabitem;
e : TTMSFMXSearchEdit;
begin
if ManageF.MTabcontrol1.FindComponent('VendorF').Name = 'VendorF' then
begin
o := TTabitem(ManageF.MTabcontrol1.FindComponent('VendorF'));
//ShowMessage(IntToStr(o.ComponentCount)) ;
// ShowMessage((o.Components[0].tostring));
for i := 0 to ManageF.MTabcontrol1.ActiveTab.ComponentCount - 1 do
if (ManageF.MTabcontrol1.ActiveTab.Components[i]) is TCustomForm then
begin
// ShowMessage('TCustomForm Recognized gonna look for child components now');
// ShowMessage(IntToStr(ManageF.MTabcontrol1.ActiveTab.Components[i].ComponentCount));
for j := 0 to ManageF.MTabcontrol1.ActiveTab.Components[i].ComponentCount - 1 do
if (ManageF.MTabcontrol1.ActiveTab.Components[i].Components[j]) is TTMSFMXSearchEdit then
begin
// ShowMessage('Edit box found =)')
if (ManageF.MTabcontrol1.ActiveTab.Components[i].Components[j].Name = 'VenSearchEdit1') then
begin
//ShowMessage('Edit1 box found =)');
//ShowMessage('See if we can focus it');
e := TTMSFMXSearchEdit(ManageF.MTabcontrol1.ActiveTab.Components[i].Components[j]) ;
e.SetFocus;
end;
end;
end;
end;
end;
Its a little sloppy but it works =). If anyone else got a better way let me know

Related

Call Procedure on Separate Unit with Timer

I am trying to write a separate unit for my main form to call, all of my other units are working except for one that uses TTimer.
Basically what the function is supposed to be doing is that the main form uDataReceived calls BlinkRect(Gateway) which is processed in rRectControl unit and the according Rectangle will blink in the main form.
Here are the codes:
unit uRectControl;
interface
uses
System.SysUtils, System.Types, System.UITypes, System.Classes,
System.Variants, System.IOUtils, FMX.Graphics, FMX.Types, FMX.Objects;
var
Blinks: array [0 .. 2] of record Rectangle: TRectangle;
Timer: TTimer;
end;
type
TMyClass = Class(TObject)
private
Timer1: TTimer;
procedure Timer1Timer(Sender: TObject);
public
procedure BlinkRect(Gateway: integer);
end;
procedure AssignRectangles;
implementation
uses uDataReceived;
// Error shows "Cannot resolve unit name 'uDataReceived'
{ TMyClass }
procedure AssignRectangles;
var
i: integer;
begin
Blinks[0].Rectangle := TC_Theft_Detection.rect1;
// Error shows Undeclared Identifier TC_Theft_Detection (which is the name of the main form)
Blinks[0].Timer := nil;
Blinks[1].Rectangle := TC_Theft_Detection.rect2;
Blinks[1].Timer := nil;
Blinks[2].Rectangle := TC_Theft_Detection.rect3;
Blinks[2].Timer := nil;
for i := 0 to 2 do
Blinks[i].Rectangle.Fill.Color := TAlphacolors.blue;
end;
procedure TMyClass.BlinkRect(Gateway: integer);
begin
Blinks[Gateway].Rectangle.Fill.Color := TAlphacolors.Red;
Blinks[Gateway].Rectangle.Fill.Kind := TBrushKind.Solid;
Blinks[Gateway].Rectangle.Stroke.Thickness := 0.3;
Blinks[Gateway].Rectangle.Stroke.Color := TAlphacolors.Black;
if Blinks[Gateway].Timer = nil then
begin
Blinks[Gateway].Timer := TTimer.Create(nil);
Blinks[Gateway].Timer.OnTimer := Timer1Timer;
Blinks[Gateway].Timer.Interval := 500;
Blinks[Gateway].Timer.Tag := Gateway;
Blinks[Gateway].Timer.Enabled := True;
end;
end;
procedure TMyClass.Timer1Timer(Sender: TObject);
var
Timer: TTimer;
begin
Timer := TTimer(Sender);
Blinks[Timer.Tag].Rectangle.Visible := not Blinks[Timer.Tag]
.Rectangle.Visible;
end;
end.
I know there must be something wrong with the unit shown above, and my question is:
How to work with TTimer in a separate unit and how to call the procedure BlinkRect(Gateway) on the main form.
Thanks a lot!!
Your code in uRectControl works provided AssignRectangles is called before you attempt to call BlinkRect. However there are a number of issues to be addressed.
1) Cross dependency of units
The form (uDataReceived) apparently uses uRectControl and that is fine. The way uRectControl is written it needs to use (uses uDataReceived in the implementation) the form and this is not good.
This error is simple to correct, because the AssignRectangles procedure is the only place where the form is referred to. AssignRectangles could just as well be in the form, since the Blinks[] array is global (in the interface of uRectControl) and can therefore be accessed by the form.
2) Global variables
Global variables should be avoided as much as possible. You have defined both the Blinks[] array and the Timer to be global, so you might by mistake access and modify them from anywhere in your program just by adding uRectControl to a uses clause. In future development you might add new forms that have indicators you want to blink and add TRectangles to the Blinks[] array possibly overwriting value that are already there and you end up in a mess. I will address this issue in my suggestion below.
3) Hardcoded entities
In Proof Of Concept code it is acceptable (or not) to hardcode constants, sizes of arrays etc. but not in production code. Just think about all changes you need to do just to add one more blinking rectangle to the form. Dynamical arrays or better TList and its derivatives etc. comes to rescue here. You have also limited yourself to only TRectangles. What if you would like to have circular indicators in your form?
4) Unsyncronized blinking
It may look cool (not really) when indicators are blinking all over the place, but actually it is just distracting. I guess you tried to change this with the timer in TMyClass, but you still left the individual timers in the Blinks records. I will address this also in my suggestion below.
Here is a suggestion
unit ShapeBlinker;
interface
uses
System.SysUtils, System.UITypes, System.Classes, System.Generics.Collections,
FMX.Graphics, FMX.Types, FMX.Objects;
type
TBlinkState = (bsOff, bsBlinking, bsSteady);
I have a background in Fire Alarm Systems, and it is common to have three states; off, blinking and steady lit. TBlinkState represents these.
Then comes a class that represent indicators in the UI. An indicator can be any TShape derivative like TRectangle, TCircle, TPath etc. Each state can have its own color.
type
[...]
TBlinkingShape = class
private
FShape: TShape;
FState: TBlinkState;
FOffColor: TAlphaColor;
FBlinkColor: TAlphaColor;
FSteadyColor: TAlphaColor;
public
constructor Create(AShape: TShape);
procedure SetBlinkState(NewState: TBlinkState);
end;
The field FShape holds a reference to a TShape derivative. Through this reference we have access to the actual component on the UI form and can change its color. We will see later how the TShape is passed to the constructor.
Then the second class which manages a collection of TBlinkingShape, timing and actual color changes of the indicators on the form.
type
[...]
TShapeBlinker = class
private
FBlinkingShapes: TObjectList<TBlinkingShape>;
FBlinkPhase: integer;
FTimer: TTimer;
public
constructor Create;
destructor Destroy; override;
procedure RegisterShape(Shape: TShape; OffColor, BlinkColor, SteadyColor: TAlphaColor);
procedure UnRegisterShape(Shape: TShape);
procedure BlinkTimer(Sender: TObject);
procedure SetBlinkState(Shape: TShape; NewState: TBlinkState);
function GetBlinkState(Shape: TShape): TBlinkState;
end;
FBlinkingShapes is the object list that holds instances of TBlinkingShapes.
FBlinkPhase syncronizes blinking of the indicators so that all blinking indicators change to the BlinkColor simultaneously. FTimer is common for all indicators.
Procedure RegisterShape is called by the UI when it wants to add an indicator to the list. UnRegister is called when an indicator is to be removed from the list. SetBlinkState is used to change state and GetBlinkState to retrieve the state of an indicator.
The unit is designed to be usable by any number of forms, synchronizing blinking for all of them. This requires that the TShapeBlinker is a singleton. It is therefore created in the initialization section of the unit, and freed in the finalization.
The instance is held by a var in the implementation, thus inaccessible directly from any other unit. Access is provided by a function declared as the last item in the interface of the unit:
function ShapeBlinker: TShapeBlinker;
This effectively prevents a mistake to accidentally call ShapeBlinker.Create.
Instead of commenting on each method I just copy the implementation here:
implementation
var
SShapeBlinker: TShapeBlinker;
function ShapeBlinker: TShapeBlinker;
begin
result := SShapeBlinker;
end;
{ TBlinkingShape }
constructor TBlinkingShape.Create(AShape: TShape);
begin
FShape := AShape;
FState := bsOff;
end;
procedure TBlinkingShape.SetBlinkState(NewState: TBlinkState);
begin
FState := NewState;
case NewState of
bsOff: begin
FShape.Fill.Color := FOffColor;
end;
bsBlinking: begin
FShape.Fill.Color := FBlinkColor;
end;
bsSteady: begin
FShape.Fill.Color := FSteadyColor;
end;
end;
end;
{ TShapeBlinker }
constructor TShapeBlinker.Create;
begin
FBlinkingShapes := TObjectList<TBlinkingShape>.Create;
FTimer := TTimer.Create(nil);
FTimer.OnTimer := BlinkTimer;
FTimer.Interval := 500;
FTimer.Enabled := False;
end;
destructor TShapeBlinker.Destroy;
begin
FTimer.Enabled := False;
FTimer.Free;
FBlinkingShapes.Free;
inherited;
end;
function TShapeBlinker.GetBlinkState(Shape: TShape): TBlinkState;
var
RegShape: TBlinkingShape;
begin
result := bsOff;
for RegShape in FBlinkingShapes do
if Shape = RegShape.FShape then result := RegShape.FState;
end;
procedure TShapeBlinker.SetBlinkState(Shape: TShape; NewState: TBlinkState);
var
RegShape: TBlinkingShape;
begin
for RegShape in FBlinkingShapes do
if Shape = RegShape.FShape then RegShape.SetBlinkState(NewState);
self.FTimer.Enabled := True;
end;
procedure TShapeBlinker.BlinkTimer(Sender: TObject);
var
i: integer;
begin
FTimer.Enabled := False;
FBlinkPhase := (FBlinkPhase + 1) mod 2;
for i := 0 to FBlinkingShapes.Count-1 do
with FBlinkingShapes[i] do
begin
case FState of
bsOff: begin
FShape.Fill.Color := FOffColor;
end;
bsBlinking: begin
if FBlinkPhase = 1 then
FShape.Fill.Color := FOffColor // alt. FSteadyColor
else
FShape.Fill.Color := FBlinkColor;
FTimer.Enabled := True;
end;
bsSteady: begin
FShape.Fill.Color := FSteadyColor;
end;
end;
end;
end;
procedure TShapeBlinker.RegisterShape(Shape: TShape; OffColor, BlinkColor, SteadyColor: TAlphaColor);
begin
with FBlinkingShapes[FBlinkingShapes.Add(TBlinkingShape.Create(Shape))] do
begin
FOffColor := OffColor; //TAlphaColors.Silver;
FBlinkColor := BlinkColor; //TAlphaColors.Red;
FSteadyColor := SteadyColor; //TAlphaColors.Yellow;
end;
end;
procedure TShapeBlinker.UnRegisterShape(Shape: TShape);
var
i: integer;
begin
for i := FBlinkingShapes.Count-1 downto 0 do
if FBlinkingShapes[i].FShape = Shape then
FBlinkingShapes.Delete(i);
end;
initialization
SShapeBlinker := TShapeBlinker.Create;
finalization
SShapeBlinker.Free;
end.
Finally a few words about usage. Consider a form, say TAlarmView, with 2 TRectangle and 1 TCircle.
In FormCreate you might register these for blinking as follows
procedure TAlarmView.FormCreate(Sender: TObject);
begin
ShapeBlinker.RegisterShape(Rect1, TAlphaColors.Silver, TAlphaColors.Red, TAlphaColors.Yellow);
ShapeBlinker.RegisterShape(Circle1, TAlphaColors.Silver, TAlphaColors.Red, TAlphaColors.Yellow);
ShapeBlinker.RegisterShape(Rect3, TAlphaColors.Silver, TAlphaColors.Red, TAlphaColors.Yellow);
end;
and then test them with button clicks like
procedure TAlarmView.Button1Click(Sender: TObject);
begin
case ShapeBlinker.GetBlinkState(Rect1) of
bsOff: ShapeBlinker.SetBlinkState(Rect1, bsBlinking);
bsBlinking: ShapeBlinker.SetBlinkState(Rect1, bsSteady);
else ShapeBlinker.SetBlinkState(Rect1, bsOff);
end;
end;
As you see I just go through the different states for each click.

How refer to a particular instance of twebbrowser? - Delphi

If I create n Tabsheets at runtime and create one Webbrowser inside each tabsheet using a method such as:
procedure createTab;
var crm: TWebbrowser;
var ts: TsTabSheet;
begin
//Instance of tabsheet
ts := TsTabSheet.Create(pageControl);
ts.PageControl := pageControl;
//Instance of webbrowser
crm := TWebbrowser.Create(ts);
crm.Parent := TWinControl(ts);
crm.Align := alClient;
end;
When one of tabsheet instance is active how could I know which webbrowser is inside it? Sample:
procedure navigateToActiveTabsheet(url: string);
begin
//TO DO - How navigate to webbrowser inside active tabsheet?
end;
The Controls property of a windowed control allows you to obtain every child control. Because these children can be any TControl descendent, you'll need to cast to TWebBrowser. Use the as operator to benefit from runtime validity checking of the cast:
procedure navigateToActiveTabsheet(url: string);
var
wb: TWebBrowser;
begin
wb := pageControl.ActivePage.Controls[0] as TWebBrowser;
wb.Navigate(url);
end;
var
WB: TWebBrowser;
WB := TWebBrowser(pageControl.ActivePage.Controls[0]);

How can I refer to a control whose name is determined at runtime?

As a kind of self-study exercise, I've made a form which contains six panels in a 2x3 rectangle and I want them to switch between visible and invisible one after another. I'm trying to do so by using a for loop of some kind. I could of course write something like:
Panel1.Visible := true;
Panel1.Visible := false;
Panel2.Visible := true;
Panel2.Visible := false;
Panel3.Visible := true;
etc. etc.
But this takes quite a lot of typing and is pretty inefficient when I decide I want it to wait for 100ms between each step. For example, I'd then have to edit all the six steps to wait. This is doable for six steps, but maybe another time I want to do it a hundred times! So I'm thinking there must also be a way to use a for loop for this, where a variable varies from 1 to 6 and is used in the object identifier. So it would something like this:
for variable := 1 to 6 do begin
Panel + variable.Visible := true;
Panel + variable.Visible := false;
end;
Now, this obviously doesn't work, but I hope somebody here can tell me if this is in fact possible and if yes, how. Maybe I can use a string as the identifier? My explanation is probably pretty bad because I don't know all the technical terms but I hope the code explains something.
You can loop through the panel's Owner's Components array.
var
i: Integer;
TmpPanel: TPanel;
begin
{ This example loops through all of the components on the form, and toggles the
Visible property of each panel to the value that is opposite of what it has (IOW,
if it's True it's switched to False, if it's False it's switched to True). }
for i := 0 to ComponentCount - 1 do
if Components[i] is TPanel then
begin
TmpPanel := TPanel(Components[i]);
TmpPanel.Visible := not TmpPanel.Visible; // Toggles between true and false
end;
end;
You can also use the FindComponent method, if you want a very specific type of component by name. For instance, if you have the 6 panels, and their names are Panel1, Panel2, and so forth:
var
i: Integer;
TmpPanel: TPanel;
begin
for i := 1 to 6 do
begin
TmpPanel := FindComponent('Panel' + IntToStr(i)) as TPanel;
if TmpPanel <> nil then // We found it
TmpPanel.Visible := not TmpPanel.Visible;
end;
end;
This is a situation where you want to create the controls dynamically at runtime rather than at designtime. Trying to grapple with 6 different variables is just going to be a world of pain. And when you need the grid to be 3x4 rather than 2x3, you'll regret that decision even more.
So, start with a completely blank form. And add, in the code, a two dimensional array of panels:
private
FPanels: array of array of TPanel;
Then, in the form's constructor, or an OnCreate event handler, you can initialise the array by calling a function like this:
procedure TMyForm.InitialisePanels(RowCount, ColCount: Integer);
var
Row, Col: Integer;
aLeft, aTop, aWidth, aHeight: Integer;
Panel: TPanel;
begin
SetLength(FPanels, RowCount, ColCount);
aTop := 0;
for Row := 0 to RowCount-1 do begin
aLeft := 0;
aHeight := (ClientHeight-aTop) div (RowCount-Row);
for Col := 0 to ColCount-1 do begin
Panel := TPanel.Create(Self);
FPanels[Row, Col] := Panel;
Panel.Parent := Self;
aWidth := (ClientWidth-aLeft) div (ColCount-Col);
Panel.SetBounds(aLeft, aTop, aWidth, aHeight);
inc(aLeft, aWidth);
end;
inc(aTop, aHeight);
end;
end;
And now you can refer to your panels using cartesian coordinates rather than a flat one dimensional array. Of course, you can easily enough declare a flat one dimensional array as well if you want.
The key idea is that when you are creating large numbers of control in a structured layout, you are best abandoning the designer and using code (loops and arrays).
Use FindComponent method of TComponent:
for variable := 1 to 6 do begin
pnl := FindComponent('Panel' + IntToStr(variable));
if pnl is TPanel then
begin
TPanel(pnl).Visible := true;
TPanel(pnl).Visible := false;
end;
end;
As others have answered, FindComponent is the way to go.
But if you just want to modify generic properties for the component, such as visible, position etc, it's not necessary to compare to the type.
This will work just as fine:
for i := 1 to 16 do
begin
(FindComponent( 'P' + inttostr(i) ) as TControl).Visible := false;
end;
(NOTE: this is for Delphi 6/ 7, modern versions probably do this in other ways)
Actually my answer
If you use a name convention to name your component like
"Mycomponent" + inttostr(global_int)
you can use it to find it very easily :
function getMyComponent(id:integer) : TComponent;
begin
result := {Owner.}FindConponent('MyComponent'+inttostr(id));
end;
You also can make your generated components to interact each other by using (sender as TComponent).name to know which other component are related to him.
Exemple
Following is an example of what you can do with this :
Imagine a pagecontrol where tabs are an interface you want to have multiple time
(for ex, to describe columns in a file with 1 tab = 1 col, and you want to dynamically add tabs).
For our example, we are naming button and edit this way :
Button : "C_(column_number)_btn"
Edit : "C_(column_number)_edi"
You can actually refer directly to the edit with a buttonclick, linked at runtime by calling findcomponent :
procedure TForm1.ColBtnClick(Sender:TObject);
var nr : string; Edit : TEdit;
begin
// Name of the TButton. C(col)_btn
nr := (Sender as TButton).Name;
// Name of the TEdit C_(column)_edi
nr := copy(nr,1,length(nr)-3)+'edi';
// Get the edit component.
edit := (Form1.Findcomponent(nr) as TEdit);
//play with it
Edit.Enabled := Not Edit.Enabled ;
showmessage(Edit.Text);
Edit.hint := 'this hint have been set by clicking on the button';
//...
end;
Of course, you link this procedure to every generated buttons.
If anyone wants to practice with it, you may want to know how to generate the tabsheet and components, here you go :
procedure Form1.addCol(idcol:integer, owner : TComponent); // Form1 is a great owner imo
var
pan : TPanel; // Will be align client with the new tabsheet
c: TComponent; //used to create components on the pannel
tab : TTabSheet;
begin
try
pan := TPanel.create(owner);
pan.name := format('Panel_%d',[idcol]);
pan.caption := '';
// dynamically create that button
c := TButton.create(Owner);
with c as TButton do
begin
Name := format('C%d_btn',[idcol]);
Parent := pan;
//Top := foo;
//Left := bar;
caption := 'press me';
OnClick := Form1.ColBtnClick; // <<<<<<< link procedure to event
end;
//create a Tedit the same way
c := TEdit.create(Owner);
with c as TEdit do
Name := format('C%d_edi',[idcol]);
Parent := pan;
// other properties
// create the tabsheet and put the panel in
finally
tab := TTabSheet.Create(Parent);
tab.caption := 'Column %d';
tab.PageControl := Pagecontrol1;
pan.Parent := tab;
pan.Align := alClient;
end;
end;
Generating names to get the component is actually a very good way to have a clean code.
Scrolling through parent - child components in order to find the one you want is actually inefficient and becomes hell if there is many component (in my example, if there is 3, 10 or unknown number of TEdit looping child (brother) components will be ugly.
Maybe this example is useless but It may helps someone, someday.

Shift in the right of last item of the menu

Delphi Xe2U4. Main menu items: File, Option, Help (name: HelpMenuItem). 2 buttons. Use StyleManager Xe2 (in project option enabled xe2 themes, and default set 'Metro Blue').
Procedure TForm1.RightMenu; // Shift in the right of last item of the menu
var mii: TMenuItemInfo;MainMenu: hMenu; Buffer: array[0..79] of Char;
begin
MainMenu := Self.Menu.Handle;
mii.cbSize := SizeOf(mii) ;
mii.fMask := MIIM_TYPE;
mii.dwTypeData := Buffer;
mii.cch := SizeOf(Buffer) ;
GetMenuItemInfo(MainMenu, HelpMenuItem.Command, false, mii) ;
mii.fType := mii.fType or MFT_RIGHTJUSTIFY;
SetMenuItemInfo(MainMenu, HelpMenuItem.Command, false, mii) ;
end;
procedure TForm1.Metro1Click(Sender: TObject); // Not Work
begin
TStyleManager.TrySetStyle('Metro Blue'); // or any other
RightMenu;
end;
procedure TForm1.Windows1Click(Sender: TObject); // Work
begin
TStyleManager.TrySetStyle('Windows'); // standart theme
RightMenu;
end;
Why does not work at use theme?
Whether or there is a normal way to shift last point of the menu in the right, whether is not dependent schemes are applied or not?
Unfortunally the vcl style hook of the TMainMenu doesn't implement the code to draw a particular menu item aligned to the right. Also this vcl style hook (TMainMenuBarStyleHook) is embedded in the TFormStyleHook (the vcl style hook for the forms) as a strict private member, so there is not much room for modifications here. Fix this issue will require which you rewrite the a new vcl style hook for the TForms and the TMainMenus. So If you want do this you must copy the TFormStyleHook class from the Vcl.Forms unit to a new unit and then fix the implementation of the TFormStyleHook.TMainMenuBarStyleHook.DrawItem and the TFormStyleHook.TMainMenuBarStyleHook.Paint methods.
Procedure TForm1.RightMenu; // Shift in the right of last item of the menu
var mii: TMenuItemInfo;MainMenu: hMenu; Buffer: array[0..79] of Char;
begin
MainMenu := Self.Menu.Handle;
mii.cbSize := SizeOf(mii) ;
mii.fMask := MIIM_TYPE;
mii.dwTypeData := Buffer;
mii.cch := SizeOf(Buffer) ;
GetMenuItemInfo(MainMenu, HelpMenuItem.Command, false, mii) ;
mii.fType := mii.fType or MFT_RIGHTJUSTIFY;
if SetMenuItemInfo(MainMenu, HelpMenuItem.Command, false, mii) then DrawMenuBar(self.Menu.WindowHandle);
end;

Setting multiple labels to transparent across 1.000 forms?

I skinned my software with Devexpress and I found that the labels were non-transparent causing them to have grey background.
There's just endless forms, so I was wondering whether there was a way to do this task (of setting labels to transparent) automatically.
I did a similar thing earlier, the Devexpress controls on the form had LookAndFeel.NativeStyle = True, I used Grep Search to replace it to False on all dfm forms. In the label's case however, the transparent property is not present.
Thank you.
The global Screen variable keeps track of all forms:
procedure MakeLabelsTransparent(AParent: TWinControl);
var
I: Integer;
begin
with AParent do
for I := 0 to ControlCount - 1 do
if Controls[I] is TLabel then
TLabel(Controls[I]).Transparent := True
else if Controls[I] is TWinControl then
MakeLabelsTransparent(TWinControl(Controls[I]));
end;
procedure TMainForm.ActiveFormChange(Sender: TObject);
begin
with Screen do
if (ActiveCustomForm <> nil) and (ActiveCustomForm.Tag = 0) then
begin
MakeLabelsTransparent(ActiveCustomForm);
ActiveCustomForm.Tag := 1;
end;
end;
procedure TMainForm.FormCreate(Sender: TObject);
begin
Screen.OnActiveFormChange := ActiveFormChange;
end;
And if you have to use the Tag property for a particular form, then omit this check: it wouldn't really get that much slower.
For this type of task, GExperts contains the Set Component Properties tool:
This tool waits in the background
until you compile a project. It then
scans the current project's forms to
check for components with certain
properties and changes those
properties to a defined value. This
tool is useful to deactivate datasets
or database connections before you
compile your applications, but it can
be used for any similar situations as
well. To activate the scanning,
enable the checkbox next to this
expert in the GExperts Configuration
screen.
It can be used to set a property which is not yet in the DFM as well, and only requires one additional entry in the GExpert configuration, and a recompile.
I have just tested it and it works as expected.
At design time, you can just parse all .dfm then add the
Transparent = True
line just after any
object MyLabel : TLabel
line.
At runtime, you may override the TCustomForm.DoCreate and TCustomFrame.Create methods, as such:
type
THookedForm = class(TCustomForm)
procedure HookedDoCreate;
end;
THookedFrame = class(TCustomFrame)
constructor Create(AOwner: TComponent); override;
end;
var
PatchForm, OriginalForm: TPatchEvent;
PatchPositionForm: PPatchEvent = nil;
PatchFrame, OriginalFrame: TPatchEvent;
PatchPositionFrame: PPatchEvent = nil;
procedure PatchCreate;
var ov: cardinal;
begin
// hook TForm:
PatchPositionForm := PPatchEvent(#THookedForm.DoCreate);
OriginalForm := PatchPositionForm^;
PatchForm.Jump := $E9; // Jmp opcode
PatchForm.Offset := PtrInt(#THookedForm.HookedDoCreate)-PtrInt(PatchPositionForm)-5;
if not VirtualProtect(PatchPositionForm, 5, PAGE_EXECUTE_READWRITE, #ov) then
RaiseLastOSError;
PatchPositionForm^ := PatchForm; // enable Hook
// hook TFrame:
PatchPositionFrame := PPatchEvent(#TCustomFrame.Create);
OriginalFrame := PatchPositionFrame^;
PatchFrame.Jump := $E9; // Jmp opcode
PatchFrame.Offset := PtrInt(#THookedFrame.Create)-PtrInt(PatchPositionFrame)-5;
if not VirtualProtect(PatchPositionFrame, 5, PAGE_EXECUTE_READWRITE, #ov) then
RaiseLastOSError;
PatchPositionFrame^ := PatchFrame; // enable Hook
end;
{ THookedForm }
procedure THookedForm.HookedDoCreate;
var i: integer;
begin
// enumerate all labels, then set Transparent := true
for i := 0 to Components.Count-1 do
if Components[i] is TLabel then
TLabel(Components[i]).Transparent := true;
DoCreate; // call initial code
end;
{ THookedFrame }
constructor THookedFrame.Create(AOwner: TComponent);
var i: integer;
begin
// enumerate all labels, then set Transparent := true
for i := 0 to Components.Count-1 do
if Components[i] is TLabel then
TLabel(Components[i]).Transparent := true;
inherited Create(AOwner); // call normal constructor
end;
....
initialization
PatchCreate;
A related tip (I always forget to make use of this handy feature):
Configure the label the way you want to have it;
Select it on the form;
Go to Component/Create component template;
You can then a name for the template:
From then on, the template appears as a new component type in your tool palette, with the settings that you prefer.
(Yeah, I know this doesn't change current labels)
You can set the BackColor property to Color.Transparent.
The following should work: the transparent-property is present in the DFM-file only if the value is not the default. So you can us a Grep-Search to insert the "Transparent=TRUE" just in the next line after the "=TLabel". I have not tried this myself, but it is easy to try...

Resources