Dynamic TForm creation Idiosyncrasies(bugs?) in Delphi XE5 - delphi

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.

Related

XE6 TListView column widths become zero if you read column.width

There is a bug in TListView.
Reading a column's Width can cause the listview to try to get the column width from the underlying Windows LISTVIEW control directly - before the Win32 control's columns have been initialized.
Because the columns have not been initialized, the listview's LVM_GETCOLUMNWIDTH message fails, returning zero. The TListView takes this to mean that the width is zero, and makes all columns zero.
This bug was introduced sometime after Delphi 5.
Steps to reproduce
Add a report style listview with three columns to a form:
Add an OnResize event handler to the listview:
procedure TForm1.ListView1Resize(Sender: TObject);
begin
{
Any column you attempt to read the width of
will **cause** the width to become zero
}
ListView1.Columns[0].Width;
// ListView1.Columns[1].Width;
ListView1.Columns[2].Width;
end;
Run it:
The Bug
The TListColumn code tries to read the column width out of the Windows listview class directly, before the columns have even been added to the Windows listview control
Formatting their code for readability:
function TListColumn.GetWidth: TWidth;
var
IsStreaming: Boolean;
LOwner: TCustomListView;
begin
LOwner := TListColumns(Collection).Owner;
IsStreaming := [csReading, csWriting, csLoading] * LOwner.ComponentState <> [];
if (
(FWidth = 0)
and (LOwner.HandleAllocated or not IsStreaming)
)
or
(
(not AutoSize)
and LOwner.HandleAllocated
and (LOwner.ViewStyle = vsReport)
and (FWidth <> LVSCW_AUTOSIZE)
and (LOwner.ValidHeaderHandle)
) then
begin
FWidth := ListView_GetColumnWidth(LOwner.Handle, FOrderTag);
end;
Result := FWidth;
end;
The problem happens while the form is being constructed during dfm deserialization:
ComCtrls.TListColumn.GetWidth: TWidth;
TForm1.ListView1Resize(Sender: TObject);
Windows.CreateWindowEx(...)
Controls.TWinControl.CreateWindowHandle(const Params: TCreateParams);
Controls.TWinControl.CreateWnd;
ComCtrls.TCustomListView.CreateWnd;
The issue is that TCustomListView.CreatWnd the columns are added sometime after the call to CreateWnd:
procedure TCustomListView.CreateWnd;
begin
inherited CreateWnd; //triggers a call to OnResize, trying to read the column widths
//...
Columns.UpdateCols; //add the columns
//...
end;
The code in TListColumn.GetWidth doesn't realize that the columns have not yet been initialized.
Why doesn't it fail in Delphi 5?
Delphi 5 uses similar TCustomListView construction:
procedure TCustomListView.CreateWnd;
begin
inherited CreateWnd; //triggers a call to OnResize
//...
Columns.UpdateCols;
//...
end;
Except Delphi 5 doesn't try to psyche itself out, and overthink things:
function TListColumn.GetWidth: TWidth;
begin
if FWidth = 0 then
FWidth := ListView_GetColumnWidth(TListColumns(Collection).Owner.Handle, Index);
Result := FWidth;
end;
If we have a width, use it.
The question
Why was TListColumn.GetWidth changed? What bug were they trying to solve? I see they don't comment their code changes, so it's impossible to tell from the VCL source what the rationale was.
More importantly, how do i fix it? I cannot remove the code from OnResize, but i can create a TFixedListView custom control; except i would have to re-write everything from scratch so that it uses a TFixedListViewColumn class.
That's no good.
The most important question: How does Embarcadero fix it? What is code that should be in TListColumn.GetWidth to fix the bug? ComponentState is empty. It seems like they will have to introduce a new variable of:
FAreColumnsInitialized: Boolean;
Or they could put the code back to how it was.
What would you suggest they fix the code to?
Why does it work with themes disabled?
The bug only happens with Visual Styles enabled.
Windows has a WM_PARENTNOTIFY message that "notifies the parent of important events in the life of the control". In the case of the listview, this sends the handle of the header control that the listview uses internally. Delphi then saves this header hwnd:
procedure TCustomListView.WMParentNotify(var Message: TWMParentNotify);
begin
with Message do
if (Event = WM_CREATE) and (FHeaderHandle = 0) then
begin
FHeaderHandle := ChildWnd;
//...
end;
inherited;
end;
With themes disabled, Windows does not send the WM_PARENTNOTIFY message until later in the construction cycle. This means that with themes disabled the TListColumn will fail to meet one of the criteria that allows it to talk to the listview:
if (
(FWidth = 0)
and (LOwner.HandleAllocated or not IsStreaming)
)
or
(
(not AutoSize)
and LOwner.HandleAllocated
and (LOwner.ViewStyle = vsReport)
and (FWidth <> LVSCW_AUTOSIZE)
and (LOwner.ValidHeaderHandle) //<--- invalid
) then
begin
FWidth := ListView_GetColumnWidth(LOwner.Handle, FOrderTag);
end;
But when we use the new version of the Windows listview control, Windows happens to send the WM_PARENTNOTIFY message sooner in the construction:
if (
(FWidth = 0)
and (LOwner.HandleAllocated or not IsStreaming)
)
or
(
(not AutoSize)
and LOwner.HandleAllocated
and (LOwner.ViewStyle = vsReport)
and (FWidth <> LVSCW_AUTOSIZE)
and (LOwner.ValidHeaderHandle) //<--- Valid!
) then
begin
FWidth := ListView_GetColumnWidth(LOwner.Handle, FOrderTag);
end;
Even through the header handle is valid, it does not mean that the columns have been added yet.
The Proposed Fix
It seems like the VCL fix is to use WM_PARENTNOTIY as the correct opportunity to add the columns to the listview:
procedure TCustomListView.WMParentNotify(var Message: TWMParentNotify);
begin
with Message do
if (Event = WM_CREATE) and (FHeaderHandle = 0) then
begin
FHeaderHandle := ChildWnd;
UpdateCols; //20140822 Ian Boyd Fixed QC123456 where the columns aren't usable in time
//...
end;
inherited;
end;
Bonus Chatter
Looking at the Windows 2000 source code, the ListView has some comments that recognize some poor apps exist out there:
lvrept.c
BOOL_PTR NEAR ListView_CreateHeader(LV* plv)
{
...
plv->hwndHdr = CreateWindowEx(0L, c_szHeaderClass, // WC_HEADER,
NULL, dwStyle, 0, 0, 0, 0, plv->ci.hwnd, (HMENU)LVID_HEADER, GetWindowInstance(plv->ci.hwnd), NULL);
if (plv->hwndHdr)
{
NMLVHEADERCREATED nmhc;
nmhc.hwndHdr = plv->hwndHdr;
// some apps blow up if a notify is sent before the control is fully created.
CCSendNotify(&plv->ci, LVN_HEADERCREATED, &nmhc.hdr);
plv->hwndHdr = nmhc.hwndHdr;
}
...
}

