Bitmapgröße an Textgröße anpassen?

[Karstadt]

hallo. so gehe ich vor:

Delphi-Quellcode:

  with Bild do
  begin
    Bild := TBitmap.create;

    Height := 50; //
    Width := 50; //

    transparentcolor := clWhite;
    transparent := true;

    canvas.TextOut(0,0,edt_text.Text);
  end;

wie kann ich die Heigth und die Width an die Text grösse anpassen? so, das das bild nicht größer ist, als der text selber..

[Neutral General]

Canvas.TextHeight, Canvas.TextWidth ist das was du suchst ;)


Z.B

Delphi-Quellcode:

with Bild do
  begin
    Bild := TBitmap.create;

    Canvas.Font := edt_text.Font;
    Height := Canvas.TextHeight('Dein Text');
    Width := Canvas.TextHeight('Dein Text');

    transparentcolor := clWhite;
    transparent := true;

    canvas.TextOut(0,0,edt_text.Text);
  end;

Gruß
Neutral General

[Karstadt]

:-D :-D :-D

[Neutral General]

Soll das heißen: "Thx es hat geklappt!" ? :mrgreen:

[Hawkeye219]

Noch eine Anmerkung: du solltest den Aufruf des Konstrukturs vor der WITH-Anweisung durchführen. Auch wenn es mit einfachen Variablen offenbar funktioniert, spätestens beim Einsatz strukturierter Variablen wirst du mit ziemlicher Sicherheit eine AV provozieren:

Delphi-Quellcode:

with Bild[Index] do
  begin
    Bild[Index] := TBitmap.Create;
    Width := 50;  // <<--- hier wird eine AV auftreten!

Gruß Hawkeye

[Karstadt]

Ja.. super..

...nun ist die Frage, wie mache ich das. wenn dieser text in MEMO eingegeben wird und es wird mit entertaste gearbeitet...

[Neutral General]

du machst für jede zeile ein Bitmap.
Am besten so etwa:

Delphi-Quellcode:

var Bmps: Array of TBitmap;

procedure Ka;
begin
  SetLength(Bmps,Memo1.Lines.Count);
  for i:= 0 to Memo1.Lines.Count-1 do begin
   Bmps[i] := TBitmap.Create;
   with Bmps[i] do begin
    Canvas.Font := Memo1.Font;
    Height := Canvas.TextHeight(Memo1.Lines[i]);
    Width := Canvas.TextHeight(Memo1.Lines[i]);

    transparentcolor := clWhite;
    transparent := true;

   // canvas.TextOut(0,0,edt_text.Text); ka irgenwo halt wieder malen
   end;
  end;
end;

Gruß
Neutral General

[Karstadt]

Delphi-Quellcode:

  Bild := TBitmap.create;

  with Bild do
  begin
    Canvas.Font := edt_text.Font;
    Height := Canvas.TextHeight(edt_text.Text)*edt_text.Lines.Count;
    Width := Canvas.TextWidth(edt_text.Text);
    transparentcolor := clWhite;
    transparent := true;
    for i:= 0 to edt_text.Lines.Count-1 do
    begin
     canvas.TextOut(0,Canvas.TextHeight(edt_text.Text)*i,edt_text.Lines.Strings[i]);
    end;
  end;

die BREITE des bildes wird doch gewaltig sein wenn es 100 zeilensind.. oder?

[Karstadt]

mein fall ist auch richig oder?

am ende soll das ein einziges bild sein ;)

[Neutral General]

Ja ka probiers doch aus.. Lass es laufen und guck ob das passiert was passieren soll ;)
Moment ich programmiere das auch mal..

[Karstadt]

Delphi-Quellcode:

var
  Bild: TBitmap;
  i,i2: Integer;
  breite: Integer;
