jvcllaz: Add scrollbuttons to cell title bars of TJvTFWeeks and TJvTFMonths instead of the ugly buttons embedded inside the cells.

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

components/jvcllaz/examples/JvTimeFramework/tfmain.lfm

@@ -171,6 +171,7 @@ object MainForm: TMainForm
         SelCellAttr.TitleAttr.Color = clHighlight
         SelCellAttr.TitleAttr.DayTxtAttr.Font.Color = clHighlightText
         SelCellAttr.DrawBottomLine = True
+        ScrollBtnAttr.DisabledArrowColor = clScrollBar
         CellPics = StateImageList
         Viewer = GlanceTextViewer1
         DateFormat = 'ddddd'
@@ -472,6 +473,7 @@ object MainForm: TMainForm
         SelCellAttr.TitleAttr.Color = clHighlight
         SelCellAttr.TitleAttr.DayTxtAttr.Font.Color = clHighlightText
         SelCellAttr.DrawBottomLine = True
+        ScrollBtnAttr.DisabledArrowColor = clScrollBar
         Viewer = GlanceTextViewer2
         DateFormat = 'ddddd'
         TimeFormat = 't'

components/jvcllaz/run/JvTimeFramework/jvtfglance.pas

@@ -258,6 +258,30 @@ type
     property AlignV: TJvTFVAlignment read FAlignV write SetAlignV default vaCenter;
   end;
 
+  TJvTFScrollBtnAttr = class(TPersistent)
+  private
+    FArrowColor: TColor;
+    FColor: TColor;
+    FDisabledArrowColor: TColor;
+    FFrameColor: TColor;
+    FOnChange: TNotifyEvent;
+    procedure SetColor(Value: TColor);
+    procedure SetArrowColor(Value: TColor);
+    procedure SetDisabledArrowColor(Value: TColor);
+    procedure SetFrameColor(Value: TColor);
+  protected
+    procedure DoChange;
+  public
+    constructor Create;
+    procedure Assign(Source: TPersistent); override;
+    property OnChange: TNotifyEvent read FOnChange write FOnChange;
+  published
+    property ArrowColor: TColor read FArrowColor write SetArrowColor default clWindowText;
+    property Color: TColor read FColor write SetColor default clWindow;
+    property DisabledArrowColor: TColor read FDisabledArrowColor write SetDisabledArrowColor default clScrollbar;
+    property FrameColor: TColor read FFrameColor write SetFrameColor default clActiveBorder;
+  end;
+
   TJvTFGlanceTitlePicAttr = class(TPersistent)
   private
     FAlignH: TAlignment;
@@ -447,6 +471,8 @@ type
     FSel: TJvTFGlanceSelList;
     FUpdatingSel: Boolean;
 
+    FScrollBtnAttr: TJvTFScrollBtnAttr;
+
     FViewer: TJvTFGlanceViewer;
 
     FOnConfigCells: TNotifyEvent;
@@ -480,6 +506,8 @@ type
     procedure SetHintProps(Value: TJvTFHintProps);
     procedure SetSchedNames(Value: TStrings);
 
+    procedure SetScrollBtnAttr(Value: TJvTFScrollBtnAttr);
+
     procedure SetSelAppt(Value: TJvTFAppt);
   protected
     // (rom) bad names
@@ -509,6 +537,7 @@ type
     procedure Notify(Sender: TObject; Code: TJvTFServNotifyCode); override;
 
     procedure GlanceTitleChange(Sender: TObject);
+    procedure ScrollBtnChange(Sender: TObject);
 
     // mouse routines
     procedure MouseDown(Button: TMouseButton; Shift: TShiftState;
@@ -546,8 +575,10 @@ type
       Attr: TJvTFGlanceCellAttr);
     procedure DrawCellFrame(ACanvas: TCanvas; ARect: TRect;
       Attr: TJvTFGlanceCellAttr; ACell: TJvTFGlanceCell);
+    procedure DrawScrollButtons(ACanvas: TCanvas; ARect: TRect);
     procedure Draw3DFrame(ACanvas: TCanvas; ARect: TRect; TLColor,
       BRColor: TColor);
