WinFBX Version 1.0

[ganlinlao]

hi ,jose
I found the UIribbon.inc class in your winapi for powerbasic package and wondered if you plan to provide a freebasic version of the cUIribbon class.
Because from windows vista, win7-win10, the system has brought uiRibbon.dll, for some do not want to use the old menu and want to use ribbon style, the use of cUIribbon class, will bring a lot of convenience.

  Thanks!

[ganlinlao]

hi，jose
I found that there is a mistake here

[José Roca]

The FreeBasic GDI+ headers are a total mess. The ColorPalette structure is defined twice

In gdiplus-c.bi as:

Code Select Expand


type ColorPalette
Flags as UINT
Count as UINT
Entries(0 to 0) as ARGB
end type


and in GdiplusPixelFormats.bi as

Code Select Expand


type ColorPalette
Flags as UINT
Count as UINT
Entries(0 to 1-1) as ARGB
end type


Entries(0 to 0) as ARGB and Entries(0 to 1-1) as ARGB are the same. Anyway, I will change it to Entries(0 to 0).

[José Roca]

hi ,jose
I found the UIribbon.inc class in your winapi for powerbasic package and wondered if you plan to provide a freebasic version of the cUIribbon class.
Because from windows vista, win7-win10, the system has brought uiRibbon.dll, for some do not want to use the old menu and want to use ribbon style, the use of cUIribbon class, will bring a lot of convenience.

  Thanks!

I will see. Because FB doesn't have support for COM classes, with more than one implemented interface, it will be a bit more difficult. However, if I haven't done it yet it is because, although many people would like to use ribbons, the interest disappears suddenly when they realize that have to learn XAML, install a XAML compiler, etc. Absolutely nobody used it with PowerBasic.

[José Roca]

Another problem is that the ribbon api uses propvariants, and although I have done some work with the CPropVar class, it have not yet thoroughly tested it. Also FB does not provide headers and libraries for the UI interfaces and propvariants.

[ganlinlao]

hi，jose
I found that there is a mistake here.
rect and rectF

[José Roca]

Changed to

width

Specifies the width of a rectangle.

height

Specifies the height of a rectangle.

Also changed SIZEF to SIZE in the entry for the SIZE structure.

