Komponente zeichnet sich nicht neu, bei Font Änderung

[Nightshade]

Delphi-Quellcode:

unit StatusScroll;

interface

uses
  SysUtils, Classes, Controls, Graphics;

type
  TStatusScroll = class(TGraphicControl)
  private
    FLines: TStringList;
    FFont: TFont;
    FRowCount: Integer;
    FAlignment: TAlignment;
    procedure SetLines(const Value: TStringList);
    procedure SetFont(const Value: TFont);
    procedure SetAlignment(const Value: TAlignment);
    { Private-Deklarationen }
  protected
    procedure Paint; override;
    { Protected-Deklarationen }
  public
    constructor Create(AOwner : TComponent); override;
    destructor destroy; override;
    { Public-Deklarationen }
  published
    property Lines : TStringList read FLines write SetLines;
    property Font : TFont read FFont write SetFont;
    property RowCount : Integer read FRowCount;
    property Alignment : TAlignment read FAlignment write SetAlignment;
    { Published-Deklarationen }
  end;

procedure Register;

implementation

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

{ TStatusScroll }

constructor TStatusScroll.Create(AOwner: TComponent);
begin
  inherited;
  FFont := TFont.Create;
  FLines := TStringList.Create;
end;

destructor TStatusScroll.destroy;
begin
  FreeAndNil(FFont);
  FreeAndNIL(FLines);
  inherited;
end;

procedure TStatusScroll.Paint;
var FTextHeight, FTextWidth, t : integer;
    bmp : TBitmap;
begin
  inherited;
  with canvas do begin
    Brush.Style:=BSClear;
    Font.Assign(FFont);
    Pen.Color:=Font.Color;
    FTextHeight := TextHeight('Ü,');
    FRowCount := trunc( height / ( FTextHeight + 4) );
    For t:= 0 to FRowCount-1 do begin
      if ( t <= Flines.Count -1 ) then begin
        FTextwidth := TextWidth(Flines.strings[t]);
        case FAlignment of
          taLeftJustify:  TextOut(2,( t * ( FTextHeight + 4 ) + 2 ),Flines.Strings[t]);
          taRightJustify: TextOut(width - FTextwidth -2,( t * ( FTextHeight + 4 ) + 2 ),Flines.Strings[t]);
          taCenter:       TextOut(trunc ( (width - FTextwidth -4) /2 ),( t * ( FTextHeight + 4 ) + 2 ),Flines.Strings[t]);
        end;
      end;
    end;
  end;
end;

procedure TStatusScroll.SetAlignment(const Value: TAlignment);
begin
  FAlignment := Value;
  Paint;
end;

procedure TStatusScroll.SetFont(const Value: TFont);
begin
  FFont.Assign(Value);
  Paint;
end;

procedure TStatusScroll.SetLines(const Value: TStringList);
begin
  FLines.Assign(Value);
  Paint;
end;

end.

Das Problem was ich habe, ist das Ändern der Font-Einstellungen.

Ich sehe die Änderungen erst, wenn ich einmal das Formular mit einem anderem Fenster überdeckt habe.

Wo ist mein Fehler ?

[sakura]

Nutze mal anstatt des Paint den Aufruf zu Invalidate bzw. Refresh. Ich hoffe, daß dieses hilft. Die werden, im Vergleich zu Paint über Windows-Botschaften verarbeitet und nicht direkt ausgeführt.

......

[Nightshade]

Hab schon Paint, Repaint, refresh, invalidate, update ausprobiert.

Leider keine Änderung...

[sakura]

Dann versuche doch mal folgende Zeile zu ändern... eigentlich sollte das nicht das Problem sein, aber man weiß ja nie

Code:

procedure TStatusScroll.Paint;
var FTextHeight, FTextWidth, t : integer;
    bmp : TBitmap;
