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

tvplanit: Support scaled imagelist of Laz 1.9+ in VpNavBar. Fix compilation with Laz 1.6.4/fpc 2.6.4.

Browse Source 
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@6388 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
wp_xxyyzz
2018-05-05 15:01:55 +00:00
parent daf38af9df
commit b68354b929
4 changed files with 119 additions and 34 deletions
Download Patch File Download Diff File Expand all files Collapse all files

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

@ -275,12 +275,11 @@ const
{$IFDEF LCL} {$IFDEF LCL}
{$IF LCL_FULLVERSION >= 1080100} {$IF LCL_FULLVERSION >= 1080100}
VP_LCL_SCALING = 2; VP_LCL_SCALING = 2;
{$ELSE} {$ELSEIF LCL_FULLVERSION >= 1080000}
{$IF LCL_FULLVERSION >= 1080000}
VP_LCL_SCALING = 1; VP_LCL_SCALING = 1;
{$ELSE} {$ELSE}
VP_LCL_SCALING = 0; VP_LCL_SCALING = 0;
{$ENDIF}{$ENDIF} {$ENDIF}
{$ELSE} {$ELSE}
VL_LCL_SCALING := 0; VL_LCL_SCALING := 0;
{$ENDIF} {$ENDIF}
@ -289,7 +288,10 @@ const
implementation implementation
initialization initialization
{$IFNDEF LCL}
{$IFDEF LCL}
//
{$ELSE}
ClickDelay := GetDoubleClickTime; ClickDelay := GetDoubleClickTime;
{$ENDIF} {$ENDIF}

7
components/tvplanit/source/vpjsonds.pas
View File

@ -486,7 +486,11 @@ begin
stream := TFileStream.Create(FFilename, fmOpenRead + fmShareDenyWrite); stream := TFileStream.Create(FFilename, fmOpenRead + fmShareDenyWrite);
try try
Resources.ClearResources; Resources.ClearResources;
{$IF FPC_FullVersion >= 30000}
p := TJSONParser.Create(stream, [joUTF8]); p := TJSONParser.Create(stream, [joUTF8]);
{$ELSE}
p := TJSONParser.Create(stream, true);
{$ENDIF}
try try
json := p.Parse as TJSONObject; json := p.Parse as TJSONObject;
resObjArray := json.Find('Resources', jtArray) as TJSONArray; resObjArray := json.Find('Resources', jtArray) as TJSONArray;
@ -647,6 +651,9 @@ var
task: TvpTask; task: TvpTask;
i, j: Integer; i, j: Integer;
stream: TStream; stream: TStream;
{$IF FPC_FullVersion < 30000}
s: TJSONStringType;
{$ENDIF}
begin begin
if FFilename = '' then if FFilename = '' then
raise Exception.Create(RSNoFilenameSpecified); raise Exception.Create(RSNoFilenameSpecified);

20
components/tvplanit/source/vpnavbar.pas
View File

