DGL
https://delphigl.com/forum/

Centre a bitmap font on the X axis...
https://delphigl.com/forum/viewtopic.php?f=19&t=6347		 Seite 1 von 1
Autor:  dpm_dpmartin [ So Feb 04, 2007 17:02 ]
Betreff des Beitrags:  Centre a bitmap font on the X axis...
So, I'm making progress on my Lyrics screen in OpenGL - it's still pretty poor overall, but things are coming along and I'm still trying to get the concept down correctly.

I'm displaying multiple layers of a background .JPG and scaling, translating and rotating them allowing them to blend nicely and provide a rather slow-moving (intentionally) calming background for Track Lyrics to be placed on top of. Here is an image of what it looks like...

Bild

I'm telling the text where to place itself using pixel coordinates... and the problem I'm having at the moment is how do I tell how wide (in pixels) the text string that I want to place on the screen is. The only way I could figure out was to go back to my normal Delphi graphics programming and use the Canvas of the main form, set up the font I think I'm using and then do a TextWidth on the string... but that is giving wrong results - as shown in the image above - possibly due to the fact that:

"Font.Size := FontSize;" and...

"Font := CreateFont (-FontSize,0,0,0,FW_BOLD,0,0,0,ANSI_CHARSET,OUT_TT_PRECIS,CLIP_DEFAULT_PRECIS,ANTIALIASED_QUALITY,FF_DONTCARE or DEFAULT_PITCH,FontFace);" are simply not the same thing.

The question then becomes... how it is possible to calculate the middle X position (in pixels) of an arbitrary string with bitmap fonts in OpenGL?

Here's the code so far, and the .zip can be downloaded from http://www.hmusiccentre.org.uk/download/Lyrics.zip if needed. Anyone who decides to provide input will notice the GetTextMiddleX inner function in my Draw procedure... that's where I'm trying to do this at the moment, but going wrong...

