Benötige Hilfe beim Entwickeln einer Komponente

[oki]

Du musst im constructor auch eine Instanz von Picture erstellen (Create).
Die Prüfung auf nil ist zwar o.k. imho aber etwas unsicher ohne Initialisierung (jetzt werden gleich wieder alle schreien, dass Delphi das beim Start min nil übernimmt ....). Egal, füge im Construktor ein create für FPicture (im Destructor FreeAndNil) ein und teste weiter.

Gruß oki

[torud]

Hm das kann es nicht sein, behaupte ich mal so, da ich nach dem Kompilieren der Komponente und dem Öffnen des Testprojektes direkt beim Anklicken der Komponente einen abstrakten Fehler erhalte.

Delphi-Quellcode:

private
    FPicture:TGraphic;

constructor TmyPanel.Create(AOwner: TComponent);
begin
  FPicture := TGraphic.Create;
  inherited Create(AOwner);
  Align       := alNone;
  BgColorFrom := clWhite;
  BgColorTo   := clSilver;
  BorderColor := clGray;
  BorderStyle := psSolid;
  BorderWidth := 2;
end;

destructor TmyPanel.Destroy;
begin
  inherited;
  FPicture.Free;
end;

Meldungen vom Compiler:
[Warnung] myPanel.pas(89): Instanz von 'TGraphic' mit der abstrakten Methode 'TGraphic.LoadFromStream' wird angelegt
[Warnung] myPanel.pas(89): Instanz von 'TGraphic' mit der abstrakten Methode 'TGraphic.SaveToStream' wird angelegt
[Warnung] myPanel.pas(89): Instanz von 'TGraphic' mit der abstrakten Methode 'TGraphic.LoadFromClipboardFormat' wird angelegt
[Warnung] myPanel.pas(89): Instanz von 'TGraphic' mit der abstrakten Methode 'TGraphic.SaveToClipboardFormat' wird angelegt

[DeddyH]

Andersherum:

Delphi-Quellcode:

destructor TmyPanel.Destroy;
begin
  FPicture.Free;
  inherited;
end;

//Edit: Das hat nichts mit den Warnungen zu tun, ich wollte nur darauf hinweisen. Leg die Grafik mal als Bitmap an, dann sollten die Warnungen verschwinden.

[torud]

Also das kanns eigentlich nicht sein, denn das Problem ist weiterhin das GLEICHE.

[DeddyH]

Die monierten Methoden sind in TGraphic als abstrakt deklariert und werden in abgeleiteten Klassen überschrieben.

[torud]

Kurzer Satz und dennoch zu viel input für mich. Was bedeutet das jetzt?

[DeddyH]

As I said: Ändere im Konstruktor mal die Zeile

Delphi-Quellcode:

FPicture := TGraphic.Create;

in

Delphi-Quellcode:

FPicture := TBitmap.Create;

[Hawkeye219]

Hallo Tom,

versuche es einmal so:

Delphi-Quellcode:

type
  TmyPanel = class (TCustomControl)
  private
    FPicture : TPicture;
    procedure PictureChanged (Sender: TObject);
    procedure SetPicture (aValue: TPicture);
  public
    constructor Create (aOwner: TComponent);  override;
    destructor Destroy;  override;
  published
    property Picture: TPicture read FPicture write SetPicture;
  end;


constructor TmyPanel.Create (aOwner: TComponent);
begin
  inherited;
  FPicture := TPicture.Create;
  FPicture.OnChange := PictureChanged;
end;

destructor TmyPanel.Destroy;
begin
  FPicture.Free;
  inherited;
end;

procedure TmyPanel.PictureChanged (Sender: TObject);
begin
  Invalidate;
end;

procedure TmyPanel.SetPicture (aValue: TPicture);
begin
  FPicture.Assign (aValue);  // KEINE Zuweisung, sondern Assign!
end;

Der Code ist nicht getestet, aber so ungefähr sollte es funktionieren.

Gruß Hawkeye

[torud]

Hallo Hawkeye,

genauso gehts!!!

[torud]

Hier nun nochmals mein vorläufiges Feedback zur erstellten Komponente.

Ich kann mit der komponente fast das tun, was ich wollte. Ein Bild laden, optional einen Gradienten drauf zeichen oder nur eine Hintergrundfarbe anzeigen lassen, einen Text draufschreiben und einen Rahmen mit eigener Farbe darstellen.

Nun zu den Punkten, die mich noch umtreiben.