begin

  breite := 0;

  for i:= 0 to edt_text.Lines.Count-1 do
  begin
    If Length(edt_text.Lines.Strings[i]) > breite Then
    begin
      i2 := i;
      breite := Length(edt_text.Lines.Strings[i]);
    end;
  end;

  Bild := TBitmap.create;

  with Bild do
  begin
    Canvas.Font := edt_text.Font;
    Bild.Height := Canvas.TextHeight(edt_text.Text)*edt_text.Lines.Count;
    Bild.Width := Canvas.TextWidth(edt_text.Lines.Strings[i2]);
    transparentcolor := clWhite;
    transparent := true;
    for i:= 0 to edt_text.Lines.Count-1 do
    begin
     canvas.TextOut(0,Canvas.TextHeight(edt_text.Text)*i,edt_text.Lines.Strings[i]);
    end;
  end;

  Bild_img.Picture.Bitmap := Bild;

  Bild.Free;

Nun habe ich das :) :) :)

[Neutral General]

Ja die Funktion mit der du die Breite ausrechnest ist zwar nötig aber nicht gut genug eigentlich.. Weil z.B was passiert wenn im Memo z.B vier Punkte in der ersten Reihe sind und drei 'W's in der zweiten?

Du musst da auch mit Canvas.TextWidth arbeiten.. Ich habs so probiert:

Delphi-Quellcode:

function GetLongesLineLength(AMemo: TMemo): Integer;
var i,temp: Integer;
    tempBmp: TBitmap;
begin
  temp := 0;

  tempBmp := TBitmap.Create;
  tempBmp.Canvas.Font := AMemo.Font;

  for i:= 0 to AMemo.Lines.Count-1 do begin
   if tempBmp.Canvas.TextWidth(AMemo.Lines[i]) > temp then
    Temp := tempBmp.Canvas.TextWidth(AMemo.Lines[i]);
  end;
  TempBmp.Free;
  Result := Temp;
end;

So müsste es besser gehn ;)

Das ganze sieht dann bei mir so aus:

Delphi-Quellcode:

procedure TForm1.Button1Click(Sender: TObject);
var B: TBitmap;
    i: Integer;
begin
  B := TBitmap.Create;
  with B do begin
   Canvas.Font := Memo1.Font;
   Height := Canvas.TextHeight(Memo1.Lines[0]) * Memo1.Lines.Count;
   Width := GetLongesLineLength(Memo1);
   for i:= 0 to Memo1.Lines.Count-1 do begin
    Canvas.TextOut(0,i*Canvas.TextHeight(Memo1.Lines[0]),Memo1.Lines[i]);
   end;
  end;
  Canvas.Draw(0,0,B);
  B.Free;
end;

Gruß
Neutral General

[Karstadt]

Zitat:

Ja die Funktion mit der du die Breite ausrechnest ist zwar nötig aber nicht gut genug eigentlich.. Weil z.B was passiert wenn im Memo z.B vier Punkte in der ersten Reihe sind und drei 'W's in der zweiten?

das kommt mit 99,99% wahrscheinlichkeit nicht vor... ;)

[Karstadt]

ich nehme deine lösung.. dankeschön :)

[Karstadt]

würde das aucht mit RTF funktioineren?
Mit Tab Taste :)....aber, das kommt später.

[Neutral General]

1. Ja aber mit der Textfarbe und so würde es dann halt komplizierter werden
2. Guck ma da oben rechts an deinem Beitrag ist ein Edit Button http://www.delphipraxis.net/template.../icon_edit.gif ;)

[Hawkeye219]

Hallo Karstadt,

hier ist eine andere Lösung:

Delphi-Quellcode:

procedure GetTextImage (aText: string;  var aBitmap: TBitmap);
var
  R : TRect;
begin
  with aBitmap.Canvas do
    begin
      SetRect(R, 0, 0, MaxInt, MaxInt);
      DrawText(Handle, PChar(aText), Length(aText), R, DT_CALCRECT);
      aBitmap.Width := R.Right - R.Left;
      aBitmap.Height := R.Bottom - R.Top;
      OffsetRect(R, -R.Left, -R.Top);
      DrawText(Handle, PChar(aText), Length(aText), R, 0);
    end;
end;

Die Routine kannst du folgendermaßen nutzen:

Delphi-Quellcode:

