home *** CD-ROM | disk | FTP | other *** search
/ Chip 2002 June / Chip_2002-06_cd1.bin / zkuste / delphi / kompon / d3456 / GPJTLINE.ZIP / line.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  2002-04-04  |  9.0 KB  |  358 lines

  1. unit line;
  2.  
  3. interface
  4.  
  5. uses
  6.   Windows, Messages, Graphics, SysUtils, Classes, Controls;
  7.  
  8. type
  9.   TLineDirection = (drLeftRight, drUpDown, drTopLeftBottomRight, drTopRightBottomLeft);
  10.  
  11.   TLine = class(TGraphicControl)
  12.   private
  13.     { Private declarations }
  14.     FLineDir: TLineDirection;
  15.     FArrow1: Boolean;
  16.     FArrow2: Boolean;
  17.     FArrowFactor: Integer;
  18.     
  19.     function GetLineWidth: Integer;
  20.     function GetLineColor: TColor;
  21.     function GetArrowColor: TColor;
  22.     procedure SetLineWidth(const NewWidth: Integer);
  23.     procedure SetLineColor(const NewColor: TColor);
  24.     procedure SetArrowColor(const NewColor: TColor);
  25.     procedure SetLineDir(const NewDir: TLineDirection);
  26.     procedure SetArrow1(Value: Boolean);
  27.     procedure SetArrow2(Value: Boolean);
  28.     procedure SetArrowFactor(Value: integer);
  29.   protected
  30.     { Protected declarations }
  31.     procedure Paint; override;
  32.   public
  33.     { Public declarations }
  34.     constructor Create(AOwner: TComponent); override;
  35.     destructor Destroy; override;
  36.   published
  37.     { Published declarations }
  38.     property DragCursor;
  39.     property DragKind;
  40.     property DragMode;
  41.     property Align;
  42.     property ParentShowHint;
  43.     property Hint;
  44.     property ShowHint;
  45.     property Visible;
  46.     property PopupMenu;
  47.     property Direction: TLineDirection read FLineDir write SetLineDir default drLeftRight;
  48.     property LineColor: TColor read GetLineColor write SetLineColor;
  49.     property ArrowColor: TColor read GetArrowColor write SetArrowColor;
  50.     property LineWidth: Integer read GetLineWidth write SetLineWidth;
  51.     property Arrow1: Boolean read FArrow1 write SetArrow1 default False;
  52.     property Arrow2: Boolean read FArrow2 write SetArrow2 default False;
  53.     property ArrowFactor: Integer read FArrowFactor write SetArrowFactor default 3;
  54.     property OnDragDrop;
  55.     property OnDragOver;
  56.     property OnEndDrag;
  57.     property OnEndDock;
  58.     property OnMouseDown;
  59.     property OnMouseMove;
  60.     property OnMouseUp;
  61.     property OnClick;
  62.     property OnDblClick;
  63.   end;
  64.  
  65. procedure Register;
  66.  
  67. implementation
  68.  
  69. { TLine }
  70.  
  71. constructor TLine.Create(AOwner: TComponent);
  72. begin
  73.   inherited Create(AOwner);
  74.   ControlStyle := ControlStyle + [csReplicatable];
  75.   Width := 65;
  76.   Height := 4;
  77.   Canvas.Brush.Color:=clBlack;
  78.   FArrowFactor:=3;
  79. end;
  80.  
  81. destructor TLine.Destroy;
  82. begin
  83.   inherited Destroy;
  84. end;
  85.  
  86. procedure TLine.SetArrowFactor(Value: Integer);
  87. begin
  88.   if Value <> FArrowFactor then begin
  89.      FArrowFactor := Value;
  90.      Invalidate; 
  91.   end;
  92. end;
  93.  
  94. procedure TLine.SetArrow1(Value: Boolean);
  95. begin
  96.   if Value <> FArrow1 then begin
  97.      FArrow1 := Value;
  98.      if Value then SetLineWidth(1);
  99.      Invalidate;
  100.   end;
  101. end;
  102.  
  103. procedure TLine.SetArrow2(Value: Boolean);
  104. begin
  105.   if Value <> FArrow2 then begin
  106.      FArrow2 := Value;
  107.      if Value then SetLineWidth(1);
  108.      Invalidate;
  109.   end;
  110. end;
  111.  
  112.  
  113. function TLine.GetLineWidth: Integer;
  114. begin
  115.   Result := Canvas.Pen.Width;
  116. end;
  117.  
  118. function TLine.GetLineColor: TColor;
  119. begin
  120.   Result := Canvas.Pen.Color;
  121. end;
  122.  
  123. function TLine.GetArrowColor: TColor;
  124. begin
  125.   Result := Canvas.Brush.Color;
  126. end;
  127.  
  128. procedure TLine.SetLineWidth(const NewWidth: Integer);
  129. begin
  130.   if NewWidth <> Canvas.Pen.Width then
  131.   begin
  132.     if FArrow1 or FArrow2 then begin
  133.        LineWidth:=1;
  134.        Canvas.Pen.Width:=1;
  135.     end else Canvas.Pen.Width := NewWidth;
  136.     Invalidate;
  137.   end;
  138. end;
  139.  
  140. procedure TLine.SetLineColor(const NewColor: TColor);
  141. begin
  142.   if NewColor <> Canvas.Pen.Color then
  143.   begin
  144.     Canvas.Pen.Color := NewColor;
  145.     Invalidate;
  146.   end;
  147. end;
  148.  
  149. procedure TLine.SetArrowColor(const NewColor: TColor);
  150. begin
  151.   if NewColor <> Canvas.Brush.Color then
  152.   begin
  153.     Canvas.Brush.Color := NewColor;
  154.     Invalidate;
  155.   end;
  156. end;
  157.  
  158. procedure TLine.SetLineDir(const NewDir: TLineDirection);
  159. begin
  160.   if NewDir <> FLineDir then
  161.   begin
  162.     FLineDir := NewDir;
  163.     Invalidate;
  164.   end;
  165. end;
  166.  
  167. procedure TLine.Paint;
  168. var
  169.   start: Integer;
  170.   p1,p2,p3:TPoint;
  171.   H0,W0,H,W:Integer;
  172.   Alfa:extended;
  173. begin
  174.   inherited;
  175.   case FLineDir of
  176.     drLeftRight:
  177.       begin
  178.         start := (Height - Canvas.Pen.Width) div 2;
  179.         Canvas.MoveTo(0, start);
  180.         Canvas.LineTo(Width, Start);
  181.         if FArrow1 then begin
  182.           //Flecha hacia izquierda
  183.           p1:=Point(0,start);
  184.           p2:=Point(FArrowFactor,Start-FArrowFactor);
  185.           p3:=Point(FArrowFactor,Start+FArrowFactor);
  186.           Canvas.Polygon([p1,p2,p3]);
  187.         end;
  188.  
  189.         if FArrow2 then begin
  190.           //Flecha hacia derecha
  191.           p1:=Point(Width-1, Start);
  192.           p2:=Point(Width-(FArrowFactor+1),Start-FArrowFactor);
  193.           p3:=Point(Width-(FArrowFactor+1),Start+FArrowFactor);
  194.           Canvas.Polygon([p1,p2,p3]);
  195.         end;
  196.       end;
  197.     drUpDown:
  198.       begin
  199.         start := (Width - Canvas.Pen.Width) div 2;
  200.         Canvas.MoveTo(start, 0);
  201.         Canvas.LineTo(start, Height);
  202.         if FArrow1 then begin
  203.           //Flecha hacia arriba
  204.           p1:=Point(start,0);
  205.           p2:=Point(Start-FArrowFactor,FArrowFactor);
  206.           p3:=Point(Start+FArrowFactor,FArrowFactor);
  207.           Canvas.Polygon([p1,p2,p3]);
  208.         end;
  209.  
  210.         if FArrow2 then begin
  211.           //Flecha hacia abajo
  212.           p1:=Point(start,Height-1);
  213.           p2:=Point(Start-FArrowFactor,Height-(FArrowFactor+1));
  214.           p3:=Point(Start+FArrowFactor,Height-(FArrowFactor+1));
  215.           Canvas.Polygon([p1,p2,p3]);
  216.         end;
  217.       end;
  218.     drTopLeftBottomRight:
  219.       begin
  220.         Canvas.MoveTo(0, 0);
  221.         Canvas.LineTo(Width, Height);
  222.         if FArrow1 and(Width>0)then begin
  223.           //Flecha hacia arriba
  224.           Alfa:=ArcTan(Height/Width);
  225.           H0:=Round((FArrowFactor+1)*Sin(Alfa));
  226.           W0:=Round((FArrowFactor+1)*Cos(Alfa));
  227.  
  228.           p1:=Point(0,0);
  229.           W:=Round(W0+(FArrowFactor*Cos((Pi/2)-Alfa)));
  230.           H:=Round(H0-(FArrowFactor*Sin((Pi/2)-Alfa)));
  231.  
  232.           if H<0 then H:=0;
  233.           if W<0 then W:=0;
  234.  
  235.           p2:=Point(W,H);
  236.  
  237.           W:=Round(W0-(FArrowFactor*Cos((Pi/2)-Alfa)));
  238.           H:=Round(H0+(FArrowFactor*Sin((Pi/2)-Alfa)));
  239.  
  240.           if H<0 then H:=0;
  241.           if W<0 then W:=0;
  242.  
  243.           p3:=Point(W,H);
  244.  
  245.           Canvas.Polygon([p1,p2,p3]);
  246.         end;
  247.  
  248.  
  249.         if FArrow2 and(Width>0)then begin
  250.           //Flecha hacia abajo
  251.           Alfa:=ArcTan(Height/Width);
  252.           H0:=Round((FArrowFactor+1)*Sin(Alfa));
  253.           W0:=Round((FArrowFactor+1)*Cos(Alfa));
  254.  
  255.           p1:=Point(Width-1, Height-1);
  256.           
  257.           W:=Round(W0-(FArrowFactor*Cos((Pi/2)-Alfa)));
  258.           H:=Round(H0+(FArrowFactor*Sin((Pi/2)-Alfa)));
  259.  
  260.           W:=Width-W-1;
  261.           H:=Height-H-1;
  262.           
  263.           if H>=Height then H:=Height-1;
  264.           if W>=Width then W:=Width-1;
  265.  
  266.           p2:=Point(W,H);
  267.  
  268.           W:=Round(W0+(FArrowFactor*Cos((Pi/2)-Alfa)));
  269.           H:=Round(H0-(FArrowFactor*Sin((Pi/2)-Alfa)));
  270.  
  271.           W:=Width-W-1;
  272.           H:=Height-H-1;
  273.           
  274.           if H>=Height then H:=Height-1;
  275.           if W>=Width then W:=Width-1;
  276.  
  277.           p3:=Point(W,H);
  278.  
  279.           Canvas.Polygon([p1,p2,p3]);
  280.         end;
  281.  
  282.       end;
  283.     drTopRightBottomLeft:
  284.       begin
  285.         Canvas.MoveTo(Width, 0);
  286.         Canvas.LineTo(0, Height);
  287.         if FArrow1 and(Width>0)then begin
  288.           //Flecha hacia arriba
  289.           Alfa:=ArcTan(Height/Width);
  290.           H0:=Round((FArrowFactor+1)*Sin(Alfa));
  291.           W0:=Round((FArrowFactor+1)*Cos(Alfa));
  292.  
  293.           p1:=Point(Width-1,0);
  294.           
  295.           W:=Round(W0+(FArrowFactor*Cos((Pi/2)-Alfa)));
  296.           H:=Round(H0-(FArrowFactor*Sin((Pi/2)-Alfa)));
  297.  
  298.           W:=Width-W-1;
  299.  
  300.           if H<0 then H:=0;
  301.           if W>=Width then W:=Width-1;
  302.  
  303.           p2:=Point(W,H);
  304.  
  305.           W:=Round(W0-(FArrowFactor*Cos((Pi/2)-Alfa)));
  306.           H:=Round(H0+(FArrowFactor*Sin((Pi/2)-Alfa)));
  307.  
  308.           W:=Width-W-1;
  309.  
  310.           if H<0 then H:=0;
  311.           if W>=Width then W:=Width-1;
  312.  
  313.           p3:=Point(W,H);
  314.  
  315.           Canvas.Polygon([p1,p2,p3]);
  316.         end;
  317.  
  318.         if FArrow2 and(Width>0)then begin
  319.           //Flecha hacia abajo
  320.           Alfa:=ArcTan(Height/Width);
  321.           H0:=Round((FArrowFactor+1)*Sin(Alfa));
  322.           W0:=Round((FArrowFactor+1)*Cos(Alfa));
  323.  
  324.           p1:=Point(0, Height-1);
  325.           
  326.           W:=Round(W0-(FArrowFactor*Cos((Pi/2)-Alfa)));
  327.           H:=Round(H0+(FArrowFactor*Sin((Pi/2)-Alfa)));
  328.  
  329.           H:=Height-H-1;
  330.           
  331.           if H>=Height then H:=Height-1;
  332.           if W<0 then W:=0;
  333.  
  334.           p2:=Point(W,H);
  335.  
  336.           W:=Round(W0+(FArrowFactor*Cos((Pi/2)-Alfa)));
  337.           H:=Round(H0-(FArrowFactor*Sin((Pi/2)-Alfa)));
  338.  
  339.           H:=Height-H-1;
  340.           
  341.           if H>=Height then H:=Height-1;
  342.           if W<0 then W:=0;
  343.  
  344.           p3:=Point(W,H);
  345.  
  346.           Canvas.Polygon([p1,p2,p3]);
  347.         end;
  348.       end;
  349.   end;
  350. end;
  351.  
  352. procedure Register;
  353. begin
  354.   RegisterComponents('Additional', [TLine]);
  355. end;
  356.  
  357. end.
  358.