pascal/lazarus-ccr
1
0
Fork 0
Code Issues Releases Activity

TvPlanIt: Improved inplace editor. Scaling of event images in Category combobox if they are too high

Browse Source 
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@8897 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
wp_xxyyzz
2023-07-22 17:41:38 +00:00
parent 45d2ee6485
commit 96e0ace939
8 changed files with 107 additions and 52 deletions
Download Patch File Download Diff File Expand all files Collapse all files

59
components/tvplanit/source/vpevnteditdlg.pas
View File

@ -333,10 +333,9 @@ var
bmp: TBitmap;
ColorRect: TRect;
IconX, IconY: Integer;
hTxt, hGutter, hDist, hMargin: Integer;
hTxt, hGutter, hDist, hMargin, hItem, hImg, wImg: Integer;
SavedStyle: TBrushStyle;
imgIndex: Integer;
h: Integer = 0;
{$IFDEF LCL}
{$IF LCL_FullVersion >= 1090000}
imgres: TScaledImageListResolution;
@ -357,7 +356,6 @@ begin
lDesc := Description;
lBkColor := BackgroundColor;
imgIndex := ImageIndex;
if Bitmap <> nil then h := Bitmap.Height;
end;
SavedColor := Category.Canvas.Brush.Color;
@ -369,26 +367,46 @@ begin
Category.Canvas.Brush.Color := lGutterColor;
Category.Canvas.Pen.Color := clBlack;
ColorRect.Left := ARect.Left; // + hMargin;
ColorRect.Top := ARect.Top; // + vMargin;
ColorRect.Bottom := ARect.Bottom; //- vMargin;
ColorRect.Left := ARect.Left+2; // + hMargin;
ColorRect.Top := ARect.Top+2; // + vMargin;
ColorRect.Bottom := ARect.Bottom-1; //- vMargin;
ColorRect.Right := ColorRect.Left + hGutter;
Category.Canvas.FillRect(ColorRect);
Category.Canvas.Rectangle(ColorRect);
hItem := HeightOf(ColorRect);
IconX := ColorRect.Right + hMargin;
IconY := (ARect.Top + ARect.Bottom - h) div 2;
if (imgIndex > -1) and (FDataStore <> nil) and (FDataStore.Images <> nil) then
if (FDataStore <> nil) and (FDataStore.Images <> nil) and Between(imgIndex, 0, FDatastore.Images.Count-1) then
begin
{$IFDEF LCL}
{$IF LCL_FullVersion >= 1090000}
ppi := Category.Font.PixelsPerInch;
f := Category.GetCanvasScaleFactor;
imgres := FDatastore.Images.ResolutionForPPI[FDatastore.ImagesWidth, ppi, f];
h := imgRes.Height;
IconY := (ARect.Top + ARect.Bottom - h) div 2;
imgres.Draw(Category.Canvas, IconX, IconY, imgIndex, true);
inc(ColorRect.Right, imgres.Width);
hImg := imgRes.Height;
// If image is too high scale it down to row height
if hImg > hItem then
begin
bmp := TBitmap.Create;
try
bmp.PixelFormat := pf32Bit;
bmp.SetSize(imgRes.Width, imgRes.Height);
imgRes.Draw(bmp.Canvas, 0, 0, imgIndex, true);
hImg := hItem;
wImg := round(imgRes.Width / imgRes.Height * hImg);
ScaleImg(bmp, wImg, hImg);
IconY := (ARect.Top + ARect.Bottom - hItem) div 2;
Category.Canvas.Draw(IconX, IconY, bmp);
finally
bmp.Free;
end;
end else
begin
IconY := (ARect.Top + ARect.Bottom - hImg) div 2;
wImg := imgRes.Width;
imgres.Draw(Category.Canvas, IconX, IconY, imgIndex, true);
end;
inc(ColorRect.Right, wImg);
{$ELSE}
FDatastore.Images.Draw(Category.Canvas, IconX, IconY, imgIndex, true);
{$IFEND}
@ -397,19 +415,22 @@ begin
bmp := TBitmap.Create;
try
bmp.Assign(CatColorMap.GetCategory(Index).Bitmap);
hImg := bmp.Height;
{$IFDEF LCL}
if hImg > hItem then
begin
wImg := round(bmp.Width / bmp.Height * hItem);
hImg := hItem;
ScaleImg(bmp, wImg, hImg);
end;
{$ENDIF}
IconY := (ARect.Top + ARect.Bottom - hImg) div 2;
Category.Canvas.Draw(IconX, IconY, bmp);
inc(ColorRect.Right, bmp.Width);
finally
bmp.Free;
end;
end;
(*
if lBmp <> nil then begin
IconX := ColorRect.Right + hMargin;
IconY := (ARect.Top + ARect.Bottom - lBmp.Height) div 2;
Category.Canvas.Draw(IconX, IconY, lBmp);
inc(ColorRect.Right, lBmp.Width);
end; *)
ARect.Left := ColorRect.Right + hDist;
Category.Canvas.Brush.Style := bsClear;