InputBox() in console program

Windows specific questions.
srvaldez
Posts: 3373
Joined: Sep 25, 2005 21:54

InputBox() in console program

Post by srvaldez »

in the spirit of my previous thread viewtopic.php?f=6&t=27723 I would like a simple input box using Windows API
this could probably be achieved by using a library like IUP or GTK, but I would rather not use external libraries, I am convinced that it can be done by using Windows API, here's a rather lengthy C++ example https://www.codeproject.com/Articles/51 ... us-program and a C# example https://www.codeproject.com/Articles/10 ... utBox-in-C
unfortunately, that's about the only examples that I could find, the C++ code is too complicated for me to understand, and forget C#, don't need a .NET dependency
are any Windows API guru's up to the challenge?
thanks in advance
jj2007
Posts: 2326
Joined: Oct 23, 2016 15:28
Location: Roma, Italia
Contact:

Re: InputBox() in console program

Post by jj2007 »

That's typically a dialog. I have my own wrappers called DlgDefine & DlgControl, under the hood you would see DialogBoxIndirectParamW (the "W" meaning Unicode). Example:

Code: Select all

include \masm32\MasmBasic\MasmBasic.inc
  Init
  DlgDefine "Please enter your opinion:", 0, 0, 150, -1, , 12
  DlgControl dcEdit, "FreeBasic is great", WS_BORDER or WS_TABSTOP or ES_MULTILINE or ES_AUTOVSCROLL, 1, -1, 90.0, 18
  DlgControl dcButton, "OK", BS_DEFPUSHBUTTON or WS_TABSTOP, 91.0, -1, 12.0, , IDOK
  DlgShow
  .if eax==IDOK			; user clicked OK, let's see what was typed:
	wMsgBox 0, wCat$(Dlg$(0)+wCrLf$+Dlg$(1)), "Please confirm:", MB_OKCANCEL
  .endif
EndOfCode
Image
That looks simple but warning, it's about 300 lines of non-trivial code underneath.
dodicat
Posts: 7976
Joined: Jan 10, 2006 20:30
Location: Scotland

Re: InputBox() in console program

Post by dodicat »

I am a bit green with dialog stuff in winapi, but rolling out a custom message box is an alternative perhaps ?

Code: Select all


#Include Once "windows.bi"
#Include once "/win/commctrl.bi"

' Globals (unavoidable)
Dim Shared As zString * 255 textMessage="start"
Dim Shared As HWND  MainWindow, MessageWindow
Dim Shared As HWND EditBox, Button,msgon


Function CreateToolTip(X As hwnd,msg As String="") As hwnd
    Dim As hwnd  TT= CreateWindowEx(0,"ToolTips_Class32","",64,0,0,0,0,X,0,GetModuleHandle(0),0)
                                                           '64=bubble,0 = rectangle
    SendMessage(TT, TTM_SETMAXTIPWIDTH, 0 , 180) 
    SendMessage(TT, TTM_SETDELAYTIME, TTDT_INITIAL ,10) 
    SendMessage(TT, TTM_SETDELAYTIME, TTDT_RESHOW  ,60)
    Dim bubble As TOOLINFO 
    bubble.cbSize = Len(TOOLINFO) 
    bubble.uFlags = TTF_IDISHWND Or TTF_SUBCLASS 
    bubble.uId = Cast(Uinteger,X) 
    bubble.lpszText = Strptr(msg)
    SendMessage(TT, TTM_ADDTOOL, 0,Cast(LPARAM,@bubble))
    Return TT
End Function

Sub CreateMessageWindow
        MessageWindow = CreateWindowEx(NULL, "WindowClass", "Messages", WS_OVERLAPPEDWINDOW Or WS_VISIBLE, CW_USEDEFAULT, CW_USEDEFAULT, 300, 150, NULL, NULL, NULL, NULL)
        EditBox = CreateWindowEx(WS_EX_CLIENTEDGE, "Edit", textmessage, WS_VISIBLE Or WS_CHILD, 10, 40, 200, 24, MessageWindow, NULL, NULL, NULL)
        Button = CreateWindowEx(NULL, "Button", "Save", WS_VISIBLE Or WS_CHILD, 10, 70, 200, 24, MessageWindow, NULL, NULL, NULL)
        createtooltip(editbox,"Write in a message")