1. Wenn ich den Rahmen mit einem 1 Pixel Stärke angeben, sind die Linien links und oben ok. Rechts und unten ist keine sichtbar. Gebe ich eine Rahmenstärke von 9 ein, habe ich links und oben 5 und rechts und unten nur 4. hier stimmt was nicht...Nur was?

2. Eigentlich wollte ich auch RoundedCorners haben, aber da fehlt mir leider der Mathematische Hintergrund (schon 20 Jahre aus der Schule) und die Programmierkenntnisse lassen auch zu wünschen übrig, denn ich lerne das alles nur aus diesem Forum und diversen Büchern nebenbei. Immerhin habe ich schon mal eine eigene Kompoente erstellt. Hoch die tassen! Aber die gerundeten Ecken sind einfach zu viel für mich und konnte auch im www nichts dazu finden.

3. Ich habe zwar etwas mit den Codes und den Hinweisen gespielt, aber ich habe es leider nicht hinbekomme, den Text so ausrichten zu lassen, dass ich es angeben kann. Vielleicht gibts da noch den ein oder anderen WINK?

Vielleicht hat der ein oder andere von Euch wieder einen hilfreichen Tipp für mich oder Codeschnipsel oder nen Link?

Hier nochmal der aktuelle Code der Kompo:

Delphi-Quellcode:

unit myPanel;

interface

uses
  Windows, Messages, SysUtils, Classes, Controls, Graphics;

type
  TbdStyle     = (bdNone, bdSolid, bdDashed, bdClear, bdDotted);
  TGradientOrientation = (goVertical, goHorizontal);

type
  TPixelRec = packed record
    case Boolean of
      true:  (Color: TColor);
      false: (r, g, b, Reserved: Byte);
  end;

type
  TmyPanel = class(TCustomControl)

  private
    FBgColorFrom : TColor;
    FBgColorTo : TColor;
    FPaintGradient : Boolean;
    FGradientDirection : TGradientOrientation;
    FBorderColor:TColor;
    FBorderStyle:TPenStyle;
    FBorderWidth:integer;
    FRoundEdges:boolean;
    FCornerWidth:integer;
    FText:String;
    FTextAlign:TAlignment;
    FPicture:TPicture;
    FTextWordwrap:Boolean;
    FTextVCenter:Boolean;
    procedure SetBgColorFrom(Value : TColor);
    procedure SetBgColorTo(Value : TColor);
    procedure SetGradientStatus(Value: Boolean);
    procedure SetBorderWidth(Value: integer);
    procedure SetBorderColor(Value : TColor);
    //procedure SetPicture(Pic : TPicture);
    procedure PictureChanged (Sender: TObject);
    procedure SetPicture (aValue: TPicture);
    procedure SetText(Content : String);
    procedure SetTextAlign(Alignment : TAlignment);
    procedure SetGradientDirection(Direction:TGradientOrientation);
    procedure SetTextWordwrap(WrapIt:Boolean);
    procedure SetTextVCenter(VCenter:Boolean);

    { Private-Deklarationen }
  protected
  { Protected-Deklarationen }
    procedure Paint; override;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    { Public-Deklarationen }

  published
    property Align;
    property BgColorFrom : TColor   read FBgColorFrom   write SetBgColorFrom;
    property BgColorTo : TColor   read FBgColorTo   write SetBgColorTo;
    property PaintGradient : boolean  read FPaintGradient   write SetGradientStatus;
    property GradientDirection : TGradientOrientation read FGradientDirection   write SetGradientDirection;
    property BorderColor : TColor  read FBorderColor   write SetBorderColor;
    property BorderStyle : TPenStyle read FBorderStyle   write FBorderStyle;
    property BorderWidth : integer read FBorderWidth   write SetBorderWidth;
    property RoundEdges : boolean  read FRoundEdges   write FRoundEdges;
    property CornerWidth : integer read FCornerWidth   write FCornerWidth;
    //property Picture : TGraphic read FPicture   write SetPicture;
    property Text : String read FText   write SetText;
    property TextAlign : TAlignment read FTextAlign   write SetTextAlign;
    property TextWordwrap : Boolean read FTextWordwrap   write SetTextWordwrap;
    property TextVCenter : Boolean read FTextVCenter   write SetTextVCenter;
    property Picture: TPicture read FPicture write SetPicture;
    { Published-Deklarationen }

  end;

procedure Register;

implementation

procedure Register;
begin
  RegisterComponents('Standard', [TmyPanel]);
end;

constructor TmyPanel.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FPicture := TPicture.Create;
  FPicture.OnChange := PictureChanged;
  Align       := alNone;
  BgColorFrom := clWhite;
  BgColorTo   := clSilver;
  BorderColor := clGray;
  BorderStyle := psSolid;
  BorderWidth := 2;
