From 7fcf7ced7d40468d733c7c261726353c05bca15b Mon Sep 17 00:00:00 2001 From: wp_xxyyzz Date: Sun, 11 Aug 2019 23:10:12 +0000 Subject: [PATCH] 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 --- .../examples/JvTimeFramework/tfmain.lfm | 2 + .../run/JvTimeFramework/jvtfglance.pas | 197 +++++++++++++++++- .../JvTimeFramework/jvtfglancetextviewer.pas | 125 ++++------- .../jvcllaz/run/JvTimeFramework/jvtfutils.pas | 113 +++++++++- 4 files changed, 348 insertions(+), 89 deletions(-) diff --git a/components/jvcllaz/examples/JvTimeFramework/tfmain.lfm b/components/jvcllaz/examples/JvTimeFramework/tfmain.lfm index a397a784f..99510d643 100644 --- a/components/jvcllaz/examples/JvTimeFramework/tfmain.lfm +++ b/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' diff --git a/components/jvcllaz/run/JvTimeFramework/jvtfglance.pas b/components/jvcllaz/run/JvTimeFramework/jvtfglance.pas index c5b9452ec..5e3c8f2b8 100644 --- a/components/jvcllaz/run/JvTimeFramework/jvtfglance.pas +++ b/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; diff --git a/components/jvcllaz/run/JvTimeFramework/jvtfglancetextviewer.pas b/components/jvcllaz/run/JvTimeFramework/jvtfglancetextviewer.pas index 0a3a06199..17dd62cc4 100644 --- a/components/jvcllaz/run/JvTimeFramework/jvtfglancetextviewer.pas +++ b/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, - GlanceControl.CellIsSelected(Viewer.Cell), False); - - Result := RectHeight(aRect) div CalcLineHeight; + with GlanceControl do + R := CalcCellBodyRect(Viewer.Cell, CellIsSelected(Viewer.Cell), False); + Result := RectHeight(R) 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; diff --git a/components/jvcllaz/run/JvTimeFramework/jvtfutils.pas b/components/jvcllaz/run/JvTimeFramework/jvtfutils.pas index f581a3dfb..fa051e7e0 100644 --- a/components/jvcllaz/run/JvTimeFramework/jvtfutils.pas +++ b/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.