Convert vbscript to FB

[ganache]

Hi, how do I translate this to FB with messagebox

Code: Select all

num1=Cint(InputBox("Enter the no. of rotten apples: "))
num2=Cint(InputBox("Enter the total no. of apples: "))
msgbox ( "The percentage is:" & num1/num2*100 &"%")

[Xusinboy Bekchanov]

InputBox And MsgBox (MessageBox) Example:

Code: Select all

#define UNICODE
#include once "windows.bi"
#include once "/win/commctrl.bi"
Dim Shared As HWND InputBoxWindow, EditBox, Button
Dim Shared As WString * 255 TextMessage = "Type text here"

Function WndProc(hWnd As HWND, msg As UINT, wParam As WPARAM, lParam As LPARAM) As LRESULT
    Select Case msg
    Case WM_COMMAND
        Select Case lParam 
        Case Button   
            GetWindowText(EditBox, @TextMessage, 255)
            Var mboxresult = MessageBox(InputBoxWindow, TextMessage, "Saved", 1)
            If mboxresult = 2 Then TextMessage = ""
            DestroyWindow(InputBoxWindow)
        End Select
          
    Case WM_CLOSE
        'message window is destroyed
    End Select
   
    Return DefWindowProc(hWnd, msg, wParam, lParam)
End Function

Sub CreateInputBox
	InputBoxWindow = 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, InputBoxWindow, NULL, NULL, NULL)
	Button = CreateWindowEx(NULL, "Button", "Save", WS_VISIBLE Or WS_CHILD, 10, 70, 200, 24, InputBoxWindow, NULL, NULL, NULL)
End Sub

' 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  = @"WindowClass"
End With

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

CreateInputBox
ShowWindow InputBoxWindow, 1

Dim As MSG uMsg
While GetMessage(@uMsg, NULL, NULL, NULL)
    TranslateMessage(@uMsg)
    DispatchMessage(@uMsg)
Wend

[dodicat]

vbscriptwise:

Code: Select all

dim as string g
g+="num1=Cint(InputBox(""Enter the no. of rotten apples: ""))"+chr(10)
g+="num2=Cint(InputBox(""Enter the total no. of apples: ""))"+chr(10)
g+="msgbox ( ""The percentage is:"" & num1/num2*100 &""%"")"+chr(10)
'print g

