Stop TCustomHint from centering itself around my point - delphi

I'm trying to use TCustomHint to show a message to my user that fades in and out nicely, to not be too distracting. However when I call ShowHint on my object with a point, the hint box appears to center itself around the point I give. What I would like is to have my box appear such that its top-left coordinate is the point given.
Here's the code I'm using so show the hint:
procedure ShowNotification(ATitle: UnicodeString; AMsg: UnicodeString);
var
Box: TCustomHint;
P: TPoint;
begin
Box := TCustomHint.Create(MyForm);
Box.Title := ATitle;
Box.Description := AMsg;
Box.Delay := 0;
Box.HideAfter := 5000;
Box.Style := bhsStandard;
P.X := 0;
P.Y := 0;
Box.ShowHint(P);
end;
I know that my point's X/Y coordinates are not relative to the form, and that's not the issue.
I've traced through what happens when I call ShowHint and it appears that if I can somehow control the final width of the underlying TCustomHintWindow inside of TCustomHint.ShowHint(Rect: TRect) then I may be in business.
So my question is: is there an obvious way to stop a TCustomHint from centering itself at my point? Or will I have to go through the process of inheriting, overriding the draw method, etc etc? I hope I'm just missing something simple.

There's no particularly easy way to do what you want. The TCustomHint class is designed to serve a very specific purpose. It was designed to be used by the TControl.CustomHint property. You can see how it is called by looking at the code for TCustomHint.ShowHint. The pertinent excerpts are:
if Control.CustomHint = Self then
begin
....
GetCursorPos(Pos);
end
else
Pos := Control.ClientToScreen(Point(Control.Width div 2, Control.Height));
ShowHint(Pos);
So, either the control is shown centred horizontally around the current cursor position, or centred horizontally around the middle of the associated control.
I think the bottom line here is that TCustomHint is not designed to be used the way you are using it.
Anyway, there is a rather gruesome way to make your code do what you want. You can create a temporary TCustomHintWindow that you never show and use it to work out the width of the hint window that you want to show. And then use that to shift the point that you pass to the real hint window. In order to make it fly you need to crack the private members of TCustomHintWindow.
type
TCustomHintWindowCracker = class helper for TCustomHintWindow
private
procedure SetTitleDescription(const Title, Description: string);
end;
procedure TCustomHintWindowCracker.SetTitleDescription(const Title, Description: string);
begin
Self.FTitle := Title;
Self.FDescription := Description;
end;
procedure ShowNotification(ATitle: UnicodeString; AMsg: UnicodeString);
var
Box: TCustomHint;
SizingWindow: TCustomHintWindow;
P: TPoint;
begin
Box := TCustomHint.Create(Form5);
Box.Title := ATitle;
Box.Description := AMsg;
Box.Delay := 0;
Box.HideAfter := 5000;
Box.Style := bhsStandard;
P := Point(0, 0);
SizingWindow := TCustomHintWindow.Create(nil);
try
SizingWindow.HintParent := Box;
SizingWindow.HandleNeeded;
SizingWindow.SetTitleDescription(ATitle, AMsg);
SizingWindow.AutoSize;
inc(P.X, SizingWindow.Width div 2);
finally
SizingWindow.Free;
end;
Box.ShowHint(P);
end;
This does what you asked, but honestly, it makes me feel rather queasy.

Related

How i can assign differents tags to various objects at runtime in Delphi

