paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-04-23 01:39:31 +02:00
Code Issues Packages Projects Releases Wiki Activity

LCL: added functions for drawing arrows from Benito van der Zander (bug #11202)

Browse Source 
git-svn-id: trunk@15305 -
This commit is contained in:
vincents 2008-06-04 08:56:54 +00:00
parent 38b8013b18
commit 51e4233a16
2 changed files with 67 additions and 0 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

12
docs/xml/lcl/graphutil.xml
View File

@ -309,6 +309,18 @@
<element name="GetShadowColor.Luminance">
<short/>
</element>
<element name="TScrollDirection">
<short/>
</element>
<element name="TArrowType">
<short/>
</element>
<element name="NiceArrowAngle">
<short/>
</element>
<element name="DrawArrow">
<short/>
</element>
</module>
<!-- GraphUtil -->
</package>

55
lcl/graphutil.pp
View File

@ -48,6 +48,18 @@ procedure DrawVerticalGradient(Canvas: TCanvas; ARect: TRect; TopColor, BottomCo
procedure DrawGradientWindow(Canvas: TCanvas; WindowRect: TRect; TitleHeight: Integer; BaseColor: TColor);
{
Draw arrows
}
type TScrollDirection=(sdLeft,sdRight,sdUp,sdDown);
TArrowType = (atSolid, atArrows);
const NiceArrowAngle=45*pi/180;
procedure DrawArrow(Canvas:TCanvas;Direction:TScrollDirection; Location: TPoint; Size: Longint; ArrowType: TArrowType=atSolid);
procedure DrawArrow(Canvas:TCanvas;p1,p2: TPoint; ArrowType: TArrowType=atSolid);
procedure DrawArrow(Canvas:TCanvas;p1,p2: TPoint; ArrowLen: longint; ArrowAngleRad: float=NiceArrowAngle; ArrowType: TArrowType=atSolid);
// delphi compatibility
procedure ColorRGBToHLS(clrRGB: COLORREF; var Hue, Luminance, Saturation: Word);
function ColorHLSToRGB(Hue, Luminance, Saturation: Word): TColorRef;
@ -193,6 +205,49 @@ begin
end;
end;
procedure DrawArrow(Canvas: TCanvas; Direction: TScrollDirection;
Location: TPoint; Size: Longint; ArrowType: TArrowType);
const ScrollDirectionX:array[TScrollDirection]of longint=(-1,+1,0,0);
ScrollDirectionY:array[TScrollDirection]of longint=(0,0,-1,+1);
begin
DrawArrow(Canvas,Location,
point(ScrollDirectionX[Direction]*size+Location.x,ScrollDirectionY[Direction]*size+Location.y),
max(5,size div 10),
NiceArrowAngle,ArrowType);
end;
procedure DrawArrow(Canvas: TCanvas; p1, p2: TPoint; ArrowType: TArrowType);
begin
DrawArrow(Canvas,p1,p2,round(sqrt(sqr(p1.x-p2.x)+sqr(p1.y-p2.y))/10),NiceArrowAngle,ArrowType);
end;
procedure DrawArrow(Canvas: TCanvas; p1, p2: TPoint; ArrowLen: longint;
ArrowAngleRad: float; ArrowType: TArrowType);
var {NormalizedLineX, NormalizedLineY, LineLen,} LineAngle: float;
ArrowPoint1, ArrowPoint2: TPoint;
begin
LineAngle:=arctan2(p2.y-p1.y,p2.x-p1.x);
ArrowPoint1.x:=round(ArrowLen*cos(pi+LineAngle-ArrowAngleRad))+p2.x;
ArrowPoint1.y:=round(ArrowLen*sin(pi+LineAngle-ArrowAngleRad))+p2.y;
ArrowPoint2.x:=round(ArrowLen*cos(pi+LineAngle+ArrowAngleRad))+p2.x;
ArrowPoint2.y:=round(ArrowLen*sin(pi+LineAngle+ArrowAngleRad))+p2.y;
Canvas.Line(p1,p2);
case ArrowType of
atSolid: begin
canvas.Polygon([ArrowPoint1,p2,ArrowPoint2]);
end;
atArrows: begin
Canvas.LineTo(ArrowPoint1.x,ArrowPoint1.y);
Canvas.Line(p2.x,p2.y,ArrowPoint2.x,ArrowPoint2.y);
end;
end;
end;
procedure ColorRGBToHLS(clrRGB: COLORREF; var Hue, Luminance, Saturation: Word);
var
H, L, S: Byte;