End Sub


Function WndProc(hWnd As HWND, msg As UINT, wParam As WPARAM, lParam As LPARAM) As LRESULT
    Select Case hWnd
    Case MainWindow  
        Select Case msg
        Case WM_PAINT
            Dim As PAINTSTRUCT ps
            BeginPaint(hWnd, @ps)
            FillRect(ps.hdc, @ps.rcPaint, CreateSolidBrush(BGR(0,100,0)))
            EndPaint(hWnd, @ps)
            
        Case WM_CLOSE
            PostQuitMessage(NULL) 
            
        Case WM_COMMAND
            Select Case lParam  
            Case msgon 
                CreateMessageWindow 
            End Select
        End Select
        
    Case MessageWindow  
        Select Case msg
        Case WM_COMMAND
            Select Case lParam  
            Case Button   
                GetWindowText(EditBox, @textMessage, 255)
              var mboxresult= MessageBox(MessageWindow, textMessage, "Saved", 1 )
               if mboxresult=2 then textmessage=""
                destroywindow(messagewindow)
            End Select
            
        Case WM_CLOSE
            'message window is destroyed
        End Select
    End Select
    
    Return DefWindowProc(hWnd, msg, wParam, lParam)
End Function


function main as long
' Create  window class:
Dim As WNDCLASS wcls

With wcls
    .style      = CS_HREDRAW Or CS_VREDRAW
    .lpfnWndProc  = Cast(WNDPROC, @WndProc)
    .hInstance    = GetModuleHandle(NULL)
    .hIcon      = LoadIcon(NULL, IDI_APPLICATION)
    .hCursor      = LoadCursor(NULL, IDC_ARROW)
    .hbrBackground  = GetStockObject(WHITE_BRUSH)
    .lpszMenuName  = NULL
    .lpszClassName  = Strptr("WindowClass")
End With

If RegisterClass(@wcls) = FALSE Then
    MessageBox(NULL, "RegisterClass('WindowClass') FAIL!", "Error!", MB_OK Or MB_ICONERROR)
    End
End If


MainWindow = CreateWindowEx(NULL, "WindowClass", "MainWindow", WS_OVERLAPPEDWINDOW Or WS_VISIBLE, CW_USEDEFAULT, CW_USEDEFAULT, 800, 600, NULL, NULL, NULL, NULL)
msgon= CreateWindowEx(NULL, "Button", "Messages", WS_VISIBLE Or WS_CHILD , 10, 40, 90, 24, MainWindow, NULL, NULL, NULL)

Dim As MSG uMsg
While GetMessage(@uMsg, NULL, NULL, NULL) <> FALSE
    TranslateMessage(@uMsg)
    DispatchMessage(@uMsg)
Wend
return 0
end function

end main


 
marpon
Posts: 342
Joined: Dec 28, 2012 13:31
Location: Paris - France

Re: InputBox() in console program

Post by marpon »

other alternative with rc file

Code: Select all

/'
 InputBox.bas  
                Dialog input box,
                
to see the returned input in console  
    compile with: "fbc" -s console  InputBox.bas InputBox.rc

or else if not needed to see the returned input
    compile with: "fbc" -s gui  InputBox.bas InputBox.rc


'/    



'use that sample under to create your rc file own inputbox.rc , copy from first line of rc file to last line of rc file
/'
//_BEGIN_RC_  'first line of rc file      // commented line
        #define IDD_DLG1 1000
        #define IDC_BTN2 1002
        #define IDC_EDT1 1003
        #define IDC_BTN1 1001
        #define IDC_STC1 1004
        #define Icon1 500
 
        IDD_DLG1 DIALOGEX 6,5,194,107
        CAPTION "Title position !"
        FONT 9,"MS Sans Serif",2000,0,0
        STYLE 0x10CC0800
        BEGIN
            CONTROL "Cancel",IDC_BTN2,"Button",0x50010000,99,69,63,18
            CONTROL "Ok",IDC_BTN1,"Button",0x50010000,27,69,63,18
            
            CONTROL "Info position",IDC_STC1,"Static",0x50000201,12,12,174,24
            CONTROL " input text...!",IDC_EDT1,"Edit",0x50010000,39,42,117,15,0x00000200            
        END
        
    // RC commented line
        //Icon1 ICON DISCARDABLE "your.ico" // change here for your own an uncomment means delete the 2 first / a beginning of that line