Code:
  1. unit Main;
  2.  
  3. interface
  4.  
  5. uses
  6.   OpenGL, Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  7.   StdCtrls, ExtCtrls, ComCtrls, Textures;
  8.  
  9. const
  10.   FontFace = 'Arial';
  11.   FontSize = 40;
  12.  
  13. type
  14.   TfrmMain = class(TForm)
  15.     Timer1 : TTimer;
  16.     procedure FormCreate (Sender : TObject);
  17.     procedure Timer1Timer (Sender : TObject);
  18.     procedure FormClose(Sender: TObject; var Action: TCloseAction);
  19.   private
  20.     procedure Draw;
  21.     procedure BuildFont;
  22.     procedure KillFont;
  23.     procedure ShadowText (X, Y : Integer; pText : String);
  24.   public
  25.   end;
  26.  
  27. var
  28.   frmMain : TfrmMain;
  29.   Background, Base : GLUInt;
  30.   Layers, ElapsedTime, DemoStart, YOffset : Integer;
  31.   R, G, B : array [0..15] of GLFloat;
  32.  
  33.  
  34. implementation
  35.  
  36.  
  37. {$R *.DFM}
  38. {$R BACKGROUND.RES}
  39.  
  40. procedure glBindTexture (Target : GLEnum; Texture : GLUInt); stdcall; external OpenGL32;
  41.  
  42.  
  43. procedure TfrmMain.BuildFont;
  44. var
  45.   Font, OldFont : HFont;
  46.   DC : HDC;
  47. begin
  48.   Base := glGenLists (96);
  49.   Font := CreateFont (-FontSize,0,0,0,FW_BOLD,0,0,0,ANSI_CHARSET,OUT_TT_PRECIS,CLIP_DEFAULT_PRECIS,ANTIALIASED_QUALITY,FF_DONTCARE or DEFAULT_PITCH,FontFace);
  50.  
  51.   DC := GetDC (Handle);
  52.   OldFont := SelectObject (DC,Font);
  53.  
  54.   wglUseFontBitmaps (DC,32,96,Base);
  55.   SelectObject (DC,OldFont);
  56.   DeleteObject (Font);
  57. end;
  58.  
  59.  
  60. procedure TfrmMain.ShadowText ( X, Y : Integer;
  61.                                 pText : String
  62.                               );
  63. begin
  64.   if (Text <> '') then
  65.   begin
  66.     glColor3f (0,0,0);
  67.     glRasterPos2i (X,Y);
  68.     glPushAttrib (GL_LIST_BIT);
  69.       glListBase (Base - 32);
  70.       glCallLists (Length (pText),GL_UNSIGNED_BYTE,PChar (pText));
  71.     glPopAttrib;
  72.  
  73.     glColor3f (1,1,1);
  74.     glRasterPos2i (X - 2,Y + 2);
  75.     glPushAttrib (GL_LIST_BIT);
  76.       glListBase (Base - 32);
  77.       glCallLists (Length (pText),GL_UNSIGNED_BYTE,PChar (pText));
  78.     glPopAttrib;
  79.   end;
  80. end;
  81.  
  82.  
  83. procedure TfrmMain.KillFont;
  84. begin
  85.   glDeleteLists (Base,96);
  86. end;
  87.  
  88.  
  89. procedure setupPixelFormat ( DC : HDC
  90.                            );
  91. const
  92.   PFD : TPIXELFORMATDESCRIPTOR = (
  93.         nSize : SizeOf (TPIXELFORMATDESCRIPTOR); nVersion : 1;
  94.         dwFlags : PFD_SUPPORT_OPENGL or PFD_DRAW_TO_WINDOW or PFD_DOUBLEBUFFER;
  95.         iPixelType : PFD_TYPE_RGBA;
  96.         cColorBits : 24; cRedBits : 0; cRedShift : 0; cGreenBits : 0;
  97.         cGreenShift : 0; cBlueBits : 0; cBlueShift : 0; cAlphaBits : 0;
  98.         cAlphaShift : 0; cAccumBits : 0; cAccumRedBits : 0; cAccumGreenBits : 0;
  99.         cAccumBlueBits : 0; cAccumAlphaBits : 0; cDepthBits : 16; cStencilBits : 0;
  100.         cAuxBuffers : 0; iLayerType : PFD_MAIN_PLANE; bReserved : 0; dwLayerMask : 0;
  101.         dwVisibleMask : 0; dwDamageMask : 0);
  102. var
  103.   PixelFormat : Integer;
  104. begin
  105.   PixelFormat := ChoosePixelFormat (DC,@PFD);
  106.   if (PixelFormat = 0) then
  107.   begin
  108.     Exit;
  109.   end;
  110.  
  111.   if (SetPixelFormat (DC,PixelFormat,@PFD) <> True) then
  112.   begin
  113.     Exit;
  114.   end;
  115. end;
  116.  
  117.  
  118. procedure TfrmMain.FormCreate ( Sender : TObject
  119.                               );
  120. var
  121.   DC : HDC;
  122.   RC : HGLRC;
  123.   I : Integer;
  124. begin
  125.   SetWindowLong (frmMain.Handle,GWL_STYLE,GetWindowLong (frmMain.Handle,GWL_STYLE) and not WS_CAPTION);
  126.   ShowWindow (frmMain.Handle,SW_SHOWMAXIMIZED);
  127.  
  128.   DemoStart := GetTickCount;
  129.   Layers := 5;
  130.   YOffset := 0;
  131.  
  132.   DC := GetDC (frmMain.Handle);
  133.   SetupPixelFormat (DC);
  134.   RC := wglCreateContext (DC);
  135.   wglMakeCurrent (DC,RC);
  136.  
  137.   BuildFont;
  138.  
  139.   glViewport (0,0,frmMain.Width,frmMain.Height);
  140.   glMatrixMode (GL_PROJECTION);
  141.   glLoadIdentity;
  142.   gluPerspective (45.0,frmMain.Width / frmMain.Height,1.0,100.0);
  143.   glMatrixMode (GL_MODELVIEW);
  144.   glLoadIdentity;
  145.  
  146.   glClearColor (0,0,0,0);
  147.   glShadeModel (GL_SMOOTH);
  148.   glBlendFunc (GL_SRC_ALPHA,GL_ONE);
  149.   glEnable (GL_BLEND);
  150.   glHint (GL_PERSPECTIVE_CORRECTION_HINT,GL_NICEST);
  151.  
  152.   glEnable (GL_TEXTURE_2D);
  153.   LoadTexture ('BACKGROUND.JPG',Background,True);
  154.  
  155.   for I := 0 to 15 do
  156.   begin
  157.     R[I] := 0.1 + 0.2 * Sin (I * PI / <!-- s8) --><img src=\"{SMILIES_PATH}/icon_cool.gif\" alt=\"8)\" title=\"Cool\" /><!-- s8) -->;
  158.     G[I] := 0.1 + 0.2 * Sin ((I + 5) * PI / <!-- s8) --><img src=\"{SMILIES_PATH}/icon_cool.gif\" alt=\"8)\" title=\"Cool\" /><!-- s8) -->;
  159.     B[I] := 0.1 + 0.2 * Sin ((I + 5)* PI / <!-- s8) --><img src=\"{SMILIES_PATH}/icon_cool.gif\" alt=\"8)\" title=\"Cool\" /><!-- s8) -->;
  160.   end;
  161. end;
  162.  
  163.  
  164. procedure TfrmMain.Draw;
  165. var
  166.   I, TWidth : Integer;
  167.   XSize, YSize, XPos, YPos, Angle, Temp : GLFloat;
  168.   CurrentLine : String;
  169.  
  170.   { Attempting to return the screen X centre position of this line of text. }
  171.  
  172.   function GetTextMiddleX ( pText : String
  173.                           ) : Integer;
  174.   var
  175.     TWidth : Integer;
  176.   begin
  177.     with frmMain.Canvas do
  178.     begin
  179.       Font.Name := FontFace;
  180.       Font.Size := FontSize;
  181.       Font.Style := Font.Style + [fsBold];
  182.       TWidth := TextWidth (pText);
  183.     end;
  184.     GetTextMiddleX := (frmMain.Width - TWidth) div 2;
  185.   end;
  186.  
  187. begin
  188.   glClear (GL_COLOR_BUFFER_BIT or GL_DEPTH_BUFFER_BIT);
  189.   glLoadIdentity;
  190.  
  191.   glTranslatef (0,0,-1);
  192.   glBindTexture (GL_TEXTURE_2D,Background);
  193.  
  194.   for I := 0 to Layers do
  195.   begin
  196.     Temp := (ElapsedTime / 96 + I * 2) / 200;
  197.     XSize := 1.0 + 0.5 * Cos (Temp * 30);
  198.     YSize := 1.0 + 0.5 * Cos (0.8 * Temp * 30);
  199.     Angle := 180.0 + 180.0 * Sin ((Temp - I) / 5);
  200.     XPos := 0.5 * Sin (Temp / 4);
  201.     YPos := 0.4 * Cos (Temp / 4);
  202.  
  203.     glPushMatrix;
  204.       glTranslatef (XPos,YPos,0);
  205.       glRotatef (Angle,0.0,0.0,1.0);
  206.       glScalef (1 + XSize,1 + YSize,0);
  207.       glColor3f (0,0,B[I]);
  208.       glBegin (GL_QUADS);
  209.         glTexCoord2f (0,0);
  210.         glVertex3f (-1,-1,0);
  211.         glTexCoord2f (1,0);
  212.         glVertex3f (1,-1,0);
  213.         glTexCoord2f (1,1);
  214.         glVertex3f (1,1,0);
  215.         glTexCoord2f (0,1);
  216.         glVertex3f (-1,1,0);
  217.       glEnd;
  218.     glPopMatrix;
  219.   end;
  220.  
  221.   glDisable (GL_TEXTURE_2D);
  222.   glDisable (GL_BLEND);
  223.  
  224.   glMatrixMode (GL_PROJECTION);
  225.   glLoadIdentity;
  226.   gluOrtho2D (0,frmMain.width,0,frmMain.height);
  227.  
  228.   CurrentLine := 'HMusicCentre Lyrics Line 1';
  229.   ShadowText (GetTextMiddleX (CurrentLine),YOffset,CurrentLine);
  230.   CurrentLine := 'HMusicCentre Lyrics Line 2';
  231.   ShadowText (GetTextMiddleX (CurrentLine),YOffset - 50,CurrentLine);
  232.   CurrentLine := 'HMusicCentre Lyrics Line 3 (ALT-F4)';
  233.   ShadowText (GetTextMiddleX (CurrentLine),YOffset - 100,CurrentLine);
  234.  
  235.   Inc (YOffset);
  236.   if (YOffset > frmMain.Height + 150) then
  237.   begin
  238.     YOffset := 0;
  239.   end;
  240.  
  241.   glViewport (0,0,frmMain.Width,frmMain.Height);
  242.   glMatrixMode (GL_PROJECTION);
  243.   glLoadIdentity;
  244.   gluPerspective (45.0,frmMain.Width / frmMain.Height,1.0,100.0);
  245.   glMatrixMode (GL_MODELVIEW);
  246.  
  247.   glEnable (GL_TEXTURE_2D);
  248.   glEnable (GL_BLEND);
  249.  
  250.   SwapBuffers (wglGetCurrentDC);
  251. end;
  252.  
  253.  
  254. procedure TfrmMain.Timer1Timer ( Sender : TObject
  255.                                );
  256. begin
  257.   ElapsedTime := (GetTickCount - DemoStart);
  258.   Draw;
  259. end;
  260.  
  261.  
  262. procedure TfrmMain.FormClose ( Sender : TObject;
  263.                                var Action : TCloseAction
  264.                              );
  265. begin
  266.   KillFont;
  267. end;
  268.  
  269.  
  270. end.
