diff --git a/components/tvplanit/source/vpconst.pas b/components/tvplanit/source/vpconst.pas index 89f00b849..22e51a4d2 100644 --- a/components/tvplanit/source/vpconst.pas +++ b/components/tvplanit/source/vpconst.pas @@ -270,6 +270,8 @@ const { Hint support } MAX_HINT_WIDTH = 400; + DesignTimeDPI = 96; + {$IFDEF LCL} {$IF LCL_FULLVERSION >= 1080100} VP_LCL_SCALING = 2; diff --git a/components/tvplanit/source/vpcontactbuttons.pas b/components/tvplanit/source/vpcontactbuttons.pas index badea435a..3e3e5f9c1 100644 --- a/components/tvplanit/source/vpcontactbuttons.pas +++ b/components/tvplanit/source/vpcontactbuttons.pas @@ -180,6 +180,9 @@ type implementation +uses + VpConst; + { TVpContactButtonBar } constructor TVpContactButtonBar.Create(AOwner: TComponent); diff --git a/components/tvplanit/source/vpedshape.pas b/components/tvplanit/source/vpedshape.pas index 1a4e2a6b8..e6404b0a6 100644 --- a/components/tvplanit/source/vpedshape.pas +++ b/components/tvplanit/source/vpedshape.pas @@ -121,7 +121,7 @@ implementation uses Math, TypInfo, - VpMisc, VpSr; + VpConst, VpMisc, VpSr; { TfrmEditShape } diff --git a/components/tvplanit/source/vpjsonds.pas b/components/tvplanit/source/vpjsonds.pas index 6d98c3836..f1e8e26d1 100644 --- a/components/tvplanit/source/vpjsonds.pas +++ b/components/tvplanit/source/vpjsonds.pas @@ -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; diff --git a/components/tvplanit/source/vpmisc.pas b/components/tvplanit/source/vpmisc.pas index f32410165..93c2a05d5 100644 --- a/components/tvplanit/source/vpmisc.pas +++ b/components/tvplanit/source/vpmisc.pas @@ -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} diff --git a/components/tvplanit/source/vpnavbar.pas b/components/tvplanit/source/vpnavbar.pas index 078c78598..49d8f9e7a 100644 --- a/components/tvplanit/source/vpnavbar.pas +++ b/components/tvplanit/source/vpnavbar.pas @@ -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); diff --git a/components/tvplanit/source/vpnavbarpainter.pas b/components/tvplanit/source/vpnavbarpainter.pas index 5b8dcb7cc..cde6c9583 100644 --- a/components/tvplanit/source/vpnavbarpainter.pas +++ b/components/tvplanit/source/vpnavbarpainter.pas @@ -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; diff --git a/components/tvplanit/source/vpprtprvdlg.pas b/components/tvplanit/source/vpprtprvdlg.pas index 45227a9f8..cb9644f33 100644 --- a/components/tvplanit/source/vpprtprvdlg.pas +++ b/components/tvplanit/source/vpprtprvdlg.pas @@ -163,7 +163,7 @@ implementation {$ENDIF} uses - VpPrtFmt; + VpConst, VpPrtFmt; { TfrmPrintPreview }