From PowerBASIC to FreeBASIC ...

[Klaas Holland]

Paul,

902 and 905 are fixed.

903 is fixed for the leading spaces but when an item is changed and you click OK then after compiling nothing has changed.

I think the problem lies in the custom item list that does not change the item in FF

[Paul Squires]

903 is fixed for the leading spaces but when an item is changed and you click OK then after compiling nothing has changed.
I think the problem lies in the custom item list that does not change the item in FF

I have looked at this code and moved the flag that sets the code to "dirty". Hopefully you can test the new version of the exe when I post it again (I should be able to do that soon).

[José Roca]

There is much stronger type checking needed in FreeBASIC. It is VERY close to "C" when you are using WinAPI functions. For example, in PowerBASIC you could almost always use a LONG or DWORD to represent a pointer variable. In FreeBASIC, you should cast (using the Cast function) your variables to the correct type as defined in the WinApi headers (eg.  HANDLE, HWND, BITMAP, WNDPROC, HFONT, etc...). for the most part you can get away with still using INTEGER or UINTEGER but you will get a LOT of compiler warnings of pointer conversions.

This is what happens when C programmers try to program in BASIC. They have no idea of how BASIC works...

We can make FreeBasic PB-like when calling external functions just changing the declares. Instead of so many silly BYVAL something PTR, we could use BYREF, and instead of so many silly aliased types, we could use always the standard data types and, to switch from 32-bit to 64-bit, and vice versa, we just need to use longint and ulongint, or LONG_PTR and DWORD_PTR.

Handles are 4 bytes in 32-bit Windows and 8 bytes in 64-bit Windows).

HRESULT is always a LONG.

LPARAM is a longint, WPARAM an ulongint and LRESULT a longint.

[José Roca]

I have made a test, changing several API declares, and now I don't need to use as many @ as before, and don't need to remember so many data types. I will also remove all the obsolete ansi stuff that is useless with the current Windows versions, that are fully unicode. I will keep some defines such HINSTANCE, WPARAM, LPARAM and LRESULT for compatibility with 64-bit.

Code Select Expand



#INCLUDE ONCE "windows.bi"

DECLARE FUNCTION WinMain (BYVAL hInstance AS HINSTANCE, _
                          BYVAL hPrevInstance AS HINSTANCE, _
                          BYVAL szCmdLine AS ZSTRING PTR, _
                          BYVAL iCmdShow AS INTEGER) AS INTEGER
                                 
                                 
   END WinMain(GetModuleHandle(""), NULL, COMMAND(), SW_NORMAL)

' =====================================================================================
' Get the Windows version (based on code from Jose Roca)
' =====================================================================================
FUNCTION AfxGetWindowsVersion () AS SINGLE
   DIM dwVersion AS INTEGER
   DIM nMajorVer AS INTEGER
   DIM nMinorVer AS INTEGER
   dwVersion = GetVersion
   nMajorVer = LOBYTE(LOWORD(dwVersion))
   nMinorVer = HIBYTE(LOWORD(dwVersion))
   FUNCTION = nMajorVer + (nMinorVer / 100)
END FUNCTION
' ========================================================================================

' ========================================================================================
' Scales an horizontal coordinate according the DPI (dots per pixel) being used by the application.
' ========================================================================================
FUNCTION AfxScaleX (BYVAL cx AS SINGLE) AS SINGLE
   DIM hDC AS DWORD
   hDC = GetDC(NULL)
   FUNCTION = cx * (GetDeviceCaps(hDC, LOGPIXELSX) / 96)
   ReleaseDC NULL, hDC
End Function
' ========================================================================================

' ========================================================================================
' Sets the current process as dots per inch (dpi) aware.
' Note SetProcessDPIAware is subject to a possible race condition if a DLL caches dpi
' settings during initialization. For this reason, it is recommended that dpi-aware be set
' through the application (.exe) manifest rather than by calling SetProcessDPIAware.
' ========================================================================================
FUNCTION AfxSetProcessDPIAware () AS LONG
   DIM AS ANY PTR pLib = DyLibLoad("user32.dll")
   IF pLib = 0 THEN EXIT FUNCTION
   DIM pProc AS FUNCTION () AS LONG
   pProc = DyLibSymbol(pLib, "SetProcessDPIAware")
   IF pProc = 0 THEN EXIT FUNCTION
   FUNCTION = pProc()
   DyLibFree(pLib)
