Graphics to Windows terminal?

[dodicat]

Has anybody managed to double buffer some graphics to the Windows terminal?
Here is a test, OK on windows console host.
Is it doable in the terminal?

Code: Select all

#include "windows.bi"

Dim Shared As hdc h:h=getdc(getconsolewindow())
Dim Shared As hdc Memhdc:Memhdc = CreateCompatibleDC(h)
Dim Shared As Any Ptr	Membitmap:Membitmap = CreateCompatibleBitmap(h, Loword(Width)*8,Hiword(Width)*16)
SelectObject(Memhdc, Membitmap)
SelectObject(Memhdc,GetStockObject(DC_BRUSH))
SelectObject(Memhdc,GetStockObject(DC_PEN))
Declare Sub getconsole(Byref columns As Long,Byref rows As Long) 
Dim Shared As Long xx,yy
getconsole(xx,yy)
Print xx,yy
Print Loword(Width),Hiword(Width)
print "Press any key"
sleep


Sub getconsole(Byref columns As Long,Byref rows As Long) 
    Dim As CONSOLE_SCREEN_BUFFER_INFO csbi
    print GetConsoleScreenBufferInfo(GetStdHandle(STD_OUTPUT_HANDLE), @csbi)
    columns = csbi.srWindow.Right - csbi.srWindow.Left + 1
    rows = csbi.srWindow.Bottom - csbi.srWindow.Top + 1
End Sub

Sub setfontsize(h As hdc,size As Long,style As zstring Ptr)
    SelectObject(h,CreateFont(size,0,0,0,Loword(Width)*8,0,0,0,DEFAULT_CHARSET,OUT_OUTLINE_PRECIS,CLIP_DEFAULT_PRECIS,ANTIALIASED_QUALITY,VARIABLE_PITCH,style)) 
End Sub

Sub setfontcolours(h As hdc,text As Ulong)
    SetTextColor(h,text) 
    SetBkMode(h,transparent)
End Sub


Sub ClearScreen(c As Ulong=bgr(0,0,100))
    Var colour=c
    SetDCBrushColor(memhdc,colour)
    SetDCPenColor(memhdc,colour)
    rectangle(memhdc,0,0,Loword(Width)*8,Hiword(Width)*16)
End Sub

Sub text(h As hdc,x As Long,y As Long,s As String)
    textout(h,x,y,s,Len(s))
End Sub

Sub pprint(s As String,x As Long,y As Long,size As Long=30,colour As Ulong=bgr(200,100,0),kind As String="courier new")
	setfontsize(Memhdc,size,kind)
    setfontcolours(Memhdc,colour)
    text(Memhdc,x,y,s)
End Sub

Sub _circle(h As hdc,xx As Long,yy As Long,r As Long,clr As Ulong)'b as ball) 'custom
    #define incircle(cx,cy,r,mx,my,a) _
    Iif(a<=1,a*(cx-mx)*a*(cx-mx) +1*(cy-my)*1*(cy-my)<= r*r*a*a,a*(cx-mx)*a*(cx-mx) +1*(cy-my)*1*(cy-my)<= (r)*(r))
    For x As Long=xx-r To xx+r
        For y As Long=yy-r To yy+r
            If incircle(xx,yy,r,x,y,1) Then
                SetPixel(h,x,y,clr)
            End If
        Next
    Next
End Sub

sub dots(h as hdc)
     #define Irange(f,l) Int(Rnd*((l+1)-(f)))+(f)
     for n as long=1 to 500
         SetPixel(h,irange(0,Loword(Width)*8),irange(0,Hiword(Width)*16),bgr(255,255,255))
     next
end sub

