[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

[DeddyH]

Anhang vergessen?

[Deep-Sea]

Ein Repaint im Create? Dass es das Problem verursacht glaube ich zwar weniger, aber trotzdem gehört das da nicht wirklich hin.

[Andreas L.]

Zitat:

Zitat von DeddyH (Beitrag 1102320)

Anhang vergessen?

Oops :oops: Hab ihn jetzt hochgeladen

Zitat:

Zitat von Deep-Sea (Beitrag 1102321)

Ein Repaint im Create? Dass es das Problem verursacht glaube ich zwar weniger, aber trotzdem gehört das da nicht wirklich hin.

War nur ein Test den ich vergessen habe auszukommentieren. Hast aber recht, ändert nichts am Problem.

[Bummi]

So, siehe Anhang funktioniert es ...

[Andreas L.]

Zitat:

Zitat von Bummi (Beitrag 1102326)

So, siehe Anhang funktioniert es ...

Danke für deine Mühe. Aber der Fehler tritt immer noch auf. An was könnte das liegen? Mein aktueller Code:

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;
    FOwner: TCsCustomPanel;
  protected
    procedure SetColor(Value: TColor);
    procedure SetWidth(Value: Byte);
    procedure SetVisible(Value: Boolean);
  public
    constructor Create(AOwner: TCsCustomPanel); overload;
    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(Self);
  FBorderRight := TCsBorderStyle.Create(Self);
  FBorderTop := TCsBorderStyle.Create(Self);
  FBorderBottom := TCsBorderStyle.Create(Self);
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 ------------------------------------------------------------- }
constructor TCsBorderStyle.Create(AOwner: TCsCustomPanel);
begin
  //inherited Create;

  FOwner := AOwner;
end;

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;

procedure TCsBorderStyle.SetColor(Value: TColor);
begin
  FColor := Value;
  if Assigned(FOwner) then
    FOwner.Invalidate;
end;

procedure TCsBorderStyle.SetWidth(Value: Byte);
begin
  FWidth := Value;
  if Assigned(FOwner) then
    FOwner.Invalidate;
end;

procedure TCsBorderStyle.SetVisible(Value: Boolean);
begin
  FVisible := Value;
  if Assigned(FOwner) then
    FOwner.Invalidate;
end;

end.

EDIT: Ich habe nun auch alle DCUs gelöscht und alles komplett neu erzeugt. Das Problem besteht weiterhin. Wenn ich auf eine der "if Assigned(FOwner) then"-Zeilen einen Haltepunkt setze, wird dieser mir beim ausführen als rotes Kreuz angezeigt. Warum wird der Haltepunkt niemals erreicht?

EDIT2: Hat sich erledigt. Ich hatte vergessen die Setter in den Eigenschaften einzutragen. Jetzt geht alles. Danke an alle :-)

[Bummi]

Du hast die entscheidenden Teile ja auch entfernt, exemplarisch

Delphi-Quellcode:

procedure TCsBorderStyle.setWidth(const Value: Byte);
begin
  FWidth := Value;
  if Assigned(FOwner) then FOwner.Invalidate;
end;

[Andreas L.]

Zitat:

Zitat von Bummi (Beitrag 1102340)

Du hast die entscheidenden Teile ja auch entfernt, exemplarisch

Delphi-Quellcode:

procedure TCsBorderStyle.setWidth(const Value: Byte);
begin
  FWidth := Value;
  if Assigned(FOwner) then FOwner.Invalidate;
end;

Du meinst das const? Jetzt gehts ja auch ohne const. Warum ist das wichtig?

[Bummi]

ich meine :

if Assigned(FOwner) then FOwner.Invalidate;

EDIT:

sorry ich hatte Deine Edits nicht gesehen ....