FreeBASIC 実行画面(Windows コンソール)のサイズと文字の大きさを変える方法

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

結果の画面を留めておく方法　左にメニュー・フレームが表示されていない場合は、ここをクリックして下さい

FreeBASIC の実行画面は、「コマンドプロンプトのプロパティ」を操作して、サイズを変更することができます。
FreeBASIC のフォーラムに掲載されていたプログラムを転載します。

レジストリ情報

レジストリーの設定
コマンドプロンプト（コンソール）に関する各種設定
https://kledgeb.blogspot.com/2017/06/windows-9.html

Windows レジストリ解剖記
https://www.pg-fl.jp/program/winreg/
・HKEY_CURRENT_USER
https://www.pg-fl.jp/program/winreg/cuser.htm

コマンドプロンプトのデフォルトフォント変更
http://sunday-programming.hatenablog.com/entry/2014/03/10/163209

コマンドラインを強化せよ! - Windows 7のコマンドプロンプトをカスタマイズする
コマンドプロンプトのフォントとウィンドウサイズを変更する
https://news.mynavi.jp/article/20110705-commandline/3
https://news.mynavi.jp/article/20110705-commandline/4

コマンドプロンプトの既定値で表示

結果が100未満になる足し算、および、100未満の数からの引き算の問題を自動生成

'作成 2019/05/12 
'プログラミングの考え方：さいころを 2つ使って 1桁の足し算を自動生成してみる

Print "2桁までの足し算と引き算の問題を自動生成します。"
Print

'このアプリは、コンソールの既定値のフォント・サイズを使って表示します。
Print "(文字の大きさは、コマンド プロンプトの「既定値」"
Print "のフォントサイズで設定して下さい。)"
Print
'---------------------------------------------------
'参考にさせて頂いた掲示
'change console mode font
'by MichaelW ≫ Feb 14, 2008 15:59 
'https://www.freebasic.net/forum/viewtopic.php?t=10651
'======================================================================
#Include "windows.bi"
'======================================================================
Dim As HKEY hKey2
Dim As DWORD fontSize
'---------------------------------------------------
'' For RegSetValueEx return value ERROR_SUCCESS = 0.
'---------------------------------------------------
RegSetValueEx( hKey2, "FontSize", 0, REG_DWORD, _
               Cast(LPSTR,@fontSize), SizeOf(DWORD) )  '指定されたレジストリキーの指定された 1 つのレジストリエントリのデータとデータ型を設定します。
'---------------------------------------------------

'結果が2桁までの加算と減算を自動生成する。

Dim A As Integer
Dim B As Integer
Dim S As Integer
Dim Calculation As String
Dim KeyInput As Integer

Input  "算法(足し算=a 引き算=s)を入力して下さい。"; Calculation 
Print

Randomize

Do
   Do
      A = Rnd * 99.4
      B = Rnd * 99.4
      S = A+B
   Loop While S >= 100
   
   If Calculation="a" Then
      Print Using "  ## + ## = "; A; B;
      Sleep
      Print Using "##       [Esc]キーで抜ける"; S
   
   Else
      Print Using "  ## - ## = ";  S; A;
      Sleep
      Print Using "##       [Esc]キーで抜ける"; B
   End If
   
   print
   KeyInput = GetKey

Loop Until KeyInput = 27 ' [27]=[Esc] キー入力するまで、繰返す

ChangeConsoleModeFont.bas

'change console mode font
'by MichaelW ≫ Feb 14, 2008 15:59 
'https://www.freebasic.net/forum/viewtopic.php?t=10651

'このアプリは、コンソール設定を制御する新しいキーを作成（または既存のキーを開く）し、
'そのキーに適切な値を設定します。
'値は、次回のアプリ起動時に有効になります。
'FreeConsoleに続けてAllocConsole を使用してコンソールを再起動することは可能ですが、
'IIRC(If I Remember Correctly)私の記憶では、これは FreeBASIC がコンソールにアクセスするために使うハンドルを事実上無効にします。
'Windows は、ゼロのフォントサイズを値がない場合と同じように解釈し、デフォルトのフォントサイズ（？）を使用します。
'私のテストでは、コンソールのプロパティを調べてサポートされていないサイズを指定した場合、
'Windows はサポートされている最小のサイズになりました。 

