Copy all selected items from ListView1 to ListView2 - delphi

How to copy multiple items from TListView to another. Right now im doing it like this:
procedure TForm1.CopyToRightClick(Sender: TObject);
var
selected: TListItem;
addItems: TListItem;
begin
saveChanges.Visible := false;
selected := deviceList.Selected;
addItems := selectedDevicesList.Items.Add;
addItems.Assign(selected);
end;
But this way only one selected item get copied. Is there a way to copy all selected items?

You can do
procedure TForm1.Button1Click(Sender: TObject);
var
i: Integer;
begin
ListView2.Items.BeginUpdate;
try
for i := 0 to ListView1.Items.Count - 1 do
if ListView1.Items[i].Selected then
ListView2.Items.Add.Assign(ListView1.Items[i]);
finally
ListView2.Items.EndUpdate;
end;
end;
to copy every selected list view item in ListView1 to ListView2.
You can do
procedure TForm1.Button2Click(Sender: TObject);
var
i: Integer;
begin
ListView1.Items.BeginUpdate;
try
ListView2.Items.BeginUpdate;
try
for i := ListView1.Items.Count - 1 downto 0 do
if ListView1.Items[i].Selected then
begin
ListView2.Items.Add.Assign(ListView1.Items[i]);
ListView1.Items[i].Delete;
end;
finally
ListView2.Items.EndUpdate;
end;
finally
ListView1.Items.EndUpdate;
end;
end;
to move every selected list view item in ListView1 to ListView2.
(This works well in moderately-sized lists. In larger lists, when you need to do something for every selected item, iterating over all items and checking the Selected property is way too slow. Instead, you should use a while loop with GetNextItem with isSelected.)

Related

How to get the MenuItem name when right-clicking any menu item?

In a 32-bit Delphi 11 VCL Application on Windows 10, when RIGHT-CLICKING any menu item, I need to get the name of the clicked MenuItem.
I use a TApplicationEvents component and this code to get notified when I click on any menu item:
procedure TformMain.ApplicationEvents1Message(var Msg: tagMSG; var Handled: Boolean);
begin
case Msg.message of
Winapi.Messages.WM_COMMAND:
begin
CodeSite.Send('TformMain.ApplicationEvents1Message: WM_COMMAND');
end;
end;
end;
However:
How to get notified only when RIGHT-clicking the menu item?
How to get the NAME of the clicked MenuItem?
Each TMenu (i.e. TMainMenu or TPopupMenu) offers a method FindItem, which allows you to find an item by varying criteria. In your case the correct call for the form's main menu would be
TheMenuItem := Menu.FindItem(Msg.wParam, fkCommand);
Since I have several forms in my application and several (popup) menus on each of these forms, a special solution is needed here:
procedure TForm1.ApplicationEvents1Message(var Msg: tagMSG; var Handled: Boolean);
begin
case Msg.message of
Winapi.Messages.WM_COMMAND:
begin
// Todo: Check HERE for RightMouseButtonDown - BUT HOW? (Or how to check HERE for modifier keys?)
var ThisMenuItem := GetMenuItem(Msg.wParam);
if Assigned(ThisMenuItem) then
begin
CodeSite.Send('TForm1.ApplicationEvents1Message: Clicked MenuItem Name', ThisMenuItem.Name);
end;
end;
end;
end;
function TForm1.GetMenuItem(const aWParam: NativeUInt): TMenuItem;
var
ThisMenuItem: TMenuItem;
begin
Result := nil;
var ThisForm := Screen.ActiveForm; // works on any form in the application
for var i := 0 to ThisForm.ComponentCount - 1 do
begin
if ThisForm.Components[i] is TMenu then
begin
ThisMenuItem := TMenu(ThisForm.Components[i]).FindItem(aWParam, fkCommand);
if Assigned(ThisMenuItem) then
begin
Result := ThisMenuItem;
EXIT;
end;
end;
end;
end;

TStream as an object inside StringList

