AGB  ·  Datenschutz  ·  Impressum  







Anmelden
Nützliche Links
Registrieren
Zurück Delphi-PRAXiS Programmierung allgemein Multimedia Delphi Font erstellen Laden mit Open GL , aber wie ?
Thema durchsuchen
Ansicht
Themen-Optionen

Font erstellen Laden mit Open GL , aber wie ?

Ein Thema von Corpsman · begonnen am 17. Mai 2006 · letzter Beitrag vom 26. Mai 2007
Antwort Antwort
Benutzerbild von turboPASCAL
turboPASCAL

Registriert seit: 8. Mai 2005
Ort: Sondershausen
4.274 Beiträge
 
Delphi 6 Personal
 
#1

Re: Font erstellen Laden mit Open GL , aber wie ?

  Alt 26. Mai 2007, 07:52
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.
Matti
Meine Software-Projekte - Homepage - Grüße vom Rüsselmops -Mops Mopser
  Mit Zitat antworten Zitat
Antwort Antwort


Forumregeln

Es ist dir nicht erlaubt, neue Themen zu verfassen.
Es ist dir nicht erlaubt, auf Beiträge zu antworten.
Es ist dir nicht erlaubt, Anhänge hochzuladen.
Es ist dir nicht erlaubt, deine Beiträge zu bearbeiten.

BB-Code ist an.
Smileys sind an.
[IMG] Code ist an.
HTML-Code ist aus.
Trackbacks are an
Pingbacks are an
Refbacks are aus

Gehe zu:

Impressum · AGB · Datenschutz · Nach oben
Alle Zeitangaben in WEZ +1. Es ist jetzt 15:25 Uhr.
Powered by vBulletin® Copyright ©2000 - 2025, Jelsoft Enterprises Ltd.
LinkBacks Enabled by vBSEO © 2011, Crawlability, Inc.
Delphi-PRAXiS (c) 2002 - 2023 by Daniel R. Wolf, 2024-2025 by Thomas Breitkreuz