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

tvplanit: Support VpNavBar scaling with screen resolution.

Browse Source 
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@6386 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
wp_xxyyzz
2018-05-04 22:28:03 +00:00
parent 74675b1396
commit 3cfeca9127
8 changed files with 233 additions and 74 deletions
Download Patch File Download Diff File Expand all files Collapse all files

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

@ -270,6 +270,8 @@ const
{ Hint support }
MAX_HINT_WIDTH = 400;
DesignTimeDPI = 96;
{$IFDEF LCL}
{$IF LCL_FULLVERSION >= 1080100}
VP_LCL_SCALING = 2;

3
components/tvplanit/source/vpcontactbuttons.pas
View File

@ -180,6 +180,9 @@ type
implementation
uses
VpConst;
{ TVpContactButtonBar }
constructor TVpContactButtonBar.Create(AOwner: TComponent);

2
components/tvplanit/source/vpedshape.pas
View File

@ -121,7 +121,7 @@ implementation
uses
Math, TypInfo,
VpMisc, VpSr;
VpConst, VpMisc, VpSr;
{ TfrmEditShape }

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

@ -66,7 +66,7 @@ implementation
uses
LazFileUtils,
jsonparser,
jsonscanner, jsonparser,
VpSR, VpMisc;
constructor TVpJSONDatastore.Create(AOwner: TComponent);
@ -486,7 +486,7 @@ begin
stream := TFileStream.Create(FFilename, fmOpenRead + fmShareDenyWrite);
try
Resources.ClearResources;
p := TJSONParser.Create(stream);
p := TJSONParser.Create(stream, [joUTF8]);
try
json := p.Parse as TJSONObject;
resObjArray := json.Find('Resources', jtArray) as TJSONArray;

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

@ -59,8 +59,6 @@ const
GranularityMinutes: Array[TVpGranularity] of Integer = (5, 6, 10, 15, 20, 30, 60);
DesignTimeDPI = 96;
function DefaultEpoch : Integer;
{-return the current century}

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

