Text auf Canvas ausgeben

Für Probleme bezüglich Grafik, Audio, GL, ACS, ...
Antworten
braunbär
Beiträge: 369
Registriert: Do 8. Jun 2017, 18:21
OS, Lazarus, FPC: Windows 10 64bit, Lazarus 2.0.10, FPC 3.2.0
CPU-Target: 64Bit
Wohnort: Wien

Text auf Canvas ausgeben

Beitrag von braunbär »

Theoretisch kein Problem, aber irgendwas mache ich falsch.

Code: Alles auswählen

      // Bild erzeugen
      with TImage.Create(self) do // wird beim Destroy der Form wieder freigegeben
        begin parent:=self;
          width:=PicWidth; height:=PicHeight;
          autosize:=false; proportional:=true;
          // wenn möglich Bild von der Festplatte laden
          pic := 'bilder\'+KNr+'.jpg';
          if fileexists(pic)
          then begin Picture.LoadFromFile(pic);
               if drehen then RotateBitmap(Picture.Bitmap);
               end
          else begin Picture.Clear;
               Picture.Bitmap.SetSize(PicWidth,PicHeight);
               end;
          // Namen unten ausgeben
          y:=Picture.Bitmap.Height-5-length(xname)*12;
          with Picture.Bitmap.Canvas do
              begin Font.Size:=8;
              Brush.Color:=clblack;
              Font.Color:=clwhite;
              for n in xname do begin TextOut(3,y,n); inc(y,12) end;
              end (* with Canvas *);
        end (* with TImage *);
Wenn kein Bild gefunden wird (else Zweig der Abfrage), dann wird der gewünschte Text richtig ausgegeben.
Aber wenn ein jpg gefunden und geladen wurde, wird kein Text eingeblendet.

Benutzeravatar
Winni
Beiträge: 1577
Registriert: Mo 2. Mär 2009, 16:45
OS, Lazarus, FPC: Laz2.2.2, fpc 3.2.2
CPU-Target: 64Bit
Wohnort: Fast Dänemark

Re: Text auf Canvas ausgeben

Beitrag von Winni »

Hi!

Ja der Hintergrund des Fonts macht es immer anders als man möchte:

In Deinem Fall muss da noch in die ganze Font und Brush-Arie

Code: Alles auswählen

brush.style := bsSolid;
Vermute ich mal.

Winni

braunbär
Beiträge: 369
Registriert: Do 8. Jun 2017, 18:21
OS, Lazarus, FPC: Windows 10 64bit, Lazarus 2.0.10, FPC 3.2.0
CPU-Target: 64Bit
Wohnort: Wien

Re: Text auf Canvas ausgeben

Beitrag von braunbär »

Danke für die Antwort!
Leider hat das auch nicht geholfen.

So schaut das TImage mit und ohne Bild aus:
Bild
Nur dort, wo kein Bild ist, ist der Text sichtbar.

Frank Ranis
Beiträge: 201
Registriert: Do 24. Jan 2013, 21:22

Re: Text auf Canvas ausgeben

Beitrag von Frank Ranis »

Hallo braunbär,

probier mal folgendes ,

gefunden unter

https://forum.lazarus.freepascal.org/in ... ic=29498.0

Code: Alles auswählen

procedure TForm1.Button1Click(Sender: TObject);
var pic:string;
    LPicture: TPicture;
begin
 pic := 'test.jpg'; // Filename

 LPicture := TPicture.Create;
 try
  LPicture.LoadFromFile(pic);
  Image1.Picture.Bitmap.PixelFormat := pf24bit;
  Image1.Picture.Bitmap.SetSize(LPicture.Width, LPicture.Height);
  Image1.Picture.Bitmap.Canvas.Draw(0, 0, LPicture.Bitmap);
 finally
  FreeAndNil(LPicture);
 end;

 // Fette Linie
 Image1.Canvas.Pen.Color:= clRed;
 Image1.Canvas.Pen.Width:=5;
 Image1.Canvas.Font.Size:=10;
 Image1.Canvas.Line(0,0,100,100);

// image1.canvas.Font.Name:='Arial';
 image1.Canvas.Font.Color:=clred;
 image1.Canvas.TextOut(1,1,'Bla-Bla-TeleBla-TEST-TEST');
end;                   
Gruß

Frank
www.flz-vortex.de

Mathias
Beiträge: 6167
Registriert: Do 2. Jan 2014, 17:21
OS, Lazarus, FPC: Linux (die neusten Trunk)
CPU-Target: 64Bit
Wohnort: Schweiz

