InputBox() in console program

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

InputBox() in console program

Postby srvaldez » Jul 15, 2019 9:00

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: 1260
Joined: Oct 23, 2016 15:28
Location: Roma, Italia
Contact:

Re: InputBox() in console program

Postby jj2007 » Jul 15, 2019 10:45

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: 5991
Joined: Jan 10, 2006 20:30
Location: Scotland

Re: InputBox() in console program

Postby dodicat » Jul 15, 2019 13:22

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

Postby marpon » Jul 15, 2019 13:52

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: 2139
Joined: Sep 25, 2005 21:54

Re: InputBox() in console program

Postby srvaldez » Jul 15, 2019 14:39

@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: 2139
Joined: Sep 25, 2005 21:54

Re: InputBox() in console program

Postby srvaldez » Jul 15, 2019 15:22

@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

Postby marpon » Jul 15, 2019 15:36

@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: 2139
Joined: Sep 25, 2005 21:54

Re: InputBox() in console program

Postby srvaldez » Jul 15, 2019 15:48

@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

Postby marpon » Jul 15, 2019 16:23

@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: 337
Joined: May 05, 2017 19:59
Location: Germany

Re: InputBox() in console program

Postby UEZ » Jul 15, 2019 18:05

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: 5991
Joined: Jan 10, 2006 20:30
Location: Scotland

Re: InputBox() in console program

Postby dodicat » Jul 15, 2019 18:06

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: 2139
Joined: Sep 25, 2005 21:54

Re: InputBox() in console program

Postby srvaldez » Jul 15, 2019 18:50

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

Re: InputBox() in console program

Postby deltarho[1859] » Jul 15, 2019 20:11

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: 337
Joined: May 05, 2017 19:59
Location: Germany

Re: InputBox() in console program

Postby UEZ » Jul 15, 2019 20:35

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: 2139
Joined: Sep 25, 2005 21:54

Re: InputBox() in console program

Postby srvaldez » Jul 15, 2019 20:44

@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.

Return to “Windows”

Who is online

Users browsing this forum: No registered users and 1 guest