Recent

Author Topic: [SOLVED] Splitting an image  (Read 8887 times)

madref

  • Hero Member
  • *****
  • Posts: 1014
  • ..... A day not Laughed is a day wasted !!
    • Nursing With Humour
Re: [NOT SOLVED] Splitting an image
« Reply #75 on: May 16, 2024, 06:20:38 am »
I would rather have it not stretched. but would love to be able to choose the size of the font and then have all letters centered.
You treat a disease, you win, you lose.
You treat a person and I guarantee you, you win, no matter the outcome.

Lazarus 3.99 (rev main_3_99-2099-gef1838e6d2) FPC 3.3.1 x86_64-darwin-cocoa
Mac OS X Sonoma 14.5

KodeZwerg

  • Hero Member
  • *****
  • Posts: 2269
  • Fifty shades of code.
    • Delphi & FreePascal
Re: [NOT SOLVED] Splitting an image
« Reply #76 on: May 16, 2024, 12:13:15 pm »
I would rather have it not stretched. but would love to be able to choose the size of the font and then have all letters centered.
The problematic part is the custom size + centering but here is my first version that does do it very quick, not perfect but usable.
And because it is custom I added 2 tweaks that you need to set, OffsetX, OffsetY, this gives you the possibility to adjust the Letter in all directions.
Also I overhauled the demo GUI so you can learn what options are in what mode available.
To explain the modes:
Speed - this is the implementation of paweld just slightly modified by me
Stretched - this will fill out the box complete
Custom - this is basicly same as pawelds variant but now customizable by fontsize and offset tweaking

no fonts included in this archive.
attached is the raw project in current state.
added image to show all three modes without altering any option, just pressed on "draw".
« Last Edit: Tomorrow at 31:76:97 xm by KodeZwerg »

madref

  • Hero Member
  • *****
  • Posts: 1014
  • ..... A day not Laughed is a day wasted !!
    • Nursing With Humour
Re: [NOT SOLVED] Splitting an image
« Reply #77 on: May 16, 2024, 07:21:16 pm »
Thanks again...


now I hope this is done... so SOLVED !!!!!!!
You treat a disease, you win, you lose.
You treat a person and I guarantee you, you win, no matter the outcome.

Lazarus 3.99 (rev main_3_99-2099-gef1838e6d2) FPC 3.3.1 x86_64-darwin-cocoa
Mac OS X Sonoma 14.5

KodeZwerg

  • Hero Member
  • *****
  • Posts: 2269
  • Fifty shades of code.
    • Delphi & FreePascal
Re: [NOT SOLVED] Splitting an image
« Reply #78 on: May 16, 2024, 11:44:42 pm »
Thanks again...