end;

destructor TmyPanel.Destroy;
begin
  FPicture.Free;
  inherited;
end;

procedure TmyPanel.PictureChanged (Sender: TObject);
begin
  Invalidate;
end;

procedure TmyPanel.SetPicture (aValue: TPicture);
begin
  FPicture.Assign (aValue);  // KEINE Zuweisung, sondern Assign!
end;

procedure TmyPanel.SetTextWordwrap(WrapIt:Boolean);
begin
  If WrapIt = FTextWordwrap then Exit;  // wenn gleicher Status nichts tun
  FTextWordwrap := WrapIt;              // Status abspeichern
  Invalidate;                           // Control neu zeichnen
end;

procedure TmyPanel.SetTextVCenter(VCenter:Boolean);
begin
  If VCenter = FTextVCenter then Exit;  // wenn gleicher Status nichts tun
  FTextVCenter := VCenter;              // Status abspeichern
  Invalidate;                           // Control neu zeichnen
end;

{procedure TmyPanel.SetPicture(Pic : TGraphic);
begin
  If Pic = FPicture then Exit;  // wenn gleicher Status nichts tun
  FPicture := Pic;              // Status abspeichern
  Invalidate;                   // Control neu zeichnen
end;}

procedure TmyPanel.SetGradientStatus(Value:Boolean);
begin
  If Value = FPaintGradient then Exit;  // wenn gleicher Status nichts tun
  FPaintGradient := Value;              // Status abspeichern
  Invalidate;                           // Control neu zeichnen
end;

procedure TmyPanel.SetGradientDirection(Direction:TGradientOrientation);
begin
  If Direction = FGradientDirection then Exit;  // wenn gleicher Status nichts tun
  FGradientDirection := Direction;              // Status abspeichern
  Invalidate;                           // Control neu zeichnen
end;

procedure TmyPanel.SetBorderWidth(Value:integer);
begin
  If Value = FBorderWidth then Exit;  // wenn gleicher Status nichts tun
  FBorderWidth := Value;              // Status abspeichern
  Invalidate;                           // Control neu zeichnen
end;

procedure TmyPanel.SetBorderColor(Value : TColor);  // Settermethode
begin
  If Value = FBorderColor then Exit;  // wenn gleiche Farbe nichts tun
  FBorderColor := Value;              // Farbe abspeichern
  Invalidate;                         // Control neu zeichnen
end;

procedure TmyPanel.SetBgColorFrom(Value : TColor);  // Settermethode
begin
  If Value = FBgColorFrom then Exit;  // wenn gleiche Farbe nichts tun
  FBgColorFrom := Value;              // Farbe abspeichern
  Invalidate;                         // Control neu zeichnen
end;

procedure TmyPanel.SetBgColorTo(Value : TColor);
begin
  If Value = FBgColorTo then Exit;
  FBgColorTo := Value;
  Invalidate;
end;

procedure TmyPanel.SetText(Content : String);  // Settermethode
begin
  If Content = FText then Exit;  // wenn gleicher Inhalt nichts tun
  FText := Content;              // Inhalt abspeichern
  Invalidate;                    // Control neu zeichnen
end;

procedure TmyPanel.SetTextAlign(Alignment : TAlignment);  // Settermethode
begin
  If Alignment = FTextAlign then Exit;  // wenn gleicher Inhalt nichts tun
  FTextAlign := Alignment;              // Inhalt abspeichern
  Invalidate;                           // Control neu zeichnen
end;

procedure DrawGradient(const Canvas: TCanvas; Color1, Color2: TColor;
                       ARect: TRect; GradientOrientation: TGradientOrientation);
var
  c1, c2, c: TPixelRec;  //for easy access to RGB values as well as TColor value
  x, y: Integer;         //current pixel position to be set
  OldPenWidth: Integer;  //Save old settings to restore them properly
  OldPenStyle: TPenStyle;//see above
