uses PNGImage;
procedure TForm108.Button1Click(Sender: TObject);
var figur, b : TBitMap;
pngfigur : TPNGImage;
cs : unicodestring;
hl, br, ho, i : integer;
te : TSize;
begin
for i := $2654
to $265f
do cs := cs + widechar(i);
b := TBitMap.Create;
figur := TBitMap.Create;
pngfigur := TPNGImage.Create;
try
br := 200;
// breite einer schachfigur grafik
ho := 200;
// hölhe
b.SetSize( 10*br, ho );
// bitmap, in welche wir alle 10 figuren schreiben werden
b.Canvas.Font.
Name := '
Segoe UI Symbol1';
// eine unicode fähige schrift wählen
// Arial Unicode MS1, Code20001, DejaVu Sans1, DejaVu Sans Mono1, Segoe UI Symbol1, Symbola1, Unifont1
b.Canvas.Font.Height := b.Height;
// schrifthöhe
b.Canvas.Font.Color := clblack;
// farbe der schrift
hl := 0;
// figuren zeichnen
for i := 1
to 10
do
begin
te := b.Canvas.TextExtent(cs[i]);
b.Canvas.TextOut(hl+(br-te.cx)
div 2, (ho-te.cy)
div 2, cs[i] );
inc(hl,br);
end;
// umgebung der figuren rot einfärben bis zur randfarbe der figuren
b.Canvas.Brush.Color := clred;
b.Canvas.Brush.Style := bsSolid;
b.Canvas.FloodFill(0,0,b.Canvas.Font.Color,fsBorder);
// figurenbitmap
figur.SetSize(br,ho);
// transparenz festlegen
figur.TransparentColor := clred;
figur.TransparentMode := tmFixed;
figur.Transparent := true;
// die 10 figuren in png files abspeichern
hl := 0;
for i := 1
to 10
do
begin
figur.Canvas.CopyRect(Rect(0,0,figur.Width,figur.Height), b.Canvas, Rect(hl,0,hl+br,ho) );
pngfigur.Assign( figur );
pngfigur.SaveToFile( extractfilepath(paramstr(0)) + '
fig' + i.ToString + '
.png' );
inc(hl,br);
end;
finally
b.Free;
figur.Free;
pngfigur.Free;
end;
end;