Well, I have the following problem:
I've painted the tree cells in different colors depending on some boolean vars.
Example:
isProcessService,
isProcessInDebugger,
isProcessService,
isProcessElevated,
isProcessNet,
isProcessOwner,
isProcessinJob,
isProcessPacked,
isProcessMarkedForDeletion,
isProcessMarkedForCreation : Boolean;
So in BeforeCellPaint I'll paint the cells background color based on those booleans like:
procedure TMainForm.ProcessVstBeforeCellPaint(Sender: TBaseVirtualTree;
TargetCanvas: TCanvas; Node: PVirtualNode; Column: TColumnIndex;
CellPaintMode: TVTCellPaintMode; CellRect: TRect; var ContentRect: TRect);
var
NodeData: PProcessData;
begin
if Node = nil then
Exit;
NodeData := Sender.GetNodeData(Node);
if NodeData = nil then
Exit;
if (NodeData^.isProcessOwner) then
begin
TargetCanvas.Brush.Color := $00AAFFFF;
TargetCanvas.FillRect(TargetCanvas.ClipRect);
end;
if (NodeData^.isProcessInDebugger) then
begin
TargetCanvas.Brush.Color := $00E5A5A5;
TargetCanvas.FillRect(TargetCanvas.ClipRect);
end;
if (NodeData^.pProcessID = 0) or (NodeData^.pProcessID = 4) then
begin
TargetCanvas.Brush.Color := $00FFCCAA;
TargetCanvas.FillRect(TargetCanvas.ClipRect);
end;
if (NodeData^.isProcessElevated) and not(NodeData^.isProcessInDebugger) then
begin
TargetCanvas.Brush.Color := $0000AAFF;
TargetCanvas.FillRect(TargetCanvas.ClipRect);
end;
if (NodeData^isProcessService) and
not (NodeData^.isProcessPacked) and
not(NodeData^.isProcessNet) then
begin
TargetCanvas.Brush.Color := $00FFFFCC;
TargetCanvas.FillRect(TargetCanvas.ClipRect);
end;
if (NodeData^.isProcessMarkedForDeletion) then
begin
TargetCanvas.Brush.Color := $005D5DFF;
TargetCanvas.FillRect(TargetCanvas.ClipRect);
end;
if (NodeData^.isProcessMarkedForCreation) then
begin
TargetCanvas.Brush.Color := $0061E15E;
TargetCanvas.FillRect(TargetCanvas.ClipRect);
end;
if (NodeData^.isProcessNet) then
begin
TargetCanvas.Brush.Color := $005CE0BF;
TargetCanvas.FillRect(TargetCanvas.ClipRect);
end;
end;
The question is:
How could I paint the cell green or red depending on a process is going to be created or deleted (let the color stay for at least one second and then switch back to its original value?)
I other words, a process is created paint the cell green wait a second and then switch back to the original color depending on: isProcessService, is ProcessOwner and so on...
The biggest Problem is I need this in a non blocking mode (I can not use sleep otherwise the tree will freeze too so the color change will not be noticed)
If you still can not follow me, I'm trying to mimic the same behavior Process Explorer or Process Hacker does when a process is created or deleted. Both applications paints the cell background for those processes red or green for a second then switching back to the original color the cell had.
Just for information, I'll get notified of process creation or deletion via wmi.
Whenever a process is created, start a timer associated with that process with a timeout of 1s. The isProcessMarkedForCreation is set to true and so the row is painted green. When the timer fires the handler sets isProcessMarkedForCreation to false and forces a repaint of that row which removes the green highlight. Now that the timer has done its work it should be deleted. The exact same approach can be used for deletion.
Related
When using getprevious(node) or getnext(node) in VirtualTreeView is it possible to get blue highlight on that previous or next nodes like on select node by click?
This is how you make a node highlighted with blue: (or other colour set at VST.Colors...)
VST.Selected[Node] := True;
Do not mix with : VST.FocusedNode !
You may consider to deselect the previous blue one first.
If VST.TreeOptions.SelectionOptions >> toMultiSelect = False, it's enough to simply "remember" the last one:
var
LastSelected: PVirtualNode; // you can put this to the Form's private section
...
procedure DeselectLastOne();
begin
if (csDestroying in VST.ComponentState) then Exit;
if Assigned(LastSelected) then begin
VST.Selected[LastSelected] := False;
LastSelected := nil;
end;
end;
procedure SelectNewOne(N: PVirtualNode);
begin
if (csDestroying in VST.ComponentState) then Exit;
DeselectLastOne();
VST.Selected[N] := True;
LastSelected := N;
end;
initialization
LastSelected = nil; // you can put this to the Form's OnCreate proc.
But if you have set VST.TreeOptions.SelectionOptions >> toMultiSelect = True than you'll have to iterate through VST.SelectedNodes() function first to deselect ALL highlighted nodes.
See also: VST.SelectedCount : integer; , VST.GetFirstSelected() , VST.GetNextSelected()
Previously I used this VirtualStringTree for showing all of the nodes, and I used the Node.Index to check the odd and even rows inside the OnBeforeCellPaint event.
But when I filtered the nodes, I realized that the Node.Index is irrelevant to be used as alternate rows as shown in the screenshot below:
Any idea/solution to solve this?
procedure TMainForm.IpTreeBeforeCellPaint(Sender: TBaseVirtualTree;
TargetCanvas: TCanvas; Node: PVirtualNode; Column: TColumnIndex;
CellPaintMode: TVTCellPaintMode; CellRect: TRect; var ContentRect: TRect);
begin
if Node.Index mod 2 = 0
then TargetCanvas.Brush.Color := $00F7E6D5
else TargetCanvas.Brush.Color := $00FBF2EA;
if Sender = ipTree then
if IpAddresses[ PVirtualNode( Node ).Index ].Highlighted then
TargetCanvas.Brush.Color := clYellow;
TargetCanvas.FillRect( CellRect );
end;
Heres my code, this doesnt take into account child nodes. It alternates color for each row. However, if you did have children, you can always use
iLevel := Sender.GetNodeLevel( Node );
then if its an even number, paint all the child nodes the same as parent.
I have a TListView with some modifications. It includes some icons (several, depending on the item) per row, as well as the possibility of a background for a row if certain conditions are met.
It seems to be rendering all right. But a problem occurs when I move the mouse over the window, it seems like the rows are being re-rendered, this creates an unnecessary lag and more importantly, it seems to mess with the visualisation. It should only re-draw if I do something (like select a row).
How do I force it to stop (seemingly refreshing rows upon mouse over)? Currently I am using the AdvancedCustomDrawItem to draw. It also takes like a second for the window to react to a selection of an item, that seems dull.
So basically, each row has DrawText() and drawing images onto the Sender.Canvas. This is admittedly a slow progress, but it works for now, if it just didn't seemingly redraw the rows when I hover over them! In fact, if I use the Aero theme, the rows become black when you hover over them.
Here is my event code on AdvancedCustomDrawItem:
procedure TfrmJobQueue.ListView1AdvancedCustomDrawItem(Sender: TCustomListView;
Item: TListItem; State: TCustomDrawState; Stage: TCustomDrawStage;
var DefaultDraw: Boolean);
const
DT_ALIGN: array[TAlignment] of integer = (DT_LEFT, DT_RIGHT, DT_CENTER);
var
r: TRect;
SL: TStringList;
TypeName: string;
I: Integer;
TypeState: integer;
x1,x2: Integer;
S: string;
begin
if Stage = cdPostPaint then begin
// Ways I tried to avoid it; but failed.
if cdsHot in State then
exit;
if cdsNearHot in State then
exit;
if cdsOtherSideHot in State then
exit;
if cdsMarked in State then
exit;
if cdsIndeterminate in State then
exit;
Sender.Canvas.Brush.Style := bsSolid;
if FRepLines.Items[Item.Index].IsAutoReport then begin
Sender.Canvas.Font.Color := clBlack;
Sender.Canvas.Brush.Color := clSkyBlue;
end else begin
Sender.Canvas.Font.Color := clBlack;
Sender.Canvas.Brush.Color := clWhite;
end;
if cdsSelected in State then begin
Sender.Canvas.Font.Color := clWhite;
Sender.Canvas.Brush.Color := clNavy;
end;
R := Item.DisplayRect(drBounds);
Sender.Canvas.FillRect(R);
Sender.Canvas.Brush.Style := bsClear;
if cdsFocused in State then
DrawFocusRect(Sender.Canvas.Handle, R);
x1 := 0;
x2 := 0;
for i := 0 to TListView(Sender).Columns.Count - 1 do
begin
inc(x2, Sender.Column[i].Width);
r.Left := x1;
r.Right := x2;
if i = 0 then
S := Item.Caption
else
S := Item.SubItems[i-1];
if DT_ALIGN[Sender.Column[i].Alignment] = DT_LEFT then
S := ' ' + S;
DrawText(Sender.Canvas.Handle,
S, length(S), r,
DT_SINGLELINE or DT_ALIGN[Sender.Column[i].Alignment] or
DT_VCENTER or DT_END_ELLIPSIS);
x1 := x2;
end;
r := Item.DisplayRect(drIcon);
SL := TStringList.Create;
SL.CommaText := FRepLines.Value(Item.Index, 'TypeState');
r.Left := Sender.Column[0].Width + Sender.Column[1].Width + Sender.Column[2].Width + Sender.Column[3].Width
+ Sender.Column[4].Width;
for I := 0 to SL.Count - 1 do begin
if GetTypeImagesIndex(SL.Names[I]) = -1 then
continue;
// FRepLines is a collection of items containing more information about each row.
if FRepLines.Value(Item.Index, 'State') <> '1' then begin // no error
TypeName := SL.Names[I];
TypeState := StrToIntDef(SL.Values[TypeName], 0);
// State*Images are TImageList.
if TypeState = 0 then
StateWaitingImages.Draw(Sender.Canvas, r.Left + 17*I, r.Top,
GetTypeImagesIndex(TypeName))
else
StateDoneImages.Draw(Sender.Canvas, r.Left + 17*I, r.Top,
GetTypeImagesIndex(TypeName));
CreateIconToolTip(StrToIntDef(FRepLines.Value(Item.Index, 'RepJob'), -1),
TypeName, r.Left + 17*I, ListView1.ViewOrigin.Y + r.Top,
Format(TranslateString('RepQTypeState'),
[TranslateString(Format('RepQTypeStateN%s', [TypeName])),
TranslateString(Format('RepQTypeState-%d', [TypeState]))]));
end;
end;
end;
end;
Some explanation of the code:
The list is a list of reports (a report queue). I am introducing a concept of 'AutoReports' (or scheduled reports in the UI), which I want to highlight with a light blue background (clSkyBlue).
In addition to that background, it also draws some icons on the Status-column, which indicates what stages the report are in and moreover, what formats a report has been ordered in (formats like PDF, Excel and HTML), and whether it has been printed and/or emailed. An icon only appears if such an event has been ordered, so the number of icons are variable.
The waiting state images are greyed out versions of the done state images. I have also tried to create some code, so when I hover over the specific icons, it has a tooltip message.
Because the code is rather dull in speed, I suspect I am doing something incredibly wrong.
HotTracking is likely enabled. That causes items to redraw as they are moused over, so the item under the mouse can be rendered differently. You are probably ignoring the hottrack state when drawing. That could account for the blackness.
You should profile your code to find the real bottleneck. Drawing code needs to be fast. I do a lot of custom drawing in a ListView and it does not behave slowly like you describe.
Update: Consider re-writing your code to draw individual columns in the OnAdvancedCustomDrawSubItem event instead of doing everything in the OnAdvancedCustomDrawItem event. Also, you don't need to calculate each column's bounds manually, you can use ListView_GetSubItemRect() instead. And lastly, you are leaking your TStringList.
I'm trying to emulate Outlook 2013 left pane tree view menu for my application. I'm using CustomDraw because I only want to change some simple font and background properties.
Here's what I want:
However, I always get the default selected drawing for both selected and hot tracked nodes. I don't have Windows 7 or XP to see if this is the normal behavior or if it's something related with my OS (Windows 8).
Here's what I'm getting:
Here's my code:
procedure TMainForm.TreeView1CustomDrawItem(Sender: TCustomTreeView;
Node: TTreeNode; State: TCustomDrawState; var DefaultDraw: Boolean);
begin
if Node.Level = 1 then
Sender.Canvas.Font.Size := Sender.Canvas.Font.Size + 2;
if cdsHot in State then
Sender.Canvas.Brush.Color := $00F7E6CD
else if (cdsSelected in State) or (cdsFocused in State) or
(cdsChecked in State) then
Sender.Canvas.Brush.Color := $00F2F2F2
else
Sender.Canvas.Brush.Color := $00DEDEDE;
DefaultDraw := true;
end;
How can I draw a different colored background for selected and hot items?
Try the following :
type
TTreeView = class(Vcl.ComCtrls.TTreeView)
protected
procedure CreateWnd; override;
end;
uses uxtheme;
procedure TTreeView.CreateWnd;
begin
inherited;
SetWindowTheme(Handle, nil , nil);
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
TreeView1.Font.Name := 'Segoe UI';
TreeView1.HotTrack := True;
TreeView1.Font.Size := TreeView1.Font.Size + 1;
TreeView1.Color := $00DEDEDE;
end;
procedure TForm1.TreeView1CustomDrawItem(Sender: TCustomTreeView;
Node: TTreeNode; State: TCustomDrawState; var DefaultDraw: Boolean);
begin
if cdsFocused in State then begin
Sender.Canvas.Brush.Color := $00F2F2F2;
Sender.Canvas.Font.Color := clblack;
Sender.Canvas.Font.Style := Sender.Canvas.Font.Style + [fsBold];
end else if cdsHot in State then
Sender.Canvas.Brush.Color := $00F7E6CD
else
Sender.Canvas.Brush.Color := $00DEDEDE;
end;
Explanation:
The Microsoft documentation on this is incredibly fuzzy, what I can say with certainty is that whenever an action (Selection, Hot tracking , De-Selection etc...) is performed on an Item (Node), a specific message is sent, this message includes the state of the Node via the parameters flag which at the very end internally decides how the Item should be updated visually based on the current Windows Theme.
This is the probable cause as to why disabling themes for the TreeView component removes the default selection rectangle & theme coloring. The documentation for the Control state flags supports this theory in partial.
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.