There is MDI-application which contains main form fMain and children forms- fChartAcc and fReal.
Main form is maximized and client area of main form is limited in screen sizes.
When children forms is opened, in client area of main form I can't see bottom part of children forms and appear horizontal scroll bars on childen forms. I want fully paste child form in client area of main form, in screen sizes and, accordingly, in main form sizes without need in horizontal scroll bar.
child form at design time
child form when app is run
Main form
Main form: Formstyle:MDIForm
Childred forms:
Formstyle:MDIChild
Align- alClient or alCustom
Position-tried poDefaultPosOnly, poDefault, poDesigned
autoSize:false
tried settings of size of chilled forms place in procedures OnCreate, OnShow, OnResize but no success.
Main form: Formstyle:MDIForm
Childred forms:
Formstyle:MDIChild
Align- alClient or alCustom
Position-tried poDefaultPosOnly, poDefault, poDesigned
autoSize:false
tried settings of size of chilled forms place in procedures OnCreate,
OnShow, OnResize but no success.
unit Umain;
procedure TFmain.MDIChildCreated(const childHandle : THandle);
begin
mdiChildrenTabs.Tabs.AddObject(TForm(FindControl(childHandle)).Caption, TObject(childHandle));
mdiChildrenTabs.TabIndex := -1 + mdiChildrenTabs.Tabs.Count;
end;
procedure TFmain.MDIChildDestroyed(const childHandle : THandle);
var
idx: Integer;
begin
idx := mdiChildrenTabs.Tabs.IndexOfObject(TObject(childHandle));
mdiChildrenTabs.Tabs.Delete(idx);
end;
procedure TFmain.NChartAccClick(Sender: TObject);
begin
application.CreateForm(TfChartAcc, fChartAcc);
fChartAcc.Show;
end;
procedure TFmain.realisatia1Click(Sender: TObject);
begin
application.CreateForm(TFgas, Fgas);
Fgas.Show;
end;
end.
unit UChartAcc;
procedure TfChartAcc.FormClose(Sender: TObject; var Action: TCloseAction);
begin
action:=caFree;
end;
procedure TfChartAcc.FormCreate(Sender: TObject);
begin
Left:=0;
Top:=Fmain.Toolbar.Height+Fmain.MDIChildrentabs.height;
Height:=Fmain.ClientHeight-Fmain.Toolbar.Height-Fmain.MDIChildrentabs.height-Fmain.StatusBar.Height-2*GetSystemMetrics(SM_CXEDGE);
Width:=Fmain.ClientWidth- 2*GetSystemMetrics(SM_CXEDGE);
FMain.MDIChildCreated(self.Handle);
end;
procedure TfChartAcc.FormDestroy(Sender: TObject);
begin
FMain.MDIChildDestroyed(self.Handle);
end;
procedure TfChartAcc.FormResize(Sender: TObject);
begin
{
Left:=0;
Top:=Fmain.Toolbar.Height+Fmain.MDIChildrentabs.height;
Height:=Fmain.ClientHeight-Fmain.Toolbar.Height-Fmain.MDIChildrentabs.height-Fmain.StatusBar.Height-2*GetSystemMetrics(SM_CXEDGE);
Width:=Fmain.ClientWidth- 2*GetSystemMetrics(SM_CXEDGE);
}
end;
procedure TfChartAcc.FormShow(Sender: TObject);
begin
Left:=0;
Top:=Fmain.Toolbar.Height+Fmain.MDIChildrentabs.height;
Height:=Fmain.ClientHeight-Fmain.Toolbar.Height-Fmain.MDIChildrentabs.height-Fmain.StatusBar.Height-2*GetSystemMetrics(SM_CXEDGE);
Width:=Fmain.ClientWidth- 2*GetSystemMetrics(SM_CXEDGE);
end;
end.
Project 1
To get current ClientRect of a MDI main form you can use WinApi.Windows.GetClientRect() function like this (adapted to your uChartAcc unit):
Add a new procedure to the FChartAcc form, e.g. MyAdjustSize. I changed the name, because AdjustSize() is a virtual method of TWinControl:
procedure TFChartAcc.MyAdjustSize;
var
r: TRect;
begin
if not WinApi.Windows.GetClientRect(FMain.ClientHandle, r) then
RaiseLastOSError;
BoundsRect := r;
end;
The window referred to by ClientHandle already excludes menu bars, tool bars etc. that are aligned to the sides of the form, so no need for further calculations.
Replace previously suggested code from TFChartAcc.FormCreate, with a call to MyAdjustSize:
procedure TFChartAcc.FormCreate(Sender: TObject);
begin
MyAdjustSize;
FMain.MDIChildCreated(self.Handle);
end;
Then in the main form add an event handler for the OnResize event as follows. The purpose is to call the MyAdjustSize procedure for all currently existing child forms:
procedure TFMain.FormResize(Sender: TObject);
var
ix: integer;
ob: TWinControl;
begin
for ix := 0 to MDIChildrenTabs.Tabs.Count-1 do
begin
ob := FindControl(THandle(MDIChildrenTabs.Tabs.Objects[ix]));
if ob is TFChartAcc then
TFChartAcc(ob).MyAdjustSize;
end;
end;
Because all child windows are already sized correctly, we don't need to call MyAdjust when selecting another child form.
procedure TFMain.mdiChildrenTabsClick(Sender: TObject);
var
ix: integer;
ob: TWinControl;
begin
ix := MDIChildrenTabs.TabIndex;
if ix > -1 then
begin
ob := FindControl(THandle(MDIChildrenTabs.Tabs.Objects[ix]));
ob.BringToFront;
end;
end;
Related
I created an application that goes out and scans every computer and populates a TreeView with Hardware, Software and updates/hotfixes information:
The problem I’m having is with printing, how do you automatically expand the treeview and sends the results of the selected computer to the printer? The method I am currently using involves sending the contents to a canvas (BMP) and then send it to the printer but that does not capture the whole treeview only whatever is being displayed on the screen. Any advice? Thank you so much.
The problem with printing the TTreeView is that the part that isn't visible has nothing to be drawn. (Windows draws only the visible portion of the control, so when you use PrintTo or the API PrintWindow function, it only has the visible nodes available to print - the non-displayed content hasn't yet been drawn and therefore can't be printed.)
If a tabular layout works (no lines, just indented levels), the easiest way is to create text and put it in a hidden TRichEdit, and then let the TRichEdit.Print handle the output. Here's an example:
// File->New->VCL Forms Application, then
// Drop a TTreeView and a TButton on the form.
// Add the following for the FormCreate (to create the treeview content)
// and button click handlers, and the following procedure to create
// the text content:
procedure TreeToText(const Tree: TTreeView; const RichEdit: TRichEdit);
var
Node: TTreeNode;
Indent: Integer;
Padding: string;
const
LevelIndent = 4;
begin
RichEdit.Clear;
Node := Tree.Items.GetFirstNode;
while Node <> nil do
begin
Padding := StringOfChar(#32, Node.Level * LevelIndent);
RichEdit.Lines.Add(Padding + Node.Text);
Node := Node.GetNext;
end;
end;
procedure TForm1.Button1Click(Sender: TObject);
var
HideForm: TForm;
HideEdit: TRichEdit;
begin
HideForm := TForm.Create(nil);
try
HideEdit := TRichEdit.Create(HideForm);
HideEdit.Parent := HideForm;
TreeToText(TreeView1, HideEdit);
HideEdit.Print('Printed TreeView Text');
finally
HideForm.Free;
end;
end;
procedure TForm3.FormCreate(Sender: TObject);
var
i, j: Integer;
RootNode, ChildNode: TTreeNode;
begin
RootNode := TreeView1.Items.AddChild(nil, 'Root');
for i := 1 to 6 do
begin
ChildNode := TreeView1.Items.AddChild(RootNode, Format('Root node %d', [i]));
for j := 1 to 4 do
TreeView1.Items.AddChild(ChildNode, Format('Child node %d', [j]));
end;
end;
I have a program with n ComboBoxes and n Labels and I want to update the corresponding Label depending on the selection from the adjacent ComboBox i.e ComboBox2 would update Label2.
I am using the same event handler for every ComboBox and currently checking if Combobox1 or Combobox2 has fired the event handler. Is there a way to use the ItemIndex of the ComboBox passed to the procedure, such as Sender.ItemIndex? This is not currently an option and gives the error 'TObject' does not contain a member named 'ItemIndex'.
procedure TForm2.ComboBoxChange(Sender: TObject);
begin
if Sender = ComboBox1 then
Label1.Caption := ComboBox1.Items.Strings[ComboBox1.ItemIndex]
else
Label2.Caption := ComboBox2.Items.Strings[ComboBox2.ItemIndex];
end;
This code has the desired behavior but is obviously not scale-able.
Every component has a Tag property inherited from TComponent, where the Tag is a pointer-sized integer. As such, you can store each TLabel pointer directly in the corresponding TComboBox.Tag, eg:
procedure TForm2.FormCreate(Sender: TObject);
begin
ComboBox1.Tag := NativeInt(Label1);
ComboBox2.Tag := NativeInt(Label2);
end;
This way, ComboBoxChange() can then directly access the TLabel of the changed TComboBox, eg:
procedure TForm2.ComboBoxChange(Sender: TObject);
var
CB: TComboBox;
begin
CB := TComboBox(Sender);
if CB.Tag <> 0 then
TLabel(CB.Tag).Caption := CB.Items.Strings[CB.ItemIndex];
end;
Option 1
This is the most robust one.
Let your form have private members
private
FControlPairs: TArray<TPair<TComboBox, TLabel>>;
procedure InitControlPairs;
and call InitControlPairs when the form is created (either in its constructor, or in its OnCreate handler):
procedure TForm1.InitControlPairs;
begin
FControlPairs :=
[
TPair<TComboBox, TLabel>.Create(ComboBox1, Label1),
TPair<TComboBox, TLabel>.Create(ComboBox2, Label2),
TPair<TComboBox, TLabel>.Create(ComboBox3, Label3)
]
end;
You need to add the controls to this array manually. That's the downside of this approach. But you only need to do this once, right here. Then everything else can be done automagically.
Now, this is where it gets really nice: Let all your comboboxes share this OnChange handler:
procedure TForm1.ComboBoxChanged(Sender: TObject);
var
i: Integer;
begin
for i := 0 to High(FControlPairs) do
if FControlPairs[i].Key = Sender then
FControlPairs[i].Value.Caption := FControlPairs[i].Key.Text;
end;
Option 2
Forget about any private fields. Now instead make sure that each pair has a unique Tag. So the first combo box and label both have Tag = 1, the second pair has Tag = 2, and so on. Then you can do simply
procedure TForm1.ComboBoxChanged(Sender: TObject);
var
TargetTag: Integer;
CB: TComboBox;
i: Integer;
begin
if Sender is TComboBox then
begin
CB := TComboBox(Sender);
TargetTag := CB.Tag;
for i := 0 to ControlCount - 1 do
if (Controls[i].Tag = TargetTag) and (Controls[i] is TLabel) then
begin
TLabel(Controls[i]).Caption := CB.Text;
Break;
end;
end;
end;
as the shared combo-box event handler. The downside here is that you must be sure that you control the Tag properties of all your controls on the form (at least with the same parent as your labels). Also, they must all have the same parent control.
At design time, I create a TScrollBox which will be the parent of TLayouts created at runtime.
The Layouts will also contain Tlabels and Tedits like this:
var
Layout1: TLayout;
Label1: TLabel;
Edit1: TEdit;
begin
Layout1 := TLayout.Create(self);
Layout1.Parent := ScrollBox1;
Label1 := TLabel.Create(self);
Label1.Parent := Layout1;
Label1.Text := 'abc';
end;
Now I want to delete everything out like this procedure has never been called.
I have tried the following, but the program would just crash.
var
i : integer;
Item : TControl;
begin
for i := 0 to Scrollbox1.ControlCount - 1 do
begin
Item := Scrollbox1.controls[i];
Item.Free;
end;
end;
Can anyone please give me a hint?
When you remove a control, the index of the ones behind it in the control list shifts down. I.e, you end up trying to access positions that do not exist.
You need to iterate the list downwards:
var
i : integer;
Item : TControl;
begin
for i := (Scrollbox1.ControlCount - 1) downto 0 do
begin
Item := Scrollbox1.controls[i];
Item.Free;
end;
end;
Another way is to stay always at index 0, free its control and check that you still have controls to free:
var
i : integer;
Item : TControl;
begin
while Scrollbox1.ControlCount > 0 do
begin
Item := Scrollbox1.controls[0];
Item.Free;
end;
end;
UPDATE
As #DavidHeffernan pointed out, there is nested parentage here. This means you should free your components from bottom up. One way to do it is by recursion.
Basically you would need a procedure to encapsulate the freeing of child controls. The code would be similar to following (please note this is just a small test I did and extra code may be required):
procedure freeChildControls(myControl : TControl; freeThisControl: boolean);
var
i : integer;
Item : TControl;
begin
if Assigned(myControl) then
begin
for i := (myControl.ControlsCount - 1) downto 0 do
begin
Item := myControl.controls[i];
if assigned(item) then
freeChildControls(item, childShouldBeRemoved(item));
end;
if freeThisControl then
FreeAndNil(myControl);
end;
end;
function childShouldBeRemoved(child: TControl): boolean;
begin
//consider whatever conditions you need
//in my test I just checked for the child's name to be layout1 or label1
Result := ...;
end;
In order to free the scrollbox1 child controls (but not itself) you would call it like this:
freeChildControls(scrollbox1, false);
Please note that I had to add the childShouldBeRemoved function in order to avoid this recursive function to free child controls of the label and layout that you should leave for their destructors to free.
One possible solution to implement this function would be to use an object list where you would add your created components, and then inside the function check if the passed child component has to be freed.
If you create components at runtime - use parent control as parameter of the constructor. Like Label1 := TLabel.Create(Layout1); - so that the parent is also the owner. When you destroy Layout1 the Label1 also will be destroyed.
I have a problem with error message "Invalid Floating Point operation." The popup menu is a design time control and it is named NavPop. It has no menu items assigned. It is assigned as popupmenu for Panel1.
I then create the menu items dynamically from a listbox, and assign the caption and on click events. Everything works 100% in terms of what I am trying to accomplish. Ie it works.
Only when i close the program, do I get
Invalid floating point operation
or otherwise:
Access Violation Address 000007355. Read of Addrss 0000007355.
Please note that everything works perfectly, except that the error when I close the program. I would appreciate any help.
// I declare the Array of TMenuItems
private
{ Private declarations }
ItemArray : array of TMenuItem;
...
procedure TMainForm.Button1Click(Sender: TObject);
begin
CreateNavPop;
end;
// Create the menu items from listbox(Navlist) items and Link them
// to events on a navigation bar.
procedure TMainForm.CreateNavPop;
var
I: Integer;
NavIndex: Integer;
begin
SetLength(ItemArray, NavList.Items.Count);
NavIndex:=0;
For I:=0 to NavList.Items.Count-1 do
begin
NavIndex:=NavBar1.Items.ItemByCaption(NavList.Items.Strings[i]).Index;
ItemArray[i]:=TMenuItem.create(Nil);
ItemArray[i].Caption:=NavList.Items.Strings[i];
ItemArray[i].OnClick:=NavBar1.Items.Items[Navindex].OnClick;
NavPop.Items.Add(ItemArray[i]);
end;
end;
// Call the Items free on program close
procedure TMainForm.FormClose(Sender: TObject; var Action: TCloseAction);
begin
FreeItems(ItemArray);
end;
// Free Dynamically created Menu Items on Form Close
procedure TMainForm.FreeItems(MItems : array of TMenuItem);
var
cnt : integer;
begin
for cnt := High(MItems) downto Low(MItems) do
begin
MItems[cnt].Free;
MItems[cnt] := nil;
end;
end;
This happens because the TPopupMenu already free the items, and you are freeing it again.
This code causes an "Invalid pointer operation":
procedure TForm1.FormCreate(Sender: TObject);
var
I: Integer;
begin
for I := 0 to 3 do
PopupMenu1.Items.Add(TMenuItem.Create(nil));
end;
destructor TForm1.Destroy;
var
I: Integer;
begin
for I := 3 downto 0 do
PopupMenu1.Items.Free;
inherited;
end;
The Items property is a TMenuItem instance, and if you look at it's destructor, it already free all the items you added.
destructor TMenuItem.Destroy;
begin
...
while Count > 0 do Items[0].Free;
...
Keeping it short, you don't need to do it again in the FreeItems method.
I tested with ReportMemoryLeaksOnShutdown := True and no memory leaks occur.
So I have a TMenuItem attached to a TAction on a TPopupMenu for a TDBGrid (actually 3rd party, but you get the idea). Based on the selected row in the grid, the TAction is enabled or disabled. What I want is to be able to display a hint to the user explaining why the item is disabled.
As far as why I want a hint on a disabled menu item, lets just say I am in agreement with Joel.
All TMenuItem's have a hint property, but as best I can tell they are only used the the TApplicationEvent.OnHint event handler to stick the hint in a TStatusBar or some other special processing. I found an article on how to create your own even window for a TMainMenu's TMenuItems, but it doesn't work on a TPopupMenu's TMenuItem. It works by handling the WM_MENUSELECT message, which as far as I can tell is not sent on a TPopupMenu.
WM_MENUSELECT is indeed handled for menu items in popup menus also, but not by the windows proc of the form containing the (popup) menu, but by an invisible helper window created by Menus.PopupList. Luckily you can (at least under Delphi 5) get at this HWND via Menus.PopupList.Window.
Now you can use the old-fashioned way to subclass a window, as described for example in this CodeGear article, to handle WM_MENUSELECT also for popup menus. The HWND will be valid from after the first TPopupMenu is created to before the last TPopupMenu object is destroyed.
A quick test with the demo app in the linked article in the question should reveal whether this is going to work.
Edit: It does indeed work. I changed the linked example to show hints also for the popup menu. Here are the steps:
Add a handler for OnDestroy, a member variable for the old window proc and a method for the new window proc to the form:
TForm1 = class(TForm)
...
procedure FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject);
procedure ApplicationEvents1Hint(Sender: TObject);
private
miHint : TMenuItemHint;
fOldWndProc: TFarProc;
procedure WMMenuSelect(var Msg: TWMMenuSelect); message WM_MENUSELECT;
procedure PopupListWndProc(var AMsg: TMessage);
end;
Change the OnCreate handler of the form to subclass the hidden PopupList window, and implement the proper restoration of the window proc in the OnDestroy handler:
procedure TForm1.FormCreate(Sender: TObject);
var
NewWndProc: TFarProc;
begin
miHint := TMenuItemHint.Create(self);
NewWndProc := MakeObjectInstance(PopupListWndProc);
fOldWndProc := TFarProc(SetWindowLong(Menus.PopupList.Window, GWL_WNDPROC,
integer(NewWndProc)));
end;
procedure TForm1.FormDestroy(Sender: TObject);
var
NewWndProc: TFarProc;
begin
NewWndProc := TFarProc(SetWindowLong(Menus.PopupList.Window, GWL_WNDPROC,
integer(fOldWndProc)));
FreeObjectInstance(NewWndProc);
end;
Implement the subclassed window proc:
procedure TForm1.PopupListWndProc(var AMsg: TMessage);
function FindItemForCommand(APopupMenu: TPopupMenu;
const AMenuMsg: TWMMenuSelect): TMenuItem;
var
SubMenu: HMENU;
begin
Assert(APopupMenu <> nil);
// menuitem
Result := APopupMenu.FindItem(AMenuMsg.IDItem, fkCommand);
if Result = nil then begin
// submenu
SubMenu := GetSubMenu(AMenuMsg.Menu, AMenuMsg.IDItem);
if SubMenu <> 0 then
Result := APopupMenu.FindItem(SubMenu, fkHandle);
end;
end;
var
Msg: TWMMenuSelect;
menuItem: TMenuItem;
MenuIndex: integer;
begin
AMsg.Result := CallWindowProc(fOldWndProc, Menus.PopupList.Window,
AMsg.Msg, AMsg.WParam, AMsg.LParam);
if AMsg.Msg = WM_MENUSELECT then begin
menuItem := nil;
Msg := TWMMenuSelect(AMsg);
if (Msg.MenuFlag <> $FFFF) or (Msg.IDItem <> 0) then begin
for MenuIndex := 0 to PopupList.Count - 1 do begin
menuItem := FindItemForCommand(PopupList.Items[MenuIndex], Msg);
if menuItem <> nil then
break;
end;
end;
miHint.DoActivateHint(menuItem);
end;
end;
This is done for all popup menus in a loop, until the first matching item or submenu is found.
Not sure if it helps, but I have created my own multi-line hint window (for Delphi7) to be able to show more then just one line of text.
It's open source and you can find it here.
There is some work involved showing it on the right location on the screen, but you have full control over it.