Tabcontrol color

[Charles Pegge]

Hi Aurel

WinUtil.inc is used for most of the windows demos, OpenGl demos, and IDEs. The meta-programming is a bit complicated but provides flexibility.

Hi Frank,
Have you thought about using buttons and edit-boxes to make you own Tab control? I think it would make customizing easier.

[Frank Brübach]

1) Yes Charles better to build Buttons Labels and so on.. for own tabcontrol... I found already an old Powerbasic example but I Had a Problem with the gradientfill function I have translated but I think I dont need to use IT Here

2) I will Go another way with owner Draw for my Editor

Regards frank

[Frank Brübach]

My Idea of a new Editor goes more and more this Direction with color Buttons and reduce all to Minimum ...

Dummy Demo Pictures below

IT took nearly two hours in Work together build this Setup but I Like IT

[Zlatko Vid]

Hi Frank

Where is code for above example Test color tabs ?
with green and red tabs...i am interested

maybe can be used for themes for example BLACK THEME for editor

[Pierre Bellisle]

a main resizable modal dialog with a tab control, each tab control have a sub tab-modeless-dialog with his own controls
those sub tab-modeless-dialog have to be sibbling of the tab control, not child.
all messages from all tab-modeless-dialog goes to TabsCommonDialogProc callback,
one could create one callback for each dialog.
code is ansi, some minor changes are needed for wide unicode.
GradientFill is used to draw the background.
See Raymond Chen tab control

Code Select Expand

'a main resizable modal dialog with a tab control, each tab control have a sub tab-modeless-dialog with his own controls
'those sub tab-modeless-dialog have to be sibbling of the tab control, not child.
'all messages from all tab-modeless-dialog goes to TabsCommonDialogProc callback,
'one could create one callback for each dialog.
'code is ansi, some minor changes are needed for wide unicode.
GradientFill is used to draw the background.
'See Raymond Chen https://devblogs.microsoft.com/oldnewthing/20191015-00/?p=102996

//KickResource "D:\Dev\Oxygen\o2\~code\~~~Resource.res"
//KickSwitch -64
//KickEnd

#autodim off
indexbase 0

uses "Dialogs.inc"

%MainDialogButton01      101
%MainDialogButtonIDCANCEL IDCANCEL

%Dialog0Frame        0101
%Dialog0ButtonOk    0102
%Dialog0Edit        0201

%Dialog1Frame        1101
%Dialog1ButtonOk    1102
%Dialog1Edit        1201

%Dialog2Frame        2101
%Dialog2ButtonOk    2102
%Dialog2Edit        2201

%DS_MODALFRAME      0x0080
%DS_3DLOOK          0x0004
%DS_NOFAILCREATE    0x0010
%DEFAULT_GUI_FONT    17
%GCL_HICON          -14
%WS_EX_RIGHTCROLLBAR 0
%WM_APP              0x08000
%WM_MOVING          0x0216
%RDW_INVALIDATE      0x0001
%RDW_ALLCHILDREN    0x0080
%RDW_INVALIDATE      0x0001
%RDW_INTERNALPAINT  0x0002
%RDW_ERASE          0x0004

%SWP_NOSIZE          0x0001
%SWP_NOMOVE          0x0002
%SWP_NOZORDER        0x0004
%SWP_NOREDRAW        0x0008
%SWP_NOACTIVATE      0x0010
%SWP_FRAMECHANGED    0x0020
%SWP_SHOWWINDOW      0x0040
%SWP_HIDEWINDOW      0x0080
%SWP_NOCOPYBITS      0x0100
%SWP_NOOWNERZORDER  0x0200
%SWP_NOSENDCHANGING  0x0400
%SWP_DRAWFRAME      %SWP_FRAMECHANGED
%SWP_NOREPOSITION    %SWP_NOOWNERZORDER

%TCS_MULTILINE      0x0200
%TCIF_TEXT          1
%TCIF_IMAGE        2
%TCIF_PARAM        0x0008
%TCIF_STATE        0x0010
%TCM_FIRST          0x1300
%TCN_FIRST          0-550
%TCN_SELCHANGE      %TCN_FIRST - 1
%TCN_SELCHANGING    %TCN_FIRST - 2
%TCM_GETIMAGELIST  %TCM_FIRST + 2
%TCM_SETIMAGELIST  %TCM_FIRST + 3
%TCM_GETITEMCOUNT  %TCM_FIRST + 4
%TCM_GETCURSEL      %TCM_FIRST + 11
%TCM_INSERTITEMA    %TCM_FIRST + 7
%TCM_ADJUSTRECT    %TCM_FIRST + 40
%TCM_INSERTITEMW    %TCM_FIRST + 62
%TCM_INSERTITEM    %TCM_INSERTITEMW

%RDW_VALIDATE        0x0008
%RDW_NOINTERNALPAINT 0x0010
%RDW_NOERASE        0x0020
%RDW_NOCHILDREN      0x0040
%RDW_ALLCHILDREN    0x0080
%RDW_UPDATENOW      0x0100
%RDW_ERASENOW        0x0200
%RDW_FRAME          0x0400
%RDW_NOFRAME        0x0800
%WC_TABCONTROL      "SysTabControl32"
%WC_STATIC          "Static"
%ICC_TAB_CLASSES    8

%SWP_SHOWWINDOW    64
%SIZE_MINIMIZED    1
%HWND_TOP          0
%HWND_DESKTOP      0

%DeviceCount        7
string device[]  = {"Monitor","Printer","Speaker","Mouse","USB","BlueTooth","Battery"}
word deviceBmp[] = {3, 7, 15, 18, 47, 55, 45}

type TCITEM 'TCITEMA TCITEMW
  int  mask, dwState, dwStateMask
  char* pszText
  int  cchTextMax, iImage
  sys  lParam
end type
typedef TCITEM TC_ITEM

TYPE SP_CLASSIMAGELIST_DATA
  dword cbSize    'DWORD
  sys  ImageList 'HIMAGELIST
  sys  Reserved  'ULONG_PTR
END TYPE

! SetupDiGetClassImageList    lib "SetupApi.dll" alias "SetupDiGetClassImageList"(sys) as bool
! SetupDiDestroyClassImageList lib "SetupApi.dll" alias "SetupDiDestroyClassImageList"(sys) as bool
'______________________________________________________________________________