Sleep 100
randomize 3
    clearscreen()
    dots(Memhdc)
    _circle(Memhdc,700,100,50,bgr(255,255,255))
    _circle(Memhdc,690,100,48,bgr(50,50,50))
    pprint "Last night I saw the new moon",5,15,,rnd*bgr(255,255,255)
    pprint "With the old moon in her arm,",5,45,,rnd*bgr(255,255,255)
    pprint "A sign, a sign since we were born",5,75,,rnd*bgr(255,255,255)
    pprint "There'll be a deadly storm.",5,105,,rnd*bgr(255,255,255)
    pprint "They had not sailed upon the sea",5,135,,rnd*bgr(255,255,255)
    pprint "A day, but barely three,",5,165,,rnd*bgr(255,255,255)
    pprint "When loud and boisterous grew the winds",5,195,,rnd*bgr(255,255,255)
    pprint "And stormy grew the sea.",5,225,,rnd*bgr(255,255,255)
    pprint "(From Anglified version of the ballad of Sir Patrick Spens)",5,300,20,bgr(255,255,255),"times new roman"
    BitBlt(h,0, 0,Loword(Width)*8,Hiword(Width)*16,Memhdc, 0, 0,SRCCOPY)


sub finish destructor
DeleteObject(Membitmap)
DeleteDC    (Memhdc)
end sub
Sleep
 

[Löwenherz]

Just an Idea but thats Not Working perfect with initdoublebuffering

Code: Select all

#include "windows.bi"

Dim Shared As hdc h:h=getdc(getconsolewindow())
Dim Shared As hdc Memhdc:Memhdc = CreateCompatibleDC(h)
Dim Shared As Any Ptr	Membitmap:Membitmap = CreateCompatibleBitmap(h, Loword(Width)*8,Hiword(Width)*16)
SelectObject(Memhdc, Membitmap)
SelectObject(Memhdc,GetStockObject(DC_BRUSH))
SelectObject(Memhdc,GetStockObject(DC_PEN))
Declare Sub getconsole(Byref columns As Long,Byref rows As Long) 
Dim Shared As Long xx,yy
Dim Shared As Long height
getconsole(xx,yy)
Print xx,yy
Print Loword(Width),Hiword(Width)
print "Press any key"
sleep


Sub getconsole(Byref columns As Long,Byref rows As Long) 
    Dim As CONSOLE_SCREEN_BUFFER_INFO csbi
    print GetConsoleScreenBufferInfo(GetStdHandle(STD_OUTPUT_HANDLE), @csbi)
    columns = csbi.srWindow.Right - csbi.srWindow.Left + 1
    rows = csbi.srWindow.Bottom - csbi.srWindow.Top + 1
End Sub

Sub setfontsize(h As hdc,size As Long,style As zstring Ptr)
    SelectObject(h,CreateFont(size,0,0,0,Loword(Width)*8,0,0,0,DEFAULT_CHARSET,OUT_OUTLINE_PRECIS,CLIP_DEFAULT_PRECIS,ANTIALIASED_QUALITY,VARIABLE_PITCH,style)) 
End Sub

Sub setfontcolours(h As hdc,text As Ulong)
    SetTextColor(h,text) 
    SetBkMode(h,transparent)
End Sub


Sub ClearScreen(c As Ulong=bgr(0,0,100))
    Var colour=c
    SetDCBrushColor(memhdc,colour)
    SetDCPenColor(memhdc,colour)
    rectangle(memhdc,0,0,Loword(Width)*8,Hiword(Width)*16)
End Sub

Sub text(h As hdc,x As Long,y As Long,s As String)
    textout(h,x,y,s,Len(s))
End Sub

Sub pprint(s As String,x As Long,y As Long,size As Long=30,colour As Ulong=bgr(200,100,0),kind As String="courier new")
	setfontsize(Memhdc,size,kind)
    setfontcolours(Memhdc,colour)
    text(Memhdc,x,y,s)
End Sub