'======================================================================
#Include "windows.bi"
'======================================================================

Dim As HKEY hKey1, hKey2
Dim As DWORD dwDisposition

Dim As DWORD fontFamily = &h30
Dim As DWORD fontSize
'fontSize = &h80008       ' 8x8
'fontSize = &h14000a      ' 10x20
Dim As DWORD fontWeight = 400
Dim As DWORD quickEdit = &h800

Dim As String key2

key2 = "C:_Program Files_FreeBASIC0.18.2b_My_ConsoleFont_test.exe"

Dim As String faceName = "Terminal"

Print GetSystemMetrics( SM_CXSCREEN )
Print GetSystemMetrics( SM_CYSCREEN )
Print

RegOpenKeyEx( HKEY_CURRENT_USER, "Console", 0, KEY_ALL_ACCESS, @hKey1 )  '指定されたレジストリキーを開きます。

Print hKey1

RegCreateKeyEx( hKey1, StrPtr(key2), 0, NULL, 0, KEY_ALL_ACCESS, _
                NULL, @hKey2, @dwDisposition )  '指定されたレジストリキーを作成します。そのキーが既に存在している場合、そのキーを開きます。

'------------------------------------
'' Possible dwDisposition values are:
'' REG_CREATED_NEW_KEY = 1
'' REG_OPENED_EXISTING_KEY = 2
'------------------------------------

Print hKey2
Print dwDisposition

'---------------------------------------------------
'' For RegSetValueEx return value ERROR_SUCCESS = 0.
'---------------------------------------------------

'print RegSetValueEx( hKey2, "FaceName", 0, REG_SZ, _
'                     strptr(faceName), sizeof(faceName)+1 )

'print RegSetValueEx( hKey2, "FontFamily", 0, REG_DWORD, _
'                     cast(LPSTR,@fontFamily), sizeof(DWORD) )

Print RegSetValueEx( hKey2, "FontSize", 0, REG_DWORD, _
                     Cast(LPSTR,@fontSize), SizeOf(DWORD) )  '指定されたレジストリキーに所属する、指定された 1 つのレジストリエントリのデータとデータ型を設定します。

'print RegSetValueEx( hKey2, "FontWeight", 0, REG_DWORD, _
'                     cast(LPSTR,@fontWeight), sizeof(DWORD) )

'print RegSetValueEx( hKey2, "FontWeight", 0, REG_DWORD, _
'                     cast(LPSTR,@fontWeight), sizeof(DWORD) )

'print RegSetValueEx( hKey2, "QuickEdit", 0, REG_DWORD, _
'                     cast(LPSTR,@quickEdit), sizeof(DWORD) )

Sleep

GetSystemMetrics
　さまざまなシステム・メトリックの値（表示要素の幅と高さ）とシステムの現在の構成を取得します。
表示要素とは、ウィンドウの一部、またはシステムが表示する画面の一部を意味します（詳細については、GetSysColor 関数の説明を参照してください）。
GetSystemMetrics 関数は、すべてのサイズをピクセル単位で取得します。

SM_CXSCREEN,SM_CYSCREEN
プライマリモニタの画面全体の幅と高さを取得します。これらは、(hdcPrimaryMonitor, HORZRES/VERTRES) を呼び出して取得するのと同じ値です。

RegOpenKeyEx
　指定されたレジストリキーを開きます。
LONG RegOpenKeyEx(
HKEY hKey, // 開いている親キーのハンドル
LPCTSTR lpSubKey, // 開くべきサブキーの名前
DWORD ulOptions, // 予約済み
REGSAM samDesired, // セキュリティアクセスマスク
PHKEY phkResult // 開くことに成功したサブキーのハンドル
);

KEY_ALL_ACCESS
STANDARD_RIGHTS_REQUIRED, KEY_QUERY_VALUE, KEY_ENUMERATE_SUB_KEYS, KEY_NOTIFY, KEY_CREATE_SUB_KEY, KEY_CREATE_LINK, KEY_SET_VALUE アクセスの組み合わせです。

