Recent

Author Topic: Is it possible to Canvas.Textout and Render is scaled (stretch==true)?  (Read 1406 times)

ozznixon

  • Full Member
  • ***
  • Posts: 119
    • http://www.modernpascal.com/
I am working on a project where I need to render 5 to 8 telnet sessions like little "view screens". I have all of the code ready... but, it does not work. Could someone help (explain the mistake and makes a working example?).


Basically, I create a TImage (640x480) scaled down to div 4, click a toolbar button and mimic a session. In that event, I do:


[/code]
Code: Pascal  [Select][+][-]
  1.  
  2. var
  3.   w, h: Integer;
  4. begin
  5.   if ssLeft in Shift then
  6.   begin
  7.     ReleaseCapture;
  8.     Perform(WM_SysCommand, $F012, 0);
  9.   end;
  10.   Image1.Canvas.Brush.Color:=clBlack;
  11.   Image1.Canvas.Font.Color:=clYellow;
  12.   Image1.Canvas.Font.Size := 12;
  13.   h := Image1.Canvas.Font.Height; // in pixels
  14.   Image1.Canvas.TextOut(0, 20 + h, 'Superior');
  15.   w := Image1.Canvas.TextWidth('Big')+12;
  16.   Image1.Canvas.Font.Color:=clLime;
  17.   Image1.Canvas.Font.Size := 6;
  18.   h := Image1.Canvas.Font.Height; // in pixels
  19.   //Image1.Canvas.Font.Style := Image1.Canvas.Font.Style + [fsBold];
  20.   Image1.Canvas.TextOut(W, 20 + h, 'Bulletin Board Software');
  21.  


The flaw is, it is rendering at 12, and 6 pixels respectively - on the small TImage. Instead of running the code, and rendering scaled. * Or am I using the wrong Component/Canvas?


Thanks!
Ozz
---
Want to kick the tires to a Free Pascal like script engine? http://www.ModernPascal.com/

KodeZwerg

  • Hero Member
  • *****
  • Posts: 2007
  • Fifty shades of code.
    • Delphi & FreePascal
Re: Is it possible to Canvas.Textout and Render is scaled (stretch==true)?
« Reply #1 on: February 15, 2023, 08:49:03 pm »
I do not fully understand yet what you try to do.
In most cases I do use a TBitmap (or similar) and draw on that what I want and when done I copy it to a TImage.
If you can show on an Image what you want to have when done, it would simplify to help you.
« Last Edit: Tomorrow at 31:76:97 xm by KodeZwerg »

ozznixon

  • Full Member
  • ***
  • Posts: 119
    • http://www.modernpascal.com/
Re: Is it possible to Canvas.Textout and Render is scaled (stretch==true)?
« Reply #2 on: February 17, 2023, 01:48:09 am »
Okay Screenshot 1 - is what I am getting with the code in my first post. (I will fix the overlap later)...


Screenshot 2 - is what I am trying to achieve. I was able to produce screenshot 2, by doing everything in screenshot 1 - at 640x480, then added a new button that changes the size to "div 4" - to get what I am trying to produce. (Which makes me think I need to do some type of Double Buffering, or Offscreen Paint, Copy, Paste to the scaled one? - And avoid flickering, as this will run all day).







---
Want to kick the tires to a Free Pascal like script engine? http://www.ModernPascal.com/

Thaddy

  • Hero Member
  • *****
  • Posts: 14205
  • Probably until I exterminate Putin.
Re: Is it possible to Canvas.Textout and Render is scaled (stretch==true)?
« Reply #3 on: February 17, 2023, 11:10:04 am »
What you want to achieve needs the font to be scaled in pixels, not points. That means the font needs to have a negative value (pixels) instead of points (positive value). That is the ONLY way to be accurate.
Formula's are like this:
(Given LOGFONT structure on Windows)
Code: [Select]
lfHeight := -MulDiv(PointSize, GetDeviceCaps(hDC, LOGPIXELSY), 72); // pixels
PointSize := MulDiv(-lfHeight, 72, GetDeviceCaps(hDC, LogPixelsY);// points
But note that for high resolution screens you should call GetDeviceCaps first. The above formulae are for Windows only, but may be Lazarus supports it cross-platform.
Specialize a type, not a var.

KodeZwerg

  • Hero Member
  • *****
  • Posts: 2007
  • Fifty shades of code.
    • Delphi & FreePascal
Re: Is it possible to Canvas.Textout and Render is scaled (stretch==true)?
« Reply #4 on: February 17, 2023, 11:45:20 am »
Thats how I calculate the Size field of font.
Code: Pascal  [Select][+][-]
  1. Round((Abs(GetFontData(AFont.Handle).Height) * 72 / AFont.PixelsPerInch));
While AFont is a TFont, crossplatform.
« Last Edit: Tomorrow at 31:76:97 xm by KodeZwerg »

ozznixon

  • Full Member
  • ***
  • Posts: 119
    • http://www.modernpascal.com/
Re: Is it possible to Canvas.Textout and Render is scaled (stretch==true)?
« Reply #5 on: February 17, 2023, 10:43:11 pm »
Thank you both, however, trying negative canvas.font.size - just resulted in my original output. e.g. Small Image, big Text.


From what I have found via other posts - is to create a TImage.Visible:=False - Put my text on it, the BitBlt to a visible TImage2.Stretch:=True, and DoubleBuffers:=True.


If I get this way to work, I will contribute the code for anyone else to see/use.
Ozz
---
Want to kick the tires to a Free Pascal like script engine? http://www.ModernPascal.com/

KodeZwerg

  • Hero Member
  • *****
  • Posts: 2007
  • Fifty shades of code.
    • Delphi & FreePascal
Re: Is it possible to Canvas.Textout and Render is scaled (stretch==true)?
« Reply #6 on: February 17, 2023, 11:36:19 pm »
Since I was not able to watch at your image (all i see is a small black something at topleft corner) I try to show you how I would do.
Maybe thats a starting point for you.
Code: Pascal  [Select][+][-]
  1. procedure TForm1.Button1Click(Sender: TObject);
  2. var
  3.   LBmp: TBitmap;
  4.   h: Integer;
  5. begin
  6.   LBmp := TBitmap.Create;
  7.   try
  8.     LBmp.Width := Image1.Width;
  9.     LBmp.Height := Image1.Height;
  10.     LBmp.Canvas.Brush.Color := clBlack;
  11.     LBmp.Canvas.FillRect(0, 0, LBmp.Width, LBmp.Height);
  12.     LBmp.Canvas.Font := Application.MainForm.Font;
  13.     LBmp.Canvas.Font.Size := 12;
  14.     LBmp.Canvas.Font.Color := clYellow;
  15.     LBmp.Canvas.TextOut(0, 20, 'Superior');
  16.     h := LBmp.Canvas.TextHeight('Superior') + 20;
  17.     LBmp.Canvas.Font.Size := 6;
  18.     LBmp.Canvas.Font.Color := clLime;
  19.     LBmp.Canvas.TextOut(0, h, 'Bulletin Board Software');
  20.     Image1.Picture.Assign(LBmp);
  21.   finally
  22.     LBmp.Free;
  23.   end;
  24. end;
« Last Edit: February 18, 2023, 12:10:58 am by KodeZwerg »
« Last Edit: Tomorrow at 31:76:97 xm by KodeZwerg »

 

TinyPortal © 2005-2018