//_END_RC_  'last line of rc file       // commented line
'/



#Include Once "windows.bi"


#define IDD_DLG1 1000
#define IDC_BTN2 1002
#define IDC_EDT1 1003
#define IDC_BTN1 1001
#define IDC_STC1 1004
#define Icon1 500

Dim Shared hIn1       AS hModule
Dim Shared hIcon1     AS hIcon

Dim Shared AS String retour : retour = "Closed"
Dim Shared  AS String Titre
Dim Shared  AS String Valeur
Dim Shared  AS String Info


Declare Function DlgProc(ByVal hI1 As hWnd , ByVal uI1 As Uinteger , ByVal wP1 As wParam , ByVal lP1 As lParam) As Integer


Declare Function WinMain(ByVal hI1 As hInstance , _
        ByVal hP1 As hInstance , _
        ByRef CLine As String , _
        ByVal CShow As Integer) As Integer


WinMain(GetModuleHandle(null) , null , Command() , SW_NORMAL)

''' Program start
'''
Function WinMain(ByVal hInstExe As hInstance , _
            ByVal hPrevInstance As hInstance , _
            ByRef lpCmdLine As String , _
            ByVal iCmdShow As Integer) As Integer
    
    'change here for your own settings
    Titre = "What title ?"
    Valeur = "What input ?"
    Info = "What Info ?"
    
    
    hIn1 = hInstExe                              '' initialisation
    
    DialogBoxParam(hIn1 , Cast(ZString Ptr , IDD_DLG1) , 0 , @DlgProc , 0)
    ''
    '' Program has ended
    Return True
    
    