I am using Delphi 7 and playing with a StringList, with TStream as object.
My test project has a ListBox, a Memo and 2 buttons (Add and Remove).
Here is what I got so far:
var
List: TStringList;
procedure TForm1.FormCreate(Sender: TObject);
begin
List := TStringList.Create;
end;
procedure TForm1.FormDestroy(Sender: TObject);
var
I: Integer;
begin
if (List.Count > 0) then
for I := 0 to Pred(List.Count) do
begin
List.Objects[I].Free;
List.Objects[I] := nil;
end;
FreeAndNil(List);
end;
procedure TForm1.btnAddClick(Sender: TObject);
var
Strm: TStream;
begin
Strm := TMemoryStream.Create;
try
Memo.Lines.SaveToStream(Strm);
List.AddObject(IntToStr(List.Count), TObject(Strm));
Memo.Clear;
ListBox.Items.Assign(List);
finally
// Strm.Free; (line removed)
end;
end;
procedure TForm1.btnDelFirstClick(Sender: TObject);
begin
if (List.Count > 0) then
begin
List.Objects[0].Free;
List.Objects[0] := nil;
List.Delete(0);
ListBox.Items.Assign(List);
end;
end;
When I double-click the ListBox I would like to load the selected item Stream object to Memo. Here is what I tried to do:
procedure TForm1.ListBoxDblClick(Sender: TObject);
var
Idx: Integer;
begin
Memo.Clear;
Idx := ListBox.ItemIndex;
if (Idx >= 0) and (TStream(List.Objects[Idx]).Size > 0) then
Memo.Lines.LoadFromStream(TStream(List.Objects[Idx]));
end;
My questions are:
Is correct the way I am adding and removing (freeing) the TStream object inside the StringList? Maybe I need to first free the Stream and then the Object??
Is correct the way I am freeing all objects on FormDestroy event?
When I try to load the stream back to Memo (Memo.Lines.LoadFromStream(TStream(List.Objects[Idx]))), it doesn't load, despite Stream.Size is higher than zero. What I am doing wrong?
1.Is correct the way I am adding and removing (freeing) the TStream object inside the StringList?
Yes, because the TStrings.Objects[] property returns a TObject pointer and TStream derives from TObject, so you can call Free() on the object pointers.
Maybe I need to first free the Stream and then the Object??
You need to free the TStream objects before freeing the TStringList object. Just as you are already doing.
2.Is correct the way I am freeing all objects on FormDestroy event?
Yes. Though technically, you do not need to check the TStringList.Count property for > 0 before entering the loop, as the loop will handle that condition for you. And you do not need to nil the pointers before freeing the TStringList:
procedure TForm1.FormDestroy(Sender: TObject);
var
I: Integer;
begin
for I := 0 to Pred(List.Count) do
List.Objects[I].Free;
List.Free;
end;
One thing you are doing that is overkill, though, is Assign()ing the entire TStringList to the TListBox whenever you add/delete a single item from the TStringList. You should instead simply add/delete the associated item from the ListBox and preserve the remaining items as-is.
And add some extra error checking to btnAddClick() as well to avoid any memory leaks if something goes wrong.
Try this:
procedure TForm1.btnAddClick(Sender: TObject);
var
Strm: TStream;
Idx: Integer;
begin
Strm := TMemoryStream.Create;
try
Memo.Lines.SaveToStream(Strm);
Strm.Position := 0;
Idx := List.AddObject(IntToStr(List.Count), Strm);
except
Strm.Free;
raise;
end;
try
ListBox.Items.Add(List.Strings[Idx]);
except
List.Objects[Idx].Free;
List.Delete(Idx);
raise;
end;
Memo.Clear;
end;
procedure TForm1.btnDelFirstClick(Sender: TObject);
begin
if List.Count > 0 then
begin
List.Objects[0].Free;
List.Delete(0);
ListBox.Items.Delete(0);
end;
end;
3.When I try to load the stream back to Memo (Memo.Lines.LoadFromStream(TStream(List.Objects[Idx]))), it doesn't load, despite Stream.Size is higher than zero. What I am doing wrong?
You are not seeking the stream back to Position 0 before loading it into the Memo. SaveToStream() always leaves the stream positioned at the end of the stream, and LoadFromStream() leave the stream positioned wherever the load stopped reading from (if not at the end, in case of failure).
Now, with all of this said, I personally would not use TListBox in this manner. I would instead set its Style property to lbVirtual and then use its OnData event to display the strings from the TStringList. No need to copy them into the TListBox directly, or try to keep the two lists in sync at all times. It would be safer, and use less memory, to let the TListBox ask you for what it needs, and then you can provide it from the TStringList (which I would then change to a TList since you are not really storing meaningful names that can't be produced dynamically in the OnData event handler):
var
List: TList;
procedure TForm1.FormCreate(Sender: TObject);
begin
List := TList.Create;
end;
procedure TForm1.FormDestroy(Sender: TObject);
var
I: Integer;
begin
ListBox.Count := 0;
for I := 0 to Pred(List.Count) do
TStream(List[I]).Free;
List.Free;
end;
procedure TForm1.btnAddClick(Sender: TObject);
var
Strm: TStream;
Idx: Integer;
begin
Strm := TMemoryStream.Create;
try
Memo.Lines.SaveToStream(Strm);
Strm.Position := 0;
Idx := List.Add(Strm);
except
Strm.Free;
raise;
end;
try
ListBox.Count := List.Count;
except
TStream(List[Idx]).Free;
List.Delete(Idx);
raise;
end;
Memo.Clear;
end;
procedure TForm1.btnDelFirstClick(Sender: TObject);
begin
if List.Count > 0 then
begin
TStream(List[0]).Free;
List.Delete(0);
ListBox.Count := List.Count;
end;
end;
procedure TForm1.ListBoxDblClick(Sender: TObject);
var
Strm: TStream;
Idx: Integer;
begin
Memo.Clear;
Idx := ListBox.ItemIndex;
if Idx >= 0 then
begin
Strm := TStream(List[Idx]);
if Strm.Size > 0 then
begin
Strm.Position := 0;
Memo.Lines.LoadFromStream(Strm);
end;
end;
end;
procedure TForm1.ListBoxData(Control: TWinControl; Index: Integer; var Data: string);
begin
Data := IntToStr(Index);
end;
I don't understand what you suggest about freeing the stream and then the object. As I understand it, the object you're talking about freeing is the stream. You can't destroy one before the other because there's only one object, which is a stream.
Your methods of adding and removing stream objects in the string list are fine. They're not ideal, but I'll limit my comments here because Stack Overflow isn't Code Review.
After you call SaveToStream, the stream's position is at the end of the stream. If you want to read from the stream, then you'll have to set the position back to the start again. Set Position := 0 for the stream prior to calling LoadFromStream.

Have cxGrid expand current date

I made my grid group by date (grabbed the column name and dragged it to where it says 'group by that column'). However, when the grid is displayed all the dates are 'closed' so I must expand them to see data. That is OK but I wonder if it is possible to have current date expanded already (all other should remain closed !) so I do not have to click the expand cross?
try this, you can put the code in other event handler like a TButton for example
procedure TForm1.FormCreate(Sender: TObject);
begin
//aDBTableView1.ViewData.Expand(true); // this is how to expand all records
aDBTableView1.ViewData.Records[YourRecordNumber].Expand(true); // this is how to expand by a given record
end;
OK try the following
procedure TForm1.FormCreate(Sender: TObject);
begin
with cxGrid1DBTableView1 do
begin
DataController.DataSource.DataSet.Locate('YourDateFieldName',DateTimeToStr(Date),
[loPartialKey]);
ViewData.Records[DataController.FocusedRowIndex].Expand(True);
end;
end;
procedure TForm1.Button1Click(Sender: TObject);
var
intLoop,
vValue: Variant;
begin
for intLoop := 0 to self.cxGrid1DBTableView1.DataController.RowCount - 1 do
begin
if self.cxGrid1DBTableView1.ViewData.Rows[IntLoop] is TcxGridGroupRow then
begin
if TcxGridGroupRow(cxGrid1DBTableView1.ViewData.Rows[IntLoop]).Level = cxGrid1DBTableView1MyDate.GroupIndex then
begin
vValue:=TcxGridGroupRow(cxGrid1DBTableView1.ViewData.Rows[IntLoop]).Value ;
if vValue = Date() then
begin
TcxGridGroupRow(cxGrid1DBTableView1.ViewData.Rows[intLoop]).Expand(False);
end;
end;
end;
end;
end;

TListItem Objects

I would like to program the following situation:
I have 2 different ListViews in a form. I would like to attach specific items from ListView2 into a ListView1 item. After the "Parent" Item gets deleted, it should also delete all the attached items from ListView2.
I tried this so far:
type
TITEMS = record
A_Items : array of TListItem;
end;
A Button that adds an item to ListView1 (ParentItems)
var
item : TListItem;
begin
item := ListView1.Items.Add;
item.Caption := 'ParentTestItem';
item.SubItems.Add('TestSubItem');
A button that adds an item to ListView2 (ChildItems)
var
item : TlistItem;
items : TITEMS;
begin
if ListView1.Selected = NIL then exit; // Make sure an item is selected.
item := ListView2.Items.Add;
item.Caption := 'ChildTestItem';
item.SubItems.Add('TestSubItem');
SetLength (items.item, Length(items.item) + 1); // wrong?
items.item[Length(items.item)-1] := item;
ListView1.Selected.SubItems.Objects[0] := #items;
A button that removes a ParentItem (and it should delete ChildItems as well...)
var
items : TItems;
i : Integer;
item : TlistItem;
begin
if ListView1.Selected = NIL then exit; // Make sure an item is selected.
items := TItems(ListView1.Selected.SubItems.Objects[0]); // Cast
for i := 0 to Length (items.item) - 1 do begin
item := items.item[i];
item.Delete;
end;
ListView1.Selected.Free;
Any Idea how I could realize this?
You need to allocate the list of items dynamically on the heap, not locally on the stack, so it stays valid in memory while you are using it.
I would suggest using a TList instead of an array, it is easier to allocate dynmically. I would also suggest using the TListItem.Data property instead of the TListItem.SubItems.Objects[] property (unless you are already using the Data property for something else).
procedure TForm1.AddParentBtnClick(Sender: TObject);
var
item : TListItem;
begin
item := ListView1.Items.Add;
item.Caption := 'ParentTestItem';
item.SubItems.Add('TestSubItem');
end;
procedure TForm1.AddChildBtnClick(Sender: TObject);
var
Selected, item : TListItem;
items : TList;
begin
Selected := ListView1.Selected;
if Selected = nil then Exit; // Make sure an item is selected.
items := TList(Selected.Data);
if items = nil then begin
items := TList.Create;
Selected.Data := items;
end;
item := ListView2.Items.Add;
try
item.Caption := 'ChildTestItem';
item.SubItems.Add('TestSubItem');
items.Add(item);
except
item.Delete;
raise;
end;
end;
procedure TForm1.DeleteParentBtnClick(Sender: TObject);
var
Selected : TListItem;
begin
Selected := ListView1.Selected;
if Selected <> nil then Selected.Delete;
end;
procedure TForm1.ListView1Deletion(Sender: TObject; Item: TListItem);
var
items : TList;
i : Integer;
begin
items := TList(Item.Data); // Cast
if items <> nil then begin
for i := 0 to items.Count - 1 do begin
TListItem(items[i]).Delete;
end;
items.Free;
Item.Data := nil;
end;
end;

How can I filter the contents of a combo box based on what's been typed?

We have a combo box with more than 100 items.
We want to filter out the items as we enter characters in combo box. For example if we entered 'ac' and click on the drop down option then we want it to display items starting with 'ac' only.
How can I do this?
Maybe you'd be happier using the autocompletion features built in to the OS. I gave an outline of how to do that here previously. Create an IAutoComplete object, hook it up to your combo box's list and edit control, and the OS will display a drop-down list of potential matches automatically as the user types. You won't need to adjust the combo box's list yourself.
To expand on Rob's answer about using the OnChange event, here is an example of how to do what he suggests.
procedure TForm1.FormCreate(Sender: TObject);
begin
FComboStrings := TStringList.Create;
FComboStrings.Add('Altair');
FComboStrings.Add('Alhambra');
FComboStrings.Add('Sinclair');
FComboStrings.Add('Sirius');
FComboStrings.Add('Bernard');
FComboStrings.Sorted := True;
ComboBox1.AutoComplete := False;
ComboBox1.Items.Text := FComboStrings.Text;
ComboBox1.Sorted := True;
end;
procedure TForm1.FormDestroy(Sender: TObject);
begin
FreeAndNil(FComboStrings);
end;
procedure TForm1.ComboBox1Change(Sender: TObject);
var
Filter: string;
i: Integer;
idx: Integer;
begin
// Dropping down the list puts the text of the first item in the edit, this restores it
Filter := ComboBox1.Text;
ComboBox1.DroppedDown := True;
ComboBox1.Text := Filter;
ComboBox1.SelStart := Length(Filter);
for i := 0 to FComboStrings.Count - 1 do
if SameText(LeftStr(FComboStrings[i], Length(ComboBox1.Text)), ComboBox1.Text) then
begin
if ComboBox1.Items.IndexOf(FComboStrings[i]) < 0 then
ComboBox1.Items.Add(FComboStrings[i]);
end
else
begin
idx := ComboBox1.Items.IndexOf(FComboStrings[i]);
if idx >= 0 then
ComboBox1.Items.Delete(idx);
end;
end;
My brief contribution working with objects in the combobox:
procedure FilterComboBox(Combo: TComboBox; DefaultItems: TStrings);
function Origin: TStrings;
begin
if Combo.Tag = 0 then
begin
Combo.Sorted := True;
Result := TStrings.Create;
Result := Combo.Items;
Combo.Tag := Integer(Result);
end
else
Result := TStrings(Combo.Tag);
end;
var
Filter: TStrings;
I: Integer;
iSelIni: Integer;
begin
if(Combo.Text <> EmptyStr) then
begin
iSelIni:= Length(Combo.Text);
Filter := TStringList.Create;
try
for I := 0 to Origin.Count - 1 do
if AnsiContainsText(Origin[I], Combo.Text) then
Filter.AddObject(Origin[I], TObject(Origin.Objects[I]));
Combo.Items.Assign(Filter);
Combo.DroppedDown:= True;
Combo.SelStart := iSelIni;
Combo.SelLength := Length(Combo.Text);
finally
Filter.Free;
end;
end
else
Combo.Items.Assign(DefaultItems);
end;
You can handle the combo box's OnChange event. Keep a master list of all items separate from the UI control, and whenever the combo box's edit control changes, adjust the combo box's list accordingly. Remove items that don't match the current text, or re-add items from the master list that you removed previously.
As Rob already answered, you could filter on the OnChange event, see the following code example. It works for multiple ComboBoxes.
{uses}
Contnrs, StrUtils;
type
TForm1 = class(TForm)
ComboBox1: TComboBox;
ComboBox2: TComboBox;
procedure FormCreate(Sender: TObject);
procedure ComboBoxChange(Sender: TObject);
procedure FormDestroy(Sender: TObject);
private
FComboLists: TList;
procedure FilterComboBox(Combo: TComboBox);
end;
implementation
{$R *.dfm}
procedure TForm1.ComboBoxChange(Sender: TObject);
begin
if Sender is TComboBox then
FilterComboBox(TComboBox(Sender));
end;
procedure TForm1.FilterComboBox(Combo: TComboBox);
function Origin: TStrings;
begin
if Combo.Tag = 0 then
begin
Combo.Sorted := True;
Result := TStringList.Create;
Result.Assign(Combo.Items);
FComboLists.Add(Result);
Combo.Tag := Integer(Result);
end
else
Result := TStrings(Combo.Tag);
end;
var
Filter: TStrings;
I: Integer;
begin
Filter := TStringList.Create;
try
for I := 0 to Origin.Count - 1 do
if AnsiStartsText(Combo.Text, Origin[I]) then
Filter.Add(Origin[I]);
Combo.Items.Assign(Filter);
Combo.SelStart := Length(Combo.Text);
finally
Filter.Free;
end;
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
FComboLists := TObjectList.Create(True);
// For Each ComboBox, set AutoComplete at design time to false:
ComboBox1.AutoComplete := False;
ComboBox2.AutoComplete := False;
end;
procedure TForm1.FormDestroy(Sender: TObject);
begin
FComboLists.Free;
end;

Resources