Buchempfehlung
Windows System Programming
Windows System Programming
Das Kompendium liefert viele interessante Informationen zur Windows-Programmierung auf Englisch. [Mehr Infos...]
FreeBASIC-Chat
Es sind Benutzer im FreeBASIC-Chat online.
(Stand:  )
FreeBASIC bei Twitter
Twitter FreeBASIC-Nachrichten jetzt auch über Twitter erhalten. Follow us!

Code-Beispiel

Code-Beispiele » Windows GUI

Schriftart in der Konsole ändern

Lizenz:Erster Autor:Letzte Bearbeitung:
k. A.RedakteurVolta 05.04.2022

Windows API - Funktionen um den Consolefont zu ändern gibt es erst ab Windows Vista (ungeprüft: XP SP3).
Für diese Funktionen gibt es bisher in FB noch keine Definitionen, daher müssen wir sie über DyLibLoad in der 'kernel32.dll' ansprechen.
Die Funktion 'SetConsoleFont' ist eine nicht dokumentierte Funktion, die mehrere Fonts und Schriftgrößen einstellen kann. Über 'GetNumberOfConsoleFonts' kann man ermitteln wie viele unterschiedliche Konsolen vordefiniert sind.
(Anmerkung von grindstone: Die ersten beiden Beispiele funktionieren mit XP SP3, das dritte Beispiel nicht, da die Funktionen "GetCurrentConsoleFontEx" und "SetCurrentConsoleFontEx" dort in der "Kernel32.dll" noch nicht implementiert sind)

#Include Once "windows.bi"
'ab Windows Vista
Function Set_ConsoleFont(typ As Integer) As Integer
  Dim As Any Ptr Kernel32
  Dim SetConsoleFont As Function(ByVal As HANDLE, ByVal As Integer) As Integer
  Kernel32 = DylibLoad("Kernel32.dll")
  If Kernel32 Then
    SetConsoleFont = DyLibSymbol(Kernel32,"SetConsoleFont")
    Function = SetConsoleFont(GetStdHandle(STD_OUTPUT_HANDLE),typ)
    DyLibFree Kernel32
  EndIf
End Function

Function NumberOfFonts() As Integer
  Dim As Any Ptr Kernel32
  Dim GetNumberOfConsoleFonts As Function() As Integer
  Kernel32 = DylibLoad("Kernel32.dll")
  If Kernel32 Then
    GetNumberOfConsoleFonts = DyLibSymbol(Kernel32,"GetNumberOfConsoleFonts")
    Function = GetNumberOfConsoleFonts()
    DyLibFree Kernel32
  EndIf
End Function

Width 50,24: Color 15,1: Cls
For i As Integer = 16 To 254
  Print Chr(i);
Next
Print
For n As Integer = 0 To NumberOfFonts-1
  Print "SetConsoleFont Typ " & n, Set_ConsoleFont(n)
  Sleep 2000,1
Next
Sleep

Der Aufruf von WinApi- DLLs lässt sich auch bei undokumentierten Funktionen noch einfacher schreiben. Hier das obige Beispiel in neuerer Schreibweise:

#Include Once "windows.bi"
'ab Windows Vista (ungeprüft: XP SP3)
Extern "Windows"
Declare Function GetNumberOfConsoleFonts() As DWORD
Declare Function SetConsoleFont(ByVal As HANDLE, ByVal As DWORD ) As BOOL
End Extern

Width 50,24: Color 15,1: Cls
For i As Integer = 16 To 254
  Print Chr(i);
Next
Print
For n As Integer = 0 To GetNumberOfConsoleFonts-1
  SetConsoleFont(GetStdHandle(STD_OUTPUT_HANDLE), n)
  Print "SetConsoleFont Typ " & n
  Sleep 2000,1
Next
Sleep

Die 'SetCurrentConsoleFontEx' erlaubt ein individuelles Einstellen des (Console)Fonts.

#Include Once "windows.bi"
'ab Windows Vista
Const FF_LUCIDA = 54
Const FF_TERMINAL = 48

Type CONSOLE_FONT_INFOEX
  cbSize     As UInteger
  nFont      As Integer
  dwFontSize As COORD
  FontFamily As UInteger
  FontWeight As UInteger
  FaceName   As WString * LF_FACESIZE
End Type

Declare Function SetConsoleFont(ByVal sTypeface As String, wFontWidth As Short, wFontHeight As Short, wFontStyle As Short) As Integer
Dim Shared As Any Ptr Kernel32
Dim Shared GetCurrentConsoleFontEx As Function (ByVal hConsoleOutput As HANDLE _
,   ByVal bMaximumWindow As Integer _
,   ByVal lpConsoleCurrentFontEx As Any Ptr) As Integer
Dim Shared SetCurrentConsoleFontEx  As Function (ByVal hConsoleOutput As HANDLE _
,   ByVal bMaximumWindow As Integer _
,   lpConsoleCurrentFontEx As Any Ptr) As Integer

Kernel32 = DylibLoad( "Kernel32.dll" )
If Kernel32 Then
  GetCurrentConsoleFontEx = DylibSymbol( Kernel32, "GetCurrentConsoleFontEx" )
  SetCurrentConsoleFontEx = DylibSymbol( Kernel32, "SetCurrentConsoleFontEx" )
Else
  End
EndIf

Dim As Integer dwMxScrn = SetConsoleFont("Lucida Console", 10, 16, FF_LUCIDA)
If dwMxScrn Then
  Print "Konsole mit " & LoWord(dwMxScrn) & "x" & HiWord(dwMxScrn) & " Zeichen."
End If
DylibFree Kernel32
Sleep

Function SetConsoleFont(ByVal sTypeface As String,wFontWidth As Short _
  ,      wFontHeight As Short, wFontStyle As Short) As Integer
  Dim hConHdl As HANDLE = GetStdHandle(STD_OUTPUT_HANDLE)
  If hConHdl < 0 Then Return 0
  Dim ConFont As CONSOLE_FONT_INFOEX
  With ConFont
    .cbSize = SizeOf(ConFont)
    .nFont = 0
    .FontFamily = wFontStyle
    .dwFontSize.X = wFontWidth
    .dwFontSize.Y = wFontHeight
    .FaceName = sTypeface
  End With
  If SetCurrentConsoleFontEx(hConHdl, 1, @ConFont) Then
    GetCurrentConsoleFontEx(hConHdl, 1, @ConFont)
    Function = ConFont.dwFontSize.X Shl(16) + ConFont.dwFontSize.Y
  End If
End Function
Zusätzliche Informationen und Funktionen
  • Das Code-Beispiel wurde am 22.11.2011 von RedakteurVolta angelegt.
  • Die aktuellste Version wurde am 05.04.2022 von Mitgliedgrindstone gespeichert.
  Bearbeiten Bearbeiten  

  Versionen Versionen