Linien-Komponente gesucht

[Muetze1]

Delphi-Quellcode:

unit FormLine;

interface

uses
  SysUtils, Classes, Controls, Windows, Graphics;

type
  TFormLine = class(TGraphicControl)
  private
   FStartPosX : Integer;
   FStartPosY : Integer;
   FEndPosX   : Integer;
   FEndPosY   : Integer;
   procedure SetStartPosX(const Value: Integer);
   procedure SetStartPosY(const Value: Integer);
   procedure SetEndPosX(const Value: Integer);
   procedure SetEndPosY(const Value: Integer);
   procedure SetPen(const Value: TPen);
   function  GetPen: TPen;
   procedure SetBrush(const Value: TBrush);
   Function  GetBrush: TBrush;
  protected
    { Protected-Deklarationen }
  public
    { Public-Deklarationen }
   procedure Paint; override;
  published
   property StartPosX: Integer read FStartPosX write SetStartPosX;
   property StartPosY: Integer read FStartPosY write SetStartPosY;
   property EndPosX  : Integer read FEndPosX   write SetEndPosX;
   property EndPosY  : Integer read FEndPosY   write SetEndPosY;
   property Pen: TPen read GetPen write SetPen;
   property Brush: TBrush read GetBrush write SetBrush;
    { Published-Deklarationen }
  end;

procedure Register;

implementation

procedure Register;
begin
  RegisterComponents('Beispiele', [TFormLine]);
end;

procedure TFormLine.SetStartPosX(const Value: Integer);
begin
IF (Value <> FStartPosX) THEN BEGIN
  FStartPosX := Value;
  Invalidate;
END;
end;

procedure TFormLine.SetStartPosY(const Value: Integer);
begin
IF (Value <> FStartPosY) THEN BEGIN
  FStartPosY := Value;
  Invalidate;
END;
end;

procedure TFormLine.SetEndPosX(const Value: Integer);
begin
IF (Value <> FEndPosX) THEN BEGIN
  FEndPosX := Value;
  Invalidate;
END;
end;

procedure TFormLine.SetEndPosY(const Value: Integer);
begin
IF (Value <> FEndPosY) THEN BEGIN
  FEndPosY := Value;
  Invalidate;
END;
end;

procedure TFormLine.SetPen(const Value: TPen);
Begin
  Canvas.Pen.Assign(Value);
End;

Function TFormLine.GetPen: TPen;
Begin
  Result := Canvas.Pen;
End;

procedure TFormLine.SetBrush(const Value: TBrush);
Begin
  Canvas.Brush.Assign(Value);
End;

Function TFormLine.GetBrush: TBrush;
Begin
  Result := Canvas.Brush;
End;

procedure TFormLine.Paint;
begin
  Canvas.FillRect(Canvas.ClipRect);
  Canvas.MoveTo(FStartPosX, FStartPosY);
  Canvas.LineTo(FEndPosX, FEndPosY);
end;

end.

So, nun sollten die Fehler raus sein.

Wenn er kein Rechteck füllen sollen, dann kannst du zum einen den Brush Style auf bsClear setzen oder du entfernst das FillRect in Paint. Erstere Methode lässt dir aber noch mehr andere Möglichkeiten offen.

Mein Code ist von TGraphicControl abgeleitet und dieses benutzt den Canvas des Parent und keinen eigenen