%GRADIENT_FILL_RECT_H  0x00000000
%GRADIENT_FILL_RECT_V  0x00000001
%GRADIENT_FILL_TRIANGLE 0x00000002
%GRADIENT_FILL_OP_FLAG  0x000000ff

TYPE GRADIENT_RECT '8 bytes
  dword UpperLeft
  dword LowerRight
END TYPE

TYPE TRIVERTEX '16 bytes
  LONG  x    'LONG
  LONG  y    'LONG
  WORD  Red  'COLOR16
  WORD  Green 'COLOR16
  WORD  Blue  'COLOR16
  WORD  Alpha 'COLOR16
END TYPE

! GradientFill lib "MSIMG32.DLL" alias "GradientFill"(sys, sys, dword, sys, dword, dword) as bool
'______________________________________________________________________________

sub DrawGradient(sys hDlg, sys hDC, short TabId)
GRADIENT_RECT GradientRect
dim TRIVERTEX Vertex(1)
Rect rc

GetClientRect(hDlg, rc)

Vertex(0).x    = 0
Vertex(0).y    = 0
Vertex(0).Red  = 0x0010
Vertex(0).Green = 0x0010
Vertex(0).Blue  = 0x0010

Vertex(1).x    = rc.Right
Vertex(1).y    = rc.Bottom
Vertex(1).Red  = 0
Vertex(1).Green = 0
Vertex(1).Blue  = 0xffff

GradientRect.UpperLeft  = 0 'Vertex(0)
GradientRect.LowerRight = 1 'Vertex(1)

GradientFill(hDC, @Vertex(0, 0), 2, @GradientRect, 1, GRADIENT_FILL_RECT_V)

end sub
'_____________________________________________________________________________

function TabsCommonDialogProc(sys hTabDialog, uint uMsg, sys wParam, lParam) as int callback
'this is a common dialog used by every TABs dialog
static sys hTabControl, hBrush
static short TabId 'will be set in WM_ERASEBKGND
static long ClientSizeX, ClientSizeY

select case uMsg

  case WM_INITDIALOG
    dword RGB_BLUE = 0x00FF0000
    hBrush = CreateSolidBrush(RGB_BLUE)
    hTabControl = FindWindowEx(GetParent(hTabDialog), 0, "SysTabControl32", "wcTabControl-01")
    return true

  case WM_COMMAND
    select case TabId
      case 0 'Tab-Dialog-0
        select case loword(wParam)
          case Dialog0ButtonOk
            if hiword(wParam) = BN_CLICKED OR hiword(wParam) = 1
              Beep(5500, 50)
            end if
          case Dialog0Edit
            if hiword(wParam) = EN_CHANGE THEN
            end if
            if hiword(wParam) = EN_SETFOCUS THEN
              Beep(2500, 50)
            end if
            if hiword(wParam) = EN_KILLFOCUS THEN
            end if
        end select
      case 1 'Tab-Dialog-1
        select case loword(wParam)
          case Dialog1ButtonOk
            if hiword(wParam) = BN_CLICKED OR hiword(wParam) = 1
              Beep(1500, 50)
            end if
        end select
      case 2 'Tab-Dialog-2
        select case loword(wParam)
          case Dialog2ButtonOk
            if hiword(wParam) = BN_CLICKED OR hiword(wParam) = 1
              Beep(1500, 50) : Beep(3500, 50)
            end if
        end select
    end select

    CASE WM_ERASEBKGND
      'display each TAB dialog with a gradient background color
      TabId = SendMessage(hTabControl, TCM_GETCURSEL, 0, 0)
      DrawGradient(hTabDialog, wParam, TabId)
      gosub MoveControl
      Return(1)

  case WM_CTLCOLOREDIT 'WM_CTLCOLORBTN | WM_CTLCOLORMSGBOX | WM_CTLCOLORSTATIC | WM_CTLCOLORSCROLLBAR | WM_CTLCOLORLISTBOX
    select GetDlgCtrlID(lParam)
      'edit control colorisation
      case Dialog0Edit, Dialog1Edit, Dialog2Edit
        SetTextColor(wParam, 0x00FFFF) 'yellow
        SetBkColor(wParam, 0xFF0000) 'blue
        return(hBrush) 'blue
      case else
        return(0)
    end select

  case WM_SIZE 'dialog size have changed
    if wParam <> SIZE_MINIMIZED
      ClientSizeX = loword(lParam)
      ClientSizeY = hiword(lParam)
      gosub MoveControl
    endif

  case WM_CLOSE
    'DestroyWindow(hTabDialog)

  case WM_DESTROY
    if hBrush then DeleteObject(hBrush)
    PostQuitMessage(0)

end select

return 0

MoveControl:
  select case TabId
    case 0
      MoveWindow(GetDlgItem(hTabDialog, Dialog0Frame), 10, 10, ClientSizeX - 20, ClientSizeY - 20, %TRUE)
      MoveWindow(GetDlgItem(hTabDialog, Dialog0ButtonOk), 30, 40, 110, 25, %TRUE)
      MoveWindow(GetDlgItem(hTabDialog, Dialog0Edit), 150, 45, 50, 16, %TRUE)
    case 1
      MoveWindow(GetDlgItem(hTabDialog, Dialog1Frame), 10, 10, ClientSizeX - 20, ClientSizeY - 20, %TRUE)
      MoveWindow(GetDlgItem(hTabDialog, Dialog1ButtonOk), 30, 40, 110, 25, %TRUE)
      MoveWindow(GetDlgItem(hTabDialog, Dialog1Edit), 150, 45, 50, 16, %TRUE)
    case 2
      MoveWindow(GetDlgItem(hTabDialog, Dialog2Frame), 10, 10, ClientSizeX - 20, ClientSizeY - 20, %TRUE)
      MoveWindow(GetDlgItem(hTabDialog, Dialog2ButtonOk), 30, 40, 110, 25, %TRUE)
      MoveWindow(GetDlgItem(hTabDialog, Dialog2Edit), 150, 45, 50, 16, %TRUE)
  end select
ret

end function
'______________________________________________________________________________