Sub _circle(h As hdc,xx As Long,yy As Long,r As Long,clr As Ulong)'b as ball) 'custom
    #define incircle(cx,cy,r,mx,my,a) _
    Iif(a<=1,a*(cx-mx)*a*(cx-mx) +1*(cy-my)*1*(cy-my)<= r*r*a*a,a*(cx-mx)*a*(cx-mx) +1*(cy-my)*1*(cy-my)<= (r)*(r))
    For x As Long=xx-r To xx+r
        For y As Long=yy-r To yy+r
            If incircle(xx,yy,r,x,y,1) Then
                SetPixel(h,x,y,clr)
            End If
        Next
    Next
End Sub

Sub CleanUp()
    DeleteObject(Membitmap)
    DeleteDC(Memhdc)
    ReleaseDC(GetConsoleWindow(), h)
End Sub

sub dots(h as hdc)
     #define Irange(f,l) Int(Rnd*((l+1)-(f)))+(f)
     for n as long=1 to 500
         SetPixel(h,irange(0,Loword(Width)*8),irange(0,Hiword(Width)*16),bgr(255,255,255))
     next
end sub

' Initialize the double buffering ' just an idea
Sub InitDoubleBuffering()
    h = GetDC(GetConsoleWindow())
    Memhdc = CreateCompatibleDC(h)
    'Membitmap = CreateCompatibleBitmap(h, WIDTH, HEIGHT) 
    
    SelectObject(Memhdc, Membitmap)
    SelectObject(Memhdc, GetStockObject(DC_BRUSH))
    SelectObject(Memhdc, GetStockObject(DC_PEN))
End Sub


Sleep 100
randomize 3

InitDoubleBuffering()

    Dim columns As Long, rows As Long
    GetConsole(columns, rows)
    Print columns, rows

    clearscreen()
    dots(Memhdc)
    _circle(Memhdc,700,100,50,bgr(255,255,255))
    _circle(Memhdc,690,100,48,bgr(50,50,50))
    pprint "Last night I saw the new moon",5,15,,rnd*bgr(255,255,255)
    pprint "With the old moon in her arm,",5,45,,rnd*bgr(255,255,255)
    pprint "A sign, a sign since we were born",5,75,,rnd*bgr(255,255,255)
    pprint "There'll be a deadly storm.",5,105,,rnd*bgr(255,255,255)
    pprint "They had not sailed upon the sea",5,135,,rnd*bgr(255,255,255)
    pprint "A day, but barely three,",5,165,,rnd*bgr(255,255,255)
    pprint "When loud and boisterous grew the winds",5,195,,rnd*bgr(255,255,255)
    pprint "And stormy grew the sea.",5,225,,rnd*bgr(255,255,255)
    pprint "(From Anglified version of the ballad of Sir Patrick Spens)",5,300,20,bgr(255,255,255),"times new roman"
    BitBlt(h,0, 0,Loword(Width)*8,Hiword(Width)*16,Memhdc, 0, 0,SRCCOPY)

Sleep(5000) ' Keep the window open for 5 seconds
    CleanUp()
    
sub finish destructor
DeleteObject(Membitmap)
DeleteDC    (Memhdc)
end sub
Sleep

[dodicat]

Hi Löwenherz.
Still no graphics on terminal.
Another win terminal problem, fb print is not scrollable, printf must be used.
Here is a workaround to use print with it's various options, semi colon, comma, tab, using.

Code: Select all

#include once "crt/stdio.bi"

#macro Tprint(n...)
printf(!"\n")
print n;
#endmacro


for n as long=0 to 4000
    Tprint( n;" Test digit + semi-colon","test comma";tab(50);"test TAB";using "  Test USING ###.### ";sqr(n)  )
next n
Tprint ( "All these lines are scrollable back to the first line" )
sleep 

[Löwenherz]

Hello dodicat...

Still no graphics on terminal.

What does IT mean sorry.. do you have another example to Check?

[dodicat]

I know graphics to the console is hardly ever done in fb, although I did a video player a while back, and a colour finder.
Console colour finder (example 2):

Code: Select all