RegCreateKeyEx 　指定されたレジストリキーを作成します。そのキーが既に存在している場合、そのキーを開きます。
LONG RegCreateKeyEx(
HKEY hKey, // 開くべきキーのハンドル
LPCTSTR lpSubKey, // サブキーの名前
DWORD Reserved, // 予約済み
LPTSTR lpClass, // クラスの文字列
DWORD dwOptions, // 特別なオプション
REGSAM samDesired, // 希望のセキュリティアクセス権
LPSECURITY_ATTRIBUTES lpSecurityAttributes, // 継承の指定
PHKEY phkResult, // キーのハンドル
LPDWORD lpdwDisposition // 既存かどうかを示す値が格納される変数
);

RegSetValueEx
　指定されたレジストリキーに所属する、指定された 1 つのレジストリエントリのデータとデータ型を設定します。
　レジストリエディタ（Regedt32.exe または Regedit.exe）は、ここで言う「レジストリエントリ」を「値」（英語版は Value）と呼んでいます。どちらも同じものを意味していて、「名前」（レジストリエントリ名）と「データ」（レジストリエントリのデータ）で構成されています。
LONG RegSetValueEx(
HKEY hKey, // 親キーのハンドル
LPCTSTR lpValueName, // レジストリエントリ名
DWORD Reserved, // 予約済み
DWORD dwType, // レジストリエントリのデータ型
CONST BYTE *lpData, // レジストリエントリのデータ
DWORD cbData // レジストリエントリのデータのサイズ
);

★FontSize
文字のサイズに関する値が入ります。
ラスターフォントの場合は16進数の下4桁が横のサイズ(0x7FFFまで)、上4桁が縦のサイズ(0x7FFFまで)になります。
その他のフォントの場合は16進数の上4桁がフォントサイズ(0x7FFFまで)になります。
16 進数の数値をコードで書きたいときは&HFFのように、頭に &H を付けます。

CommandPromptFontsZippy.bas

'Command prompt fonts
'by Zippy ≫ May 20, 2009 20:30 
'https://www.freebasic.net/forum/viewtopic.php?t=13851

'console setup, Windows only, 
'Win2k and newer will not execute from FBEdit in Vista with UAC,
'  invoke from commandline or Explorer

#Include Once "windows.bi"
'
Declare Function _
    consolesetup(_
        fontheight As Integer,_
        fontwidth  As Integer,_
        facename   As String,_
        conheight  As Integer=25,_
        conwidth   As Integer=80,_
        buffheight As Integer=25,_
        buffwidth  As Integer=80,_
        quickedit  As Integer=1,_
        insertmode As Integer=1) As Integer
'
Dim As Integer res
res=consolesetup(16,0,"Lucida",25,40,,40)
Color 15,0
Print "We're done here.."
'
Sleep
'
'==========================================================        
'コンソール設定
'Lucida コンソールで有効なフォントの高さ
'5, 6, 7, 8, 10, 12, 14, 16, 18, 20, 24, 28, 36, and 72

'ラスタフォントで有効なフォントの幅と高さ
'4X6, 6X8, 8X8, 16X8, 5X12, 7X12, 8X12, 16X12, 12X16, and 10X18
'
Function _
    consolesetup(_
        fontheight As Integer,_
        fontwidth As Integer,_
        facename As String,_
        conheight As Integer=25,_
        conwidth As Integer=80,_
        buffheight As Integer=25,_
        buffwidth As Integer=80,_
        quickedit As Integer=1,_
        insertmode As Integer=1) As Integer