function savefile(filename As String,p As String) as string
    Dim As long n=freefile
    If Open (filename For Binary Access Write As #n)=0 Then
        Put #n,,p
        Close
    Else
        Print "Unable to save " + filename:sleep:end
    End If
    return filename
End function

Sub runscript(filename As String) 
  Shell "cscript.exe /Nologo "+ filename 
End Sub


savefile("script.vbs",g)
runscript("script.vbs")
kill "script.vbs"
sleep 

[hhr]

Look at

https://github.com/JoseRoca/WinFBX

There is a green button called 'Code'.

Download the zip-file, extract it and copy the Afx-folder into the inc-folder of FreeBASIC.
Then try

Code: Select all

#Include once "Afx\CWindow.inc"
Dim As Integer num1, num2
num1 = Valint(AfxInputBox(0, 0, 0, , "Enter the no. of rotten apples: "))
num2 = Valint(AfxInputBox(0, 0, 0, , "Enter the total no. of apples: "))
AfxMsg("The percentage is:" & num1/num2*100 &"%", "")
'Sleep

In WinFBE it is unnecessary to download the zip-file:
https://github.com/PaulSquires/WinFBE/releases

[dodicat]

Method 2

Code: Select all

#include "windows.bi"

Function Set_Font (Font As String,Size As Integer,Bold As Integer,Italic As Integer,Underline As Integer,StrikeThru As Integer) As HFONT
    Dim As HDC hDC=GetDC(HWND_DESKTOP)
    Dim As Integer CyPixels=GetDeviceCaps(hDC,LOGPIXELSY)
    ReleaseDC(HWND_DESKTOP,hDC)
    Return CreateFont(0-(Size*CyPixels)/72,0,0,0,Bold,Italic,Underline,StrikeThru,ANSI_CHARSET _
    ,OUT_TT_PRECIS,CLIP_DEFAULT_PRECIS,DEFAULT_QUALITY,FF_DONTCARE,Font)
End Function

Function inputbox(message As String) As Double
    Dim As HFONT  ThisFont=Set_Font("Times new roman",12,0,0,0,0)
    Dim As Double result
    Dim  As HWND Main_Win,OKwin,edit,cancel
    Main_Win=CreateWindowEx(0,"#32770",message,WS_OVERLAPPEDWINDOW Or WS_VISIBLE,200,200,400,200,0,0,0,0)
    OKwin=CreateWindowEx(0,"button","OK", WS_VISIBLE Or WS_CHILD,0,0,60,30,Main_win,0,0,0)
    edit=CreateWindowEx(0,"edit","", WS_VISIBLE Or WS_CHILD Or WS_Border,5,100,290,30,Main_win,0,0,0)
    cancel=CreateWindowEx(0,"button","Cancel", WS_VISIBLE Or WS_CHILD,0,40,60,30,Main_win,0,0,0)
    SendMessage(edit,WM_SETFONT,Cast(WPARAM,ThisFont),0)
    SendMessage(OKWin,WM_SETFONT,Cast(WPARAM,ThisFont),0)
    SendMessage(cancel,WM_SETFONT,Cast(WPARAM,ThisFont),0)
    SetFocus( edit )
    Dim As msg msg
    While GetMessage( @msg,Main_Win,0,0)
        TranslateMessage(@msg)
        DispatchMessage(@msg)
        Select Case msg.hwnd
        Case Main_Win
            Select Case msg.message
            Case 273  
                DeleteObject(Cast(HGDIOBJ,ThisFont))
                End
            End Select
            
        Case OKwin 
            Select Case msg.message  
            Case WM_LBUTTONDOWN
                Dim As zstring * 100 s
                GetWindowText(edit,s,100)
                destroywindow(Main_Win)
                DeleteObject(Cast(HGDIOBJ,ThisFont))
                Return Val(s)
            End Select
            
        Case cancel 
            Select Case msg.message  
            Case WM_LBUTTONDOWN
                destroywindow(Main_Win)
                Exit While
            End Select   
            
        End Select
    Wend 
    DeleteObject(Cast(HGDIOBJ,ThisFont))
    Return 0
End Function

'========= start =========='

Var n1=inputbox("Enter the no. of rotten apples: ")
Var n2=inputbox("Enter the total no. of rotten apples: ")
messagebox (0,Str( n1/n2*100) &"%", "The percentage is:",mb_ok)
 

[Lothar Schirm]

InputBox And MsgBox (MessageBox) Example:

Code: Select all

#define UNICODE
#include once "windows.bi"
#include once "/win/commctrl.bi"
Dim Shared As HWND InputBoxWindow, EditBox, Button
Dim Shared As WString * 255 TextMessage = "Type text here"

Function WndProc(hWnd As HWND, msg As UINT, wParam As WPARAM, lParam As LPARAM) As LRESULT
    Select Case msg
    Case WM_COMMAND
        Select Case lParam 
        Case Button   
            GetWindowText(EditBox, @TextMessage, 255)
            Var mboxresult = MessageBox(InputBoxWindow, TextMessage, "Saved", 1)
            If mboxresult = 2 Then TextMessage = ""
            DestroyWindow(InputBoxWindow)
        End Select
          
    Case WM_CLOSE
        'message window is destroyed
    End Select
   
    Return DefWindowProc(hWnd, msg, wParam, lParam)
End Function

Sub CreateInputBox
	InputBoxWindow = 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, InputBoxWindow, NULL, NULL, NULL)
	Button = CreateWindowEx(NULL, "Button", "Save", WS_VISIBLE Or WS_CHILD, 10, 70, 200, 24, InputBoxWindow, NULL, NULL, NULL)
End Sub

' 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  = @"WindowClass"
End With

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

CreateInputBox
ShowWindow InputBoxWindow, 1

Dim As MSG uMsg
While GetMessage(@uMsg, NULL, NULL, NULL)
    TranslateMessage(@uMsg)
    DispatchMessage(@uMsg)
Wend

The code does not run. I get the following compiler warning: unbenannt.bas(42) warning 4(1): Suspicious pointer assignment. When I run the compiled code, nothing happens - no window, no inputbox.

[dodicat]

You have defined unicode so
.lpszClassName is wstring ptr.

Code: Select all

 #define UNICODE
#include once "windows.bi"
#include once "/win/commctrl.bi"
Dim Shared As HWND InputBoxWindow, EditBox, Button
Dim Shared As WString * 255 TextMessage = "Type text here"

Function WndProc(hWnd As HWND, msg As UINT, wParam As WPARAM, lParam As LPARAM) As LRESULT
    Select Case msg
    Case WM_COMMAND
        Select Case lParam
        Case Button   
            GetWindowText(EditBox, @TextMessage, 255)
            Var mboxresult = MessageBox(InputBoxWindow, TextMessage, "Saved", 1)
            If mboxresult = 2 Then TextMessage = ""
            DestroyWindow(InputBoxWindow)
        End Select
         
    Case WM_CLOSE
        'message window is destroyed
    End Select
   
    Return DefWindowProc(hWnd, msg, wParam, lParam)
End Function

Sub CreateInputBox
   InputBoxWindow = CreateWindowExW(NULL, "WindowClass", "Messages", WS_OVERLAPPEDWINDOW Or WS_VISIBLE, 20, 20, 300, 150, NULL, NULL, NULL, NULL)
   EditBox = CreateWindowEx(WS_EX_CLIENTEDGE, "Edit", TextMessage, WS_VISIBLE Or WS_CHILD, 10, 40, 200, 24, InputBoxWindow, NULL, NULL, NULL)
   Button = CreateWindowEx(NULL, "Button", "Save", WS_VISIBLE Or WS_CHILD, 10, 70, 200, 24, InputBoxWindow, NULL, NULL, NULL)