End Function
''' Program end



Function DlgProc(ByVal hWin As hWnd , ByVal uMsg As Uinteger , _
            ByVal wParam1 As wParam , _
            ByVal lParam1 As lParam) As Integer
    
    Dim         AS Integer id
    Dim         AS Integer Event1
    
    dim nBuffer AS string = space(50)
    
    Select Case uMsg
        Case WM_INITDIALOG
            SetWindowText hWin , Titre
            SetWindowText GetDlgItem(hWin , IDC_EDT1) , Valeur
            SetWindowText GetDlgItem(hWin , IDC_STC1) , Info
            
            hIcon1 = LoadIcon(hIn1 , Cast(ZString Ptr , Icon1))
            SendMessage(hWin , WM_SETICON , NULL , Cast(lParam , hIcon1))
        Case WM_CLOSE
            EndDialog(hWin , 0)
            '
        Case WM_COMMAND
            id = LoWord(wParam1)
            Event1 = HiWord(wParam1)
            Select Case id
                Case IDC_BTN1
                    GetWindowText GetDlgItem(hWin , IDC_EDT1) , nBuffer , 50
                    'MessageBox(hWin, nBuffer, "Test de bouton 1", MB_ICONINFORMATION)
                    retour = nBuffer
                    EndDialog(hWin , 0)
                Case IDC_BTN2
                    'MessageBox(hWin, "Fermeture du programme", "Bouton OK", MB_ICONSTOP)
                    retour = "Cancel"
                    EndDialog(hWin , 0)
                    '
            End Select
            
        Case Else
            Return FALSE
            '
    End Select
    Return TRUE
    
End Function


#if __FB_GUI__                                   ' valid only for fbc 1.06 version, not before
    
#else
    #include "crt\stdio.bi"
    printf(!"%s \n\n\n" , retour)
    printf( "Wait 5 seconds, or press any key to finish")
    sleep 5000
#endif





srvaldez
Posts: 3373
Joined: Sep 25, 2005 21:54

Re: InputBox() in console program

Post by srvaldez »

@all
thanks for your valuable code and suggestions
@marpon
your code is exactly what I am after, it compiles and runs ok when using gas but it fails to compile when using gen gcc, would you be so kind and look into it?
srvaldez
Posts: 3373
Joined: Sep 25, 2005 21:54

Re: InputBox() in console program

Post by srvaldez »

@marpon
for some reason the printf statements are not agreeable to the C compiler, replacing them with Print solves the problem :-)
marpon
Posts: 342
Joined: Dec 28, 2012 13:31
Location: Paris - France

Re: InputBox() in console program

Post by marpon »

@srvaldez
good to know

for me it works ok even with printf on gas and also on gcc 32 and gcc 64
its probably your gcc chain , or fbc version not compatibles

i"m using fbc 1.06 standalone version ,
with gcc v5.02 on 32 bits
and same gcc v5.02 on 64 bits

the libs on fbc are also (as i understood) gcc v5.02...

but ok if print is working
i often use printf because the resulting exe is smaller almost - 10ko without print (wich is a lot on very litle tools)
srvaldez
Posts: 3373
Joined: Sep 25, 2005 21:54

Re: InputBox() in console program

Post by srvaldez »

@marpon
I am using FBC Version 1.07.0 (06-06-2019), with gcc 9.1.0
when compiling to 64-bit was getting a warning on the line

Code: Select all

DialogBoxParam(hIn1 , Cast(ZString Ptr , IDD_DLG1) , 0 , @DlgProc , 0)
msgbox.bas(64) warning 3(1): Passing different pointer types, at parameter 4 of DIALOGBOXPARAM()
changing @DlgProc to cptr(DLGPROC , @DlgProc) fbc then compiles without warning
marpon
Posts: 342
Joined: Dec 28, 2012 13:31
Location: Paris - France

Re: InputBox() in console program

Post by marpon »

@srvaldez
I am using FBC Version 1.07.0 (06-06-2019), with gcc 9.1.0
that's why . Even fbc v1.07 uses libs done with gcc v5.02
that's probably the reason for printf not working ( diferent stdio lib from crt ?)


for the warning thats correct I also have same on 64bits, you have done the correct fix

so now you have a generic windows input box, for arround 35ko , if you want an very tiny one try using tcc with c code it will be arround 4ko
UEZ
Posts: 972
Joined: May 05, 2017 19:59
Location: Germany

Re: InputBox() in console program

Post by UEZ »

Here my version:

Code: Select all

'Coded by UEZ build 2019-07-15
#Include "windows.bi"

Dim Shared As HWND g__hGUI, g__hInput

Function __WndProc(hWnd As HWND, uMsg As UINT, wParam As WPARAM, lParam As LPARAM) As Integer
	Select Case hWnd
		Case g__hGUI	
			Select Case uMsg
				Case WM_CLOSE
					PostQuitMessage(0)
					Return 0
				Case WM_CTLCOLOREDIT
					If lParam = g__hInput Then
						Dim As HDC hdcStatic = Cast(HDC, wParam)
						SetTextColor(hdcStatic, &h000000) 'BGR
						SetBkColor(hdcStatic, GetSysColor(COLOR_WINDOW))
						Return Cast(INT_PTR, (GetSysColorBrush(COLOR_WINDOW)))
					End If
			End Select		
	End Select
	Return DefWindowProc(hWnd, uMsg, wParam, lParam)
End Function

Function InputBox(sText As WString, sTitle As WString, sTextL As WString = "Ok", sTextR As WString = "Cancel", iW As Ushort = 300, iX As Short = -1, iY As Short = -1) As Byte
	Dim szAppName As ZString * 30 => "FB GUI"
	Dim As Ushort iH = 110
	Dim wc As WNDCLASSEX
	Dim msg As MSG
	Dim As HWND hButton_Ok, hButton_Cancel
	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	= GetSyscolorbrush(COLOR_3DFACE)
		.lpszMenuName	= NULL
		.lpszClassName	= @szAppName
		.cbSize			= SizeOf(WNDCLASSEX)
	End With	
	RegisterClassEx(@wc)
	Dim As Integer sW, sH
	Screeninfo(sW, sH)
	iW = Iif(iW < 210, 210, Iif(iW > sW * 0.75, sW * 0.75, iW))
	If iX = -1 And iY = -1 Then
		iX = (sW - iW) / 2
		iY = (sH - iH) / 2
	End If
	g__hGUI = CreateWindowEx(WS_EX_TOPMOST, wc.lpszClassName, sTitle, WS_SYSMENU Or WS_CAPTION, iX , iY, iW, iH, NULL, NULL, wc.hInstance, NULL)
	g__hInput = CreateWindowEx(WS_EX_CLIENTEDGE Or WS_EX_NOPARENTNOTIFY, "Edit", NULL, WS_EX_TOOLWINDOW Or WS_CHILD Or WS_TABSTOP Or WS_VISIBLE, 8, 8, iW - 24, 26, g__hGUI, NULL, NULL, NULL)
	hButton_Ok = CreateWindowEx(NULL, "Button", sTextL, WS_VISIBLE Or WS_CHILD, 8, iH - 65, 90, 26, g__hGUI, NULL, NULL, NULL)
	hButton_Cancel = CreateWindowEx(NULL, "Button", sTextR, WS_VISIBLE Or WS_CHILD, iW - 110, iH - 65, 94, 26, g__hGUI, NULL, NULL, NULL)
	SetWindowText(g__hInput, sText)
	ShowWindow(g__hGUI, SW_Showna)
	While GetMessage(@msg, 0, 0, 0)
		TranslateMessage(@msg)
		DispatchMessage(@msg)
		Select Case msg.message
			Case WM_LBUTTONDOWN
				Select Case msg.hwnd
					Case hButton_Ok
						DestroyWindow(g__hGUI)
						Return 1					
					Case hButton_Cancel
						DestroyWindow(g__hGUI)
						Return 2
				End Select
		End Select
	Wend
	DestroyWindow(g__hGUI)
	Return 0
End Function

'Example
Select Case InputBox("Do you like FreeBasic?", "Test", "Yes", "No")
	Case 1
		? ":-)"
	Case 2
		? ":-("
End Select

Sleep
Edit: more a messagebox with input rather than an input box. ^^
Last edited by UEZ on Jul 15, 2019 21:14, edited 2 times in total.
dodicat
Posts: 7976
Joined: Jan 10, 2006 20:30
Location: Scotland

Re: InputBox() in console program

Post by dodicat »

How does your dialog box work marpon?
When I run I get a five second console with closed and wait five seconds.
I used -s console
Must I run the resource bit with an .ico file?

srvaldez
a simple console box

Code: Select all


#Include Once "windows.bi"

Sub box(textmessage As zstring)
    Static  As HWND  MessageWindow,EditBox,save,cancel,del
    #macro CreateMessageWindow(textmessage)
    MessageWindow = CreateWindowEx(NULL,"#32770", "What is your message?", WS_OVERLAPPEDWINDOW Or WS_VISIBLE, CW_USEDEFAULT, CW_USEDEFAULT, 350, 200, NULL, NULL, NULL, NULL)
    EditBox = CreateWindowEx(WS_EX_CLIENTEDGE, "Edit", textmessage, WS_VISIBLE Or WS_CHILD Or WS_HSCROLL  Or ES_AUTOHSCROLL Or ES_MULTILINE, 10, 0, 250, 50, MessageWindow, NULL, NULL, NULL)
    save = CreateWindowEx(NULL, "Button", "Save", WS_VISIBLE Or WS_CHILD, 10, 70, 200, 24, MessageWindow, NULL, NULL, NULL)
    cancel=CreateWindowEx(NULL, "Button", "cancel", WS_VISIBLE Or WS_CHILD, 10, 100, 200, 24, MessageWindow, NULL, NULL, NULL)
    del=CreateWindowEx(NULL, "Button", "delete message", WS_VISIBLE Or WS_CHILD, 10, 130, 200, 24, MessageWindow, NULL, NULL, NULL)
    #endmacro

    createmessagewindow(textmessage)
    Dim As msg msg1
    While GetMessage(@msg1,0,0,0)
        TranslateMessage(@msg1)
        DispatchMessage(@msg1)
        Select Case msg1.hwnd
        Case Messagewindow
            Select Case msg1.message
            Case 273  'close by clicking X
                destroywindow(messagewindow)
                Exit Sub
            End Select
            
        Case save
            Select Case msg1.message  
            Case WM_LBUTTONDOWN
                GetWindowText(EditBox,textMessage,255)
                destroywindow(messagewindow)
                Exit Sub
            End Select
            
        Case cancel
            Select Case msg1.message  
            Case WM_LBUTTONDOWN
                destroywindow(messagewindow)
                Exit Sub
            End Select
            
        Case del
            Select Case msg1.message  
            Case WM_LBUTTONDOWN
                textmessage=""
                destroywindow(messagewindow)
                Exit Sub
            End Select
        End Select
    Wend
End Sub


Dim As String s
Dim As zstring *255 txt
Do
    
    Do
        Print "Do you want to save a message y/n or <esc> key ?"
        s=Input(1)
        s=Lcase(s)
        If s=Chr(27) Then End
    Loop Until s="y" Or s="n"
    If Lcase(s)="y" Then box(txt)
    If Lcase(s)="n" Then Print "no message chosen"
    If Len(txt) Then Print "your message was  ";txt
Loop Until Multikey(1)

  
srvaldez
Posts: 3373
Joined: Sep 25, 2005 21:54

Re: InputBox() in console program

Post by srvaldez »

hi dodicat
that's very good, I really like the simplicity and brevity of your code, thank you :-)
deltarho[1859]
Posts: 4292
Joined: Jan 02, 2017 0:34
Location: UK
Contact:

Re: InputBox() in console program

Post by deltarho[1859] »

Using José Roca's WinFBX, wrappers for Windows SDK. We get a couple of warnings with gcc 9.1 but works, nonetheless.

OK with 32 or 64 bit.

Code: Select all

#Include once "Afx/CWindow.inc"

Dim S as String

S = AfxInputBox( 0, 100, 100, "Input Test", "Optional prompt" )
If Len( S ) = 0 Then
  Print "No input given"
Else
  Print S
End If

'If last parameter is True then displays all characters as an
' asterisk (*) as they are typed into the edit control.

S = AfxInputBox( 0, 100, 100, "Input Test",,,, True )
If Len( S ) = 0 Then
  Print "No input given"
Else
  Print S
End If

Sleep
Image
Last edited by deltarho[1859] on Jul 15, 2019 20:41, edited 1 time in total.
UEZ
Posts: 972
Joined: May 05, 2017 19:59
Location: Germany

Re: InputBox() in console program

Post by UEZ »

Here my next version which is small advanced version from my previous example:

Code: Select all

'Coded by UEZ build 2019-07-15
#Include "windows.bi"

Dim Shared As HWND g__hGUI, g__hInput
Dim Shared As HBRUSH g__hBrush
Dim Shared As Ulong g__TxtColor = 0


Sub __FadeInputBox()
	Static As UByte c = 0
	Dim As RECT tRECT
	GetClientRect(g__hInput, @tRECT)
	Dim As HBRUSH hBrush = CreateSolidBrush((128 + Sin(c / 10) * 127) Shl 0) 'BGR
	Dim As Any Ptr hDC = GetDC(g__hInput), _
				   hHBitmap = CreateCompatibleBitmap(hDC, tRECT.right, 26), _
				   hDC_backbuffer = CreateCompatibleDC(hDC), DC_obj, DC_obj2
	DC_obj = SelectObject(hDC_backbuffer, hHBitmap)
	DC_obj2 = SelectObject(hDC_backbuffer, hBrush)
	Rectangle(hDC_backbuffer, 0, 0, tRECT.right, 26)
	SelectObject(hDC_backbuffer, DC_obj)
	SelectObject(hDC_backbuffer, DC_obj2)
	DeleteDC(hDC_backbuffer)
	ReleaseDC(g__hInput, hDC)
	DeleteObject(hBrush)
	g__hBrush = CreatePatternBrush(hHBitmap)
	DeleteObject(hHBitmap)
	RedrawWindow(g__hInput, 0, 0, RDW_UPDATENOW Or RDW_INVALIDATE)
	c += 1
End Sub

Function __WndProc(hWnd As HWND, uMsg As UINT, wParam As WPARAM, lParam As LPARAM) As Integer
	Select Case hWnd
		Case g__hGUI	
			Select Case uMsg
				Case WM_CLOSE
					PostQuitMessage(0)
					Return 0
				Case WM_CTLCOLOREDIT
					If lParam = g__hInput Then
						Dim As HDC hdcStatic = Cast(HDC, wParam)
						SetTextColor(hdcStatic, g__TxtColor) 'BGR
						SetBkMode(hdcStatic, TRANSPARENT)
						Return Cast(INT_PTR, g__hBrush)
					End If
					Return 0
			End Select		
	End Select
	Return DefWindowProc(hWnd, uMsg, wParam, lParam)
End Function

Function InputBox(sText As ZString, sTitle As ZString, iW As Ushort = 300, iX As Short = -1, iY As Short = -1, _
				  bTopmost As Bool = 1, bFlash As Bool = 1) As String
	Dim szAppName As ZString * 30 => "FB GUI"
	Dim As Ushort iH = 110
	Dim wc As WNDCLASSEX
	Dim msg As MSG
	Dim As HWND hButton_Ok, hButton_Cancel
	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	= GetSyscolorbrush(COLOR_3DFACE)
		.lpszMenuName	= NULL
		.lpszClassName	= @szAppName
		.cbSize			= SizeOf(WNDCLASSEX)
	End With	
	RegisterClassEx(@wc)
	Dim As Integer sW, sH
	Screeninfo(sW, sH)
	iW = Iif(iW < 210, 210, Iif(iW > sW * 0.75, sW * 0.75, iW))
	If iX = -1 And iY = -1 Then
		iX = (sW - iW) / 2
		iY = (sH - iH) / 2
	End If
	g__hGUI = CreateWindowEx(WS_EX_TOPMOST * bTopmost, wc.lpszClassName, sTitle, WS_SYSMENU Or WS_CAPTION, iX , iY, iW, iH, NULL, NULL, wc.hInstance, NULL)
	g__hInput = CreateWindowEx(WS_EX_CLIENTEDGE Or WS_EX_NOPARENTNOTIFY, "Edit", NULL, WS_EX_TOOLWINDOW Or WS_CHILD Or WS_TABSTOP Or WS_VISIBLE, 8, 8, iW - 24, 26, g__hGUI, NULL, NULL, NULL)
	hButton_Ok = CreateWindowEx(NULL, "Button", "Ok", WS_VISIBLE Or WS_CHILD, 8, iH - 65, 90, 26, g__hGUI, NULL, NULL, NULL)
	hButton_Cancel = CreateWindowEx(NULL, "Button", "Cancel", WS_VISIBLE Or WS_CHILD, iW - 110, iH - 65, 94, 26, g__hGUI, NULL, NULL, NULL)
	SetWindowText(g__hInput, sText)
	ShowWindow(g__hGUI, SW_Showna)
	Dim As UINT_PTR nIDEvent
	If bFlash Then 
		g__TxtColor = &hFFFFFF
		nIDEvent = SetTimer(g__hGUI, 1, 50, Cast(Any Ptr, @__FadeInputBox))
	End If
	While GetMessage(@msg, 0, 0, 0)
		TranslateMessage(@msg)
		DispatchMessage(@msg)
		Select Case msg.message
			Case WM_LBUTTONDOWN
				Select Case msg.hwnd
					Case hButton_Ok
						If bFlash Then Killtimer(g__hGUI, nIDEvent)
						Dim As ZString * 255 sInput
						GetWindowText(g__hInput, sInput, GetWindowTextLength(g__hInput) + 1)
						DestroyWindow(g__hGUI)
						Return sInput
					Case hButton_Cancel
						If bFlash Then Killtimer(g__hGUI, nIDEvent)
						DestroyWindow(g__hGUI)
						Return ""
				End Select
		End Select
	Wend
	If bFlash Then Killtimer(g__hGUI, nIDEvent)
	DestroyWindow(g__hGUI)
	Return ""
End Function

'Example
? InputBox("Do you like FreeBasic?", "Input Box Test")
Sleep
Currently only ANSI support.
Last edited by UEZ on Jul 15, 2019 21:38, edited 3 times in total.
srvaldez
Posts: 3373
Joined: Sep 25, 2005 21:54

Re: InputBox() in console program

Post by srvaldez »

@deltarho[1859] thank you :-)
I had no Idea that Josep Roca had already made a perfect input box, I also noticed the suspicious pointer warning, but have no idea how to fix it, but as long as it works I am happy.
Post Reply