END FUNCTION
' ========================================================================================

' =====================================================================================
' Scales a vertical coordinate according the DPI (dots per pixel) being used by the application.
' =====================================================================================
Function AfxScaleY (BYVAL cy AS SINGLE) AS SINGLE
   DIM hDC AS DWORD
   hDC = GetDC(NULL)
   FUNCTION = cy * (GetDeviceCaps(hDC, LOGPIXELSY) / 96)
   ReleaseDC NULL, hDC
End Function
' =====================================================================================

' ========================================================================================
' Adjust the bounding rectangle of a window based on the desired size of the client area.
' ========================================================================================
SUB AfxSetClientSize (BYVAL hwnd AS DWORD, BYVAL nWidth AS LONG, BYVAL nHeight AS LONG)

   DIM rc      AS RECT
   DIM rcTemp  AS RECT
   DIM hMenu   AS DWORD
   DIM dwStyle AS DWORD
   DIM cx      AS LONG
   DIM cy      AS LONG

   ' // Convert the client rectangle to a window rectangle.
   ' // The AdjustWindowRectEx function cannot take menu wrapping into account
   ' // because it doesn't know which menu we are using.
   SetRect(rc, 0, 0, AfxScaleX(nWidth), AfxScaleY(nHeight))
   hMenu   = GetMenu(hwnd)
   dwStyle = GetWindowLongPtr(hwnd, GWL_STYLE)
   AdjustWindowRectEx (rc, dwStyle, (hMenu <> NULL), GetWindowLongPtr(hwnd, GWL_EXSTYLE))

  ' // If there is a menu, we need to check how much wrapping occurs when we set
  ' // the window to the width specified by AdjustWindowRectEX and an infinite
  ' // amount of height. An infinite height allows us to see every single menu wrap.

   IF hMenu <> null THEN
      rcTemp = rc
      rcTemp.Bottom = &H7FFF   ' // "Infinite" height
      SendMessage (hwnd, WM_NCCALCSIZE, 0, cast(LPARAM, @rcTemp))
      ' // Adjust our previous calculation to compensate for menu wrapping.
      rc.Bottom = rc.Bottom + rcTemp.Top
   END IF

   ' // The AdjustWindowRectEx function does not take the WS_VSCROLL or WS_HSCROLL
   ' // styles into account. To account for the scroll bars, we need to call the
   ' // GetSystemMetrics function with SM_CXVSCROLL or SM_CYHSCROLL.
   IF (dwStyle AND WS_HSCROLL) = WS_HSCROLL THEN
      rc.Bottom = rc.Bottom + GetSystemMetrics(SM_CYHSCROLL)
   END IF
   IF (dwStyle AND WS_VSCROLL) = WS_VSCROLL THEN
      rc.Right = rc.Right + GetSystemMetrics(SM_CXVSCROLL)
   END IF
   cx = rc.Right - rc.Left
   cy = rc.Bottom - rc.Top
   SetWindowPos(hwnd, NULL, 0, 0, cx, cy, SWP_NOZORDER OR SWP_NOMOVE OR SWP_NOACTIVATE)

END SUB
' ========================================================================================

' ========================================================================================
' Window procedure
' ========================================================================================
FUNCTION WndProc (BYVAL hWnd AS DWORD, BYVAL uMsg AS DWORD, BYVAL wParam AS WPARAM, BYVAL lParam AS LPARAM) AS LRESULT
   
    FUNCTION = 0
   
    SELECT CASE (uMsg)
       CASE WM_CREATE           
          EXIT FUNCTION

       CASE WM_PAINT
    DIM rc  AS RECT
    DIM ps  AS PAINTSTRUCT
    DIM hDC AS DWORD
         
          hDC = BeginPaint(hWnd, ps)
          GetClientRect(hWnd, rc)
           
          DrawText(hDC, _
                   "Hello, World!", _
            -1, _
                   rc, _
                   DT_SINGLELINE or DT_CENTER or DT_VCENTER)
           
          EndPaint(hWnd, ps)
           
          EXIT FUNCTION           
       
