FreeBasic

Данный пример показывает как создать изображение, нарисовать в нем текст с нужным шрифтом и сохранить в формате PNG с помощью библиотеки GDI+. Можно сохранять и в других форматах, достаточно поменять расширение файла и CLSID:

• BMP {557CF400-1A04-11D3-9A73-0000F81EF32E}
• JPEG {557CF401-1A04-11D3-9A73-0000F81EF32E}
• GIF {557CF402-1A04-11D3-9A73-0000F81EF32E}
• TIFF {557CF405-1A04-11D3-9A73-0000F81EF32E}
• PNG {557CF406-1A04-11D3-9A73-0000F81EF32E}

Платформы: Windows.
Автор: Hard, создано в 2009 году

#INCLUDE Once "WIN/GDIPLUS.BI"


Using GDIPLUS

Dim ULONG_PTR_01 As ULONG_PTR

Dim GDIPLUSSTARTUPINPUT_01 As GDIPLUSSTARTUPINPUT

GDIPLUSSTARTUPINPUT_01.GdiplusVersion = 1


If (GDIPLUSSTARTUP(@ULONG_PTR_01, @GDIPLUSSTARTUPINPUT_01, NULL) <> 0) Then

        Print "FAIL"
Endif

Dim GPIMAGE_01 As GPIMAGE Ptr


If (GDIPCREATEBITMAPFROMSCAN0(100, 100, NULL, PIXELFORMAT32BPPRGB, NULL, @GPIMAGE_01) <> 0) Then

        Print "FAIL"
Endif

Dim GPGRAPHICS_01 As GPGRAPHICS Ptr


If (GDIPGETIMAGEGRAPHICSCONTEXT(GPIMAGE_01, @GPGRAPHICS_01) <> 0) Then

        Print "FAIL"
Endif

If (GDIPSETSMOOTHINGMODE(GPGRAPHICS_01, SMOOTHINGMODEANTIALIAS) <> 0) Then

        Print "FAIL"
Endif

Dim GPFONTFAMILY_01 As GPFONTFAMILY Ptr


If (GDIPCREATEFONTFAMILYFROMNAME(Wstr("COURIER NEW"), NULL, @GPFONTFAMILY_01) <> 0) Then

        Print "FAIL"
Endif

Dim GPFONT_01 As GPFONT Ptr


If (GDIPCREATEFONT(GPFONTFAMILY_01, 12, NULL, NULL, @GPFONT_01) <> 0) Then

        Print "FAIL"
Endif

Dim GPBRUSH_01 As GPBRUSH Ptr


If (GDIPCREATESOLIDFILL(Rgba(255, 255, 255, 255), @GPBRUSH_01) <> 0) Then

        Print "FAIL"
Endif

Dim RECTF_01 As RECTF

RECTF_01.X = 10

RECTF_01.Y = 10


If (GDIPDRAWSTRING(GPGRAPHICS_01, Wstr("TEST"), Len("TEST"), GPFONT_01, @RECTF_01, NULL, GPBRUSH_01) <> 0) Then

        Print "FAIL"
Endif

GDIPDELETEBRUSH GPBRUSH_01

GDIPDELETEFONTFAMILY GPFONTFAMILY_01

GDIPDELETEFONT GPFONT_01

Dim CLSID_01 As CLSID

CLSIDFROMSTRING Wstr("{557CF406-1A04-11D3-9A73-0000F81EF32E}"), @CLSID_01 

If (GDIPSAVEIMAGETOFILE(GPIMAGE_01, Wstr("1.png"), @CLSID_01 , NULL) <> 0) Then

        Print "FAIL"
Endif

GDIPDELETEGRAPHICS GPGRAPHICS_01

GDIPDISPOSEIMAGE GPIMAGE_01

GDIPLUSSHUTDOWN ULONG_PTR_01