+
     function PicsToDraw(ACell: TJvTFGlanceCell): Boolean;
     procedure GetPicsWidthHeight(ACell: TJvTFGlanceCell; PicBuffer: Integer;
       Horz: Boolean; var PicsWidth, PicsHeight: Integer);
@@ -598,6 +629,7 @@ type
     function TitleRect: TRect;
     function CellTitleRect(ACell: TJvTFGlanceCell): TRect;
     function CellBodyRect(ACell: TJvTFGlanceCell): TRect;
+    function CellScrollBtnRect(const ATitleRect: TRect): TRect;
     function CalcCellTitleRect(ACell: TJvTFGlanceCell; Selected, Full: Boolean): TRect;
     function CalcCellBodyRect(ACell: TJvTFGlanceCell; Selected, Full: Boolean): TRect;
     function PtToCell(X, Y: Integer): TJvTFGlanceCoord;
@@ -624,6 +656,7 @@ type
     property TitleAttr: TJvTFGlanceMainTitle read FTitleAttr write SetTitleAttr;
     property CellAttr: TJvTFGlanceCellAttr read FCellAttr write SetCellAttr;
     property SelCellAttr: TJvTFGlanceCellAttr read FSelCellAttr write SetTFSelCellAttr;
+    property ScrollBtnAttr: TJvTFScrollBtnAttr read FScrollBtnAttr write SetScrollBtnAttr;
     property CellPics: TCustomImageList read FCellPics write SetCellPics;
     property Viewer: TJvTFGlanceViewer read FViewer write SetViewer;
     property HintProps: TJvTFHintProps read FHintProps write SetHintProps;
@@ -731,6 +764,9 @@ type
     function ScheduleCount: Integer;
     property Schedules[Index: Integer]: TJvTFSched read GetSchedule;
     function GetApptAt(X, Y: Integer): TJvTFAppt; virtual;
+
+    function CanScrollCell(ADir: TJvTFVScrollDir): Boolean; virtual;
+    procedure ScrollCell(ADelta: Integer); virtual;
   published
     property RepeatGrouped: Boolean read FRepeatGrouped write SetRepeatGrouped default True;
     property ShowSchedNamesInHint: Boolean read FShowSchedNamesInHint write SetShowSchedNamesInHint default True;
@@ -1303,7 +1339,6 @@ begin
   StartDate := Date;
 
   FTitleAttr := TJvTFGlanceMainTitle.Create(Self);
-
 // obones: Commented out, it goes against the default value in TJvTFGlanceMainTitle
 //  FTitleAttr.Visible := False; // not visible by default. (Tim)
   FTitleAttr.OnChange := @GlanceTitleChange;
@@ -1314,6 +1349,9 @@ begin
   FSelCellAttr.TitleAttr.Color := clHighlight;
   FSelCellAttr.TitleAttr.DayTxtAttr.Font.Color := clHighlightText;
 
+  FScrollBtnAttr := TJvTFScrollBtnAttr.Create;
+  FScrollBtnAttr.OnChange := @ScrollBtnChange;
+
   //FSelOrder := soColMajor;
   FSelOrder := soRowMajor;
   FSel := TJvTFGlanceSelList.Create(Self);
@@ -1752,6 +1790,8 @@ procedure TJvTFCustomGlance.MouseDown(Button: TMouseButton; Shift: TShiftState;
   X, Y: Integer);
 var
   Info: TJvTFGlanceCoord;
+  canScrollUp, canScrollDown: Boolean;
+  scrollBtnRect: TRect;
 begin
   inherited MouseDown(Button, Shift, X, Y);
 
@@ -1786,6 +1826,32 @@ begin
     begin
       if Assigned(Info.Cell) and Info.Cell.CanSelect then
         SelectCell(Info.Cell, True);