'
    Dim As Integer fontfamily,fontsize=(fontheight*2^16)+fontwidth
    Dim As Integer consize,buffsize
    Dim As String key2
    Dim As HKEY hKey1,hKey2
    Dim As DWORD dwDisposition
    Dim As DWORD fontWeight
    '
    If InStr(UCase(facename),"LUCIDA")>0 Then
        facename="Lucida Console"
        'fontfamily=54
        fontwidth=0
        fontweight=400
    Else
        facename="Raster Fonts" ' "Terminal" in Vista, no matter
        fontfamily=48
        fontweight=700
    End If
    '
    key2 = Command(0)
    For x As Integer = 1 To Len(key2)
        If Mid(key2,x,1) = "\" Then
            Mid(key2,x,1)="_"
        End If 
    Next x
    '
    RegOpenKeyEx(HKEY_CURRENT_USER,"Console",0,KEY_WRITE,@hKey1)
    '
    RegCreateKeyEx(hKey1,StrPtr(key2),0,NULL,0,KEY_ALL_ACCESS, _
                   NULL, @hKey2, @dwDisposition)
    '
    RegSetValueEx(hKey2,"FaceName",0,REG_SZ,_
                  StrPtr(faceName),Len(faceName)+2)'changed from Sizeof
    '
    RegSetValueEx(hKey2,"FontFamily",0,REG_DWORD,_
                  Cast(LPSTR,@fontFamily),SizeOf(DWORD))
    '
    RegSetValueEx(hKey2,"FontSize",0,REG_DWORD, _
                  Cast(LPSTR,@fontSize),SizeOf(DWORD))
    '
    RegSetValueEx(hKey2,"FontWeight",0,REG_DWORD,_
                  Cast(LPSTR,@fontWeight),SizeOf(DWORD))
    
    RegSetValueEx(hKey2,"QuickEdit",0,REG_DWORD,_
                  Cast(LPSTR,@quickedit),SizeOf(DWORD))
    '
    RegSetValueEx(hKey2,"InsertMode",0,REG_DWORD,_
                  Cast(LPSTR,@insertmode),SizeOf(DWORD))
    '
    consize=(conheight*2^16)+conwidth
    RegSetValueEx(hKey2,"WindowSize",0,REG_DWORD,_
                  Cast(LPSTR,@consize),SizeOf(DWORD))
    '    
    buffsize=(buffheight*2^16)+buffwidth
    RegSetValueEx(hKey2,"ScreenBufferSize",0,REG_DWORD,_
                  Cast(LPSTR,@buffsize),SizeOf(DWORD))
    '
    'need to free console and reallocate to apply new settings
    freeconsole()
    allocconsole()
    '
    Return 1
'        
End Function

CommandPromptFontsPhishguy.bas

'Command prompt fonts
'https://www.freebasic.net/forum/viewtopic.php?t=13851
'by phishguy ≫ May 20, 2009 20:41 

'console setup, Windows only, Win2k and newer
'  will not execute from FBEdit in Vista with UAC,
'  invoke from commandline or Explorer

#Include Once "windows.bi"
'
Declare Function _
    consolesetup(_
        Con_Xpos   As Integer=1,_
        Con_Ypos   As Integer=1,_
        fontheight As Integer,_
        fontwidth  As Integer,_
        facename   As String,_
        conheight  As Integer=25,_
        conwidth   As Integer=80,_
        buffheight As Integer=25,_
        buffwidth  As Integer=80,_
        quickedit  As Integer=1,_
        insertmode As Integer=1) As Integer
'
Dim As Integer res,fontsize,w,h


For x As Integer = 1 To 14
   Read fontsize
   res=consolesetup(10,100,fontsize,0,"Lucida",10,40,10,40)
   Color 15,0
   Locate ,,0
   Print "Font Size";fontsize
   Print "フォントサイズ";fontsize
   Print "実行結果を表示しています.."
'
Sleep 2000
Next x

For x As Integer = 1 To 10
   Read w,h
   res=consolesetup(10,100,h,w,"Console",10,40,10,40)
   Color 15,0
   Locate ,,0 
   Print "Font Size W:";w;" H:";h
   Print "フォントサイズ W:";w;" H:";h
   Print "実行結果を表示しています.."
'
Sleep 2000
Next x

Sleep

'
'==========================================================        
'コンソール設定
'Lucida コンソールで有効なフォントの高さ
Data 5, 6, 7, 8, 10, 12, 14, 16, 18, 20, 24, 28, 36,  72

