const
CHESS_WHITE_QUEEN = #$2654;
CHESS_WHITE_KING = #$2655;
CHESS_WHITE_ROOK = #$2656;
CHESS_WHITE_BISHOP = #$2657;
CHESS_WHITE_KNIGHT = #$2658;
CHESS_WHITE_PAWN = #$2659;
CHESS_BLACK_QUEEN = #$265A;
CHESS_BLACK_KING = #$265B;
CHESS_BLACK_ROOK = #$265C;
CHESS_BLACK_BISHOP = #$265D;
CHESS_BLACK_KNIGHT = #$265E;
CHESS_BLACK_PAWN = #$265F;
function CharToBitmap(sFontName:
String; c: WideChar; cBackColor, cFontColor, cOutlineColor: TColor;
OutlineSize: Integer; bmp: TBitmap): Boolean;
var
r: TRect;
OtmSize: Integer;
pTm: POutlineTextMetric;
LogFont: TLogFont;
begin
Result := False;
//destination rect
r := Rect(0, 0, bmp.Width, bmp.Height);
//set new font
bmp.Canvas.Font.
Name := sFontName;
bmp.Canvas.Font.Style := [fsBold];
bmp.Canvas.Font.Size := 10;
//fill background
bmp.Canvas.Brush.color := cBackColor;
bmp.Canvas.FillRect(r);
//get font metrics
OtmSize := GetOutlineTextMetrics(bmp.Canvas.Handle, SizeOf(TOutlineTextMetric),
nil);
if OtmSize > 0
then
begin
//reserve memory
GetMem(pTm, OtmSize);
try
pTm^.otmSize := OtmSize;
//set size
if GetOutlineTextMetrics(bmp.Canvas.Handle, OtmSize, pTm) <> 0
then
begin
//fill whole height
bmp.Canvas.Font.Height := - bmp.Height;
BeginPath(bmp.Canvas.handle);
SetBKMode(bmp.Canvas.Handle, TRANSPARENT);
DrawTextW(bmp.canvas.handle, @c, 1, r, DT_SINGLELINE
or
DT_CENTER
or DT_VCENTER);
EndPath(bmp.Canvas.handle);
bmp.Canvas.Brush.color := cFontColor;
bmp.Canvas.pen.color := cOutlineColor;
bmp.Canvas.pen.width := OutlineSize;
StrokeAndFillPath(bmp.Canvas.Handle);
Result := True;
end;
finally
FreeMem(pTm);
end;
end;
end;
procedure TForm1.Button4Click(Sender: TObject);
var
bmp: TBitmap;
begin
bmp := TBitmap.create;
try
bmp.width := 100;
bmp.height := 100;
//white piece
CharToBitmap('
Chess Merida Unicode', CHESS_WHITE_BISHOP,
clGreen,
clBlack,
clWhite,
bmp.height
div 80,
bmp);
Image1.Picture.Assign(bmp);
//black piece
CharToBitmap('
Chess Merida Unicode', CHESS_BLACK_KING,
clGreen,
clBlack,
clWhite,
bmp.height
div 80,
bmp);
Image2.Picture.Assign(bmp);
finally
bmp.Free;
end;
end;