begin
  c1.Color := ColorToRGB(Color1);  //convert system colors to RGB values
  c2.Color := ColorToRGB(Color2);  //if neccessary
  OldPenWidth := Canvas.Pen.Width; //get old settings
  OldPenStyle := Canvas.Pen.Style;
  Canvas.Pen.Width:=1;             //ensure correct pen settings
  Canvas.Pen.Style:=psInsideFrame;

  case GradientOrientation of 
    goVertical: 
    begin 
      for y := 0 to ARect.Bottom - ARect.Top do
      begin 
        c.r := Round(c1.r + (c2.r - c1.r) * y / (ARect.Bottom - ARect.Top)); 
        c.g := Round(c1.g + (c2.g - c1.g) * y / (ARect.Bottom - ARect.Top)); 
        c.b := Round(c1.b + (c2.b - c1.b) * y / (ARect.Bottom - ARect.Top)); 
        Canvas.Brush.Color := c.Color; 
        Canvas.FillRect(Classes.Rect(ARect.Left, ARect.Top + y, 
                                     ARect.Right, ARect.Top + y + 1)); 
      end; 
    end; 
    goHorizontal: 
    begin 
      for x := 0 to ARect.Right - ARect.Left do 
      begin 
        c.r := Round(c1.r + (c2.r - c1.r) * x / (ARect.Right - ARect.Left)); 
        c.g := Round(c1.g + (c2.g - c1.g) * x / (ARect.Right - ARect.Left)); 
        c.b := Round(c1.b + (c2.b - c1.b) * x / (ARect.Right - ARect.Left)); 
        Canvas.Brush.Color := c.Color; 
        Canvas.FillRect(Rect(ARect.Left + x, ARect.Top,
                             ARect.Left + x + 1, ARect.Bottom)); 
      end; 
    end; 
  end; 
  Canvas.Pen.Width := OldPenWidth; //restore old settings
  Canvas.Pen.Style := OldPenStyle;
end; 

procedure TmyPanel.Paint;
var
  myRect,TextRect : TRect;
begin
  myRect := GetClientRect;
    Canvas.FillRect(myRect);
    Canvas.Brush.Style := bsSolid;
    Canvas.Brush.Color := FBgColorFrom;

    Canvas.Pen.Mode    := pmCopy;
    Canvas.Pen.Style   := BorderStyle;
    Canvas.Pen.Width   := BorderWidth;
    Canvas.Pen.Color   := BorderColor;

    //zeichnen des gradients
    if PaintGradient then
      DrawGradient(Canvas, BgColorFrom, BgColorTo, myRect, GradientDirection);

    //zeichnen des bildes, wenn vorhanden
    if Picture <> nil then
      Canvas.StretchDraw(myRect,Picture.Graphic);

    //zeichnen des rahmens
    Canvas.MoveTo(0,0);
    Canvas.LineTo(myRect.Left,myRect.Bottom);
    Canvas.MoveTo(0,0);
    Canvas.LineTo(myRect.Right,myRect.Top);
    Canvas.MoveTo(self.Width,0);
    Canvas.LineTo(myRect.Right,myRect.Bottom);
    Canvas.MoveTo(0,self.Height); //links unten
    Canvas.LineTo(myRect.Right,myRect.Bottom);

    //schreiben des textes
    TextRect := Rect(BorderWidth, BorderWidth, self.Width-BorderWidth, self.Height-BorderWidth);
    SetBkMode(Canvas.Handle, TRANSPARENT);
    DrawText(self.Canvas.Handle, PChar(FText), -1, TextRect,
             DT_VCENTER or DT_VCENTER or DT_WORDBREAK);
end;

end.

[torud]

Einen Punkt meiner Wunsch und Problemliste kann ich nun doch schon FAST streichen. Und zwar gehts um den Border. Ich vermute mal, dass der Stift beim zeichnen zentriert aufgesetzt wird und habe aus dem Grund mal die X-Position um die Hälfte der BoderWidth verschoben und siehe da, wenn ich eine BorderWidth > 1 habe funzt das schon mal. Der Code, der nicht wirklich schön ist, sieht so aus - zumindest bei mir. Werde die Division vorher einmal erledigen und nicht jedesmal neu rechnen lassen und einen Klausel für die BorderWidth 1 einführen.

Delphi-Quellcode:

    //zeichnen des rahmens
    Canvas.MoveTo(0 + (BorderWidth div 2),0);  //links oben
    Canvas.LineTo(myRect.Left + (BorderWidth div 2),myRect.Bottom);

    Canvas.MoveTo(0,0 + (BorderWidth div 2));
    Canvas.LineTo(myRect.Right,myRect.Top + (BorderWidth div 2));

    Canvas.MoveTo(self.Width-(BorderWidth div 2),0);   //rechts unten
    Canvas.LineTo(myRect.Right-(BorderWidth div 2),myRect.Bottom);

    Canvas.MoveTo(0,self.Height-(BorderWidth div 2)); //links unten
    Canvas.LineTo(myRect.Right,myRect.Bottom-(BorderWidth div 2));

[oki]

Hi torud,