BTW please note that because it is declared as Rect_ in gdiplus-c.bi (to avoid conflicting with GDI's Rect) and as class in GdiPlusTypes.bi, in my headers I'm using the functions GDIP_RECT, GDIP_RECTF, GDIP_POINT, GDIP_POINTF. Otherwise, there is no way to compile the same code to 32 and 64 bit. The FB headers for GDI+ need a complete rewrite.

Thinking about it, I'm going to use the aliases in the documentation, i.e. GpPoint, GpPointF, GpRect, GpRectF, GpSize and GpSizeF.

[José Roca]

I'm going to add this method to the CWSTR class.

Code Select Expand


' ========================================================================================
' Resizes the string to a length of n characters.
' Parameters:
' nSize : New string length, expressed in number of characters.
' ch: Character used to fill the new character space added to the string (in case the
' string is expanded).
' If nSize is smaller than the current string length, the current value is shortened to
' its first nSize characters.
' If nSize is greater than the current string length, the current content is extended by
' inserting at the end as many characters as needed to reach a size of nSize. If ch is
' specified, the new elements are initialized as copies of ch, otherwise, spaces are added.
' ========================================================================================
PRIVATE SUB CWstr.Resize (BYVAL nSize AS UINT, BYREF ch AS WSTRING = "")
   CWSTR_DP("CWSTR Resize")
   IF m_BufferLen \ 2 = nSize THEN EXIT SUB
   IF m_BufferLen \ 2 > nSize THEN
      m_BufferLen = nSize * 2
      m_Capacity = nSize * 2
      m_pBuffer[m_BufferLen] = 0
      m_pBuffer[m_BufferLen + 1] = 0
   ELSE
      DIM cws AS CWSTR
      DIM nChars AS UINT = ((nSize * 2) - m_BufferLen) \ 2
      IF ch <> "" THEN cws = STRING(nChars, ASC(ch, 1)) ELSE cws = SPACE(nChars)
      this.Add(cws)
   END IF
END SUB
' ========================================================================================


[ganlinlao]

hi，jose
Thank you, this method is very good, my friend and I a few days ago, just talked about the string and custom structure types of memory self-growth and cleaning problems.

[José Roca]

Thank you. I have modified the text to

Returns a GpPoint color value initialized with the specified values for the x and y coordinates.

Returns a GpPointF color value initialized with the specified values for the x and y coordinates.

and also the return types from GpRect/F to GpPoint/F.

[José Roca]

Regarding the Resize method, I have changed it to

Code Select Expand


' ========================================================================================
' Resizes the string to a length of n characters.
' Parameters:
' nSize : New string length, expressed in number of characters.
' ch: Character used to fill the new character space added to the string (in case the
' string is expanded).
' If nSize is smaller than the current string length, the current value is shortened to
' its first nSize characters.
' If nSize is greater than the current string length, the current content is extended by
' inserting at the end as many characters as needed to reach a size of nSize. If ch is
' specified, the new elements are initialized as copies of ch, otherwise, spaces are added.
' ========================================================================================
PRIVATE SUB CWstr.Resize (BYVAL nSize AS UINT, BYREF ch AS WSTRING = "")
   CWSTR_DP("CWSTR Resize")
   IF m_BufferLen \ 2 = nSize THEN EXIT SUB
   IF m_BufferLen \ 2 > nSize THEN
      m_BufferLen = nSize * 2
      m_Capacity = nSize * 2
      m_pBuffer[m_BufferLen] = 0
      m_pBuffer[m_BufferLen + 1] = 0
   ELSE
      IF LEN(ch) > 1 THEN ch = LEFT(ch, 1)
      DIM nChars AS UINT = ((nSize * 2) - m_BufferLen) \ 2
      DIM cws AS CWSTR = SPACE(nChars)
      IF ch <> "" THEN
         FOR i AS LONG = 1 TO nChars
            MID(**cws, i, 1) = ch
         NEXT
      END IF
      this.Add(cws)
   END IF
END SUB
' ========================================================================================


Because the FreeBasic STRING function does not work with Unicode.

Will have to also modify other functions that use STRING. Fortunately they're only three: AfxStrLset, AfxStrRSet and AfxStrCSet.

[José Roca]

Done. Changed these functions to:

Code Select Expand


' ========================================================================================
' Returns a string containing a left-justified (padded) string.
' If the optional parameter wszPadCharacter not specified, the function pads the string with
' space characters to the left. Otherwise, the function pads the string with the first
' character of wszPadCharacter
' Example: DIM cws AS CWSTR = AfxStrLSet("FreeBasic", 20, "*")
' ========================================================================================
PRIVATE FUNCTION AfxStrLSet (BYREF wszMainStr AS WSTRING, BYVAL nStringLength AS LONG, BYREF wszPadCharacter AS WSTRING = " ") AS CWSTR
   IF LEN(wszPadCharacter) > 1 THEN wszPadCharacter = LEFT(wszPadCharacter, 1)
   DIM cws AS CWSTR = SPACE(nStringLength)
   IF wszPadCharacter <> "" THEN
      FOR i AS LONG = 1 TO LEN(cws)
         MID(**cws, i, 1) = wszPadCharacter
      NEXT
   END IF
   MID(**cws, 1, LEN(wszMainStr)) = wszMainStr
   RETURN cws
END FUNCTION
' ========================================================================================

' ========================================================================================
' Returns a string containing a right-justified (padded) string.
' If the optional parameter wszPadCharacter not specified, the function pads the string with
' space characters to the left. Otherwise, the function pads the string with the first
' character of wszPadCharacter.
' Example: DIM cws AS CWSTR = AfxStrRSet("FreeBasic", 20, "*")
' ========================================================================================
PRIVATE FUNCTION AfxStrRSet (BYREF wszMainStr AS WSTRING, BYVAL nStringLength AS LONG, BYREF wszPadCharacter AS WSTRING = " ") AS CWSTR
   IF LEN(wszPadCharacter) > 1 THEN wszPadCharacter = LEFT(wszPadCharacter, 1)
   DIM cws AS CWSTR = SPACE(nStringLength)
   IF wszPadCharacter <> "" THEN
      FOR i AS LONG = 1 TO LEN(cws)
         MID(**cws, i, 1) = wszPadCharacter
      NEXT
   END IF
   MID(**cws, nStringLength - LEN(wszMainStr) + 1, LEN(wszMainStr)) = wszMainStr
   RETURN cws
END FUNCTION
' ========================================================================================

' ========================================================================================
' Returns a string containing a centered (padded) string.
' If the optional parameter wszPadCharacter not specified, the function pads the string with
' space characters to the left. Otherwise, the function pads the string with the first
' character of wszPadCharacter.
' Example: DIM cws AS CWSTR = AfxStrCSet("FreeBasic", 20, "*")
' ========================================================================================
PRIVATE FUNCTION AfxStrCSet (BYREF wszMainStr AS WSTRING, BYVAL nStringLength AS LONG, BYREF wszPadCharacter AS WSTRING = " ") AS CWSTR
   IF LEN(wszPadCharacter) > 1 THEN wszPadCharacter = LEFT(wszPadCharacter, 1)
   DIM cws AS CWSTR = SPACE(nStringLength)
   IF wszPadCharacter <> "" THEN
      FOR i AS LONG = 1 TO LEN(cws)
         MID(**cws, i, 1) = wszPadCharacter
      NEXT
   END IF
   MID(**cws, (nStringLength - LEN(wszMainStr)) \ 2 + 1, LEN(wszMainStr)) = wszMainStr
   RETURN cws
END FUNCTION
' ========================================================================================


[Paul Squires]

Hi Jose,

Just looking at the new LSet function. Seems like it can be simplified a bit because the PadCharacter will always be at least 1 character (the default if no parameter is passed is a blank character).

Code Select Expand


PRIVATE FUNCTION AfxStrLSet (BYREF wszMainStr AS WSTRING, BYVAL nStringLength AS LONG, BYREF wszPadCharacter AS WSTRING = " ") AS CWSTR
   wszPadCharacter = LEFT(wszPadCharacter, 1)
   DIM cws AS CWSTR = SPACE(nStringLength)
   FOR i AS LONG = 1 TO LEN(cws)
      MID(**cws, i, 1) = wszPadCharacter
   NEXT
   MID(**cws, 1, LEN(wszMainStr)) = wszMainStr
   RETURN cws
END FUNCTION


Agree?

[José Roca]

Yes. I forgot that the default was " " instead of "".

Code Select Expand


' ========================================================================================
' Returns a string containing a left-justified (padded) string.
' If the optional parameter wszPadCharacter not specified, the function pads the string with
' space characters to the left. Otherwise, the function pads the string with the first
' character of wszPadCharacter
' Example: DIM cws AS CWSTR = AfxStrLSet("FreeBasic", 20, "*")
' ========================================================================================
PRIVATE FUNCTION AfxStrLSet (BYREF wszMainStr AS WSTRING, BYVAL nStringLength AS LONG, BYREF wszPadCharacter AS WSTRING = " ") AS CWSTR
   wszPadCharacter = LEFT(wszPadCharacter, 1)
   DIM cws AS CWSTR = SPACE(nStringLength)
   FOR i AS LONG = 1 TO LEN(cws)
      MID(**cws, i, 1) = wszPadCharacter
   NEXT
   MID(**cws, 1, LEN(wszMainStr)) = wszMainStr
   RETURN cws
END FUNCTION
' ========================================================================================

' ========================================================================================
' Returns a string containing a right-justified (padded) string.
' If the optional parameter wszPadCharacter not specified, the function pads the string with
' space characters to the left. Otherwise, the function pads the string with the first
' character of wszPadCharacter.
' Example: DIM cws AS CWSTR = AfxStrRSet("FreeBasic", 20, "*")
' ========================================================================================
PRIVATE FUNCTION AfxStrRSet (BYREF wszMainStr AS WSTRING, BYVAL nStringLength AS LONG, BYREF wszPadCharacter AS WSTRING = " ") AS CWSTR
   wszPadCharacter = LEFT(wszPadCharacter, 1)
   DIM cws AS CWSTR = SPACE(nStringLength)
   FOR i AS LONG = 1 TO LEN(cws)
      MID(**cws, i, 1) = wszPadCharacter
   NEXT
   MID(**cws, nStringLength - LEN(wszMainStr) + 1, LEN(wszMainStr)) = wszMainStr
   RETURN cws
END FUNCTION
' ========================================================================================

' ========================================================================================
' Returns a string containing a centered (padded) string.
' If the optional parameter wszPadCharacter not specified, the function pads the string with
' space characters to the left. Otherwise, the function pads the string with the first
' character of wszPadCharacter.
' Example: DIM cws AS CWSTR = AfxStrCSet("FreeBasic", 20, "*")
' ========================================================================================
PRIVATE FUNCTION AfxStrCSet (BYREF wszMainStr AS WSTRING, BYVAL nStringLength AS LONG, BYREF wszPadCharacter AS WSTRING = " ") AS CWSTR
   wszPadCharacter = LEFT(wszPadCharacter, 1)
   DIM cws AS CWSTR = SPACE(nStringLength)
   FOR i AS LONG = 1 TO LEN(cws)
      MID(**cws, i, 1) = wszPadCharacter
   NEXT
   MID(**cws, (nStringLength - LEN(wszMainStr)) \ 2 + 1, LEN(wszMainStr)) = wszMainStr
   RETURN cws
END FUNCTION
' ========================================================================================


[José Roca]

After a discussion in the PowerBasic forum, I have written the following functions to get the handle of the top level window of a web browser. I will incorporate them in AfxWin.inc

Code Select Expand


' ========================================================================================
' Retrieves the handle of the top level window of the web browser.
' Parameter:
'    pwszClassName: The browser class name.
' Return value:
'    The handle of the top level window of the browser.
' Thanks to Dominic Mitchell for the information provided in this thread:
' https://forum.powerbasic.com/forum/user-to-user-discussions/powerbasic-for-windows/767812-handle-to-browser-window?p=767896#post767896
' Examples:
' DIM hwndBrowser AS HWND = AfxGetBrowserHandle("IEFrame")              ' // Internet Explorer
' DIM hwndBrowser AS HWND = AfxGetBrowserHandle("MozillaWindowClass")   ' // Firefox
' DIM hwndBrowser AS HWND = AfxGetBrowserHandle("Chrome_WidgetWin_1")   ' // Chrome
' ========================================================================================
FUNCTION AfxEnumThreadWndProc (BYVAL hwnd AS HWND, BYVAL lParam AS LPARAM) AS WINBOOL
   DIM dwStyle AS DWORD = GetWindowLongPtr(hwnd, GWL_STYLE)
   IF ((dwStyle AND (WS_POPUP OR WS_CHILD)) = 0) AND ((dwStyle AND WS_VISIBLE) <> 0) THEN
      DIM phwndTop AS HWND PTR
      CAST(LPARAM, phwndTop) = lParam
      *phwndTop = hwnd
      RETURN FALSE
   END IF
   RETURN CTRUE
END FUNCTION
' ========================================================================================
' ========================================================================================
FUNCTION AfxGetBrowserHandle (BYVAL pwszClassName AS WSTRING PTR) AS HWND
  DIM hwndBrowser AS HWND = FindWindowW(pwszClassName, NULL)
  IF hwndBrowser = NULL THEN RETURN NULL
  DIM dwThread AS DWORD = GetWindowThreadProcessId(hwndBrowser, NULL)
  IF dwThread = 0 THEN RETURN NULL
  DIM hwndTop AS HWND
  EnumThreadWindows(dwThread, @AfxEnumThreadWndProc, CAST(LPARAM, @hwndTop))
  RETURN hwndTop
END FUNCTION
' ========================================================================================
' ========================================================================================
' Retrieves the top level window handle of Intenet Explorer.
' ========================================================================================
FUNCTION AfxGetInternetExplorerHandle () AS HWND
   RETURN AfxGetBrowserHandle("IEFrame")
END FUNCTION
' ========================================================================================
' ========================================================================================
' Retrieves the top level window handle of Firefox.
' ========================================================================================
FUNCTION AfxGetFireFoxHandle () AS HWND
   RETURN AfxGetBrowserHandle("MozillaWindowClass")
END FUNCTION
' ========================================================================================
' ========================================================================================
' Retrieves the top level window handle of Google Chrome.
' ========================================================================================
FUNCTION AfxGetGoogleChromeHandle () AS HWND
   RETURN AfxGetBrowserHandle("Chrome_WidgetWin_1")
END FUNCTION
' ========================================================================================