@ -190,11 +190,13 @@ type
FBackgroundMethod: TVpBackgroundMethod; FBackgroundMethod: TVpBackgroundMethod;
// FBorderStyle: TBorderStyle; // FBorderStyle: TBorderStyle;
FButtonHeight: Integer; FButtonHeight: Integer;
FCanvasScaleFactor: Double;
FContainers: TVpContainerList; FContainers: TVpContainerList;
FDrawingStyle: TVpFolderDrawingStyle; FDrawingStyle: TVpFolderDrawingStyle;
FFolders: TVpCollection; FFolders: TVpCollection;
FHotFolder: Integer; FHotFolder: Integer;
FImages: TImageList; FImages: TImageList;
FImagesWidth: Integer;
FItemFont: TFont; FItemFont: TFont;
FItemSpacing: Integer; FItemSpacing: Integer;
FPreviousFolder: Integer; FPreviousFolder: Integer;
@ -257,6 +259,7 @@ type
// procedure SetBorderStyle(const Value: TBorderStyle); // procedure SetBorderStyle(const Value: TBorderStyle);
procedure SetButtonHeight(Value: Integer); procedure SetButtonHeight(Value: Integer);
procedure SetImages(Value: TImageList); procedure SetImages(Value: TImageList);
procedure SetImagesWidth(const AValue: Integer);
procedure SetItemFont(Value: TFont); procedure SetItemFont(Value: TFont);
procedure SetItemSpacing(Value: Integer); procedure SetItemSpacing(Value: Integer);
procedure SetSelectedItemFont(Value: TFont); procedure SetSelectedItemFont(Value: TFont);
@ -345,6 +348,7 @@ type
property DrawingStyle: TVpFolderDrawingStyle read FDrawingStyle write SetDrawingStyle; property DrawingStyle: TVpFolderDrawingStyle read FDrawingStyle write SetDrawingStyle;
property FolderCollection: TVpCollection read FFolders write FFolders; property FolderCollection: TVpCollection read FFolders write FFolders;
property Images: TImageList read FImages write SetImages; property Images: TImageList read FImages write SetImages;
property ImagesWidth: Integer read FImagesWidth write SetImagesWidth;
property ItemFont: TFont read FItemFont write SetItemFont; property ItemFont: TFont read FItemFont write SetItemFont;
property ItemSpacing: Integer read FItemSpacing write SetItemSpacing stored IsStoredItemSpacing; property ItemSpacing: Integer read FItemSpacing write SetItemSpacing stored IsStoredItemSpacing;
property PlaySounds: Boolean read FPlaySounds write FPlaySounds; property PlaySounds: Boolean read FPlaySounds write FPlaySounds;
@ -420,6 +424,9 @@ type
property DrawingStyle; property DrawingStyle;
property FolderCollection; property FolderCollection;
property Images; property Images;
{$IFDEF LCL}{$IF LCL_FullVersion >= 1090000}
property ImagesWidth;
{$ENDIF}{$ENDIF}
property ItemFont; property ItemFont;
property ItemSpacing; property ItemSpacing;
property PlaySounds; property PlaySounds;
@ -1021,7 +1028,7 @@ begin
FItemSpacing := DEFAULT_ITEMSPACING; FItemSpacing := DEFAULT_ITEMSPACING;
{$IF VP_LCL_SCALING = 0} {$IF VP_LCL_SCALING = 0}
FItemSpacing := ScaleY(FItemSpacing, DesignTimeDPI)} FItemSpacing := ScaleY(FItemSpacing, DesignTimeDPI);
{$ENDIF} {$ENDIF}
FSelectedItemFont := TFont.Create; FSelectedItemFont := TFont.Create;
@ -2070,6 +2077,10 @@ procedure TVpCustomNavBar.Paint;
var var
painter: TVpNavBarPainter; painter: TVpNavBarPainter;
begin begin
{$IFDEF LCL}{$IF LCL_FullVersion >= 1090000}
FCanvasScaleFactor := GetCanvasScaleFactor;
{$IFEND}{$ENDIF}
painter := TVpNavBarPainter.Create(Self); painter := TVpNavBarPainter.Create(Self);
try try
painter.Paint; painter.Paint;
@ -2941,6 +2952,13 @@ begin
end; end;
{=====} {=====}
procedure TVpCustomNavBar.SetImagesWidth(const AValue: Integer);
begin
if AValue = FImagesWidth then exit;
FImagesWidth := AValue;
Invalidate;
end;
procedure TVpCustomNavBar.SetItemFont(Value: TFont); procedure TVpCustomNavBar.SetItemFont(Value: TFont);
begin begin
if Assigned(Value) then if Assigned(Value) then

116
components/tvplanit/source/vpnavbarpainter.pas
View File

