Recent

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

KodeZwerg

  • Hero Member
  • *****
  • Posts: 2269
  • Fifty shades of code.
    • Delphi & FreePascal
Re: splitting an image
« Reply #30 on: May 05, 2024, 05:40:53 pm »
For the Windows OS I wrote me once a wrapper unit that offer me easy access to any font that I've included into the binary resource without the need to extract or "install" (copy into windows folder).
The usage is pretty simple but not limited to that example:
Code: Pascal  [Select][+][-]
  1. ...class
  2.            private
  3.              FFonts: TkzFonts;
  4. ...
  5.            procedure TForm1.Button1Click(Sender: TObject);
  6.            begin
  7.              // in FPC this is not working by default so you need to FFonts := nil; in FormCreate.
  8.              if (FFonts = nil) then
  9.                FFonts := TkzFonts.Create;
  10.              // load within RT_FONT the ID #1
  11.              if FFonts.LoadResourceFont(HInstance, 1, RT_FONT) then
  12.                begin
  13.                  Label1.Font.Name := FFonts.Index[0].Name;
  14.                  Label1.Caption := FFonts.Index[0].Name;
  15.                end;
  16.              // load within RT_RCDATA the ID FONTB
  17.              if FFonts.LoadResourceFont(HInstance, 'FONTB') then
  18.                begin
  19.                  Label2.Font.Name := FFonts.Index[1].Name;
  20.                  Label2.Caption := FFonts.Index[1].Name;
  21.               end;
  22.            end;
The unit is attached, again: Windows exclusive.
« 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: splitting an image
« Reply #31 on: May 05, 2024, 08:30:05 pm »
To bad for me.... I am using a Mac
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

TRon

  • Hero Member
  • *****
  • Posts: 2801
Re: splitting an image
« Reply #32 on: May 06, 2024, 10:14:46 am »
To bad for me.... I am using a Mac
Unfortunately the current ttf font manager implementation does not support fonts loaded from memory. It is an easy fix on/for Windows (using an Windows specific api call) but alas that isn't available on/for other platforms.

I wonder if that was a simple oversight, perhaps omitted due to time restrictions (when the manager got implemented), a "who on earth is ever going to use that functionality, there are more prioritizing matters" or something else.

In theory it can be done without relying on anything but freetype library but you basically would have to re-implement about every function from current font-manager...

A quick alternative, for your case, could be to also have a list of basic characters embedded as bitmap but that is only useful for ascii and single font size (or bitmaps big enough so that they scale properly).

KodeZwerg

  • Hero Member
  • *****
  • Posts: 2269
  • Fifty shades of code.
    • Delphi & FreePascal
Re: [SOLVED] splitting an image
« Reply #33 on: May 06, 2024, 01:29:14 pm »
This is my current achievement with that font project, beside transparency it runs okay, I think.
There is one method that requires Windows, comment out the "FontCheck" and all what it calls.
What I do is not same as paweld do.
I first create a high scaled blank image with one letter on it where I take care about the used dimensions.
I downscale the high-res version that it fit into the "sign".
I random pick one of those "sign-holder" image.
I print the prepared letter image onto the empty sign space.
I add that single letter onto the class image property.
(a space character is just an empty sign)

//edit
updated example and tweaked a little the drawing canvas size/dimension so it should always fit now without overlapping.
« Last Edit: May 06, 2024, 07:23:40 pm by KodeZwerg »
« 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: splitting an image
« Reply #34 on: May 08, 2024, 01:46:29 am »
@paweld: Is it possible to add a scaling factor to it?
So that the png can be 1.25 times bigger then the original?
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: splitting an image
« Reply #35 on: May 08, 2024, 06:10:43 am »
Just turn "stretch" property from the TImage on and its that large however you set the dimensions?
Attached updated to a variant that is free of unit windows :D
On those images you might see why I choose the slower way, the sign will always be filled-out while the edit shows the "original"
Problematic could be small printable chars that become "overstretched", like a dot become a gigantic cube.
Anyway, its alpha and upgradable  :-X
« Last Edit: May 08, 2024, 06:36:29 am by KodeZwerg »
« 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: splitting an image
« Reply #36 on: May 08, 2024, 07:52:05 pm »
Why do I get this error?
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: splitting an image
« Reply #37 on: May 08, 2024, 08:45:52 pm »
Why do I get this error?
Because your FPC version is missing a resource compiler I guess.
I've attached an updated version where the images are linked into resource by using project options, as an alternate this archive got 2 pre-compiled resource files, one made by the IDE and a second where i pre-compiled the image.rc so you could include that instead of project options variant.
I hope that this works now well for for.
« 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: splitting an image
« Reply #38 on: May 09, 2024, 12:04:04 am »
Thanks....


