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

15
components/tvplanit/examples/dayview_wrapstyle/dvwsmain.lfm
View File

@ -132,13 +132,14 @@ object Form1: TForm1
Printer.Granularity = gr30Min
Printer.MarginUnits = imAbsolutePixel
Printer.PrintFormats = <>
Left = 147
Top = 66
Left = 248
Top = 118
end
object VpIniDatastore1: TVpIniDatastore
CategoryColorMap.Category0.Description = 'Category 0'
CategoryColorMap.Category0.ImageIndex = 0
CategoryColorMap.Category1.Description = 'Category 1'
CategoryColorMap.Category1.ImageIndex = 9
CategoryColorMap.Category2.Description = 'Category 2'
CategoryColorMap.Category3.Description = 'Category 3'
CategoryColorMap.Category4.Description = 'Category 4'
@ -152,11 +153,11 @@ object Form1: TForm1
Images = ImageList2
AutoConnect = True
FileName = 'data.ini'
Left = 147
Top = 120
Left = 248
Top = 184
end
object ImageList1: TImageList
Left = 256
Left = 344
Top = 118
Bitmap = {
4C7A0400000010000000100000003E0300000000000078DAED574D485451143E
@ -191,8 +192,8 @@ object Form1: TForm1
object ImageList2: TImageList
Height = 24
Width = 24
Left = 216
Top = 228
Left = 344
Top = 184
Bitmap = {
4C7A040000001800000018000000960500000000000078DAED595D685C45143E
F5A7E2BF2F2A8AE243157D525111C420C67F04ADD65A412CF82A1524B6D4DF87

20
components/tvplanit/examples/fulldemo/bufdsdatamodule.lfm
View File

@ -5,33 +5,21 @@ object DemoDM: TDemoDM
VerticalOffset = 519
Width = 277
object Datastore: TVpBufDSDataStore
CategoryColorMap.Category0.Color = clNavy
CategoryColorMap.Category0.Description = 'Category 0'
CategoryColorMap.Category1.Color = clRed
CategoryColorMap.Category1.Description = 'Category 1'
CategoryColorMap.Category2.Color = clYellow
CategoryColorMap.Category2.Description = 'Category 2'
CategoryColorMap.Category3.Color = clLime
CategoryColorMap.Category3.Description = 'Category 3'
CategoryColorMap.Category4.Color = clPurple
CategoryColorMap.Category4.Description = 'Category 4'
CategoryColorMap.Category5.Color = clTeal
CategoryColorMap.Category5.Description = 'Category 5'
CategoryColorMap.Category6.Color = clFuchsia
CategoryColorMap.Category6.Description = 'Category 6'
CategoryColorMap.Category7.Color = clOlive
CategoryColorMap.Category7.Description = 'Category 7'
CategoryColorMap.Category8.Color = clAqua
CategoryColorMap.Category8.Description = 'Category 8'
CategoryColorMap.Category9.Color = clMaroon
CategoryColorMap.Category9.Description = 'Category 9'
EnableEventTimer = True
PlayEventSounds = True
HiddenCategories.BackgroundColor = clSilver
HiddenCategories.Color = clGray
AutoConnect = True
AutoCreate = True
DayBuffer = 31
Directory = 'data'
left = 87
top = 32
Left = 87
Top = 32
end
end

2
components/tvplanit/examples/fulldemo/bufdsdatamodule.pas
View File

@ -5,7 +5,7 @@ unit bufdsdatamodule;
interface
uses
Classes, SysUtils, FileUtil, VpBufDS;
Classes, SysUtils, Controls, VpBufDS;
type

15
components/tvplanit/source/vpdayview.pas
View File

@ -115,7 +115,7 @@ type
{ Forward Declarations }
TVpDayView = class;
TVpDvInplaceEdit = class(TCustomEdit)
TVpDvInplaceEdit = class(TCustomMemo) //TCustomEdit)
protected
procedure CreateParams(var Params: TCreateParams); override;
procedure KeyDown(var Key: Word; Shift: TShiftState); override;
@ -560,13 +560,15 @@ begin
inherited Create(AOwner);
TabStop := False;
BorderStyle := bsNone;
WantReturns := false;
WantTabs := false;
// DoubleBuffered := False;
end;
procedure TVpDvInPlaceEdit.CreateParams(var Params: TCreateParams);
begin
inherited CreateParams(Params);
Params.Style := Params.Style{$IFNDEF LCL} or ES_MULTILINE{$ENDIF};
// Params.Style := Params.Style{$IFNDEF LCL} or ES_MULTILINE{$ENDIF};
end;
procedure TVpDvInPlaceEdit.KeyDown(var Key: Word; Shift: TShiftState);
@ -2294,12 +2296,21 @@ begin
HeightOf(dvActiveEventRec)
)
else
{
dvInPlaceEditor.SetBounds(
dvActiveIconRec.Right + TextMargin,
dvActiveEventRec.Top + TextMargin,
WidthOf(dvActiveEventRec) - dvActiveIconRec.Right - TextMargin*2,
HeightOf(dvActiveEventRec) - TextMargin
);
}
dvInplaceEditor.SetBounds(
dvActiveEventRec.Left,
dvActiveEventRec.Top,
WidthOf(dvActiveEventRec),
HeightOf(dvActiveEventRec)
);
dvInPlaceEditor.Show;
dvInPlaceEditor.Text := FActiveEvent.Description;
Invalidate;

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

@ -1119,13 +1119,13 @@ begin
begin
{$IFDEF REGION_SUPPORT}
WorkRegion1 := CreateRectRgn(AIconRect.Right + FScaledTextMargin, AEventRect.Top, AEventRect.Right, AIconRect.Bottom);
WorkRegion2 := CreateRectRgn(AEventRect.Left + FScaledGutterWidth, AIconRect.Bottom, AEventRect.Right, AEventRect.Bottom);
WorkRegion2 := CreateRectRgn(AEventRect.Left + FScaledIconMargin, AIconRect.Bottom, AEventRect.Right, AEventRect.Bottom);
TextRegion := CreateRectRgn(AIconRect.Right, AEventRect.Top, AEventRect.Right, AIconRect.Bottom);
CombineRgn(TextRegion, WorkRegion1, WorkRegion2, RGN_OR);
{$ELSE}
SetLength(TextRects, 2);
TextRects[0] := Rect(AIconRect.Right + FScaledTextMargin, AEventRect.Top, AEventRect.Right, AIconRect.Bottom);
TextRects[1] := Rect(AEventRect.Left + FScaledGutterWidth, AIconRect.Bottom, AEventRect.Right, AEventRect.Bottom);
TextRects[1] := Rect(AEventRect.Left + FScaledIconMargin, AIconRect.Bottom, AEventRect.Right, AEventRect.Bottom);
{$ENDIF}
end else
begin
@ -1661,7 +1661,7 @@ begin
{$ENDIF}
if Event.AlarmSet then begin
if (FDayView.IconAttributes.AlarmImageIndex > -1) and (imgList <> nil) then
if (imgList <> nil) and Between(FDayView.IconAttributes.AlarmImageIndex, 0, imgList.Count-1) then
begin
{$IFDEF LCL}
{$IF LCL_FullVersion >= 1090000}
@ -1680,7 +1680,7 @@ begin
if Event.RepeatCode <> rtNone then
begin
if (FDayView.IconAttributes.RecurringImageIndex > -1) and (imgList <> nil) then
if (imgList <> nil) and Between(FDayView.IconAttributes.RecurringImageIndex, 0, imgList.Count-1) then
begin
{$IFDEF LCL}
{$IF LCL_FullVersion >= 1090000}
@ -1709,7 +1709,7 @@ begin
if Event.Category < 10 then
begin
cat := FDayView.Datastore.CategoryColorMap.GetCategory(Event.Category);
if (cat.ImageIndex > -1) and (imgList <> nil) then
if (imgList <> nil) and Between(cat.ImageIndex, 0, imgList.Count-1) then
begin
{$IFDEF LCL}
{$IF LCL_FullVersion >= 1090000}

2
components/tvplanit/source/vpevnteditdlg.lfm
View File

@ -11,7 +11,7 @@ object DlgEventEdit: TDlgEventEdit
OnCreate = FormCreate
OnShow = FormShow
Position = poScreenCenter
LCLVersion = '2.3.0.0'
LCLVersion = '3.99.0.0'
object ButtonPanel: TPanel
Left = 0
Height = 37

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;

36
components/tvplanit/source/vpmisc.pas
View File

@ -207,11 +207,15 @@ procedure LoadGlyphFromRCDATA(AGlyph: TBitmap; ABaseResName: String;
procedure LoadImageFromRCDATA(AImage: TImage; ABaseResName: String;
ALowRes, AMedRes, AHighRes: Integer; AdjustSize: Boolean = true);
procedure ScaleImg(AImage: TCustomBitmap; ANewWidth, ANewHeight: Integer);
function GetScrollbarHeight: Integer;
function GetScrollbarWidth: Integer;
procedure FixLabels({%H-}AForm: TCustomForm);
function Between(x, min, max: Integer): Boolean;
procedure Unused(const A1); overload;
procedure Unused(const A1, A2); overload;
procedure Unused(const A1, A2, A3); overload;
@ -222,7 +226,7 @@ implementation
uses
Math,
{$IFDEF LCL}
DateUtils, StrUtils, LazUTF8, EditBtn, ButtonPanel,
FPCanvas, IntfGraphics, LazCanvas, DateUtils, StrUtils, LazUTF8, EditBtn, ButtonPanel,
{$ENDIF}
VpSR, VpBaseDS;
@ -1286,6 +1290,30 @@ begin
end;
end;
{$IFDEF LCL}
procedure ScaleImg(AImage: TCustomBitmap; ANewWidth, ANewHeight: Integer);
var
srcImg: TLazIntfImage = nil;
destCanvas: TLazCanvas = nil;
begin
try
// Create the source LazIntfImage
srcImg := AImage.CreateIntfImage;
// Create the destination LazCanvas
destCanvas := TLazCanvas.Create(srcImg);
destCanvas.Interpolation := TFPBaseInterpolation.Create;
// Execute the canvas.StretchDraw
destCanvas.StretchDraw(0, 0, ANewWidth, ANewHeight, srcImg);
// Reload the stretched image into the CustomBitmap
AImage.LoadFromIntfImage(srcImg);
AImage.SetSize(ANewWidth, ANewHeight);
finally
destCanvas.Free;
srcImg.Free;
end;
end;
{$ENDIF}
function GetScrollbarHeight: Integer;
begin
Result := GetSystemMetrics(SM_CYHSCROLL);
@ -1310,6 +1338,12 @@ begin
{$IFEND}
end;
{ Returns true if x is between min and min, including limits. }
function Between(x, min, max: Integer): Boolean;
begin
Result := (x >= min) and (x <= max);
end;
{$PUSH}{$HINTS OFF}
procedure Unused(const A1);
begin