CASE WM_KEYDOWN
IF (LOBYTE(wParam) = 27) THEN
PostMessage(hWnd, WM_CLOSE, 0, 0)
END IF

    CASE WM_DESTROY
         PostQuitMessage(0)
         EXIT FUNCTION
   END SELECT
   
   FUNCTION = DefWindowProc(hWnd, uMsg, wParam, lParam)
   
END FUNCTION
' ========================================================================================

' ========================================================================================
' Main
' ========================================================================================
FUNCTION WinMain (BYVAL hInstance AS HINSTANCE, _
                  BYVAL hPrevInstance AS HINSTANCE, _
                  BYVAL szCmdLine AS ZSTRING PTR, _
                  BYVAL iCmdShow AS INTEGER) AS INTEGER   

   ' // Set process DPI aware
   AfxSetProcessDPIAware
     
   DIM wcls AS WNDCLASS     
   DIM hWnd AS DWORD
   DIM wszClassName AS WSTRING * 20 = "HelloWin"
     
   FUNCTION = 0
     
   WITH wcls
      .style         = CS_HREDRAW or CS_VREDRAW
      .lpfnWndProc   = @WndProc
      .cbClsExtra    = 0
      .cbWndExtra    = 0
      .hInstance     = hInstance
      .hIcon         = LoadIcon(NULL, IDI_APPLICATION)
      .hCursor       = LoadCursor(NULL, IDC_ARROW)
      .hbrBackground = GetStockObject(WHITE_BRUSH)
      .lpszMenuName  = NULL
      .lpszClassName = @wszClassName
   END WITH
         
   IF (RegisterClass(wcls) = FALSE) THEN
      MessageBox(NULL, "Failed to register wcls", "Error", MB_ICONERROR)
      EXIT FUNCTION
   END IF
   
   hWnd = CreateWindowEx(0, _
           wszClassName, _
                         "The Hello Program", _
                         WS_OVERLAPPEDWINDOW, _
                         0, 0, 0, 0, _
                         NULL, NULL, _
                         hInstance, _
                         NULL)

   IF hWnd = NULL THEN
      MessageBox(NULL, "CreateWindowEx failed", "Error", MB_ICONERROR)
      EXIT FUNCTION
   END IF

   AfxSetClientSize(hwnd, AfxScaleX(300), AfxScaleY(200))
   ShowWindow(hWnd, iCmdShow)
   UpdateWindow(hWnd)
     
   DIM uMsg AS MSG
   WHILE (GetMessage(uMsg, NULL, 0, 0) <> FALSE)
      TranslateMessage(uMsg)
      DispatchMessage(uMsg)
   WEND
   
   FUNCTION = uMsg.wParam

END FUNCTION
' ========================================================================================


[José Roca]

The official declares have been written as if they were going to be used with a C compiler...

Apparently, my fate is to be always at odds with the official declares for any Basic compiler

[Paul Squires]

Hi Jose!  Great to see you stop by again and post code. The latest FB package uses a newly translated version of the MinGW C includes. That is what dkl used for the translation. To help automate the translations, dkl uses a program that he wrote called FBFROG. https://github.com/dkl/fbfrog

[José Roca]

I have downloaded them tonight and, as I said, they are more suitable for programming in C-style that in Basic-style.

Code Select Expand


declare function GetMessageW(byval lpMsg as LPMSG, byval hWnd as HWND, byval wMsgFilterMin as UINT, byval wMsgFilterMax as UINT) as WINBOOL
declare function TranslateMessage(byval lpMsg as const MSG ptr) as WINBOOL
declare function DispatchMessageW(byval lpMsg as const MSG ptr) as LRESULT

   WHILE (GetMessage(@wMsg, NULL, 0, 0) <> FALSE)
      TranslateMessage(@wMsg)
      DispatchMessage(@wMsg)
   WEND


My translation:

Code Select Expand