ich bin schon ziemlich k.o. für heute, aber zum Thema Textausrichtung kann ich noch mal was beisteuern. Du übergibst in DrawText als letzten Parameter die Ausrichtungsflags.
Somit definierst du dir eine Variable vom Typ UINT und setzt diese mit MyTextForm := ersteFlag or zweitesFlag or ...
Das mit übergeben, und das wars schon.

Gruß oki

[oki]

Nachtrag,

Rahmen mit Canvas.FrameRect

Gruß

[torud]

Moin Moin Oki,

ich bin auch schon ziemlich groggy, aber hier mal mein aktueller Status.

Das mit dem Rahmen passt nun, auch wenn ich NOCH nicht mit FrameRect gemacht habe. Kommt noch.

Dann habe ich mich mal an die Ausrichtung gewagt und siehe da, es gibt einen teilweisen Erfolg.

Folgenden Code habe ich benutzt, um die Ausrichtung zur vollziehen. Dabei hatte ich dass Problem, dass ich eigentlich die bekannte Eigenschaft Layout benutzen wollte, wie sie beim TLabel zum Einsatz kommt, aber dazu war leider nichts in der Hilfe zu finden.

Delphi-Quellcode:

var
  ...
  myFirstAlignment,mySecondAlignment : Cardinal;

    //init
    myFirstAlignment := DT_CENTER;
    mySecondAlignment:= DT_VCENTER;
    
    case TextAlign of
      taCenter       : myFirstAlignment := DT_CENTER;
      taLeftJustify  : myFirstAlignment := DT_LEFT;
      taRightJustify : myFirstAlignment := DT_RIGHT;
    end; //bis hierher ist alles super

    case Layout of
      tlTop          : mySecondAlignment := DT_TOP;
      tlCenter       : mySecondAlignment := DT_VCENTER;
      tlBottom       : mySecondAlignment := DT_BOTTOM;
    end; //das hier funzt noch nicht

    DrawText(self.Canvas.Handle, PChar(FText), -1, TextRect,
             myFirstAlignment or mySecondAlignment or DT_WORDBREAK);

Folgenden Code benutze ich für das Layout:

Delphi-Quellcode:

type
  TLayout = (tlTop, tlCenter, tlBottom);

private
    FLayout:TLayout;
    procedure SetTextLayout(Layout : TLayout);
published
    property Layout : TLayout read FLayout   write SetTextLayout;

procedure TmyPanel.SetTextLayout(Layout:TLayout);
begin
  If Layout = FLayout then Exit;  // wenn gleicher Status nichts tun
  FLayout := Layout;              // Status abspeichern
  Invalidate;                     // Control neu zeichnen
end;

Findest Du da einen Fehler? Am liebsten wäre mir ja, wenn ich die originale Eigenschaft LAYOUT nutzen könnte, wie beim Alignment...

[oki]

Hi,

warum so kompliziert.

Delphi-Quellcode:

    case TextAlign of
      taCenter       : myAlignment := DT_CENTER;
      taLeftJustify  : myAlignment := DT_LEFT;
      taRightJustify : myAlignment := DT_RIGHT;
    end;

    case Layout of
      tlTop          : myAlignment := myAlignment or DT_TOP;
      tlCenter       : myAlignment := myAlignment or DT_VCENTER;
      tlBottom       : myAlignment := myAlignment or DT_BOTTOM;
    end;
    
    IF FWordWrap then myAlignment := MyAlignment or DT_WORDBREAK;

    DrawText(self.Canvas.Handle, PChar(FText), -1, TextRect, myAlignment);

und alles ist super.

Um mal kurz auf das Thema runde Ecken zu kommen. Wie es in echt gemacht wird ist mir auch nicht bekannt. Aber such mal CombineRGN und CreateRGN hier im Forum. Da wirst du was zu Transparenz und "Durchklickbar" finden. Ich denke zu zeichnes dann deinen Rahmen mit runden Ecken und kombinierst zwei Ranges miteinander. Einer ist begrenzt durch BoundsRect, der Zweite durch deinen Rahmen. Somit wird der äußere Bereich transparent und Durchklickbar.
guckst du hier hier

Gruß oki

[torud]

Danke für den Tipp und die Einkürzung des Codes. Die Zusammenstellung ist schon ok, aber leider habe ich immer noch das Problem, dass LAYOUT nicht funktioniert. Das war auch der Grund warum ich den Aufbau in meinem vorherigen Post darlegte.

Irgendwie scheint das was nicht zu stimmen...