And how to I add 6 more colors (Red, Bleu, Green, Yellow, Purple and Black)?
They all are the same as the orange one's
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: splitting an image
« Reply #39 on: May 09, 2024, 01:10:05 am »
Thanks....


And how to I add 6 more colors (Red, Bleu, Green, Yellow, Purple and Black)?
They all are the same as the orange one's
Basicly same way as I've integrated the first ones.
For a full solution I would need those files.
I introduce you another method how images could be included but I am unsure if its good with that many ...
With that method I did just bintoinc the image files to produce me an array of byte so at runtile I'll quick load it.

Now you got 3 options, include files via IDE project options/resources, find out how to compile resource scripts (*.rc) or const them all :D
« Last Edit: Tomorrow at 31:76:97 xm by KodeZwerg »

KodeZwerg

  • Hero Member
  • *****
  • Posts: 2269
  • Fifty shades of code.
    • Delphi & FreePascal
Re: splitting an image
« Reply #40 on: May 09, 2024, 04:45:34 am »
here's my pre-alpha that in theory is prepared for your colorsets
class property imageset controls what is used, default is "isOrange" for the first set you gave
additional image sets can just be straight added by keeping the number continious increasing
(as of right now it is Font0..Font9 so next set (isRed) would be Font10..Font19 etc etc etc, no matter if as ID in resource or as variable array name)
and since you had problems to include files but wrote a "Thanks" I assume one method worked, so (de)activate switchs for an automated way of doing.
Since I do not have other sets, I cant test much :D
Code: Pascal  [Select][+][-]
  1. unit uFont;
  2.  
  3. (*
  4. project: custom font printing on image-set(s)
  5. author: KodeZwerg
  6. copyright: KodeZwerg 2024
  7. licence: royalty free
  8. *)
  9.  
  10. // choose how you want to link the images in
  11. // each set consist of 10 files, counting begin at 0 with prefix "Font"
  12. // to comment a switch of, simple put a "." (dot) infront of "$"
  13. // do NOT activate more than one at same time!
  14.  
  15. // use that switch if you want to use the images.rc file to be compiled and linked in
  16. // that method needs less RAM at a minimal cost of performance
  17. {$DEFINE UseRC}
  18.  
  19. // use that switch if you want to use the images.res file that you earlier compiled somehow
  20. // that method needs less RAM at a minimal cost of performance
  21. {.$DEFINE UseRES}
  22.  
  23. // use that switch if you want to include the images as "array of byte" constants
  24. // that method needs most RAM and is fastest in execution
  25. {.$DEFINE UseINC}
  26.  
  27. // use this switch if you implemented the images via lazarus project options resource menu
  28. // that method needs less RAM at a minimal cost of performance
  29. {.$DEFINE UseLaz}
  30.  
  31. {$mode ObjFPC}{$H+}
  32.  
  33. interface
  34.  
  35. uses
  36.   Classes,
  37.   SysUtils,
  38.   Forms,
  39.   Graphics,
  40.   fpCanvas, IntfGraphics, LazCanvas;
  41.  
  42. type
  43.  
  44.   { TImageFont }
  45.  
  46.   // in the ImageSet property use one of those values
  47.   // you must have implemented them in that order
  48.   TImageSet = (isOrange, isRed, isBlue, isGreen, isYellow, isPurple, isBlack);
  49.   TImageFont = class(TObject)
  50.     strict private
  51.       type
  52.         TImages = array of TPicture;
  53.         TIntArray = array of Integer;
  54.       const
  55.         CImageCount = Integer(10); // this number controls how many variations per set implemented (absolute number, 0 mean 0, 1 mean 1 etc)
  56.         CImageSets = Integer(1); // this number controls how many sets implemented (1 = isOrange, 2 = isOrange and isRed ...etc)
  57.         CImageWidth = Integer(35); // generic fixed width per character
  58.         CImageHeight = Integer(100); // generic fixed height per character
  59.         CCanvasTop = Integer(7); // controls the top of the canvas
  60.         CCanvasLeft = Integer(8); // controls the left of the canvas
  61.         CCanvasWidth = Integer(27); // controls the width of the canvas
  62.         CCanvasHeight = Integer(32); // controls the height of the canvas
  63.     strict private
  64.       FText: WideString;
  65.       FFont: TFont;
  66.       FBackground: TColor;
  67.       FImage: TPicture;
  68.       FImagePool: array of TImages;
  69.       FLastIndex: Integer;
  70.       FTempArray: TIntArray;
  71.       FImageSet: TImageSet;
  72.     private
  73.       procedure SetBackground(const AValue: TColor);
  74.       procedure SetFont(const AValue: TFont);
  75.       procedure SetImageSet(const AValue: TImageSet);
  76.       procedure SetText(const AValue: WideString);
  77.       function FontCheck(const AFontFaceName: WideString): Boolean;
  78.       function BuildImageList: Boolean;
  79.       procedure ResetTempArray;
  80.       function PickRandom: Integer;
  81.       procedure ExactTextPixels(const AFont: TFont; const AText: string; const ABackground: TColor; out AImage: TBitmap);
  82.       procedure AntiAliasedStretchDrawBitmap(SourceBitmap, DestBitmap: TCustomBitmap);
  83.     protected
  84.     public
  85.       constructor Create;
  86.       destructor Destroy; override;
  87.     published
  88.       property Text: WideString read FText write SetText;
  89.       property Font: TFont read FFont write SetFont;
  90.       property Background: TColor read FBackground write SetBackground default $FEFEFE;
  91.       property ImageSet: TImageSet read FImageSet write SetImageSet default isOrange;
  92.       property Image: TPicture read FImage;
  93.   end;
  94.  
  95. implementation
  96.  
  97. // import the pictures
  98.  
  99. {$IFDEF UseRC}
  100. {$R 'images.rc'}
  101. {$ENDIF UseRC}
  102.  
  103. {$IFDEF UseRES}
  104. {$R 'images.res'}
  105. {$ENDIF UseRES}
  106.  
  107. {$IFDEF UseINC}
  108. {$I 'Font0.inc'}
  109. {$I 'Font1.inc'}
  110. {$I 'Font2.inc'}
  111. {$I 'Font3.inc'}
  112. {$I 'Font4.inc'}
  113. {$I 'Font5.inc'}
  114. {$I 'Font6.inc'}
  115. {$I 'Font7.inc'}
  116. {$I 'Font8.inc'}
  117. {$I 'Font9.inc'}
  118. {$ENDIF UseINC}
  119.  
  120. { TImageFont }
  121.  
  122. constructor TImageFont.Create;
  123. var
  124.   LPNG: TPortableNetworkGraphic;
  125. begin
  126.   inherited Create;
  127.   Randomize;
  128.   FText := '';
  129.   FLastIndex := -1;
  130.   FFont := TFont.Create;
  131.   // try setup a default (windows) font
  132.   if FontCheck('Segoe UI') then
  133.     FFont.Name := 'Segoe UI'
  134.   else
  135.   if FontCheck('Tahoma') then
  136.     FFont.Name := 'Tahoma'
  137.   else
  138.   if FontCheck('MS Shell Dlg 2') then
  139.     FFont.Name := 'MS Shell Dlg 2';
  140.   FFont.Color := $010101;
  141.   FBackground := $FEFEFE;
  142.   FImageSet := isOrange;
  143.   BuildImageList;
  144.   ResetTempArray;
  145.   FImage := TPicture.Create;
  146.   LPNG := TPortableNetworkGraphic.Create;
  147.   try
  148.     LPNG.SetSize(0, 100);
  149.     LPNG.TransparentMode := tmFixed;
  150.     LPNG.TransparentColor := clDefault;
  151.     LPNG.Transparent := True;
  152.     FImage.Assign(LPNG);
  153.   finally
  154.     LPNG.Free;
  155.   end;
  156. end;
  157.  
  158. destructor TImageFont.Destroy;
  159. var
  160.   i, j: Integer;
  161. begin
  162.   FFont.Free;
  163.   FFont := nil;
  164.   FImage.Free;
  165.   FImage := nil;
  166.   for i := High(FImagePool) downto Low(FImagePool) do
  167.     for j := High(FImagePool[i]) downto Low(FImagePool[i]) do
  168.       begin
  169.         FImagePool[i][j].Free;
  170.         FImagePool[i][j] := nil;
  171.       end;
  172.   inherited Destroy;
  173. end;
  174.  
  175. function TImageFont.FontCheck(const AFontFaceName: WideString): Boolean;
  176. begin
  177.   Result := Screen.Fonts.IndexOf(AnsiString(AFontFaceName)) <> -1;
  178. end;
  179.  
  180. function TImageFont.BuildImageList: Boolean;
  181.   {$IfDef UseINC}
  182.   function ConstToBytes(const ABytes: array of byte): TBytes;
  183.   var
  184.     i: Integer;
  185.   begin
  186.     SetLength(Result, Length(ABytes));
  187.     for i := Low(ABytes) to High(ABytes) do
  188.       Result[i] := ABytes[i];
  189.   end;
  190.   {$EndIf UseINC}
  191. {$IfDef UseRC}
  192. const
  193.   Prefix = AnsiString('Font');
  194. {$EndIf UseRC}
  195. {$IfDef UseRES}
  196. const
  197.   Prefix = AnsiString('Font');
  198. {$EndIf UseRES}
  199. {$IfDef UseLaz}
  200. const
  201.   Prefix = AnsiString('Font');
  202. {$EndIf UseLaz}
  203. var
  204.   {$IfDef UseINC}
  205.   bytes: TBytes;
  206.   stream: TStream;
  207.   {$EndIf UseINC}
  208.   i, j: Integer;
  209. begin
  210.   SetLength(FImagePool, CImageSets);
  211.   for i := Low(FImagePool) to High(FImagePool) do
  212.     SetLength(FImagePool[i], CImageCount);
  213.   for i := Low(FImagePool) to High(FImagePool) do
  214.     for j := Low(FImagePool[i]) to High(FImagePool[i]) do
  215.       begin
  216.         FImagePool[i][j] := TPicture.Create;
  217.         {$IfDef UseINC}
  218.         case (i * 10) + j of
  219.           0: bytes := ConstToBytes(Font0);
  220.           1: bytes := ConstToBytes(Font1);
  221.           2: bytes := ConstToBytes(Font2);
  222.           3: bytes := ConstToBytes(Font3);
  223.           4: bytes := ConstToBytes(Font4);
  224.           5: bytes := ConstToBytes(Font5);
  225.           6: bytes := ConstToBytes(Font6);
  226.           7: bytes := ConstToBytes(Font7);
  227.           8: bytes := ConstToBytes(Font8);
  228.           9: bytes := ConstToBytes(Font9);
  229.         end;
  230.         stream := TBytesStream.Create(bytes);
  231.         try
  232.           stream.Position := 0;
  233.           FImagePool[i][j].LoadFromStream(stream);
  234.         finally
  235.           stream.Free;
  236.         end;
  237.         {$EndIf UseINC}
  238.         {$IfDef UseRC}
  239.         FImagePool[i][j].LoadFromResourceName(HInstance, Prefix + IntToStr((i * 10) + j));
  240.         {$EndIf UseRC}
  241.         {$IfDef UseRES}
  242.         FImagePool[i][j].LoadFromResourceName(HInstance, Prefix + IntToStr((i * 10) + j));
  243.         {$EndIf UseRES}
  244.         {$IfDef UseLaz}
  245.         FImagePool[i][j].LoadFromResourceName(HInstance, Prefix + IntToStr((i * 10) + j));
  246.         {$EndIf UseLaz}
  247.       end;
  248.   Result := (Length(FImagePool) > 0);
  249. end;
  250.  
  251. procedure TImageFont.ResetTempArray;
  252. var
  253.   i: Integer;
  254. begin
  255.   SetLength(FTempArray, CImageCount);
  256.   for i := Low(FTempArray) to High(FTempArray) do
  257.     FTempArray[i] := i;
  258. end;
  259.  
  260. procedure TImageFont.SetBackground(const AValue: TColor);
  261. begin
  262.   if AValue = FBackground then
  263.     Exit;
  264.   FBackground := AValue;
  265. end;
  266.  
  267. procedure TImageFont.SetFont(const AValue: TFont);
  268. begin
  269.   if AValue = FFont then
  270.     Exit;
  271.   if FontCheck(WideString(AValue.Name)) then
  272.     FFont.Assign(AValue);
  273. end;
  274.  
  275. procedure TImageFont.SetImageSet(const AValue: TImageSet);
  276. begin
  277.   if FImageSet = AValue then
  278.     Exit;
  279.   if Ord(AValue) > CImageSets then
  280.     Exit;
  281.   FImageSet := AValue;
  282. end;
  283.  
  284. function TImageFont.PickRandom: Integer;
  285. var
  286.   i: Integer;
  287. begin
  288.   if (Length(FTempArray) = 0) then
  289.     ResetTempArray;
  290.   i := Random(Length(FTempArray));
  291.   Result := FTempArray[i];
  292.   Delete(FTempArray, i, 1);
  293. end;
  294.  
  295. procedure TImageFont.ExactTextPixels(const AFont: TFont; const AText: string; const ABackground: TColor; out AImage: TBitmap);
  296.   function Max(const AValueA, AValueB: Integer): Integer; inline;
  297.   begin
  298.     if AValueA > AValueB then
  299.       Result := AValueA
  300.     else
  301.       Result := AValueB;
  302.   end;
  303.   function Min(const AValueA, AValueB: Integer): Integer; inline;
  304.   begin
  305.     if AValueA < AValueB then
  306.        Result := AValueA
  307.      else
  308.        Result := AValueB;
  309.   end;
  310. var
  311.   Bitmap: TBitmap;
  312.   PixelX, PixelY, // for the scanning
  313.   LeftX, RightX, TopY, BottomY, // store each direction to accurate output AWidth and AHeight
  314.   SizeX, SizeY: Integer; // initial bitmap size
  315.   LRect: TRect;
  316.   GotUpperCase: Boolean;
  317. begin
  318.   // Initialize the output values
  319.   LRect.Width := 0;
  320.   LRect.Height := 0;
  321.   LRect.Top := 0;
  322.   LRect.Left := 0;
  323.   LRect.Right := 0;
  324.   LRect.Bottom := 0;
  325.  
  326.   GotUpperCase := False;
  327.   for LeftX := Low(AText) to High(AText) do
  328.     if AText[LeftX] = UpperCase(AText[LeftX]) then
  329.       begin
  330.         GotUpperCase := True;
  331.         break;
  332.       end;
  333.  
  334.   // Create a bitmap and canvas
  335.   Bitmap := TBitmap.Create;
  336.   try
  337.     // Set the font for the canvas
  338.     Bitmap.Canvas.Font := AFont;
  339.     Bitmap.Canvas.Font.Size := 20;
  340.  
  341.     // Calculate the needed dimension and add more space for non-normal fonts or font styles
  342.     SizeX := Bitmap.Canvas.TextWidth(AText) * 3;
  343.     SizeY := Bitmap.Canvas.TextHeight(AText) * 3;
  344.     Bitmap.SetSize(SizeX, SizeY);
  345.  
  346.     // Clear the bitmap and draw the text onto the bitmap,
  347.     // ensure that we got 2 different colors to check for one of them
  348.     if ABackground <> clNone then
  349.       begin
  350.         Bitmap.Canvas.Brush.Color := ABackground;
  351.         Bitmap.Canvas.FillRect(Bitmap.Canvas.ClipRect);
  352.       end;
  353. //    Bitmap.Canvas.Font.Color := clBlack;
  354.     Bitmap.Canvas.TextOut(0, 0, AText);
  355.  
  356.     // Initialize scan variables in opposite manner to use Min() and Max() correct
  357.     LeftX := Bitmap.Width;
  358.     RightX := 0;
  359.     TopY := Bitmap.Height;
  360.     BottomY := 0;
  361.  
  362.     // Scan the bitmap from left to right
  363.     for PixelX := 0 to Pred(Bitmap.Width) do
  364.       for PixelY := 0 to Pred(Bitmap.Height) do
  365.         if Bitmap.Canvas.Pixels[PixelX, PixelY] <> ABackground then
  366.           LeftX := Min(LeftX, PixelX);
  367.  
  368.     // Scan the bitmap from right to left
  369.     for PixelX := Pred(Bitmap.Width) downto 0 do
  370.       for PixelY := 0 to Pred(Bitmap.Height) do
  371.         if Bitmap.Canvas.Pixels[PixelX, PixelY] <> ABackground then
  372.           RightX := Max(RightX, PixelX);
  373.  
  374.     // Scan the bitmap from top to bottom
  375.     for PixelY := 0 to Pred(Bitmap.Height) do
  376.       for PixelX := 0 to Pred(Bitmap.Width) do
  377.         if Bitmap.Canvas.Pixels[PixelX, PixelY] <> ABackground then
  378.           TopY := Min(TopY, PixelY);
  379.  
  380.     // Scan the bitmap from bottom to top
  381.     for PixelY := Pred(Bitmap.Height) downto 0 do
  382.       for PixelX := 0 to Pred(Bitmap.Width) do
  383.         if Bitmap.Canvas.Pixels[PixelX, PixelY] <> ABackground then
  384.           BottomY := Max(BottomY, PixelY);
  385.  
  386.     // Calculate the width and height based on the scan results
  387.     LRect.Top := TopY;
  388.     LRect.Left := LeftX;
  389.     LRect.Bottom := Succ(BottomY);
  390.     if GotUpperCase then
  391.       LRect.Right := Succ(RightX)
  392.     else
  393.       LRect.Right := RightX;
  394.     {%H-}AImage.SetSize(LRect.Width, LRect.Height);
  395.     AImage.Canvas.CopyMode := cmSrcCopy;
  396.     AImage.Canvas.CopyRect(AImage.Canvas.ClipRect, Bitmap.Canvas, LRect);
  397.  finally
  398.    Bitmap.Free;
  399.  end;
  400. end;
  401.  
  402. procedure TImageFont.AntiAliasedStretchDrawBitmap(SourceBitmap, DestBitmap: TCustomBitmap);
  403. var
  404.   DestIntfImage, SourceIntfImage: TLazIntfImage;
  405.   DestWidth, DestHeight: Integer;
  406.   DestCanvas: TLazCanvas;
  407. begin
  408.   DestWidth := DestBitmap.Width;
  409.   DestHeight := DestBitmap.Height;
  410.   DestIntfImage := TLazIntfImage.Create(0, 0);
  411.   try
  412.     DestIntfImage.LoadFromBitmap(DestBitmap.Handle, DestBitmap.MaskHandle);
  413.     DestCanvas := TLazCanvas.Create(DestIntfImage);
  414.     try
  415.       SourceIntfImage := SourceBitmap.CreateIntfImage;
  416.       try
  417.         DestCanvas.Interpolation := TFPBaseInterpolation.Create;
  418.         try
  419.           DestCanvas.StretchDraw(0, 0, DestWidth, DestHeight, SourceIntfImage);
  420.           DestBitmap.LoadFromIntfImage(DestIntfImage);
  421.         finally
  422.           DestCanvas.Interpolation.Free;
  423.         end;
  424.       finally
  425.         SourceIntfImage.Free;
  426.       end;
  427.     finally
  428.       DestCanvas.Free;
  429.     end;
  430.   finally
  431.     DestIntfImage.Free;
  432.   end;
  433. end;
  434.  
  435. procedure TImageFont.SetText(const AValue: WideString);
  436. var
  437.   LPNG: TPortableNetworkGraphic;
  438.   LOutput: TPortableNetworkGraphic;
  439.   LBMP: TBitmap;
  440.   LBMP2: TBitmap;
  441.   i, WidthCount: Integer;
  442. begin
  443.   if AValue = '' then
  444.     Exit;
  445.   FImage.Free;
  446.   FImage := TPicture.Create;
  447.   WidthCount := 0;
  448.   LPNG := TPortableNetworkGraphic.Create;
  449.   LOutput := TPortableNetworkGraphic.Create;
  450.   try
  451.     LOutput.TransparentMode := tmAuto;
  452.     LOutput.Transparent := True;
  453.     LPNG.Canvas.Font := FFont;
  454.     LBMP := TBitmap.Create;
  455.     try
  456.       LBMP.Canvas.Font := FFont;
  457.       for i := Low(AValue) to High(AValue) do
  458.         begin
  459.           ExactTextPixels(FFont, string(AValue[i]), $FEFEFE, LBMP);
  460.           LBMP2 := TBitmap.Create;
  461.           try
  462.             LBMP2.Width := CCanvasWidth;
  463.             LBMP2.Height := CCanvasHeight;
  464.             AntiAliasedStretchDrawBitmap(LBMP, LBMP2);
  465.             LPNG.Width := CImageWidth;
  466.             LPNG.Height := CImageHeight;
  467.             LPNG.TransparentMode := tmAuto;
  468.             LPNG.Transparent := True;
  469.             LPNG.Canvas.Brush.Color := FBackground;
  470.             LPNG.Canvas.Brush.Style := bsSolid;
  471.             LPNG.Canvas.FillRect(LPNG.Canvas.ClipRect);
  472.             LPNG.Canvas.Draw(0, 0, FImagePool[Ord(FImageSet)][PickRandom].Graphic);
  473.             LPNG.Canvas.CopyMode := cmSrcCopy;
  474.             LPNG.Canvas.CopyRect(Rect(CCanvasLeft, CCanvasTop, CCanvasWidth, CCanvasHeight),
  475.                                  LBMP2.Canvas,
  476.                                  LBMP2.Canvas.ClipRect);
  477.             Inc(WidthCount);
  478.             LOutput.SetSize(CImageWidth * WidthCount, CImageHeight);
  479.             LOutput.Canvas.Draw(CImageWidth * WidthCount - CImageWidth, 0, LPNG);
  480.           finally
  481.             LBMP2.Free;
  482.           end;
  483.         end;
  484.       FImage.Assign(LOutput);
  485.     finally
  486.       LBMP.Free;
  487.     end;
  488.   finally
  489.     LOutput.Free;
  490.     LPNG.Free;
  491.   end;
  492. end;
  493.  
  494. end.
