Print

Please login or register.
1 Hour 1 Day 1 Week 1 Month Forever
Login with username, password and session length

[José Roca]

I have finished the work. ColeCon and CWebBrowser are now history, having been replaced by CAxHost and CWebCtx. I have also have modified the examples and templates.

I think that it is time to leave the release candidate versions and post the first version of the WinFBX framework. WinFBX means Windows FreeBasic Extensions and it has been chosen to highlight its ties with the WinFBE editor. It can be used with other editors, but WinFBE makes its use easier.

[Paul Squires]

That's great news Jose! Congratulations on making it to Version 1, although with everything that's in this package it feels more like version 10! 

[ganlinlao]

wow , Jose,thank you very much!

[ganlinlao]

hi, jose
Error in compiling example mothviews. There is an error in axhost.inc

[José Roca]

In fact it is a bug in the version 1.05 of the compiler. You can download version 1.06 at http://users.freebasic-portal.de/stw/builds/ or change pAxHost->m_bInPlaceActive = FALSE to CLNG(pAxHost->m_bInPlaceActive) = FALSE.

The other error is caused by a change in Put from a function to a property. Use this code:

Code: [Select]

' ########################################################################################
' Microsoft Windows
' Contents: Embedded MonthView Calendar OCX
' Compiler: FreeBasic 32 & 64 bit
' Copyright (c) 2016 Jose Roca. Freeware. Use at your own risk.
' THIS CODE AND INFORMATION IS PROVIDED "AS IS" WITHOUT WARRANTY OF ANY KIND, EITHER
' EXPRESSED OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE IMPLIED WARRANTIES OF
' MERCHANTABILITY AND/OR FITNESS FOR A PARTICULAR PURPOSE.
' ########################################################################################

#define UNICODE
#INCLUDE ONCE "Afx/CAxHost/CAxHost.inc"
#INCLUDE ONCE "Afx/CDispInvoke.inc"
#INCLUDE ONCE "Afx/AfxCOM.inc"
USING Afx

DECLARE FUNCTION WinMain (BYVAL hInstance AS HINSTANCE, _
                          BYVAL hPrevInstance AS HINSTANCE, _
                          BYVAL szCmdLine AS ZSTRING PTR, _
                          BYVAL nCmdShow AS LONG) AS LONG

   END WinMain(GetModuleHandleW(NULL), NULL, COMMAND(), SW_NORMAL)

DECLARE FUNCTION WndProc (BYVAL hwnd AS HWND, BYVAL uMsg AS UINT, BYVAL wParam AS WPARAM, BYVAL lParam AS LPARAM) AS LRESULT

CONST IDC_MONTHVIEW = 1001

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

   ' // Set process DPI aware
   ' // The recommended way is to use a manifest file
   AfxSetProcessDPIAware

   ' // Creates the main window
   DIM pWindow AS CWindow
   ' -or- DIM pWindow AS CWindow = "MyClassName" (use the name that you wish)
   DIM hwndMain AS HWND = pWindow.Create(NULL, "CAxHost - Embedded MonthView Calendar OCX", @WndProc)
   ' // Sizes it by setting the wanted width and height of its client area
   pWindow.SetClientSize(580, 360)
   ' // Centers the window
   pWindow.Center

   DIM wszLibName AS WSTRING * 260 = ExePath & "\MSCOMCT2.OCX"
   DIM CLSID_MSComCtl2_MonthView AS CLSID = (&h232E456A, &h87C3, &h11D1, {&h8B, &hE3,&h00, &h00, &hF8, &h75, &h4D, &hA1})
   DIM IID_MSComCtl2_MonthView AS CLSID = (&h232E4565, &h87C3, &h11D1, {&h8B, &hE3,&h00, &h00, &hF8, &h75, &h4D, &hA1})
   DIM RTLKEY_MSCOMCT2 AS WSTRING * 260 = "651A8940-87C5-11d1-8BE3-0000F8754DA1"

   DIM pHost AS CAxHost = CAxHost(@pWindow, IDC_MONTHVIEW, wszLibName, CLSID_MSComCtl2_MonthView, _
       IID_MSComCtl2_MonthView, RTLKEY_MSCOMCT2, 0, 0, pWindow.ClientWidth, pWindow.ClientHeight)
   DIM hCtl AS HWND = GetDlgItem(pWindow.hWindow, IDC_MONTHVIEW)

'   SetFocus pHost.hWindow

   DIM pdisp AS CDispInvoke = pHost.OcxDispObj
   pdisp.Put("Year") = 1985
   pdisp.Put("Month") = 1
   pdisp.Put("Day") = 21

   ' // Display the window
   ShowWindow(hwndMain, nCmdShow)
   UpdateWindow(hwndMain)

   ' // Dispatch Windows messages
   DIM uMsg AS MSG
   WHILE (GetMessageW(@uMsg, NULL, 0, 0) <> FALSE)
      IF AfxCAxHostForwardMessage(GetFocus, @uMsg) = FALSE THEN
         IF IsDialogMessageW(hwndMain, @uMsg) = 0 THEN
            TranslateMessage(@uMsg)
            DispatchMessageW(@uMsg)
         END IF
      END IF
   WEND
   FUNCTION = uMsg.wParam

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

