I face a issue with dynamically resizing the column width of a TJVListview in Delphi XE4 (in Windows 7 environment). Application takes longer time for column resize and sometimes throws access violation if there are huge data on the listview. We are using the below code for resizing the columns.
for i := 0 to LV.Columns.Count -1 do
begin
if LV.Columns.Items[i].Tag = 0 then
begin
LV.Columns.Items[i].Width := ColumnTextWidth;
LV.Columns.Items[i].Width := ColumnHeaderWidth;
end;
end;
Previously the same code used to work fine with Delphi 2009. The problem I noticed only when we are using customdrawitem event(Where we are placing images inside the listview). For the normal listview with only text display the above code is working fine.
I tried using the Column AutoSize property by setting it true, but it is of no use.
Any suggestion on how to overcome this issue. Actually, we are using the TJVlistview component in number of places in our application.
Regards,
Siran.
cODE :
1) In my form I have a JVListview, Button and imagelist. Button for loading into List view.
2) in Advancecustomdrawitem, I try to place a BMP control and also perform alternative row color change...
procedure TForm1.Button1Click(Sender: TObject);
var
i, ii: Integer;
ListItem: TListItem;
strVal : String;
begin
strVal := 'Test String';
try
ListView.Items.BeginUpdate;
LockWindowUpdate(listview.handle);
try
ListView.Clear;
for i := 1 to 15 do
begin
ListItem := ListView.Items.Add;
ListItem.SubItems.Add(strVal +'_' +IntToStr(i));
ListItem.SubItems.Add(strVal +'_' +IntToStr(i));
ListItem.SubItems.Add(strVal +'_' +IntToStr(i));
ListItem.SubItems.Add(strVal +'_' +IntToStr(i));
ListItem.SubItems.Add(strVal +'_' +IntToStr(i));
end;
finally
// for resizing the columns based on the text size
FitToTextWidth(ListView);
ListView.Items.EndUpdate;
LockWindowUpdate(0);
end;
except
on E: Exception do
MessageDlg(PWideChar(E.Message), TMsgDlgType.mtError, [TMsgDlgBtn.mbOK], 0);
end;
end;
procedure TForm1.FitToTextWidth(LV: TListView);
var
i : integer;
begin
// Set the Column width based on based on textwidth and headerwidth
for i := 0 to LV.Columns.Count -1 do
begin
if LV.Columns.Items[i].Tag = 0 then
begin
LV.Columns.Items[i].Width := ColumnTextWidth;
LV.Columns.Items[i].Width := ColumnHeaderWidth;
end;
end;
end;
procedure TForm1.LISTVIEWAdvancedCustomDrawItem(Sender: TCustomListView;
Item: TListItem; State: TCustomDrawState; Stage: TCustomDrawStage;
var DefaultDraw: Boolean);
Var
R : TRect;
C : TCanvas;
B : TBitMap;
begin
// Set C
C := (Sender as TListView).Canvas;
// Set R
R := Item.DisplayRect(drLabel);
B := TBitMap.Create;
B.Transparent := True;
B.TransparentColor := clWhite;
// based on item index set the image and change the row color
if odd(item.Index) = true then
begin
ImageList.GetBitmap(0,B);
TJvListItem( Item ).Brush.Color := clWhite;
TJvListItem( Item ).Font.Color := clBlack;
end
else
begin
ImageList.GetBitmap(1,B);
TJvListItem( Item ).Brush.Color := clMoneyGreen;
TJvListItem( Item ).Font.Color := clBlack;
end;
C.Draw(R.Left + 5 ,R.Top, B);
B.Free;
end;
The above code works well with Delphi 2009... but currently trying migrating to XE4 in Win 7 environment.. my problem here is, it takes lot of time in loading the list view (When performing column resizing dynamically by calling FitToTextWidth method) .. but without this method it is working fine but without column resizing...
When you set the width of a column to any one of the automatic constants, the control have to evaluate the length of the items/subitems to be able to calculate the necessary width. This takes time.
Also, when you set the width of a column, the VCL ListView updates all columns.
You have six columns, setting the width of any one of them involves 6 column updates, together with the spurious call in your FitToTextWidth procedure, your code is causing reading all items/subitems of a column 42 times (due to the code path in VCL: 1 time for 1st col, 2 times for 2nd -> 21 times for setting the width of 6 columns). Enclose your width setting in Begin/EndUpdate calls and remove the extra call, and you'll finish it in 6 rounds.
procedure TForm1.FitToTextWidth(LV: TListView);
var
i : integer;
begin
// Set the Column width based on based on textwidth and headerwidth
LV.Columns.BeginUpdate;
try
for i := 0 to LV.Columns.Count -1 do
begin
if LV.Columns.Items[i].Tag = 0 then
begin
// LV.Columns.Items[i].Width := ColumnTextWidth;
LV.Columns.Items[i].Width := ColumnHeaderWidth;
end;
end;
finally
LV.Columns.EndUpdate;
end;
end;
As I don't get any AV with your test case, I cannot comment on that.
Related
Using Delphi XE8 I'm currently testing functionality with Firemonkey TListViews.
One thing I'm trying to do is to load a field of all records from a TFDMemtable component into a Listview Item, specifically into the DetailObject of the ListView Item.
For example, I have 3 records in a table (db field is called 'Name'):
Record 1 = Name 1
Record 2 = Name 2
Record 3 = Name 3
There is only 1 DetailObject property per ListView Item so my question is, would I be able to add all of the fields (Name 1, Name 2, Name 3) into that one DetailObject?
Below is what I've attempted so far but no luck. Not 100% sure what I need to do.
procedure MainForm.BuildList;
var LItem : TListViewItem;
begin
ListView1.BeginUpdate;
try
ListView1.CLearItems;
LItem := ListView1.Items.Add;
LItem.Objects.DetailObject.Visible := True;
with memtable do
begin
while not eof do
begin
LItem.Detail := FieldByName('Name').AsString;
end;
end;
finally
ListView1.EndUpdate;
end;
end;
I'm sorry if this isn't clear enough, please let me know.
Any help would be great.
I think I should warn you that before seeing your q, I'd never done anything with FMX ListViews and Master/Detail datasets. The Following is a little rough around the edges, and the layout isn't ideal, but it shows one way to populate a ListView from Master + Detail datasets. I have no idea whether there are better ways. Personally, I would see if I could use Live Bindings to do the job.
procedure TMasterDetailForm.BuildList;
var
LItem : TListViewItem;
DetailItem : TListViewItem;
ListItemText : TListItemText;
DetailIndex : Integer;
begin
ListView1.BeginUpdate;
ListView1.ItemAppearanceObjects.ItemEditObjects.Text.TextVertAlign := TTextAlign.Leading; // The default
// seems to be `Center`, whereas we want the Master field name to be at the top of the item
try
ListView1.Items.Clear; //Items;
Master.First;
while not Master.eof do begin
LItem := ListView1.Items.Add;
LItem.Text := Master.FieldByName('Name').AsString;
LItem.Height := 25;
Detail.First;
DetailIndex := 0;
while not Detail.Eof do begin
Inc(DetailIndex);
ListItemText := TListItemText.Create(LItem);
ListItemText.PlaceOffset.X := 100;
ListItemText.PlaceOffset.Y := 25 * (DetailIndex - 1);
ListItemText.TextAlign := TTextAlign.Leading;
ListItemText.Name := 'Name' + IntToStr(DetailIndex); //Detail.FieldByName('Name').AsString;
LItem.Data['Name' + IntToStr(DetailIndex)] := Detail.FieldByName('Name').AsString;
Detail.Next;
end;
LItem.Height := LItem.Height * (1 + DetailIndex);
Master.Next;
end;
finally
ListView1.EndUpdate;
end;
end;
TListItemText is one of a number of "drawable" FMX objects that can be added to do the TListViewItem. They seem to need unique names so that they can be accessed via the Names property.
FWIW, I used 2 TClientDataSets as the Master and Detail in my code.
Also FWIW, for FMX newbies like me, populating an FMX TreeView is a lot more like what you'd do in a VCL project:
procedure TMasterDetailForm.BuildTree;
var
PNode,
ChildNode : TTreeViewItem;
begin
TreeView1.BeginUpdate;
try
TreeView1.Clear;
Master.First;
while not Master.eof do begin
PNode := TTreeViewItem.Create(TreeView1);
TreeView1.AddObject(PNode);
PNode.Text := Master.FieldByName('Name').AsString;
Detail.First;
while not Detail.Eof do begin
ChildNode := TTreeViewItem.Create(TreeView1);
ChildNode.Text := Detail.FieldByName('Name').AsString;
PNode.AddObject(ChildNode);
Detail.Next;
end;
Master.Next;
end;
finally
TreeView1.EndUpdate;
end;
end;
Btw, in your code you should have been calling
memtable.Next;
in your while not eof loop, and memtable.First immediately before the loop.
I probably have a very simple to fix problem, though I have no clue how to do it. I am pretty new to Delphi, which is why I have very little experience.
Below is the piece of code I want to simplify:
procedure TForm1.Asign();
begin
case TileValue[1,1] of
0: Fx1y1.Color:=clBtnFace;
1: Fx1y1.Color:=clBlue;
2: Fx1y1.Color:=clMaroon;
end;
case TileValue[1,2] of
0: Fx1y2.Color:=clBtnFace;
1: Fx1y2.Color:=clBlue;
2: Fx1y2.Color:=clMaroon;
end;
case TileValue[1,3] of
0: Fx1y3.Color:=clBtnFace;
1: Fx1y3.Color:=clBlue;
2: Fx1y3.Color:=clMaroon;
end;
end;
The Fx1y1 is a panel while the x1 is coordinate as well as the y1 (Coordinates on a "4 in a row game"). I am trying to somehow replace the x and y coordinate in the panel name by another variable, so I can shorten the code. It should look something like this:
procedure TForm1.Asign();
var A,B:integer;
begin
for B:=1 to 6 do begin
for A:=1 to 7(Because the 4 in a row playing field is 6 by 7) do begin
case TileValue[A,B] of
0: Fx{A}y{b}.Color:=clBtnFace;
1: Fx{A}y{b}.Color:=clBlue;
2: Fx{A}y{b}.Color:=clMaroon;
end;
end;
end;
end;
Is that even possible? If yes or no please tell me.
You can do what you're asking for by using the Form's FindComponent function, which returns the component for the supplied name. Since that can be any component, you have to cast the result to TPanel. This will throw an exception if there is no component with the supplied name, or (possibly) if it is not a Panel. To further simplify the code I would also use an array for the colors.
procedure TForm1.Assign;
const Colors: array[0..2] of TColor = (clBtnFace, clBlue, clMaroon);
var x,y: integer;
Panel: TPanel;
begin
for x := 1 to 7 do
for y := 1 to 6 do
begin
Panel := TPanel(FindComponent('Fx' + x.ToString + 'y' + y.ToString));
Panel.Color := Colors[TileValue[x,y]];
end;
end;
As David mentioned, it would be cleaner to put the Panels in an array, and use that. From the code you showed it seems like you have created all the panels at design time, which is not required. It looks like you already have 42 panels, which is a lot to create manually, and if you wanted to make the field larger, it would become even more infeasible. That's why it's probably best to create the panels from code:
procedure TForm1.FormCreate(Sender: TObject);
begin
CreatePanels;
Assign;
end;
procedure TForm1.CreatePanels;
var x,y: integer;
begin
for x := 1 to 7 do
for y := 1 to 6 do
begin
Panels[x,y] := TPanel.Create(Self);
Panels[x,y].Parent := Self;
// set the position of the panel
Panels[x,y].Left := 10 + (x-1)*50;
Panels[x,y].Top := 10 + (y-1)*50;
Panels[x,y].Width := 50;
Panels[x,y].Height := 50;
// make sure we can assign a non-default color
Panels[x,y].ParentBackground := false;
// do whatever else you want to do with the panel
end;
end;
procedure TForm1.Assign;
const Colors: array[0..2] of TColor = (clBtnFace, clBlue, clMaroon);
var x,y: integer;
begin
for x := 1 to 7 do
for y := 1 to 6 do
Panels[x,y].Color := Colors[TileValue[x,y]];
end;
You would declare the array of Panels where-ever you declared TileValue. Not only makes this assigning the colors easier, you can also change appearance & dimensions of the playing field a lot more quickly.
I have a function to update a cxGrid made with help from answers to Loop through records on a cxgrid and update a field/column
But it is sometimes acting a bit strange. If I open the form with the cxGrid and click the columnheader without doing anything else, the records are updateted OK. But if the 'selectorbar' is moved away from the top, the record marked is not updated.
I am sure it is a property that needs to be changed, but which one.
The variable fSelected is set to False at FormShow and is ther so that the user can unselect records as well.
procedure TfrmContactsSelect.colContactSelectedHeaderClick(Sender: TObject);
var
i: Integer;
Index: Integer;
BookMark : TBookMark;
Contact: variant;
begin
if fMulti = True then
begin
Screen.Cursor := crHourGlass;
fSelected := not fSelected;
BookMark := qryContacts.GetBookmark;
qryContacts.DisableControls;
try
for i := 0 to grdContactsView1.DataController.FilteredRecordCount - 1 do
begin
Index := grdContactsView1.DataController.FilteredRecordIndex[i];
Contact := grdContactsView1.DataController.Values[Index, 4];
if grdContactsView1.DataController.LocateByKey(Contact) then
begin
qryContacts.Edit;
qryContacts.FieldByName('fldcontact_selected').AsBoolean := fSelected;
qryContacts.Post;
end;
end;
finally
qryContacts.EnableControls;
qryContacts.GotoBookmark(BookMark);
qryContacts.FreeBookmark(BookMark);
end;
Screen.Cursor := crDefault;
end;
end;
Delphi XE7, DevExpress 14.2.2, UniDAC 5.5.12 for DB access
Comment:
I have ended up with the following solution based on the answer and input from MartynA
procedure TfrmContactsSelect.colContactSelectedHeaderClick(Sender: TObject);
var
i: Integer;
Index: Integer;
MarkedRecord: variant;
CurrentRecord: variant;
begin
if fMulti = True then
begin
Screen.Cursor := crHourGlass;
fSelected := not fSelected;
Index := grdContactsView1.DataController.FocusedRecordIndex;
MarkedRecord := grdContactsView1.DataController.Values[Index, colContactGuid.ID];
try
for i := 0 to grdContactsView1.DataController.FilteredRecordCount - 1 do
begin
Index := grdContactsView1.DataController.FilteredRecordIndex[i];
CurrentRecord := grdContactsView1.DataController.Values[Index, colContactGuid.ID];
if grdContactsView1.DataController.LocateByKey(CurrentRecord) then
begin
grdContactsView1.DataController.Edit;
grdContactsView1.DataController.SetEditValue(colContactSelected.ID, fSelected, evsText);
grdContactsView1.DataController.Post;
end;
end;
finally
grdContactsView1.DataController.LocateByKey(MarkedRecord);
end;
Screen.Cursor := crDefault;
end;
end;
I can reproduce your problem using the sample project I posted in my answer to your other q.
Try this: Add a TMemo to your form, and inside the 'if grdContactsView1.DataController.LocateByKey(Contact) then' block, write the value of a row-unique datafield and the Selected datafield value to the memo.
Then, what I get when some row other than the top row is selected is that one row is listed twice in the memo, with Selected both false and true, and one of the rows in the filter isn't listed at all, which I think accounts for the behaviour you're seeing. If I then comment out the .Edit .. .Post lines, it correctly lists all the rows in the filter.
So evidently doing the Selected field changes inside a block which iterated the FilteredRecordIndex property of the DBTableView is what's causing the problem.
Personally, I find that it goes a bit against the grain to modify dataset rows in code via a DB-aware control (because you usually end up fighting the DB-awareness of the control), but in this case, it's straightforward to do the processing via the DBTableView of the cxGrid.
procedure TForm1.ProcessFilteredRecords;
var
PrevV,
V : Variant;
i,
Index: Integer;
S : String;
begin
// First, pick up a reference to the current record
// so that we can return to it afterwards
Index := cxGrid1DBTableView1.DataController.FocusedRecordIndex;
PrevV := cxGrid1DBTableView1.DataController.Values[Index, 0];
try
for i := 0 to cxGrid1DBTableView1.DataController.FilteredRecordCount - 1 do begin
Index := cxGrid1DBTableView1.DataController.FilteredRecordIndex[i];
V := cxGrid1DBTableView1.DataController.Values[Index, 0];
if cxGrid1DBTableView1.DataController.LocateByKey(V) then begin
cxGrid1DBTableView1.DataController.Edit;
// 2 is the index of my Selected column in the grid
if cxGrid1DBTableView1.DataController.SetEditValue(2, True, evsText) then
Caption := 'OK'
else
Caption := 'Failed';
cxGrid1DBTableView1.DataController.Post;
end;
end;
finally
if cxGrid1DBTableView1.DataController.LocateByKey(PrevV) then
Caption := 'OK'
else
Caption := 'Failed';
end;
end;
Another way to avoid the problem is to change the Selected states in two steps:
Iterate the FilteredRecordIndex to build a list of rows to change - in your case this would be a list of guids
Then, iterate the list of rows and update their Selected states.
Code:
procedure TForm1.ProcessFilteredRecords;
var
V : Variant;
i,
Index: Integer;
BM : TBookMark;
S : String;
TL : TStringList;
begin
Memo1.Lines.Clear;
TL := TStringList.Create;
try
for i := 0 to cxGrid1DBTableView1.DataController.FilteredRecordCount - 1 do begin
Index := cxGrid1DBTableView1.DataController.FilteredRecordIndex[i];
V := cxGrid1DBTableView1.DataController.Values[Index, 0];
if cxGrid1DBTableView1.DataController.LocateByKey(V) then begin
if CDS1.FieldByName('Selected').AsBoolean then
S := 'True'
else
S := 'False';
S := CDS1.FieldByName('Name').AsString + ' ' + S;
Memo1.Lines.Add(S);
TL.Add(CDS1.FieldByName('Guid').AsString);
end;
end;
try
BM := CDS1.GetBookMark;
CDS1.DisableControls;
for i := 0 to TL.Count - 1 do begin
if CDS1.Locate('guid', TL[i], []) then begin
CDS1.Edit;
CDS1.FieldByName('Selected').AsBoolean := True;
CDS1.Post;
end
end;
finally
CDS1.EnableControls;
CDS1.GotoBookmark(BM);
CDS1.FreeBookmark(BM);
end;
finally
TL.Free;
end;
end;
Like you, I was expecting that changing a property or two of the cxGrid might avoid the problem without any code, but I haven't been able to find anything which does.
I am hiding a field so that when it is shown (on checkbox checked) it preforms a certain calculation.
procedure TForm1.cxCheckBox1Click(Sender: TObject);
var
C:TcxGridDBColumn;
begin
if ABSTable1.FieldByName('CENIK_IME').AsString = 'PAK' then begin
C := cxGrid2dbtableview1.GetColumnByFieldName('TT');
if Assigned(C) then C.Visible := not C.Visible;
ABSQuery2.Edit;
ABSQuery2.FieldByName('TOTAL').AsCurrency := (ABSQuery2.FieldByName('TOTAL').AsCurrency) + (ABSQuery2.FieldByName('TT').AsCurrency);
ABSQuery2.Refresh;
end;
end;
Problem is that every time I check or uncheck the checkbox my TOTAL gets bigger and bigger. Any way to prevent the checkbox from summing every time it gets checked or unchecked ?
Also I have this on calculate fields of the query ;
procedure TForm1.ABSQuery2CalcFields(DataSet: TDataSet);
begin
ABSQuery2.FieldByName('TT').Value:= (ABSQuery2.FieldByName('DAYS').AsCurrency) * 1.01 ;
end;
This is all done on a Temp table which is used just for the occassion. Contents get deleted all the time....
Won't you need to subtract ABSQuery2.FieldByName('TT').AsCurrency if the column is hidden?
And also only change Total if the TT is found?
So:
procedure TForm1.cxCheckBox1Click(Sender: TObject);
var
C:TcxGridDBColumn;
begin
if ABSTable1.FieldByName('CENIK_IME').AsString = 'PAK' then begin
C := cxGrid2dbtableview1.GetColumnByFieldName('TT');
if Assigned(C) then
begin
C.Visible := not C.Visible;
ABSQuery2.Edit;
if C.Visible then
ABSQuery2.FieldByName('TOTAL').AsCurrency := (ABSQuery2.FieldByName('TOTAL').AsCurrency) + (ABSQuery2.FieldByName('TT').AsCurrency)
else
ABSQuery2.FieldByName('TOTAL').AsCurrency := (ABSQuery2.FieldByName('TOTAL').AsCurrency) - (ABSQuery2.FieldByName('TT').AsCurrency);
ABSQuery2.Post;
ABSQuery2.Refresh;
end;
end;
end;
Is there a feature in the Listview control to shift items up and down?
Not having worked with TListView very much (I mostly use database grids), I took your question as a chance to learn something. The following code is the result, it is more visually oriented that David's answer. It has some limitations: it will only move the first selected item, and while it moves the item, the display for vsIcon and vsSmallIcon is strange after the move.
procedure TForm1.btnDownClick(Sender: TObject);
var
Index: integer;
temp : TListItem;
begin
// use a button that cannot get focus, such as TSpeedButton
if ListView1.Focused then
if ListView1.SelCount>0 then
begin
Index := ListView1.Selected.Index;
if Index<ListView1.Items.Count then
begin
temp := ListView1.Items.Insert(Index+2);
temp.Assign(ListView1.Items.Item[Index]);
ListView1.Items.Delete(Index);
// fix display so moved item is selected/focused
ListView1.Selected := temp;
ListView1.ItemFocused := temp;
end;
end;
end;
procedure TForm1.btnUpClick(Sender: TObject);
var
Index: integer;
temp : TListItem;
begin
// use a button that cannot get focus, such as TSpeedButton
if ListView1.Focused then
if ListView1.SelCount>0 then
begin
Index := ListView1.Selected.Index;
if Index>0 then
begin
temp := ListView1.Items.Insert(Index-1);
temp.Assign(ListView1.Items.Item[Index+1]);
ListView1.Items.Delete(Index+1);
// fix display so moved item is selected/focused
ListView1.Selected := temp;
ListView1.ItemFocused := temp;
end;
end;
end;
You have two options:
Delete them and then re-insert them at the new location.
Use a virtual list view and move them in your data structure.
My routine for doing the first of these options is like this:
procedure TBatchTaskList.MoveTasks(const Source: array of TListItem; Target: TListItem);
var
i, InsertIndex: Integer;
begin
Assert(IsMainThread);
BeginUpdate;
Try
//work out where to move them
if Assigned(Target) then begin
InsertIndex := FListItems.IndexOf(Target);
end else begin
InsertIndex := FListItems.Count;
end;
//create new items for each moved task
for i := 0 to high(Source) do begin
SetListItemValues(
FListItems.Insert(InsertIndex+i),
TBatchTask(Source[i].Data)
);
Source[i].Data := nil;//handover ownership to the new item
end;
//set selection and focus item to give feedback about the move
for i := 0 to high(Source) do begin
FListItems[InsertIndex+i].Selected := Source[i].Selected;
end;
FBatchList.ItemFocused := FListItems[InsertIndex];
//delete the duplicate source tasks
for i := 0 to high(Source) do begin
Source[i].Delete;
end;
Finally
EndUpdate;
End;
end;
The method SetListItemValues is used to populate the columns of the list view.
This is a perfect example of why virtual controls are so great.