Autor:  i0n0s [ So Feb 04, 2007 19:12 ]
Betreff des Beitrags: 
Ever looked how VCL does this?
Code:
  1. GetTextExtentPoint32(FHandle, PChar(Text), Length(Text), Result);

So take a look at GetTextExtentPoint32 from MSDN.
Autor:  dpm_dpmartin [ So Feb 04, 2007 23:40 ]
Betreff des Beitrags:  Different answers...
Interesting, and frustrating.

I now have two functions to get the size of my text string... my sample string is 'HMusicCentre Lyrics Line 1' and the font I've set up is: "CreateFont (-FontSize,0,0,0,FW_BOLD,0,0,0,ANSI_CHARSET,OUT_TT_PRECIS,CLIP_DEFAULT_PRECIS,ANTIALIASED_QUALITY,FF_DONTCARE or DEFAULT_PITCH,FontFace);" with FontSize being "40" (or really "-40") and FontFace being "Arial".

With this function, I get an answer of the string being 179 pixels wide... and the mid-point being way to the right of where I would expect:
Code:
  1.  
  2. function GetTextMiddleX ( pText : String
  3.                         ) : Integer;
  4. var
  5.   Size : TSize;
  6.   DC : HDC;
  7. begin
  8.   DC := GetDC (frmMain.Handle);
  9.   GetTextExtentPoint32 (DC,PChar (pText),Length (pText),Size);
  10.   GetTextMiddleX := (frmMain.Width - Size.cx) div 2;
  11. end;
  12.  