Re: Text auf Canvas ausgeben

Beitrag von Mathias »

Code: Alles auswählen

              for n in xname do begin TextOut(3,y,n); inc(y,12) end;
              end (* with Canvas *);
Evtl. schreibst du aussershalb der Bitmap, Setze mal die Koordinaten auf 1, 1 .
Mit Lazarus sehe ich grün
Mit Java und C/C++ sehe ich rot

wennerer
Beiträge: 507
Registriert: Di 19. Mai 2015, 20:05
OS, Lazarus, FPC: Linux Mint 20 Cinnamon,Lazarus 2.2.6 (rev lazarus_2_2_6) FPC 3.2.2 x86_64-linux-
CPU-Target: x86_64-linux-gtk2

Re: Text auf Canvas ausgeben

Beitrag von wennerer »

Hi Braunbär,
ich hab mal mit deinem Code etwas herumgespielt und alles weggelassen was nicht unbedingt zum Testen da sein muss. Mit unten stehendem Code wird der Text über das Bild gezeichnet. Ich weiß auch nicht ob du beim Erzeugen der Image alles richtig machst. Ich habe es so jedenfalls noch nicht gesehen. Vielleicht bringt dich das schon weiter.

Viele Grüße
Bernd

Code: Alles auswählen

unit Unit1;

{$mode objfpc}{$H+}

interface

uses
  Classes, SysUtils, Forms, Controls, Graphics, Dialogs, StdCtrls, ExtCtrls;

type

  { TForm1 }

  TForm1 = class(TForm)
    Button1: TButton;
    procedure Button1Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
  private

  public

  end;

var
  Form1: TForm1;

implementation

{$R *.lfm}

{ TForm1 }

procedure TForm1.Button1Click(Sender: TObject);
var OpenDialog : TOpenDialog;
    pic        : string;
    Image      : TImage;
begin
  OpenDialog   := TOpenDialog.Create(self);
   if OpenDialog.Execute then
   pic := OpenDialog.FileName;
  // Bild erzeugen
   Image := TImage.Create(self);
   with Image do // wird beim Destroy der Form wieder freigegeben
     begin parent:=self;
       //width:=PicWidth; height:=PicHeight;
       //autosize:=true; //proportional:=true;
      width:=800;
      height:= 600;
      Picture.LoadFromFile(pic);
          // wenn möglich Bild von der Festplatte laden
          //pic := 'bilder\'+KNr+'.jpg';
          //if fileexists(pic)
          //then begin Picture.LoadFromFile(pic);
              // if drehen then RotateBitmap(Picture.Bitmap);
               //end
          //else begin
       //Picture.Clear;
       //Picture.Bitmap.SetSize(PicWidth,PicHeight);
      end;
  // Namen unten ausgeben
          //y:=Picture.Bitmap.Height-5-length(xname)*12;
   with Image.Picture.Bitmap.Canvas do
     begin Font.Size:=8;
      Brush.Color :=clblack;
      Font.Color  :=clwhite;
      TextOut(10,10,'Das ist ein Test');
          //    for n in xname do begin TextOut(3,y,n); inc(y,12) end;
     end (* with Canvas *);
end (* with TImage *);

procedure TForm1.FormCreate(Sender: TObject);
begin
 width := 800;
 height:= 700;
end;



end.


Sieben
Beiträge: 202
Registriert: Mo 24. Aug 2020, 14:16
OS, Lazarus, FPC: Ubuntu Xenial 32, Lazarus 2.2.0, FPC 3.2.2
CPU-Target: i386

Re: Text auf Canvas ausgeben

Beitrag von Sieben »

Wenn der Button während der Laufzeit mehrfach geclickt wird, würde ich auf jeden Fall sowohl den Opendialog als auch das Image mit nil anlegen und im Event auch wieder freigeben.

braunbär
Beiträge: 369
Registriert: Do 8. Jun 2017, 18:21
OS, Lazarus, FPC: Windows 10 64bit, Lazarus 2.0.10, FPC 3.2.0
CPU-Target: 64Bit
Wohnort: Wien

Re: Text auf Canvas ausgeben

Beitrag von braunbär »

