OpenGL实现中文显示

OpenGL实现中文显示       上次我发了个帖子，名为《OpenGL实现中文显示》。有朋友说使用 wglUseFontBitMapsW 函数就可以显示中文，由于考虑兼容问题，所以没有在原文给出实现方法。后来觉得使用 Window9X/Me 的人越来越少，所以决定改进一下原来的代码，以便支持 Unicode 编码。修改后的代码如下： unit Unit2; interface uses   Windows, Messages, SysUtils, Variants, Graphics, GL, GLu, GLext; Type   PGLFont = ^TGLFont;   TGLFont = record     b3D     : Boolean;    //三维字体？     bBold   : Boolean;    //粗体？     bItalic : Boolean;    //斜体？     Height  : Integer;     Weight  : Integer;     CharSet : Cardinal;   //字符集     Typeface: PChar;      //字体   end;   TGLText = class   private     bUniCode   : Boolean; //OS支持Unicode吗?     GLStrEng   : PChar;   //英文字串     GLStrChn   : PChar;   //中文字串     procedure Build(srcDC: HDC; glStr: PChar; glFont: PGLFont);     procedure GetWinVer;     procedure wglUseFontBitmapsExt(srcDC : HDC; First, Count, ListBase : DWORD);   public     constructor Create(srcDC : HDC; EngStr, ChnStr : PChar;                        EngFont, ChnFont : PGLFont);     destructor Destroy; override;     procedure glShowStr(glStr : PChar);   end; implementation { TGLText } procedure TGLText.Build(srcDC: HDC; glStr: PChar; glFont: PGLFont); var   i,   Chartmp     : Byte;   CharW       : PWideChar;   Font, oFont : HFONT;   glBold      : Integer;   glItalic    : Cardinal;   dwChar      : DWORD;   gmf         : GLYPHMETRICSFLOAT; begin   if glFont.bBold then     glBold := FW_BOLD   else     glBold := FW_NORMAL;   if glFont.bItalic then     glItalic := 1   else     glItalic := 0;   Font := CreateFont(glFont.Height, glFont.Weight, 0, 0, glBold, glItalic,                      0, 0, glFont.CharSet, OUT_TT_PRECIS,                      CLIP_DEFAULT_PRECIS, ANTIALIASED_QUALITY,                      FF_DONTCARE or DEFAULT_PITCH,                      glFont.Typeface);   oFont := SelectObject(srcDC, Font);   if glStr = 'All English' then   begin     if bUniCode then       if glFont.b3D then         wglUseFontOutLinesW(srcDC, 32, 125, 32, 0, 0, WGL_FONT_POLYGONS, @gmf)       else         wglUseFontBitMapsW(srcDC, 32, 125, 32)     else       if glFont.b3D then         wglUseFontOutLines(srcDC, 32, 125, 32, 0, 0, WGL_FONT_POLYGONS, @gmf)       else         wglUseFontBitMaps(srcDC, 32, 125, 32);   end   else   begin     i := 0;     While i < Length(glStr) do     begin       if bUniCode then       begin         GetMem(CharW, (Length(glStr) + 1) * 2);         StringToWideChar(glStr, CharW, Length(glStr) + 1);         dwChar := Word(CharW);         if glFont.b3D then           wglUseFontOutLinesW(srcDC, dwChar, 1, dwChar, 0, 0,                              WGL_FONT_POLYGONS, @gmf)         else           wglUseFontBitMapsW(srcDC, dwChar, 1, dwChar);         FreeMem(CharW, (Length(glStr) + 1) * 2);         i := i + 1;       end       else       begin         Chartmp := Byte(glStr);         if glStr in LeadBytes  then         begin           dwChar := ((Chartmp shl 8) or Byte(glStr[i+1]));           i := i + 2;         end         else         begin           dwChar := Chartmp;           i := i + 1;         end;         if glFont.b3D then           wglUseFontOutLines(srcDC, dwChar, 1, dwChar, 0, 0,                              WGL_FONT_POLYGONS, @gmf)         else           wglUseFontBitMapsExt(srcDC, dwChar, 1, dwChar);       end;     end;   end;   SelectObject(srcDC, oFont);   DeleteObject(Font); end; constructor TGLText.Create(srcDC : HDC; EngStr, ChnStr: PChar;                            EngFont, ChnFont: PGLFont); begin   GetWinVer;   GLStrEng := EngStr;   GLStrChn := ChnStr;   if EngStr  nil then       Build(srcDC, EngStr, EngFont);   if ChnStr  nil then       Build(srcDC, ChnStr, ChnFont); end; destructor TGLText.Destroy; var   i,   Chartmp : Byte;   CharW   : PWideChar;   dwChar  : DWORD; begin   if GLStrEng  nil then     if GLStrEng = 'All English' then     begin       glDeleteLists(32, 93);     end     else     begin       i := 0;       While i < Length(GLStrEng) do       begin         dwChar := Byte(GLStrEng);         glDeleteLists(dwChar, 1);         i := i + 1;       end;     end;   if GLStrChn  nil then   begin     i := 0;     While i < Length(GLStrChn) do     begin       if bUniCode then       begin         GetMem(CharW, (Length(GLStrChn) + 1) * 2);         StringToWideChar(GLStrChn, CharW, Length(GLStrChn) + 1);         dwChar := Word(CharW);         glDeleteLists(dwChar, 1);         FreeMem(CharW, (Length(GLStrChn) + 1) * 2);         i := i + 1;       end       else       begin         Chartmp := Byte(GLStrChn);         if GLStrChn in LeadBytes then         begin           dwChar := ((Chartmp shl 8) or Byte(GLStrChn[i+1]));           i := i + 2;         end         else         begin           dwChar := Chartmp;           i := i + 1;         end;         glDeleteLists(dwChar, 1);       end;     end;   end; inherited Destroy; end; procedure TGLText.GetWinVer; var   VersionInfo: TOSVersionInfo; begin   VersionInfo.dwOSVersionInfoSize := SizeOf(VersionInfo);   GetVersionEx(VersionInfo);   if Versioninfo.dwPlatformId < 2 then     bUniCode := False   else     bUniCode := True; end; procedure TGLText.glShowStr(glStr : PChar); var   i,   Chartmp     : Byte;   CharW       : PWideChar;   dwChar      : DWORD; begin   i := 0;   While i < Length(glStr) do   begin     if bUniCode then     begin       GetMem(CharW, (Length(glStr) + 1) * 2);       StringToWideChar(glStr, CharW, Length(glStr) + 1);       dwChar := Word(CharW);       FreeMem(CharW, (Length(glStr) + 1) * 2);       i := i + 1;       glCallList(dwChar);     end     else     begin       Chartmp := Byte(glStr);       if glStr in LeadBytes then       begin         dwChar := ((Chartmp shl 8) or Byte(glStr[i+1]));         i := i + 2;       end       else       begin         dwChar := Chartmp;         i := i + 1;       end;       glCallList(dwChar);     end;   end; end; procedure TGLText.wglUseFontBitmapsExt(srcDC: HDC; First, Count,                                        ListBase: DWORD); var   i : DWORD;   size : DWORD;   gm : GLYPHMETRICS;   hBits : THANDLE;   lpBits : PGLubyte;   mat : MAT2; begin   mat.eM11.fract := 0;   mat.eM11.value := 1;   mat.eM12.fract := 0;   mat.eM12.value := 0;   mat.eM21.fract := 0;   mat.eM21.value := 0;   mat.eM22.fract := 0;   mat.eM22.value := -1;   for i := 0 to Count - 1 do   begin     glNewList(ListBase+i, GL_COMPILE);       size := GetGlyphOutline(srcDC, First+i, GGO_BITMAP, gm, 0, nil, mat);       hBits  := GlobalAlloc(GHND, size);       lpBits := GlobalLock(hBits);       GetGlyphOutline(srcDC,             //* handle to device context */                        First+i,          //* character to query */                        GGO_BITMAP,       //* format of data to return */                        gm,               //* pointer to structure for metrics */                        size,             //* size of buffer for data */                        lpBits,           //* pointer to buffer for data */                        mat               //* pointer to transformation */                                          //* matrix structure */                     );       glBitmap(gm.gmBlackBoxX,gm.gmBlackBoxY,                gm.gmptGlyphOrigin.x,                gm.gmptGlyphOrigin.y,                gm.gmCellIncX,gm.gmCellIncY,                lpBits);       GlobalUnlock(hBits);       GlobalFree(hBits);     glEndList;   end; end; end. 这次我把使用的例子也贴上了： unit Unit1; interface uses   Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,   Dialogs, DotWindow, GL, GLu, GLext, Unit2; type   TForm1 = class(TDotForm)     procedure FormCreate(Sender: TObject);     procedure FormShow(Sender: TObject);     procedure FormClose(Sender: TObject; var Action: TCloseAction);     procedure FormPaint(Sender: TObject);     procedure FormKeyDown(Sender: TObject; var Key: Word;       Shift: TShiftState);   private     { Private declarations }     fX, fY : Integer;     MyText  : TGLText;     procedure BuildLists;     procedure Clearing;     procedure DrawInfo;     procedure InitGLStatus(width, height: GLsizei);   public     { Public declarations }   end; var   Form1: TForm1; implementation {$R *.dfm} procedure TForm1.FormCreate(Sender: TObject); begin fX := 640; fY := 480; Self.BorderStyle := bsNone; Self.Height      := fY; Self.Width       := fX; Self.Context.DC  := GetDC(Self.Handle); ShowCursor(False); end; procedure TForm1.FormShow(Sender: TObject); begin   Self.Context.QuickPF(32, 0, 24, 0);   Self.Context.InitGL;   InitGLStatus(Self.ClientWidth, Self.ClientHeight);   BuildLists; end; procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction); begin   MyText.Free; end; procedure TForm1.FormPaint(Sender: TObject); begin   clearing;   DrawInfo;   Self.Context.PageFlip; end; procedure TForm1.FormKeyDown(Sender: TObject; var Key: Word;   Shift: TShiftState); begin   case Key of     VK_ESCAPE :     begin       Clearing;       Self.Close;     end;   end; end; procedure TForm1.Clearing; begin glClear(GL_COLOR_BUFFER_BIT or GL_DEPTH_BUFFER_BIT); end; procedure TForm1.InitGLStatus(width, height: GLsizei); begin glClearColor(0, 0, 0, 0.5);   glMatrixMode(GL_PROJECTION);     gluOrtho2D(-(fX div 2), fX div 2, -(fY div 2), fY div 2);   glMatrixMode(GL_MODELVIEW); end; procedure TForm1.BuildLists; var   StrE, StrC : TGLFont; begin //中、英文字体   StrE.b3D := False;   StrE.bBold := False;   StrE.bItalic := False;   StrE.Height := 13;   StrE.Weight := 0;   StrE.CharSet:= ANSI_CHARSET;   StrE.Typeface := 'Tahoma';   StrC.b3D := False;   StrC.bBold := False;   StrC.bItalic := False;   StrC.Height := 13;   StrC.Weight := 0;   StrC.CharSet:= GB2312_CHARSET;   StrC.Typeface := 'Tahoma';   MyText := TGLText.Create(Self.Context.DC,                            'All English' , '这是中文请按键退出。……',                            @StrE, @StrC); end; procedure TForm1.DrawInfo; begin   glLoadIdentity;   glRasterPos2f(-250, 200);   MyText.glShowStr('这是中文。');   glRasterPos2f(-250, 150);   MyText.glShowStr('These are English characters. ');   glRasterPos2f(-80, -80);   MyText.glShowStr('请按 Esc 键退出……'); end; end.