#define _WIN32_WINNT  &h0500
#include "windows.bi"
#include "crt.bi"
Declare Function SetWindowTheme Lib "UxTheme.dll" Alias "SetWindowTheme"(As Any Ptr,As zstring Ptr,As zstring Ptr) As Long
'non resizable console
SetWindowLong(GetConsoleWindow(),GWL_STYLE, GetWindowLong(GetConsoleWindow(), GWL_STYLE) And Not(WS_MAXIMIZEBOX) And Not(WS_SIZEBOX))

Union Colour                          
      As Ulong c                 
      Type
      As Ubyte r,g,b,a 'windae's bgr
      End Type
End Union

Dim As hwnd p = GetConsoleWindow()
Dim As Point pt
Dim As colour clr
Dim As Long r=50
setwindowpos(p, HWND_TOPMOST, 100, 100, 200, 280, SWP_SHOWWINDOW)
SetWindowTheme(p," "," ")
Shell("title [MOVE]")
Dim As hdc h=GetDC(0), wh=GetDC(p)
SelectObject(wh,GetStockObject(DC_BRUSH))
SelectObject(wh,GetStockObject(DC_PEN))
While p<>0
      getcursorpos(@pt)
      clr.c=getpixel(h,pt.x,pt.y)
      ShowScrollBar(p, SB_BOTH, FALSE)
      SetDCBrushColor(wh,clr.c)
      SetDCPenColor(wh,clr.c)
      ellipse(wh,(95-r),(70-r),(95+r),(70+r))
      Locate(10,3,0)
      printf("Red   %s","   ")
      Locate(10,3,0)
      printf("Red   %d",clr.r)
      Locate(11,3,0)
      printf("Green %s","   ")
      Locate(11,3,0)
      printf("Green %d",clr.g)
      
      Locate(12,3,0)
      printf("Blue  %s","   ")
      Locate(12,3,0)
      printf("Blue  %d",clr.b)
      
      Locate(13,3,0)
      printf("HEX   %s","          ")
      Locate(13,3,0)
      Var s=Hex(clr.c,8)
      printf("HEX  %s"," &h")
      printf("%s",s)
      
      Locate(14,3,0)
      printf("RAW   %s","          ")
      Locate(14,3,0)
      printf("RAW   %d",clr.c)
      
      Locate(15,3,0)
      printf("X,Y   %s","             ")
      Locate(15,3,0)
      printf("X,Y   %d ,%s %d",pt.x,"",pt.y)
      Sleep(20)
Wend
 

This Console colour finder will only work with windows console host, and not windows terminal--which is the default console in win 11.
Basically, I cannot get the handle to the terminal, the handle to the old console (windows console host) is
Dim As hwnd p = GetConsoleWindow()
And also, from my previous post, fb print does not scroll in the terminal, I did a rough workaround.

[Löwenherz]

I have the solution: the Trick is "showScrollbar"

hello dodicat, I have found the solution

Code: Select all

 'Dim As hwnd p = GetConsoleWindow()
#define _WIN32_WINNT  &h0500
#include once "crt/stdio.bi"
#Include "windows.bi"
#include "crt.bi"
#macro Tprint(n...)
printf(!"\n")
print n;
#endmacro

'Declare Function ShowScrollBar Lib "user32.dll" (ByVal hwnd As HWND, ByVal wBar As Integer, ByVal bShow As Integer) As Integer

Declare Function SetWindowTheme Lib "UxTheme.dll" Alias "SetWindowTheme"(As Any Ptr,As zstring Ptr,As zstring Ptr) As Long
'non resizable console
SetWindowLong(GetConsoleWindow(),GWL_STYLE, GetWindowLong(GetConsoleWindow(), GWL_STYLE) And Not(WS_MAXIMIZEBOX) And Not(WS_SIZEBOX))

Union Colour
      As Ulong c
      Type
      As Ubyte r,g,b,a 'windae's bgr
      End Type
End Union