now I hope this is done... so SOLVED !!!!!!!
I am glad that this is what you wanted to have while for me it is not fully solved.
I hated my extra slow working stretched variant and begun from scratch writing a better one with the result that it is now as fast as all other methods.
Here is the code that I currently use, I hope I made no mistakes since it is first time for me that I work with a Lazarus Image Format.
I've tested with quality settings way over 100 (total overkill) that Lazarus Format is really fast. (my new default is 100 for the quality)
Code: Pascal  [Select][+][-]
  1. procedure TImageFont.CroppedText(const AFont: TFont; const AText: UnicodeString; const ABackground: TColor; out AImage: TBitmap);
  2.   function Max(const AValueA, AValueB: Integer): Integer; inline;
  3.     begin
  4.       if AValueA > AValueB then
  5.         Result := AValueA
  6.       else
  7.         Result := AValueB;
  8.     end;
  9.   function Min(const AValueA, AValueB: Integer): Integer; inline;
  10.     begin
  11.       if AValueA < AValueB then
  12.          Result := AValueA
  13.        else
  14.          Result := AValueB;
  15.     end;
  16. var
  17.   LBitmap: TBitmap;
  18.   LText: RawByteString;
  19.   LImage: TLazIntfImage;
  20.   LinePointer: PIntegerArray;
  21.   CurrentX, CurrentY,
  22.   FromTop, FromLeft, FromBottom, FromRight: Integer;
  23.   LRect: TRect;
  24. begin
  25.   LText := RawByteString(AText);
  26.   LBitmap := TBitmap.Create;
  27.   try
  28.     LBitmap.PixelFormat := pf32bit;
  29.  
  30.     case UTF8CodepointSizeFast(PAnsiChar(LText)) of
  31.       1: LBitmap.Canvas.Font := AFont;
  32.       2: begin
  33.            if FontCheck('Segoe UI') then
  34.              LBitmap.Canvas.Font.Name := 'Segoe UI'
  35.            else
  36.            if FontCheck('Tahoma') then
  37.              LBitmap.Canvas.Font.Name := 'Tahoma'
  38.            else
  39.            if FontCheck('Arial') then
  40.              LBitmap.Canvas.Font.Name := 'Arial'
  41.            else
  42.              LBitmap.Canvas.Font.Name := 'MS Shell Dlg 2';
  43.          end;
  44.     end;
  45.  
  46.     LBitmap.Canvas.Font.Size := FQuality;
  47.     LBitmap.SetSize(LBitmap.Canvas.TextWidth(LText) * 3, LBitmap.Canvas.TextHeight(LText) * 3);
  48.     LBitmap.Canvas.Brush.Color := ABackground;
  49.     LBitmap.Canvas.FillRect(LBitmap.Canvas.ClipRect);
  50.     LBitmap.Canvas.TextOut(0, 0, AnsiString(AText));
  51.     LImage := LBitmap.CreateIntfImage;
  52.  
  53.     FromTop := -1;
  54.     FromLeft := -1;
  55.     FromBottom := -1;
  56.     FromRight := -1;
  57.  
  58.     for CurrentY := 0 to Pred(LImage.Height) do
  59.       begin
  60.         LinePointer := LImage.GetDataLineStart(CurrentY);
  61.         for CurrentX := 0 to Pred(LImage.Width) do
  62.           begin
  63.             if LinePointer^[CurrentX] <> ABackground then
  64.               begin
  65.                 if FromLeft = -1 then
  66.                   FromLeft := CurrentX
  67.                 else
  68.                   FromLeft := Min(FromLeft, CurrentX);
  69.  
  70.                 if FromRight = -1 then
  71.                   FromRight := CurrentX
  72.                 else
  73.                   FromRight := Max(FromRight, CurrentX);
  74.  
  75.                 if FromTop = -1 then
  76.                   FromTop := CurrentY
  77.                 else
  78.                   FromTop := Min(FromTop, CurrentY);
  79.  
  80.                 if FromBottom = -1 then
  81.                   FromBottom := CurrentY
  82.                 else
  83.                   FromBottom := Max(FromBottom, CurrentY);
  84.               end;
  85.           end;
  86.       end;
  87.     LImage.Free;
  88.     LRect.Top := FromTop;
  89.     LRect.Left := FromLeft;
  90.     LRect.Right := FromRight;
  91.     LRect.Bottom := FromBottom;
  92.     {%H-}AImage.SetSize(LRect.Width, LRect.Height);
  93.     AImage.Canvas.CopyMode := cmSrcCopy;
  94.     AImage.Canvas.CopyRect(AImage.Canvas.ClipRect, LBitmap.Canvas, LRect);
  95.   finally
  96.     LBitmap.Free;
  97.   end;
  98. end;
On my todo-list just one thing missing, but I am lazy :D
Measure from each image the x1,x2,y1,y2 coordinates and add it into my logic so that the chars looking centered on all boxes same way.
(the boxes are not at same location on all images)
« Last Edit: Tomorrow at 31:76:97 xm by KodeZwerg »

madref

  • Hero Member
  • *****
  • Posts: 1014
  • ..... A day not Laughed is a day wasted !!
    • Nursing With Humour
Re: [SOLVED] Splitting an image
« Reply #79 on: May 17, 2024, 06:37:34 am »
Where do I need to put this?

You treat a disease, you win, you lose.
You treat a person and I guarantee you, you win, no matter the outcome.

Lazarus 3.99 (rev main_3_99-2099-gef1838e6d2) FPC 3.3.1 x86_64-darwin-cocoa
Mac OS X Sonoma 14.5

KodeZwerg

  • Hero Member
  • *****
  • Posts: 2269
  • Fifty shades of code.
    • Delphi & FreePascal
Re: [SOLVED] Splitting an image
« Reply #80 on: May 17, 2024, 07:55:11 am »
Where do I need to put this?
It is easier for me to upload my current state than to explain :D (i recommend to replace this unit with the one from last archive)
This just immense speed up the "stretched" method, nothing else changed I think  ;D

I've also uploaded my newer .lfm file where I unlocked the quality up to 1000 (while I suggest to not go over 100, wasted cycles)
« Last Edit: Tomorrow at 31:76:97 xm by KodeZwerg »

 

TinyPortal © 2005-2018