How i can to assign differents tags to various objects (e.j: TCircle) of the same type at runtime?
Lets me explain that: I want to create various Circles at runtime and to assign to each one of them a different tag and then with on click event to show the Circle that i clicked.
This is a fragment of my code:
procedure
TPhotoX.FormCreate(Sender:
TObject);
var
FilesN: String;
S: TBitmap;
Cir: TCircle;
begin
FlowLayout1.DeleteChildren;
GetFP:= TDirectory.GetFiles(GetPathIma, '*jpg', TSearchOption.soTopDirectoryOnly);
for FilesN in GetFP do
VertScrollBox1.BeginUpdate;
Cir.TCircle.Create(Self);
Cir.Parent:= FlowLayOut1;
Cir.Fill.Bitmap.WrapMode:=TWrapMode.TileOriginal;
Cir.Fill.Kind:= TBrushkind.Bitmap;
Cir.Height:= 85;
Cir.Width:= 85;
//...more circle's properties next including the Circle's Tag property that i ignore to implement
// Sorry i'm Delphi's Beginner but Delphi's power believer too!!! :-)
Cir.OnClick: CirClick;
try
S.TBitmap.Create;
FlowLayout1.AddObject(Cir);
S.LoadThumbnailsFromFile(FilesN, 150, 150);
Cir.Fill.Bitmap.Bitmap:=S;
Cir.Repaint;
VertScrollBox1.EndUpdate;
finally
S.Free;
end;
end;
//in the code above, how i can to assign differents tags for each circle for referencing later with this handler:
procedure TPhotoX.CirClick(Sender:TObject);
begin
case TCircle(Sender).Tag of
1: //event to show the image
inside the circle
2: // event to show another
image inside the circle
end;
end;
end;
I appreciate any kind of help... Thanks you
As pointed out in comments, there are several mistakes in your code. You are not creating the TBitmap and TCircle objects correctly. You are not adequately protecting resources. And your for loop lacks a required begin/end block to contain your loop logic.
And, to answer your question, since you are using a for..in loop, if you want to assign index-based Tag values then you need to use a separate variable to keep track of the current index as you iterate through the collection.
Try something more like this:
procedure TPhotoX.FormCreate(Sender: TObject);
var
FilesN: String;
S: TBitmap;
Cir: TCircle;
I: Integer;
begin
FlowLayout1.DeleteChildren;
GetFP := TDirectory.GetFiles(GetPathIma, '*jpg', TSearchOption.soTopDirectoryOnly);
if GetFP <> nil then Exit;
VertScrollBox1.BeginUpdate;
try
I := 1;
for FilesN in GetFP do
begin
Cir := TCircle.Create(Self);
try
Cir.Parent := FlowLayOut1;
Cir.Fill.Bitmap.WrapMode := TWrapMode.TileOriginal;
Cir.Fill.Kind := TBrushkind.Bitmap;
Cir.Height := 85;
Cir.Width := 85;
Cir.Tag := I; // <-- or whatever you need
Inc(I);
Cir.OnClick := CirClick;
S := TBitmap.Create;
try
S.LoadThumbnailsFromFile(FilesN, 150, 150);
Cir.Fill.Bitmap.Bitmap := S;
finally
S.Free;
end;
FlowLayout1.AddObject(Cir);
except
Cir.Free;
raise;
end;
//Cir.Repaint;
end;
finally
VertScrollBox1.EndUpdate;
end;
end;
procedure TPhotoX.CirClick(Sender: TObject);
begin
case TCircle(Sender).Tag of
1: // event to show the image inside the circle
2: // event to show another image inside the circle
end;
end;

Canvas.textout doesn´t show text after a new series is made visible