With this function I get an answer of the string being 692 pixels wide... and the mid-point being way to the left of where I would expect:
Code:
  1.  
  2. function GetTextMiddleX ( pText : String
  3.                         ) : Integer;
  4. var
  5.   TWidth : Integer;
  6. begin
  7.   with frmMain.Canvas do
  8.   begin
  9.     Font.Name := FontFace;
  10.     Font.Size := FontSize;
  11.     Font.Style := Font.Style + [fsBold];
  12.     TWidth := TextWidth (pText);
  13.   end;
  14.   GetTextMiddleX := (frmMain.Width - TWidth) div 2;
  15. end;
  16.  
...and, get this, actually measuring the actual pixels by taking a screenshot and cropping the image just to the text, tells me that the real width of the string is actually 508 pixels. So when I perform code along the lines of ShadowText (254,YOffset,CurrentLine); it is then perfectly centred on my screen.

Am I doing everything right with the usage of GetTextExtentPoint32? Do I need to tell it anything about the font I want it to measure, or does it already know about my font, 'cos I'm using it? Am I doing the correct thing in getting the DC? Is there another means of returning the width of my string in pixels?
Autor:  dpm_dpmartin [ Mo Feb 05, 2007 00:22 ]
Betreff des Beitrags:  Progress... of sorts...
Further investigation has brought some progress, not that good, but progress nevertheless - I don't know how useful this is for me, but it does calculate a string width correctly, seemingly.

