Author Topic: CWindow for bc9Basic  (Read 1230 times)

0 Members and 1 Guest are viewing this topic.

Offline James C. Fuller

  • Global Moderator
  • Hero Member
  • *****
  • Posts: 699
CWindow for bc9Basic
« on: August 03, 2016, 07:55:22 PM »
I have been very busy the last few months working with Fred Harris and his TCLib and more recently with Josť Roca and Paul Squires on their respective source ports to FreeBasic.
http://www.planetsquires.com/protect/forum/index.php
The main reason for the FreeBasic ports, as quoted by Josť, was the discovery of the "PRIVATE" Function/Sub modifier. With this directive the compiler only includes and compiles the source if it is used in the application, very similar to PowerBASIC's dead code removal.

Josť has given me permission to port his copyrighted CWindow and assorted Afx sources to bc9Basic.
A massive job but I do have a lot done though there is still much work ahead.
This project is 64bit UNICODE for Visual C++ only.

The main advantage here is the ability to include all your library sources.
Well that was a BIG problem with bc9Basic and c++. Normally you create and compile very granulated libraries, which you then link to your main application. This is a HUGE PIA as any small source change requires a recompile.
The main issue I had to overcome was simulating PRIVATE and I did it.
I wrap the source with $IFUSE USE_FuncName ... $ENDUSE

$IFUSE USE_SetColor
'------------------------------------------------------------------------------
Function SetColor (TxtColr As COLORREF,BkColr As COLORREF, hdc As HDC ) AS HBRUSH
    static As HBRUSH ReUsableBrush
    DeleteObject(ReUsableBrush)
    ReUsableBrush = CreateSolidBrush( BkColr )
    SetTextColor( hdc, TxtColr )
    SetBkColor( hdc, BkColr )
    Function  = ReUsableBrush
End Function
'------------------------------------------------------------------------------
$ENDUSE

With the new bc9Basic $USE directive the translator will only include the source if it finds:
$USE USE_SetColor earlier in the app source. This is completely manual now but it is not as bad as it might seem.
If the c++ compiler can't find SetColor it will complain "can't find SetColor". Just highlight, paste near the top of your source, and preface it with $USE USE_ .

One of the reasons I investigated CWindow for bc9Basic is the ability to create DPI aware applications. With the proliferation of high resolution monitors Josť has been advocating the need for many years. In the source below one line of code let's me see how my app will look on different DPI settings without me having to set it in the OS.
'pWindow->DPI(192)

Stay tuned for more ....

James


$NOMAIN
$CPP
$ONEXIT "ULEX.EXE $FILE$.CPP TCHARXLATER_VC.TXT"
'$ONEXIT "VSCPP.BAT $FILE$ -m64 gui"
$ONEXIT "TCLIB.BAT $FILE$"

'include these library functions
$USE USE_CREATEARRAY USE_AfxAddWindowExStyle

'uncomment for tclib usage
$HEADER
    #include <commctrl.h>
    #pragma comment(lib,"comctl32.lib")
    #pragma comment(lib,"gdi32.lib")
    #pragma comment(lib,"advapi32.lib")
   
$HEADER

$Include <Afx/CWindow.bi>
$Include <Afx/AfxWin.bi>
$Include <bc9Lib.bi>
$Include <Afx/CLayout.bi>

CONST IDC_OFD = 1001
CallBack Function WndProc()
    Select Case Msg
        Case WM_COMMAND
            Select Case CBCTL
                Case IDCANCEL
                    If CBCTLMSG = BN_CLICKED Then
                        SendMessageW(CBHWND,WM_CLOSE,0,0)
                    EndIf
                    Exit Function
            End Select
        Case WM_GETMINMAXINFO
            Dim As MINMAXINFO PTR ptmmi = (MINMAXINFO PTR) lParam
            Dim As CWindow Ptr pWindow = (CWindow Ptr) GetWindowLongPtr(CBHNDL,0)
            If pWindow Then
                ptmmi->ptMinTrackSize.x = 300 * pWindow->rxRatio()
                ptmmi->ptMinTrackSize.y = 180 * pWindow->ryRatio()
            EndIf
            Exit Function
        Case WM_SIZE
            Dim AS CLayout Ptr pLayout = (CLayout Ptr) GetPropW(CBHNDL,_T("CLAYOUTPTR"))
            If pLayout Then
                pLayout->AdjustControls()
            EndIf
            Exit Function
        Case WM_DESTROY
            RemovePropW(CBHNDL,_T("CLAYOUTPTR"))
            PostQuitMessage(0)
            Exit Function
    End Select
End Function
'==============================================================================
CONST IDC_EDIT1 = 1001
CONST IDC_EDIT2 = 1002
CONST IDC_GROUPBOX = 1003
CONST IDC_COMBOBOX = 1004
CONST Anchor(LOPtr,Parent,Id,where) = LOPtr->AnchorControl(GetDlgItem(Parent->hWindow(),Id),where)
CONST CTLHNDL(id) = GetDlgItem(hWnd,id)
'==============================================================================

Function WinMain()
    Dim As Int RetVal
    Dim As HWND hWnd
    Dim As CWindow Ptr pWindow = new CWindow
    'pWindow->DPI(192)
    hWnd = pWindow->Create(NULL,"Sizing example", &WndProc)
    pWindow->SetClientSize(455,180)
    'reduce groupbox flickering
    AfxAddWindowExStyle(hWnd,WS_EX_COMPOSITED)
    pWindow->Center()
    Dim As HWND hEdit = pWindow->AddControl("Edit", hWnd, IDC_EDIT1, "", 20, 15, 305, 23)
    pWindow->AddControl("EditMultiline", hWnd, IDC_EDIT2, "", 20, 45, 305, 80)
    SetFocus(hEdit)
    pWindow->AddControl("GroupBox", hWnd, IDC_GROUPBOX, "GroupBox", 340, 8, 100, 155)
    pWindow->AddControl("Button", hWnd, IDCANCEL, "&Close", 250, 140, 75, 23)
    Dim As HWND hComboBox  = pWindow->AddControl("ComboBox", hWnd, IDC_COMBOBOX, "", 350, 30, 80, 100)
    Dim sTxt$
    For int i = 1 To 9
        sTxt$ = "Item " & Right$("00" & Str$(i),2)
        SendMessageW(hComboBox,CB_ADDSTRING,0,(LPARAM)sTxt$)
    Next
    'Anchor the controls
    Dim As CLayout Ptr pLayout = new CLayout(hWnd)
    SetPropW(pWindow->hWindow(),_T("CLAYOUTPTR"),pLayout)
    Anchor(pLayout,pWindow,IDC_EDIT1,AFX_ANCHOR_WIDTH)
    pLayout->AnchorControl(CTLHNDL(IDC_EDIT2), AFX_ANCHOR_HEIGHT_WIDTH)
    pLayout->AnchorControl(CTLHNDL(IDCANCEL), AFX_ANCHOR_BOTTOM_RIGHT)
    pLayout->AnchorControl(CTLHNDL(IDC_GROUPBOX), AFX_ANCHOR_HEIGHT_RIGHT)
    pLayout->AnchorControl(CTLHNDL(IDC_COMBOBOX), AFX_ANCHOR_RIGHT)
    RetVal = pWindow->Do_Events(CmdShow)
    delete pWindow
    Function = RetVal
   
End Function
'==============================================================================