Dim As hwnd p = GetConsoleWindow()
Dim As Point pt
Dim As colour clr
Dim As Long r=50
setwindowpos(p, HWND_TOPMOST, 100, 100, 200, 280, SWP_SHOWWINDOW)
SetWindowTheme(p," "," ")
Shell("title [MOVE]")

' Set the console buffer size to be larger than the window size
Dim bufferSize As COORD
bufferSize.X = 80 ' Width of the buffer
bufferSize.Y = 300 ' Height of the buffer (larger than the window height)
SetConsoleScreenBufferSize(GetStdHandle(STD_OUTPUT_HANDLE), bufferSize)

' Enable scrollbars
ShowScrollBar(p, SB_VERT, TRUE)

Dim As hdc h=GetDC(0), wh=GetDC(p)
SelectObject(wh,GetStockObject(DC_BRUSH))
SelectObject(wh,GetStockObject(DC_PEN))
While p<>0
      getcursorpos(@pt)
      clr.c=getpixel(h,pt.x,pt.y)
      SetDCBrushColor(wh,clr.c)
      SetDCPenColor(wh,clr.c)
      ellipse(wh,(95-r),(70-r),(95+r),(70+r))
      Locate(10,3,0)
      printf("Red   %s","   ")
      Locate(10,3,0)
      printf("Red   %d",clr.r)
      Locate(11,3,0)
      printf("Green %s","   ")
      Locate(11,3,0)
      printf("Green %d",clr.g)

      Locate(12,3,0)
      printf("Blue  %s","   ")
      Locate(12,3,0)
      printf("Blue  %d",clr.b)

      Locate(13,3,0)
      printf("HEX   %s","          ")
      Locate(13,3,0)
      Var s=Hex(clr.c,8)
      printf("HEX  %s"," &h")
      printf("%s",s)

      Locate(14,3,0)
      printf("RAW   %s","          ")
      Locate(14,3,0)
      printf("RAW   %d",clr.c)

      Locate(15,3,0)
      printf("X,Y   %s","             ")
      Locate(15,3,0)
      printf("X,Y   %d ,%s %d",pt.x,"",pt.y)
      Sleep(20)

      Dim n As Long
      wend

Sleep 50

'ShowScrollBar(p, SB_BOTH, FALSE)
'ShowScrollBar(p, SB_VERT, TRUE)

[hhr]

I have experimented a little:
- Hide cursor
- Hide scrollbars
- Refresh window when it is brought from the background to the foreground...

In Ellipse I have replaced wh with Memhdc.

The sub _circle puts a lot of load on the computer.

Code: Select all

#include "windows.bi"

Locate ,,0 'Hide the cursor
Screen 0 'Hide the scrollbars
Width 40,25

Dim As hdc h : h = getdc(getconsolewindow)
Dim As hdc Memhdc : Memhdc = CreateCompatibleDC(h)
Dim As Any Ptr Membitmap : Membitmap = CreateCompatibleBitmap(h, Loword(Width)*8,Hiword(Width)*16)

SelectObject(Memhdc, Membitmap)

Sub _circle(h As hdc,xx As Long,yy As Long,r As Long,clr As Ulong)'b as ball) 'custom
   #define incircle(cx,cy,r,mx,my,a) _
   Iif(a<=1,a*(cx-mx)*a*(cx-mx) +1*(cy-my)*1*(cy-my)<= r*r*a*a,a*(cx-mx)*a*(cx-mx) +1*(cy-my)*1*(cy-my)<= (r)*(r))
   For x As Long=xx-r To xx+r
      For y As Long=yy-r To yy+r
         If incircle(xx,yy,r,x,y,1) Then
            SetPixel(h,x,y,clr)
         End If
      Next
   Next
End Sub

Do 'Refresh the window
   ellipse(Memhdc,200,150,300,250)
   _circle(Memhdc,100,100,50,bgr(255,255,0))
   _circle(Memhdc,110,100,48,bgr(50,50,50))
   BitBlt(h,0, 0,Loword(Width)*8,Hiword(Width)*16,Memhdc, 0, 0,SRCCOPY)
   Sleep 100,1
