Tvirtualstringtree aftercellpaint isssue[SOLVED]

[snorkel]

Laz 1.0.4 32bit
Virtualtreeview 4.8.7.1 (from SVN)
LCL extensions 0.5 (from SVN)
Windows 7 64bit

Ok, what I am trying to do is port some delphi code that draws a progress bar in a cell of the tree
It works perfectly on Delphi and sort of on Lazarus.

The way this works is you add a progress value to the nodes record, and then when you repaint the node it draws the progress bar in the column cell that you have set to owner draw.

I have attached a screen shot of what happens on Lazarus when adding a single node to the
treeview.  It adds a single duplicate row/node, so if I add one row it shows the row I added and
a clone of that row, if I add three nodes it shows 4 rows and so on.  The rest of the control then
turns black as seen in the screen shot.

Here is the code in the AfterCellPaint event for the treeview:
(Note: I did not write this, I am just trying to port the app)

Code: [Select]

procedure TCompanyFilesForm.upload_gridAfterCellPaint(Sender: TBaseVirtualTree;
 TargetCanvas: TCanvas; Node: PVirtualNode; Column: TColumnIndex;
 const CellRect: TRect);
Var
    Ptxt : String;
    R : Trect;
    P : int64;
    data : PUploadGridData;
    Arect:trect;
begin
     if node = nil then exit;
     if Column < 2 then
        exit;
     arect:=CellRect;
     data := upload_grid.GetNodeData(Node);
     if data^.progress > 0 then
        with TargetCanvas do
             begin
                  R := CellRect;
                  Inc(R.Left,1);
                  Inc(R.Top,1);
                  Dec(R.Right,1);
                  Dec(R.Bottom,1);
                  // draw a rectangle in the box
                  Pen.Color   := clgreen;
                  Pen.Width   := 1;
                  Rectangle(R.Left,R.Top,R.Right,R.Bottom);
                  Rectangle(R.Left+1,R.Top+1,R.Right-1,R.Bottom-1);
                  // draw the progess indicator
                  If data^.Progress < 0 then data^.Progress := 0;
                  If data^.Progress > 100 then data^.Progress := 100;
                  R.Right := CellRect.Left+Trunc((CellRect.Right - CellRect.Left - 1) * data^.Progress/100)-1;
                  Ptxt := formatfloat('0 %',data^.Progress);
                  Brush.Color := clblue;
                  Brush.Style := bsSolid;
                  P := R.Left+2+Trunc((CellRect.Right - CellRect.Left - 1) *  data^.Progress/100)-1;
                  FillRect(R.Left+2,R.Top+2, P ,R.Bottom-2);
                  Brush.Color := clblue;
                  FillRect(P+1, R.Top+2, R.Right, R.Bottom-2);
                  // Color and other text atributes
                  If (upload_grid.SelectedCount > 0) and (upload_grid.Selected[Node]) then
                   Font.Color := ClWhite
                  else
                   Font.Color := clBlack;
                  Brush.Style := Bsclear;
                  Drawtext(TargetCanvas.Handle, Pchar(Ptxt), Length(Ptxt), aRect,DT_CENTER Or DT_VCENTER Or DT_SINGLELINE);
             end;
end;                         

 

[snorkel]

Sort of got it working after hacking around with it:

Seems lazarus does not this line:
Brush.Style := Bsclear;

If I don't set the brush.style to bsclear it all works as expected except the percent text looks a
bit funny because it's not transparent.

[LuizAmérico]

Seems lazarus does not this line:
Brush.Style := Bsclear;

Its the opposite. Delphi has a bug that ignores the style. Lazarus behavior is correct

About transparent text, try use SetBKMode(TRANSPARENT)

[taazz]

or simple revert the changes you have made after you paint the cell to their initial values. eg

Code: [Select]

procedure TCompanyFilesForm.upload_gridAfterCellPaint(Sender: TBaseVirtualTree;
 TargetCanvas: TCanvas; Node: PVirtualNode; Column: TColumnIndex;
 const CellRect: TRect);
Var
    Ptxt : String;
    R : Trect;
    P : int64;
    data : PUploadGridData;
    Arect:trect;
    BckPen:TPen;
    BckBrush : TBrush;
begin
     if node = nil then exit;
     if Column < 2 then
        exit;
  BckPen := Tpen.Create;
  BckBrush := TBrush.Create;
  try
     BckPen.assign(TargetCanvas.Pen);
     BckBrush.Assign(TargetCanvas.Brush);
     arect:=CellRect;
     data := upload_grid.GetNodeData(Node);
     if data^.progress > 0 then
        with TargetCanvas do
             begin
                  R := CellRect;
                  Inc(R.Left,1);
                  Inc(R.Top,1);
                  Dec(R.Right,1);
                  Dec(R.Bottom,1);
                  // draw a rectangle in the box
                  Pen.Color   := clgreen;
                  Pen.Width   := 1;
                  Rectangle(R.Left,R.Top,R.Right,R.Bottom);
                  Rectangle(R.Left+1,R.Top+1,R.Right-1,R.Bottom-1);
                  // draw the progess indicator
                  If data^.Progress < 0 then data^.Progress := 0;
                  If data^.Progress > 100 then data^.Progress := 100;
                  R.Right := CellRect.Left+Trunc((CellRect.Right - CellRect.Left - 1) * data^.Progress/100)-1;
                  Ptxt := formatfloat('0 %',data^.Progress);
                  Brush.Color := clblue;
                  Brush.Style := bsSolid;
                  P := R.Left+2+Trunc((CellRect.Right - CellRect.Left - 1) *  data^.Progress/100)-1;
                  FillRect(R.Left+2,R.Top+2, P ,R.Bottom-2);
                  Brush.Color := clblue;
                  FillRect(P+1, R.Top+2, R.Right, R.Bottom-2);
                  // Color and other text atributes
                  If (upload_grid.SelectedCount > 0) and (upload_grid.Selected[Node]) then
                   Font.Color := ClWhite
                  else
                   Font.Color := clBlack;
                  Brush.Style := Bsclear;
                  Drawtext(TargetCanvas.Handle, Pchar(Ptxt), Length(Ptxt), aRect,DT_CENTER Or DT_VCENTER Or DT_SINGLELINE);
             end;
  finally
    TargetCanvas.Pen.Assign(BckPen);
    TargetCanvas.Brush.Assign(BckBrush);
  end;
end;                         



[snorkel]

Thanks for the technical assistance guys, it's working fine now.

Port is almost complete and it's looking great.