Den Rest mit dem Border und Deinen weiteren Hinweisen zu den abgerundeten Ecken werde ich mir nach dem jetzt stattfindenden Wocheneinkauf anschauen.

EDIT
Habe mir FrameRect angesehen und werde es wohl meiden, da es fix einen Border von einem Pixel zeichnet. So wie ich es habe bin ich flexibel und könnte es sogar dahingehend aufboren, dass man jeder Seite seine eigene Rahmenbreite zuweisen kann.

[oki]

Moin torud,

Zitat:

Zitat von torud

Habe mir FrameRect angesehen und werde es wohl meiden, da es fix einen Border von einem Pixel zeichnet. So wie ich es habe bin ich flexibel und könnte es sogar dahingehend aufboren, dass man jeder Seite seine eigene Rahmenbreite zuweisen kann.

Klar!

Bei deinem Code mit dem Layout kann ich keinen Fehler finden. Da mußt du an anderer Stelle was falsch machen. Geh mal mit dem Debugger durch den Bereich mit TextDraw und dem Setzen der attribute und sag mal was passiert.

Gruß oki

[torud]

Sorry für die Dumme Frage, aber wenn ich in der Komponente F9 drücke und mir vorher einen Stopppunkt setze, funzt das leider nicht, dass ich mir das mit dem Debugger anschauen kann, da ihm wohl noch eine Host-Anwendung fehlt => ist doch meine erste Komponente. Ich weiss es nicht besser. Was muss ich tun?

[oki]

Hi,

kein Problem.
Eine Compo alleine kannst du nicht debuggen. Ist ja imho nur ne Unit (+Pakage). Du mußt dir eine kleine Testanwendung schreiben. einfach neue Anwendung und deine neue Compo auf der Form platzieren. Dann öffnest du deine Unit (der Compo), compilierst das Projekt und setzt den Brakepoint. Dann anwendung starten. Da dein Brakepoint in der Paint-methode steckt, wird er natürlich sofort angesprungen. Also am Besten Anwendung starten und dann Brakepoint setzen. immer wenn du deine Form in den Vordergrund bringst, schlägt der Debugger zu. Du kannst ja auch Variablen auswerten usw.

Wenn du weitere Fragen hast, keine Scham; her damit.

Gruß oki

[torud]

So ich habe es so gemacht, wie Du mir gesagt hast.

Folgendes habe ich dabei getan. Während der Debugger zugeschlagen hat, bin ich mit der Maus über die für mich eigentlich wichtigen Variablen gegangen und habe dabei folgende Daten zusammen getragen:

TextAlign = taCenter
daraus folgt, dass
myAlignment := 1 zugewiesen wird.

Layout = tlBottom
daraus folgt, dass zu
myAlignment DT_BOTTOM "addiert" wird, was am Ende eine 9 ergibt

In DrawText wird dann auch die 9 zugewiesen. Ich hoffe, dass ich alles richtig beschrieben habe. Also ist Layout auf jeden Fall schon mal belegt und es hat auch den richtigen Inhalt, den ich im OI zugewiesen habe. Wenn ich testweise man Layout auf tlCenter stellt ist myAlignment = 5. Das scheint stimmig zu sein...

Keine Ahnung was da nun falsch ist...!?

Ok, und da ich ja einen Text auf das Control schreibe, möchte ich natürlich auch den Font zuweisen können. Ich habe mir aus einem Tutorial alles zusammengesucht, was ich dafür brauche, aber die Zuweisung scheint nicht zu funzen. Kann man denn dem Canvas einen Font zuweisen?

Folgenden Code benutze ich für den Font bisher:

Delphi-Quellcode:

  private
    ...
    FFont: TFont;
  published
    property Font: TFont read FFont write FFont;

constructor TmyPanel.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FFont:=TFont.Create;
  ...

destructor TmyPanel.Destroy;
begin
  FFont.Free;
  ...

procedure TmyPanel.Paint;
begin
  ...
  Canvas.Font        := Font;

Habe ich da was wichtiges vergessen?

[DeddyH]

Versuch es mal mit

Delphi-Quellcode:

Canvas.Font.Assign(FFont);

[torud]

Oje da kommt es zu folgender Fehlermeldung:

Format '%p' ungültig oder nicht kompatibel mit Argument.

Probiert hatte ich das auch schon mit Assign(Font);

Nach der Fehlermeldung wird auch nichts mehr gezeichnet...Scheint was schlimmeres zu sein...

[DeddyH]

Hä? Hast Du eine Format-Anweisung irgendwo? :gruebel:

[torud]

Hier nochmal alles, was ich zum Thema Font in meiner Komponente drin habe:

