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

tvplanit/Drag&Drop: Introduce DragMarkerColor.

Browse Source 
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@8915 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
wp_xxyyzz
2023-08-07 11:55:05 +00:00
parent 43558032e7
commit 110ffd365b
2 changed files with 55 additions and 2 deletions
Download Patch File Download Diff File Expand all files Collapse all files

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

@ -181,6 +181,8 @@ type
TVpMouseOverItemEvent = procedure(Sender: TObject; Item: TVpNavBtnItem) of object;
TVpCustomNavBar = class(TVpCustomControl)
private
FDragMarkerColor: TColor;
protected {private}
{property variables}
FActiveFolder: Integer;
@ -409,6 +411,7 @@ type
property ActiveItem: Integer read FActiveItem;
property Containers[Index: Integer]: TVpFolderContainer read GetContainer;
property DragMarkerColor: TColor read FDragMarkerColor write FDragMarkerColor default clBlack;
property Folders[Index: Integer]: TVpNavFolder read GetFolder;
property FolderCount: Integer read GetFolderCount;
property PreviousFolder : Integer read FPreviousFolder;
@ -428,6 +431,7 @@ type
property BackgroundMethod;
property BorderStyle default bsNone;
property ButtonHeight;
property DragMarkerColor;
property DrawingStyle;
property FolderCollection;
property Images;
@ -1103,6 +1107,7 @@ begin
FBackgroundColor := clWindow;
FBackgroundImage := TBitmap.Create;
FBackgroundMethod := bmNormal;
FDragMarkerColor := clBlack;
// FBorderStyle := bsSingle;
FButtonHeight := 0;
FActiveFolder := -1;

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

@ -46,6 +46,10 @@ type
nabScrollUpBtn: TSpeedButton;
nabScrollDownBtn: TSpeedButton;
nabTopItem: Integer;
nabDropY: Integer;
nabExternalDrag: Boolean;
nabFolderAccept: Boolean;
nabCursorOverItem: Boolean;
FFolderArea: TRect;
@ -76,6 +80,7 @@ type
procedure DrawActiveFolderItems(Canvas: TCanvas; var CurPos: Integer);
procedure DrawBottomFolderButtons(Canvas: TCanvas; ARect: TRect;
var CurPos: Integer);
procedure DrawDragMarker(Canvas: TCanvas);
procedure DrawTab(Canvas: TCanvas; R: TRect; ATabIndex: Integer);
procedure DrawTopFolderButtons(Canvas: TCanvas; ARect: TRect;
DrawFolder: Boolean; var CurPos: Integer);
@ -129,6 +134,10 @@ begin
nabScrollUpBtn := TVpNavBarOpener(FNavBar).nabScrollUpBtn;
nabScrollDownBtn := TVpNavBarOpener(FNavBar).nabScrollDownBtn;
nabTopItem := TVpNavBarOpener(FNavBar).nabTopItem;
nabDropY := TVpNavBarOpener(FNavBar).nabDropY;
nabExternalDrag := TVpNavBarOpener(FNavBar).nabExternalDrag;
nabFolderAccept := TVpNavBarOpener(FNavBar).nabFolderAccept;
nabCursorOverItem := TVpNavBarOpener(FNavBar).nabCursorOverItem;
FFolderArea := TVpNavBarOpener(FNavBar).nabGetFolderArea(FActiveFolder);
end;
@ -491,6 +500,42 @@ begin
end;
end;
procedure TVpNavBarPainter.DrawDragMarker(Canvas: TCanvas);
const
MARKERSIZE = 4;
MARKERPOS = 3;
var
scaledMARKERSIZE: Integer;
scaledMARKERPOS: Integer;
begin
if FNavBar.Dragging and (nabDropY <> -1) then
begin
{ Don't draw the drag marker if we're doing external dragging and the
cursor is over an item. }
if nabExternalDrag then
if not nabFolderAccept or nabCursorOverItem then
exit;
scaledMARKERSIZE := FNavBar.Scale96ToFont(MARKERSIZE);
scaledMARKERPOS := FNavBar.Scale96ToFont(MARKERPOS);
Canvas.Pen.Color := FNavBar.DragMarkerColor;
Canvas.Brush.Color := FNavBar.DragMarkerColor;
Canvas.MoveTo(scaledMARKERSIZE + 1, nabDropY);
Canvas.LineTo(FNavBar.ClientWidth - scaledMARKERSIZE - 1, nabDropY);
//Canvas.Polygon([Point(3, nabDropY+4), Point(7, nabDropY), Point(3, nabDropY-4)]);
Canvas.Polygon([
Point(scaledMARKERPOS, nabDropY + scaledMARKERSIZE),
Point(scaledMARKERPOS + scaledMARKERSIZE, nabDropy),
Point(scaledMARKERPOS, nabDropY - scaledMARKERSIZE)
]);
Canvas.Polygon([
Point(FNavBar.ClientWidth - scaledMARKERPOS, nabDropY + scaledMARKERSIZE),
Point(FNavBar.ClientWidth - scaledMARKERPOS - scaledMARKERSIZE, nabDropY),
Point(FNavBar.ClientWidth - scaledMARKERPOS, nabDropY - scaledMARKERSIZE)
]);
end;
end;
{ Draw regular etched (Win98 style) buttons
Returns the usable text area inside the tab rect.}
function TVpNavBarPainter.DrawEtchedButton(Canvas: TCanvas; R: TRect;
@ -661,7 +706,7 @@ begin
AItem.IconRect := R;
if FShowButtons then begin
DrawItemHighlight(Canvas, R, FActiveItem = AItem.Index);
DrawItemHighlight(Canvas, R, (FActiveItem = AItem.Index) and (not FNavBar.Dragging));
if Assigned(FImages) and (AItem.IconIndex >= 0) and (AItem.IconIndex < FImages.Count) then
begin
{$IFDEF LCL}{$IF LCL_FullVersion >= 1090000}
@ -713,7 +758,7 @@ begin
Exit; // Returns false
if FShowButtons then begin
DrawItemHighlight(Canvas, R, FActiveItem = AItem.Index);
DrawItemHighlight(Canvas, R, (FActiveItem = AItem.Index) and (not FNavBar.Dragging));
if Assigned(FImages) then begin
{$IFDEF LCL}{$IF LCL_FullVersion >= 1090000}
with TVpNavBarOpener(FNavBar) do begin
@ -1030,6 +1075,9 @@ begin
{ Draw the folder buttons at the bottom }
DrawBottomFolderButtons(DrawBmp.Canvas, MyRect, CurPos);
{ Draw the drag marker }
DrawDragMarker(DrawBmp.Canvas);
{ Copy the buffer bitmap to the control }
FNavBar.Canvas.CopyMode := cmSrcCopy;
FNavBar.Canvas.CopyRect(MyRect, DrawBmp.Canvas, Rect(0, 0, DrawBmp.Width, DrawBmp.Height));