Stop TCustomHint from centering itself around my point

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.

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.

How can you get hints for cells in a TStringGrid appearing more smoothly?

I am running Lazarus 0.9.30.
I have a standard TStringGrid on a form and want to show a different hint as I move my mouse pointer over a column title. I am using this code to do this and it sort of works but you often have to click on the cell to get the hint to change, when I actually want it to change as the mouse pointer moves over it. I have all the hints stored in a collection that I search through using the column index as the key.
Is there a way to get more smooth display of hints?
procedure TTmMainForm.SgScoutLinkMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
var
R, C: Integer;
begin
R := 0;
C := 0;
SgScoutLink.MouseToCell(X, Y, C, R);
with SgScoutLink do
begin
if (R = 0) then
if ((C >= 3) and (C <= 20)) then
begin
SgScoutLink.Hint := FManager.ScoutLinkColumnTitles.stGetColumnTitleHint(C-3);
SgScoutLink.ShowHint:= True;
end; {if}
end; {with}
end;
Assign an event handler to the TApplication.OnShowHint or TApplicationEvents.OnShowHint event, or subclass the TStringGrid to intercept the CM_HINTSHOW message. Any one of those will provide you access to a THintInfo record that is used to control the behavior of the hint window. You can customize the coordinates of the THintInfo.CursorRect member as needed. The hint window is reactivated with the latest Hint property text (which can be customized with the THintInfo.HintStr member before it is displayed) whenever the mouse moves outside of that rectangle. The smaller the rectangle, the more often the hint window is reactivated. This feature allows a UI control to have multiple subsections within its client area that display different hint strings while the mouse is moving around that same UI control.
The value of the TApplication.HintShortPause property (or from intercepting the CM_HINTSHOWPAUSE message) controls whether the hint window disappears before reactivating. If you set the pause value to zero, the hint window updates its text immediately without disappearing. If you set the pause value to a non-zero value, the hint window disappears and then reappears after the specified number of milliseconds have elapsed, as long as the mouse remains over the same UI control.
For example:
procedure TTmMainForm.FormCreate(Sender: TObject);
begin
Application.OnShowHint := AppShowHint;
end;
procedure TTmMainForm.FormDestroy(Sender: TObject);
begin
Application.OnShowHint := nil;
end;
procedure TTmMainForm.AppShowHint(var HintStr: String; var CanShow: Boolean; var HintInfo: THintInfo);
var
R, C: Integer;
begin
if HintInfo.HintControl = SgScoutLink then
begin
R := 0;
C := 0;
SgScoutLink.MouseToCell(HintInfo.CursorPos.X, HintInfo.CursorPos.Y, C, R);
if (R = 0) and (C >= 3) and (C <= 20) then
begin
HintInfo.CursorRect := SgScoutLink.CellRect(C, R);
HintInfo.HintStr := FManager.ScoutLinkColumnTitles.stGetColumnTitleHint(C-3);
end;
end;
end;
Edit: I just noticed that you are using Lazarus. What I described is how to handle this issue in Delphi. I have no clue if it also applies to Lazarus or not.
I came to the following solution... have no idea if it works in lazarus but my delphi is ok with it... Write the following pseudo-code for the grid mousemove handler:
if (current_coords==old_coords) then
{showhint=true;hint=use_mousetocell_call_to_create}
else
{showhint=false;hint=''} old_coords=current_coords;

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