function MainDialogProc(sys hDlg, uint uMsg, sys wParam, lParam) as int callback
'creation of tab control and all needed tab-dialogs with their control
static SP_CLASSIMAGELIST_DATA ClassImageListData
static sys hIcon, hFont, hTabControl, ImageList
static short TabId, TabIdPrv
dim static sys hTabDlg[6]

select case uMsg

  case WM_INITDIALOG
    hIcon = ExtractIcon(GetModuleHandle(0), "Shell32.dll", 294) 'o icon
    SetClassLongPtr(hDlg, GCL_HICON, hIcon)
    hFont = GetStockObject(DEFAULT_GUI_FONT) 'DeleteObject not really needed becose StockObject
    SendMessage(GetDlgItem(hDlg, MainDialogButton01), WM_SETFONT, hFont, 0)
    SendMessage(GetDlgItem(hDlg, MainDialogButtonIDCANCEL), WM_SETFONT, hFont, 0)

    'create main tab control container
    hTabControl = CreateWindowEx(0, WC_TABCONTROL, "wcTabControl-01",
                                  WS_CHILD | WS_CLIPSIBLINGS | WS_VISIBLE | TCS_MULTILINE | WS_TABSTOP,
                                  0, 0, 100, 100, 'remove TCS_MULTILINE for one row only tabs
                                  hDlg, null, GetModuleHandle(0), null)
    if hTabControl = null : mbox "Create Tab Control failed" : return null : endif
    SendMessage(hTabControl, WM_SETFONT, hFont, 0)

    'steal bmp image list from SetupDi api
    ClassImageListData.cbSize = SIZEOF(SP_CLASSIMAGELIST_DATA)
    SetupDiGetClassImageList(@ClassImageListData)
    SendMessage(hTabControl, TCM_SETIMAGELIST, 0, ClassImageListData.ImageList)

    'create seven (DeviceCount) TAB item
    TCITEM TabItem
    TabItem.mask = TCIF_TEXT | TCIF_IMAGE | TCIF_PARAM
    for TabId = 0 to < %DeviceCount
        TabItem.pszText    = device[TabId]
        TabItem.cchTextMax = len(device[TabId])
        TabItem.iImage    = deviceBmp[TabId] 'select an icon in the image list
        TabItem.lParam    = TabId 'if more or less than 4 bytes of application-defined data exist per tab,
                                  'an application must define a structure and use it instead of the TCITEM structure.
                                  'The first member of the application-defined
        if SendMessage(hTabControl, TCM_INSERTITEMA, TabId, @TabItem) = -1 then
          mbox "InsertItem Tab failed" : DestroyWindow(hTabControl)
          return null
        endif
    next

    'create seven (DeviceCount) hidden tab-dialog, only view one
    TabId = 0
    Dialog(10, 30, 120, 40, "TabDialog()", WS_CHILD | DS_SETFONT | DS_3DLOOK | WS_TABSTOP, 9, "Segoe UI", WS_EX_CONTROLPARENT)
    GroupBox("Frame - " + device(TabId) + " " + str(TabId), Dialog0Frame, 1, 1, 118, 38)
    PushButton("IDOK 0", Dialog0ButtonOk, 20, 25, 40, 12)
    Control("[edit 0]", Dialog0Edit, "Edit", ES_LEFT | ES_NOHIDESEL | WS_TABSTOP, 76, 28, 40, 8, WS_EX_LEFT | WS_EX_STATICEDGE)
    hTabDlg(TabId) = CreateModelessDialog(hDlg, @TabsCommonDialogProc, TabId)

    TabId = 1
    Dialog(10, 30, 120, 40, "TabDialog()", WS_CHILD | DS_SETFONT | DS_3DLOOK | WS_TABSTOP, 9, "Segoe UI", WS_EX_CONTROLPARENT)
    GroupBox("Frame - " + device(TabId) + " " + str(TabId), Dialog1Frame, 1, 1, 118, 38)
    PushButton("IDOK 1", Dialog1ButtonOk, 20, 25, 40, 12)
    Control("[edit 1]", Dialog1Edit, "Edit", ES_LEFT | ES_NOHIDESEL | WS_TABSTOP, 76, 28, 40, 8, WS_EX_LEFT | WS_EX_STATICEDGE)
    hTabDlg(TabId) = CreateModelessDialog(hDlg, @TabsCommonDialogProc, TabId)

    TabId = 2
    Dialog(10, 30, 120, 40, "TabDialog()", WS_CHILD | DS_SETFONT | DS_3DLOOK | WS_TABSTOP, 9, "Segoe UI", WS_EX_CONTROLPARENT)
    GroupBox("Frame - " + device(TabId) + " " + str(TabId), Dialog2Frame, 1, 1, 118, 38)
    PushButton("IDOK 2", Dialog2ButtonOk, 20, 25, 40, 12)
    Control("[edit 2]", Dialog2Edit, "Edit", ES_LEFT | ES_NOHIDESEL | WS_TABSTOP, 76, 28, 40, 8, WS_EX_LEFT | WS_EX_STATICEDGE)
    hTabDlg(TabId) = CreateModelessDialog(hDlg, @TabsCommonDialogProc, TabId)

    for TabId = 3 to < DeviceCount
      Dialog(10, 30, 120, 40, "TabDialog()", WS_CHILD | DS_SETFONT | DS_3DLOOK | WS_TABSTOP, 9, "Segoe UI", WS_EX_CONTROLPARENT)
      hTabDlg(TabId) = CreateModelessDialog(hDlg, @TabsCommonDialogProc, TabId)
    next
    TabId = 0 : ShowWindow(hTabDlg(TabId), SW_SHOW)
    return true

  case WM_COMMAND
    select case loword(wParam)
      case MainDialogButton01
        if hiword(wParam) = BN_CLICKED | hiword(wParam) = 1
          Beep(3500, 50)
        endif
      case MainDialogButtonIDCANCEL
        if hiword(wParam) = BN_CLICKED OR hiword(wParam) = 1
          EndDialog(hDlg, null)
        end if
    end select

  case WM_SIZE 'main dialog size have changed
    if wParam <> SIZE_MINIMIZED
      long ClientSizeX = loword(lParam) 'client area width  in pixels.
      long ClientSizeY = hiword(lParam) 'client area height in pixels.
      MoveWindow(hTabControl, 10, 10, ClientSizeX - 20, ClientSizeY - 50, %TRUE)
      gosub TabClientRectAjust 'TabId must be set right before gosub  'ADJUSTRECT
      MoveWindow(GetDlgItem(hDlg, MainDialogButton01), 20, ClientSizeY - 32, 90, 25, %TRUE)
      MoveWindow(GetDlgItem(hDlg, MainDialogButtonIDCANCEL), ClientSizeX - 110, ClientSizeY - 32, 90, 25, %TRUE)
    endif

  case WM_NOTIFY 'tab selection
    NMHDR pNotifyMessageHeader at lParam
    if pNotifyMessageHeader.hwndFrom = hTabControl then
      'tab notification: NM_CLICK, NM_DBLCLK, NM_RCLICK, NM_RDBLCLK, NM_RELEASEDCAPTURE,
      '                  TCN_FOCUSCHANGE, TCN_GETOBJECT, TCN_KEYDOWN, TCN_SELCHANGE, TCN_SELCHANGING.
      if pNotifyMessageHeader.code = TCN_SELCHANGING then 'sent before the selection changes
        TabIdPrv = SendMessage(hTabControl, TCM_GETCURSEL, 0, 0)
        ShowWindow(hTabDlg(TabIdPrv), SW_HIDE)
      elseif pNotifyMessageHeader.code = TCN_SELCHANGE then 'sent after the selection changes
        TabId = SendMessage(hTabControl, TCM_GETCURSEL, 0, 0)
        gosub TabClientRectAjust
        ShowWindow(hTabDlg(TabId), SW_SHOWNORMAL)
      endif
    endif

  case WM_CLOSE
    EndDialog(hDlg, null)

  case WM_DESTROY
    if ClassImageListData.ImageList then ImageList_Destroy(@ClassImageListData) 'in this case, don't use SetupDiDestroyClassImageList()
    if hIcon then DestroyIcon(hIcon)