' ========================================================================================
' Main window procedure
' ========================================================================================
FUNCTION WndProc (BYVAL hwnd AS HWND, BYVAL uMsg AS UINT, BYVAL wParam AS WPARAM, BYVAL lParam AS LPARAM) AS LRESULT

   SELECT CASE uMsg

      CASE WM_COMMAND
         SELECT CASE LOWORD(wParam)
            CASE IDCANCEL
               ' // If ESC key pressed, close the application by sending an WM_CLOSE message
               IF HIWORD(wParam) = BN_CLICKED THEN
                  SendMessageW hwnd, WM_CLOSE, 0, 0
                  EXIT FUNCTION
               END IF
         END SELECT

      CASE WM_SIZE
         ' // Optional resizing code
         IF wParam <> SIZE_MINIMIZED THEN
            ' // Retrieve a pointer to the CWindow class
            DIM pWindow AS CWindow PTR = AfxCWindowPtr(hwnd)
            ' // Move the position of the button
            IF pWindow THEN pWindow->MoveWindow GetDlgItem(hwnd, IDC_MONTHVIEW), _
               0, 0, pWindow->ClientWidth, pWindow->ClientHeight, CTRUE
         END IF

    CASE WM_DESTROY
         ' // Ends the application by sending a WM_QUIT message
         PostQuitMessage(0)
         EXIT FUNCTION

   END SELECT

   ' // Default processing of Windows messages
   FUNCTION = DefWindowProcW(hwnd, uMsg, wParam, lParam)

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


[José Roca]

If you're going to try the old VB6 OCXs, here is an example for the masked edit control.

Code: [Select]

' ########################################################################################
' Microsoft Windows
' Contents: Embedded Microsoft Masked Edit Control
' Compiler: FreeBasic 32 & 64 bit
' Copyright (c) 2017 Jose Roca. Freeware. Use at your own risk.
' THIS CODE AND INFORMATION IS PROVIDED "AS IS" WITHOUT WARRANTY OF ANY KIND, EITHER
' EXPRESSED OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE IMPLIED WARRANTIES OF
' MERCHANTABILITY AND/OR FITNESS FOR A PARTICULAR PURPOSE.
' ########################################################################################

#define UNICODE
#INCLUDE ONCE "Afx/CAxHost/CAxHost.inc"
#INCLUDE ONCE "Afx/CDispInvoke.inc"
#INCLUDE ONCE "Afx/AfxCOM.inc"
USING Afx

DECLARE FUNCTION WinMain (BYVAL hInstance AS HINSTANCE, _
                          BYVAL hPrevInstance AS HINSTANCE, _
                          BYVAL szCmdLine AS ZSTRING PTR, _
                          BYVAL nCmdShow AS LONG) AS LONG

   END WinMain(GetModuleHandleW(NULL), NULL, COMMAND(), SW_NORMAL)

DECLARE FUNCTION WndProc (BYVAL hwnd AS HWND, BYVAL uMsg AS UINT, BYVAL wParam AS WPARAM, BYVAL lParam AS LPARAM) AS LRESULT

CONST IDC_MSMASK1 = 1001
CONST IDC_MSMASK2 = 1002

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

   ' // Set process DPI aware
   ' // The recommended way is to use a manifest file
   AfxSetProcessDPIAware

   ' // Creates the main window
   DIM pWindow AS CWindow
   ' -or- DIM pWindow AS CWindow = "MyClassName" (use the name that you wish)
   DIM hwndMain AS HWND = pWindow.Create(NULL, "Masked Edit Control", @WndProc)
   ' // Sizes it by setting the wanted width and height of its client area
   pWindow.SetClientSize(200, 80)
   ' // Centers the window
   pWindow.Center

   DIM wszLibName AS WSTRING * 260 = ExePath & "\MSMASK32.OCX"
   DIM CLSID_MaskEdBox AS CLSID = (&hC932BA85, &h4374, &h101B, {&hA5, &h6C, &h00, &hAA, &h00, &h36, &h68, &hDC})
   DIM IID_IMSMask AS IID = (&h4D6CC9A0, &hDF77, &h11CF, {&h8E, &h74, &h00, &hA0, &hC9, &h0F, &h26, &hF8})
   DIM RTLKEY_MaskEdBox AS WSTRING * 260 = "BC96F860-9928-11cf-8AFA-00AA00C00905"

   DIM pHost AS CAxHost = CAxHost(@pWindow, IDC_MSMASK1, wszLibName, CLSID_MaskEdBox, _
       IID_IMSMask, RTLKEY_MaskEdBox, 10, 10, pWindow.ClientWidth - 20, 22)
   DIM pHost2 AS CAxHost = CAxHost(@pWindow, IDC_MSMASK2, wszLibName, CLSID_MaskEdBox, _
       IID_IMSMask, RTLKEY_MaskEdBox, 10, 45, pWindow.ClientWidth - 20, 22)
   SetFocus pHost.hWindow

   DIM pdisp AS CDispInvoke = pHost.OcxDispObj
   ' Set the fore and back colors
   pdisp.Put("ForeColor") = BGR(0, 0, 255)
   ' Set the mask
   pdisp.Put("Mask") = "(###) - ### - ####"

   DIM pdisp2 AS CDispInvoke = pHost2.OcxDispObj
   ' Set the fore and back colors
   pdisp2.Put("ForeColor") = BGR(255, 0, 0)
   pdisp2.Put("BackColor") = BGR(255, 255, 0)
   ' Set the mask
   pdisp2.Put("Mask") = "(###) - ### - ####"

   ' // Display the window
   ShowWindow(hwndMain, nCmdShow)
   UpdateWindow(hwndMain)

   ' // Dispatch Windows messages
   DIM uMsg AS MSG
   WHILE (GetMessageW(@uMsg, NULL, 0, 0) <> FALSE)
      IF AfxCAxHostForwardMessage(GetFocus, @uMsg) = FALSE THEN
         IF IsDialogMessageW(hwndMain, @uMsg) = 0 THEN
            TranslateMessage(@uMsg)
            DispatchMessageW(@uMsg)
         END IF
      END IF
   WEND
   FUNCTION = uMsg.wParam

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

