How to make a TBitMap in 2-color-Mode (PixelFormat=pf1bit) to work? lazarus / 39-Graphics ---------------------------------------------------------------------- Hartmut · 2023-12-19 14:00 I want to draw font characters of a selectable Font on a TCanvas of a TBitMap and then analyze their shape. For 2 reasons I want to use this TBitMap in 2-color-Mode (PixelFormat=pf1bit): 1) then I have only 2 colors to analyze (not black and white and *many* gray values) 2) it might speed things up to carry only 1 bit per pixel around instead of 24. My code works with 'PixelFormat=pf24bit', but not with 'PixelFormat=pf1bit'. Here is a short demo: Code: Pascal  [Select][+][-]window.onload = function(){var x1 = document.getElementById("main_content_section"); if (x1) { var x = document.getElementsByClassName("geshi");for (var i = 0; i unit Unit1; {$mode objfpc}{$H+} {$IFNDEF LINUX}   {$apptype console} {for writeln on Windows}{$ENDIF} interface uses Classes, SysUtils, Forms, Controls, Graphics, Dialogs, StdCtrls, Types; type  { TForm1 }  TForm1 = class(TForm)  Button1: TButton;  procedure Button1Click(Sender: TObject); private public end; var Form1: TForm1; implementation {$R *.lfm} { TForm1 } const BGC = clWhite; {Background Color}      FGC = clBlack; {Foreground Color} procedure drawBitMap(BM: TBitMap);   {"draws" the content of a BitMap as Hex-values}   var col: TColor;     xx,yy: longint;       x,y: integer;   begin   BM.GetSize(xx,yy); {get size of the Bitmap}    for y:=0 to yy-1 do      begin      for x:=0 to xx-1 do         begin         col:=BM.Canvas.Pixels[x,y];       write(IntToHex(col,6), ' ');         end;      writeln;      end;   end; procedure TForm1.Button1Click(Sender: TObject);   var BM: TBitMap;       CV: TCanvas;       SR: TSize;       s: string;   begin   BM:=TBitMap.Create;   BM.PixelFormat:=pf24bit; // works// BM.PixelFormat:=pf1bit;  // works not   writeln('PixelFormat=', BM.PixelFormat);    CV:=BM.Canvas; {abbreviation}   CV.Font.Name:='Courier New';   CV.Font.Height:=12;    s:='X';   SR:=CV.TextExtent(s); {get size of string 's'}   BM.SetSize(SR.cx,SR.cy);    CV.Brush.Color:=BGC;   CV.Clear;   CV.Clear;   CV.Pen.Color:=FGC;    CV.TextOut(0,0,s); {draw 's' on Canvas}   drawBitMap(BM);    {shows the content of a BitMap as Hex- values}    BM.Free;   end; end. The demo draws letter 'X' on a Canvas and then shows the color-values of every pixel. On the screenshot you see my output: a) with 'PixelFormat=pf24bit' you can recognize the letter 'X' with values of white ('FFFFFF') and several gray values. b) with 'PixelFormat=pf1bit' you see, that *all* pixels have the same value ('010000'). I played with const 'BGC' and 'FGC' but this did not help. And there is a message "Gdk-WARNING **: 14:34:05.858: No colormap in gc_get_foreground". What does it mean? What do I do wrong? I use Lazarus 2.0.10 on Linux Ubuntu 22.04. I attached a compilable project. Thanks in advance. ---------------------------------------------------------------------- wp · 2023-12-19 14:40 The trick is to set the bitmap's Monochrome property to true, and to do this immediately after creating the bitmap, before setting its size. See attached demo Code: Pascal  [Select][+][-]window.onload = function(){var x1 = document.getElementById("main_content_section"); if (x1) { var x = document.getElementsByClassName("geshi");for (var i = 0; i   FBitmapMono := TBitmap.Create;  FBitmapMono.Monochrome := true;  // before SetSize  FBitmapMono.SetSize(W, H);  FBitmapMono.Canvas.Brush.Color := clWhite;  FBitmapMono.Canvas.FillRect(0, 0, W, H);  FBitmapMono.Canvas.Brush.Color := clBlack;  FBitmapMono.Canvas.Ellipse(5, 5, W-10, H-10); [P.S.] Tried this on Windows, where it works. But double-checking on a Linux- VM I see that I get a crash when the monochrome bitmap is painted. And with your code, I get the same result as you. [P.P.S.] Now I see the 'x'! I must open the debug console before the bitmap is written to the console... ---------------------------------------------------------------------- domasz · 2023-12-19 14:55 PixelFormats different than 24 and 32 bit are broken in Lazarus. ---------------------------------------------------------------------- Hartmut · 2023-12-19 16:15 Hello wp, thank you for this idea. Unfortunately this trick does not help on my Linux system (as you said). Meanwhile I tested my demo on Windows 7, 32 bit, where it works without problems (no need for the monochrome-trick), see new screenshot. I'm frustrated, that again something, what works on Windows, does not work on Linux. Unfortunately I need this only for Linux... Quote from: domasz on December 19, 2023, 03:55:50 pmPixelFormats different than 24 and 32 bit are broken in Lazarus. Hmmm. But on Windows it works perfectly... Is this an official statement from a FPC/Lazarus developer? Is this documented somewhere? ---------------------------------------------------------------------- wp · 2023-12-19 16:31 Quote from: Hartmut on December 19, 2023, 05:15:43 pmHello wp, thank you for this idea. Unfortunately this trick does not help on my Linux system (as you said). Meanwhile I tested my demo on Windows 7, 32 bit, where it works without problems (no need for the monochrome-trick), see new screenshot. I'm frustrated, that again something, what works on Windows, does not work on Linux. Unfortunately I need this only for Linux... I did some further investigation why it first did not work in Linux and then it did: I also had switched from gtk2 to qt5 widgetset - on gtk2 it is not working (screenshot like in your initial post), on qt5 it works (screenshot like in my previous post). I also checked gtk3 - here the monochrome bitmap is converted to 24bit. Quote from: Hartmut on December 19, 2023, 05:15:43 pmQuote from: domasz on December 19, 2023, 03:55:50 pmPixelFormats different than 24 and 32 bit are broken in Lazarus. Hmmm. But on Windows it works perfectly... Is this an official statement from a FPC/Lazarus developer? Is this documented somewhere?In my experience, it depends... It is possible to create 1-bit, or paletted 8-bit bitmaps and to store them. But when they are loaded into a TImage they are always converted to 24 or 32-bit. ---------------------------------------------------------------------- Hartmut · 2023-12-19 17:41 Quote from: wp on December 19, 2023, 05:31:04 pmI did some further investigation why it first did not work in Linux and then it did: I also had switched from gtk2 to qt5 widgetset - on gtk2 it is not working (screenshot like in your initial post), on qt5 it works (screenshot like in my previous post). I also checked gtk3 - here the monochrome bitmap is converted to 24bit. Thank you wp for investigating this. I'm on gtk2. Switching to qt5 now is not an option. But good to know for the future. Maybe I must stay with my 24-bit TBitMap... Or is there any other class, where I can draw a font character on it and which can be set to monochrome and where I can read it's pixels? ---------------------------------------------------------------------- wp · 2023-12-19 17:57 Quote from: Hartmut on December 19, 2023, 03:00:19 pmI want to draw font characters of a selectable Font on a TCanvas of a TBitMap and then analyze their shape. For 2 reasons I want to use this TBitMap in 2-color-Mode (PixelFormat=pf1bit): 1) then I have only 2 colors to analyze (not black and white and *many* gray values) Hmmm.... But the gray colors are what makes true-type fonts look nice. In pure black and white (no grays), the characters will look very ugly. Do you want this? ---------------------------------------------------------------------- Hartmut · 2023-12-19 18:06 Quote from: wp on December 19, 2023, 06:57:09 pmQuote from: Hartmut on December 19, 2023, 03:00:19 pmI want to draw font characters of a selectable Font on a TCanvas of a TBitMap and then analyze their shape. For 2 reasons I want to use this TBitMap in 2-color-Mode (PixelFormat=pf1bit): 1) then I have only 2 colors to analyze (not black and white and *many* gray values) Hmmm.... But the gray colors are what makes true-type fonts look nice. In pure black and white (no grays), the characters will look very ugly. Do you want this? Yes. Because I do not display those characters, I only "draw" them somewhere not visual with the only purpose to analyze their shape. Therefore monochrome is much easier as to have many grays. ---------------------------------------------------------------------- wp · 2023-12-19 23:47 Here is a mini project based on FCLImage which works in Windows and Linux/gtk2 and displays the (anti-aliased) pixels of a text in black- and-white: Code: Pascal  [Select][+][-]window.onload = function(){var x1 = document.getElementById("main_content_section"); if (x1) { var x = document.getElementsByClassName("geshi");for (var i = 0; i program project1; uses  Types, FPImage, FPCanvas, FPImgCanv, FTFont; const  TXT = 'A'; var  img: TFPMemoryImage;  cnv: TFPCustomCanvas;  fnt: TFreeTypeFont;  sz: TSize;  x, y: Integer;  c: TFPColor;  fontName: String = 'DejaVuSans';begin  {$IFDEF Linux}  FTFont.InitEngine('/usr/share/fonts/truetype/ttf-dejavu/');  fontName := '/usr/share/fonts/truetype/dejavu/' + fontName;  {$ENDIF}  fnt := TFreeTypeFont.Create;  fnt.AntiAliased := false;   img := TFPMemoryImage.Create(1, 1);   // measure text size  cnv := TFPImageCanvas.Create(img);  cnv.Font := fnt;  cnv.Font.Name := fontName;  cnv.Font.Size := 20;  cnv.Font.FPColor := colBlack;  sz := cnv.TextExtent(TXT);  img.SetSize(sz.CX, sz.CY);   // Draw background  cnv.Brush.FPColor := colWhite;  cnv.FillRect(0, 0, img.Width, img.Height);   // Draw text  cnv.TextOut(0, sz.Cy, TXT);   // Output to screen  for y := 0 to img.Height-1 do  begin    for x := 0 to img.Width-1 do    begin      c := img.Colors[x, y];      if c = colBlack then        Write('XX')      else      if c = colWhite then      Write('..')      else        Write('??');    end;    WriteLn;  end;   cnv.Free;  img.Free;  fnt.Free;end. ---------------------------------------------------------------------- Hartmut · 2023-12-20 16:03 Thank you very much wp for that demo. I studied it and again learned from you. Unfortunately it does not return the results which I am looking for: In 1st line I want to detect if an UTF8-character is contained in a font or not. If not, those characters are normally displayed as a rectangle with 4 or 6 hex digits in it (see $EFBFBE and $EFBFBF in screenshot1). With my program from my 1st post (with a small modification by using your displaying routine and setting Font.Height:=16) you can see this shape in screenshot2 (lower part), while your program shows something completely other (see screenshot3, lower part). But even for valid UTF8-characters I found discrepancies: e.g. UTF- char $EFBFA5 is shown normally as something like letter "y" with 2 horizontal lines (see also screenshot1). My program from my 1st post shows the same (see screenshot2, upper part). But your program shows some additional artefact (see screenshot3, upper part). Another example would be $C2A9, which should display a "(c)" Copyright sign, but there is an additional "Ä" before it with your code (screenshot 4). I don't want you to spend more time into this project because it is not important enough for me. I have a (not so ideal) 24-bit solution which "does the job". It would be fine to have a monochrome solution (which might be something faster), but it's not worth that you spend more time on it (I hope I found the right words - my English is not so good). Again thanks that you tried to help me. ---------------------------------------------------------------------- wp · 2023-12-20 18:00 One idea: My demo was an FPC commandline program, and this does not know about UTF8. Either transfer the code to a Lazarus GUI application, or add package LazUtils to the project requirements and unit LazUTF8 to the uses clause. This way I was able to display a greek alpha character (which is not in my ANSI code page). Did not test on Linux, though. ---------------------------------------------------------------------- Hartmut · 2023-12-21 11:43 You are right, wp, with package LazUtils and unit LazUTF8 the results are better - but not correct. In screenshot 5 you see UTF8-char $C2A9 in the upper part from your code without LazUtils & LazUTF8 and in the lower part with both. The right part of the "(c)" is missing. And in screenshot 6 (which was made with LazUtils & LazUTF8) you see in the upper part UTF8-char $EFBFA5 (which should be a "y" with 2 horizontal lines as in screenshot 2 from my reply #9) and in the lower part of screenshot 6 you see UTF8-char $EFBFBF (which should be a complete rectangle with "FFFF" inside as in screenshot 2 from my reply #9). ---------------------------------------------------------------------- wp · 2023-12-21 16:08 I don't know. Basically the approach is correct, but there seems to be some issue in extraction of the text size. In case of the '(c)', you can double the width of the image (img.SetSize(sz.CX*2, sz.CY) ), and now the character is complete (with some extra blank pixels at the right). From this I get the impression that the glyph has some empty pixels at the left which are not considered in width calculation, but the glyph nevertheless is drawn at its origin. Unfortunately the relevant information is contained only in classes which are declared as private and thus are not accessible. There are some other truetype libraries in the Lazarus/FPC source tree, maybe they would be more helpful, but as you said that you are happy with your gray-scale workaround, I do not intend to further investigate in this direction. ---------------------------------------------------------------------- Hartmut · 2023-12-21 16:58 Yes, with double-width the Copyright sign is complete, but for UTF8-characters $EFBFA5 and $EFBFBF you must double the height too and still don't get the correct shape as I get with my code from my 1st post. We should stop here, because other truetype libraries in the Lazarus/FPC source tree could be interesting, but will probably cause other problems and this is not worth your valuable time, because I have a working workaround. Thanks again for your help. Again I learned from you. ---------------------------------------------------------------------- domasz · 2023-12-21 17:03 If speed is not very important you can set background to something like 10xwidth, 10xheight, draw the character somewhere in the middle and then crop borders. ---------------------------------------------------------------------- Hartmut · 2023-12-22 13:05 Thanks domasz for your reply. But for e.g. UTF8-characters $EFBFA5 and $EFBFBF even with increasing the image size there is not the correct character displayed (see screenshot 7), which should look like in screenshot 2. But I want to ask a question: is there in FPC a ready-to-use crop frunction? Or would I have to do this "manually" by checking pixel for pixel? ---------------------------------------------------------------------- domasz · 2023-12-22 15:22 I don't think there is a ready-to-use function but this one should work fine: https://stackoverflow.com/questions/10532445/how-to-calculate-close- crop-rectangle-of-a-bitmap ---------------------------------------------------------------------- wp · 2023-12-22 15:26 Quote from: Hartmut on December 22, 2023, 02:05:33 pmThanks domasz for your reply. But for e.g. UTF8-characters $EFBFA5 and $EFBFBF even with increasing the image size there is not the correct character displayed (see screenshot 7), which should look like in screenshot 2. But I want to ask a question: is there in FPC a ready-to-use crop frunction? Or would I have to do this "manually" by checking pixel for pixel? No, you must do it manually: Code: Pascal  [Select][+][-]window.onload = function(){var x1 = document.getElementById("main_content_section"); if (x1) { var x = document.getElementsByClassName("geshi");for (var i = 0; i procedure CropImage(Img: TFPCustomImage; AEmptyColor: TFPColor;  out xLeft, yTop, xRight, yBottom: Integer);   function EmptyRow(y: Integer): Boolean;  var    x: Integer;  begin    Result := false;    for x := 0 to Img.Width-1 do      if Img.Colors[x, y] <> AEmptyColor then        exit;    Result := true;  end;   function EmptyCol(x: Integer): Boolean;  var    y: Integer;    c: TFPColor;  begin    Result := false;    for y := 0 to Img.Height-1 do    begin      c := Img.Colors[x, y];      if c <> AEmptyColor then        exit;    end;  Result := true;  end; var  x, y: Integer;begin  xLeft := 0;  for x := 0 to Img.Width-1 do    if not EmptyCol(x) then    begin      xLeft := x;      break;    end;  xRight := Img.Width-1;  for x := Img.Width-1 downto 0 do    if not EmptyCol(x) then    begin      xRight := x;    break;    end;  yTop := 0;  for y := 0 to Img.Height-1 do    if not EmptyRow(y) then    begin      yTop := y;      break;    end;  yBottom := 0;  for y := Img.Height-1 downto 0 do    if not EmptyRow(y) then  begin      yBottom := y;      break;    end;end; // *** In the main program ***   // Draw text  cnv.TextOut(0, img.Height div 2, TXT);   // Crop image  CropImage(img, colWhite, xLeft, yTop, xRight, yBottom);   // Output to screen  for y := yTop to yBottom do  begin  for x := xLeft to xRight do    begin      c := img.Colors[x, y];      if c = colBlack then        Write('XX')      else      if c = colWhite then        Write('..')      else        Write('??');    end;    WriteLn;  end; ---------------------------------------------------------------------- Hartmut · 2023-12-22 17:44 Thank you to domasz and wp for the link and the crop demo. ---------------------------------------------------------------------- Boleeman · 2024-02-03 20:47 Some French guy (Jean) on the old (now gone) efg's computer lab image processing website made a Delphi demo for making 1bit bitmaps. I tried converting to Lazarus, but could not get the colours to work. This compiles OK in Delphi Community Edition. Attached is the Delphi source and some screen shots. Enjoy. ---------------------------------------------------------------------- domasz · 2024-02-03 21:02 I noticed loading doesn't work so I fixed loading. Is anything else wrong? Lazarus has problems with PixelFormat. You can't change PixelFormat of an "existing" bitmap. You can only set pixelformat when creating an image. Code: Pascal  [Select][+][-]window.onload = function(){var x1 = document.getElementById("main_content_section"); if (x1) { var x = document.getElementsByClassName("geshi");for (var i = 0; i {loading a .bmp file}procedure TFormPf1bit.Button1Click(Sender: TObject); var bit map:tbitmap; bitmap2:tbitmap;beginbitmap:=tbitmap.create;try with bitmap do    begin       if openPictureDialog1.execute then        bitmap.LoadFromFile(OpenPictureDialog1.FileName);    end;    label1.caption:=inttostr(bitmap.width)+' '+inttostr(bitmap.height);   bitmap2 := tbitmap.create;    bitmap2.setsize(bitmap.width, bitmap.height);    bitmap2.pixelformat:=pf1bit;    bitmap2.Canvas.CopyRect(rect(0,0,bitmap.width,bitmap.height), bitmap.canvas, rect(0,0,bitmap.width,bitmap.height));    ImageBits.Picture.graphic := Bitmap2;FINALLY    Bitmap.Free;    bitmap2.free;end;end; ---------------------------------------------------------------------- Boleeman · 2024-02-03 21:06 Ah, I quickly converted it to Lazarus and left the Delphi defines to make it compatible with Delphi. Like mentioned previously, the colour part does not work in the Lazarus conversion (it does in the Delphi version) but you do get Black and White images. Perhaps a member of the forum could possibly help with this conversion to add the colour part. Enjoy. ---------------------------------------------------------------------- Boleeman · 2024-02-03 21:10 Looks like you posted at the same time as me. The part where you change to different colours (define palette) does not work in the Lazarus version and as I remember possibly the saving bit (unsure have not touched this for a long time but came across it and thought you may like to play with it). WP is really good at Delphi to Lazarus conversions. Possibly he may be able to help out. If you would like the compiled Delphi version I can upload to elsewhere. Enjoy. ---------------------------------------------------------------------- Boleeman · 2024-02-03 21:26 You mentioned "can't change PixelFormat" I also recall that in the Delphi version when defining the PixelFormat it had to be a certain spot to work. That message is in the code comments for saving to1bit BMP:       Width  := ImageBits.Picture.Bitmap.Width;       Height := ImageBits.Picture.Bitmap.Height;       // Unclear why this must follow width/height to work correctly.       // If PixelFormat precedes width/height, bitmap will always be black.       PixelFormat := pf1bit;  domasz, if you have any luck getting the define palette part to work that would be nice to share. I tried replacing all components with Lazarus components and manually putting in the code and Lazarus compiler directives but went round in circles. Perhaps you will have better luck? Also in my Lazarus conversion, the loading of the BMP was working OK (possibly because I left the Delphi defines) I also tried your solution and that worked as well. With this example, I like how they also do rotation and symmetry of the pixel grid.