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.
Related
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.
Short Version: Is there any way to control or modify LisBox items individually? for example set their Visible property to False separately.
I found a TListBoxItem class in Fire Monkey when I was searching, but I don't want to use Fire Monkey and want it in VCL.
Detailed Version:
I tried to filter my ListBox using two TStringList and an Edit, one StringList is global to keep the original list (list_files_global) and another StringList to help filtering procedure (list_files_filter) and my primary list of files is my ListBox (list_files).
I created my global StringList on onCreate event while program is starting to store my original list:
procedure Tfrm_main.FormCreate(Sender: TObject);
Begin
list_files_global := TStringList.Create;
list_files_global.Assign(list_files.Items);
End;
and used Edit's onChange event for filtering:
procedure Tfrm_main.edit_files_filterChange(Sender: TObject);
Var
list_files_filter: TStringList;
i: Integer;
Begin
list_files_filter := TStringList.Create;
list_files_filter.Assign(list_files.Items);
list_files.Clear;
for i := 0 to list_files_filter.Count - 1 do
if pos(edit_files_filter.text, list_files_filter[i]) > 0 then
list_files.Items.Add(list_files_filter[i]);
End;
and for switching off the filter, just recover the list from my global list that I created at first:
list_files.Items := list_files_global;
here so far, everything works just fine, but problem is when I'm trying to edit/rename/delete items from filtered list, for example I change an item:
list_files.Items[i] := '-- Changed Item --';
list will be edited, but when I switch off the filter, the original list will be back and all changes are lost.
so I want to know is there any proper way to solve this problem? Something like hiding items individually or change items visibility, etc... so I can change the filtering algorithm and get rid of all this making extra lists.
I searched the internet and looked into Delphi's help file for a whole day and nothing useful came up.
The items of a VCL listbox, List Box in the API, does not have any visibility property. The only option for not showing an item is to delete it.
You can use the control in virtual mode however, where there are no items at all. You decide what data to keep, what to display. That's LBS_NODATA window style in the API. In VCL, set the style property to lbVirtual.
Extremely simplified example follows.
Let's keep an array of records, one record per virtual item.
type
TListItem = record
FileName: string;
Visible: Boolean;
end;
TListItems = array of TListItem;
You can extend the fields as per your requirements. Visibility is one of the main concerns in the question, I added that. You'd probably add something that represents the original name so that you know what name have been changed, etc..
Have one array per listbox. This example contains one listbox.
var
ListItems: TListItems;
Better make it a field though, this is for demonstration only.
Required units.
uses
ioutils, types;
Some initialization at form creation. Empty the filter edit. Set listbox style accordingly. Fill up some file names. All items will be visible at startup.
procedure TForm1.FormCreate(Sender: TObject);
var
ListFiles: TStringDynArray;
i: Integer;
begin
ListFiles := ioutils.TDirectory.GetFiles(TDirectory.GetCurrentDirectory);
SetLength(ListItems, Length(ListFiles));
for i := 0 to High(ListItems) do begin
ListItems[i].FileName := ListFiles[i];
ListItems[i].Visible := True;
end;
ListBox1.Style := lbVirtual;
ListBox1.Count := Length(ListFiles);
Edit1.Text := '';
end;
In virtual mode the listbox is only interested in the Count property. That will arrange how many items will show, accordingly the scrollable area.
Here's the filter part, this is case sensitive.
procedure TForm1.Edit1Change(Sender: TObject);
var
Text: string;
Cnt: Integer;
i: Integer;
begin
Text := Edit1.Text;
if Text = '' then begin
for i := 0 to High(ListItems) do
ListItems[i].Visible := True;
Cnt := Length(ListItems);
end else begin
Cnt := 0;
for i := 0 to High(ListItems) do begin
ListItems[i].Visible := Pos(Text, ListItems[i].FileName) > 0;
if ListItems[i].Visible then
Inc(Cnt);
end;
end;
ListBox1.Count := Cnt;
end;
The special case in the edit's OnChange is that when the text is empty. Then all items will show. Otherwise code is from the question. Here we also keep the total number of visible items, so that we can update the listbox accordingly.
Now the only interesting part, listbox demands data.
procedure TForm1.ListBox1Data(Control: TWinControl; Index: Integer;
var Data: string);
var
VisibleIndex: Integer;
i: Integer;
begin
VisibleIndex := -1;
for i := 0 to High(ListItems) do begin
if ListItems[i].Visible then
Inc(VisibleIndex);
if VisibleIndex = Index then begin
Data := ListItems[i].FileName;
Break;
end;
end;
end;
What happens here is that the listbox requires an item to show providing its index. We loop through the master list counting visible items to find out which one matches that index, and supply its text.
This is something I often do, but with list views instead of list boxes. The basic principles are the same, though.
I tend to store the individual items as objects, which are reference types in Delphi. And I keep them all in one main unfiltered list, which owns the objects, while I maintain a filtered list (which does not own the objects) for display purposes. Like #Sertac, I combine this with a virtual list view.
To see how this works in practice, create a new VCL application and drop a list view (lvDisplay) and an edit control (eFilter) on the main form:
Notice I have added three columns to the list view control: "Name", "Age", and "Colour". I also make it virtual (OwnerData = True).
Now define the class for the individual data items:
type
TDogInfo = class
Name: string;
Age: Integer;
Color: string;
constructor Create(const AName: string; AAge: Integer; const AColor: string);
function Matches(const AText: string): Boolean;
end;
where
{ TDogInfo }
constructor TDogInfo.Create(const AName: string; AAge: Integer;
const AColor: string);
begin
Name := AName;
Age := AAge;
Color := AColor;
end;
function TDogInfo.Matches(const AText: string): Boolean;
begin
Result := ContainsText(Name, AText) or ContainsText(Age.ToString, AText) or
ContainsText(Color, AText);
end;
And let us create the unfiltered list of dogs:
TForm1 = class(TForm)
eFilter: TEdit;
lvDisplay: TListView;
procedure FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject);
private
FList, FFilteredList: TObjectList<TDogInfo>;
public
end;
where
function GetRandomDogName: string;
const
DogNames: array[0..5] of string = ('Buster', 'Fido', 'Pluto', 'Spot', 'Bill', 'Rover');
begin
Result := DogNames[Random(Length(DogNames))];
end;
function GetRandomDogColor: string;
const
DogColors: array[0..2] of string = ('Brown', 'Grey', 'Black');
begin
Result := DogColors[Random(Length(DogColors))];
end;
procedure TForm1.FormCreate(Sender: TObject);
var
i: Integer;
begin
FList := TObjectList<TDogInfo>.Create(True); // Owns the objects
// Populate with sample data
for i := 1 to 1000 do
FList.Add(
TDogInfo.Create(GetRandomDogName, Random(15), GetRandomDogColor)
);
FFilteredList := FList;
lvDisplay.Items.Count := FFilteredList.Count;
lvDisplay.Invalidate;
end;
procedure TForm1.FormDestroy(Sender: TObject);
begin
if FFilteredList <> FList then
FreeAndNil(FFilteredList);
FreeAndNil(FList);
end;
The idea is that the list view control always displays the FFilteredList, which either points to the same object instance as FList, or points to a filtered (or sorted) version of it:
// The list view's OnData event handler
procedure TForm1.lvDisplayData(Sender: TObject; Item: TListItem);
begin
if FFilteredList = nil then
Exit;
if not InRange(Item.Index, 0, FFilteredList.Count - 1) then
Exit;
Item.Caption := FFilteredList[Item.Index].Name;
Item.SubItems.Add(FFilteredList[Item.Index].Age.ToString);
Item.SubItems.Add(FFilteredList[Item.Index].Color);
end;
// The edit control's OnChange handler
procedure TForm1.eFilterChange(Sender: TObject);
var
i: Integer;
begin
if string(eFilter.Text).IsEmpty then // no filter, display all items
begin
if FFilteredList <> FList then
begin
FreeAndNil(FFilteredList);
FFilteredList := FList;
end;
end
else
begin
if (FFilteredList = nil) or (FFilteredList = FList) then
FFilteredList := TObjectList<TDogInfo>.Create(False); // doesn't own the objects
FFilteredList.Clear;
for i := 0 to FList.Count - 1 do
if FList[i].Matches(eFilter.Text) then
FFilteredList.Add(FList[i]);
end;
lvDisplay.Items.Count := FFilteredList.Count;
lvDisplay.Invalidate;
end;
The result:
Notice that there always is only one in-memory object for each dog, so if you rename a dog, the changes will reflect in the list view, filtered or not. (But don't forget to invalidate it!)
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.
If I create multiple TButton objects with this routine:
procedure CreateButton;
begin
Btn := TButton.Create(nil);
end;
Then, how can I refer to a specific object instance to free it using another method like:
procedure FreeButton;
begin
Btn[0].Free; //???
end;
Of course, this does not compile, but I think the question is clear: How do I declare Btn? And how do I free multiple instances?
It doesn't make much sense to create a TButton anywhere that isn't part of a form (which your code does).
With that being said, in order to refer to it later to free it, you need to store a reference to it somewhere.
Since you're referring to "multiple buttons" and using array code in your delete routine, I think you're probably wanting to track an array of buttons. Here's an example of doing just that:
type
TForm1 = class(TForm)
procedure FormCreate(Sender: TObject); // Add via Object Inspector Events tab
private
{ Private declarations }
// Add these yourself
BtnArray: array of TButton;
procedure CreateButtons(const NumBtns: Integer);
procedure DeleteBtn(BtnToDel: TButton);
procedure BtnClicked(Sender: TObject);
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
procedure TForm1.DeleteBtn(BtnToDel: TButton);
var
i: Integer;
begin
// Check each button in the array to see if it's BtnToDel. If so,
// remove it and set the array entry to nil so it can't be deleted
// again.
for i := Low(BtnArray) to High(BtnArray) do
begin
if BtnArray[i] = BtnToDel then
begin
FreeAndNil(BtnArray[i]);
Break;
end;
end;
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
// Create 10 buttons on the form
CreateButtons(10);
end;
// Called when each button is clicked. Assigned in CreateButtons() below
procedure TForm1.BtnClicked(Sender: TObject);
begin
// Delete the button clicked
if (Sender is TButton) then
DeleteBtn(TButton(Sender));
end;
procedure TForm1.CreateButtons(const NumBtns: Integer);
var
i: Integer;
begin
// Allocate storage for the indicated number of buttons
SetLength(BtnArray, NumBtns);
// For each available array item
for i := Low(BtnArray) to High(BtnArray) do
begin
BtnArray[i] := TButton.Create(nil); // Create a button
BtnArray[i].Parent := Self; // Tell it where to display
BtnArray[i].Top := i * (BtnArray[i].Height + 2); // Set the top edge so they show
BtnArray[i].Name := Format('BtnArray%d', [i]); // Give it a name (not needed)
BtnArray[i].Caption := Format('Btn %d', [i]); // Set a caption for it
BtnArray[i].OnClick := BtnClicked; // Assign the OnClick event
end;
end;
If you put this code in a new blank VCL forms application and run it, you'll see 10 buttons ('Btn 0throughBtn 9`) on a form. Clicking on a button will remove it from the form (and the array).
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.