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;
Related
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
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.
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...
I am using Delphi, and I want to show custom text in the buttons of a MessageDlg, as described here. What is the best way to do that?
Answering my own question.... I wrote the below unit which works well for me.
Delphi provides CreateMessageDialog() to give you a dialog template, which you can modify before displaying. I used that to create a function I called MessageDlgCustom, which takes the same parameters as a standard MessageDlg, but adds one more for replacement button titles.
It correctly handles custom fonts and automatically adjusts buttons to be wide enough for their message. If the buttons overflow the dialog, then that gets adjusted too.
After using that unit, the below sample works:
case MessageDlgCustom('Save your changes?',mtConfirmation,
[mbYes,mbNo,mbCancel],
['&Yes, I would like to save them with this absurdly long button',
'&No, I do not care about my stupid changes',
'&Arg! What are you talking about? Do not close the form!'],
nil) //nil = no custom font
of
mrYes:
begin
SaveChanges;
CloseTheForm;
end; //mrYes (save & close)
mrNo:
begin
CloseForm;
end; //mrNo (close w/o saving)
mrCancel:
begin
//do nothing
end; //mrCancel (neither save nor close)
end; //case
If someone else knows a better way, please share it.
unit CustomDialog;
interface
uses
Dialogs, Forms, Graphics, StdCtrls;
function MessageDlgCustom(const Msg: string; DlgType: TMsgDlgType;
Buttons: TMsgDlgButtons; ToCaptions: array of string;
customFont: TFont) : integer;
procedure ModifyDialog(var frm: TForm; ToCaptions : array of string;
customFont : TFont = nil);
implementation
uses
Windows, SysUtils;
function GetTextWidth(s: string; fnt: TFont; HWND: THandle): integer;
var
canvas: TCanvas;
begin
canvas := TCanvas.Create;
try
canvas.Handle := GetWindowDC(HWND);
canvas.Font := fnt;
Result := canvas.TextWidth(s);
finally
ReleaseDC(HWND,canvas.Handle);
FreeAndNil(canvas);
end; //try-finally
end;
function MessageDlgCustom(const Msg: string;
DlgType: TMsgDlgType; Buttons: TMsgDlgButtons; ToCaptions: array of string;
customFont: TFont): integer;
var
dialog : TForm;
begin
try
dialog := CreateMessageDialog(Msg, DlgType, Buttons);
dialog.Position := poScreenCenter;
ModifyDialog(dialog,ToCaptions,customFont);
Result := dialog.ShowModal;
finally
dialog.Release;
end; //try-finally
end;
procedure ModifyDialog(var frm: TForm; ToCaptions: array of string;
customFont: TFont);
const
c_BtnMargin = 10; //margin of button around caption text
var
i,oldButtonWidth,newButtonWidth,btnCnt : integer;
begin
oldButtonWidth := 0;
newButtonWidth := 0;
btnCnt := 0;
for i := 0 to frm.ComponentCount - 1 do begin
//if they asked for a custom font, assign it here
if customFont <> nil then begin
if frm.Components[i] is TLabel then begin
TLabel(frm.Components[i]).Font := customFont;
end;
if frm.Components[i] is TButton then begin
TButton(frm.Components[i]).Font := customFont;
end;
end;
if frm.Components[i] is TButton then begin
//check buttons for a match with a "from" (default) string
//if found, replace with a "to" (custom) string
Inc(btnCnt);
//record the button width *before* we changed the caption
oldButtonWidth := oldButtonWidth + TButton(frm.Components[i]).Width;
//if a custom caption has been provided use that instead,
//or just leave the default caption if the custom caption is empty
if ToCaptions[btnCnt - 1]<>'' then
TButton(frm.Components[i]).Caption := ToCaptions[btnCnt - 1];
//auto-size the button for the new caption
TButton(frm.Components[i]).Width :=
GetTextWidth(TButton(frm.Components[i]).Caption,
TButton(frm.Components[i]).Font,frm.Handle) + c_BtnMargin;
//the first button can stay where it is.
//all other buttons need to slide over to the right of the one b4.
if (1 < btnCnt) and (0 < i) then begin
TButton(frm.Components[i]).Left :=
TButton(frm.Components[i-1]).Left +
TButton(frm.Components[i-1]).Width + c_BtnMargin;
end;
//record the button width *after* changing the caption
newButtonWidth := newButtonWidth + TButton(frm.Components[i]).Width;
end; //if TButton
end; //for i
//whatever we changed the buttons by, widen / shrink the form accordingly
frm.Width := Round(frm.Width + (newButtonWidth - oldButtonWidth) +
(c_BtnMargin * btnCnt));
end;
end.
As an alternative you can use the Open Source SynTaskDialog unit. SynTaskDialog uses the Windows TaskDialog API natively on newer Windows versions and emulates it on older versions. You even can use it with FireMonkey.
For an example of a customizable MessageDlg function have a look at this answer.
You may have a look at the TDam component available on GitHub (https://github.com/digao-dalpiaz/Dam).
This component allows you to create customized Message Dialogs with pre-defined buttons, using formatted text (HTML Text), and allowing to customize a lot of aspects of dialogs.
Besides that, you can manage all your app dialogs into a "container", which stores all dialogs as objects (TDamMsg).
TDam Message Example
TDamMsg properties allows to customize message dialog, like:
Button1 - button 1 caption
Button2 - button 2 caption
Button3 - button 3 caption
Buttons: TDamMsgButtons = Defines the buttons in the message dialog:
dbOK: Defines one button OK
dbYesNo: Defines two buttons Yes/No
dbOne: Defines one button by Button1 defined caption
dbTwo: Defines two buttons by Button1 and Button2 defined captions
dbThree: Defines three buttons by Button1, Button2 and Button3 defined captions
Also, make sure that your 3rd party controls also
call your custom message dlg and not standard
MessageDlg function. That is if they're actually
using it. It is possible that 3rd party controls
do not use the Delphi messagedlg and call the
MessageBox API directly. If that's case, you might
end up with inconsistencies in showing message
boxes.
I have been using code similar to this
MessageDlg('', mtWarning, [mbOK], 0);
throughout my project, (thanks to the GExperts Message Dialog tool :) ) and i was wondering if anyone knows of a way do override the call and show my own custom Form.
The only way i can think to do it its make a New Form with something like
function MessageDlg(const Msg: string; DlgType: TMsgDlgType;
Buttons: TMsgDlgButtons; HelpCtx: Longint): Integer;
begin
//show my own code here
end;
and put it each of my uses lists before the Dialogs unit but is there a guaranteed way to make sure it uses my code not the Dialogs unit Code.
I don't like the idea of copying the dialogs unit to a local dir and making changes to it.
Or is this all to much work and should i just use my own function call and replace all the MessageDlg with my own. (which would not be fun, ive prob used MessageDlg too much)
BTW, you want to add it after the Dialogs unit in your uses clause.
You have three choices in my opinion:
Add your own unit after the Dialogs unit that has a method called MessageDlg and has the same signature to create your own form.
Or create a whole new method, or set of methods, that creates specific dialogs using your own form.
Do a global Search & Replace for MessageDlg with DarkAxi0mMessageDlg and then add your DarkAxi0mDialogs unit to your uses clause.
The first one is problematic because you might miss a unit and still get the old MessageDlg. The second one takes a lot more use, but provides better flexibility in the long run. The third one is probably the easiest and with the least downsides. Make sure you backup before doing the replace, and then use a diff tool (like Beyond Compare) to check your changes.
I would recommend you to encapsulate the MessageDlg inside of you own procedures, this way if you change your procedures all your Message dialogs will be changed and you keep a standard.
Example: Create some procedures like, Alert(), Error(), Warning(), etc. If you ever need to change your error message looks, you need to do it only in one place.
Someday you might want to add a picture to your error messages, alerts... whatever, who knows?
You can use a tool like TextPad to search/replace all instances of a string across folders and subfolders. So, I would suggest that you replace "MessageDlg(" with "MyMessageDlg(" so that you can customize it at will. Should take all of 5 minutes.
I think it would cause you problems to create a replacement and leave it named as it is currently in conflict with the VCL.
You can hijack the MessageDlg function and make it point to your own MyMessageDlg function (with same signature) but I think it would the least safe of all the solutions.
A bad hack in lieu of clean code IMO.
Save the original opcodes of MessageDlg (asm generated by the compiler)
Put a hard jump to your MyMessageDlg code
...then any call to MessageDlg will actually execute YOUR code ...
Restore the original code to MessageDlg
MessageDlg now behaves as usual
It works but should be reserved for desperate situations...
i made a MessageDlgEx function based on MessageDlg and dropped it into one of my "library" files so all my apps can use it. my function allows you to specify default & cancel buttons, give button texts, etc. it'd be a bad practice to modify/replace the built-in function. i still use the built-in function but keep this function on hand for situations where a little more is needed.
FYI--the function returns the number of the button pressed. the first button is 1. pressing Close causes a return value of 0. the buttons have no glyphs.
i have been using this for about 5 years & it's served me well.
function MessageDlgEx(Caption, Msg: string; AType: TMsgDlgType;
AButtons: array of string;
DefBtn, CanBtn: Integer; iWidth:integer=450;bCourier:boolean=false): Word;
const
icMin=50;
icButtonHeight=25;
icInterspace=10;
icButtonResultStart=100;
icFirstButtonReturnValue=1;
var
I, iButtonWidth, iAllButtonsWidth,
iIconWidth,iIconHeight:Integer;
LabelText:String;
Frm: TForm;
Lbl: TLabel;
Btn: TBitBtn;
Glyph: TImage;
FIcon: TIcon;
Rect:TRect;
Caption_ca:Array[0..2000] of Char;
begin
{ Create the form.}
Frm := TForm.Create(Application);
Frm.BorderStyle := bsDialog;
Frm.BorderIcons := [biSystemMenu];
Frm.FormStyle := fsStayOnTop;
Frm.Height := 185;
Frm.Width := iWidth;
Frm.Position := poScreenCenter;
Frm.Caption := Caption;
Frm.Font.Name:='MS Sans Serif';
Frm.Font.Style:=[];
Frm.Scaled:=false;
if ResIDs[AType] <> nil then
begin
Glyph := TImage.Create(Frm);
Glyph.Name := 'Image';
Glyph.Parent := Frm;
FIcon := TIcon.Create;
try
FIcon.Handle := LoadIcon(HInstance, ResIDs[AType]);
iIconWidth:=FIcon.Width;
iIconHeight:=FIcon.Height;
Glyph.Picture.Graphic := FIcon;
Glyph.BoundsRect := Bounds(icInterspace, icInterspace, FIcon.Width, FIcon.Height);
finally
FIcon.Free;
end;
end
else
begin
iIconWidth:=0;
iIconHeight:=0;
end;
{ Loop through buttons to determine the longest caption. }
iButtonWidth := 0;
for I := 0 to High(AButtons) do
iButtonWidth := Max(iButtonWidth, frm.Canvas.TextWidth(AButtons[I]));
{ Add padding for the button's caption}
iButtonWidth := iButtonWidth + 18;
{assert a minimum button width}
If iButtonWidth<icMin Then
iButtonWidth:=icMin;
{ Determine space required for all buttons}
iAllButtonsWidth := iButtonWidth * (High(AButtons) + 1);
{ Each button has padding on each side}
iAllButtonsWidth := iAllButtonsWidth +icInterspace*High(AButtons);
{ The form has to be at least as wide as the buttons with space on each side}
if iAllButtonsWidth+icInterspace*2 > Frm.Width then
Frm.Width := iAllButtonsWidth+icInterspace*2;
if Length(Msg)>sizeof(Caption_ca) then
SetLength(Msg,sizeof(Caption_ca));
{ Create the message control}
Lbl := TLabel.Create(Frm);
Lbl.AutoSize := False;
Lbl.Left := icInterspace*2+iIconWidth;
Lbl.Top := icInterspace;
Lbl.Height := 200;
Lbl.Width := Frm.ClientWidth - icInterspace*3-iIconWidth;
Lbl.WordWrap := True;
Lbl.Caption := Msg;
Lbl.Parent := Frm;
if bCourier then
lbl.Font.Name:='Courier New';
Rect := Lbl.ClientRect;
LabelText:=Lbl.Caption;
StrPCopy(Caption_ca, LabelText);
Lbl.Height:=DrawText(Lbl.Canvas.Handle,
Caption_ca,
Length(LabelText),
Rect,
DT_CalcRect or DT_ExpandTabs or DT_WordBreak Or DT_Left);
If Lbl.Height<iIconHeight Then
Lbl.Height:=iIconHeight;
{ Adjust the form's height accomodating the message, padding and the buttons}
Frm.ClientHeight := Lbl.Height + 3*icInterspace + icButtonHeight;
{ Create the pusbuttons}
for I := 0 to High(AButtons) do
begin
Btn := TBitBtn.Create(Frm);
Btn.Height := icButtonHeight;
Btn.Width := iButtonWidth;
Btn.Left:=((Frm.Width-iAllButtonsWidth) Div 2)+I*(iButtonWidth+icInterspace);
Btn.Top := Frm.ClientHeight - Btn.height-icInterspace;
Btn.Caption := AButtons[I];
Btn.ModalResult := I + icButtonResultStart + icFirstButtonReturnValue;
Btn.Parent := Frm;
If I=DefBtn-1 Then
Begin
Frm.ActiveControl:=Btn;
Btn.Default:=True;
End
Else
Btn.Default:=False;
If I=CanBtn-1 Then
Btn.Cancel:=True
Else
Btn.Cancel:=False;
end;
Application.BringToFront;
Result := Frm.ShowModal;
{trap and convert user Close into mrNone}
If Result=mrCancel Then
Result:=mrNone
Else
If Result>icButtonResultStart Then
Result:=Result - icButtonResultStart
Else
Exception.Create('Unknown MessageDlgEx result');
Frm.Free;
end;