DECLARE FUNCTION GetMessageW (BYREF lpMsg AS MSG, BYVAL hWnd AS DWORD, BYVAL wMsgFilterMin AS DWORD, BYVAL wMsgFilterMax AS DWORD) AS LONG
DECLARE FUNCTION TranslateMessage (BYREF lpMsg AS MSG) AS LONG
DECLARE FUNCTION DispatchMessageW (BYREF lpMsg AS MSG) AS LRESULT
   
   WHILE (GetMessage(uMsg, NULL, 0, 0) <> FALSE)
      TranslateMessage(uMsg)
      DispatchMessage(uMsg)
   WEND


[James Fuller]

Jose,
With having to use -gen gcc for 64bit I still am scratching my head on why dkl decided to make integers 64bit?? The only data type that changes from 32 -> 64 is pointers on windows.
Or am I missing something??

James

[José Roca]

They have made the translations as literal as possible, but this means that aren't very Basic friendly.

int and long are 32-bit values both in 32-bit and 64-bit Windows.

LPARAM, WPARAM and LRESULT types change size to 8 bytes in Windows 64-bit.

Handles are 4 bytes in 32-bit and 8 bytes in 64-bit Windows.

HRESULT is a LONG both in 32-bit and 64-bit Windows.

SIZE_T and SSIZE_T change from 4 to 8 bytes.

size_t, time_t, ptrdiff_t and others from the C runtime change from 4 bytes to 8 bytes.

Whe setting the cbWndExtra member of the WNDCLASS structure, reserve 8 bytes for pointers, because all pointers are 8 bytes in 64-bit Windows.

To access window or class private data that contains pointers use:

GetClassLongPtr
GetWindowLongPtr
SetClassLongPtr
SetWindowLongPtr

instead of GetClassLong, GetWindowLong, SetClassLong and SetWindowLong.

Another difference is the alignment of structures, which is a pain in PB because Bob did choose the rules of VB instead of C. If FreeBasic follows the C rules, then there is not problem.

[José Roca]

> Handles are 4 bytes in 32-bit and 8 bytes in 64-bit Windows.

Therefore, in my translation I have to change the hWnd parameter from DWORD to another type, but we can use a generic HANDLE instead of all these HBITMAP, HWND, HFONT, etc.

We can handle 32/64 bit compatibility with just a few defines for the types that change size from 32 to 64 bit, but to have hundreds of them is a nightmare.

I have these polymorphic types in my list:

HANDLE
WPARAM
LPARAM
LRESULT
LONG_PTR
DWORD_PTR
VOID_PTR

[José Roca]

Jose,
With having to use -gen gcc for 64bit I still am scratching my head on why dkl decided to make integers 64bit?? The only data type that changes from 32 -> 64 is pointers on windows.
Or am I missing something??

James

In C++, INT does not change size in 64-bit Window. It is a 32-bit value.

But in FreeBasic, Integer is an standard data type, not an alias for INT, and they have decided to do it this way. Of course, this will lead to misunderstandings.

Use LONG instead of INTEGER.

[José Roca]

This is my first test with FreeBasic 64-bit, changing the declares of the functions used to be more PB compatible. One or two polymorphic types would be enough for compatibility with 32-bit, but I will use half a dozen for clarity. I will also use only the unicode declares. In WinMain I have changed Integer to Long, since the C++ function uses int, that does not translate to 8 bytes in 64-bit Windows. The similirarity of names between Integer and int is going to cause trouble among FBer's.

Code Select Expand


#INCLUDE ONCE "windows.bi"

DECLARE FUNCTION WinMain (BYVAL hInstance AS HANDLE, _
                          BYVAL hPrevInstance AS HANDLE, _
                          BYVAL szCmdLine AS ZSTRING PTR, _
                          BYVAL nCmdShow AS LONG) AS LONG
                                 
                                 
   END WinMain(GetModuleHandle(""), NULL, COMMAND(), SW_NORMAL)