' ========================================================================================
' Main window procedure
' ========================================================================================
FUNCTION WndProc (BYVAL hwnd AS HWND, BYVAL uMsg AS UINT, BYVAL wParam AS WPARAM, BYVAL lParam AS LPARAM) AS LRESULT

   SELECT CASE uMsg

      CASE WM_COMMAND
         SELECT CASE LOWORD(wParam)
            CASE IDCANCEL
               ' // If ESC key pressed, close the application by sending an WM_CLOSE message
               IF HIWORD(wParam) = BN_CLICKED THEN
                  SendMessageW hwnd, WM_CLOSE, 0, 0
                  EXIT FUNCTION
               END IF
         END SELECT

      CASE WM_SIZE
         ' // Optional resizing code
         IF wParam <> SIZE_MINIMIZED THEN
            ' // Retrieve a pointer to the CWindow class
            DIM pWindow AS CWindow PTR = AfxCWindowPtr(hwnd)
            ' // Move the position of the controls
            IF pWindow THEN pWindow->MoveWindow GetDlgItem(hwnd, IDC_MSMASK1), _
               10, 10, pWindow->ClientWidth - 20, 22, CTRUE
            IF pWindow THEN pWindow->MoveWindow GetDlgItem(hwnd, IDC_MSMASK2), _
               10, 45, pWindow->ClientWidth - 20, 22, CTRUE
         END IF

    CASE WM_DESTROY
         ' // Ends the application by sending a WM_QUIT message
         PostQuitMessage(0)
         EXIT FUNCTION

   END SELECT

   ' // Default processing of Windows messages
   FUNCTION = DefWindowProcW(hwnd, uMsg, wParam, lParam)

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