begin
  inherited;
  with canvas do begin
    Brush.Style:=BSClear;
    [color=#ff0000][b]Canvas.[/b]Font.Assign([b]Self.[/b]FFont);[/color]
    Pen.Color:=Font.Color;
    FTextHeight := TextHeight('Ü,');
    FRowCount := trunc( height / ( FTextHeight + 4) );
    For t:= 0 to FRowCount-1 do begin
      if ( t <= Flines.Count -1 ) then begin
        FTextwidth := TextWidth(Flines.strings[t]);
        case FAlignment of
          taLeftJustify:  TextOut(2,( t * ( FTextHeight + 4 ) + 2 ),Flines.Strings[t]);
          taRightJustify: TextOut(width - FTextwidth -2,( t * ( FTextHeight + 4 ) + 2 ),Flines.Strings[t]);
          taCenter:       TextOut(trunc ( (width - FTextwidth -4) /2 ),( t * ( FTextHeight + 4 ) + 2 ),Flines.Strings[t]);
        end;
      end;
    end;
  end;
end;

......

[Nightshade]

Zitat von sakura:

Dann versuche doch mal folgende Zeile zu ändern... eigentlich sollte das nicht das Problem sein, aber man weiß ja nie

Ne, Leider auch kein Erfolg.

Gruß Nightshade

[Nightshade]

Hat denn keiner ne Idee ??

Gruß Nightshade....

[Leuselator]

Ideen:
1. Versuch mal 'ne Abfrage, nach dem Assign, um zu schauen, welcher Font tatsächlich gesetzt wird.
2. Probier mal den Canvas zu locken (Canvas.Lock siehe OH)
3. Projektoptionen-Hostapplication=Delphi.exe und dann Breakpoints setzen, um zu sehen, ob nach Deinem Paint noch wer auf Deiner Kompo rummalt.

Gruß

[Rumpi]

Hi

Delphi-Quellcode:

 TStatusScroll = class(TGraphicControl) 
 private
  ... 
  procedure CMFontChanged(var Message: TMessage); message CM_FONTCHANGED;


procedure TStatusScroll.CMFontChanged(var Message: TMessage);
begin
  inherited;
  Invalidate;
end;

versuchs mal...


mfg Rumpu

[Rumpi]

Das geht,

habs ausprobiert.
Du musst auch mit invalidate anstelle von paint arbeiten.

Delphi-Quellcode:

unit StatusScroll;

interface 

uses
  SysUtils, Classes, Controls, Graphics, Messages;

type
  TStatusScroll = class(TGraphicControl) 
  private
    { Private-Deklarationen }
    FLines: TStringList;
    FRowCount: Integer;
    FAlignment: TAlignment; 
    procedure SetLines(const Value: TStringList); 
    procedure SetAlignment(const Value: TAlignment);
    procedure CMFontChanged(var Message: TMessage); message CM_FONTCHANGED;
  protected
    { Protected-Deklarationen }
        procedure Paint; override;
  public
    { Public-Deklarationen }
    constructor Create(AOwner : TComponent); override; 
    destructor destroy; override; 

  published
   { Published-Deklarationen }
    property Lines : TStringList read FLines write SetLines; 
    property RowCount : Integer read FRowCount;
    property Alignment : TAlignment read FAlignment write SetAlignment; 
    property Font;
  end; 

procedure Register; 

implementation 

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

{ TStatusScroll } 

constructor TStatusScroll.Create(AOwner: TComponent); 
begin 
  inherited;
  FLines := TStringList.Create;
end;

destructor TStatusScroll.destroy;
begin
  FreeAndNIL(FLines);
  inherited; 
end;

procedure TStatusScroll.Paint; 
var FTextHeight, FTextWidth, t : integer; 
    bmp : TBitmap; 
begin 
  inherited; 
  with canvas do
  begin
    Font.Assign( Self.Font );
    Brush.Style := BSClear;
    Pen.Color   := Font.Color;
    FTextHeight := TextHeight('Ü,');
    FRowCount := trunc( height / ( FTextHeight + 4) );
    For t:= 0 to FRowCount-1 do
    begin
      if ( t <= Flines.Count -1 ) then
      begin
        FTextwidth := TextWidth(Flines.strings[t]);
        case FAlignment of
          taLeftJustify:  TextOut(2,( t * ( FTextHeight + 4 ) + 2 ),Flines.Strings[t]);
          taRightJustify: TextOut(width - FTextwidth -2,( t * ( FTextHeight + 4 ) + 2 ),Flines.Strings[t]);
          taCenter:       TextOut(trunc ( (width - FTextwidth -4) /2 ),( t * ( FTextHeight + 4 ) + 2 ),Flines.Strings[t]);
        end;
      end;
    end;
  end;
end;

procedure TStatusScroll.SetAlignment(const Value: TAlignment);
begin
  if FAlignment <> Value then
  begin
    FAlignment := Value;
    Invalidate; // Paint;
  end;
end;

procedure TStatusScroll.SetLines(const Value: TStringList);
begin
  FLines.Assign(Value);
  Invalidate; // Paint;
end;

procedure TStatusScroll.CMFontChanged(var Message: TMessage);
begin
  inherited;
  Invalidate;
end;

end.

mfg Rumpi

[Nightshade]

Jau geht,

hab Font redeklariert, deswegen gings nicht....

Danke..

Nightshade