Here is a printf subroutine that prints to the active window.
It is slow. Some assembler is required but is beyond me.
I started with some code that was posted by Dave Navarro and I
added to it. I tend to use an SDK window as a console window and
have routines to emulate the Basic PRINT, CLS, LOCATE etc. I
bought PBCC but do not use it because of the console window's
poor performance and my lack of control of the console window and
its event loop. If I would have bought PBCC directly from
Powerbasic I would have asked for my money back. The fact that
there is a market for CONSOLE TOOLS speaks volumes. PBDLL should
have been designed with its PRINT etc. commands in place.
I came from a Mac background. There was a basic called Zbasic
(now FutureBasic) which should be the model for this issue.
I will get off my soap box now.
'-------------------------------------------------------------------------------
' printf subroutine will print to the active window
' by Jim Klutho with code by Dave Navarro from Powerbasic forum
' Sept 12, 2001
'-------------------------------------------------------------------------------
#COMPILE EXE
#INCLUDE "WIN32API.INC"
DECLARE SUB printf CDECL (BYVAL f AS STRING [, ANY , ANY, ANY, ANY, ANY, ANY, ANY, ANY, ANY])
'------------------------------------------------------------------------------
FUNCTION WINMAIN (BYVAL hInstance AS LONG, _
BYVAL hPrevInstance AS LONG, _
lpCmdLine AS ASCIIZ PTR, _
BYVAL iCmdShow AS LONG) AS LONG
LOCAL Msg AS tagMsg
LOCAL wndclass AS WndClassEx
LOCAL szAppName AS ASCIIZ * 80
LOCAL hWnd AS LONG
LOCAL hTemp AS LONG
szAppName = "MyWin"
wndclass.cbSize = SIZEOF(WndClass)
wndclass.style = %CS_HREDRAW OR %CS_VREDRAW
wndclass.lpfnWndProc = CODEPTR( WndProc )
wndclass.cbClsExtra = 0
wndclass.cbWndExtra = 0
wndclass.hInstance = hInstance
wndclass.hIcon = LoadIcon( hInstance, "HELLOWIN" )
wndclass.hCursor = LoadCursor( %NULL, BYVAL %IDC_ARROW )
wndclass.hbrBackground = GetStockObject( %WHITE_BRUSH )
wndclass.lpszMenuName = %NULL
wndclass.lpszClassName = VARPTR( szAppName )
wndclass.hIconSm = LoadIcon( hInstance, BYVAL %IDI_APPLICATION )
RegisterClassEx wndclass
hWnd = CreateWindow(szAppName, _ ' window class name
"Printf Test", _ ' window caption
%WS_OVERLAPPEDWINDOW , _ ' window style
%CW_USEDEFAULT, _ ' initial x position
%CW_USEDEFAULT, _ ' initial y position
%CW_USEDEFAULT, _ ' initial x size
%CW_USEDEFAULT, _ ' initial y size
%NULL, _ ' parent window handle
%NULL, _ ' window menu handle
hInstance, _ ' program instance handle
BYVAL %NULL) ' creation parameters
ShowWindow hWnd, iCmdShow
hTemp=130
printf "%@ Press F1 thru F5 - see code for explaination",hTemp
WHILE GetMessage(Msg, %NULL, 0, 0)
TranslateMessage Msg
DispatchMessage Msg
WEND
FUNCTION = msg.wParam
END FUNCTION ' WinMain
'------------------------------------------------------------------------------
FUNCTION WndProc (BYVAL hWnd AS LONG, BYVAL wMsg AS LONG, _
BYVAL wParam AS LONG, BYVAL lParam AS LONG) EXPORT AS LONG
LOCAL x AS LONG
LOCAL hTemp AS LONG
LOCAL mydouble AS DOUBLE
SELECT CASE wMsg
CASE %WM_CREATE
'Do nothing
CASE %WM_KEYDOWN
SELECT CASE wParam
CASE %VK_F1 'Clear Screen
printf "\c"
CASE %VK_F2 'Print 100 lines
FOR x=1 TO 100
printf "Test line %l\n" , x
NEXT x
CASE %VK_F3 'Move to 10,20 and print line
hTemp=1959
printf "%@ Move to row 19 col 59", hTemp
CASE %VK_F4 'Print successive lines
printf "\cThis is"
printf "a test string"
CASE %VK_F5 'Formatted double on row 4 col 1
mydouble=123.456789
hTemp=401
printf "\c %@ This is my formatted double %6.2d",hTemp,mydouble
END SELECT
hTemp=130
printf "%@ Press F1 thru F5 - see code for explaination", hTemp
FUNCTION = 0
EXIT FUNCTION
CASE %WM_DESTROY
PostQuitMessage 0
FUNCTION = 0
EXIT FUNCTION
END SELECT
FUNCTION = DefWindowProc(hWnd, wMsg, wParam, lParam)
END FUNCTION
SUB printf CDECL (BYVAL f AS STRING [, ANY , ANY, ANY, ANY, ANY, ANY, ANY, ANY, ANY])
LOCAL x AS LONG
LOCAL count AS LONG
LOCAL p AS STRING PTR
LOCAL s AS STRING PTR
LOCAL b AS BYTE
LOCAL t AS STRING
LOCAL ps AS STRING
LOCAL tlen AS STRING
LOCAL prec AS STRING
LOCAL formatstr AS STRING
LOCAL myf AS SINGLE PTR
LOCAL myi AS INTEGER PTR
LOCAL myl AS LONG PTR
LOCAL myd AS DOUBLE PTR
LOCAL myb AS BYTE PTR
LOCAL hWnd AS LONG
LOCAL hDC AS LONG
STATIC row AS LONG
STATIC col AS LONG
STATIC CurrentX AS LONG
STATIC CurrentY AS LONG
LOCAL itemp AS LONG
LOCAL windowWidth AS LONG
LOCAL windowHeight AS LONG
LOCAL outstr AS ASCIIZ * 256
LOCAL wndrect AS RECT
LOCAL numrows AS LONG
LOCAL numcols AS LONG
LOCAL hFont AS LONG
LOCAL hOldFont AS LONG
LOCAL FontHeight AS LONG
LOCAL FontWidth AS LONG
LOCAL crColor AS LONG
LOCAL clrbrush AS LONG
LOCAL stat AS LONG
hWnd=GetActiveWindow
IF hWnd=0 THEN GOTO endprintf
hDC = GetDC(hWnd)
GetClientRect hWnd, wndrect
hFont=GetStockObject(%OEM_FIXED_FONT) 'height 14 width 8
FontHeight=14
FontWidth=8
hOldFont=SelectObject(hDC,hFont)
numrows=wndrect.nBottom\FontHeight
numcols=wndrect.nRight\FontWidth
crColor=RGB(255,255,255) ' White
clrbrush=CreateSolidBrush(crColor)
IF CurrentY < 1 THEN CurrentY=1
IF CurrentX < 1 THEN CurrentX=1
p = VARPTR(f)
FOR x = 1 TO LEN(f)
b = ASC(f, x)
IF b = 37 THEN
INCR x
b = ASC(f, x)
IF ((b > 47 AND b < 58) OR b=46) THEN GOSUB printfprecision
IF b = 37 THEN
t = t & CHR$(b)
ELSE
p = p + 4
SELECT CASE b
CASE 100 'd float (double)
myd=p
IF LEN(formatstr)>0 THEN
t = t & FORMAT$(@@myd,formatstr)
ELSE
t = t & FORMAT$(@@myd)
END IF
CASE 98 'b byte
myb=p
IF LEN(formatstr)>0 THEN
t = t & FORMAT$(@@myb,formatstr)
ELSE
t = t & FORMAT$(@@myb)
END IF
CASE 102 'f float (single)
myf=p
IF LEN(formatstr)>0 THEN
t = t & FORMAT$(@@myf,formatstr)
ELSE
t = t & FORMAT$(@@myf)
END IF
CASE 105 'i integer
myi=p
IF LEN(formatstr)>0 THEN
t = t & FORMAT$(@@myi,formatstr)
ELSE
t = t & FORMAT$(@@myi)
END IF
CASE 108 'l long
myl=p
IF LEN(formatstr)> 0 THEN
t = t & FORMAT$(@@myl,formatstr)
ELSE
t = t & FORMAT$(@@myl)
END IF
CASE 115 's string
s = p
IF LEN(formatstr)>0 THEN
t = t & MID$(@@s,1,VAL(tlen))
ELSE
t = t & @@s
END IF
CASE 64 '@ moveto row col row is in hundreds example: row 19 and col 59 = 1959
myl=p
CurrentY=(@@myl)\100
CurrentX=(@@myl) MOD 100
END SELECT
END IF '%
ELSEIF b=92 THEN '\
INCR x
b = ASC(f, x)
SELECT CASE b
CASE 110 'n
GOSUB printfprint
INCR CurrentY
CurrentX=1
CASE 99 'c
FillRect hDC,wndrect,clrbrush
CurrentX=1
CurrentY=1
END SELECT
ELSE
t = t & CHR$(b)
END IF
NEXT
IF LEN(t)> 0 THEN GOSUB printfprint
GOTO endprintf
printfprecision:
formatstr=""
ps=""
WHILE ((b > 47 AND b < 58) OR b=46)
ps=ps & CHR$(b)
INCR x
b = ASC(f, x)
WEND
count=INSTR(1,ps,".")
IF count > 0 THEN
tlen=MID$(ps,1,count-1)
prec=MID$(ps,count+1)
ELSE
tlen=ps
prec="0"
END IF
formatstr=STRING$(VAL(tlen),"#")
IF count > 0 THEN
IF LEN(prec)>0 THEN formatstr=formatstr +"."+ STRING$(VAL(prec),"#")
END IF
RETURN
printfprint:
itemp=LEN(t)
outstr=t
IF CurrentY > numrows THEN
CurrentY = numrows
stat= ScrollWindow (hWnd,0,-FontHeight,wndrect,wndrect)
END IF
ValidateRect hWnd, BYVAL %NULL
col=CurrentX * FontWidth - 6
row=CurrentY * FontHeight - 12
CALL Textout(hDC,col,row,outstr,itemp)
CurrentX = CurrentX + LEN(t)+1
t=""
RETURN
endprintf:
ReleaseDC hWnd, hDC
hOldFont=SelectObject(hDC,hOldFont)
DeleteObject hFont
DeleteObject clrbrush
END SUB
------------------
It is slow. Some assembler is required but is beyond me.
I started with some code that was posted by Dave Navarro and I
added to it. I tend to use an SDK window as a console window and
have routines to emulate the Basic PRINT, CLS, LOCATE etc. I
bought PBCC but do not use it because of the console window's
poor performance and my lack of control of the console window and
its event loop. If I would have bought PBCC directly from
Powerbasic I would have asked for my money back. The fact that
there is a market for CONSOLE TOOLS speaks volumes. PBDLL should
have been designed with its PRINT etc. commands in place.
I came from a Mac background. There was a basic called Zbasic
(now FutureBasic) which should be the model for this issue.
I will get off my soap box now.
'-------------------------------------------------------------------------------
' printf subroutine will print to the active window
' by Jim Klutho with code by Dave Navarro from Powerbasic forum
' Sept 12, 2001
'-------------------------------------------------------------------------------
#COMPILE EXE
#INCLUDE "WIN32API.INC"
DECLARE SUB printf CDECL (BYVAL f AS STRING [, ANY , ANY, ANY, ANY, ANY, ANY, ANY, ANY, ANY])
'------------------------------------------------------------------------------
FUNCTION WINMAIN (BYVAL hInstance AS LONG, _
BYVAL hPrevInstance AS LONG, _
lpCmdLine AS ASCIIZ PTR, _
BYVAL iCmdShow AS LONG) AS LONG
LOCAL Msg AS tagMsg
LOCAL wndclass AS WndClassEx
LOCAL szAppName AS ASCIIZ * 80
LOCAL hWnd AS LONG
LOCAL hTemp AS LONG
szAppName = "MyWin"
wndclass.cbSize = SIZEOF(WndClass)
wndclass.style = %CS_HREDRAW OR %CS_VREDRAW
wndclass.lpfnWndProc = CODEPTR( WndProc )
wndclass.cbClsExtra = 0
wndclass.cbWndExtra = 0
wndclass.hInstance = hInstance
wndclass.hIcon = LoadIcon( hInstance, "HELLOWIN" )
wndclass.hCursor = LoadCursor( %NULL, BYVAL %IDC_ARROW )
wndclass.hbrBackground = GetStockObject( %WHITE_BRUSH )
wndclass.lpszMenuName = %NULL
wndclass.lpszClassName = VARPTR( szAppName )
wndclass.hIconSm = LoadIcon( hInstance, BYVAL %IDI_APPLICATION )
RegisterClassEx wndclass
hWnd = CreateWindow(szAppName, _ ' window class name
"Printf Test", _ ' window caption
%WS_OVERLAPPEDWINDOW , _ ' window style
%CW_USEDEFAULT, _ ' initial x position
%CW_USEDEFAULT, _ ' initial y position
%CW_USEDEFAULT, _ ' initial x size
%CW_USEDEFAULT, _ ' initial y size
%NULL, _ ' parent window handle
%NULL, _ ' window menu handle
hInstance, _ ' program instance handle
BYVAL %NULL) ' creation parameters
ShowWindow hWnd, iCmdShow
hTemp=130
printf "%@ Press F1 thru F5 - see code for explaination",hTemp
WHILE GetMessage(Msg, %NULL, 0, 0)
TranslateMessage Msg
DispatchMessage Msg
WEND
FUNCTION = msg.wParam
END FUNCTION ' WinMain
'------------------------------------------------------------------------------
FUNCTION WndProc (BYVAL hWnd AS LONG, BYVAL wMsg AS LONG, _
BYVAL wParam AS LONG, BYVAL lParam AS LONG) EXPORT AS LONG
LOCAL x AS LONG
LOCAL hTemp AS LONG
LOCAL mydouble AS DOUBLE
SELECT CASE wMsg
CASE %WM_CREATE
'Do nothing
CASE %WM_KEYDOWN
SELECT CASE wParam
CASE %VK_F1 'Clear Screen
printf "\c"
CASE %VK_F2 'Print 100 lines
FOR x=1 TO 100
printf "Test line %l\n" , x
NEXT x
CASE %VK_F3 'Move to 10,20 and print line
hTemp=1959
printf "%@ Move to row 19 col 59", hTemp
CASE %VK_F4 'Print successive lines
printf "\cThis is"
printf "a test string"
CASE %VK_F5 'Formatted double on row 4 col 1
mydouble=123.456789
hTemp=401
printf "\c %@ This is my formatted double %6.2d",hTemp,mydouble
END SELECT
hTemp=130
printf "%@ Press F1 thru F5 - see code for explaination", hTemp
FUNCTION = 0
EXIT FUNCTION
CASE %WM_DESTROY
PostQuitMessage 0
FUNCTION = 0
EXIT FUNCTION
END SELECT
FUNCTION = DefWindowProc(hWnd, wMsg, wParam, lParam)
END FUNCTION
SUB printf CDECL (BYVAL f AS STRING [, ANY , ANY, ANY, ANY, ANY, ANY, ANY, ANY, ANY])
LOCAL x AS LONG
LOCAL count AS LONG
LOCAL p AS STRING PTR
LOCAL s AS STRING PTR
LOCAL b AS BYTE
LOCAL t AS STRING
LOCAL ps AS STRING
LOCAL tlen AS STRING
LOCAL prec AS STRING
LOCAL formatstr AS STRING
LOCAL myf AS SINGLE PTR
LOCAL myi AS INTEGER PTR
LOCAL myl AS LONG PTR
LOCAL myd AS DOUBLE PTR
LOCAL myb AS BYTE PTR
LOCAL hWnd AS LONG
LOCAL hDC AS LONG
STATIC row AS LONG
STATIC col AS LONG
STATIC CurrentX AS LONG
STATIC CurrentY AS LONG
LOCAL itemp AS LONG
LOCAL windowWidth AS LONG
LOCAL windowHeight AS LONG
LOCAL outstr AS ASCIIZ * 256
LOCAL wndrect AS RECT
LOCAL numrows AS LONG
LOCAL numcols AS LONG
LOCAL hFont AS LONG
LOCAL hOldFont AS LONG
LOCAL FontHeight AS LONG
LOCAL FontWidth AS LONG
LOCAL crColor AS LONG
LOCAL clrbrush AS LONG
LOCAL stat AS LONG
hWnd=GetActiveWindow
IF hWnd=0 THEN GOTO endprintf
hDC = GetDC(hWnd)
GetClientRect hWnd, wndrect
hFont=GetStockObject(%OEM_FIXED_FONT) 'height 14 width 8
FontHeight=14
FontWidth=8
hOldFont=SelectObject(hDC,hFont)
numrows=wndrect.nBottom\FontHeight
numcols=wndrect.nRight\FontWidth
crColor=RGB(255,255,255) ' White
clrbrush=CreateSolidBrush(crColor)
IF CurrentY < 1 THEN CurrentY=1
IF CurrentX < 1 THEN CurrentX=1
p = VARPTR(f)
FOR x = 1 TO LEN(f)
b = ASC(f, x)
IF b = 37 THEN
INCR x
b = ASC(f, x)
IF ((b > 47 AND b < 58) OR b=46) THEN GOSUB printfprecision
IF b = 37 THEN
t = t & CHR$(b)
ELSE
p = p + 4
SELECT CASE b
CASE 100 'd float (double)
myd=p
IF LEN(formatstr)>0 THEN
t = t & FORMAT$(@@myd,formatstr)
ELSE
t = t & FORMAT$(@@myd)
END IF
CASE 98 'b byte
myb=p
IF LEN(formatstr)>0 THEN
t = t & FORMAT$(@@myb,formatstr)
ELSE
t = t & FORMAT$(@@myb)
END IF
CASE 102 'f float (single)
myf=p
IF LEN(formatstr)>0 THEN
t = t & FORMAT$(@@myf,formatstr)
ELSE
t = t & FORMAT$(@@myf)
END IF
CASE 105 'i integer
myi=p
IF LEN(formatstr)>0 THEN
t = t & FORMAT$(@@myi,formatstr)
ELSE
t = t & FORMAT$(@@myi)
END IF
CASE 108 'l long
myl=p
IF LEN(formatstr)> 0 THEN
t = t & FORMAT$(@@myl,formatstr)
ELSE
t = t & FORMAT$(@@myl)
END IF
CASE 115 's string
s = p
IF LEN(formatstr)>0 THEN
t = t & MID$(@@s,1,VAL(tlen))
ELSE
t = t & @@s
END IF
CASE 64 '@ moveto row col row is in hundreds example: row 19 and col 59 = 1959
myl=p
CurrentY=(@@myl)\100
CurrentX=(@@myl) MOD 100
END SELECT
END IF '%
ELSEIF b=92 THEN '\
INCR x
b = ASC(f, x)
SELECT CASE b
CASE 110 'n
GOSUB printfprint
INCR CurrentY
CurrentX=1
CASE 99 'c
FillRect hDC,wndrect,clrbrush
CurrentX=1
CurrentY=1
END SELECT
ELSE
t = t & CHR$(b)
END IF
NEXT
IF LEN(t)> 0 THEN GOSUB printfprint
GOTO endprintf
printfprecision:
formatstr=""
ps=""
WHILE ((b > 47 AND b < 58) OR b=46)
ps=ps & CHR$(b)
INCR x
b = ASC(f, x)
WEND
count=INSTR(1,ps,".")
IF count > 0 THEN
tlen=MID$(ps,1,count-1)
prec=MID$(ps,count+1)
ELSE
tlen=ps
prec="0"
END IF
formatstr=STRING$(VAL(tlen),"#")
IF count > 0 THEN
IF LEN(prec)>0 THEN formatstr=formatstr +"."+ STRING$(VAL(prec),"#")
END IF
RETURN
printfprint:
itemp=LEN(t)
outstr=t
IF CurrentY > numrows THEN
CurrentY = numrows
stat= ScrollWindow (hWnd,0,-FontHeight,wndrect,wndrect)
END IF
ValidateRect hWnd, BYVAL %NULL
col=CurrentX * FontWidth - 6
row=CurrentY * FontHeight - 12
CALL Textout(hDC,col,row,outstr,itemp)
CurrentX = CurrentX + LEN(t)+1
t=""
RETURN
endprintf:
ReleaseDC hWnd, hDC
hOldFont=SelectObject(hDC,hOldFont)
DeleteObject hFont
DeleteObject clrbrush
END SUB
------------------
Comment