<pre style="margin-top: 0pt; display: inline;">// Initially developed by Gon Perez-Jimenez. 2002-4th-April for Delphi<br>unit ULine;<br><br>interface<br><br>uses<br> SysUtils, Classes, Controls, Graphics;<br><br>type<br>
TLineDirection = (drLeftRight, drUpDown, drTopLeftBottomRight, drTopRightBottomLeft);<br><br> TLine = class(TGraphicControl)<br> private<br> { Private declarations }<br> FLineDir: TLineDirection;<br> FArrow1: Boolean;<br>
FArrow2: Boolean;<br> FArrowFactor: Integer;<br> function GetLineWidth: Integer;<br> function GetLineColor: TColor;<br> function GetLineStyle: TPenStyle;<br> procedure SetLineWidth(const NewWidth: Integer);<br>
procedure SetLineColor(const NewColor: TColor);<br> procedure SetLineDir(const NewDir: TLineDirection);<br> procedure SetArrow1(Value: Boolean);<br> procedure SetArrow2(Value: Boolean);<br> procedure SetArrowFactor(Value: integer);<br>
procedure SetLineStyle(const NewStyle: TPenStyle);<br> protected<br> { Protected declarations }<br> procedure Paint; override;<br> public<br> { Public declarations }<br> constructor Create(AOwner: TComponent); override;<br>
destructor Destroy; override;<br> published<br> { Published declarations }<br> property DragCursor;<br> property DragKind;<br> property DragMode;<br> property Align;<br> property ParentShowHint;<br>
property Hint;<br> property ShowHint;<br> property Visible;<br> property PopupMenu;<br> property Direction: TLineDirection read FLineDir write SetLineDir default drLeftRight;<br> property Color: TColor read GetLineColor write SetLineColor;<br>
property LineStyle :TPenStyle read GetLineStyle write SetLineStyle;<br> property LineWidth: Integer read GetLineWidth write SetLineWidth;<br> property Arrow1: Boolean read FArrow1 write SetArrow1 default False;<br>
property Arrow2: Boolean read FArrow2 write SetArrow2 default False;<br> property ArrowFactor: Integer read FArrowFactor write SetArrowFactor default 3;<br> property OnDragDrop;<br> property OnDragOver;<br> property OnEndDrag;<br>
property OnEndDock;<br> property OnMouseDown;<br> property OnMouseMove;<br> property OnMouseUp;<br> property OnClick;<br> property OnDblClick;<br> end;<br><br>procedure Register;<br><br>implementation<br>
<br>{ TLine }<br><br>constructor TLine.Create(AOwner: TComponent);<br>begin<br> inherited Create(AOwner);<br> ControlStyle := ControlStyle + [csReplicatable];<br> Width := 65;<br> Height := 4;<br> Canvas.Brush.Color:=clBlack;<br>
FArrowFactor:=3;<br>end;<br><br>destructor TLine.Destroy;<br>begin<br> inherited Destroy;<br>end;<br><br>procedure TLine.SetArrowFactor(Value: Integer);<br>begin<br> if Value <> FArrowFactor then begin<br> FArrowFactor := Value;<br>
Invalidate; <br> end;<br>end;<br><br>procedure TLine.SetArrow1(Value: Boolean);<br>begin<br> if Value <> FArrow1 then begin<br> FArrow1 := Value;<br> if Value then SetLineWidth(1);<br> Invalidate;<br>
end;<br>end;<br><br>procedure TLine.SetArrow2(Value: Boolean);<br>begin<br> if Value <> FArrow2 then begin<br> FArrow2 := Value;<br> if Value then SetLineWidth(1);<br> Invalidate;<br> end;<br>end;<br>
<br>function TLine.GetLineWidth: Integer;<br>begin<br> Result := Canvas.Pen.Width;<br>end;<br><br>function TLine.GetLineColor: TColor;<br>begin<br> Result := Canvas.Pen.Color;<br>end;<br><br>function TLine.GetLineStyle: TPenStyle;<br>
begin<br> Result := Canvas.Pen.Style;<br>end;<br><br>procedure TLine.SetLineWidth(const NewWidth: Integer);<br>begin<br> if NewWidth <> Canvas.Pen.Width then<br> begin<br> if FArrow1 or FArrow2 then begin<br> LineWidth:=1;<br>
Canvas.Pen.Width:=1;<br> end else Canvas.Pen.Width := NewWidth;<br> Invalidate;<br> end;<br>end;<br><br>procedure TLine.SetLineColor(const NewColor: TColor);<br>begin<br> if NewColor <> Canvas.Pen.Color then<br>
begin<br> Canvas.Pen.Color := NewColor;<br> Invalidate;<br> end;<br>end;<br><br>procedure TLine.SetLineStyle(const NewStyle: TPenStyle);<br>begin<br> if NewStyle <> Canvas.Pen.Style then<br> begin<br> Canvas.Pen.Style := NewStyle;<br>
Invalidate;<br> end;<br>end;<br><br>procedure TLine.SetLineDir(const NewDir: TLineDirection);<br>begin<br> if NewDir <> FLineDir then<br> begin<br> FLineDir := NewDir;<br> Invalidate;<br> end;<br>end;<br>
<br>procedure TLine.Paint;<br>var<br> start: Integer;<br> p1,p2,p3:TPoint;<br> H0,W0,H,W:Integer;<br> Alfa:extended;<br>begin<br> inherited;<br> case FLineDir of<br> drLeftRight:<br> begin<br> start := (Height - Canvas.Pen.Width) div 2;<br>
Canvas.Brush.Style := bsClear;<br> Canvas.MoveTo(0, start);<br> Canvas.LineTo(Width, Start);<br> if FArrow1 then begin<br> // Arrow left<br> p1:=Point(0,start);<br> p2:=Point(FArrowFactor,Start-FArrowFactor);<br>
p3:=Point(FArrowFactor,Start+FArrowFactor);<br> Canvas.Brush.Style := bsSolid;<br> Canvas.Brush.Color := Canvas.Pen.Color;<br> Canvas.Polygon([p1,p2,p3]);<br> end;<br><br> if FArrow2 then begin<br>
// Arrow right<br> p1:=Point(Width-1, Start);<br> p2:=Point(Width-(FArrowFactor+1),Start-FArrowFactor);<br> p3:=Point(Width-(FArrowFactor+1),Start+FArrowFactor);<br> Canvas.Brush.Style := bsSolid;<br>
Canvas.Brush.Color := Canvas.Pen.Color;<br> Canvas.Polygon([p1,p2,p3]);<br> end;<br> end;<br> drUpDown:<br> begin<br> start := (Width - Canvas.Pen.Width) div 2;<br> Canvas.Brush.Style := bsClear;<br>
Canvas.MoveTo(start, 0);<br> Canvas.LineTo(start, Height);<br> if FArrow1 then begin<br> // Arrow up<br> p1:=Point(start,0);<br> p2:=Point(Start-FArrowFactor,FArrowFactor);<br>
p3:=Point(Start+FArrowFactor,FArrowFactor);<br> Canvas.Brush.Style := bsSolid;<br> Canvas.Brush.Color := Canvas.Pen.Color;<br> Canvas.Polygon([p1,p2,p3]);<br> end;<br><br> if FArrow2 then begin<br>
// Arrow down<br> p1:=Point(start,Height-1);<br> p2:=Point(Start-FArrowFactor,Height-(FArrowFactor+1));<br> p3:=Point(Start+FArrowFactor,Height-(FArrowFactor+1));<br> Canvas.Brush.Style := bsSolid;<br>
Canvas.Brush.Color := Canvas.Pen.Color;<br> Canvas.Polygon([p1,p2,p3]);<br> end;<br> end;<br> drTopLeftBottomRight:<br> begin<br> Canvas.Brush.Style := bsClear;<br> Canvas.MoveTo(0, 0);<br>
Canvas.LineTo(Width, Height);<br> if FArrow1 and(Width>0)then begin<br> // Arrow up<br> Alfa:=ArcTan(Height/Width);<br> H0:=Round((FArrowFactor+1)*Sin(Alfa));<br> W0:=Round((FArrowFactor+1)*Cos(Alfa));<br>
p1:=Point(0,0);<br> W:=Round(W0+(FArrowFactor*Cos((Pi/2)-Alfa)));<br> H:=Round(H0-(FArrowFactor*Sin((Pi/2)-Alfa)));<br> if H<0 then H:=0;<br> if W<0 then W:=0;<br> p2:=Point(W,H);<br>
W:=Round(W0-(FArrowFactor*Cos((Pi/2)-Alfa)));<br> H:=Round(H0+(FArrowFactor*Sin((Pi/2)-Alfa)));<br> if H<0 then H:=0;<br> if W<0 then W:=0;<br> p3:=Point(W,H);<br> Canvas.Brush.Style := bsSolid;<br>
Canvas.Brush.Color := Canvas.Pen.Color;<br> Canvas.Polygon([p1,p2,p3]);<br> end;<br> if FArrow2 and(Width>0)then begin<br> // Arrou down<br> Alfa:=ArcTan(Height/Width);<br>
H0:=Round((FArrowFactor+1)*Sin(Alfa));<br> W0:=Round((FArrowFactor+1)*Cos(Alfa));<br> p1:=Point(Width-1, Height-1);<br> W:=Round(W0-(FArrowFactor*Cos((Pi/2)-Alfa)));<br> H:=Round(H0+(FArrowFactor*Sin((Pi/2)-Alfa)));<br>
W:=Width-W-1;<br> H:=Height-H-1;<br> if H>=Height then H:=Height-1;<br> if W>=Width then W:=Width-1;<br> p2:=Point(W,H);<br> W:=Round(W0+(FArrowFactor*Cos((Pi/2)-Alfa)));<br>
H:=Round(H0-(FArrowFactor*Sin((Pi/2)-Alfa)));<br> W:=Width-W-1;<br> H:=Height-H-1;<br> if H>=Height then H:=Height-1;<br> if W>=Width then W:=Width-1;<br> p3:=Point(W,H);<br>
Canvas.Brush.Style := bsSolid;<br> Canvas.Brush.Color := Canvas.Pen.Color;<br> Canvas.Polygon([p1,p2,p3]);<br> end;<br> end;<br> drTopRightBottomLeft:<br> begin<br> Canvas.Brush.Style := bsClear;<br>
Canvas.MoveTo(Width, 0);<br> Canvas.LineTo(0, Height);<br> if FArrow1 and(Width>0)then begin<br> // Arrou up<br> Alfa:=ArcTan(Height/Width);<br> H0:=Round((FArrowFactor+1)*Sin(Alfa));<br>
W0:=Round((FArrowFactor+1)*Cos(Alfa));<br> p1:=Point(Width-1,0);<br> W:=Round(W0+(FArrowFactor*Cos((Pi/2)-Alfa)));<br> H:=Round(H0-(FArrowFactor*Sin((Pi/2)-Alfa)));<br> W:=Width-W-1;<br>
if H<0 then H:=0;<br> if W>=Width then W:=Width-1;<br> p2:=Point(W,H);<br> W:=Round(W0-(FArrowFactor*Cos((Pi/2)-Alfa)));<br> H:=Round(H0+(FArrowFactor*Sin((Pi/2)-Alfa)));<br>
W:=Width-W-1;<br> if H<0 then H:=0;<br> if W>=Width then W:=Width-1;<br> p3:=Point(W,H);<br> Canvas.Brush.Style := bsSolid;<br> Canvas.Brush.Color := Canvas.Pen.Color;<br>
Canvas.Polygon([p1,p2,p3]);<br> end;<br> if FArrow2 and(Width>0)then begin<br> // Arrow down<br> Alfa:=ArcTan(Height/Width);<br> H0:=Round((FArrowFactor+1)*Sin(Alfa));<br>
W0:=Round((FArrowFactor+1)*Cos(Alfa));<br> p1:=Point(0, Height-1);<br> W:=Round(W0-(FArrowFactor*Cos((Pi/2)-Alfa)));<br> H:=Round(H0+(FArrowFactor*Sin((Pi/2)-Alfa)));<br> H:=Height-H-1;<br>
if H>=Height then H:=Height-1;<br> if W<0 then W:=0;<br> p2:=Point(W,H);<br> W:=Round(W0+(FArrowFactor*Cos((Pi/2)-Alfa)));<br> H:=Round(H0-(FArrowFactor*Sin((Pi/2)-Alfa)));<br>
H:=Height-H-1;<br> if H>=Height then H:=Height-1;<br> if W<0 then W:=0;<br> p3:=Point(W,H);<br> Canvas.Brush.Style := bsSolid;<br> Canvas.Brush.Color := Canvas.Pen.Color;<br>
Canvas.Polygon([p1,p2,p3]);<br> end;<br> end;<br> end;<br>end;<br><br>procedure Register;<br>begin<br> RegisterComponents('Misc', [TLine]);<br>end;<br><br>end. <br></pre><div style="visibility: hidden; left: -5000px; position: absolute; z-index: 9999; padding: 0px; margin-left: 0px; margin-top: 0px; overflow: hidden; word-wrap: break-word; color: black; font-size: 10px; text-align: left; line-height: 130%;" id="avg_ls_inline_popup">
</div>