end select

return 0

TabClientRectAjust:
  rect rcTabControl
  GetWindowRect(hTabControl, rcTabControl)
  MapWindowPoints(HWND_DESKTOP, hDlg, rcTabControl, 2)
  SendMessage(hTabControl, TCM_ADJUSTRECT, false, rcTabControl) 'window rectangle
  MoveWindow(hTabDlg(TabId), rcTabControl.left,    rcTabControl.top,
                              rcTabControl.right  - rcTabControl.left,
                              rcTabControl.bottom - rcTabControl.top, %TRUE)
ret

end function
'______________________________________________________________________________

sub winmain()
sys hDlg
MSG wMsg

init_common_controls()
Dialog(0, 0, 300, 200, "OxygenBASIC" + sizeof(sys) * 8 + " - TAB control - Sizeable", WS_CAPTION |
        WS_SIZEBOX | WS_MINIMIZEBOX | WS_MAXIMIZEBOX | WS_SYSMENU | DS_CENTER, 9, "Segoe UI", 0)

PushButton("Button", MainDialogButton01, 40, 85, 40, 12)
PushButton("Close", MainDialogButtonIDCANCEL, 130, 85, 40, 12)

CreateModalDialog(null, @MainDialogProc, 0)

end sub
'______________________________________________________________________________

winmain()
'______________________________________________________________________________
'

updated Dialogs.inc for safer memory buffer

Code Select Expand

'library functions for creating dialogs at runtime in memory
'coded according to Win32 Help file
'
'based on
'dialogs.bas in:
'https://www.freebasic.net/forum/viewtopic.php?t=5667

'dialogs.inc in:
'MASM32 SDK

'Pierre Bellisle memory buffer modification, search for "2024-02-01:"

uses corewin
uses generics
#ifdef review
  uses console
#endif

'some classes for using InitCommonControlsEx
% WC_HEADER="SysHeader32"
% TOOLBARCLASSNAME="ToolbarWindow32"
% STATUSCLASSNAME="msctls_statusbar32"
% TRACKBAR_CLASS="msctls_trackbar32"
% UPDOWN_CLASS="msctls_updown32"
% PROGRESS_CLASS="msctls_progress32"
% WC_LISTVIEW="SysListView32"
% WC_TREEVIEW="SysTreeView32"
% WC_TABCONTROL="SysTabControl32"
% ANIMATE_CLASS="SysAnimate32"
% RICHEDIT_CLASS10A="RICHEDIT"
% RICHEDIT_CLASS="RichEdit20A"
% MSFTEDIT_CLASS="RichEdit50W"
% MONTHCAL_CLASS="SysMonthCal32"
% DATETIMEPICK_CLASS="SysDateTimePick32"
% WC_IPADDRESS="SysIPAddress32"
% HOTKEY_CLASS="msctls_hotkey32"
% REBARCLASSNAME="ReBarWindow32"
% WC_PAGESCROLLER="SysPager"
% WC_NATIVEFONTCTL="NativeFontCtl"
% WC_COMMCTRL_DRAGLISTMSG="commctrl_DragListMsg"
% WC_COMBOBOXEX="ComboBoxEx32"
% TOOLTIPS_CLASS="tooltips_class32"
'==============================================================================

'Items needed to run dialogs.inc
% DS_SETFONT=0x40
% SS_LEFT=0
% SS_CENTER=1
% SS_RIGHT=2
% SS_ICON=3
% SS_BITMAP=0x0E
% SS_NOTIFY=0x0100
% CBS_SIMPLE=1
% CBS_DROPDOWN=2
% CBS_DROPDOWNLIST=3
% CBS_SORT=0x0100
% CBS_HASSTRINGS=0x0200
% ES_SAVESEL=0x8000

'some often used constants
% DS_CENTER=0x0800
% LR_LOADFROMFILE=0x0010
% IMAGE_BITMAP=0
% IMAGE_ICON=1
% ICON_SMALL=0
% ICON_BIG=1
% WM_SETICON=0x80
% STM_SETIMAGE=0x172
% SWP_NOMOVE=2
% SWP_NOREDRAW=8
% COLOR_WINDOW=5
% SM_CXBORDER=5
% SM_CYBORDER=6
% SWP_NOZORDER=4
% HWND_TOPMOST= -1
% HORZRES=8
% VERTRES=10
% ODS_SELECTED=1
% WM_DRAWITEM=0x2B
% SRCCOPY=0xCC0020
% SB_SETTEXT=0x401
% SB_SETPARTS=0x404