So what i'm doing is display the x and y values of the mouse pointer on a teechart chart using the following code, inside the onmousemove event:
oscilografia.Repaint;
if ((x>236) and (x<927)) and ((y>42) and (y<424)) then
begin
oscilografia.Canvas.Brush.Style := bsSolid;
oscilografia.Canvas.Pen.Color := clBlack;
oscilografia.Canvas.Brush.Color := clWhite;
oscilografia.Canvas.TextOut(x+10,y,datetimetostr(oscilografia.Series[0].XScreenToValue(x))+','+FormatFloat('#0.00',oscilografia.series[0].YScreenToValue(y)));
edit1.Text:=inttostr(x)+' '+inttostr(y);
end;
The code works fine, but a problem happens when i make another series visible by selecting it on the legend: the text inside the box created by canvas.textout isn´t shown anymore.
The box is still there following the mouse, but without any text. So i would like a solution to this.
The basic problem is down to how painting works. Windows do not have persistent drawing surfaces. What you paint onto a window will be overwritten the next time the system needs to repaint it.
You need to arrange that all painting is in response to WM_PAINT messages. In Delphi terms that typically means that you would put your painting code in an overridden Paint method.
So the basic process goes like this:
Derive a sub-class of the chart control and in that class override Paint. Call the inherited Paint method and then execute your code to display the desired text.
In your OnMouseMove event handler, if you detect that the mouse coordinates text needs to be updated, call Invalidate on the chart.
The call to Invalidate will mark that window as being dirty and when the next paint cycle occurs, your code in Paint will be executed.
What is more, when anything else occurs that forces a paint cycle, for instance other modifications to the chart, your paint code will execute again.
Note, as an alternative to sub-classing, you can probably use the TChart event OnAfterDraw. But I'm not an expert on TChart, so am not sure. The main points though are as I state above.
From a comment you wrote, I see you followed this example.
Note it doesn't draw any rectangle; it only draws text, so I'm not sure to understand what box is following your mouse.
Also note the example calls Invalidate, as David Heffernan suggested in his answer.
Find below a modified version of the same example, painting a rectangle before the text.
procedure TForm1.FormCreate(Sender: TObject);
begin
Series1.FillSampleValues(10);
Chart1.View3D := False;
end;
procedure TForm1.Chart1MouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
var tmpL,tmpL2,ClickedValue : Integer;
tmpWidth, tmpHeight: Integer;
tmpText: string;
begin
clickedvalue := -1;
tmpL2:= -1;
With Chart1 do
begin
If (Series1.Clicked(X, Y) <> -1) And (not OnSeriesPoint) Then
begin
Canvas.Brush.Style := bsSolid;
Canvas.Pen.Color := clBlack;
Canvas.Brush.Color := clWhite;
tmpText:=FormatFloat('#.00',Series1.XScreenToValue(x))+','+FormatFloat('#.00',Series1.YScreenToValue(y));
tmpWidth:=Canvas.TextWidth(tmpText)+10;
tmpHeight:=Canvas.TextHeight(tmpText);
Canvas.Rectangle(x+5, y, x+tmpWidth, y+tmpHeight);
Canvas.TextOut(x+10,y,tmpText);
OnSeriesPoint := True;
ClickedValue:= Series1.Clicked(x,y);
End;
//Repaint Chart to clear Textoutputted Mark
If (ClickedValue=-1) And (OnSeriesPoint) Then
begin
OnSeriesPoint := False;
Invalidate;
End;
tmpL := Chart1.Legend.Clicked(X, Y);
If (tmpL <> -1) And ((tmpL <> tmpL2) Or (not OnLegendPoint)) Then
begin
repaint;
Canvas.Brush.Color := Series1.LegendItemColor(tmpL);
Canvas.Rectangle( X, Y, X + 20, Y + 20);
Canvas.Brush.Color := clWhite;
Canvas.TextOut(x+15,y+7,FormatFloat('#.00',Series1.XValues.Items[Series1.LegendToValueIndex(tmpl)]));
tmpL2 := tmpL;
OnLegendPoint := True;
End;
If (tmpL2 = -1) And (OnLegendPoint) Then
begin
OnLegendPoint := False;
Invalidate;
End;
End;
End;

Dynamic TForm creation Idiosyncrasies(bugs?) in Delphi XE5

