FreeBASIC マニュアルのトップに戻る

FreeBASIC TTF_with_WindowsAPI(描画画面に日本語を表示)

目次→フォーラム→FreeBASIC→補足TTF_with_WindowsAPI←オリジナル・サイト

TTF_with_WindowsAPI(描画画面に日本語フォントを表示) 左にメニュー・フレームが表示されていない場合は、ここをクリックして下さい

←リンク元に戻る プログラム開発関連に戻る

日本語フォントを表示
 これは、Windows API と GDIPlus を使って TTF font を表示するプログラム例です。
 UEZ さんに教えていただきました。


TTF_with_WindowsAPI.bas
'Example coded by UEZ build 2022-12-09
'ttf examples with sdl and fb native
'by UEZ ≫ Dec 09, 2022 14:14
'https://www.freebasic.net/forum/viewtopic.php?p=295921&sid=c6b2b0bf0a1caca2163e13f522ec29ef#p295921

#Ifdef __Fb_64bit__
   #Inclib "gdiplus"
   #Include Once "win/gdiplus-c.bi"
#Else
   #Include Once "win/gdiplus.bi"
   Using Gdiplus
#EndIf
#Include "windows.bi"

Dim Shared gdipToken As ULONG_PTR
Dim Shared GDIp As GdiplusStartupInput 
Dim Shared As Any Ptr hCanvas, hBrush, hFont, hFont2, hFamily, hFamily2, hFormat
Dim Shared As GpRectF tLayout, tLayout2
Dim Shared message1 As WString * 100 = "Freebasic はクールです。"
Dim Shared message2 As WString * 100 = "UEZ さん、教えていただき有難うございます!"

Function WndProc(hWnd As HWND,uMsg As UINT,wParam As WPARAM,lParam As LPARAM) As Integer
	Select Case uMsg
		Case WM_CLOSE
			PostQuitMessage(0)
		Case WM_CREATE
		Case WM_ERASEBKGND
			GdipGraphicsClear(hCanvas, &hFF000000)
            'Syntax
            'GpStatus WINGDIPAPI GdipDrawString(
            '    GpGraphics *graphics,
            '    GDIPCONST WCHAR *string,
            '    INT length,
            '    GDIPCONST GpFont *font,
            '    GDIPCONST RectF *layoutRect,
            '    GDIPCONST GpStringFormat *stringFormat,
            '    GDIPCONST GpBrush *brush
            ');
			'GdipDrawString(hCanvas, "Freebasic はクールです。", -1, hFont, @tLayout, hFormat, hBrush)	'draw string to canvas	
			GdipDrawString(hCanvas, message1, -1, hFont, @tLayout, hFormat, hBrush)	'draw string to canvas
			GdipDrawString(hCanvas, message2, -1, hFont2, @tLayout2, hFormat, hBrush)	'draw string to canvas
			Return 0			
	End Select
	Return DefWindowProc(hWnd, uMsg, wParam, lParam)
End Function

Function _GDIPlus_Startup() As Bool
	GDIp.GdiplusVersion = 1
	If GdiplusStartup(@gdipToken, @GDIp, NULL) <> 0 Then
		Error 1
		Return FALSE
	EndIf
	Return TRUE
End Function

Sub _GDIPlus_Shutdown()
	GdiplusShutdown(gdipToken)
End Sub

Dim As Long sW, sH
ScreenInfo(sW, sH)

Const w = 1000, h = 600
Dim As HWND hHWND
Dim wc As WNDCLASSEX
Dim msg As MSG
Dim szAppName As ZString * 6 => "FB GUI"
Dim As String sTitle = "GDI+ TTF Font Example by UEZ"

With wc
	.style			= CS_HREDRAW Or CS_VREDRAW
	.lpfnWndProc	= @WndProc
	.cbClsExtra		= NULL
	.cbWndExtra		= NULL
	.hInstance		= GetModuleHandle(NULL)
	.hIcon			= LoadIcon(NULL, IDI_APPLICATION)
	.hCursor		= LoadCursor(NULL, IDC_ARROW)
	.hbrBackground	= GetStockObject(BLACK_BRUSH)
	.lpszMenuName	= NULL
	.lpszClassName	= @szAppName
	.cbSize			= SizeOf(WNDCLASSEX)
End With

RegisterClassEx(@wc)
hHWND = CreateWindowEx(WS_EX_APPWINDOW Or WS_EX_WINDOWEDGE, wc.lpszClassName, sTitle, _
							  WS_OVERLAPPEDWINDOW Or WS_VISIBLE Or WS_SYSMENU Xor WS_MAXIMIZEBOX, _
							  (sW - w) / 2, (sH - h) / 2, _
							  w, h, _
							  NULL, NULL, wc.hInstance, NULL)
ShowWindow(hHWND, SW_SHOW)
							  
tLayout.x = 0
tLayout.y = 0
tLayout.width = w
tLayout.height = h
tLayout2.x = 0
tLayout2.y = 80
tLayout2.width = w
tLayout2.height = h
	
_GDIPlus_Startup()	'init GDIPlus
GdipCreateFromHWND(hHWND, @hCanvas)	'create canvas not double buffered
GdipSetSmoothingMode(hCanvas, 6) '6 = 8x8 anti-aliasing mode for canvas
GdipSetTextRenderingHint(hCanvas, TextRenderingHintAntiAliasGridFit) 'anti-aliasing for font

GdipCreateSolidFill(&hFFFFFFFF, @hBrush)	'create brush handle
GdipCreateStringFormat(0, 0, @hFormat)	'create format handle
'GdipCreateFontFamilyFromName("Consolas", 0, @hFamily)	'create familiy handle
'GdipCreateFontFamilyFromName("MS 明朝", 0, @hFamily)	'create familiy handle
GdipCreateFontFamilyFromName("id-懐流体1P", 0, @hFamily)	'create familiy handle
GdipCreateFontFamilyFromName("HGP行書体", 0, @hFamily2)	'create familiy handle

GdipCreateFont(hFamily, 50, 0, 3, @hFont)	'create font handle with 50px of size
GdipCreateFont(hFamily2, 30, 0, 3, @hFont2)	'create font handle with 30px of size
GdipSetStringFormatAlign(hFormat, StringAlignmentCenter)	'center font H
GdipSetStringFormatLineAlign(hFormat, StringAlignmentCenter)	'center font V

InvalidateRect(hHWND, NULL, TRUE) 'force GUI to be redrawn

While GetMessage(@msg, 0, 0, 0)
	TranslateMessage(@msg)
	DispatchMessage(@msg)
Wend

'release GDIPlus resources
GdipDeleteBrush(hBrush)
GdipDeleteFontFamily(hFamily)
GdipDeleteStringFormat(hFormat)
GdipDeleteFont(hFont)
GdipDeleteGraphics(hCanvas)
_GDIPlus_Shutdown()
 
補足 に戻る
←リンク元に戻る プログラム開発関連に戻る
ページ歴史:2022-12-11
日本語翻訳:WATANABE Makoto、原文著作者:UEZ

ホームページのトップに戻る

表示-非営利-継承