'MultiByteToWideChar
% CP_ACP=0
% MB_PRECOMPOSED=1

'WinApi types
packed type DLGTEMPLATE 'template for dialog box
  dword style
  dword dwExtendedStyle
  word  cdit  'number of items
  short x    'in dialog box units
  short y
  short cx    'width
  short cy    'height
end type
'immediately followed by some data

packed type DLGITEMTEMPLATE 'template for a control in a dialog box
  dword style
  dword dwExtendedStyle
  short x    'in dialog box units
  short y
  short cx    'width
  short cy    'height
  word  id    'control identifier
end type
'immediately followed by some data

'needed for menus
% GRAYED=MF_GRAYED
% CHECKED=MF_CHECKED
% OWNERDRAW=MF_OWNERDRAW
string tab=chr(9)

'needed for accelerators
% FVIRTKEY=1 'TRUE
% FNOINVERT=0x02
% FSHIFT=0x04
% FCONTROL=0x08
% FALT=0x10

type ACCEL
  byte fVirt
  word key
  word cmd
end type


'====================================================================

sys g_memptr        'points to an address in memory
int g_dialog_width  'for centering  a control in a dialog.
int g_Ccount        'controls actually created

sys g_lpdtptr      'pointer to initial DLGTEMPLATE struc
string sDialogTemplate '2024-02-01

'====================================================================

'macros
macro align_2(v) {v+=1 : v = v and -2}
macro align_4(v) {v+=3 : v = v and -4}

macro make_ustring(text,memptr, count)
  int count = MultiByteToWideChar( CP_ACP, MB_PRECOMPOSED,
                              text,
                              -1,
                              memptr,
                              len(text)+1 )
  memptr += count*2
end macro

macro set_val(i,v) {i=v : g_memptr+=sizeof(i)}

'====================================================================
' Create a modal dialog from the dialog box template pointed to by lpdt.
' hParent should be null if the dialog is the main window of the application.
'
' DialogBoxIndirectParam function does not return until EndDialog.
' rval returns whatever was specified as result of EndDialog.
'
function CreateModalDialog( sys hParent, sys *lpDialogProc, dwInitParam, optional lpdt=g_lpdtptr) as sys

  sys rval
  rval = DialogBoxIndirectParam( GetModuleHandle(null),
                                lpdt,
                                hParent,
                                @lpDialogProc,
                                dwInitParam )
  if rval=-1 then
    mbox "Creating modal Dialog failed. Stop!"
#ifdef review
  printl "Error: rval = " rval
  printl "Enter to end ... ": waitkey
#endif
    ExitProcess(0)
  end if

  sDialogTemplate = "" '2024-02-01

  return rval
end function

'====================================================================

' Create a modeless dialog from the dialog box template pointed to by lpdt.
' hParent should be null if the dialog is the main window of the application.
'
' CreateDialogIndirectParam function will use DestroyWindow to return
' rval normally returns the handle to the dialog window.
'
' WS_VISIBLE style is required for a modeless dialog to be visible.
'
function CreateModelessDialog( sys hParent, sys *lpDialogProc, lParamInit, optional lpdt=g_lpdtptr) as sys

  sys rval

  rval = CreateDialogIndirectParam( GetModuleHandle(null),
                                    lpdt,
                                    hParent,
                                    @lpDialogProc,
                                    lParamInit )
  if rval=0 then
    mbox "Cannot create modeless Dialog. Stop!"
#ifdef review
  printl "Error: rval = " rval
  printl "Enter to end ... ": waitkey
#endif
    ExitProcess(0)
  end if

  sDialogTemplate = "" '2024-02-01

  return rval
end function

'====================================================================

' Initialize the essential members of the DLGTEMPLATE structure,
' the menu, class, and title arrays, and optionally the font
' point size and typeface array. Returns a pointer to the next
' WORD following the title or typeface array in g_memptr, and a
' pointer to the allocated memory in lpdt.
'
' Parameter cdit must match the number of controls defined.
' If the value is too high then the function that creates the
' dialog will fail. If the value is too low then one or more
' of the controls will not be created.
'
'
sub Dialog( short x,y,cx,cy, string title, dword style,
          optional short pointSize=0, string typeFace="", dword extStyle=0)

  int e = int(title) : if e != 0 or title=0 then mbox "Warning: title in Dialog probably not a string"
#ifdef review
  printl "sub Dialog: try to create Dialog template structure"
#endif

  sDialogTemplate=nuls(20480) '2024-02-01
  g_lpdtptr=strptr(sDialogTemplate) '2024-02-01

  word cdit at g_lpdtptr+sizeof(dword)*2 'lpdt.cdit
  cdit = 0

  g_dialog_width = cx

  DLGTEMPLATE lpdt at g_lpdtptr
  lpdt.style = style
  lpdt.dwExtendedStyle = extStyle
  lpdt.cdit = cdit
  lpdt.x  = x
  lpdt.y  = y
  lpdt.cx = cx
  lpdt.cy = cy

  ' Set g_memptr to the menu array that follows the structure.
  g_memptr = g_lpdtptr + sizeof(lpdt)

  word menu_ at g_memptr : set_val(menu_, 0)
  word class_ at g_memptr : set_val(class_, 0)

  'title array and set g_memptr to next WORD following the title array.
  make_ustring( title, g_memptr )

  'if DS_SETFONT then point size and typeface
  if style and DS_SETFONT then
    word pointsize_ at g_memptr : set_val(pointsize_, pointSize)
    make_ustring( typeFace, g_memptr )
  end if

  g_Ccount=0

end sub

'====================================================================

' General-purpose control definition starting at g_memptr, initializes
' the essential members of a DLGITEMTEMPLATE structure and
' the class, caption and creation data arrays.
'
' For the class array - six predefined system (User32) classes -
' use "BUTTON", "EDIT", "STATIC", "LISTBOX", "SCROLLBAR", and "COMBOBOX".
' For common controls use the class strings defined for comctl32.dll.
'
' Caption array can specify the caption or initial text for the control,
' or the ordinal value of a resource in the executable file.
' Specify a caption or initial text in the caption parameter,
' or an ordinal value in the rid (ResourceID) parameter. If the
' rid parameter is non-zero then the caption parameter is ignored.
'
' There is no support for creation data.
'
' The tab order of the controls in a dialog is determined by the order in which
' the controls are created and which controls have the WS_TABSTOP style.
'
' To center the control in the dialog horizontally specify -1 for the x parameter.
' This feature will not work correctly for an auto-sized control.
'