Loop' Until Len(Inkey)

[dodicat]

Thanks hhr/ Löwenherz .
OK in windows console host (old console), but nothing on the windows terminal (New thing from win 11).
hhr, you can do ellipse from my _circle by adding another parameter.

Code: Select all

#include "windows.bi"

Locate ,,0 'Hide the cursor
Screen 0 'Hide the scrollbars
Width 40,25

Dim As hdc h : h = getdc(getconsolewindow)
Dim As hdc Memhdc : Memhdc = CreateCompatibleDC(h)
Dim As Any Ptr Membitmap : Membitmap = CreateCompatibleBitmap(h, Loword(Width)*8,Hiword(Width)*16)

SelectObject(Memhdc, Membitmap)

Sub _circle(h As hdc,xx As Long,yy As Long,r As Long,clr As Ulong,e as single=1)'b as ball) 'custom
   #define incircle(cx,cy,r,mx,my,a) _
   Iif(a<=1,a*(cx-mx)*a*(cx-mx) +1*(cy-my)*1*(cy-my)<= r*r*a*a,a*(cx-mx)*a*(cx-mx) +1*(cy-my)*1*(cy-my)<= (r)*(r))
   For x As Long=xx-r To xx+r
      For y As Long=yy-r To yy+r
         If incircle(xx,yy,r,x,y,e) Then
            SetPixel(h,x,y,clr)
         End If
      Next
   Next
End Sub

Do 'Refresh the window
   ellipse(Memhdc,200,150,300,250)
   _circle(Memhdc,100,100,50,bgr(255,255,0),.5)
   _circle(Memhdc,110,100,48,bgr(50,50,50),1.5)
   BitBlt(h,0, 0,Loword(Width)*8,Hiword(Width)*16,Memhdc, 0, 0,SRCCOPY)
   Sleep 100,1
Loop' Until Len(Inkey) 

[hhr]

If the image is not changed, ellipse and _circle can be removed from the loop.
The CPU load is then reduced.

Code: Select all

ellipse(Memhdc,200,150,300,250)
_circle(Memhdc,100,100,50,bgr(255,255,0),.5)
_circle(Memhdc,110,100,48,bgr(50,50,50),1.5)

Do 'Refresh the window
   BitBlt(h,0, 0,Loword(Width)*8,Hiword(Width)*16,Memhdc, 0, 0,SRCCOPY)
   Sleep 1,1
Loop' Until Len(Inkey)

[UEZ]

You can get the handle of the WindowsTerminal.exe using these lines:

Code: Select all

Dim As HWND hWndWT
hWndWT = FindWindow("CASCADIA_HOSTING_WINDOW_CLASS", NULL)

Investigations has shown that the issue is that Windows Terminal does not support direct GDI rendering. Windows Terminal (WindowsTerminal.exe) uses DirectWrite and DirectX instead of GDI.

DirectX is an unknown area for me and the examples I found don't work...

More information about Windows Terminal: https://github.com/microsoft/terminal/t ... wsTerminal

[srvaldez]

Hi UEZ
with your code one can easily check if your program is running in the new fandangled Windows 11 terminal, if hWndWT <> 0

[UEZ]

Hi UEZ
with your code one can easily check if your program is running in the new fandangled Windows 11 terminal, if hWndWT <> 0

When started not in a console windows:
The problem is that other console programs can also be started and attached to WindowsTerminal.exe.
Therefore, the check is no guarantee that the app is in the Windows Terminal window. You have to check if your app is running as a child process under conhost.exe
If conhost.exe is the child process then most likely it is attached to the Windows Terminal window which is started as a service.

There is no visibility in the task list between your app and WindowsTerminal.exe.

When it is started in a console windows then it should be a child process of WindowsTerminal.exe when started in the new console. Otherwise same as above.