'ラスタフォントで有効なフォントの幅と高さ
Data 4,6, 6,8, 8,8, 16,8, 5,12, 7,12, 8,12, 16,12, 12,16, 10,18
'
Function _
    consolesetup(_
        Con_Xpos   As Integer=1,_
        Con_Ypos   As Integer=1,_
        fontheight As Integer,_
        fontwidth As Integer,_
        facename As String,_
        conheight As Integer=25,_
        conwidth As Integer=80,_
        buffheight As Integer=25,_
        buffwidth As Integer=80,_
        quickedit As Integer=1,_
        insertmode As Integer=1) As Integer
'
    Dim As Integer fontfamily,fontsize=(fontheight*2^16)+fontwidth
    Dim As Integer consize,buffsize
    Dim As String key2
    Dim As HKEY hKey1,hKey2
    Dim As DWORD dwDisposition
    Dim As DWORD fontWeight
    '
    If InStr(UCase(facename),"LUCIDA")>0 Then
        facename="Lucida Console"
        'fontfamily=54
        fontwidth=0
        fontweight=400
    Else
        facename="Raster Fonts" ' "Terminal" in Vista, no matter
        fontfamily=48
        fontweight=700
    End If
    '
    key2 = Command(0)
    For x As Integer = 1 To Len(key2)
        If Mid(key2,x,1) = "\" Then
            Mid(key2,x,1)="_"
        End If 
    Next x
    '
    RegOpenKeyEx(HKEY_CURRENT_USER,"Console",0,KEY_WRITE,@hKey1)
    '
    RegCreateKeyEx(hKey1,StrPtr(key2),0,NULL,0,KEY_ALL_ACCESS, _
                   NULL, @hKey2, @dwDisposition)
    '
    'RegSetValueEx(hKey2,"FaceName",0,REG_SZ,_
    '              StrPtr(faceName),Len(faceName)+2) 'changed from Sizeof
    '
    RegSetValueEx(hKey2,"FontFamily",0,REG_DWORD,_
                  Cast(LPSTR,@fontFamily),SizeOf(DWORD))
    '
    RegSetValueEx(hKey2,"FontSize",0,REG_DWORD, _
                  Cast(LPSTR,@fontSize),SizeOf(DWORD))
    '
    RegSetValueEx(hKey2,"FontWeight",0,REG_DWORD,_
                  Cast(LPSTR,@fontWeight),SizeOf(DWORD))
    
    'RegSetValueEx(hKey2,"QuickEdit",0,REG_DWORD,_
    '              Cast(LPSTR,@quickedit),SizeOf(DWORD))
    '
    'RegSetValueEx(hKey2,"InsertMode",0,REG_DWORD,_
    '              Cast(LPSTR,@insertmode),SizeOf(DWORD))
    '
    consize=(conheight*2^16)+conwidth
    RegSetValueEx(hKey2,"WindowSize",0,REG_DWORD,_
                  Cast(LPSTR,@consize),SizeOf(DWORD))
    '    
    buffsize=(buffheight*2^16)+buffwidth
    RegSetValueEx(hKey2,"ScreenBufferSize",0,REG_DWORD,_
                  Cast(LPSTR,@buffsize),SizeOf(DWORD))
    '
    'need to free console and reallocate to apply new settings
    freeconsole()
    allocconsole()
    Dim conwnd As hwnd
    conwnd = getconsolewindow
    SetWindowPos(conwnd,NULL,Con_Xpos,_
Con_Ypos,NULL,NULL,SWP_NOZORDER Or SWP_NOSIZE )

    '
    Return 1
'        
End Function

SetWindowPos
　子ウィンドウ、ポップアップウィンドウ、またはトップレベルウィンドウのサイズ、位置、および Z オーダーを変更します。
これらのウィンドウは、その画面上での表示に従って順序が決められます。
最前面にあるウィンドウは最も高いランクを与えられ、Z オーダーの先頭に置かれます。
BOOL SetWindowPos(
HWND hWnd, // ウィンドウのハンドル
HWND hWndInsertAfter, // 配置順序のハンドル
int X, // 横方向の位置
int Y, // 縦方向の位置
int cx, // 幅
int cy, // 高さ
UINT uFlags // ウィンドウ位置のオプション
);

補足に戻る

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

日本語著作：WATANABE Makoto