« Last Edit: May 09, 2024, 05:03:00 am by KodeZwerg »
« Last Edit: Tomorrow at 31:76:97 xm by KodeZwerg »

TRon

  • Hero Member
  • *****
  • Posts: 2801
Re: splitting an image
« Reply #41 on: May 09, 2024, 05:57:02 am »
Why do I get this error?
Indeed as explained by KodeZwerg because you either do not have windres on your system and/or FPC is unable to locate the windres executable.

Windres is part of gnu binutils.

Precompiled version of those binutils (albeit a bit older version(s) but that does not matter) can be obtained from here (windres is included in the bin.tar archive(s) )

Alternatively FPC source-tree seem to contain windres as well, see here (select your corresponding directory matching your host/target).

Providing the option -FC"path_and_name_to_windres_executable" to FPC allows you to explicitly choose the resource compiler being used.

Also note that in the future FPC will be shipped with its own resource compiler (so that it does not depend on 'these' external tools anymore but we have to wait for 2 releases for it to becomes FPC standard).
« Last Edit: May 09, 2024, 06:04:16 am by TRon »

paweld

  • Hero Member
  • *****
  • Posts: 1061
Re: splitting an image
« Reply #42 on: May 09, 2024, 08:45:22 am »
You can stretch the final image, as @KodeZwerg wrote - but then you also have stretched letters, or you can scale each element before placing it on the final image.
As for the colors, if it's going to be a simple color change, you can do it by changing the hue, you don't need to put new graphics in the assets.
Modified sample in attachement.
Edit: added automatic font size
« Last Edit: May 09, 2024, 09:36:32 am by paweld »
Best regards / Pozdrawiam
paweld

KodeZwerg

  • Hero Member
  • *****
  • Posts: 2269
  • Fifty shades of code.
    • Delphi & FreePascal
Re: splitting an image
« Reply #43 on: May 09, 2024, 12:37:39 pm »
Edit: added automatic font size
Hey my friend, I've just tested yours, impressive speed and quality!
It has some bug in calculating the "perfect sized" font size as you can see on attached image but in general *thumbs up* !
« Last Edit: Tomorrow at 31:76:97 xm by KodeZwerg »

paweld

  • Hero Member
  • *****
  • Posts: 1061
Re: splitting an image
« Reply #44 on: May 09, 2024, 01:28:08 pm »
Thank you for pointing it out.
Actually there is a mistake here because I don't check the width of the character - I just set the height of the “tile” as FontHeight.
Best regards / Pozdrawiam
paweld

 

TinyPortal © 2005-2018