@ -36,7 +36,7 @@ interface
uses
{$IFDEF LCL}
LMessages, LCLProc, LCLType, LCLIntf,
LMessages, LCLProc, LCLType, LCLIntf, LCLVersion,
{$ELSE}
Windows, Messages, MMSystem,
{$ENDIF}
@ -196,7 +196,7 @@ type
FHotFolder: Integer;
FImages: TImageList;
FItemFont: TFont;
FItemSpacing: Word;
FItemSpacing: Integer;
FPreviousFolder: Integer;
FPreviousItem: Integer;
FPlaySounds: Boolean;
@ -248,6 +248,7 @@ type
function GetFolder(Index: Integer): TVpNavFolder;
function GetFolderCount: Integer;
function GetContainer(Index: Integer): TVpFolderContainer;
function IsStoredItemSpacing: boolean;
procedure SetActiveFolder(Value: Integer);
procedure SetBackgroundColor(Value: TColor);
procedure SetBackgroundImage(Value: TBitmap);
@ -257,7 +258,7 @@ type
procedure SetButtonHeight(Value: Integer);
procedure SetImages(Value: TImageList);
procedure SetItemFont(Value: TFont);
procedure SetItemSpacing(Value: Word);
procedure SetItemSpacing(Value: Integer);
procedure SetSelectedItemFont(Value: TFont);
procedure SetScrollDelta(Value: Integer);
@ -299,6 +300,15 @@ type
procedure WMEraseBkGnd(var Msg: TLMEraseBkGnd); message LM_ERASEBKGND;
procedure WMNCHitTest(var Msg: TLMNCHitTest); message LM_NCHITTEST;
procedure WMSetCursor(var Msg: TLMSetCursor); message LM_SETCURSOR;
{$IF LCL_FullVersion >= 1080000}
procedure DoAutoAdjustLayout(const AMode: TLayoutAdjustmentPolicy;
const AXProportion, AYProportion: Double);
{$ENDIF}
{$IF VP_LCL_SCALING = 2}
procedure ScaleFontsPPI(const AToPPI: Integer; const AProportion: Double);
{$ELSEIF VP_LCL_SCALING = 1}
procedure ScaleFontsPPI(const AProportion: Double);
{$ENDIF}
{$ENDIF}
procedure CreateParams(var Params: TCreateParams); override;
procedure CreateWnd; override;
@ -331,12 +341,12 @@ type
property BackgroundColor: TColor read FBackgroundColor write SetBackgroundColor default clWindow;
property BackgroundImage: TBitmap read FBackgroundImage write SetBackgroundImage;
property BackgroundMethod: TVpBackgroundMethod read FBackgroundMethod write SetBackgroundMethod;
property ButtonHeight: Integer read FButtonHeight write SetButtonHeight;
property ButtonHeight: Integer read FButtonHeight write SetButtonHeight default 0;
property DrawingStyle: TVpFolderDrawingStyle read FDrawingStyle write SetDrawingStyle;
property FolderCollection: TVpCollection read FFolders write FFolders;
property Images: TImageList read FImages write SetImages;
property ItemFont: TFont read FItemFont write SetItemFont;
property ItemSpacing: Word read FItemSpacing write SetItemSpacing;
property ItemSpacing: Integer read FItemSpacing write SetItemSpacing stored IsStoredItemSpacing;
property PlaySounds: Boolean read FPlaySounds write FPlaySounds;
property ScrollDelta: Integer read FScrollDelta write SetScrollDelta default 2;
property SelectedItem: Integer read FSelectedItem write FSelectedItem;
@ -375,6 +385,7 @@ type
function GetFolderAt(X, Y: Integer): Integer;
function GetItemAt(X, Y: Integer): Integer;
function Container: TVpFolderContainer;
function GetRealButtonHeight: Integer;
procedure InsertFolder(const ACaption: string; AFolderIndex: Integer);
procedure AddFolder(const ACaption: string);
procedure RemoveFolder(AFolderIndex: Integer);
@ -473,6 +484,9 @@ uses
Themes,
VpNavBarPainter;
const
DEFAULT_ITEMSPACING = 8;
{$IFNDEF PAINTER}
{DrawNavTab - returns the usable text area inside the tab rect.}
function DrawNavTab(Canvas: TCanvas; const Client: TRect; BevelWidth: Integer;
@ -981,8 +995,6 @@ end;
{===== TVpNavBar ================================================}
constructor TVpCustomNavBar.Create(AOwner: TComponent);
{var
HSnd: THandle; }
begin
inherited Create(AOwner);
BorderStyle := bsNone;
@ -1006,7 +1018,11 @@ begin
FItemFont.Name := Font.Name;
FItemFont.OnChange := nabFontChanged;
FItemFont.Color := clWindowText;
FItemSpacing := abs(FItemFont.Height) + 3;
FItemSpacing := DEFAULT_ITEMSPACING;
{$IF VP_LCL_SCALING = 0}
FItemSpacing := ScaleY(FItemSpacing, DesignTimeDPI)}
{$ENDIF}
FSelectedItemFont := TFont.Create;
FSelectedItemFont.Name := Font.Name;
@ -1037,8 +1053,8 @@ begin
{$ENDIF}
NumGlyphs := 1;
Left := -20;
Height := 15;
Width := 17;
Height := ScaleY(15, DesignTimeDPI);
Width := ScaleX(17, DesignTimeDPI);
end;
nabScrollDownBtn := TSpeedButton.Create(Self);
@ -1053,8 +1069,8 @@ begin
{$ENDIF}
NumGlyphs := 1;
Left := -20;
Height := 15;
Width := 17;
Height := ScaleY(15, DesignTimeDPI);
Width := ScaleX(17, DesignTimeDPI);
end;
{create edit control}
@ -1064,8 +1080,8 @@ begin
nabEdit.OnExit := nabCommitEdit;
end;
Height := 240;
Width := 120;
Height := ScaleY(240, DesignTimeDPI);
Width := ScaleY(120, DesignTimeDPI);
ParentColor := False;
FAllowRearrange := True;
@ -1073,7 +1089,7 @@ begin
FBackgroundImage := TBitmap.Create;
FBackgroundMethod := bmNormal;
// FBorderStyle := bsSingle;
FButtonHeight := 20;
FButtonHeight := 0;
FActiveFolder := -1;
FActiveItem := -1;
FSelectedItem := -1;
@ -1314,6 +1330,23 @@ begin
end;
{=====}
function TVpCustomNavBar.GetRealButtonHeight: Integer;
begin
if FButtonHeight = 0 then begin
if Font.IsDefault then
Canvas.Font.Assign(Screen.SystemFont)
else
Canvas.Font.Assign(Font);
Result := Canvas.TextHeight('Tg') + ScaleY(4, DesignTimeDPI) + 1;
end else
Result := ScaleY(FButtonHeight, DesignTimeDPI);
end;
function TVpCustomNavBar.IsStoredItemSpacing: Boolean;
begin
Result := FItemSpacing <> DEFAULT_ITEMSPACING;
end;
function TVpCustomNavBar.Container: TVpFolderContainer;
begin
if Folders[FActiveFolder].FolderType = ftContainer then
@ -1689,14 +1722,16 @@ end;
function TVpCustomNavBar.nabGetFolderArea(Index: Integer): TRect;
var
I : Integer;
btnHeight: Integer;
begin
Unused(Index);
Result := ClientRect;
btnHeight := GetRealButtonHeight;
for I := 0 to ActiveFolder do
Inc(Result.Top, FButtonHeight);
Inc(Result.Top, btnHeight);
for I := FolderCount-1 downto ActiveFolder+1 do
Dec(Result.Bottom, FButtonHeight);
Dec(Result.Bottom, btnHeight);
end;
{=====}
@ -2733,6 +2768,7 @@ var
R: TRect;
R2: TRect;
AllowChange: Boolean;
btnHeight: Integer;
begin
if Value <> FActiveFolder then begin
@ -2740,6 +2776,7 @@ begin
FActiveFolder := -1
else
if (Value > -1) and (Value < FolderCount) then begin
btnHeight := GetRealButtonHeight;
{ Fire DoFolderChange only if not dragging. }
if nabDragFromItem = -1 then begin
{ Default for AllowChange is True. }
@ -2774,14 +2811,14 @@ begin
if Value > FActiveFolder then begin
{up}
YDelta := -FScrollDelta;
Inc(R.Bottom, Abs(Value-FActiveFolder)*FButtonHeight);
R2.Top := R2.Bottom+Abs(Value-FActiveFolder)*FButtonHeight;
Inc(R.Bottom, Abs(Value-FActiveFolder)*btnHeight);
R2.Top := R2.Bottom+Abs(Value-FActiveFolder)*btnHeight;
R2.Bottom := R2.Top;
end else begin
{down}
YDelta := +FScrollDelta;
Dec(R.Top, Abs(Value-FActiveFolder)*FButtonHeight);
R2.Bottom := R2.Top-Abs(Value-FActiveFolder)*FButtonHeight;
Dec(R.Top, Abs(Value-FActiveFolder)*btnHeight);
R2.Bottom := R2.Top-Abs(Value-FActiveFolder)*btnHeight;
R2.Top := R2.Bottom;
end;
Y := RectHeight(R)-FScrollDelta;
@ -2856,7 +2893,7 @@ begin
if Value <> FButtonHeight then begin
{Minimum ButtonHeight for CoolTabs is 17}
if FDrawingStyle = dsCoolTab then begin
if Value < 17
if (Value < 17) and (FButtonHeight <> 0)
then FButtonHeight := 17
else FButtonHeight := Value;
end else
@ -2911,12 +2948,12 @@ begin
end;
{=====}
procedure TVpCustomNavBar.SetItemSpacing(Value: Word);
procedure TVpCustomNavBar.SetItemSpacing(Value: Integer);
begin
if (Value > 0) then begin
FItemSpacing := Value;
Invalidate;
end;
if (FItemSpacing = Value) then
exit;
FItemSpacing := Value;
Invalidate;
end;
{=====}
@ -3116,6 +3153,42 @@ begin
end;
end;
{$IF LCL_FullVersion >= 1080000}
procedure TVpCustomNavBar.DoAutoAdjustLayout(const AMode: TLayoutAdjustmentPolicy;
const AXProportion, AYProportion: Double);
begin
inherited DoAutoAdjustLayout(AMode, AXProportion, AYProportion);
if AMode in [lapAutoAdjustWithoutHorizontalScrolling, lapAutoAdjustForDPI] then
begin
DisableAutoSizing;
try
// FButtonHeight := round(FButtonHeight * AYProportion);
if not IsStoredItemSpacing then
FItemSpacing := round(FItemSpacing * AYProportion);
finally
EnableAutoSizing;
end;
end;
end;
{$IF VP_LCL_SCALING = 2}
procedure TVpCustomNavBar.ScaleFontsPPI(const AToPPI: Integer;
const AProportion: Double);
begin
inherited;
DoScaleFontPPI(FItemFont, AToPPI, AProportion);
DoScaleFontPPI(FSelectedItemFont, AToPPI, AProportion);
end;
{$ELSEIF VP_LCL_SCALING = 1}
procedure TVpCustomNavBar.ScaleFontsPPI(const AProportion: Double);
begin
inherited;
DoScaleFontPPI(FItemFont.Font, AProportion);
DoScaleFontPPI(FScaledItem.Font, AProportion);
end;
{$ENDIF}
{$ENDIF}
initialization
RegisterClass(TVpFolderContainer);

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

