paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-09-23 22:40:03 +02:00
Code Issues Packages Projects Releases Wiki Activity

Opkman: Dpi-aware painting of the stars in the VTV.

Browse Source 
git-svn-id: trunk@59423 -
This commit is contained in:
wp 2018-11-01 18:32:14 +00:00
parent 6e2fa136b9
commit df91898ca2
1 changed files with 24 additions and 21 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

45
components/onlinepackagemanager/opkman_visualtree.pas
View File

@ -106,6 +106,7 @@ type
FMouseEnter: Boolean; FMouseEnter: Boolean;
FShowHintFrm: TShowHintFrm; FShowHintFrm: TShowHintFrm;
FOldButtonNode: PVirtualNode; FOldButtonNode: PVirtualNode;
FStarSize: Integer;
procedure VSTBeforeCellPaint(Sender: TBaseVirtualTree; procedure VSTBeforeCellPaint(Sender: TBaseVirtualTree;
TargetCanvas: TCanvas; Node: PVirtualNode; {%H-}Column: TColumnIndex; TargetCanvas: TCanvas; Node: PVirtualNode; {%H-}Column: TColumnIndex;
{%H-}CellPaintMode: TVTCellPaintMode; CellRect: TRect; var {%H-}ContentRect: TRect); {%H-}CellPaintMode: TVTCellPaintMode; CellRect: TRect; var {%H-}ContentRect: TRect);
@ -177,6 +178,9 @@ var
implementation implementation
uses
imgList;
{ TVisualTree } { TVisualTree }
constructor TVisualTree.Create(const AParent: TWinControl; const AImgList: TImageList; constructor TVisualTree.Create(const AParent: TWinControl; const AImgList: TImageList;
@ -294,6 +298,10 @@ begin
OnScroll := @VSTScroll; OnScroll := @VSTScroll;
end; end;
FShowHintFrm := TShowHintFrm.Create(nil); FShowHintFrm := TShowHintFrm.Create(nil);
if AImgList <> nil then
FStarSize := AImgList.WidthForPPI[FVSt.ImagesWidth, FVST.Font.PixelsPerInch]
else
FStarSize := 0;
end; end;
destructor TVisualTree.Destroy; destructor TVisualTree.Destroy;
@ -645,24 +653,17 @@ end;
procedure TVisualTree.DrawStars(ACanvas: TCanvas; AStartIndex: Integer; procedure TVisualTree.DrawStars(ACanvas: TCanvas; AStartIndex: Integer;
P: TPoint; AAvarage: Double); P: TPoint; AAvarage: Double);
var
imgres: TScaledImageListResolution;
procedure Draw(const AX, AY: Integer; ATyp, ACnt: Integer); procedure Draw(const AX, AY: Integer; ATyp, ACnt, AWidth: Integer);
var var
Bmp: TBitMap;
I: Integer; I: Integer;
begin begin
Bmp := TBitmap.Create; if AStartIndex + ATyp > 25 then
try ShowMessage('crap');
Bmp.Width := 16; for I := 0 to ACnt - 1 do
Bmp.Height := 16; imgres.Draw(ACanvas, AX + I*AWidth + 5, AY, AStartIndex + ATyp);
if AStartIndex + ATyp > 25 then
ShowMessage('crap');
TImageList(FVST.Images).GetBitmap(AStartIndex + ATyp, Bmp);
for I := 0 to ACnt - 1 do
ACanvas.Draw(AX + I*16 + 5, AY, Bmp);
finally
Bmp.Free;
end;
end; end;
var var
@ -671,6 +672,8 @@ var
Stars, NoStars: Integer; Stars, NoStars: Integer;
HalfStar: Boolean; HalfStar: Boolean;
begin begin
imgres := FVST.Images.ResolutionForPPI[FVST.ImagesWidth, FVST.Font.PixelsPerInch, FVST.GetCanvasScaleFactor];
HalfStar := False; HalfStar := False;
F := Frac(AAvarage); F := Frac(AAvarage);
I := Trunc(AAvarage); I := Trunc(AAvarage);
@ -697,14 +700,14 @@ begin
end; end;
X := P.X; X := P.X;
Y := P.Y; Y := P.Y;
Draw(X, Y, 0, Stars); Draw(X, Y, 0, Stars, FStarSize);
Inc(X, Stars*16); Inc(X, Stars*FStarSize);
if HalfStar then if HalfStar then
begin begin
Draw(X, Y, 2, 1); Draw(X, Y, 2, 1, FStarSize);
Inc(X, 16); Inc(X, FStarSize);
end; end;
Draw(X, Y, 1, NoStars); Draw(X, Y, 1, NoStars, FStarSize);
end; end;
procedure TVisualTree.VSTAfterCellPaint(Sender: TBaseVirtualTree; procedure TVisualTree.VSTAfterCellPaint(Sender: TBaseVirtualTree;
@ -723,10 +726,10 @@ begin
begin begin
R := FVST.GetDisplayRect(Node, Column, False); R := FVST.GetDisplayRect(Node, Column, False);
P.X := R.Left + 1; P.X := R.Left + 1;
P.Y := ((R.Bottom - R.Top - 16) div 2) + 1; P.Y := ((R.Bottom - R.Top - FStarSize) div 2) + 1;
if (Node = FHoverNode) and (not FLeaving) and (FHoverP.X >= P.X + 1) and (Abs(FHoverP.X - P.X) <= R.Right - R.Bottom) then if (Node = FHoverNode) and (not FLeaving) and (FHoverP.X >= P.X + 1) and (Abs(FHoverP.X - P.X) <= R.Right - R.Bottom) then
begin begin
Stars := Trunc((FHoverP.X - P.X)/16) + 1; Stars := Trunc((FHoverP.X - P.X)/FStarSize) + 1;
if Stars > 5 then if Stars > 5 then
Stars := 5; Stars := 5;
DrawStars(TargetCanvas, 23, P, Stars) DrawStars(TargetCanvas, 23, P, Stars)