I added GLUT to my project, and I used the glutBitmapLength API to calculate the correct width of the string, but I could only select from a subset of fonts. I used GLUT_BITMAP_HELVETICA_18 and I changed my BuiltFont code so that it used -18 and Helvetica. Then, when using the following line, the string was output in the middle X of the screen...

ShadowText ((frmMain.Width - glutBitmapLength (8,PChar (CurrentLine))) div 2,YOffset,CurrentLine);

...but I'll admit, even though it worked OK for this, and also when I tried GLUT_BITMAP_TIMES_ROMAN_24 I'm not happy using GLUT or its apparent limitations on the fonts that I can use. I would still like another way to work properly if that is possible.

With Times New Roman, 24 - the three methods of calculating the string width are now returning:

1) GetTextExtentPoint32 = 179 pixels.
2) frmMain.Canvas, Font, TextWidth = 390 pixels.
3) GLUT glutBitmapLength = 281 pixels, which is almost spot on.

Bild

Some differences there, for sure.
Autor:  dpm_dpmartin [ Mo Feb 05, 2007 10:34 ]
Betreff des Beitrags:  Last hurdle, I think...
OK... something's wrong with my usage of the GetTextExtentPoint32, that's for sure. It returns a width of 179 pixels regardless of what font I'm actually using to draw on my OpenGL DC. I have some global constants at the top of my program which are passed into the BuildFont procedure... when I change the values between:

Code:
  1.  
  2. const
  3.   FontFace = 'Times New Roman';
  4.   FontSize = 24;
  5.  

Code:
  1.  
  2. const
  3.   FontFace = 'Helvetica';
  4.   FontSize = 18;
  5.  

Code:
  1.  
  2. const
  3.   FontFace = 'Arial';
  4.   FontSize = 40;
  5.  
...I always get 179 pixels from the following procedure:

Code:
  1.  
  2. function GetTextMiddleX ( pText : String
  3.                         ) : Integer;
  4. var
  5.   Size : TSize;
  6.   DC : HDC;
  7. begin
  8.   DC := GetDC (frmMain.Handle);
  9.   GetTextExtentPoint32 (DC,PChar (pText),Length (pText),Size);
  10.   GetTextMiddleX := (frmMain.Width - Size.cx) div 2;
  11. end;
  12.  
...would it be possible for anyone to point out to me how I should be properly using GetTextExtentPoint32 in my program, so that it actually knows what font I'm referring to?

For instance, should I have a single DC defined in the program, as a global variable? Can the GetTextExtentPoint32 API refer to another DC that will provide details of my font being used?
Autor:  dpm_dpmartin [ Mo Feb 05, 2007 10:56 ]
Betreff des Beitrags:  Success!
I've got it...

Code:
  1.  
  2. function GetTextMiddleX ( pText : String
  3.                         ) : Integer;
  4. var
  5.   Size : TSize;
  6.   DC : HDC;
  7. begin
  8.   DC := GetDC (frmMain.Handle);
  9.   SelectObject (DC,MyFont);
  10.   GetTextExtentPoint32 (DC,PChar (pText),Length (pText),Size);
  11.   GetTextMiddleX := (frmMain.Width - Size.cx) div 2;
  12. end;
  13.  
...at long last! Appears to work for any font, any size.
Autor:  Lossy eX [ Mo Feb 05, 2007 11:03 ]
Betreff des Beitrags: 
An other way to get your textwidth is the GetCharABCWidths function from the GDI. The right use should look like this.