' ========================================================================================
' Sets the current process as dots per inch (dpi) aware.
' Note SetProcessDPIAware is subject to a possible race condition if a DLL caches dpi
' settings during initialization. For this reason, it is recommended that dpi-aware be set
' through the application (.exe) manifest rather than by calling SetProcessDPIAware.
' ========================================================================================
FUNCTION AfxSetProcessDPIAware () AS LONG
   DIM AS ANY PTR pLib = DyLibLoad("user32.dll")
   IF pLib = 0 THEN EXIT FUNCTION
   DIM pProc AS FUNCTION () AS LONG
   pProc = DyLibSymbol(pLib, "SetProcessDPIAware")
   IF pProc = 0 THEN EXIT FUNCTION
   FUNCTION = pProc()
   DyLibFree(pLib)
END FUNCTION
' ========================================================================================

' =====================================================================================
' Scales a vertical coordinate according the DPI (dots per pixel) being used by the application.
' =====================================================================================
Function AfxScaleY (BYVAL cy AS SINGLE) AS SINGLE
   DIM hDC AS HANDLE
   hDC = GetDC(NULL)
   FUNCTION = cy * (GetDeviceCaps(hDC, LOGPIXELSY) / 96)
   ReleaseDC NULL, hDC
End Function
' =====================================================================================

' ========================================================================================
' Scales an horizontal coordinate according the DPI (dots per pixel) being used by the application.
' ========================================================================================
FUNCTION AfxScaleX (BYVAL cx AS SINGLE) AS SINGLE
   DIM hDC AS HANDLE
   hDC = GetDC(NULL)
   FUNCTION = cx * (GetDeviceCaps(hDC, LOGPIXELSX) / 96)
   ReleaseDC NULL, hDC
End Function
' ========================================================================================

' ========================================================================================
' Adjusts the bounding rectangle of a window based on the desired size of the client area.
' ========================================================================================
SUB AfxSetClientSize (BYVAL hwnd AS HANDLE, BYVAL nWidth AS LONG, BYVAL nHeight AS LONG)

   DIM rc      AS RECT
   DIM rcTemp  AS RECT
   DIM hMenu   AS HANDLE
   DIM dwStyle AS DWORD
   DIM cx      AS LONG
   DIM cy      AS LONG

   ' // Convert the client rectangle to a window rectangle.
   ' // The AdjustWindowRectEx function cannot take menu wrapping into account
   ' // because it doesn't know which menu we are using.
   SetRect(rc, 0, 0, AfxScaleX(nWidth), AfxScaleY(nHeight))
   hMenu   = GetMenu(hwnd)
   dwStyle = GetWindowLongPtr(hwnd, GWL_STYLE)
   AdjustWindowRectEx(rc, dwStyle, (hMenu <> NULL), GetWindowLongPtr(hwnd, GWL_EXSTYLE))

  ' // If there is a menu, we need to check how much wrapping occurs when we set
  ' // the window to the width specified by AdjustWindowRectEX and an infinite
  ' // amount of height. An infinite height allows us to see every single menu wrap.

   IF hMenu <> NULL THEN
      rcTemp = rc
      rcTemp.Bottom = &H7FFF   ' // "Infinite" height
      SendMessage(hwnd, WM_NCCALCSIZE, 0, cast(LPARAM, @rcTemp))
      ' // Adjust our previous calculation to compensate for menu wrapping.
      rc.Bottom = rc.Bottom + rcTemp.Top
   END IF

   ' // The AdjustWindowRectEx function does not take the WS_VSCROLL or WS_HSCROLL
   ' // styles into account. To account for the scroll bars, we need to call the
   ' // GetSystemMetrics function with SM_CXVSCROLL or SM_CYHSCROLL.
   IF (dwStyle AND WS_HSCROLL) = WS_HSCROLL THEN
      rc.Bottom = rc.Bottom + GetSystemMetrics(SM_CYHSCROLL)
   END IF
   IF (dwStyle AND WS_VSCROLL) = WS_VSCROLL THEN
      rc.Right = rc.Right + GetSystemMetrics(SM_CXVSCROLL)
   END IF
   cx = rc.Right - rc.Left
   cy = rc.Bottom - rc.Top
   SetWindowPos(hwnd, NULL, 0, 0, cx, cy, SWP_NOZORDER OR SWP_NOMOVE OR SWP_NOACTIVATE)

