|
|
上次我发了个帖子，名为《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.
我用 Delphi 6 以及 Delphi 2006(Delphi 10) 验证通过。
有疑问可以发帖，或者发邮件给我，地址如下：
testerHooK@126.com
演示程序请见附件（含源代码）。
P.S. 演示程序用到了DOT工具，请到www.delphi3d.net下载最新版。
|
|
发表于 2006-8-17 08:46:00
楼主