@ -6,7 +6,7 @@ interface
uses uses
{$IFDEF LCL} {$IFDEF LCL}
LCLProc, LCLType, LCLIntf, LCLProc, LCLType, LCLIntf, LCLVersion,
{$ELSE} {$ELSE}
Windows, Messages, MMSystem, Windows, Messages, MMSystem,
{$ENDIF} {$ENDIF}
@ -62,7 +62,7 @@ type
procedure DrawItemHighlight(Canvas: TCanvas; R: TRect; Enable: Boolean); procedure DrawItemHighlight(Canvas: TCanvas; R: TRect; Enable: Boolean);
function DrawItemText(Canvas: TCanvas; AItem: TVpNavBtnItem; CurPos: Integer; function DrawItemText(Canvas: TCanvas; AItem: TVpNavBtnItem; CurPos: Integer;
AText: String; AtLargeIcon: Boolean; out AWidth: Integer): Boolean; AText: String; AtLargeIcon: Boolean; out AHeight: Integer): Boolean;
function DrawLargeIcon(Canvas: TCanvas; AItem: TVpNavBtnItem; function DrawLargeIcon(Canvas: TCanvas; AItem: TVpNavBtnItem;
CurPos: Integer): Boolean; CurPos: Integer): Boolean;
function DrawSmallIcon(Canvas: TCanvas; AItem: TVpNavBtnItem; function DrawSmallIcon(Canvas: TCanvas; AItem: TVpNavBtnItem;
@ -92,7 +92,7 @@ function GetLargeIconDisplayName(Canvas: TCanvas; Rect: TRect; const Name: strin
implementation implementation
uses uses
Math, Themes, Math, Themes, imglist,
VpConst, VpMisc; VpConst, VpMisc;
type type
@ -138,28 +138,42 @@ procedure TVpNavBarPainter.DrawActiveFolderItems(Canvas: TCanvas; var CurPos: In
const const
BUTTON_DISTANCE = 8; BUTTON_DISTANCE = 8;
LARGE_ICON_OFFSET = 4; LARGE_ICON_OFFSET = 4;
SMALL_ICON_OFFSET = 3; SMALL_ICON_TEXT_DISTANCE = 6;
var var
folder: TVpNavFolder; folder: TVpNavFolder;
item: TVpNavBtnItem; item: TVpNavBtnItem;
J: Integer; J: Integer;
text: String; text: String;
X: Integer; h: Integer;
R: TRect; R: TRect;
largeIconOffs: Integer; largeIconOffs: Integer;
smallIconOffs: Integer; smallIconOffs: Integer;
{$IFDEF LCL}
{$IF LCL_FullVersion >= 1090000}
imgres: TScaledImageListResolution;
f: Double;
ppi: Integer;
{$IFEND}
{$ENDIF}
begin begin
folder := FNavBar.Folders[FActiveFolder]; folder := FNavBar.Folders[FActiveFolder];
largeIconOffs := ScaleY(LARGE_ICON_OFFSET, DesignTimeDPI); largeIconOffs := ScaleY(LARGE_ICON_OFFSET, DesignTimeDPI);
smallIconOffs := ScaleX(SMALL_ICON_OFFSET, DesignTimeDPI); smallIconOffs := ScaleX(SMALL_ICON_TEXT_DISTANCE, DesignTimeDPI);
if FImages <> nil then begin if FImages <> nil then begin
{$IFDEF LCL}{$IF LCL_FullVersion >= 1090000}
with TVpNavBarOpener(FNavBar) do begin
f := FCanvasScaleFactor;
ppi := Font.PixelsPerInch;
imgRes := FImages.ResolutionForPPI[FImagesWidth, ppi, f];
end;
FLargeImagesSize := imgRes.Width;
{$ELSE}
FLargeImagesSize := FImages.Width; FLargeImagesSize := FImages.Width;
FSmallImagesSize := FImages.Width div 2; {$ENDIF}{$ENDIF}
end else begin end else
FLargeImagesSize := 32; FLargeImagesSize := 32;
FSmallImagesSize := 16; FSmallImagesSize := FLargeImagesSize div 2;
end;
if folder.FolderType = ftDefault then begin if folder.FolderType = ftDefault then begin
if folder.ItemCount = 0 then if folder.ItemCount = 0 then
@ -206,9 +220,9 @@ begin
CurPos := item.IconRect.Bottom; CurPos := item.IconRect.Bottom;
{now, draw the text} {now, draw the text}
if not DrawItemText(Canvas, item, CurPos, text, true, X) then if not DrawItemText(Canvas, item, CurPos, text, true, h) then
Continue; Continue;
Inc(CurPos, FItemSpacing + X); Inc(CurPos, FItemSpacing + h);
end else end else
begin begin
{ Small Icons } { Small Icons }
@ -221,9 +235,9 @@ begin
item.IconRect := R; item.IconRect := R;
{now, draw the text} {now, draw the text}
if not DrawItemText(Canvas, item, CurPos, text, false, X) then if not DrawItemText(Canvas, item, CurPos, text, false, h) then
Continue; Continue;
Inc(CurPos, FItemSpacing + X); Inc(CurPos, FItemSpacing + h);
end; { if folder.IconSize ... } end; { if folder.IconSize ... }
end; { for J } end; { for J }
end; { if folder.FolderType = ftDefault ... } end; { if folder.FolderType = ftDefault ... }
@ -522,7 +536,7 @@ begin
end; end;
function TVpNavBarPainter.DrawItemText(Canvas: TCanvas; AItem: TVpNavBtnItem; function TVpNavBarPainter.DrawItemText(Canvas: TCanvas; AItem: TVpNavBtnItem;
CurPos: Integer; AText: String; AtLargeIcon: Boolean; out AWidth: Integer): Boolean; CurPos: Integer; AText: String; AtLargeIcon: Boolean; out AHeight: Integer): Boolean;
const const
HOR_MARGIN = 5; HOR_MARGIN = 5;
var var
@ -533,20 +547,19 @@ var
horDist: Integer; horDist: Integer;
begin begin
Result := false; Result := false;
horDist := ScaleX(HOR_MARGIN, DesignTimeDPI);
if AtLargeIcon then if AtLargeIcon then
begin begin
horDist := ScaleX(HOR_MARGIN, DesignTimeDPI);
R.Top := CurPos; R.Top := CurPos;
R.Bottom := CurPos + FButtonHeight div 2 - 7; // what is -7 good for? R.Bottom := CurPos + FButtonHeight div 2 - 7; // what is -7 good for?
R.Left := 0; R.Left := 0;
R.Right := FNavBar.ClientWidth - 1; R.Right := FNavBar.ClientWidth - 1;
AItem.LabelRect := R; AItem.LabelRect := R;
AItem.DisplayName := GetLargeIconDisplayName(Canvas, R, AText); AItem.DisplayName := GetLargeIconDisplayName(Canvas, R, AText);
AWidth := Canvas.TextWidth(AItem.DisplayName); txtWidth := Canvas.TextWidth(AItem.DisplayName);
R.Left := Max(horDist, (FNavBar.ClientWidth - AWidth) div 2); R.Left := Max(horDist, (FNavBar.ClientWidth - txtWidth) div 2);
R.Right := Min(R.Left + AWidth, FNavBar.ClientWidth - hordist); R.Right := Min(R.Left + txtWidth, FNavBar.ClientWidth - hordist);
AItem.LabelRect := R; AItem.LabelRect := R;
if R.Top > nabItemsRect^.Bottom then if R.Top > nabItemsRect^.Bottom then
Exit; Exit;
@ -559,32 +572,40 @@ begin
AItem.LabelRect := R; AItem.LabelRect := R;
bkMode := SetBkMode(Canvas.Handle, TRANSPARENT); bkMode := SetBkMode(Canvas.Handle, TRANSPARENT);
AWidth := DrawText(Canvas.Handle, PChar(s), Length(s), R, DT_CENTER or DT_VCENTER or DT_WORDBREAK); AHeight:= DrawText(Canvas.Handle, PChar(s), Length(s), R, DT_CENTER or DT_VCENTER or DT_WORDBREAK);
SetBkMode(Canvas.Handle, bkMode); SetBkMode(Canvas.Handle, bkMode);
end else end else
begin begin
R.Top := CurPos; R.Top := CurPos;
R.Bottom := CurPos + FButtonHeight div 2 - 7; R.Bottom := CurPos + Canvas.TextHeight('Tg');
// R.Bottom := CurPos + FButtonHeight div 2 - 7;
R.Left := AItem.IconRect.Right; R.Left := AItem.IconRect.Right;
R.Right := R.Left + FNavBar.ClientWidth - R.Left - ScaleX(7, DesignTimeDPI); R.Right := FNavBar.ClientWidth - 2*AItem.IconRect.Left; // - 2*horDist;
// R.Right := R.Left + FNavBar.ClientWidth - R.Left - ScaleX(7, DesignTimeDPI);
AItem.LabelRect := R; AItem.LabelRect := R;
if R.Top > nabItemsRect^.Bottom then if R.Top > nabItemsRect^.Bottom then
Exit; Exit;
// Measure size of display string
R := AItem.LabelRect; R := AItem.LabelRect;
s := GetDisplayString(Canvas, AText, 1, WidthOf(R)); s := GetDisplayString(Canvas, AText, 1, WidthOf(R));
AItem.DisplayName := s; AItem.DisplayName := s;
DrawText(Canvas.Handle, PChar(s), Length(s), R, DT_LEFT or DT_VCENTER or DT_CALCRECT); DrawText(Canvas.Handle, PChar(s), Length(s), R, DT_LEFT or DT_CALCRECT);
txtWidth := WidthOf(R); txtWidth := WidthOf(R);
AHeight := HeightOf(R);
R.Right := R.Left + txtWidth + 1; R.Right := R.Left + txtWidth + 1;
{$IFDEF MSWINDOWS}
OffsetRect(R, 0, -1); // Better centering of text
{$ENDIF}
AItem.LabelRect := R; AItem.LabelRect := R;
bkMode := SetBkMode(Canvas.Handle, TRANSPARENT); bkMode := SetBkMode(Canvas.Handle, TRANSPARENT);
AWidth := DrawText(Canvas.Handle, PChar(s), Length(s), R, DT_LEFT or DT_VCENTER); Canvas.TextOut(R.Left, (R.Top + R.Bottom - AHeight) div 2, s);
// AHeight := DrawText(Canvas.Handle, PChar(s), Length(s), R, DT_LEFT or DT_VCENTER);
SetBkMode(Canvas.Handle, bkMode); SetBkMode(Canvas.Handle, bkMode);
if AWidth < 16 then AWidth := 16; // This it the width of the small icons if AHeight < FSmallImagesSize then
AHeight := FSmallImagesSize;
end; end;
Result := true; Result := true;
end; end;
@ -599,19 +620,27 @@ var
W, H: Integer; W, H: Integer;
R: TRect; R: TRect;
dist: Integer; dist: Integer;
{$IFDEF LCL}{$IF LCL_FullVersion >= 1090000}
imgres: TScaledImageListResolution;
f: Double;
ppi: Integer;
{$ENDIF}{$ENDIF}
begin begin
Result := false; Result := false;
{ If an image list is assigned then use the image size. { If an image list is assigned then use the image size.
If no image list is assinged then assume a 32 x 32 image size. } If no image list is assinged then assume a 32 x 32 image size. }
dist := ScaleX(MARGIN, DesignTimeDPI); dist := ScaleX(MARGIN, DesignTimeDPI);
W := FLargeImagesSize + 2*dist;
H := FLargeImagesSize + 2*dist;
{
if Assigned(FImages) then begin if Assigned(FImages) then begin
W := FImages.Width + 2*dist; W := FImages.Width + 2*dist;
H := FImages.Height + 2*dist; H := FImages.Height + 2*dist;
end else begin end else begin
W := ScaleX(32, DesignTimeDPI); W := ScaleX(32, DesignTimeDPI);
H := ScaleY(32, DesignTimeDPI); H := ScaleY(32, DesignTimeDPI);
end; end;}
R.Top := CurPos; R.Top := CurPos;
R.Bottom := CurPos + H; R.Bottom := CurPos + H;
@ -625,7 +654,18 @@ begin
if FShowButtons then begin if FShowButtons then begin
DrawItemHighlight(Canvas, R, FActiveItem = AItem.Index); DrawItemHighlight(Canvas, R, FActiveItem = AItem.Index);
if Assigned(FImages) and (AItem.IconIndex >= 0) and (AItem.IconIndex < FImages.Count) then if Assigned(FImages) and (AItem.IconIndex >= 0) and (AItem.IconIndex < FImages.Count) then
begin
{$IFDEF LCL}{$IF LCL_FullVersion >= 1090000}
with TVpNavBarOpener(FNavBar) do begin
f := FCanvasScalefactor;
ppi := Font.PixelsPerInch;
end;
imgRes := FImages.ResolutionForPPI[FImages.Width, ppi, f];
imgRes.Draw(Canvas, R.Left + dist, R.Top + dist, AItem.IconIndex);
{$ELSE}
FImages.Draw(Canvas, R.Left + dist, R.Top + dist, AItem.IconIndex); FImages.Draw(Canvas, R.Left + dist, R.Top + dist, AItem.IconIndex);
{$ENDIF}{$ENDIF}
end;
end; end;
Result := true; Result := true;
@ -636,17 +676,26 @@ function TVpNavBarPainter.DrawSmallIcon(Canvas: TCanvas; AItem: TVpNavBtnItem;
CurPos: Integer): Boolean; CurPos: Integer): Boolean;
const const
DELTA = 8; DELTA = 8;
MARGIN = 2;
var var
lOffset: Integer; lOffset: Integer;
bmp: TBitmap;
R: TRect; R: TRect;
del: Integer; del: Integer;
m: Integer;
{$IFDEF LCL}{$IF LCL_FullVersion >= 1090000}
imgres: TScaledImageListResolution;
f: Double;
ppi: Integer;
{$ELSE}
bmp: TBitmap;
{$ENDIF}{$ENDIF}
begin begin
Result := false; Result := false;
{glyph is at the left} {glyph is at the left}
R.Top := CurPos; R.Top := CurPos;
del := ScaleY(DELTA, DesignTimeDPI); del := ScaleY(DELTA, DesignTimeDPI);
m := ScaleX(MARGIN, DesignTimeDPI);
lOffset := abs(Canvas.Font.Height) div 2; lOffset := abs(Canvas.Font.Height) div 2;
if lOffset > del then if lOffset > del then
R.Top := R.Top + lOffset - del; R.Top := R.Top + lOffset - del;
@ -660,6 +709,14 @@ begin
if FShowButtons then begin if FShowButtons then begin
DrawItemHighlight(Canvas, R, FActiveItem = AItem.Index); DrawItemHighlight(Canvas, R, FActiveItem = AItem.Index);
if Assigned(FImages) then begin if Assigned(FImages) then begin
{$IFDEF LCL}{$IF LCL_FullVersion >= 1090000}
with TVpNavBarOpener(FNavBar) do begin
f := FCanvasScalefactor;
ppi := Font.PixelsPerInch;
end;
imgRes := FImages.ResolutionForPPI[FImages.Width div 2, ppi, f];
imgRes.Draw(Canvas, R.Left, R.Top, AItem.IconIndex);
{$ELSE}
bmp := TBitmap.Create; bmp := TBitmap.Create;
try try
FImages.GetBitmap(AItem.IconIndex, bmp); FImages.GetBitmap(AItem.IconIndex, bmp);
@ -668,6 +725,7 @@ begin
finally finally
bmp.Free; bmp.Free;
end; end;
{$ENDIF}{$ENDIF}
end; end;
end; end;