Code:
  1.  
  2.   TfrmMain = class(TForm)
  3.     ...
  4.   private
  5.     fDC: HDC;
  6.     fRC: HGLRC;
  7.     fTextAbc: array[32..128] of TABC;
  8.     ...
  9.   end;
  10.  
  11.  
  12. procedure TfrmMain.BuildFont;
  13. var
  14.   Font, OldFont : HFont;
  15. begin
  16.   Base := glGenLists (96);
  17.  
  18.   Font := CreateFont (-FontSize, 0, 0, 0, FW_BOLD, 0, 0, 0, ANSI_CHARSET, OUT_DEFAULT_PRECIS, CLIP_DEFAULT_PRECIS, DEFAULT_QUALITY, DEFAULT_PITCH, FontFace);
  19.  
  20.   OldFont := SelectObject (fDC, Font);
  21.  
  22.   wglUseFontBitmaps (fDC, 32, 96, Base);
  23.  
  24.   GetCharABCWidths(fDC, 32, 128, fTextAbc[32]);   // here
  25.  
  26.   SelectObject (fDC, OldFont);
  27.   DeleteObject (Font);
  28. end;
  29.  
  30.  
  31.  
  32.   function GetTextMiddleX ( pText : String
  33.                           ) : Integer;
  34.   var
  35.     TWidth : Cardinal;
  36.     Idx: Integer;
  37.   begin
  38.     TWidth := 0;
  39.  
  40.     for Idx := 1 to Length(pText) do
  41.       with fTextAbc[Ord(pText[Idx])] do       // caution: no range checking
  42.         TWidth := TWidth + abcA + abcB + abcC;
  43.  
  44.     GetTextMiddleX := (frmMain.ClientWidth - TWidth) div 2;
  45.   end;


And i have some other suggestions for you.
- You should use one global fDC and fRC member of your class. The Global DC should only once initialied with GetDC. So you can destroy your context if you dont needit anymore. And DCs you created with GetDC you allways should release with ReleaseDC.
Code:
  1. procedure TfrmMain.FormClose ( Sender : TObject;
  2.                                var Action : TCloseAction
  3.                              );
  4. begin
  5.   KillFont;
  6.  
  7.   wglMakeCurrent(0, 0);
  8.   wglDeleteContext(fRC);
  9.   ReleaseDC(Handle, fDC);
  10. end;


- You should order your draw function. I think its better when you set your set you perspective if you need it. Let me explain what i mean. You work like this.
// render perpective objects
// set orthomode
// render ortho objects
// set perspective

Yes it works but its better to understand if you work like this.
// set perspective
// render perpective objects
// set orthomode
// render ortho objects
In this case you dosnt need to set the perspective after you created the RC. In the first case you must set the perspective first.

- Last but not least. You should really use our OpenGL Header. The standard header from borland is really old and contains some from functions. glColor should has the Name glColor3f or some else.

PS: To your last post. If you want to use GetTextExtentPoint32 you must select the Font to the DC. Each DC has its own Fonts. But all points to the same window. Its confuse. But i dont know if GetTextExtentPoint32 could make some Problems. Because some fonts supports kerning (overlapping charcombinations). But if you created the chars with wglUseFontBitmaps the kerning couldnt be used. And with GetTextExtentPoint32 the kering will be applyed so the widthes will not be the same.
Autor:  Lossy eX [ Mo Feb 05, 2007 11:07 ]
Betreff des Beitrags: 
You are to fast or im to slow. ;)

But your last code. You should be careful. Every call you created an DC but you never release them. Sometimes you wont get an DC and maybe you memory will be full. Call ReleaseDC to release an DC. I have written it above but its importat so i write it again. ;)

And GetTextExtentPoint32 could have some problems. Also from above. But i think on centered text it shouldnt be visible.
Autor:  dpm_dpmartin [ Mo Feb 05, 2007 11:19 ]
Betreff des Beitrags:  Good feedback...
Cool. I have now added ReleaseDC where necessary; thanks. I will review your other post in more detail. I will also look into using the header you mention... I am a little bit in the dark about it all to be honest as I'm, quite obviously, just starting out with all this stuff.
Seite 1 von 1 Alle Zeiten sind UTC + 1 Stunde
Powered by phpBB® Forum Software © phpBB Group
https://www.phpbb.com/