Delphi-PRAXiS

Delphi-PRAXiS (https://www.delphipraxis.net/forum.php)
-   Multimedia (https://www.delphipraxis.net/16-multimedia/)
-   -   Delphi Font erstellen Laden mit Open GL , aber wie ? (https://www.delphipraxis.net/69597-font-erstellen-laden-mit-open-gl-aber-wie.html)

Corpsman 17. Mai 2006 16:02


Font erstellen Laden mit Open GL , aber wie ?
 
Liste der Anhänge anzeigen (Anzahl: 2)
Hi , Ich versuche gerade eine Klasse zu bauen die mir eine Font aus einer Datei lädt und diese dann via Opengl auf den Monitor ausgibt.

Dazu habe ich die unten augeführte Unit gebastelt.

Das Laden des Bitmap's klappt und der Rechner malt mir auch was auf den Monitor,
Allerdings sieht das alles andere als Richtig aus.

Das einzige was ich erkennen kann ist das die Anzahl der Buchstaben stimmt.

Mein Versuch ist heir einen Buchstaben 20 x 20 Pixel groß zu laden. Nur leider klappt das nicht.
nach nun über 6 h rumprobieren hab ich keine Idee mehr was ich noch bauen könnte.

Falls jemand eine Functionierende version hat die functioniert würde ich die auch nehmen.
Alles was ich gerade versuceh ist einen Text auf den OpenGL monitor aus zu geben.

Delphi-Quellcode:
Unit OpenGL_Font;

Interface

Uses
  glu,
  gl,
  glext, textures;

Type
  TOpenGLFont = Class
    mFontTexId: GLuint;
    mBaseListId: gluint;
    fbase: gluint;
    Procedure Go2d;
    Procedure exit2d;
  private
  public
    Constructor create();
    Procedure Textout(x, y: integer; fmt: String);
    Destructor destroy; override;
  End;

Implementation

Const
  NUMCHARS = 256;

Constructor TOpenGLFont.create();
Const
  bh = 20; // Height of one Letter
  bw = 20; // Width of one Letter
Var
  cx, cy: single;
  loop: integer;
Begin
  Inherited Create;
  LoadTexture('D:\Tools\Projects\Balanced\Pic400_400N.bmp', mFontTexId);
  mBaseListId := glGenLists(NUMCHARS); // Creating NUMCHARS Display Lists
  glBindTexture(GL_TEXTURE_2D, mFontTexId);
  For loop := 0 To numchars - 1 Do Begin
    cx := (loop Mod bw) / bw; // X Position Of Current Character
    cy := (loop / bh) / bh; // Y Position Of Current Character
    glNewList(mBaseListId + loop, GL_COMPILE); // Start Building A List
    glBegin(GL_QUADS); // Use A Quad For Each Character
    glTexCoord2f(cx, 1 - cy - (1 / bh)); // Texture Coord (Bottom Left)
    glVertex2i(0, 0); // Vertex Coord (Bottom Left)
    glTexCoord2f(cx + (1 / bw), 1 - cy - (1 / bh)); // Texture Coord (Bottom Right)
    glVertex2i(bw, 0); // Vertex Coord (Bottom Right)
    glTexCoord2f(cx + (1 / bw), 1 - cy); // Texture Coord (Top Right)
    glVertex2i(bw, bh); // Vertex Coord (Top Right)
    glTexCoord2f(cx, 1 - cy); // Texture Coord (Top Left)
    glVertex2i(0, bh); // Vertex Coord (Top Left)
    glEnd(); // Done Building Our Quad (Character)
    glTranslatef(bw, 0, 0); // Move To The Right Of The Character
    glEndList(); // Done Building The Display List
  End;
End;

Destructor TOpenGLFont.destroy;
Begin
  glDeleteLists(mBaseListId, NUMCHARS); // Delete All Display Lists
  //  Inherited destroy; // Brauchen wir net machen da wir von TObject abgeleitet haben
End;

Procedure TOpenGLFont.Go2d();
Begin
  glMatrixMode(GL_PROJECTION);
  glPushMatrix(); // Store The Projection Matrix
  glLoadIdentity(); // Reset The Projection Matrix
  glOrtho(0, 640, 0, 480, -1, 1); // Set Up An Ortho Screen
  glMatrixMode(GL_MODELVIEW);
  glPushMatrix(); // Store old Modelview Matrix
  glLoadIdentity(); // Reset The Modelview Matrix
End;

Procedure TOpenGLFont.Exit2d();
Begin
  glMatrixMode(GL_PROJECTION);
  glPopMatrix(); // Restore old Projection Matrix
  glMatrixMode(GL_MODELVIEW);
  glPopMatrix(); // Restore old Projection Matrix
End;

Procedure TOpenGLFont.Textout(x, y: integer; fmt: String);
Begin
  glEnable(GL_TEXTURE_2D);
  glBindTexture(GL_TEXTURE_2D, mFontTexId);
  glDisable(GL_DEPTH_TEST);
  glEnable(GL_BLEND); // For transparent background
  glBlendFunc(GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA);
  Go2d();
  glTranslated(x, y, 0);
  glListBase(mBaseListId - 32); // Font bitmaps starts at ' ' (space/32).
  glcolor3f(1, 0, 0);
  glCallLists(length(fmt), GL_BYTE, pchar(fmt)); // Write The Text To The Screen
  Exit2d();
  glDisable(GL_BLEND);
  glEnable(GL_DEPTH_TEST);
End;

End.

Corpsman 17. Mai 2006 16:12

Re: Font erstellen Laden mit Open GL , aber wie ?
 
Liste der Anhänge anzeigen (Anzahl: 1)
Habe grad mal noch nen Screenshot vom ganzen Alphabet gemacht.

Oben klein abc ..z
unden Groß ABC ..Z

Corpsman 18. Mai 2006 18:46

Re: Font erstellen Laden mit Open GL , aber wie ?
 
Ich finde es ja Schade das mir keiner Helfen konnte,

zum Glück habe ich den Fehler Gefunden.

Es Lag an der Berechnung der cx und cy.

Für alle die diesen Post finden weil sie das gleiche Problem haben, habe ich mein nun Fertiges Werk unter

OpenGL font

bereitgestellt.

Corpsman 4. Mai 2007 11:45

Re: Font erstellen Laden mit Open GL , aber wie ?
 
Also wen ein Moderatpor das liest !!

ich habe den Post ur gemacht weil der Oben genannte Link nicht mehr geht.

Hier ist der Neue für die BMP fonts

und Hier der Neue für die TFonts in OpenGL

turboPASCAL 26. Mai 2007 07:52

Re: Font erstellen Laden mit Open GL , aber wie ?
 
Delphi-Quellcode:
{******************************************************************************}
{    FontGen Unit - Create a Font from any Windowsfont                       }
{               __                                                             }
{   ...by     / /_____                                                        }
{            / __/ __ \                                                        }
{           / /_/ /_/ /                                                        }
{          \__/  ___/                                                          }
{            /_/                                                               }
{                                                                              }
{*********************************[ 14.07.2006 ]*******************************}

///// Sample: //////////////////////////////////////////////////////////////////
//
//  var
//    AnyFontMap: TFontMap; // Base Display List For The Font Set
//
//  BEGIN
//    BuildFont(DC, 'Arial', AnyFontMap, -14, [fsBold]);
//    ...
//    glGoto2D;
//    glPrintXY(10, 20, 'Sample', AnyFontMap);
//    glExit2D;
//    ...
//    glPrint3D(10,-10,10, 'Hallo', AnyFontMap);
//    ...
//    KillFont(AnyFontMap);
//  END.
//

unit FontGen;

interface

uses
  Windows, OpenGL;

  const
    GenListsCount = 256;

  type
    TFontMap = Record
                 Map: GLuint;
                 CharWidth: array [0..GenListsCount-1] of Integer;
                 CharHight: Integer;
               end;

    TGLFontStyle = (fsBold, fsItalic, fsUnderline, fsStrikeOut);
    TGLFontStyles = set of TGLFontStyle;

  procedure glCreateFont(DC: HDC; const FontName: string; var FontMap: TFontMap;
    const Size: Integer = 8; FontStyle: TGLFontStyles = []);
  procedure glKillFont(FontMap: TFontMap);
  procedure glPrint3D(X,Y, Z: Single; Text: String; FontMap: TFontMap);
  procedure glPrintXY(X,Y: Single; Text: String; FontMap: TFontMap); overload;
  procedure glPrintXY(X,Y: Single; Text: PChar; FontMap: TFontMap); overload;
  procedure glPrint(text: PChar; FontMap: TFontMap);
  function glGetTextLength(Text: String; FontMap: TFontMap): integer;

implementation

function TextExtent(DC: HDC; X: Char): TSize;
begin
  GetTextExtentPoint(DC, @X, 1, Result);
end;

procedure glCreateFont(DC: HDC; const FontName: string; var FontMap: TFontMap;
    const Size: Integer = 8; FontStyle: TGLFontStyles = []);
var
  font, oldfont: HFONT;
  nBold, n: Integer;

  function isTrue(Value: TGLFontStyle): Byte;
  begin
    if Value in FontStyle then Result := 1 else Result := 0;
  end;

begin
  if fsBold in FontStyle then nBold := FW_BOLD else nBold := FW_NORMAL;

  FontMap.Map := glGenLists(GenListsCount);        // Storage For X Characters
  font := CreateFont(-MulDiv(Size, GetDeviceCaps(DC, LOGPIXELSY), 72), // Height Of Font
           0,                          // Width Of Font
           0,              // Angle Of Escapement
           0,              // Orientation Angle
           nBold,                // Font Weight
           isTrue(fsItalic),           // Italic
           isTrue(fsUnderline),        // Underline
           isTrue(fsStrikeOut),        // Strikeout
           ANSI_CHARSET,        // Character Set Identifier
           OUT_TT_PRECIS,             // Output Precision
           CLIP_DEFAULT_PRECIS,     // Clipping Precision
           ANTIALIASED_QUALITY,        // Output Quality
           FF_DONTCARE or DEFAULT_PITCH,// Family And Pitch
           PChar(FontName));        // Font Name

  oldfont := SelectObject(DC, font);        // Selects The previous font
  wglUseFontBitmaps(DC, 0, GenListsCount-1, FontMap.Map); // Builds X Characters Starting At Character 32

  for n := 0 to GenListsCount-1 do
    FontMap.CharWidth[n] := TextExtent(DC, Chr(n)).cx;
  FontMap.CharHight := TextExtent(DC, 'X').cy;

  SelectObject(DC, oldfont);                   // Put back the old font
  DeleteObject(font);                            // Delete the font we just created
end;                                             //   (we already have it in the Display list)

procedure glKillFont(FontMap: TFontMap);     // Delete The Font
begin
  glDeleteLists(FontMap.Map, GenListsCount);     // Delete the X Characters
end;

procedure glPrint3D(X, Y, Z: Single; Text: String; FontMap: TFontMap);
begin
  glPushMatrix;
  glDisable(GL_LIGHTING);
  glDisable(GL_TEXTURE_2D);
  glRasterPos3d(X, Y, Z);
  glPrint(PChar(Text), FontMap);
  glEnable(GL_TEXTURE_2D);
  glEnable(GL_LIGHTING);
  glPopMatrix;
end;

procedure glPrintXY(X,Y: Single; Text: String; FontMap: TFontMap); overload;
begin
  glRasterPos2f(X, Y);                           //This function is to position the text!!!
  glPrint(PChar(Text), FontMap);
end;

procedure glPrintXY(X,Y: Single; Text: PChar; FontMap: TFontMap); overload;
begin
  glRasterPos2f(X, Y);                           //This function is to position the text!!!
  glPrint(Text, FontMap);
end;

procedure glPrint(text : pchar; FontMap: TFontMap); // Custom GL "Print" Routine
begin
  if (text = '') then             // If There's No Text
    Exit;                 // just exit

  glPushAttrib(GL_LIST_BIT);           // Pushes The Display List Bits
  glListBase(FontMap.Map);           // Sets The Base Character

  glCallLists(length(text), GL_UNSIGNED_BYTE, text); // Draws The Display List Text
  glPopAttrib();              // Pops The Display List Bits
end;

function glGetTextLength(Text: String; FontMap: TFontMap): integer;
var i, w: Integer;
begin
  w := 0;
  for i := 1 to length(Text) do
    w := w + FontMap.CharWidth[ord(Text[i])];
  Result := w;
end;

end.
Auch eine Möglichkeit. :mrgreen:


Alle Zeitangaben in WEZ +1. Es ist jetzt 02:03 Uhr.

Powered by vBulletin® Copyright ©2000 - 2024, Jelsoft Enterprises Ltd.
LinkBacks Enabled by vBSEO © 2011, Crawlability, Inc.
Delphi-PRAXiS (c) 2002 - 2023 by Daniel R. Wolf, 2024 by Thomas Breitkreuz