@ -37,6 +37,8 @@ type
FSelectedItem: Integer;
FSelectedItemFont: TFont;
FShowButtons: Boolean;
FSmallImagesSize: Integer;
FLargeImagesSize: Integer;
nabItemsRect: PRect;
nabLastMouseOverItem: Integer;
@ -49,12 +51,14 @@ type
procedure DrawBackground(Canvas: TCanvas; R: TRect);
function DrawCoolTab(Canvas: TCanvas; R: TRect; ATabIndex: Integer;
ATabColor: TColor): TRect;
function DrawDefButton(Canvas: TCanvas; R: TRect; ATabIndex: Integer): TRect;
function DrawEtchedButton(Canvas: TCanvas; R: TRect; ATabIndex: Integer): TRect;
function DrawStandardTab(Canvas: TCanvas; R: TRect; ATabIndex: Integer;
ATabColor: TColor): TRect;
function DrawCoolTab(Canvas: TCanvas; R: TRect;
ATabIndex: Integer; ATabColor: TColor): TRect;
function DrawDefButton(Canvas: TCanvas; R: TRect;
ATabIndex: Integer): TRect;
function DrawEtchedButton(Canvas: TCanvas; R: TRect;
ATabIndex: Integer): TRect;
function DrawStandardTab(Canvas: TCanvas; R: TRect;
ATabIndex: Integer; ATabColor: TColor): TRect;
procedure DrawItemHighlight(Canvas: TCanvas; R: TRect; Enable: Boolean);
function DrawItemText(Canvas: TCanvas; AItem: TVpNavBtnItem; CurPos: Integer;
@ -89,7 +93,7 @@ implementation
uses
Math, Themes,
VpMisc;
VpConst, VpMisc;
type
TVpNavBarOpener = class(TVpCustomNavBar);
@ -104,7 +108,7 @@ begin
FBackgroundColor := TVpNavBarOpener(FNavBar).BackgroundColor;
FBackgroundImage := TVpNavBarOpener(FNavBar).BackgroundImage;
FBackgroundMethod := TVpNavBarOpener(FNavBar).BackgroundMethod;
FButtonHeight := TVpNavBarOpener(FNavBar).ButtonHeight;
FButtonHeight := TVpNavBarOpener(FNavBar).GetRealButtonHeight;
FClientWidth := TVpNavBarOpener(FNavBar).ClientWidth;
FClientHeight := TVpNavBarOpener(FNavBar).ClientHeight;
FDrawingStyle := TVpNavBarOpener(FNavBar).DrawingStyle;
@ -131,6 +135,10 @@ end;
{ Draw the items for the active folder }
procedure TVpNavBarPainter.DrawActiveFolderItems(Canvas: TCanvas; var CurPos: Integer);
const
BUTTON_DISTANCE = 8;
LARGE_ICON_OFFSET = 4;
SMALL_ICON_OFFSET = 3;
var
folder: TVpNavFolder;
item: TVpNavBtnItem;
@ -138,15 +146,27 @@ var
text: String;
X: Integer;
R: TRect;
largeIconOffs: Integer;
smallIconOffs: Integer;
begin
folder := FNavBar.Folders[FActiveFolder];
largeIconOffs := ScaleY(LARGE_ICON_OFFSET, DesignTimeDPI);
smallIconOffs := ScaleX(SMALL_ICON_OFFSET, DesignTimeDPI);
if FImages <> nil then begin
FLargeImagesSize := FImages.Width;
FSmallImagesSize := FImages.Width div 2;
end else begin
FLargeImagesSize := 32;
FSmallImagesSize := 16;
end;
if folder.FolderType = ftDefault then begin
if folder.ItemCount = 0 then
exit;
// Distance of top-most icon to the last upper button
Inc(CurPos, 8);
Inc(CurPos, ScaleY(BUTTON_DISTANCE, DesignTimeDPI));
with nabItemsRect^ do begin
Top := CurPos;
@ -181,7 +201,7 @@ begin
{make the icon's bottom blend into the label's top}
R := item.IconRect;
inc(R.Bottom, 4);
inc(R.Bottom, largeIconOffs);
item.IconRect := R;
CurPos := item.IconRect.Bottom;
@ -197,7 +217,7 @@ begin
{make the icon's right blend into the label's left}
R := item.IconRect;
inc(R.Right, 3);
inc(R.Right, smallIconOffs);
item.IconRect := R;
{now, draw the text}
@ -329,15 +349,15 @@ begin
Points[2] := Point(R.Left + 14, R.Top + 6); {Control point}
Points[3] := Point(R.Left + 15, R.Top + 1); {Control point}
Points[4] := Point(R.Left + 21, R.Top + 0); {End point}
{$IFNDEF VERSION4}
{$IFNDEF VERSION4}
{$IFDEF CBuilder}
PolyBezier(Points);
{$ELSE}
Polyline(Points);
{$ENDIF}
{$ELSE}
{$ELSE}
PolyBezier([Points[1], Points[2], Points[3], Points[4]]);
{$ENDIF}
{$ENDIF}
{Draw the top of the tab}
MoveTo(R.Left + 21, R.Top);
@ -503,25 +523,30 @@ end;
function TVpNavBarPainter.DrawItemText(Canvas: TCanvas; AItem: TVpNavBtnItem;
CurPos: Integer; AText: String; AtLargeIcon: Boolean; out AWidth: Integer): Boolean;
const
HOR_MARGIN = 5;
var
R: TRect;
s: String;
txtWidth: Integer;
bkMode: Integer;
horDist: Integer;
begin
Result := false;
if AtLargeIcon then
begin
horDist := ScaleX(HOR_MARGIN, DesignTimeDPI);
R.Top := CurPos;
R.Bottom := CurPos + FButtonHeight div 2 - 7;
R.Bottom := CurPos + FButtonHeight div 2 - 7; // what is -7 good for?
R.Left := 0;
R.Right := FNavBar.ClientWidth - 1;
AItem.LabelRect := R;
AItem.DisplayName := GetLargeIconDisplayName(Canvas, R, AText);
AWidth := Canvas.TextWidth(AItem.DisplayName);
R.Left := Max(5, (FNavBar.ClientWidth - AWidth) div 2);
R.Right := Min(R.Left + AWidth, FNavBar.ClientWidth - 5);
R.Left := Max(horDist, (FNavBar.ClientWidth - AWidth) div 2);
R.Right := Min(R.Left + AWidth, FNavBar.ClientWidth - hordist);
AItem.LabelRect := R;
if R.Top > nabItemsRect^.Bottom then
Exit;
@ -542,7 +567,7 @@ begin
R.Top := CurPos;
R.Bottom := CurPos + FButtonHeight div 2 - 7;
R.Left := AItem.IconRect.Right;
R.Right := R.Left + FNavBar.ClientWidth - R.Left - 7;
R.Right := R.Left + FNavBar.ClientWidth - R.Left - ScaleX(7, DesignTimeDPI);
AItem.LabelRect := R;
if R.Top > nabItemsRect^.Bottom then
Exit;
@ -564,23 +589,28 @@ begin
Result := true;
end;
{ Draw a large icon: centered horizontally, text to be drawn underneath icon. }
{ Draw a large icon: centered horizontally, text to be drawn underneath icon.
CurPos is upper edge of the icon. }
function TVpNavBarPainter.DrawLargeIcon(Canvas: TCanvas; AItem: TVpNavBtnItem;
CurPos: Integer): Boolean;
const
MARGIN = 2;
var
W, H: Integer;
R: TRect;
dist: Integer;
begin
Result := false;
{ 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. }
dist := ScaleX(MARGIN, DesignTimeDPI);
if Assigned(FImages) then begin
W := FImages.Width + 2;
H := FImages.Height + 2;
W := FImages.Width + 2*dist;
H := FImages.Height + 2*dist;
end else begin
W := 32;
H := 32;
W := ScaleX(32, DesignTimeDPI);
H := ScaleY(32, DesignTimeDPI);
end;
R.Top := CurPos;
@ -595,7 +625,7 @@ begin
if FShowButtons then begin
DrawItemHighlight(Canvas, R, FActiveItem = AItem.Index);
if Assigned(FImages) and (AItem.IconIndex >= 0) and (AItem.IconIndex < FImages.Count) then
FImages.Draw(Canvas, R.Left + 2, R.Top + 2, AItem.IconIndex);
FImages.Draw(Canvas, R.Left + dist, R.Top + dist, AItem.IconIndex);
end;
Result := true;
@ -605,23 +635,24 @@ end;
function TVpNavBarPainter.DrawSmallIcon(Canvas: TCanvas; AItem: TVpNavBtnItem;
CurPos: Integer): Boolean;
const
W = 16;
H = 16;
DELTA = 8;
var
lOffset: Integer;
bmp: TBitmap;
R: TRect;
del: Integer;
begin
Result := false;
{glyph is at the left}
R.Top := CurPos;
del := ScaleY(DELTA, DesignTimeDPI);
lOffset := abs(Canvas.Font.Height) div 2;
if lOffset > 8 then
R.Top := R.Top + lOffset - 8;
R.Bottom := R.Top + H;
R.Left := 8;
R.Right := R.Left + W;
if lOffset > del then
R.Top := R.Top + lOffset - del;
R.Bottom := R.Top + FSmallImagesSize;
R.Left := del;
R.Right := R.Left + FSmallImagesSize;
AItem.IconRect := R;
if R.Top > nabItemsRect^.Bottom then
Exit; // Returns false
@ -647,9 +678,21 @@ end;
Returns the usable text area inside the tab rect.}
function TVpNavBarPainter.DrawStandardTab(Canvas: TCanvas; R: TRect;
ATabIndex: Integer; ATabColor: TColor): TRect;
const
_LEFT_DISTANCE = 10;
_RIGHT_DISTANCE = 2;
_RADIUS = 2;
var
leftDist: Integer;
rightDist: Integer;
radius: Integer;
begin
Result := R;
leftDist := ScaleX(_LEFT_DISTANCE, DesignTimeDPI);
rightDist := ScaleX(_RIGHT_DISTANCE, DesignTimeDPI);
radius := ScaleX(_RADIUS, DesignTimeDPI);
{fill the tab area}
Canvas.Brush.Style := bsSolid;
Canvas.Brush.Color := clBtnFace;
@ -673,16 +716,25 @@ begin
Canvas.Brush.Style := bsSolid;
Canvas.Pen.Color := ATabColor;
Canvas.Polygon([
Point(R.Left + leftDist, R.Bottom - 1), // 10 -1
Point(R.Left + leftDist, R.Top + radius + 1), // 10 3
Point(R.Left + leftDist + radius, R.Top + 1), // 12 1
Point(R.Right - rightDist - radius, R.Top + 1), // -4 1
Point(R.Right - rightDist, R.Top + radius + 1), // -2 3
Point(R.Right - rightDist, R.Bottom - 1) // -2 -1
]);
{
Point(R.Left + 10, R.Bottom - 1),
Point(R.Left + 10, R.Top + 3),
Point(R.Left + 12, R.Top + 1),
Point(R.Right - 4, R.Top + 1),
Point(R.Right - 2, R.Top + 3),
Point(R.Right - 2, R.Bottom - 1)
]);
]); }
{highlight tab}
Canvas.Pen.Color := clBtnHighlight;
{
Canvas.PolyLine([
Point(R.Left, R.Bottom - 2),
Point(R.Left + 8, R.Bottom - 2),
@ -690,13 +742,23 @@ begin
Point(R.Left + 9, R.Top + 3),
Point(R.Left + 11, R.Top + 1),
Point(R.Right - 1, R.Top + 1)
]);}
Canvas.PolyLine([
Point(R.Left, R.Bottom - radius), // 0 -2
Point(R.Left + leftDist - radius, R.Bottom - radius), // 8 -2
Point(R.Left + leftdist - 1, R.Bottom - radius - 1), // 9 -3
Point(R.Left + leftDist - 1, R.Top + radius + 1), // 9 3
Point(R.Left + leftDist + 1, R.Top + 1), // 11 1
Point(R.Right - 1, R.Top + 1) // -1 1
]);
{draw border}
Canvas.Pen.Color := clBlack;
{
Canvas.PolyLine([
Point(R.Left, R.Bottom - 1),
Point(R.Left + 9, R.Bottom - 1),
Point(R.Left, R.Bottom - 1),
Point(R.Left + 9, R.Bottom - 1),
Point(R.Left + 10, R.Bottom - 2),
Point(R.Left + 10, R.Top + 4),
Point(R.Left + 11, R.Top + 3),
@ -704,6 +766,17 @@ begin
Point(R.Right - 2, R.Top + 2),
Point(R.Right - 1, R.Top + 3),
Point(R.Right - 1, R.Bottom - 1)
]);}
Canvas.PolyLine([
Point(R.Left, R.Bottom - 1), // 0 -1
Point(R.Left + leftDist - 1, R.Bottom - 1), // 9 -1
Point(R.Left + leftDist, R.Bottom - radius), // 10 -2
Point(R.Left + leftdist, R.Top + radius + 2), // 10 +4
Point(R.Left + leftdist + 1, R.Top + radius + 1), // 11 +3
Point(R.Left + leftdist + 2, R.Top + radius), // 12 +2
Point(R.Right - radius, R.Top + radius), // -2 +2
Point(R.Right - radius + 1, R.Top + radius + 1), // -1 +3
Point(R.Right -1, R.Bottom - 1) // -1 -1
]);
Result := Rect(R.Left + 1, R.Top + 2, R.Right - 2, R.Bottom);
@ -873,9 +946,9 @@ begin
else
TR := FNavBar.ClientRect;
{ Draw background }
DrawBackground(DrawBmp.Canvas, TR);
{ Draw background }
if FNavBar.FolderCount = 0 then begin
nabScrollUpBtn.Visible := False;
nabScrollDownBtn.Visible := False;
@ -895,7 +968,7 @@ begin
{ Copy the buffer bitmap to the control }
FNavBar.Canvas.CopyMode := cmSrcCopy;
FNavBar.Canvas.CopyRect(MyRect, DrawBmp.Canvas, Rect(0, 0, DrawBmp.Width,DrawBmp.Height));
FNavBar.Canvas.CopyRect(MyRect, DrawBmp.Canvas, Rect(0, 0, DrawBmp.Width, DrawBmp.Height));
{ Show/hide scroll buttons }
ProcessScrollButtons;
@ -906,24 +979,34 @@ begin
end;
procedure TVpNavBarPainter.ProcessScrollButtons;
const
DISTANCE = 5;
var
dist: Integer;
w, h: Integer;
begin
if not (csDesigning in FNavBar.ComponentState) then begin
dist := ScaleY(DISTANCE, DesignTimeDPI);
{show the top scroll button}
if TVpNavBarOpener(FNavBar).nabShowScrollUp() then begin
nabScrollUpBtn.Top := FNavBar.Folders[FActiveFolder].Rect.Bottom + 5;
nabScrollUpBtn.Left := FNavBar.ClientWidth - 20;
w := nabScrollUpBtn.Width;
nabScrollUpBtn.Top := FNavBar.Folders[FActiveFolder].Rect.Bottom + dist;
nabScrollUpBtn.Left := FNavBar.ClientWidth - w - dist;
nabScrollUpBtn.Visible := True;
end else
nabScrollUpBtn.Visible := False;
{show the bottom scroll button}
if TVpNavBarOpener(FnavBar).nabShowScrollDown() then begin
w := nabScrollDownBtn.Width;
h := nabScrollDownBtn.Height;
if FActiveFolder = FNavBar.FolderCount-1 then
{there are no folders beyond the active one}
nabScrollDownBtn.Top := FNavBar.ClientHeight -20
nabScrollDownBtn.Top := FNavBar.ClientHeight - h - dist
else
nabScrollDownBtn.Top := FNavBar.Folders[FActiveFolder+1].Rect.Top - 20;
nabScrollDownBtn.Left := FNavBar.ClientWidth - 20;
nabScrollDownBtn.Top := FNavBar.Folders[FActiveFolder+1].Rect.Top - h - dist;
nabScrollDownBtn.Left := FNavBar.ClientWidth - w - dist;
nabScrollDownBtn.Visible := True;
end else
nabScrollDownBtn.Visible := False;

2
components/tvplanit/source/vpprtprvdlg.pas
View File

@ -163,7 +163,7 @@ implementation
{$ENDIF}
uses
VpPrtFmt;
VpConst, VpPrtFmt;
{ TfrmPrintPreview }