sub control( string caption, word cid, string _class, dword style=0, short x,y,cx,cy,
            optional extStyle = 0, short rid=0 )

  if x = -1 then x = (g_dialog_width - cx) / 2

  '--------------------------------------------------------------
  'must be dword boundary
  '--------------------------------------------------------------
  align_4(g_memptr)

  'initialize the essential members of the structure.
  'establish the base style as WS_CHILD or WS_VISIBLE.

  DLGITEMTEMPLATE lpdit at g_memptr
  lpdit.style = WS_CHILD or WS_VISIBLE or style
  lpdit.dwExtendedStyle = extStyle
  lpdit.x  = x
  lpdit.y  = y
  lpdit.cx = cx
  lpdit.cy = cy
  lpdit.id = cid

  'set g_memptr to the class array that follows the structure.
  g_memptr += sizeof(lpdit)

  'initialize the class array and set g_memptr to the next WORD
  make_ustring( _class, g_memptr )

  'initialize the caption array and set g_memptr to the next WORD
  if rid then
    word class_ at g_memptr : set_val(class_, 0xffff)
    word rid_ at g_memptr : set_val(rid_, rid)
  else
    make_ustring( caption, g_memptr )
  end if

  'skip the first element of the creation data, set it to zero (no creation data).
  align_2(g_memptr)
  word create_data at g_memptr : set_val(create_data, 0)

  g_Ccount+=1

#ifdef review
  printl "Controls created: " g_Ccount
#endif

  word cdit at g_lpdtptr+sizeof(dword)*2  'lpdt.cdit
  cdit=g_Ccount
end sub

'====================================================================
' The following specialized control definition procedures are
' simply wrappers for the general-purpose procedure.
'====================================================================

'PUSHBUTTON, PUSHBOX, DEFPUSHBUTTON, CHECKBOX, AUTOCHECKBOX, AUTO3STATE, STATE3, RADIOBUTTON, AUTORADIOBUTTON, GROUPBOX

sub PushButton( string caption, word cid, short x,y,cx,cy, optional dword style=0, extStyle=0, rid=0 )
  Control( caption, cid, "BUTTON", BS_PUSHBUTTON or WS_TABSTOP or style, x,y,cx,cy, extStyle, rid )
end sub

sub PushBox( string caption, word cid, short x,y,cx,cy, optional dword style=0, extStyle=0, rid=0 )
  Control( caption, cid, "BUTTON", BS_PUSHBOX or WS_TABSTOP or style, x,y,cx,cy, extStyle, rid )
end sub

sub DefPushButton( string caption, word cid, short x,y,cx,cy, optional dword style=0, extStyle=0, rid=0 )
  Control( caption, cid, "BUTTON", BS_DEFPUSHBUTTON or WS_TABSTOP or style, x,y,cx,cy, extStyle, rid )
end sub

sub CheckBox( string caption, word cid, short x,y,cx,cy, optional dword style=0, extStyle=0, rid=0 )
  Control( caption, cid, "BUTTON", BS_CHECKBOX or WS_TABSTOP or BS_NOTIFY or style, x,y,cx,cy, extStyle, rid )
end sub

sub AutoCheckBox( string caption, word cid, short x,y,cx,cy, optional dword style=0, extStyle=0, rid=0 )
  Control( caption, cid, "BUTTON", BS_AUTOCHECKBOX or WS_TABSTOP or BS_NOTIFY or style, x,y,cx,cy, extStyle, rid )
end sub

sub Auto3State( string caption, word cid, short x,y,cx,cy, optional dword style=0, extStyle=0, rid=0 )
  Control( caption, cid, "BUTTON", BS_AUTO3STATE or WS_TABSTOP or BS_NOTIFY or style, x,y,cx,cy, extStyle, rid )
end sub

sub State3( string caption, word cid, short x,y,cx,cy, optional dword style=0, extStyle=0, rid=0 )
  Control( caption, cid, "BUTTON", BS_3STATE or WS_TABSTOP or BS_NOTIFY or style, x,y,cx,cy, extStyle, rid )
end sub

sub RadioButton( string caption, word cid, short x,y,cx,cy, optional dword style=0, extStyle=0, rid=0 )
  Control( caption, cid, "BUTTON", BS_AUTORADIOBUTTON or WS_TABSTOP or BS_NOTIFY or style, x,y,cx,cy, extStyle, rid )
end sub

sub AutoRadioButton( string caption, word cid, short x,y,cx,cy, optional dword style=0, extStyle=0, rid=0 )
  Control( caption, cid, "BUTTON", BS_AUTORADIOBUTTON or WS_TABSTOP or BS_NOTIFY or style, x,y,cx,cy, extStyle, rid )
end sub

sub GroupBox( string caption, word cid, short x,y,cx,cy, optional dword style=0, extStyle=0, rid=0 )
  Control( caption, cid, "BUTTON", BS_GROUPBOX or WS_TABSTOP or style, x,y,cx,cy, extStyle, rid )
end sub
'====================================================================

'EDITTEXT, MultiLineText

sub EditText( string caption, word cid, short x,y,cx,cy, optional dword style=0, extStyle=0, rid=0 )
  Control( caption, cid, "EDIT", ES_LEFT or WS_BORDER or WS_TABSTOP or ES_AUTOHSCROLL or style, x,y,cx,cy,
            WS_EX_CLIENTEDGE or WS_EX_ACCEPTFILES or extStyle, rid )
end sub

sub MultiLineText( string caption, word cid, short x,y,cx,cy, optional dword style=0, extStyle=0, rid=0 )
  Control( caption, cid, "EDIT", ES_LEFT|WS_BORDER|WS_TABSTOP|WS_GROUP|WS_VSCROLL|WS_HSCROLL|ES_MULTILINE|ES_AUTOVSCROLL|ES_AUTOHSCROLL|ES_WANTRETURN|style,x,y,cx,cy,
            WS_EX_CLIENTEDGE or WS_EX_ACCEPTFILES or extStyle, rid )