Please note that these examples are for testing purposes and use the a registration free technique (I don't have any of them registered). If they are registered and licensed, you can use the constructor that accepts a ProgID. As with my previous OLE containers, some will work a some won't. VB6 used the form as an OLE container and implemented interfaces (some not standard) to build complex controls that contain other controls, and even arrays of controls. These are outside the purpose of my modest OLE container. I wanted to use ATL.DLL, but it works very badly.

[José Roca]

CDispInvoke.inc

I have changed Put and PutRef to a properties, but as FreeBasic doesn't accept more than a parameter in properties, I also have added the Set and SetRef functions with up to two index parameters (I think that two are enough; we could add more if needed).

But whereas Put and PutRef will allow this syntax:

pdisp.Put ("property name") = value

being a function, with Set and SetRef you will have to use

pdisp.Set ("property name", index[es], value)

[José Roca]

I have added another overloaded PutRef property. Only when testing you find the convenience of additions to ease its use.

Code: [Select]

' ========================================================================================
PRIVATE PROPERTY CDispInvoke.PutRef (BYVAL dispID AS DISPID, BYVAL pv AS ANY PTR)
   CDISPINVOKE_DP("CDISPINVOKE DispInvoke.PutRef - DISPID - ANY PTR")
   DIM cvArg AS CVAR = CVAR(CAST(IUnknown PTR, pv), TRUE)
   SetResult(this.DispInvoke(DISPATCH_PROPERTYPUTREF, dispID, cvArg, 1, m_lcid))
END PROPERTY
' ========================================================================================
' ========================================================================================
PRIVATE PROPERTY CDispInvoke.PutRef (BYVAL pwszName AS WSTRING PTR, BYVAL pv AS ANY PTR)
   CDISPINVOKE_DP("CDISPINVOKE DispInvoke.PutRef - Name - ANY PTR")
   DIM cvArg AS CVAR = CVAR(CAST(IUnknown PTR, pv), TRUE)
   SetResult(this.DispInvoke(DISPATCH_PROPERTYPUTREF, pwszName, cvArg, 1, m_lcid))
END PROPERTY
' ========================================================================================

Preparing the test for the Microsoft Hierarchical Control (see below) I needed it to set a pointer to the data source.

[José Roca]

Two of the Microsoft grid controls, the Flex Grid and the Hierarchical Flex Grid work well with my OLE container, and because they use twips, they're DPI aware. It is a pity that they are only 32 bit. Maybe I will write classes to ease its use and add events.

Test for the Microsoft Hierarchical Grid Control:

Code: [Select]

' ########################################################################################
' Microsoft Windows
' Contents: Embedded Microsoft Hierarchical Grid Control
' Compiler: FreeBasic 32 & 64 bit
' Copyright (c) 2017 Jose Roca. Freeware. Use at your own risk.
' THIS CODE AND INFORMATION IS PROVIDED "AS IS" WITHOUT WARRANTY OF ANY KIND, EITHER
' EXPRESSED OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE IMPLIED WARRANTIES OF
' MERCHANTABILITY AND/OR FITNESS FOR A PARTICULAR PURPOSE.
' ########################################################################################

#define UNICODE
#INCLUDE ONCE "Afx/AfxCOM.inc"
#INCLUDE ONCE "Afx/CAxHost/CAxHost.inc"
#INCLUDE ONCE "Afx/CDispInvoke.inc"
#INCLUDE ONCE "Afx/CADODB/CADODB.inc"
USING Afx

DECLARE FUNCTION WinMain (BYVAL hInstance AS HINSTANCE, _
                          BYVAL hPrevInstance AS HINSTANCE, _
                          BYVAL szCmdLine AS ZSTRING PTR, _
                          BYVAL nCmdShow AS LONG) AS LONG

   END WinMain(GetModuleHandleW(NULL), NULL, COMMAND(), SW_NORMAL)

DECLARE FUNCTION WndProc (BYVAL hwnd AS HWND, BYVAL uMsg AS UINT, BYVAL wParam AS WPARAM, BYVAL lParam AS LPARAM) AS LRESULT

CONST IDC_GRID = 1001

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

   ' // Set process DPI aware
   ' // The recommended way is to use a manifest file
   AfxSetProcessDPIAware

   ' // Creates the main window
   DIM pWindow AS CWindow
   ' -or- DIM pWindow AS CWindow = "MyClassName" (use the name that you wish)
   DIM hwndMain AS HWND = pWindow.Create(NULL, "Microsoft Hierarchical Flex Grid", @WndProc)
   ' // Sizes it by setting the wanted width and height of its client area
   pWindow.SetClientSize(800, 450)
   ' // Centers the window
   pWindow.Center

   DIM wszLibName AS WSTRING * 260 = ExePath & "\MSHFLXGD.OCX"
   DIM CLSID_MSHFlexGrid AS CLSID = (&h0ECD9B64, &h23AA, &h11D0, {&hB3, &h51, &h00, &hA0, &hC9, &h05, &h5D, &h8E})
   DIM IID_IMSHFlexGrid AS IID = (&h0ECD9B62, &h23AA, &h11D0, {&hB3, &h51, &h00, &hA0, &hC9, &h05, &h5D, &h8E})
   DIM RTLKEY_MSHFlexGrid AS WSTRING * 260 = "1F3D5522-3F42-11d1-B2FA-00A0C908FB55"

   DIM pHost AS CAxHost = CAxHost(@pWindow, IDC_GRID, wszLibName, CLSID_MSHFlexGrid, _
       IID_IMSHFlexGrid, RTLKEY_MSHFlexGrid, 0, 0, pWindow.ClientWidth, pWindow.ClientHeight)
   SetFocus pHost.hWindow

   DIM pGrid AS CDispInvoke = pHost.OcxDispObj
   ' Change the width of the columns (measures are in twips)
   ' The first parameter is the grid's pointer reference,
   ' the second the column index, and the third the col width.
   pGrid.Set("ColWidth", 0, 0, 300)
   pGrid.Set("ColWidth", 1, 0, 1100)
   pGrid.Set("ColWidth", 2, 0, 3000)
   pGrid.Set("ColWidth", 3, 0, 2000)
   pGrid.Set("ColWidth", 4, 0, 2000)
   pGrid.Set("ColWidth", 5, 0, 3000)
   pGrid.Set("ColWidth", 6, 0, 1500)
   pGrid.Set("ColWidth", 7, 0, 700)
   pGrid.Set("ColWidth", 8, 0, 1200)
   pGrid.Set("ColWidth", 9, 0, 1200)
   pGrid.Set("ColWidth", 10, 0, 1500)
   pGrid.Set("ColWidth", 11, 0, 1500)

   ' Change the foreground and background colors
   pGrid.Put("ForeColor") = BGR(0, 0, 0)
   pGrid.Put("BackColor") = BGR(255,255,235)

   ' Open an ADO connection
   DIM pConnection AS CAdoConnection PTR = NEW CAdoConnection
   pConnection->ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & ExePath & $"\nwind.mdb"
   pConnection->Open
   ' Open a recordset
   DIM pRecordset AS CAdoRecordset PTR = NEW CAdoRecordset
   DIM cvSource AS CVAR = "SELECT * FROM Customers"
   pRecordset->Open(cvSource, pConnection, adOpenKeyset, adLockOptimistic, adCmdText)
   ' Set the Datasource property of the recordset
   pGrid.PutRef("DataSource") = pRecordset->DataSource
   ' Close the recordset
   pRecordset->Close
   ' Close the connection
   pConnection->Close
   ' // Delete the recordset
   Delete pRecordset
   ' // Delete the connection
   Delete pConnection

   ' // Display the window
   ShowWindow(hwndMain, nCmdShow)
   UpdateWindow(hwndMain)

   ' // Dispatch Windows messages
   DIM uMsg AS MSG
   WHILE (GetMessageW(@uMsg, NULL, 0, 0) <> FALSE)
      IF AfxCAxHostForwardMessage(GetFocus, @uMsg) = FALSE THEN
         IF IsDialogMessageW(hwndMain, @uMsg) = 0 THEN
            TranslateMessage(@uMsg)
            DispatchMessageW(@uMsg)
         END IF
      END IF
   WEND
   FUNCTION = uMsg.wParam

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

' ========================================================================================
' Main window procedure
' ========================================================================================
FUNCTION WndProc (BYVAL hwnd AS HWND, BYVAL uMsg AS UINT, BYVAL wParam AS WPARAM, BYVAL lParam AS LPARAM) AS LRESULT

   SELECT CASE uMsg

      CASE WM_COMMAND
         SELECT CASE LOWORD(wParam)
            CASE IDCANCEL
               ' // If ESC key pressed, close the application by sending an WM_CLOSE message
               IF HIWORD(wParam) = BN_CLICKED THEN
                  SendMessageW hwnd, WM_CLOSE, 0, 0
                  EXIT FUNCTION
               END IF
         END SELECT

      CASE WM_SIZE
         ' // Optional resizing code
         IF wParam <> SIZE_MINIMIZED THEN
            ' // Retrieve a pointer to the CWindow class
            DIM pWindow AS CWindow PTR = AfxCWindowPtr(hwnd)
            ' // Move the position of the button
            IF pWindow THEN pWindow->MoveWindow GetDlgItem(hwnd, IDC_GRID), _
               0, 0, pWindow->ClientWidth, pWindow->ClientHeight, CTRUE
         END IF

    CASE WM_DESTROY
         ' // Ends the application by sending a WM_QUIT message
         PostQuitMessage(0)
         EXIT FUNCTION

   END SELECT

   ' // Default processing of Windows messages
   FUNCTION = DefWindowProcW(hwnd, uMsg, wParam, lParam)

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


[José Roca]

Test for the Microsoft Flex Grid Control:

Code: [Select]

' ########################################################################################
' Microsoft Windows
' Contents: Embedded Microsoft Flex Grid Control
' Compiler: FreeBasic 32 & 64 bit
' Copyright (c) 2017 Jose Roca. Freeware. Use at your own risk.
' THIS CODE AND INFORMATION IS PROVIDED "AS IS" WITHOUT WARRANTY OF ANY KIND, EITHER
' EXPRESSED OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE IMPLIED WARRANTIES OF
' MERCHANTABILITY AND/OR FITNESS FOR A PARTICULAR PURPOSE.
' ########################################################################################

#define UNICODE
#INCLUDE ONCE "Afx/AfxCOM.inc"
#INCLUDE ONCE "Afx/CAxHost/CAxHost.inc"
#INCLUDE ONCE "Afx/CDispInvoke.inc"
#INCLUDE ONCE "Afx/CADODB/CADODB.inc"
USING Afx

DECLARE FUNCTION WinMain (BYVAL hInstance AS HINSTANCE, _
                          BYVAL hPrevInstance AS HINSTANCE, _
                          BYVAL szCmdLine AS ZSTRING PTR, _
                          BYVAL nCmdShow AS LONG) AS LONG

   END WinMain(GetModuleHandleW(NULL), NULL, COMMAND(), SW_NORMAL)

DECLARE FUNCTION WndProc (BYVAL hwnd AS HWND, BYVAL uMsg AS UINT, BYVAL wParam AS WPARAM, BYVAL lParam AS LPARAM) AS LRESULT

CONST IDC_GRID = 1001

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

   ' // Set process DPI aware
   ' // The recommended way is to use a manifest file
   AfxSetProcessDPIAware

   ' // Creates the main window
   DIM pWindow AS CWindow
   ' -or- DIM pWindow AS CWindow = "MyClassName" (use the name that you wish)
   DIM hwndMain AS HWND = pWindow.Create(NULL, "Microsoft Flex Grid", @WndProc)
   ' // Sizes it by setting the wanted width and height of its client area
   pWindow.SetClientSize(800, 450)
   ' // Centers the window
   pWindow.Center

   DIM wszLibName AS WSTRING * 260 = ExePath & "\Msflxgrd.ocx"
   DIM CLSID_MSFlexGrid AS CLSID = (&h6262D3A0, &h531B, &h11CF, {&h91, &hF6, &hC2, &h86, &h3C, &h38, &h5E, &h30})
   DIM IID_IMSFlexGrid AS IID = (&h5F4DF280, &h531B, &h11CF, {&h91, &hF6, &hC2, &h86, &h3C, &h38, &h5E, &h30})
   DIM RTLKEY_MSFlexGrid AS WSTRING * 260 = "72E67120-5959-11cf-91F6-C2863C385E30"

   DIM pHost AS CAxHost = CAxHost(@pWindow, IDC_GRID, wszLibName, CLSID_MSFlexGrid, _
       IID_IMSFlexGrid, RTLKEY_MSFlexGrid, 0, 0, pWindow.ClientWidth, pWindow.ClientHeight)
   SetFocus pHost.hWindow

   ' Open an ADO connection
   DIM pConnection AS CAdoConnection PTR = NEW CAdoConnection
   pConnection->ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & ExePath & $"\nwind.mdb"
   pConnection->Open
   ' Open a recordset
   DIM pRecordset AS CAdoRecordset PTR = NEW CAdoRecordset
   DIM cvSource AS CVAR = "SELECT * FROM Customers"
   pRecordset->Open(cvSource, pConnection, adOpenKeyset, adLockOptimistic, adCmdText)
   ' Move to the last record
   pRecordset->MoveLast

   ' Set the number of grid rows and columns
   DIM pGrid AS CDispInvoke = pHost.OcxDispObj
   pGrid.Put("Rows") = pRecordset->RecordCount + 1
   pGrid.Put("Cols") = 12

   ' Set the headers
   pGrid.Set("TextMatrix", 0,  1, "Customer ID")
   pGrid.Set("TextMatrix", 0,  2, "Company Name")
   pGrid.Set("TextMatrix", 0,  3, "Contact Name")
   pGrid.Set("TextMatrix", 0,  4, "Contact Title")
   pGrid.Set("TextMatrix", 0,  5, "Address")
   pGrid.Set("TextMatrix", 0,  6, "City")
   pGrid.Set("TextMatrix", 0,  7, "Region")
   pGrid.Set("TextMatrix", 0,  8, "Postal Code")
   pGrid.Set("TextMatrix", 0,  9, "Country")
   pGrid.Set("TextMatrix", 0,  10, "Phone")
   pGrid.Set("TextMatrix", 0,  11, "Fax")

   ' Change the width of the columns (measures are in twips)
   pGrid.Set("ColWidth", 0, 300)
   pGrid.Set("ColWidth", 1, 1100)
   pGrid.Set("ColWidth", 2, 3000)
   pGrid.Set("ColWidth", 3, 2000)
   pGrid.Set("ColWidth", 4, 2000)
   pGrid.Set("ColWidth", 5, 3000)
   pGrid.Set("ColWidth", 6, 1500)
   pGrid.Set("ColWidth", 7, 700)
   pGrid.Set("ColWidth", 8, 1200)
   pGrid.Set("ColWidth", 9, 1200)
   pGrid.Set("ColWidth", 10, 1500)
   pGrid.Set("ColWidth", 11, 1500)

   ' Allow to resize columns
   pGrid.Put("AllowUserResizing") = 1   ' flexResizeColumns

   ' Change the foreground and background colors
   pGrid.Put("ForeColor") = BGR(0, 0, 0)
   pGrid.Put("BackColor") = BGR(255,255,235)

   ' Move to the first record
   pRecordset->MoveFirst
   ' Parse the recordset and fill the grid
   DIM row AS LONG = 1
   WHILE NOT pRecordset->EOF
      'Select the row
      pGrid.Put("Row") = row
      ' Set the content of cell 1
      pGrid.Put("Col") = 1
      pGrid.Put("CellAlignment") = 1   ' flexAlignLeftCenter
      pGrid.Put("Text") = pRecordset->Collect("CustomerID")
      ' Set the content of cell 2
      pGrid.Put("Col") = 2
      pGrid.Put("CellAlignment") = 1   ' flexAlignLeftCenter
      pGrid.Put("Text") = pRecordset->Collect("CompanyName")
      ' Set the content of cell 3
      pGrid.Put("Col") = 3
      pGrid.Put("CellAlignment") = 1   ' flexAlignLeftCenter
      pGrid.Put("Text") = pRecordset->Collect("ContactName")
      ' Set the content of cell 4
      pGrid.Put("Col") = 4
      pGrid.Put("CellAlignment") = 1   ' flexAlignLeftCenter
      pGrid.Put("Text") = pRecordset->Collect("ContactTitle")
      ' Set the content of cell 5
      pGrid.Put("Col") = 5
      pGrid.Put("CellAlignment") = 1   ' flexAlignLeftCenter
      pGrid.Put("Text") = pRecordset->Collect("Address")
      ' Set the content of cell 6
      pGrid.Put("Col") = 6
      pGrid.Put("CellAlignment") = 1   ' flexAlignLeftCenter
      pGrid.Put("Text") = pRecordset->Collect("City")
      ' Set the content of cell 7
      pGrid.Put("Col") = 7
      pGrid.Put("CellAlignment") = 1   ' flexAlignLeftCenter
      pGrid.Put("Text") = pRecordset->Collect("Region")
      ' Set the content of cell 8
      pGrid.Put("Col") = 8
      pGrid.Put("CellAlignment") = 1   ' flexAlignLeftCenter
      pGrid.Put("Text") = pRecordset->Collect("PostalCode")
      ' Set the content of cell 9
      pGrid.Put("Col") = 9
      pGrid.Put("CellAlignment") = 1   ' flexAlignLeftCenter
      pGrid.Put("Text") = pRecordset->Collect("Country")
      ' Set the content of cell 10
      pGrid.Put("Col") = 10
      pGrid.Put("CellAlignment") = 1   ' flexAlignLeftCenter
      pGrid.Put("Text") = pRecordset->Collect("Phone")
      ' Set the content of cell 11
      pGrid.Put("Col") = 11
      pGrid.Put("CellAlignment") = 1   ' flexAlignLeftCenter
      pGrid.Put("Text") = pRecordset->Collect("Fax")
      ' Fetch the next row
      pRecordset->MoveNext
      ' Increment the counter
      row += 1
   WEND

   ' Select the first cell
   pGrid.Put("Row") = 1
   pGrid.Put("Col") = 1

   ' Close the recordset
   pRecordset->Close
   ' Close the connection
   pConnection->Close
   ' // Delete the recordset
   Delete pRecordset
   ' // Delete the connection
   Delete pConnection

   ' // Display the window
   ShowWindow(hwndMain, nCmdShow)
   UpdateWindow(hwndMain)

   ' // Dispatch Windows messages
   DIM uMsg AS MSG
   WHILE (GetMessageW(@uMsg, NULL, 0, 0) <> FALSE)
      IF AfxCAxHostForwardMessage(GetFocus, @uMsg) = FALSE THEN
         IF IsDialogMessageW(hwndMain, @uMsg) = 0 THEN
            TranslateMessage(@uMsg)
            DispatchMessageW(@uMsg)
         END IF
      END IF
   WEND
   FUNCTION = uMsg.wParam

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

' ========================================================================================
' Main window procedure
' ========================================================================================
FUNCTION WndProc (BYVAL hwnd AS HWND, BYVAL uMsg AS UINT, BYVAL wParam AS WPARAM, BYVAL lParam AS LPARAM) AS LRESULT

   SELECT CASE uMsg

      CASE WM_COMMAND
         SELECT CASE LOWORD(wParam)
            CASE IDCANCEL
               ' // If ESC key pressed, close the application by sending an WM_CLOSE message
               IF HIWORD(wParam) = BN_CLICKED THEN
                  SendMessageW hwnd, WM_CLOSE, 0, 0
                  EXIT FUNCTION
               END IF
         END SELECT

      CASE WM_SIZE
         ' // Optional resizing code
         IF wParam <> SIZE_MINIMIZED THEN
            ' // Retrieve a pointer to the CWindow class
            DIM pWindow AS CWindow PTR = AfxCWindowPtr(hwnd)
            ' // Move the position of the button
            IF pWindow THEN pWindow->MoveWindow GetDlgItem(hwnd, IDC_GRID), _
               0, 0, pWindow->ClientWidth, pWindow->ClientHeight, CTRUE
         END IF

    CASE WM_DESTROY
         ' // Ends the application by sending a WM_QUIT message
         PostQuitMessage(0)
         EXIT FUNCTION

   END SELECT

   ' // Default processing of Windows messages
   FUNCTION = DefWindowProcW(hwnd, uMsg, wParam, lParam)

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

I thik that CDispInvoke has become easier to use than DispHelper, and without having to use a third party C++ DLL.

[José Roca]

Test for the Microsoft DataList Control

Code: [Select]

' ########################################################################################
' Microsoft Windows
' Contents: Microsoft Data List Control
' Compiler: FreeBasic 32 & 64 bit
' Copyright (c) 2017 Jose Roca. Freeware. Use at your own risk.
' THIS CODE AND INFORMATION IS PROVIDED "AS IS" WITHOUT WARRANTY OF ANY KIND, EITHER
' EXPRESSED OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE IMPLIED WARRANTIES OF
' MERCHANTABILITY AND/OR FITNESS FOR A PARTICULAR PURPOSE.
' ########################################################################################

#define UNICODE
#INCLUDE ONCE "Afx/AfxCOM.inc"
#INCLUDE ONCE "Afx/CAxHost/CAxHost.inc"
#INCLUDE ONCE "Afx/CDispInvoke.inc"
#INCLUDE ONCE "Afx/CADODB/CADODB.inc"
USING Afx

DECLARE FUNCTION WinMain (BYVAL hInstance AS HINSTANCE, _
                          BYVAL hPrevInstance AS HINSTANCE, _
                          BYVAL szCmdLine AS ZSTRING PTR, _
                          BYVAL nCmdShow AS LONG) AS LONG

   END WinMain(GetModuleHandleW(NULL), NULL, COMMAND(), SW_NORMAL)

DECLARE FUNCTION WndProc (BYVAL hwnd AS HWND, BYVAL uMsg AS UINT, BYVAL wParam AS WPARAM, BYVAL lParam AS LPARAM) AS LRESULT

CONST IDC_DATALIST = 1001

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

   ' // Set process DPI aware
   ' // The recommended way is to use a manifest file
   AfxSetProcessDPIAware

   ' // Creates the main window
   DIM pWindow AS CWindow
   ' -or- DIM pWindow AS CWindow = "MyClassName" (use the name that you wish)
   DIM hwndMain AS HWND = pWindow.Create(NULL, "Microsoft Data List Control", @WndProc)
   ' // Sizes it by setting the wanted width and height of its client area
   pWindow.SetClientSize(300, 350)
   ' // Centers the window
   pWindow.Center

   DIM wszLibName AS WSTRING * 260 = ExePath & "\MSDATLST.OCX"
   DIM CLSID_DataList AS CLSID = (&hF0D2F219, &hCCB0, &h11D0, {&hA3, &h16, &h00, &hAA, &h00, &h68, &h8B, &h10})
   DIM IID_IDataList AS IID = (&hF0D2F217, &hCCB0, &h11D0, {&hA3, &h16, &h00, &hAA, &h00, &h68, &h8B, &h10})
   DIM RTLKEY_DATALIST AS WSTRING * 260 = "A133F000-CCB0-11d0-A316-00AA00688B10"

   DIM pHost AS CAxHost = CAxHost(@pWindow, IDC_DATALIST, wszLibName, CLSID_DataList, _
       IID_IDataList, RTLKEY_DATALIST, 0, 0, pWindow.ClientWidth, pWindow.ClientHeight)
   SetFocus pHost.hWindow

   ' Get a reference to the DataList object
   DIM pDataList AS CDispInvoke = pHost.OcxDispObj
   ' Change the foreground and background colors
   pDataList.Put("ForeColor") = BGR(0, 0, 0)
   pDataList.Put("BackColor") = BGR(255,255,235)

   ' Open an ADO connection
   DIM pConnection AS CAdoConnection PTR = NEW CAdoConnection
   pConnection->ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & ExePath & $"\Biblio.mdb"
   pConnection->Open
   ' Open a recordset
   DIM pRecordset AS CAdoRecordset PTR = NEW CAdoRecordset
   DIM cvSource AS CVAR = "SELECT * FROM Publishers ORDER BY Name"
   pRecordset->Open(cvSource, pConnection, adOpenKeyset, adLockOptimistic, adCmdText)
   ' Set the recordset to the control
   pDataList.PutRef("RowSource") = pRecordset->DataSource
   pDataList.Put("ListField") = "Name"

   ' // Display the window
   ShowWindow(hwndMain, nCmdShow)
   UpdateWindow(hwndMain)

   ' // Dispatch Windows messages
   DIM uMsg AS MSG
   WHILE (GetMessageW(@uMsg, NULL, 0, 0) <> FALSE)
      IF AfxCAxHostForwardMessage(GetFocus, @uMsg) = FALSE THEN
         IF IsDialogMessageW(hwndMain, @uMsg) = 0 THEN
            TranslateMessage(@uMsg)
            DispatchMessageW(@uMsg)
         END IF
      END IF
   WEND
   FUNCTION = uMsg.wParam

   ' Close the recordset
   pRecordset->Close
   ' Close the connection
   pConnection->Close
   ' // Delete the recordset
   Delete pRecordset
   ' // Delete the connection
   Delete pConnection

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

' ========================================================================================
' Main window procedure
' ========================================================================================
FUNCTION WndProc (BYVAL hwnd AS HWND, BYVAL uMsg AS UINT, BYVAL wParam AS WPARAM, BYVAL lParam AS LPARAM) AS LRESULT

   SELECT CASE uMsg

      CASE WM_COMMAND
         SELECT CASE LOWORD(wParam)
            CASE IDCANCEL
               ' // If ESC key pressed, close the application by sending an WM_CLOSE message
               IF HIWORD(wParam) = BN_CLICKED THEN
                  SendMessageW hwnd, WM_CLOSE, 0, 0
                  EXIT FUNCTION
               END IF
         END SELECT

      CASE WM_SIZE
         ' // Optional resizing code
         IF wParam <> SIZE_MINIMIZED THEN
            ' // Retrieve a pointer to the CWindow class
            DIM pWindow AS CWindow PTR = AfxCWindowPtr(hwnd)
            ' // Move the position of the button
            IF pWindow THEN pWindow->MoveWindow GetDlgItem(hwnd, IDC_DATALIST), _
               0, 0, pWindow->ClientWidth, pWindow->ClientHeight, CTRUE
         END IF

    CASE WM_DESTROY
         ' // Ends the application by sending a WM_QUIT message
         PostQuitMessage(0)
         EXIT FUNCTION

   END SELECT

   ' // Default processing of Windows messages
   FUNCTION = DefWindowProcW(hwnd, uMsg, wParam, lParam)

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


[José Roca]

Test for the Microsoft Data Combo Control

Code: [Select]

' ########################################################################################
' Microsoft Windows
' Contents: Microsoft Data Combo Control
' Compiler: FreeBasic 32 & 64 bit
' Copyright (c) 2017 Jose Roca. Freeware. Use at your own risk.
' THIS CODE AND INFORMATION IS PROVIDED "AS IS" WITHOUT WARRANTY OF ANY KIND, EITHER
' EXPRESSED OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE IMPLIED WARRANTIES OF
' MERCHANTABILITY AND/OR FITNESS FOR A PARTICULAR PURPOSE.
' ########################################################################################

#define UNICODE
#INCLUDE ONCE "Afx/AfxCOM.inc"
#INCLUDE ONCE "Afx/CAxHost/CAxHost.inc"
#INCLUDE ONCE "Afx/CDispInvoke.inc"
#INCLUDE ONCE "Afx/CADODB/CADODB.inc"
USING Afx

DECLARE FUNCTION WinMain (BYVAL hInstance AS HINSTANCE, _
                          BYVAL hPrevInstance AS HINSTANCE, _
                          BYVAL szCmdLine AS ZSTRING PTR, _
                          BYVAL nCmdShow AS LONG) AS LONG

   END WinMain(GetModuleHandleW(NULL), NULL, COMMAND(), SW_NORMAL)

DECLARE FUNCTION WndProc (BYVAL hwnd AS HWND, BYVAL uMsg AS UINT, BYVAL wParam AS WPARAM, BYVAL lParam AS LPARAM) AS LRESULT

CONST IDC_DATACOMBO = 1001

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

   ' // Set process DPI aware
   ' // The recommended way is to use a manifest file
   AfxSetProcessDPIAware

   ' // Creates the main window
   DIM pWindow AS CWindow
   ' -or- DIM pWindow AS CWindow = "MyClassName" (use the name that you wish)
   DIM hwndMain AS HWND = pWindow.Create(NULL, "Microsoft Data Combo Control", @WndProc)
   ' // Sizes it by setting the wanted width and height of its client area
   pWindow.SetClientSize(300, 200)
   ' // Centers the window
   pWindow.Center

   DIM wszLibName AS WSTRING * 260 = ExePath & "\MSDATLST.OCX"
   DIM CLSID_DataCombo AS CLSID = (&hF0D2F21C, &hCCB0, &h11D0, {&hA3, &h16, &h00, &hAA, &h00, &h68, &h8B, &h10})
   DIM IID_IDataCombo AS IID = (&hF0D2F21A, &hCCB0, &h11D0, {&hA3, &h16, &h00, &hAA, &h00, &h68, &h8B, &h10})
   DIM RTLKEY_DATACOMBO AS WSTRING * 260 = "A133F000-CCB0-11d0-A316-00AA00688B10"

   DIM pHost AS CAxHost = CAxHost(@pWindow, IDC_DATACOMBO, wszLibName, CLSID_DataCombo, _
       IID_IDataCombo, RTLKEY_DATACOMBO, 0, 0, pWindow.ClientWidth, pWindow.ClientHeight)
   SetFocus pHost.hWindow

   ' Get a reference to the DataList object
   DIM pDataList AS CDispInvoke = pHost.OcxDispObj
   ' Change the foreground and background colors
   pDataList.Put("ForeColor") = BGR(0, 0, 0)
   pDataList.Put("BackColor") = BGR(255,255,235)

   ' Open an ADO connection
   DIM pConnection AS CAdoConnection PTR = NEW CAdoConnection
   pConnection->ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & ExePath & $"\Biblio.mdb"
   pConnection->Open
   ' Open a recordset
   DIM pRecordset AS CAdoRecordset PTR = NEW CAdoRecordset
   DIM cvSource AS CVAR = "SELECT * FROM Publishers ORDER BY Name"
   pRecordset->Open(cvSource, pConnection, adOpenKeyset, adLockOptimistic, adCmdText)
   ' Set the recordset to the control
   pDataList.PutRef("RowSource") = pRecordset->DataSource
   pDataList.Put("ListField") = "Name"

   ' // Display the window
   ShowWindow(hwndMain, nCmdShow)
   UpdateWindow(hwndMain)

   ' // Dispatch Windows messages
   DIM uMsg AS MSG
   WHILE (GetMessageW(@uMsg, NULL, 0, 0) <> FALSE)
      IF AfxCAxHostForwardMessage(GetFocus, @uMsg) = FALSE THEN
         IF IsDialogMessageW(hwndMain, @uMsg) = 0 THEN
            TranslateMessage(@uMsg)
            DispatchMessageW(@uMsg)
         END IF
      END IF
   WEND
   FUNCTION = uMsg.wParam

   ' Close the recordset
   pRecordset->Close
   ' Close the connection
   pConnection->Close
   ' // Delete the recordset
   Delete pRecordset
   ' // Delete the connection
   Delete pConnection

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

' ========================================================================================
' Main window procedure
' ========================================================================================
FUNCTION WndProc (BYVAL hwnd AS HWND, BYVAL uMsg AS UINT, BYVAL wParam AS WPARAM, BYVAL lParam AS LPARAM) AS LRESULT

   SELECT CASE uMsg

      CASE WM_COMMAND
         SELECT CASE LOWORD(wParam)
            CASE IDCANCEL
               ' // If ESC key pressed, close the application by sending an WM_CLOSE message
               IF HIWORD(wParam) = BN_CLICKED THEN
                  SendMessageW hwnd, WM_CLOSE, 0, 0
                  EXIT FUNCTION
               END IF
         END SELECT

      CASE WM_SIZE
         ' // Optional resizing code
         IF wParam <> SIZE_MINIMIZED THEN
            ' // Retrieve a pointer to the CWindow class
            DIM pWindow AS CWindow PTR = AfxCWindowPtr(hwnd)
            ' // Move the position of the button
            IF pWindow THEN pWindow->MoveWindow GetDlgItem(hwnd, IDC_DATACOMBO), _
               0, 0, pWindow->ClientWidth, pWindow->ClientHeight, CTRUE
         END IF

    CASE WM_DESTROY
         ' // Ends the application by sending a WM_QUIT message
         PostQuitMessage(0)
         EXIT FUNCTION

   END SELECT

   ' // Default processing of Windows messages
   FUNCTION = DefWindowProcW(hwnd, uMsg, wParam, lParam)

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


[ganlinlao]

hi，jose
I downloaded and used the fbc1.0.6 compiler and downloaded your latest idispinvoke.inc.
Using the latest example code from above. In the mothview example, there is still an error.
Code:
DIM pdisp AS CDispInvoke = pHost.OcxDispObj
   pdisp.Put ("Year", 2017)
   pdisp.Put ("Month", 12)
   pdisp.Put ("Day", 25)
Will show the same type of mismatch error.

 pdisp.Put ("Year", cVar (2017))

This will not be a problem.

I really like idispatch.put ("") = value like this style, thank you very much. I am very  looking forward to your ways to provide easier-to-handle "events".

[José Roca]

Works fine here. Maybe you're using an outdated CVAR.inc.