tvplanit/Drag&Drop: Introduce DragMarkerColor.

git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@8915 8e941d3f-bd1b-0410-a28a-d453659cc2b4

components/tvplanit/source/vpnavbar.pas

@@ -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;

components/tvplanit/source/vpnavbarpainter.pas

@@ -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));