NYIL

Top  Previous  Next

 

{ TArrow - Irányitott nyilak

DELPHI 1.0 komponens

StellaSOFT

}

 

unit Nyil;

 

interface

 

uses

SysUtils, WinTypes, WinProcs, Messages, Classes,

Graphics, Controls, Forms, Dialogs,stdctrls;

 

type

TDirection = (dLeft,dUpLeft,dUp,dUpRight,dRight,dDownRight,dDown,dDownLeft);

TArrowStyle = (asThin,asStrick);

 

TArrow = class(TGraphicControl)

private

   FPen : TPen;

   FBrush : TBrush;

   FDirection : TDirection;

   FArrowStyle : TArrowStyle;

   FCtl3d : boolean;

   procedure SetPen(Value:TPen);

   procedure SetBrush(Value:TBrush);

   procedure SetDirection(Value:TDirection);

   procedure SetArrowStyle(Value:TArrowStyle);

   procedure SetCtl3d(Value:boolean);

protected

public

   constructor Create(AOwner:TComponent);override;

   destructor Destroy;override;

   Procedure Paint;override;

published

   Property Pen : TPen read FPen write SetPen ;

   Property Brush : TBrush read FBrush write SetBrush ;

   Property Direction : TDirection read FDirection write SetDirection ;

   Property ArrowStyle : TArrowStyle read FArrowStyle write SetArrowStyle ;

   Property Ctl3d : boolean read FCtl3d write SetCtl3d ;

end;

 

procedure Register;

 

 

implementation

 

procedure Register;

begin

    RegisterComponents('AL',[TArrow]);

end;

 

constructor TArrow.Create(AOwner:TComponent);

begin

    inherited Create(AOwner);

    width  := 50;

    height := 50;

    FPen:=TPen.Create;

    FBrush:=TBrush.Create;

    FPen.Width := 4;

    FPen.Color := clRed;

end;

 

destructor TArrow.Destroy;

begin

    FPen.Destroy;

    FBrush.Destroy;

    inherited Destroy;

end;

 

 

procedure TArrow.SetPen(Value:TPen);

begin

If FPen<>Value then begin

    FPen.Assign(Value);

    invalidate;

end;

end;

 

 

procedure TArrow.SetBrush(Value:TBrush);

begin

If FBrush<>Value then begin

    FBrush.Assign(Value);

    invalidate;

end;

end;

 

 

procedure TArrow.SetDirection(Value:TDirection);

begin

If FDirection<>Value then begin

    FDirection := Value;

    invalidate;

end;

end;

 

 

procedure TArrow.SetArrowStyle(Value:TArrowStyle);

begin

If FArrowStyle<>Value then begin

    FArrowStyle := Value;

    invalidate;

end;

end;

 

 

procedure TArrow.SetCtl3d(Value:boolean);

begin

If FCtl3D<>Value then begin

    FCtl3D := Value;

    invalidate;

end;

end;

 

Procedure TArrow.Paint;

begin

with Canvas do

begin

   Pen := FPen;

   Brush := FBrush;

   case Direction of

   dLeft     : Case ArrowStyle of

               asThin : begin

                          MoveTo(0,Height div 2);

                          LineTo(Width,Height div 2);

                          MoveTo(Width-(Height div 2),0);

                          LineTo(Width,Height div 2);

                          LineTo(Width-(Height div 2),Height);

                        end;

               end;

   dUpLeft   : begin

               end;

   dUp       : begin

               end;

   dUpRight  : begin

               end;

   dRight    : begin

               end;

   dDownRight: begin

               end;

   dDown     : begin

               end;

   dDownLeft : begin

               end;

   end;

end;

inherited Paint;

end;

 

end.