Delphi-Quellcode:

private
    ...
    FFont: TFont;
  published
    property Font: TFont read FFont write FFont;

constructor TmyPanel.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FFont:=TFont.Create;
  ...

destructor TmyPanel.Destroy;
begin
  FFont.Free;
  ...

procedure TmyPanel.Paint;
begin
  ...
  Canvas.Font        := Font;

[DeddyH]

Delphi-Quellcode:

private
    ...
    FFont: TFont;
  published
    property Font: TFont read FFont write FFont;

constructor TmyPanel.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FFont:=TFont.Create;
  ...

destructor TmyPanel.Destroy;
begin
  FFont.Free;
  ...

procedure TmyPanel.Paint;
begin
  ...
  self.Canvas.Font.Assign(FFont);

So sollte es eigentlich gehen.

[oki]

Hallo torud,

du brauchst keinen eigenen Font creieren. TCanvas besitzt schon einen. Es ist nur so, dass der Font des Controls nicht der Font des Canvas ist (zwei seperate Fonts). Da reicht es aber, wenn du den Font des Controls dem Font des Canvas zuweist.

Delphi-Quellcode:

procedure TMyPanel.Paint;
begin
  Canvas.Font.assign(self.Font);
....

Alle Änderungen auf den Font des Controls (im OI) wirken sich dann automatisch auf den Canvas aus und werden somit beim DrawTest berücksichtigt.

Irgentwo war auch noch eine Methode FontChange oder so. in der ruft man inhereitet auf, damit das Control bei Änderung des Fonts neu gezeichnet wird.

Ob das jetzt mit deiner Textausrichtung geklappt hat, hab ich jetzt nicht so richtig verstanden.

Gruß oki

[oki]

Ich hab grad noch mal nachgeschaut, ich glaub das mit FontChange war Käse. Wenn du den Font des Controls änderst, wird glaub ich das Control automatisch neu gezeichnet.

Gruß oki

[torud]

:-D FAST!
Aber nur fast, denn wenn ich die Farbe oder die Schriftart ändere bekomme ich wieder ne böse Fehlermeldung.

Zugriffsverletzung bei Adresse 4000596E in Modul 'rtl60.bpl'. Lesen von Adresse 00000001.

Danach wird natürlich auch wieder nix mehr auf dem Canvas gezeichnet...

[torud]

Hm, kann ich jetzt also die Variablendeklaration FFont löschen oder was soll ich tun?

Habe gerade mal folgendes im OI getan.

Font aufgeklappt und dort dann alles einzeln geändert => Schriftart, Grösse, Farbe usw. Es hat sich nichts in der Kompo getan. Erst als ich ein Resize ausgelöst habe, wurde es neu gezeichnet und dann war alles schön - ohne Fehlermeldung.

Gehe ich aber den Weg über den FontDialog erhalte ich die Fehlermeldungen:

Format '%p' ungültig oder nicht kompatibel mit Argument.

und danach:
Kein Expandieren möglich

und danach:
Zugriffsverletzung bei Adresse 40005974 in Modul 'rtl60.bpl'. Lesen von Adresse FFFFFFDD.

[oki]

Hi,

wie gesagt, keinen eigenen Font creieren. Schmeiss deine Deklaration (property Font ...), FFont, Create und Free komplett raus.

gruß oki

[torud]

Blöde Frage, aber wie soll ich dann einen anderen Font wählen können? Per Code? Ich versuche mich...

[Alter Mann]

Hi torud

Kleines Beispiel für den Font(stammt aus dem Kalender - unter OpenSource).

Delphi-Quellcode:

  TCalendarControl = class(TCustomControl)
  private
    ...
    FFont         : TFont;
    ...
    procedure   SetFont(Value : TFont);
    ...
  public
    constructor Create(aOwner : TComponent);  override;
    destructor  Destroy;                      override;
    ...
  end;

...

implementation

...
constructor TCalendarControl.Create(aOwner : TComponent);
begin
  inherited Create(aOwner);
  ...
  FFont         := TFont.Create;
  FFont.Name    := 'Arial';
  FFont.Size    := 8;
  ...
end;

procedure   TCalendarControl.SetFont(Value : TFont);
begin
  if FFont <> Value then
  begin
    FFont.Assign(Value);
    Canvas.Font.Assign(Value);
    Invalidate;
  end;
end;

destructor  TCalendarControl.Destroy;
begin
  ...
  FFont.Free;
  inherited Destroy;
end;

und für den Rahmen:

Delphi-Quellcode:

