Convert vbscript to FB

New to FreeBASIC? Post your questions here.
ganache
Posts: 46
Joined: Aug 04, 2016 9:25

Convert vbscript to FB

Postby ganache » Oct 06, 2020 6:06

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
Posts: 362
Joined: Jul 26, 2018 18:28

Re: Convert vbscript to FB

Postby Xusinboy Bekchanov » Oct 06, 2020 7:20

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

Re: Convert vbscript to FB

Postby dodicat » Oct 06, 2020 8:05

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
Posts: 12
Joined: Nov 29, 2019 10:41

Re: Convert vbscript to FB

Postby hhr » Oct 06, 2020 19:30

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
Last edited by hhr on Oct 07, 2020 7:31, edited 1 time in total.
dodicat
Posts: 6805
Joined: Jan 10, 2006 20:30
Location: Scotland

Re: Convert vbscript to FB

Postby dodicat » Oct 06, 2020 23:14

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
Posts: 349
Joined: Sep 28, 2013 15:08
Location: Germany

Re: Convert vbscript to FB

Postby Lothar Schirm » Feb 27, 2021 18:41

Xusinboy Bekchanov wrote: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
Posts: 6805
Joined: Jan 10, 2006 20:30
Location: Scotland

Re: Convert vbscript to FB

Postby dodicat » Feb 27, 2021 19:34

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

Re: Convert vbscript to FB

Postby jj2007 » Feb 27, 2021 20:57

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
Posts: 362
Joined: Jul 26, 2018 18:28

Re: Convert vbscript to FB

Postby Xusinboy Bekchanov » Feb 27, 2021 21:23

jj2007 wrote: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.

Lothar Schirm wrote: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
Last edited by Xusinboy Bekchanov on Feb 27, 2021 21:54, edited 4 times in total.
Josep Roca
Posts: 516
Joined: Sep 27, 2016 18:20
Location: Valencia, Spain

Re: Convert vbscript to FB

Postby Josep Roca » Feb 27, 2021 21:29

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
Posts: 349
Joined: Sep 28, 2013 15:08
Location: Germany

Re: Convert vbscript to FB

Postby Lothar Schirm » Feb 28, 2021 14:00

Thank you all!

Return to “Beginners”

Who is online

Users browsing this forum: No registered users and 13 guests