End Sub

' Create  window class:
Dim As WNDCLASS wcls
const as string Cname="WindowClass"

dim as wstring * len(Cname)+1 ws=cname

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  = @ws
End With

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

CreateInputBox
ShowWindow InputBoxWindow, 1

Dim As MSG uMsg

While GetMessage(@uMsg, NULL, NULL, NULL)<>false
    TranslateMessage(@uMsg)
    DispatchMessage(@uMsg)
Wend 

[jj2007]

Xusinboy's code works fine for me, except that it doesn't exit properly. Instead of the WM_CLOSE handler, you need this:

Code: Select all

    Case WM_DESTROY
        PostQuitMessage(0)

[Xusinboy Bekchanov]

Xusinboy's code works fine for me, except that it doesn't exit properly. Instead of the WM_CLOSE handler, you need this:

Code: Select all

    Case WM_DESTROY
        PostQuitMessage(0)

Thanks for the correction.

The code does not run. I get the following compiler warning: unbenannt.bas(42) warning 4(1): Suspicious pointer assignment. When I run the compiled code, nothing happens - no window, no inputbox.

It works on UTF-8 file format.
For ANSI (and UTF8) file format with UNICODE:

Code: Select all

#define UNICODE
#include once "windows.bi"
#include once "/win/commctrl.bi"
Dim Shared As HWND InputBoxWindow, EditBox, Button
Dim Shared As WString * 255 TextMessage = "Type text here"

Function WndProc(hWnd As HWND, msg As UINT, wParam As WPARAM, lParam As LPARAM) As LRESULT
    Select Case msg
    Case WM_COMMAND
        Select Case lParam
        Case Button   
            GetWindowText(EditBox, @TextMessage, 255)
            Var mboxresult = MessageBox(InputBoxWindow, TextMessage, "Saved", 1)
            If mboxresult = 2 Then TextMessage = ""
            DestroyWindow(InputBoxWindow)
        End Select
         
    Case WM_CLOSE
        'message window is destroyed
    Case WM_DESTROY
        PostQuitMessage(0)
    End Select
   
    Return DefWindowProc(hWnd, msg, wParam, lParam)
End Function

Sub CreateInputBox
   InputBoxWindow = 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, InputBoxWindow, NULL, NULL, NULL)
   Button = CreateWindowEx(NULL, "Button", "Save", WS_VISIBLE Or WS_CHILD, 10, 70, 200, 24, InputBoxWindow, NULL, NULL, NULL)
End Sub

' 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  = @WStr("WindowClass")
End With

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

CreateInputBox
ShowWindow InputBoxWindow, 1

Dim As MSG uMsg
While GetMessage(@uMsg, NULL, NULL, NULL)
    TranslateMessage(@uMsg)
    DispatchMessage(@uMsg)
Wend

For ANSI (and UTF8) file format without UNICODE:

Code: Select all

#include once "windows.bi"
#include once "/win/commctrl.bi"
Dim Shared As HWND InputBoxWindow, EditBox, Button
Dim Shared As String * 255 TextMessage = "Type text here"

Function WndProc(hWnd As HWND, msg As UINT, wParam As WPARAM, lParam As LPARAM) As LRESULT
    Select Case msg
    Case WM_COMMAND
        Select Case lParam
        Case Button   
            GetWindowText(EditBox, StrPtr(TextMessage), 255)
            Var mboxresult = MessageBox(InputBoxWindow, TextMessage, "Saved", 1)
            If mboxresult = 2 Then TextMessage = ""
            DestroyWindow(InputBoxWindow)
        End Select
         
    Case WM_CLOSE
        'message window is destroyed
    Case WM_DESTROY
        PostQuitMessage(0)
    End Select
   
    Return DefWindowProc(hWnd, msg, wParam, lParam)
End Function

Sub CreateInputBox
   InputBoxWindow = 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, InputBoxWindow, NULL, NULL, NULL)
   Button = CreateWindowEx(NULL, "Button", "Save", WS_VISIBLE Or WS_CHILD, 10, 70, 200, 24, InputBoxWindow, NULL, NULL, NULL)
End Sub

' 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  = @Str("WindowClass")
End With

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

CreateInputBox
ShowWindow InputBoxWindow, 1

Dim As MSG uMsg
While GetMessage(@uMsg, NULL, NULL, NULL)
    TranslateMessage(@uMsg)
    DispatchMessage(@uMsg)
Wend

[Josep Roca]

Using the WinFBX framework:

Code: Select all

#INCLUDE ONCE "Afx/CWindow.inc"

Var num1 = CInt(AfxInputBox( , , , "Input Box", "Enter the no. of rotten apples: "))
Var num2 = CInt(AfxInputBox( , , , "Input Box", "Enter the total no. of apples: "))
AfxMsg "The percentage is : " & num1/num2*100 &"%"

[Lothar Schirm]

Thank you all!