[TCanvas] Komponente wird nicht richtig aktualisiert

[Andreas L.]

Hallo,

ich habe eine Komponente von TCustomPanel abgeleitet und möchte in der Paint-Methode Rahmen zeichnen. Für jeden Rahmen habe ich eine Eigenschaft definiert und in der jeweiligen Setter-Methode wird Invalidate aufgerufen um den Rahmen zu zeichnen (ich habe dort auch schon Refresh, Repaint, Paint versucht). Zur Laufzeit funktioniert alles wunderbar, zur Designtime wird wenn ich in einer Rahmen-Eigenschaft einen Wert verändere der Rahmen nicht richtig gezeichnet (nur 3 Punkte und keine ganze Linie, siehe Screenshot im Anhang). Klicke ich auf das Objekt auf dem Formular wird der Rahmen korrekt gezeichnet. Ich kann mir das nicht erklären. Habt ihr eine Idee was ich falsch mache?

Delphi-Quellcode:

unit CsPanels;

interface

uses
  SysUtils, Classes, Controls, ExtCtrls, Graphics, Forms, Types;

type
  TCsBorderPosition = (cbpTop, cbpBottom, cbpLeft, cbpRight);

  { Forward-Deklarationen }
  TCsCustomPanel = class;

  TCsPanel = class;

  TCsBorderStyle = class;

  TCsCustomPanel = class(TCustomPanel)
  private
    FBorderLeft: TCsBorderStyle;
    FBorderRight: TCsBorderStyle;
    FBorderTop: TCsBorderStyle;
    FBorderBottom: TCsBorderStyle;
  protected
    procedure SetBorderLeft(Value: TCsBorderStyle);
    procedure SetBorderRight(Value: TCsBorderStyle);
    procedure SetBorderBottom(Value: TCsBorderStyle);
    procedure SetBorderTop(Value: TCsBorderStyle);

    procedure DrawBorder(Style: TCsBorderStyle; Position: TCsBorderPosition);
    function GetBorderStartPosition(Position: TCsBorderPosition): TPoint;
    function GetBorderEndPosition(Position: TCsBorderPosition): TPoint;

    property BorderLeft: TCsBorderStyle read FBorderLeft write SetBorderLeft;
    property BorderRight: TCsBorderStyle read FBorderRight write SetBorderRight;
    property BorderTop: TCsBorderStyle read FBorderTop write SetBorderTop;
    property BorderBottom: TCsBorderStyle read FBorderBottom write SetBorderBottom;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure Loaded; override;
    procedure Paint; override;
  published
    { Published-Deklarationen }
  end;

  TCsPanel = class(TCsCustomPanel)
  published
    property BorderLeft;
    property BorderRight;
    property BorderTop;
    property BorderBottom;
    property Color;
    property Align;
    property ParentBackground;
    property Font;
  end;

  TCsBorderStyle = class(TPersistent)
  private
    FColor: TColor;
    FWidth: Byte;
    FVisible: Boolean;
  public
    procedure Assign(Source: TPersistent); override;
    procedure AssignTo(Dest: TPersistent); override;
  published
    property Color: TColor read FColor write FColor;
    property Width: Byte read FWidth write FWidth;
    property Visible: Boolean read FVisible write FVisible;
  end;

implementation

{ TCsCustomPanel ------------------------------------------------------------- }
constructor TCsCustomPanel.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);

  BevelInner := bvNone;
  BevelOuter := bvNone;
  BorderStyle := bsNone;
  ShowCaption := False;

  FBorderLeft := TCsBorderStyle.Create;
  FBorderRight := TCsBorderStyle.Create;
  FBorderTop := TCsBorderStyle.Create;
  FBorderBottom := TCsBorderStyle.Create;

  Repaint;
end;

destructor TCsCustomPanel.Destroy;
begin
  FreeAndNil(FBorderLeft);
  FreeAndNil(FBorderRight);
  FreeAndNil(FBorderTop);
  FreeAndNil(FBorderBottom);

  inherited Destroy;
end;

procedure TCsCustomPanel.SetBorderLeft(Value: TCsBorderStyle);
begin
  FBorderLeft.Assign(Value);
  Invalidate;
end;

procedure TCsCustomPanel.SetBorderRight(Value: TCsBorderStyle);
begin
  FBorderRight.Assign(Value);
  Invalidate;
end;

procedure TCsCustomPanel.SetBorderBottom(Value: TCsBorderStyle);
begin
  FBorderBottom.Assign(Value);
  Invalidate;
end;

procedure TCsCustomPanel.SetBorderTop(Value: TCsBorderStyle);
begin
  FBorderTop.Assign(Value);
  Invalidate;
end;

procedure TCsCustomPanel.Loaded;
begin
  inherited Loaded;
  //Repaint;
end;

procedure TCsCustomPanel.DrawBorder(Style: TCsBorderStyle;
  Position: TCsBorderPosition);
var
  Coord: TPoint;
begin
  if Style.Visible then
  begin
    Canvas.Pen.Color := Style.Color;
    Canvas.Pen.Width := Style.Width;
    Canvas.PenPos := GetBorderStartPosition(Position);

    Coord := GetBorderEndPosition(Position);

    Canvas.LineTo(Coord.X, Coord.Y);
  end;
end;

function TCsCustomPanel.GetBorderStartPosition(Position: TCsBorderPosition): TPoint;
begin
  case Position of
    cbpTop:
    begin
      Result.X := 0;
      Result.Y := 0;
    end;
    cbpBottom:
    begin
      Result.X := 0;
      Result.Y := Height;
    end;
    cbpLeft:
    begin
      Result.X := 0;
      Result.Y := 0;
    end;
    cbpRight:
    begin
      Result.X := Width;
      Result.Y := 0;
    end;
  end;
end;

function TCsCustomPanel.GetBorderEndPosition(Position: TCsBorderPosition): TPoint;
begin
  case Position of
    cbpTop:
    begin
      Result.X := Width;
      Result.Y := 0;
    end;
    cbpBottom:
    begin
      Result.X := Width;
      Result.Y := Height;
    end;
    cbpLeft:
    begin
      Result.X := 0;
      Result.Y := Height;
    end;
    cbpRight:
    begin
      Result.X := Width;
      Result.Y := Height;
    end;
  end;
end;

procedure TCsCustomPanel.Paint;
begin
  inherited Paint;

  DrawBorder(FBorderLeft, cbpLeft);
  DrawBorder(FBorderRight, cbpRight);
  DrawBorder(FBorderTop, cbpTop);
  DrawBorder(FBorderBottom, cbpBottom);
end;

{ TCsBorderStyle ------------------------------------------------------------- }
procedure TCsBorderStyle.Assign(Source: TPersistent);
begin
  if Source is TCsBorderStyle then
  begin
    FColor := TCsBorderStyle(Source).Color;
    FWidth := TCsBorderStyle(Source).Width;
    FVisible := TCsBorderStyle(Source).Visible;
  end
  else
    inherited Assign(Source);
end;

procedure TCsBorderStyle.AssignTo(Dest: TPersistent);
begin
  if Dest is TCsBorderStyle then
  begin
    TCsBorderStyle(Dest).Color := FColor;
    TCsBorderStyle(Dest).Width := FWidth;
    TCsBorderStyle(Dest).Visible := FVisible;
  end
  else
    inherited AssignTo(Dest);
end;

end.

Schöne Grüße,
Andreas

Cross-Post: http://www.delphi-forum.de/viewtopic.php?t=105618