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

tvplanit: activate Hi-DPI imagelist of Laz 1.9+ for DayView icons.

Browse Source 
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@6438 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
wp_xxyyzz
2018-05-18 22:55:29 +00:00
parent ec29b90757
commit 6629fa2cc6
2 changed files with 136 additions and 63 deletions
Download Patch File Download Diff File Expand all files Collapse all files

82
components/tvplanit/source/vpdayviewpainter.pas
View File

@ -5,7 +5,8 @@ unit VpDayViewPainter;
interface
uses
SysUtils, LCLType, LCLIntf, Types, Classes, Graphics, ImgList,
SysUtils, LCLType, LCLIntf, LCLVersion,
Types, Classes, Graphics, ImgList,
VpConst, VPBase, VpData, VpBasePainter, VpDayView;
type
@ -209,11 +210,17 @@ end;
function TVpDayViewPainter.DetermineIconRect(AEventRect: TRect): TRect;
var
MaxHeight: Integer;
w: Integer;
begin
Result.Left := AEventRect.Left;
Result.Top := AEventRect.Top;
Result.Bottom := AEventRect.Bottom;
Result.Right := AEventRect.Left + AlarmW + RecurringW + CategoryW + CustomW + FScaledIconMargin + 2;
w := 0;
if AlarmW <> 0 then inc(w, AlarmW + FScaledIconMargin);
if RecurringW <> 0 then inc(w, RecurringW + FScaledIconMargin);
if CategoryW <> 0 then inc(w, CategoryW + FScaledIconMargin);
if CustomW <> 0 then inc(w, CustomW + FScaledIconMargin);
if w <> 0 then inc(w, FScaledIconMargin);
Result := AEventRect;
Result.Right := Result.Left + w;
MaxHeight := AlarmH + FScaledIconMargin;
if RecurringH + FScaledIconMargin > MaxHeight then
@ -1048,15 +1055,16 @@ var
if IncDrawPos then
inc(DrawPos, w + FScaledIconMargin);
end;
end;
begin
DrawPos := 0;
DrawIcon(dvBmpAlarm, AlarmW, AlarmH, true);
DrawIcon(dvBmpRecurring, RecurringW, RecurringH, true);
DrawIcon(dvBmpCustom, CustomW, CustomH, true);
DrawIcon(dvBmpCategory, CategoryW, CategoryH, true);
DrawIcon(dvBmpAlarm, AlarmW, AlarmH, true);
DrawIcon(dvBmpRecurring, RecurringW, RecurringH, false);
end;
procedure TVpDayViewPainter.DrawEventText(const AText: String;
@ -1578,6 +1586,13 @@ var
isOverlayed: Boolean;
grp: TVpResourceGroup;
imgList: TCustomImageList;
{$IFDEF LCL}
{$IF LCL_FullVersion >= 1090000}
ppi: Integer;
f: Double;
w96: Integer;
{$IFEND}
{$ENDIF}
begin
ShowAlarm := False;
ShowRecurring := False;
@ -1585,11 +1600,29 @@ begin
ShowCustom := False;
imgList := GetImageList;
{$IFDEF LCL}
{$IF LCL_FullVersion >= 1090000}
ppi := FDayView.Font.PixelsPerInch;
f := FDayView.GetCanvasScaleFactor;
w96 := FDayView.DataStore.ImagesWidth;
w := imgList.SizeForPPI[w96, ppi].CX;
{$IFEND}
{$ENDIF}
if Event.AlarmSet then begin
if (FDayView.IconAttributes.AlarmImageIndex > -1) and (imgList <> nil) then
imgList.Getbitmap(FDayView.IconAttributes.AlarmImageIndex, dvBmpAlarm)
else
begin
{$IFDEF LCL}
{$IF LCL_FullVersion >= 1090000}
dvBmpAlarm.PixelFormat := pf32Bit;
dvBmpAlarm.SetSize(w, w);
imgList.DrawForPPI(dvBmpAlarm.Canvas, 0, 0,
FDayView.IconAttributes.AlarmImageIndex, w96, ppi, f);
{$ELSE}
imgList.GetBitmap(FDayView.IconAttributes.AlarmImageIndex, dvBmpAlarm)
{$IFEND}
{$ENDIF}
end else
dvBmpAlarm.Assign(FDayView.IconAttributes.AlarmBitmap);
ShowAlarm := (dvBmpAlarm.Width <> 0) and (dvBmpAlarm.Height <> 0);
end;
@ -1597,8 +1630,18 @@ begin
if Event.RepeatCode <> rtNone then
begin
if (FDayView.IconAttributes.RecurringImageIndex > -1) and (imgList <> nil) then
begin
{$IFDEF LCL}
{$IF LCL_FullVersion >= 1090000}
dvBmpRecurring.PixelFormat := pf32Bit;
dvBmpRecurring.SetSize(w, w);
imgList.DrawForPPI(dvBmpRecurring.Canvas, 0, 0,
FDayView.IconAttributes.RecurringImageIndex, w96, ppi, f);
{$ELSE}
imgList.GetBitmap(FDayview.IconAttributes.RecurringImageIndex, dvBmpRecurring)
else
{$IFEND}
{$ENDIF}
end else
dvBmpRecurring.Assign(FDayView.IconAttributes.RecurringBitmap);
ShowRecurring := (dvBmpRecurring.Width <> 0) and (dvBmpRecurring.Height <> 0);
end;
@ -1616,17 +1659,18 @@ begin
begin
cat := FDayView.Datastore.CategoryColorMap.GetCategory(Event.Category);
if (cat.ImageIndex > -1) and (imgList <> nil) then
begin
{$IFDEF LCL}
{$IF LCL_FullVersion >= 1090000}
dvBmpCategory.PixelFormat := pf32Bit;
dvBmpCategory.SetSize(w, w);
imgList.DrawForPPI(dvBmpCategory.Canvas, 0, 0, cat.ImageIndex, w96, ppi, f);
{$ELSE}
imgList.GetBitmap(cat.ImageIndex, dvBmpCategory)
else
{$IFEND}
{$ENDIF}
end else
dvBmpCategory.Assign(cat.Bitmap);
{
w := cat.Bitmap.Width;
h := cat.Bitmap.Height;
dvBmpCategory.Width := w;
dvBmpCategory.Height := h;
R := Rect(0, 0, w, h);
dvBmpCategory.Canvas.CopyRect(R, cat.Bitmap.canvas, R);
}
end else
begin
dvBmpCategory.Width := 0;

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

@ -180,7 +180,7 @@ type
implementation
uses
DateUtils,
DateUtils, ImgList,
VpSR, VpMisc, VpWavDlg;
{$IFDEF LCL}
@ -297,65 +297,94 @@ procedure TDlgEventEdit.CategoryDrawItem(Control: TWinControl; Index: Integer;
var
lBkColor, lGutterColor, SavedColor: TColor;
lDesc: string;
lBmp: TBitmap;
bmp: TBitmap;
ColorRect: TRect;
IconX, IconY: Integer;
hTxt, hGutter, hDist, vMargin, hMargin: Integer;
SavedStyle: TBrushStyle;
imgIndex: Integer;
h: Integer = 0;
{$IFDEF LCL}
{$IF LCL_FullVersion >= 1090000}
imgres: TScaledImageListResolution;
ppi: Integer;
f: Double;
{$IFEND}
{$ENDIF}
begin
Unused( State);
lBmp := TBitmap.Create;
try
hTxt := Category.Canvas.TextHeight('Tj');
vMargin := ScaleY(2, DesignTimeDPI);
hMargin := ScaleX(3, DesignTimeDPI);
hGutter := ScaleX(10, DesignTimeDPI);
hDist := ScaleX(5, DesignTimeDPI);
hTxt := Category.Canvas.TextHeight('Tj');
vMargin := ScaleY(2, DesignTimeDPI);
hMargin := ScaleX(3, DesignTimeDPI);
hGutter := ScaleX(10, DesignTimeDPI);
hDist := ScaleX(5, DesignTimeDPI);
with CatColorMap.GetCategory(Index) do begin
lGutterColor := Color;
lDesc := Description;
lBkColor := BackgroundColor;
if (ImageIndex > -1) and (FDataStore <> nil) and (FDataStore.Images <> nil) then
FDataStore.Images.GetBitmap(ImageIndex, lBmp)
else
lBmp.Assign(Bitmap);
with CatColorMap.GetCategory(Index) do begin
lGutterColor := Color;
lDesc := Description;
lBkColor := BackgroundColor;
imgIndex := ImageIndex;
if Bitmap <> nil then h := Bitmap.Height;
end;
SavedColor := Category.Canvas.Brush.Color;
SavedStyle := Category.Canvas.Brush.Style;
if State * [odSelected, odFocused] = [] then
Category.Canvas.Brush.Color := lBkColor;
Category.Canvas.FillRect(ARect);
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.Right := ColorRect.Left + hGutter;
Category.Canvas.FillRect(ColorRect);
Category.Canvas.Rectangle(ColorRect);
IconX := ColorRect.Right + hMargin;
IconY := (ARect.Top + ARect.Bottom - h) div 2;
if (imgIndex > -1) and (FDataStore <> nil) and (FDataStore.Images <> nil) 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);
{$ELSE}
FDatastore.Images.Draw(Category.Canvas, IconX, IconY, imgIndex, true);
{$IFEND}
{$ENDIF}
end else begin
bmp := TBitmap.Create;
try
bmp.Assign(CatColorMap.GetCategory(Index).Bitmap);
Category.Canvas.Draw(IconX, IconY, bmp);
inc(ColorRect.Right, bmp.Width);
finally
bmp.Free;
end;
SavedColor := Category.Canvas.Brush.Color;
SavedStyle := Category.Canvas.Brush.Style;
if State * [odSelected, odFocused] = [] then
Category.Canvas.Brush.Color := lBkColor;
Category.Canvas.FillRect(ARect);
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.Right := ColorRect.Left + hGutter;
Category.Canvas.FillRect(ColorRect);
Category.Canvas.Rectangle(ColorRect);
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;
end; *)
ARect.Left := ColorRect.Right + hDist;
Category.Canvas.Brush.Style := bsClear;
Category.Canvas.TextOut(ARect.Left, (ARect.Top + ARect.Bottom - hTxt) div 2, lDesc);
ARect.Left := ColorRect.Right + hDist;
Category.Canvas.Brush.Style := bsClear;
Category.Canvas.TextOut(ARect.Left, (ARect.Top + ARect.Bottom - hTxt) div 2, lDesc);
Category.Canvas.Brush.Color := SavedColor;
Category.canvas.Brush.Style := SavedStyle;
finally
lBmp.Free;
end;
Category.Canvas.Brush.Color := SavedColor;
Category.canvas.Brush.Style := SavedStyle;
end;
procedure TDlgEventEdit.CancelBtnClick(Sender: TObject);