Zeichnen auf TCanvas

[DiBo33]

Hallo,
ich habe mir ein Lineal gebastelt und nun stelle ich 2 Unterschiede gegenüber Delphi fest.

Code: Alles auswählen

with Canvas do begin
  Brush.Color := clBtnFace;
  FillRect(ClientRect);
end;

In Delphi wird nun die Fläche mit der Farbe clBtnFace gezeichnet, in Lazarus ist die Farbe immer weis.

Code: Alles auswählen

MoveTo(x, Height - 9);
LineTo(x, Height);

Diese Striche werden nicht gezeichnet, während TextOut() richtig ausgegeben wird.

Wie kann ich es erreichen, dass das Verhalten gleich wie bei Delphi ist?

Hier mal der Quelltext

Code: Alles auswählen

unit DiBoRuler;
 
interface
 
uses
  SysUtils, Classes, Graphics, Controls;
 
type
  TDiBoRuler = class(TGraphicControl)
  private
    FFont:       TFont;
    FLeftMargin,
    CharWidth:   integer;
    procedure SetFont(Value: TFont);
    procedure SetLeftMargin(Value: integer);
  protected
    procedure Paint; override;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
  published
    property Align;
    property Color;
    property Enabled;
    property Font;
    property Height;
    property PopupMenu;
    property Visible;
    property Width;
    property EditFont: TFont read FFont write SetFont;
    property LeftMargin: integer read FLeftMargin write SetLeftMargin;
  end;
 
implementation
 
constructor TDiBoRuler.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  Align := alTop;
  Color := clBtnFace;
  Enabled := true;
  Visible := true;
  Height := 20;
  Font.Name := 'Arial';
  Font.Size := 8;
  FFont := TFont.Create;
  FFont.Name := 'Courier New';
  FFont.Size := 10;
  FLeftMargin := 3;
  CharWidth := 8;
  Parent := TWinControl(AOwner);
end;
 
destructor TDiBoRuler.Destroy;
begin
  FFont.Free;
  inherited;
end;
 
procedure TDiBoRuler.Paint;
var
  x, p, h: integer;
  s: string;
begin
  p := 0; x := FLeftMargin;
  with Canvas do begin
    Brush.Color := Color;
    FillRect(ClientRect);
    repeat
      h := 3;
      if (p MOD 5) = 0 then inc(h, 3);
      if (p MOD 10) = 0 then begin
        s := IntToStr(p);
        TextOut(x - TextWidth(s) SHR 1, 0, s);
        inc(h, 3);
      end;
      MoveTo(x, Height - h);
      LineTo(x, Height);
      inc(x, CharWidth); inc(p);
    until x >= Width;
  end;
end;
 
procedure TDiBoRuler.SetFont(Value: TFont);
begin
  FFont := Value;
  Canvas.Font.Assign(Value);
  CharWidth := Canvas.TextWidth('0');
  Canvas.Font.Assign(Font);
  Invalidate;
end;
 
procedure TDiBoRuler.SetLeftMargin(Value: integer);
begin
  FLeftMargin := Value + 3;
  Invalidate;
end;
 
end.

Eingebunden wird er folgendermassen in der Form.

Code: Alles auswählen

Ruler := TDiBoRuler.Create(Self);
Ruler.EditFont.Assign(SynEdit1.Font);
Ruler.LeftMargin := SynEdit1.Gutter.Width;

Ich hoffe jemand kann mir hier helfen.

Gruß

[theo]

Hast du dem Pen mal eine Farbe gegeben?
Canvas.Pen.Color

[DiBo33]

Hast du dem Pen mal eine Farbe gegeben?
Canvas.Pen.Color

Ja, leider ohne Wirkung.
Die Striche werden einfach nicht gezeichnet.

[Euklid]

Hallo DiBo33!
In der Regel zeichnet Lazarus auf eine Canvas. Kannst ja z.B. einfach mal ne Image erstellen - darauf funktioniert das Zeichnen zumindest. Oder auf eine nakte Form, da funktionierts auch.
Wo bei deinem TDiBoRuler das Problem liegt, kann ich dir leider nicht sagen.

Euklid

[theo]

Musst halt ein bischen debuggern!

Ich hab's mir kurz angeschaut:
Einfachste Lösung:
Leite von TCustomControl statt von TGraphicControl ab dann geht's.
Das Problem ist, dass du in deinem "with Canvas do begin" die Height vom Canvas und nicht vom Control ausliest.
Ein TGraphicControl erbt den Canvas vom Parent, und dieser ist in diesem Falle so hoch wie das Fomular. TCustomControl hat einen eigenen Canvas.

("With" Konstrukte sind sowieso nicht gut, weil die immer solchen Ärger machen)

[DiBo33]

In der Regel zeichnet Lazarus auf eine Canvas. Kannst ja z.B. einfach mal ne Image erstellen - darauf funktioniert das Zeichnen zumindest. Oder auf eine nakte Form, da funktionierts auch.

Ich könnte mal versuchen was passiert wenn ich direkt auf den Parent zeichne.

[DiBo33]

Musst halt ein bischen debuggern!

Ich hab's mir kurz angeschaut:
Einfachste Lösung:
Leite von TCustomControl statt von TGraphicControl ab dann geht's.
Das Problem ist, dass du in deinem "with Canvas do begin" die Height vom Canvas und nicht vom Control ausliest.
Das ist so, weil ein TGraphicControl den Canvas vom Parent erbt, und dieser ist in diesem Falle so hoch wie das Fomular. TCustomControl hat einen eigenen Canvas.

