From 6629fa2cc67a970a1f7f7a8d9862b316bd7f7465 Mon Sep 17 00:00:00 2001 From: wp_xxyyzz Date: Fri, 18 May 2018 22:55:29 +0000 Subject: [PATCH] tvplanit: activate Hi-DPI imagelist of Laz 1.9+ for DayView icons. git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@6438 8e941d3f-bd1b-0410-a28a-d453659cc2b4 --- .../tvplanit/source/vpdayviewpainter.pas | 82 +++++++++--- components/tvplanit/source/vpevnteditdlg.pas | 117 +++++++++++------- 2 files changed, 136 insertions(+), 63 deletions(-) diff --git a/components/tvplanit/source/vpdayviewpainter.pas b/components/tvplanit/source/vpdayviewpainter.pas index 171e1d22a..a1589db12 100644 --- a/components/tvplanit/source/vpdayviewpainter.pas +++ b/components/tvplanit/source/vpdayviewpainter.pas @@ -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; diff --git a/components/tvplanit/source/vpevnteditdlg.pas b/components/tvplanit/source/vpevnteditdlg.pas index 88edcae84..bf2bae598 100644 --- a/components/tvplanit/source/vpevnteditdlg.pas +++ b/components/tvplanit/source/vpevnteditdlg.pas @@ -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);