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

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

Browse Source 
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@7119 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
wp_xxyyzz
2019-08-11 23:10:12 +00:00
parent 0be5a20ecf
commit 7fcf7ced7d
4 changed files with 348 additions and 89 deletions
Download Patch File Download Diff File Expand all files Collapse all files

2
components/jvcllaz/examples/JvTimeFramework/tfmain.lfm
View File

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

197
components/jvcllaz/run/JvTimeFramework/jvtfglance.pas
View File

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

125
components/jvcllaz/run/JvTimeFramework/jvtfglancetextviewer.pas
View File

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

113
components/jvcllaz/run/JvTimeFramework/jvtfutils.pas
View File

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