end sub
'====================================================================

'LTEXT, RTEXT, CTEXT, ICON, Bitmap

sub Ltext( string caption, word cid, short x,y,cx,cy, optional dword style=0, extStyle=0, rid=0 )
  Control( caption, cid, "STATIC", SS_LEFT or SS_NOTIFY or style, x,y,cx,cy, extStyle, rid )
end sub

sub Rtext( string caption, word cid, short x,y,cx,cy, optional dword style=0, extStyle=0, rid=0 )
  Control( caption, cid, "STATIC", SS_RIGHT or SS_NOTIFY or style, x,y,cx,cy, extStyle, rid )
end sub

sub Ctext( string caption, word cid, short x,y,cx,cy, optional dword style=0, extStyle=0, rid=0 )
  Control( caption, cid, "STATIC", SS_CENTER or SS_NOTIFY or style, x,y,cx,cy, extStyle, rid )
end sub

sub Icon( string caption, word cid, optional short x=0,y=0,cx=0,cy=0, dword style=0, extStyle=0, rid=0 )
  Control( caption, cid, "STATIC", SS_ICON or SS_NOTIFY or style, x,y,cx,cy, extStyle, rid )
end sub

sub Bitmap( string caption, word cid, optional short x=0,y=0,cx=0,cy=0, dword style=0, extStyle=0, rid=0 )
  Control( caption, cid, "STATIC", SS_BITMAP or SS_NOTIFY or style, x,y,cx,cy, extStyle, rid )
end sub
'====================================================================

'LISTBOX
sub ListBox( string caption, word cid, short x,y,cx,cy, optional dword style=0, extStyle=0, rid=0 )
  Control( "", cid, "LISTBOX", WS_VSCROLL or WS_BORDER or WS_TABSTOP or LBS_NOTIFY or style, x,y,cx,cy,
            WS_EX_CLIENTEDGE or WS_EX_ACCEPTFILES or extStyle, 0 )
end sub
'====================================================================

'SimpleCombo, SortedCombo,  COMBOBOX, DropDownList

sub SimpleCombo( string caption,word cid, short x,y,cx,cy, optional dword style=0, extStyle=0, rid=0 )
  Control( "", cid, "COMBOBOX", WS_VSCROLL or CBS_DROPDOWN or CBS_HASSTRINGS or WS_TABSTOP or style, x,y,cx,cy,
            WS_EX_CLIENTEDGE or WS_EX_ACCEPTFILES or extStyle, 0 )
end sub

sub SortedCombo( string caption, word cid, short x,y,cx,cy, optional dword style=0, extStyle=0, rid=0 )
  Control( "", cid, "COMBOBOX", WS_VSCROLL or CBS_DROPDOWN or CBS_HASSTRINGS or CBS_SORT or WS_TABSTOP or style, x,y,cx,cy,
            WS_EX_CLIENTEDGE or WS_EX_ACCEPTFILES or extStyle, 0 )
end sub

sub ComboBox(string caption, word cid, short x,y,cx,cy, optional dword style=0, extStyle=0, rid=0 )
  Control( "", cid, "COMBOBOX", CBS_SIMPLE or WS_TABSTOP or style, x,y,cx,cy, extStyle, rid )
end sub

sub DropDownList( string caption, word cid, short x,y,cx,cy, optional dword style=0, extStyle=0, rid=0 )
  Control( "", cid, "COMBOBOX", WS_VSCROLL or CBS_DROPDOWNLIST or CBS_HASSTRINGS or WS_TABSTOP or style, x,y,cx,cy,
            WS_EX_CLIENTEDGE or WS_EX_ACCEPTFILES or extStyle, 0 )
end sub
'====================================================================

'SCROLLBAR, VScrollBar

sub ScrollBar( string caption, word cid, short x,y,cx,cy, optional dword style=0, extStyle=0, rid=0 )
  Control( "", cid, "SCROLLBAR", SBS_HORZ or WS_TABSTOP or style, x,y,cx,cy, extStyle, 0 )
end sub

sub VScrollBar( string caption, word cid, short x,y,cx,cy, optional dword style=0, extStyle=0, rid=0 )
  Control( "", cid, "SCROLLBAR", SBS_VERT or WS_TABSTOP or style, x,y,cx,cy, extStyle, 0 )
end sub
'====================================================================

' To use a Rich Edit control your app must first call LoadLibrary to load the appropriate DLL
' RICHED32.DLL for version 1.
' RICHED20.DLL for version 2 or 3,
' MSFTEDIT.DLL for version 4.1
'====================================================================

' This procedure is coded for version 1.
sub RichEdit1( string caption, word cid, short x,y,cx,cy, optional dword style=0, extStyle=0, rid=0 )
  Control( caption, cid, RICHEDIT_CLASS10A, WS_TABSTOP or WS_VSCROLL or ES_AUTOVSCROLL or ES_SAVESEL or ES_MULTILINE or WS_BORDER or ES_WANTRETURN or style, x,y,cx,cy,
            WS_EX_CLIENTEDGE or WS_EX_ACCEPTFILES or extStyle, rid )
end sub

' This procedure is coded for version 2 or 3.
sub RichEdit( string caption, word cid, short x,y,cx,cy, optional dword style=0, extStyle=0, rid=0 )
  Control( caption, cid, RICHEDIT_CLASS, WS_TABSTOP or WS_VSCROLL or ES_AUTOVSCROLL or ES_SAVESEL or ES_MULTILINE or WS_BORDER or ES_WANTRETURN or style, x,y,cx,cy,
            WS_EX_CLIENTEDGE or WS_EX_ACCEPTFILES or extStyle, rid )
end sub

' This procedure is coded for version 4.1.
sub MsftEdit( string caption, word cid, short x,y,cx,cy, optional dword style=0, extStyle=0, rid=0 )
  Control( caption, cid, MSFTEDIT_CLASS, WS_TABSTOP or WS_VSCROLL or ES_AUTOVSCROLL or ES_SAVESEL or ES_MULTILINE or WS_BORDER or ES_WANTRETURN or style, x,y,cx,cy,
            WS_EX_CLIENTEDGE or WS_EX_ACCEPTFILES or extStyle, rid )
end sub
'====================================================================