...
procedure   TCalendarControl.Paint;
...
begin
  ...
    if FOptions.BorderStyle = bsSingle then
    begin
      Rectangle(R);
      InflateRect(R, -1, -1);
    end;
  ...
end;
...

Für Rectangle geht auch RoundRect.

Die Zuweisung Canvas.Font.Assign(Value) kann auch in Paint erfolgen, dann aber so Canvas.Font.Assign(FFont).

Gruß

[torud]

Da fehlt doch aber der Plublished-Abschnitt - Oder?

ich nehme mal an, dass das so aussehen sollte:

Delphi-Quellcode:

  published
    property Font: TFont read FFont write SetFont;

//edit
getestet => FUNZT SUPER!!!

Das mit dem Border muss ich mir auch noch ansehen, da mir das jetzt gar nix sagt...

[Alter Mann]

Böse Falle, habe ich doch glattweg übersehen.

Richtiger ist es so:

Delphi-Quellcode:

...
  public
    ...
    property Font : TFont read GetFont write SetFont;
    ...

function    TCalendarControl.GetFont : TFont;
begin
  Result := Canvas.Font;
end;

...

Aber wie schon geschrieben, Kalender-Kompo unter OpenSource in der DP.


Gruß

[torud]

Jo ich habe dort schon mal geschaut, aber wie Du selbst dort in Deinem letzten post schreibst, hast du den Source rausgenommen. Also nix zum schauen... :gruebel:

BTW: Ich habe die Veröffentlichung nicht in public stehen, sondern in published, da es anders nicht ging! Ansonsten ist es nun ok mit dem Font zumindest.

BTW2: Nun bräuchte ich nur noch etwas Unterstützung mit dem "Layout", da da die Vertikale Ausrichtung nicht funktioniert. Dies wird derzeit so gemacht. Horizontal läuft es, Vertikal nicht. Zeilenumbruch geht auch.

Delphi-Quellcode:

    case TextAlign of
      taCenter       : myAlignment := DT_CENTER;
      taLeftJustify  : myAlignment := DT_LEFT;
      taRightJustify : myAlignment := DT_RIGHT;
    end; //funzt

    case Layout of
      tlTop          : myAlignment := myAlignment or DT_TOP;
      tlCenter       : myAlignment := myAlignment or DT_VCENTER;
      tlBottom       : myAlignment := myAlignment or DT_BOTTOM;
    end; //funzt nicht

    IF FTextWordwrap then myAlignment := MyAlignment or DT_WORDBREAK; //funzt auch

    DrawText(self.Canvas.Handle, PChar(FText), -1, TextRect, myAlignment);

TextAlign, Layout und FTextWordwrap sind inhaltlich korrekt belegt. Leider werden aber die Angaben von Layout nicht berücksichtigt.

[Alter Mann]

Hi torud,

ich habe gerade kein D6Prof. auf meinem Rechner installiert, aber schau doch mal in der Hilfe (Windows SDK)
nach DrawText, dort steht:

Zitat:

DT_VCENTER Centers text vertically (single line only).

Dass heißt, wenn der Text vertikal Zentriert sein soll, darf kein DT_WORDBREAK enthalten sein.

Alles klar?

Gruß

[torud]

Ich will Dir nicht widersprechen, da ich einfach zu wenig Erfahrungen habe, aber wenn dem so wäre, müsste es ja funktionieren, wenn ich einen einfachen kurzen Text in die Komponente schreibe, WordWrap auf False stellt und im Layout tlCenter wähle. Dem ist aber nicht so...der Text bleibt stur tlTop...

Die SDK habe ich nicht zur Hand, werde aber mal googlen...

[DeddyH]

Delphi-Quellcode:

IF FTextWordwrap then myAlignment := MyAlignment or DT_WORDBREAK
else myAlignment := MyAlignment or DT_SINGLELINE;

[torud]

Gute Idee, aber es bleibt stur!

[oki]

Hi torud,

schau in der MSDN-Hilfe unter DrawText nach, da sind die Flags erläutert.

Zum Thema Font. Noch mal, keinen eigenen Font kreieren!!!!! :warn:

Da du dein Control von TCustomControl ableitest, sind die Eigenschaften wie Font usw. natürlich noch nicht published. also mußt du die Sichtbarkeit der Eigenschaft ändern.
Mach einfach folgendes:

Delphi-Quellcode:

published
  property Font;
....
end;

mit dieser Anweisung änderst du einfach die Sichtbarkeit einer Eigenschaft, ohne sie zu überschreiben. Dann ist sie auch im OI!

Gruß oki