procedure Form1.Button1Click (Sender: TObject);
var
  BMP : TBitmap;
begin
  BMP := TBitmap.Create;
  try
    BMP.Canvas.Font.Assign (RichEdit1.Font);
    GetTextImage (RichEdit1.Text, BMP);
    Self.Canvas.Draw (0, 0, BMP);
  finally
    BMP.Free;
  end;
end;

Gruß Hawkeye

[Karstadt]

Zitat:

Zitat von Hawkeye219

Hallo Karstadt,

hier ist eine andere Lösung:

Delphi-Quellcode:

procedure GetTextImage (aText: string;  var aBitmap: TBitmap);
var
  R : TRect;
begin
  with aBitmap.Canvas do
    begin
      SetRect(R, 0, 0, MaxInt, MaxInt);
      DrawText(Handle, PChar(aText), Length(aText), R, DT_CALCRECT);
      aBitmap.Width := R.Right - R.Left;
      aBitmap.Height := R.Bottom - R.Top;
      OffsetRect(R, -R.Left, -R.Top);
      DrawText(Handle, PChar(aText), Length(aText), R, 0);
    end;
end;

Die Routine kannst du folgendermaßen nutzen:

Delphi-Quellcode:

procedure Form1.Button1Click (Sender: TObject);
var
  BMP : TBitmap;
begin
  BMP := TBitmap.Create;
  try
    BMP.Canvas.Font.Assign (RichEdit1.Font);
    GetTextImage (RichEdit1.Text, BMP);
    Self.Canvas.Draw (0, 0, BMP);
  finally
    BMP.Free;
  end;
end;

Gruß Hawkeye

irgendwie funktioniert das bei mir nicht. (RTF Formatierung wird nicht angezeigt)

[Hawkeye219]

Hallo Karstadt,

Zitat:

Zitat von Karstadt

irgendwie funktioniert das bei mir nicht. (RTF Formatierung wird nicht angezeigt)

Falls du mit "RTF Formatierung" verschiedene Farben und Zeichenattribute meinst, die werden von keiner der hier vorgestellten Lösungen unterstützt. Alle Codes arbeiten nur mit dem reinen Text - ohne Formatierung.

Gruß Hawkeye

[Karstadt]

das mit RFT ist schade.. nun ist das problem.. , das ich mit TAB Tasten arbeiten will. das funktioniert abernicht. dort wird immer ein "anderes" Zeichen dartegestllt. Gibt es hier für auch eine lösung?

MFG

[Karstadt]

Hallo. Ich habe nun ein weiteres Problem... dieser Text soll auf ein JPG bild unten untergebracht werden... das habe ich auch geschaft... nun aber!

Wenn die Auflösung des Bilder bei ca. 2 MP liegt, dann ist dieser Text nicht zusehen.... ich muss also die schriftgröße vergrößern... wie mache ich das? wie finde ich heraus, welche schriftgröße ich nehmen soll wenn das bild die 2 MP auflösung hat?

[H4ndy]

Zitat:

Zitat von Karstadt

Hallo. Ich habe nun ein weiteres Problem... dieser Text soll auf ein JPG bild unten untergebracht werden... das habe ich auch geschaft... nun aber!

Wenn die Auflösung des Bilder bei ca. 2 MP liegt, dann ist dieser Text nicht zusehen.... ich muss also die schriftgröße vergrößern... wie mache ich das? wie finde ich heraus, welche schriftgröße ich nehmen soll wenn das bild die 2 MP auflösung hat?

Eigentlich bei neuer Frage = neuer Tread.
Aber da ich kein Unmensch bin ;)

Delphi-Quellcode:

bmp.Canvas.Font.Size := 75;

[Karstadt]

..gut! :) ich muss es selber ausprobieren, welche schriftgröße beim welches Bild genommen werden muss ;) dann auf gehts :)

ps: ich wusste wo man das ändert, ich weis aber nicht welche FORMEL man am besten anwendet, um die Schriftgröße zu errechnen... das muss ich ausprobieren ;)