END SUB
' ========================================================================================

' ========================================================================================
' Window procedure
' ========================================================================================
FUNCTION WndProc (BYVAL hWnd AS HANDLE, BYVAL uMsg AS DWORD, BYVAL wParam AS WPARAM, BYVAL lParam AS LPARAM) AS LRESULT
   
    FUNCTION = 0
   
    SELECT CASE (uMsg)
       CASE WM_CREATE           
          EXIT FUNCTION

       CASE WM_PAINT
    DIM rc AS RECT, ps AS PAINTSTRUCT, hDC AS HANDLE
         hDC = BeginPaint(hWnd, ps)
         GetClientRect(hWnd, rc)
         DrawText(hDC, "Hello, World!", -1, rc, DT_SINGLELINE or DT_CENTER or DT_VCENTER)
         EndPaint(hWnd, ps)
         EXIT FUNCTION           
       
CASE WM_KEYDOWN
IF (LOBYTE(wParam) = 27) THEN PostMessage(hWnd, WM_CLOSE, 0, 0)

    CASE WM_DESTROY
         PostQuitMessage(0)
         EXIT FUNCTION
   END SELECT
   
   FUNCTION = DefWindowProc(hWnd, uMsg, wParam, lParam)
   
END FUNCTION
' ========================================================================================

' ========================================================================================
' Main
' ========================================================================================
FUNCTION WinMain (BYVAL hInstance AS HANDLE, _
                  BYVAL hPrevInstance AS HANDLE, _
                  BYVAL szCmdLine AS ZSTRING PTR, _
                  BYVAL nCmdShow AS LONG) AS LONG   

   ' // Set process DPI aware
   AfxSetProcessDPIAware

   DIM wcls AS WNDCLASS     
   DIM hWnd AS HANDLE
   DIM wszClassName AS WSTRING * 20 = "HelloWin"
     
   FUNCTION = 0

   WITH wcls
      .style         = CS_HREDRAW or CS_VREDRAW
      .lpfnWndProc   = @WndProc
      .cbClsExtra    = 0
      .cbWndExtra    = 0
      .hInstance     = hInstance
      .hIcon         = LoadIcon(NULL, IDI_APPLICATION)
      .hCursor       = LoadCursor(NULL, IDC_ARROW)
      .hbrBackground = GetStockObject(WHITE_BRUSH)
      .lpszMenuName  = NULL
      .lpszClassName = @wszClassName
   END WITH
         
   IF (RegisterClass(wcls) = FALSE) THEN
      MessageBox(NULL, "Failed to register wcls", "Error", MB_ICONERROR)
      EXIT FUNCTION
   END IF

   hWnd = CreateWindowEx(0, wszClassName, "The Hello Program", WS_OVERLAPPEDWINDOW, _
                         0, 0, 0, 0, NULL, NULL, hInstance, NULL)

   IF hWnd = NULL THEN
      MessageBox(null, "Failure in CreateWindowEx", "Error", MB_ICONERROR)
      EXIT FUNCTION
   END IF

   AfxSetClientSize(hwnd, 500, 320)
   ShowWindow(hWnd, nCmdShow)
   UpdateWindow(hWnd)

   DIM uMsg AS MSG
   WHILE (GetMessage(uMsg, NULL, 0, 0) <> FALSE)
      TranslateMessage(uMsg)
      DispatchMessage(uMsg)
   WEND
   
   FUNCTION = uMsg.wParam

END FUNCTION
' ========================================================================================


[José Roca]

The biggest show stopper for a Windows programmer like me is the lack of native support for OLE strings. Having to use SysAllocString and/or SysFreeString each time I need to use an OLE string is a real pain. You have always to use intermediate steps to get the pointer to the allocated string to free it later.

Since the authors seem to be C programmers mainly working with Linux, I don't blieve this is going to change anytime soon.

[Paul Squires]

I imagine that eventually I will have to create a String class (much like the C++ string class) that will handle all of the string operations including allocation and deallocation, and dynamic bstr and/or fixed and unicode, etc....

[James Fuller]

If I remember correctly the native fb string has the same format as the PB ole string does it not?

James