@wennerer
Danke für deine Unit. Das ist, was bei mir herauskommt (neue Unit mit cut and paste ins Projekt eingebunden, passendes Formular dazugeklickt, den Button1 etwas zu hoch, das sollte egal sein, überhaupt keine Änderungen an deinem Quelltext:
Bild
Wo der Text zu sehen sein sollte, trotz

Code: Alles auswählen

Brush.Color :=clblack;
ein weißer Texthintergrund aber kein Text :evil:
Es ändert sich übrigens auch nichts am Bild, wenn ich als Fontfarbe clgreen statt clwhite einsetze, HIntergrund bleibt weiß, kein Text zu sehen.
Das Problem dürfte tatsächlich von der Farbtiefe 32bit des Original jpg sein.
Sieben hat geschrieben:
Fr 16. Okt 2020, 15:28
Wenn der Button während der Laufzeit mehrfach geclickt wird, würde ich auf jeden Fall sowohl den Opendialog als auch das Image mit nil anlegen und im Event auch wieder freigeben.
Im meinem Programm gibt es dann keinen derartigen Button, zum Testen ist es egal.
Mathias hat geschrieben:
Fr 16. Okt 2020, 13:56

Code: Alles auswählen

              for n in xname do begin TextOut(3,y,n); inc(y,12) end;
              end (* with Canvas *);
Evtl. schreibst du aussershalb der Bitmap, Setze mal die Koordinaten auf 1, 1 .
Wie man an den oben angezeigten Bildern erkennt, stimmt die Berechnung der Textposition bei den Nicht-Bildern (y=Bildhöhe-Zeilenzahl*12Pixel-5, x=3), nur wenn vorher ein Jpg ins Bitmap geladen wurde, kommt kein Text. Aber auch das Schreiben an die Position 1,1 ändert nichts. Es wird kein Text angezeigt.
Frank Ranis hat geschrieben:
Fr 16. Okt 2020, 08:05
Hallo braunbär,

probier mal folgendes ,

gefunden unter

https://forum.lazarus.freepascal.org/in ... ic=29498.0

Gruß

Frank
Danke, das funktioniert. die Symptome sind offenbar auf das gleiche Problem zurückzuführen wie in deinem Link beschrieben.

Benutzeravatar
theo
Beiträge: 10468
Registriert: Mo 11. Sep 2006, 19:01

Re: Text auf Canvas ausgeben

Beitrag von theo »

braunbär hat geschrieben:
So 18. Okt 2020, 00:56
Das Problem dürfte tatsächlich von der Farbtiefe 32bit des Original jpg sein.
Meines Wissens gibt es keine 32bit JPEG.

Von welchem Betriebssystem sprechen wir überhaupt?

Manchmal hilft es, das Bild einfach auf den Ziel Canvas zu zeichnen, vor den weiteren Manipulationen.

Code: Alles auswählen

var  pichelp:TPicture;
begin
    pichelp:=TPicture.Create;
    pichelp.LoadFromFile('/home/theo/Bilder/test.png');
    Image1.Picture.Bitmap.SetSize(pichelp.bitmap.Width,pichelp.bitmap.Height);
    Image1.Picture.Bitmap.Canvas.Draw(0,0,pichelp.Bitmap);
    pichelp.free;
    Image1.Picture.Bitmap.Canvas.Font.Size:=8;
    Image1.Picture.Bitmap.Canvas.Brush.Color:=clblack;
    Image1.Picture.Bitmap.Canvas.Font.Color:=clwhite;
    Image1.Picture.Bitmap.Canvas.TextOut(5,5,'Test');
end;        

braunbär
Beiträge: 369
Registriert: Do 8. Jun 2017, 18:21
OS, Lazarus, FPC: Windows 10 64bit, Lazarus 2.0.10, FPC 3.2.0
CPU-Target: 64Bit
Wohnort: Wien

Re: Text auf Canvas ausgeben

Beitrag von braunbär »

theo hat geschrieben:
So 18. Okt 2020, 11:49
Meines Wissens gibt es keine 32bit JPEG.
Ich habe das jetzt überprüft, jedenfalls sind die Jpgs, die ich habe, mit denen das Schreiben nicht funktioniert, tatsächlich nur 24 Bit breit. Da scheint in der Implementierung des TCanvas ein Fehler sein.
Von welchem Betriebssystem sprechen wir überhaupt?
Windows 10
Manchmal hilft es, das Bild einfach auf den Ziel Canvas zu zeichnen, vor den weiteren Manipulationen.
Ja, das dürfte das Einfachste sein. Allerdings habe ich da noch eine Frage. Die Properties von Image1 sind so eingestellt, dass das Bild automatisch entsprechend der Größe des TImage verkleinert wird. Mit einem TPicture weiß ich aber nicht, wie ich das bewerkstelligen könnte. Als quick and dirty Möglichkeit fällt mir ein, ein zusätzliches, unsichtbares TImage auf die Form zu legen. Gibt es da eine bessere Lösung?

Warf
Beiträge: 1908
Registriert: Di 23. Sep 2014, 17:46
OS, Lazarus, FPC: Win10 | Linux
CPU-Target: x86_64

Re: Text auf Canvas ausgeben

Beitrag von Warf »

braunbär hat geschrieben:
So 18. Okt 2020, 18:32
Ja, das dürfte das Einfachste sein. Allerdings habe ich da noch eine Frage. Die Properties von Image1 sind so eingestellt, dass das Bild automatisch entsprechend der Größe des TImage verkleinert wird. Mit einem TPicture weiß ich aber nicht, wie ich das bewerkstelligen könnte. Als quick and dirty Möglichkeit fällt mir ein, ein zusätzliches, unsichtbares TImage auf die Form zu legen. Gibt es da eine bessere Lösung?
Du musst beim zeichnen skalieren: Link (Ist delphi doc, da die fpc doc für die Funktion sehr mau ist, sollte aber genauso gelten)

Benutzeravatar
Winni
Beiträge: 1577
Registriert: Mo 2. Mär 2009, 16:45
OS, Lazarus, FPC: Laz2.2.2, fpc 3.2.2
CPU-Target: 64Bit
Wohnort: Fast Dänemark

Re: Text auf Canvas ausgeben

Beitrag von Winni »

Hallo!

Skalieren von Bildern ist nicht trivial.
Oder Du machst es trivial - dann hast Du Treppen im Bild.

Das beste Zoomen, das ich bisher gesehen habe, macht die BGRA Bibliothek.

Und es ist sehr einfach zu bedienen.

Das BGRAbitmapPack per Online Package Manager installieren.

Code: Alles auswählen

uses .........,BGRAbitmap, BGRAdefaultBitmap, BGRAtypes;

var bmp : TBGRAbitmap;
begin
bmp:= TBGRAbitmap.create ('My.JPG');
BGRAreplace (bmp, bmp.resample(Image1.width,Image1.height));
bmp.draw (Image1.Canvas,0,0);
bmp.free;
end;

Angenommen wird automatisch als Parameter "rmFineResample" , der mit aufwendigen Algoritmen arbeitet - je nachdem ob Du verkleinerst oder vergrößerst.
Wenn Du wirklich mal Treppchen-Graphic brauchst (Tetris, Balkendiagramme), dann kannst Du auch den Parameter "rmSimpleStretch" benutzen.

BGRA arbeitet intern mit Subpixels.
Und außerdem mit Fliesskomma Werten (single, TPointF).

Winni

Benutzeravatar
Ally
Beiträge: 263
Registriert: Do 11. Jun 2009, 09:25
OS, Lazarus, FPC: Win und Lazarus Stable release
CPU-Target: x64

Re: Text auf Canvas ausgeben

Beitrag von Ally »

Hallo,
Skalieren von Bildern ist nicht trivial.
Das herunterskalieren in hoher Qualität geht auch mit "Bordmitteln" ganz gut:

Code: Alles auswählen

unit MyScaleBitmap;

{$mode objfpc}{$H+}

interface

uses
  Graphics, IntfGraphics, LazCanvas, FPCanvas;

procedure ScaleBitmap(BM: TCustomBitmap; Width, Height: Integer);

implementation

procedure ScaleBitmap(BM: TCustomBitmap; Width, Height: Integer);
var
  Source: TLazIntfImage = nil;
  Dest: TLazCanvas = nil;
begin
  try
    // Create the Source-LazIntfImage
    Source := BM.CreateIntfImage;
    // Create the Destination-LazCanvas
    Dest := TLazCanvas.Create(Source);
    // Execute the Canvas.StretchDraw
    Dest.StretchDraw(0, 0, Width, Height, Source);
    // Reload the stretched Source into the Bitmap
    BM.LoadFromIntfImage(Source);
    BM.SetSize(Width, Height);
  finally
    Dest.Free;
    Source.Free;
  end;
end;

end.
Guß Roland

wp_xyz
Beiträge: 4869
Registriert: Fr 8. Apr 2011, 09:01

Re: Text auf Canvas ausgeben

Beitrag von wp_xyz »

Zurück zur ursprünglichen Frage: Wenn man den Text im OnPaint-Ereignis von TImage ausgibt, funktioniert alles richtig - siehe Anhang.
Dateianhänge
TextOnImage.zip
(102.74 KiB) 212-mal heruntergeladen

Antworten