+
+      // Scroll up/down
+      scrollBtnRect := CellScrollBtnRect(CellTitleRect(info.Cell));
+      if PtInRect(scrollBtnRect, Point(X, Y)) then begin
+        Viewer.SetTo(Info.Cell);
+        canScrollUp := Viewer.CanScrollCell(sdUp);
+        canScrollDown := Viewer.CanScrollCell(sdDown);
+        if canScrollUp and (Y < (scrollBtnRect.Top + scrollBtnRect.Bottom) div 2) then
+          Viewer.ScrollCell(-1)
+        else
+        if canScrollDown and (Y > (scrollBtnRect.Top + scrollBtnRect.Bottom) div 2) then
+          Viewer.ScrollCell(+1);
+        {
+        if canScrollUp and canScrollDown then begin
+          if (Y < (scrollBtnRect.Top + scrollBtnRect.Bottom) div 2) then
+            Viewer.ScrollCell(-1)
+          else
+            Viewer.ScrollCell(+1);
+        end else
+        if canScrollUp then
+          Viewer.ScrollCell(-1)
+        else
+          Viewer.ScrollCell(+1);
+          }
+      end;
+
       SelAppt := Info.Appt;
       if Assigned(Info.Appt) then
         BeginDrag(False);
@@ -2088,6 +2154,11 @@ begin
   FSelCellAttr.Assign(Value);
 end;
 
+procedure TJvTFCustomGlance.SetScrollBtnAttr(Value: TJvTFScrollBtnAttr);
+begin
+  FScrollBtnAttr.Assign(Value);
+end;
+
 procedure TJvTFCustomGlance.SetStartDate(Value: TDate);
 begin
   if not EqualDates(Value, FStartDate) then
@@ -2428,6 +2499,13 @@ begin
   Result := CalcCellBodyRect(ACell, CellIsSelected(ACell), True);
 end;
 
+function TJvTFCustomGlance.CellScrollBtnRect(const ATitleRect: TRect): TRect;
+begin
+  Result := ATitleRect;
+  InflateRect(Result, -2, -2);
+  Result.Left := Result.Right - RectHeight(Result)*3 div 4;
+end;
+
 function TJvTFCustomGlance.CellTitleRect(ACell: TJvTFGlanceCell): TRect;
 begin
   Result := CalcCellTitleRect(ACell, CellIsSelected(ACell), True);
@@ -2536,6 +2614,12 @@ begin
 
   // draw the title frame
   DrawCellTitleFrame(ACanvas, ATitleRect, Attr);