This one is driving me up a wall. Most of the conversion from Delphi 6 to XE5 is proceeding smoothly, but I have various routines to dynamically build various TForm descendents (NO DFM), pop it up and generally return a value. I have a number of them that work fine in D6. Generally, I choose a place I want to pop something up (like over a panel), and what I want to popup (editbox, memo, listbox...). I create the form, set initial values and call showmodal and return some result.
The same code, compiled in XE5 has execution (glitches). One is that the created form accepts left,top and such, but does NOT display itself there. The values are correctly in the properties, but the form is in the wrong place. A second, probably related (glitch) is that when I create a TMemo or TListbox and store some text in it, "ShowModal" displays the data properly, but "Show" does not.
It has taken me several hours to digest the problem down to its simplest form, removing virtual all of my personal code. AS SHOWN HERE, IT WORKS PERFECTLY
If I comment out this line, it does not work - the form is displayed in the wrong place
XX.ClientToScreen(Point(0,0)); // EXTREMELY WEIRD PATCH
This line is a function call which OUGHT NOT affect anything else, and I don't use the returned value.
The commented out "Show" line demonstrates the other problem (data not being displayed).
I have tried Application.ProcessMessages in all sorts of places, but it never makes things better, and at times make things worse.
Color me "puzzled".
//-----------------------------------------------------------------------------------------
//-----------------------------------------------------------------------------------------
type TMemoForm = class(TForm)
private
public
XMemo : TMemo;
end;
Function PopUpMemoStr(txt : AnsiString; x : integer = 200; y : integer = 200; w : integer = 400 ; h : integer = 400 ) : AnsiString; // more or less a dummy for testing on XE5 2/28/14
var XX : TMemoForm;
begin
XX := TMemoForm.CreateNew(Application);
XX.ClientToScreen(Point(0,0)); // *** EXTREMELY WEIRD FIX ***
XX.Left := X; XX.Top := Y; XX.Width := w; XX.height := h;
XX.caption := 'Dummy PopUpMemo';
XX.XMemo := TMemo.create(XX);
XX.XMemo.parent := XX;
XX.XMemo.align := alClient;
XX.XMemo.text := txt;
//logit('PopUpMemoStr R='+TRectToStr(MyGetScreenRect(XX)));
XX.showmodal;
//XX.show; delay(3.00); // other "no data" problem
XX.free;
end;
//exercise code -- Panel2 is just a visible spot to see if positioning works correctly
var s : AnsiString;
var R : TRect;
begin
//R := MyGetScreenRect(Panel2);
R := Rect(414,514,678,642); // just a useful screen location for testing
s := 'One'+CRLF+'Two'+CRLF+'Three'+CRLF+'Four'; // "CRLF is #13#10
PopUpMemoStr(s,R.Left,R.Top,R.Right-R.Left,R.Bottom-R.Top);
//-----------------------------------------------------------------------------------------
//-----------------------------------------------------------------------------------------
To fix the form positioning problem, you need to set the form's Position to poDesigned.
For your second problem, you can't delay like that. You are not giving the Form a chance to process messages. Changing it to something like the code below displays the data correctly (although you really should not be doing this sort of thing either):
begin
XX := TMemoForm.CreateNew(nil);
try
XX.Position := poDesigned; // This line needs to be added for the positioning
XX.SetBounds(X, Y, w, h);
XX.Caption := 'Dummy PopUpMemo';
XX.XMemo := TMemo.Create(XX);
XX.XMemo.Parent := XX;
XX.XMemo.Align := alClient;
XX.XMemo.Text := txt;
//logit('PopUpMemoStr R='+TRectToStr(MyGetScreenRect(XX)));
// XX.ShowModal;
// This displays the data correctly but is not advisable
XX.Show;
for I := 1 to 6 do
begin
Sleep(500);
Application.ProcessMessages;
end;
finally
XX.Free;
end;
end;
If you want to use Show() for a Form like that, you should use the Form's OnClose event and set its Action parameter to caFree and just do the Show() in your code. Put a timer on the Form for x seconds and Close() it when the timer finishes. A bit like this:
type
TMemoForm = class(TForm)
public
XMemo : TMemo;
XTimer: TTimer;
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure TimerElapsed(Sender: TObject);
end;
procedure TMemoForm.FormClose(Sender: TObject; var Action: TCloseAction);
begin
Action := caFree;
end;
procedure TMemoForm.TimerElapsed(Sender: TObject);
begin
Close;
end;
begin
XX := TMemoForm.CreateNew(nil);
try
XX.Position := poDesigned; // This line needs to be added for the positioning
XX.SetBounds(X, Y, w, h);
XX.Caption := 'Dummy PopUpMemo';
XX.OnClose := XX.FormClose;
XX.XMemo := TMemo.Create(XX);
XX.XMemo.Parent := XX;
XX.XMemo.Align := alClient;
XX.XMemo.Text := txt;
XX.XTimer := TTimer.Create(XX);
XX.XTimer.Interval := 3000;
XX.XTimer.OnTimer := XX.TimerElapsed;
XX.Active := True;
XX.Show; // Just show the form. The rest is in the Form itself.
except
XX.Free;
raise;
end;
end;
Your extremely weird patch, calling ClientToScreen on the newly created form, should fix the issue as it does, even if you don't use the point that's returned.
In the case when you don't use it, when you set your form's bounds, since the window of the form has not yet been created, the VCL keeps this information to be later passed to the API when the window is about to be shown. But this information will be discarded since VCL also tells the API to use default window position because of the poDefaultPosOnly setting of Position property.
In the case when you use it, to be able to determine the position of the form in the screen the VCL first creates the window of the form. Hence when you later set the bounds of the form, they are actually implemented through SetWindowPos.
As such, if you've used
XX.HandleNeeded;
instead of
XX.ClientToScreen(Point(0,0));
it would be a more direct workaround.
Of course the correct solution is in Graymatter's answer.
I cannot comment on Show not displaying data, the code you posted in the question should not exhibit that kind of behavior.

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.

Can you override MessageDlg calls to a Custom TForm/Dialog?

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;

Resources