I know that i can set custom colors to items when i add them to the list using OnDraw Events but i want to change colors of the items at a certain point after they are already in the list.
Is there a way to do this ?
To redraw only certain items use the UpdateItems method. It has two input parameters where you can specify the range of the items to be redrawn. If you are going to redraw only one item, then just specify that one item index as a range.
In this example I'm storing the color of the item into the TListItem.Data property and fading this color in the timer's event. After changing the value I call the UpdateItems function which force the draw item event to fire. And yes, without DoubleBuffered set, it flickers (even when you set the timer's interval e.g. to 500ms).
procedure TForm1.FormCreate(Sender: TObject);
begin
ListView1.AddItem('Item 1', TObject(clWhite));
ListView1.AddItem('Item 2', TObject(clWhite));
ListView1.AddItem('Item 3', TObject(clWhite));
Timer1.Enabled := True;
end;
procedure TForm1.ListView1CustomDrawItem(Sender: TCustomListView;
Item: TListItem; State: TCustomDrawState; var DefaultDraw: Boolean);
begin
ListView1.Canvas.Brush.Color := TColor(Item.Data);
end;
procedure TForm1.Timer1Timer(Sender: TObject);
var
C: Byte;
I: TColor;
procedure ChangeItemColor;
begin
I := TColor(ListView1.Items[0].Data);
C := GetRValue(I);
if C < 150 then C := 255 else Dec(C);
I := RGB(C, C, C);
ListView1.Items[0].Data := TObject(I);
end;
begin
// color change
ChangeItemColor;
// repaint of the item with index 1
ListView1.UpdateItems(1, 1);
end;
Related
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!)
I've written some code which colours individual cells on my stringgrid, within my delphi application, according to a list of data.
I now need to write some code in the OnDblClick event on my stringgrid which deduces whether or not a cell is coloured and then proceeds according to the result found. For instance:
DOUBLE CLICK CELL
IS CELL COLOURED
YES > PROCEED A
NO > PROCEED B
Store the color at the time you draw it into the predefined TStringGrid.Objects property. When you need to retrieve it, you can get it back from the Column and Row coordinates. Here's a trivial example that stores either clWhite or clBlack in the Objects for the cell based on whether or not it's an odd-numbered column, and simply displays the stored value as a string when the cell is selected. It should get you started.
procedure TForm1.FormCreate(Sender: TObject);
var
r, c: Integer;
const
ColorSel: array[Boolean] of TColor = (clWhite, clBlack);
begin
StringGrid1.RowCount := 10;
StringGrid1.ColCount := 6;
for c := 1 to StringGrid1.ColCount - 1 do
for r := 1 to StringGrid1.RowCount - 1 do
begin
StringGrid1.Cells[c, r] := Format('C: %d R: %d', [c, r]);
StringGrid1.Objects[c, r] := TObject(ColorSel[Odd(c)]);
end;
end;
procedure TForm1.StringGrid1SelectCell(Sender: TObject; ACol, ARow: Integer;
var CanSelect: Boolean);
begin
ShowMessage(ColorToString(TColor(StringGrid1.Objects[ACol, ARow])));
end;
You can use this in the OnMouseUp event easily to detect what color is in the cell. Remove the StringGrid1SelectCell (using the Object Inspector, just remove the value for the event) and add this as the OnMouseUp event for the grid instead:
procedure TForm1.StringGrid1MouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
var
Col, Row: Integer;
begin
StringGrid1.MouseToCell(X, Y, Col, Row);
if (Col > -1) and (Row > -1) then
ShowMessage(ColorToString(TColor(StringGrid1.Objects[Col, Row])));
end;
Handling the double-click then becomes pretty easy (thanks to #TLama for a big assist):
procedure TForm1.StringGrid1DblClick(Sender: TObject);
var
IsDefaultColor: Boolean;
CurrCellColor: TColor;
CurrCol, CurrRow: Integer;
begin
// Save typing by grabbing the currently selected cell col/row
CurrCol := StringGrid1.Col;
CurrRow := StringGrid1.Row;
// Get the stored color for the selected cell
CurrCellColor := TColor(StringGrid1.Objects[CurrCol, CurrRow]);
// See if it's been painted a different color than the default
IsDefaultColor := (CurrCellColor = StringGrid1.Color);
if not IsDefaultColor then
HandleDifferentColorCell
else
HandleNormalColorCell;
end;
Note that if you're choosing not to change the color for a cell, you should still assign the default color of the cell to the Objects[Column, Row] so that there's something meaningful there in order to avoid an improper conversion when retrieving the value.
I have grid panel 16 x 4 like this one:
Sometimes i want to hide some rows and to move bottom rows up. When I set component visible property to false the layout is not updated:
Nevertheless the row size type is set to auto:
Why the component don't set row height to zero when there is nothing to display?
Why the component don't set row height to zero when there is nothing to display ?
Because the row is considered as empty only if there are no components in all columns in that row, not if they're visible or not. So the same returns the IsRowEmpty method. To workaround this, you'd need to be notified by the cell component about its visibility change. When this notification is generated, you can check the row just like the IsRowEmpty method does, except you'll check if the controls are visible, not if they're assigned. Based on the result of such method, you can then set the size of the Value to 0 to hide the row.
With a help of interposed class, the method for checking if all controls in a row or column are visible, you might write something like this. Those methods return True, when all existing controls in a certain row or column are visible, False otherwise:
uses
ExtCtrls, Consts;
type
TGridPanel = class(ExtCtrls.TGridPanel)
public
function IsColContentVisible(ACol: Integer): Boolean;
function IsRowContentVisible(ARow: Integer): Boolean;
end;
implementation
function TGridPanel.IsColContentVisible(ACol: Integer): Boolean;
var
I: Integer;
Control: TControl;
begin
Result := False;
if (ACol > -1) and (ACol < ColumnCollection.Count) then
begin
for I := 0 to ColumnCollection.Count -1 do
begin
Control := ControlCollection.Controls[I, ACol];
if Assigned(Control) and not Control.Visible then
Exit;
end;
Result := True;
end
else
raise EGridPanelException.CreateFmt(sInvalidColumnIndex, [ACol]);
end;
function TGridPanel.IsRowContentVisible(ARow: Integer): Boolean;
var
I: Integer;
Control: TControl;
begin
Result := False;
if (ARow > -1) and (ARow < RowCollection.Count) then
begin
for I := 0 to ColumnCollection.Count -1 do
begin
Control := ControlCollection.Controls[I, ARow];
if Assigned(Control) and not Control.Visible then
Exit;
end;
Result := True;
end
else
raise EGridPanelException.CreateFmt(sInvalidRowIndex, [ARow]);
end;
And the usage shown for the first row:
procedure TForm1.Button1Click(Sender: TObject);
begin
// after you update visibility of controls in the first row...
// if any of the controls in the first row is not visible, change the
// row's height to 0, what makes it hidden, otherwise set certain height
if not GridPanel1.IsRowContentVisible(0) then
GridPanel1.RowCollection[0].Value := 0
else
GridPanel1.RowCollection[0].Value := 50;
end;
I've got a hacky solution ... keeping the Autosizing
Procedure ShowHideControlFromGrid(C:TControl);
begin
if C.Parent = nil then
begin
c.Parent := TWinControl(c.Tag)
end
else
begin
c.Tag := NativeInt(C.Parent);
c.Parent := nil;
end;
end;
procedure TForm4.Button1Click(Sender: TObject);
begin // e.g. Call
ShowHideControlFromGrid(Edit5);
ShowHideControlFromGrid(Edit6);
ShowHideControlFromGrid(Edit7);
ShowHideControlFromGrid(Label1);
end;
All is in the title.
How can we also make an officehint customisable for each row. Mean when mousemove on a row, display the information of this record (from a db query).
Thanks
You can color individual cells using the CellProperties property of the grid. You can use this to color an entire row:
var
RowIndex: Integer;
ColIndex: Integer;
with MyDBAdvGrid do
begin
// you choose the row index; you may want to iterate all rows to
// color each of them
RowIndex := 2;
// now iterate all (non-fixed, visible) cells in the row and color each cell
for ColIndex := FixedCols to ColCount - 1 do
begin
CellProperties[ColIndex, RowIndex].BrushColor := clYellow;
CellProperties[ColIndex, RowIndex].FontColor := clGreen;
end;
end;
To fill your office hint with record data I would suggest updating it when the user moves the mouse. Use the MouseToCell function to get row and column under the mouse, then use MyDBAdvGrid.AllCells[ColIndex, RowIndex] to access the cell content.
An Alternative to Heinrich answer is to use the OnGetCellColor event.
This can be use like so:
procedure TDBAdvGrid.DBGridGetCellColor(Sender: TObject; ARow,
ACol: Integer; AState: TGridDrawState; ABrush: TBrush; AFont: TFont);
begin
if (your condition) then ABrush.Color := clRed;
end;
Similarly for the hint:
procedure TDBAdvGrid.DBGridGridHint(Sender: TObject; ARow, ACol: Integer;
var hintstr: String);
begin
hintstr := 'your hint text';
end;
I have a TStringGrid where the selected row (max 1, no multi-select) should always have a different background colo(u)r.
I set the DefaultDrawing property to false, and provide a method for the OnDrawCell event, shown below - but it is not working. I can't even describe exactly how it is not working; I supect that if I could I would already have solved the problem. Suffice it to say that instead of having complete rows all with the same background colour it is a mish-mash. Muliple rows have some cells of the "Selected" colour and not all cells of the cselected row have the selected colour.
Note that I compare the cell's row with the strnggrid's row; I can't check the cell state for selected since only cell of the selected row is selected.
procedure TForm1.DatabaseNamesStringGridDrawCell(Sender: TObject;
ACol, ARow: Integer;
Rect: TRect;
State: TGridDrawState);
var cellText :String;
begin
if gdFixed in State then
DatabaseNamesStringGrid.Canvas.Brush.Color := clBtnFace
else
if ARow = DatabaseNamesStringGrid.Row then
DatabaseNamesStringGrid.Canvas.Brush.Color := clAqua
else
DatabaseNamesStringGrid.Canvas.Brush.Color := clWhite;
DatabaseNamesStringGrid.Canvas.FillRect(Rect);
cellText := DatabaseNamesStringGrid.Cells[ACol, ARow];
DatabaseNamesStringGrid.Canvas.TextOut(Rect.Left + 2, Rect.Top + 2, cellText);
end;
if you are trying of paint the selected row or cell with a different color you must check for the gdSelected value in the state var.
procedure TForm1.DatabaseNamesStringGridDrawCell(Sender: TObject;
ACol, ARow: Integer;
Rect: TRect;
State: TGridDrawState);
var
AGrid : TStringGrid;
begin
AGrid:=TStringGrid(Sender);
if gdFixed in State then //if is fixed use the clBtnFace color
AGrid.Canvas.Brush.Color := clBtnFace
else
if gdSelected in State then //if is selected use the clAqua color
AGrid.Canvas.Brush.Color := clAqua
else
AGrid.Canvas.Brush.Color := clWindow;
AGrid.Canvas.FillRect(Rect);
AGrid.Canvas.TextOut(Rect.Left + 2, Rect.Top + 2, AGrid.Cells[ACol, ARow]);
end;
Do you have run-time themes enabled? Run-time themes override any colour scheme you try to enforce for Windows Vista and up.
When a new cell is selected in a stringgrid only the previous and the new selected cell are invalidated. Thus the remaining cells of the previous and new row are not redrawn, giving the effect you describe.
One workaround would be to call InvalidateRow for both affected rows, but this is a protected method and you have to find a way to reach this method from an OnSelectCell event handler. Depending on your Delphi version there are different ways to accomplish that.
The cleanest way would be to derive from TStringGrid, but in most cases this is not feasible. With a newer Delphi version you can use a class helper to achieve this. Otherwise you have to rely on the usual protected hack.
This works for me
procedure TFmain.yourStringGrid(Sender: TObject; ACol, ARow: Integer; Rect: TRect;
State: TGridDrawState);
var
md: integer;
begin
with yourStringGrid do
begin
if yourStringGrid,Row = ARow then
Canvas.Brush.Color:= clYellow //your highlighted color
else begin
md := Arow mod 2;
if md <> 0 then Canvas.Brush.Color:= $00BADCC1 else //your alternate color
Canvas.Brush.Color:= clwhite;
end;
Canvas.FillRect(Rect);
Canvas.TextOut(L, Rect.top + 4, cells[ACol, ARow]);
end;
end;
Refresh the grid
procedure TFmain.yourStringGridClick(Sender: TObject);
begin
yourStringGrid.Refresh;
end;
Note: Has a little latency, but otherwise works great.
(Used in Delphi XE2)