+
+  // Draw the scroll buttons
+  if Assigned(Cell) then begin
+    Viewer.SetTo(Cell);
+    DrawScrollButtons(ACanvas, CellScrollBtnRect(ATitleRect));
+  end;
 end;
 
 procedure TJvTFCustomGlance.DrawCellFrame(ACanvas: TCanvas; ARect: TRect;
@@ -2656,6 +2740,33 @@ begin
   end;
 end;
 
+procedure TJvTFCustomGlance.DrawScrollButtons(ACanvas: TCanvas; ARect: TRect);
+var
+  canScrollUp, canScrollDown: Boolean;
+  colorUP, colorDOWN: TColor;
+begin
+  canScrollUp := Viewer.CanScrollCell(sdUp);
+  canScrollDown := Viewer.CanScrollCell(sdDown);
+  if canScrollUp or canScrollDown then begin
+    ACanvas.Brush.Color := ScrollBtnAttr.Color;
+    ACanvas.Pen.Color := ScrollBtnAttr.FrameColor;
+    ACanvas.Rectangle(ARect);
+    if canScrollUp and canScrollDown then begin
+      colorUP := ScrollBtnAttr.ArrowColor;
+      colorDOWN := ScrollBtnAttr.ArrowColor;
+    end else
+    if canScrollUp then begin
+      colorUP := ScrollBtnAttr.ArrowColor;
+      colorDOWN := ScrollBtnAttr.DisabledArrowColor;
+    end else
+    if canScrollDown then begin
+      colorUP := ScrollBtnAttr.DisabledArrowColor;
+      colorDown := ScrollBtnAttr.ArrowColor;
+    end;
+    DrawDblArrow(ACanvas, ARect, dirUpDown, colorUP, colorDOWN);
+  end;
+end;
+
 function TJvTFCustomGlance.PicsToDraw(ACell: TJvTFGlanceCell): Boolean;
 var
   I: Integer;
@@ -3001,6 +3112,11 @@ begin
   Invalidate;
 end;
 
+procedure TJvTFCustomGlance.ScrollBtnChange(Sender: TObject);
+begin
+  Invalidate;
+end;
+
 procedure TJvTFCustomGlance.UpdateCellTitleText(Cell: TJvTFGlanceCell);
 var
   NewTitleText: string;
@@ -3498,6 +3614,11 @@ begin
   end;
 end;
 
+function TJvTFGlanceViewer.CanScrollCell(ADir: TJvTFVScrollDir): Boolean;
+begin
+  Result := false;
+end;
+
 procedure TJvTFGlanceViewer.EnsureCol(ACol: Integer);
 begin
   GlanceControl.EnsureCol(ACol);
@@ -3610,6 +3731,11 @@ begin
     Result := 0;
 end;
 
+procedure TJvTFGlanceViewer.ScrollCell(ADelta: Integer);
+begin
+  // to be overridden.
+end;
+
 procedure TJvTFGlanceViewer.SetGlanceControl(Value: TJvTFCustomGlance);
 begin
   FGlanceControl := Value;
@@ -3932,6 +4058,75 @@ begin
   FPicPoint := Point(X, Y);
 end;
 
+
+//=== { TJvTFScrollBtnAttr } =================================================
+
+constructor TJvTFScrollBtnAttr.Create;
+begin
+  inherited Create;
+  FArrowColor := clWindowText;
+  FColor := clWindow;
+  FDisabledArrowColor := clScrollbar;
+  FFrameColor := clActiveBorder;
+end;
+
+procedure TJvTFScrollBtnAttr.Assign(Source: TPersistent);
+begin
+  if Source is TJvTFScrollBtnAttr then
+  begin
+    FArrowColor := TJvTFScrollBtnAttr(Source).ArrowColor;
+    FColor := TJvTFScrollBtnAttr(Source).Color;
+    FDisabledArrowColor := TJvTFScrollBtnAttr(Source).DisabledArrowColor;
+    FFrameColor := TJvTFScrollBtnAttr(Source).FrameColor;
+    DoChange;
+  end
+  else
+    inherited Assign(Source);
+end;
+
+procedure TJvTFScrollBtnAttr.DoChange;
+begin
+  if Assigned(FOnChange) then
+    FOnChange(self);
+end;
+
+procedure TJvTFScrollBtnAttr.SetArrowColor(Value: TColor);
+begin
+  if Value <> FArrowColor then
+  begin
+    FArrowColor := Value;
+    DoChange;
+  end;
+end;
+
+procedure TJvTFScrolLBtnAttr.SetColor(Value: TColor);
+begin
+  if Value <> FColor then
+  begin
+    FColor := Value;
+    DoChange;
+  end;
+end;
+
+procedure TJvTFScrollBtnAttr.SetDisabledArrowColor(Value: TColor);
+begin
+  if Value <> FDisabledArrowColor then
+  begin
+    FDisabledArrowColor := Value;
+    DoChange;
+  end;
+end;
+
+procedure TJvTFScrollBtnAttr.SetFrameColor(Value: TColor);
+begin
+  if Value <> FFrameColor then
+  begin
+    FFrameColor := Value;
+    DoChange;
+  end;
+end;
+
+
 //=== { TJvTFGlanceTitlePicAttr } ============================================
 
 constructor TJvTFGlanceTitlePicAttr.Create;

components/jvcllaz/run/JvTimeFramework/jvtfglancetextviewer.pas

@@ -128,9 +128,10 @@ type
     property Replicating: Boolean read FReplicating;
     procedure Paint; override;
     procedure DrawDDButton(ACanvas: TCanvas);
-    procedure DrawArrow(ACanvas: TCanvas; aRect: TRect; Direction: TJvTFDirection);
+    {
     procedure DrawScrollUpBtn(ACanvas: TCanvas; aCellRect: TRect);
     procedure DrawScrollDnBtn(ACanvas: TCanvas; aCellRect: TRect);
+    }
     function GetStartEndString(Appt: TJvTFAppt): string;
 
     function CalcLineHeight: Integer;
@@ -254,6 +255,9 @@ type
     function GetTopLine(ACell: TJvTFGlanceCell): Integer;
     function GetApptAt(X, Y: Integer): TJvTFAppt; override;
 
+    function CanScrollCell(ADir: TJvTFVScrollDir): Boolean; override;
+    procedure ScrollCell(ADelta: Integer); override;
+
     // editor management routines
     procedure EditAppt(ACell: TJvTFGlanceCell; RelLine: Integer; Appt: TJvTFAppt);
     procedure FinishEditAppt; override;
@@ -529,6 +533,7 @@ begin
        FMouseInControl and FShowDDButton then
       DrawDDButton(ACanvas);
 
+    (*     wp: looks ugly. Was replaced by scroll buttons in cell title...
     BtnRect := ScrollUpBtnRect(DrawInfo.aRect);
     if not IsRectEmpty(BtnRect) then
       DrawScrollUpBtn(ACanvas, DrawInfo.aRect);
@@ -536,16 +541,7 @@ begin
     BtnRect := ScrollDnBtnRect(DrawInfo.aRect);
     if not IsRectEmpty(BtnRect) then
       DrawScrollDnBtn(ACanvas, DrawInfo.aRect);
-
+    *)
-    {
-    if TopLine > 0 then
-      DrawScrollUpBtn(ACanvas, DrawInfo.aRect);
-
-    BottomLine := TopLine + FullViewableLines - 1;
-    LastLine := LineCount - 1;
-    if BottomLine < LastLine then
-      DrawScrollDnBtn(ACanvas, DrawInfo.aRect);
-    }
   end;
 end;
 
@@ -594,74 +590,6 @@ begin
   end;
 end;
 
-procedure TJvTFGVTextControl.DrawArrow(ACanvas: TCanvas; aRect: TRect;
-  Direction: TJvTFDirection);
-var
-  I, ArrowHeight, ArrowWidth, BaseX, BaseY: Integer;
-begin
-  ArrowWidth := RectWidth(aRect) - 2;
-  if not Odd(ArrowWidth) then
-    Dec(ArrowWidth);
-  ArrowHeight := (ArrowWidth + 1) div 2;
-
-  case Direction of
-    dirUp:
-      begin
-        BaseX := aRect.Left + RectWidth(aRect) div 2 - ArrowWidth div 2;
-        BaseY := aRect.Top + RectHeight(aRect) div 2 + ArrowHeight div 2 - 1;
-
-        for I := ArrowHeight downto 1 do
-          with ACanvas do
-          begin
-            MoveTo(BaseX, BaseY);
-            LineTo(BaseX + I * 2 - 1, BaseY);
-            Inc(BaseX);
-            Dec(BaseY);
-          end;
-      end;
-    dirDown:
-      begin
-        BaseX := aRect.Left + RectWidth(aRect) div 2 - ArrowWidth div 2;
-        BaseY := aRect.Top + RectHeight(aRect) div 2 - ArrowHeight div 2 + 1;
-
-        for I := ArrowHeight downto 1 do
-        with ACanvas do
-          begin
-            MoveTo(BaseX, BaseY);
-            LineTo(BaseX + I * 2 - 1, BaseY);
-            Inc(BaseX);
-            Inc(BaseY);
-          end;
-      end;
-    dirLeft:
-      begin
-        BaseX := aRect.Left + RectWidth(aRect) div 2 + ArrowHeight div 2;
-        BaseY := aRect.Top + RectHeight(aRect) div 2 - ArrowWidth div 2;
-
-        for I := ArrowHeight downto 1 do
-          with ACanvas do
-          begin
-            MoveTo(BaseX, BaseY);
-            LineTo(BaseX, BaseY + I * 2 - 1);
-            Dec(BaseX);
-            Inc(BaseY);
-          end;
-      end;
-  else
-    BaseX := aRect.Left + RectWidth(aRect) div 2 - ArrowHeight div 2;
-    BaseY := aRect.Top + RectHeight(aRect) div 2 - ArrowWidth div 2;
-
-    for I := ArrowHeight downto 1 do
-      with ACanvas do
-      begin
-        MoveTo(BaseX, BaseY);
-        LineTo(BaseX, BaseY + I * 2 - 1);
-        Inc(BaseX);
-        Inc(BaseY);
-      end;
-  end;
-end;
-
 procedure TJvTFGVTextControl.UpdateDDBtnRect;
 begin
   FDDBtnRect := LineRect(FMousePtInfo.AbsLineNum);
@@ -745,7 +673,7 @@ function TJvTFGVTextControl.DoMouseWheelDown(Shift: TShiftState;
   MousePos: TPoint): Boolean;
 begin
   Result := inherited;
-  if not Result then begin
+  if not Result and Viewer.CanScrollCell(sdDown) then begin
     Scroll(+1);
     Result := true;
   end;
@@ -755,8 +683,9 @@ function TJvTFGVTextControl.DoMouseWheelUp(Shift: TShiftState;
   MousePos: TPoint): Boolean;
 begin
   Result := inherited;
-  if not Result then begin
+  if not Result and Viewer.CanScrollCell(sdUp) then begin
     Scroll(-1);
+    Result := true;
   end;
 end;
 
@@ -1011,6 +940,7 @@ begin
   end;
 end;
 
+{
 procedure TJvTFGVTextControl.DrawScrollDnBtn(ACanvas: TCanvas; aCellRect: TRect);
 var
   aRect: TRect;
@@ -1028,15 +958,15 @@ begin
   BitBlt(ACanvas.Handle, aRect.Left, aRect.Top, RectWidth(aRect),
     RectHeight(aRect), FScrollUpBtnBMP.Canvas.Handle, 0, 0, SRCCOPY);
 end;
+}
 
 function TJvTFGVTextControl.FullViewableLines: Integer;
 var
-  aRect: TRect;
+  R: TRect;
 begin
-  aRect := GlanceControl.CalcCellBodyRect(Viewer.Cell,
+  with GlanceControl do
-    GlanceControl.CellIsSelected(Viewer.Cell), False);
+    R := CalcCellBodyRect(Viewer.Cell, CellIsSelected(Viewer.Cell), False);
-
+  Result := RectHeight(R) div CalcLineHeight;
-  Result := RectHeight(aRect) div CalcLineHeight;
 end;
 
 (*
@@ -1274,6 +1204,15 @@ begin
   inherited Destroy;
 end;
 
+function TJvTFGlanceTextViewer.CanScrollCell(ADir: TJvTFVScrollDir): Boolean;
+begin
+  with FViewControl do
+    case ADir of
+      sdUp: Result := TopLine > 0;
+      sdDown: Result := TopLine + FullViewableLines < LineCount;
+    end;
+end;
+
 procedure TJvTFGlanceTextViewer.Change;
 begin
   Refresh;
@@ -1373,7 +1312,14 @@ end;
 
 procedure TJvTFGlanceTextViewer.Refresh;
 begin
-  FViewControl.Invalidate;
+  if FViewControl.Parent <> nil then
+    FViewControl.Parent.Invalidate;
+  {
+  if FViewControl.Parent = nil then
+    FViewControl.Invalidate
+  else
+    FViewControl.Parent.Invalidate;
+    }
 end;
 
 procedure TJvTFGlanceTextViewer.ResetTopLines;
@@ -1382,6 +1328,11 @@ begin
   GlanceControl.Invalidate;
 end;
 
+procedure TJvTFGlanceTextViewer.ScrollCell(ADelta: Integer);
+begin
+  FViewControl.Scroll(ADelta)
+end;
+
 procedure TJvTFGlanceTextViewer.SelApptAttrChange(Sender: TObject);
 begin
   //Change;

components/jvcllaz/run/JvTimeFramework/jvtfutils.pas

@@ -44,7 +44,9 @@ type
 
   TJvTFVAlignment = (vaTop, vaCenter, vaBottom);
 
-  TJvTFDirection = (dirUp, dirDown, dirLeft, dirRight);
+  TJvTFDirection = (dirUp, dirDown, dirLeft, dirRight, dirUpDown);
+
+  TJvTFVScrollDir = (sdUp, sdDown);
 
 const
   DOW_WEEK: TTFDaysOfWeek = [dowSunday..dowSaturday];
@@ -112,6 +114,10 @@ function StringsToStr(const List: TStrings; const Sep: string;
 
 procedure FixFont(const AFont: TFont);
 
+procedure DrawArrow(ACanvas: TCanvas; ARect: TRect; ADirection: TJvTFDirection);
+procedure DrawDblArrow(ACanvas: TCanvas; ARect: TRect; ADirection: TJvTFDirection;
+  AColor1, AColor2: TColor);
+
 
 implementation
 
@@ -827,4 +833,109 @@ begin
 end;
 
 
+{ Draw an arrow }
+
+procedure DoDrawArrow(ACanvas: TCanvas; ARect: TRect; ADirection: TJvTFDirection;
+  AColor1, AColor2: TColor);
+var
+  I, ArrowHeight, ArrowWidth, BaseX, BaseY: Integer;
+begin
+  ArrowWidth := RectWidth(ARect) - 2;
+  if not Odd(ArrowWidth) then
+    Dec(ArrowWidth);
+  ArrowHeight := (ArrowWidth + 1) div 2;
+
+  ACanvas.Pen.Color := AColor1;
+  case ADirection of
+    dirUp:
+      begin
+        BaseX := ARect.Left + RectWidth(ARect) div 2 - ArrowWidth div 2;
+        BaseY := ARect.Top + RectHeight(ARect) div 2 + ArrowHeight div 2 - 1;
+        for I := ArrowHeight downto 1 do
+          with ACanvas do
+          begin
+            MoveTo(BaseX, BaseY);
+            LineTo(BaseX + I * 2 - 1, BaseY);
+            Inc(BaseX);
+            Dec(BaseY);
+          end;
+      end;
+    dirDown:
+      begin
+        BaseX := ARect.Left + RectWidth(ARect) div 2 - ArrowWidth div 2;
+        BaseY := ARect.Top + RectHeight(ARect) div 2 - ArrowHeight div 2 + 1;
+        for I := ArrowHeight downto 1 do
+        with ACanvas do
+          begin
+            MoveTo(BaseX, BaseY);
+            LineTo(BaseX + I * 2 - 1, BaseY);
+            Inc(BaseX);
+            Inc(BaseY);
+          end;
+      end;
+    dirUpDown:
+      begin
+        // UP arrow
+        BaseX := ARect.Left + RectWidth(ARect) div 2 - ArrowWidth div 2;
+        BaseY := ARect.Top + RectHeight(ARect) div 2 - 2;
+        for I := ArrowHeight downto 1 do
+        with ACanvas do
+          begin
+            MoveTo(BaseX, BaseY);
+            LineTo(BaseX + I * 2 - 2, BaseY);
+            Inc(BaseX);
+            Dec(BaseY);
+          end;
+
+        // down arrow
+        ACanvas.Pen.Color := AColor2;
+        BaseX := ARect.Left + RectWidth(ARect) div 2 - ArrowWidth div 2;
+        BaseY := ARect.Top + RectHeight(ARect) div 2 + 2;
+        for I := ArrowHeight downto 1 do
+        with ACanvas do
+          begin
+            MoveTo(BaseX, BaseY);
+            LineTo(BaseX + I * 2 - 2, BaseY);
+            Inc(BaseX);
+            Inc(BaseY);
+          end;
+      end;
+    dirLeft:
+      begin
+        BaseX := ARect.Left + RectWidth(ARect) div 2 + ArrowHeight div 2;
+        BaseY := ARect.Top + RectHeight(ARect) div 2 - ArrowWidth div 2;
+        for I := ArrowHeight downto 1 do
+          with ACanvas do
+          begin
+            MoveTo(BaseX, BaseY);
+            LineTo(BaseX, BaseY + I * 2 - 1);
+            Dec(BaseX);
+            Inc(BaseY);
+          end;
+      end;
+  else
+    BaseX := ARect.Left + RectWidth(ARect) div 2 - ArrowHeight div 2;
+    BaseY := ARect.Top + RectHeight(ARect) div 2 - ArrowWidth div 2;
+    for I := ArrowHeight downto 1 do
+      with ACanvas do
+      begin
+        MoveTo(BaseX, BaseY);
+        LineTo(BaseX, BaseY + I * 2 - 1);
+        Inc(BaseX);
+        Inc(BaseY);
+      end;
+  end;
+end;
+
+procedure DrawArrow(ACanvas: TCanvas; ARect: TRect; ADirection: TJvTFDirection);
+begin
+  DoDrawArrow(ACanvas, ARect, ADirection, ACanvas.Pen.Color, clNone);
+end;
+
+procedure DrawDblArrow(ACanvas: TCanvas; ARect: TRect;
+  ADirection: TJvTFDirection; AColor1, AColor2: TColor);
+begin
+  DoDrawArrow(ACanvas, ARect, ADirection, AColor1, AColor2);
+end;
+
 end.