sub init_common_controls(optional dword classes=0)

  ' create a structure of INITCOMMONCONTROLSEX
  INITCOMMONCONTROLSEXt iccex

  iccex.dwSize=sizeof(iccex)
  'Register Common Controls
  if classes !=0 then
    'set own value
    iccex.dwICC=classes
  else
    'use default
    iccex.dwICC= 0xffff
/*
    0x0001 or ' ICC_LISTVIEW_CLASSES  - list view and header control classes.
    0x0002 or ' ICC_TREEVIEW_CLASSES  - tree view and tooltip control classes.
    0x0004 or ' ICC_BAR_CLASSES        - toolbar, status bar, trackbar, and tooltip control classes.
    0x0008 or ' ICC_TAB_CLASSES        - tab and tooltip control classes.
    0x0010 or ' ICC_UPDOWN_CLASS      - up-down control class.
    0x0020 or ' ICC_PROGRESS_CLASS    - progress bar control class.
    0x0040 or ' ICC_HOTKEY_CLASS      - hot key control class.
    0x0080 or ' ICC_ANIMATE_CLASS      - animate control class.
    0x00ff or ' ICC_WIN95_CLASSES      - animate control, header, hot key,
                                        ' list view, progress bar, status bar, tab,
                                        ' tooltip, toolbar, trackbar, tree view,
                                        ' and up-down control classes.
    0x0100 or ' ICC_DATE_CLASSES      - date and time picker control class.
    0x0200 or ' ICC_USEREX_CLASSES    - ComboBoxEx class.
    0x0400 or ' ICC_COOL_CLASSES      - rebar control class.
    0x0800 or ' ICC_INTERNET_CLASSES  - IP address class.
    0x1000 or ' ICC_PAGESCROLLER_CLASS - pager control class.
    0x2000 or ' ICC_NATIVEFNTCTL_CLASS - native font control class
    0x4000 or ' ICC_STANDARD_CLASSES  - one of the intrinsic User32 control classes.
                                        ' The user controls include button, edit, static,
                                        ' listbox, combobox, and scroll bar.
    0x8000    ' ICC_LINK_CLASS        - hyperlink control class.
*/
  end if

  InitCommonControlsEx(@iccex)
end sub

'==============================================================================

'Menus, PopupMenus
int g_MnuLv[10]  'Main Menu or PopupMenu and 9 levels of SubMenus
int g_Midx        'Menu index


macro MENU(hMenu)
  hMenu=CreateMenu
  g_Midx=1
  g_MnuLv[1]=hMenu
end macro

'Vertical Main Popup Menu
macro PopupMENU(hMenu)
  hMenu=CreatePopupMenu
  g_Midx=1
  g_MnuLv[1]=hMenu
end macro

sub BEGIN(optional int none=0)
end sub

sub POPUP(string item)
  sys hSubM=CreateMenu
  g_Midx+=1 : g_MnuLv[g_Midx]=hSubM
  AppendMenu( g_MnuLv[g_Midx-1], MF_POPUP, g_MnuLv[g_Midx], item )
end sub

sub MENUITEM(string item, optional sys id=0, uint uflags=MF_STRING)
  if lcase(item) = "separator" then
    AppendMenu(g_MnuLv[g_Midx], MF_SEPARATOR, 0, 0)
  else
    AppendMenu(g_MnuLv[g_Midx], uflags, id, item )
  end if
end sub

sub ENDMenu(optional int=0)
  g_Midx-=1
end sub

'==============================================================================


[Zlatko Vid]

But what if i use Windows ..not Dialogs
all work?

[Pierre Bellisle]

Then you replace dialogs with windows.

[Pierre Bellisle]

Aurel,
Yes it should work, look at SDK Tab control on PowerBASIC site.
It could make life it easier if you want to convert code to SDK.

[Zlatko Vid]

Okay Pierre 

[Roland Stowasser]

Hi Charles,

in Dialogs.inc Pierre replaced sys ValidMemPointer with string sDialogTemplate and if this is results in a safer memory buffer then inc\Dialogs.inc should be replaced? I tested the files in demos\WinDynDialogs and almost  all demos ran ok, two or three apps are faulty, but the reason is not because of dialogs.inc. They need to be examined a little more closely.

[Pierre Bellisle]

Hi Roland,
To explain a little, this sDialogTemplate buffer is used in the Dialog() to create a template for
DialogBoxIndirectParam() for modal or CreateDialogIndirectParam() for modeless dialog.

This buffer must be valid from the time Dialog() is called until
CreateModalDialog()/CreateModelessDialog() finishes.

As it was, the buffer itself was local to the Dialog() sub.
That explain all my GPF when I create multiples dialog.
I know some did not get any, still the old code will bite sooner or later.

So I made the buffer global and, to be clean, I free it on
CreateModalDialog()/CreateModelessDialog() exit.

Never had any problem since...

[Roland Stowasser]

Hi Pierre,

thank you for the info. I know you're much better and more experienced at programming than I am, and I'm glad you've explored further into dialogs.inc. It's still somewhat experimental and could use a few improvements / expansions. But compared to the demos in Freebasic / Masm it performs quite well. In /demos/WinDynDialogs/Pgbar3d.o2bas I was also able to convert an app of Borje Hagsten, although I do not know much about PB, so I think some kind of DDT programming should also be possible.

I would like to ask a question about Kickstart (which I am not currently using, but I will start to check it). KickResource uses Resource.res. Is Resource.res a file that is generally used and what does Resource.rc look like?

[Zlatko Vid]

 Kickstart....is that google Google's online coding competitions 

[Pierre Bellisle]

Hi Roland,
I really like this Dialogs.inc, it make life easy when you want to use dialogs.

Resource.rc is a classic rc file that, in this case, use an external xml manifest, mainly to have Microsoft.Windows.Common-Controls v6.

The program GoRC.exe in your tool folder will convert this .rc file to a .res file that the compiler will use to create the final exe.

In kick, you may specify a .rc, then Kick will call GoRC to generate the .res file.
If you specify a .res then it will be used directly when calling the compiler.

Aurel, see Kick - o2 precompiler

Here is a zip made from the .rc and the manifest.

[Zlatko Vid]

Ha ..that one is yours ..i guess
but why he called it kickstart...ok..