("With" Konstrukte sind sowieso nicht gut, weil die immer solchen Ärger machen)

Ha, das wars

Das komische ist, als erstes hatte ich es von TCustomControl abgeleitet, aber dann hatte etwas in Delphi nicht funktioniert (weiß ehrlich nicht mehr was).

Aber von TCustomControl abgeleitet, funktionierts wie es soll.
Dann werde ich es mal so umschreiben, dass es in Delphi und Lazarus gleichermassen funktioniert.

Danke euch

Gruß

[DiBo33]

("With" Konstrukte sind sowieso nicht gut, weil die immer solchen Ärger machen)

Du meinst grundsätzlich wäre eine Fullreferenzierung besser?
Mit Delphi hatte ich da noch nie Probleme, aber wenn du meinst unter Lazarus ist es besser, dann schreibe ich es entsprechend um.

[theo]

("With" Konstrukte sind sowieso nicht gut, weil die immer solchen Ärger machen)

Du meinst grundsätzlich wäre eine Fullreferenzierung besser?
Mit Delphi hatte ich da noch nie Probleme, aber wenn du meinst unter Lazarus ist es besser, dann schreibe ich es entsprechend um.

Da ist kein Unterschied von Delphi zu Lazarus.
Das Konstrukt an sich führt oft zu "undurchsichtigen" Fehlern, weil man nicht gut sehen kann worauf sich ein Property bezieht.
Du kannst den TGraphicControl schon behalten, dann muss du aber Self.Height auslesen oder oben explizit Referenzieren (ohne with).

[DiBo33]

Da ist kein Unterschied von Delphi zu Lazarus.
Das Konstrukt an sich führt oft zu "undurchsichtigen" Fehlern, weil man nicht gut sehen kann worauf sich ein Property bezieht.

Naja, in dem Fall hatten ja beide unterschiedlich reagiert.

Du kannst den TGraphicControl schon behalten, dann muss du aber Self.Height auslesen oder oben explizit Referenzieren (ohne with).

Stimmt jetzt gehts.

Ich machs einfach ohne with, dann bin ich auf der sicheren Seite.

Danke dir.

[theo]

Naja, in dem Fall hatten ja beide unterschiedlich reagiert.

Das lag aber nicht daran, dass "with" unterschiedlich funktionieren würde sondern daran, dass TGraphicControl.Canvas.Height scheint's unter D und Laz sich nicht auf das gleiche bezieht.
Das Problem lag hier also nicht direkt am "with".
Trotzdem sind "with" Konstrukte gerade im Zusammenhang mit "Allerwelts-Properties" wie Height eine häufige Fehlerquelle.

[DiBo33]

Ok, ich werde daran denken.
Falls es mal jemand benötigt, hier das Endprodukt.

Code: Alles auswählen

unit DiBoRuler;
 
interface
 
uses
  SysUtils, Classes, Graphics, Controls;
 
type
  TDiBoRuler = class(TGraphicControl)
  private
    FFontName:   string;
    FFontSize,
    FLeftMargin,
    LeftSpace,
    CharWidth:   integer;
    procedure SetFont;
    procedure SetFontName(Value: string);
    procedure SetFontSize(Value: integer);
    procedure SetLeftMargin(Value: integer);
  protected
    procedure Paint; override;
  public
    constructor Create(AOwner: TComponent); override;
  published
    property Align;
    property Color;
    property Enabled;
    property Font;
    property Height;
    property PopupMenu;
    property Visible;
    property Width;
    property FontName: string read FFontName write SetFontName;
    property FontSize: integer read FFontSize write SetFontSize;
    property LeftMargin: integer read FLeftMargin write SetLeftMargin;
  end;
 
implementation
 
constructor TDiBoRuler.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  Align := alTop;
  Color := clBtnFace;
  Enabled := true;
  Visible := true;
  Height := 12;
  Font.Name := 'Arial';
  Font.Size := 6;
  FFontName := 'Courier New';
  FFontSize := 10;
  FLeftMargin := 0;
  CharWidth := 8;
  LeftSpace := 4;
  Parent := TWinControl(AOwner);
end;
 
procedure TDiBoRuler.Paint;
var
  x, p, h: integer;
  s: string;
begin
  p := 0; x := FLeftMargin + LeftSpace;
  Canvas.Font.Assign(Font);
  Canvas.Brush.Color := Color;
  Canvas.FillRect(ClientRect);
  Canvas.TextOut(0, 0, Format('%d %s', [FFontSize, FFontName]));
  repeat
    h := 3; inc(x, CharWidth); inc(p);
    if (p MOD 5) = 0 then inc(h, 3);
    if (p MOD 10) = 0 then begin
      s := IntToStr(p);
      Canvas.TextOut(x - Canvas.TextWidth(s) SHR 1, 0, s);
    end;
    Canvas.MoveTo(x, Height - h);
    Canvas.LineTo(x, Height);
  until x >= Width;
end;
 
procedure TDiBoRuler.SetFont;
begin
  Canvas.Font.Name := FFontName;
  Canvas.Font.Size := FFontSize;
  CharWidth := Canvas.TextWidth('0');
  Invalidate;
end;
 
procedure TDiBoRuler.SetFontName(Value: string);
begin
  FFontName := Value;
  SetFont;
end;
 
procedure TDiBoRuler.SetFontSize(Value: integer);
begin
  FFontSize := Value;
  SetFont;
end;
 
procedure TDiBoRuler.SetLeftMargin(Value: integer);
begin
  FLeftMargin := Value;
  Invalidate;
end;
 
end.

Gruß