Tabcontrol color

Started by Frank Brübach, January 14, 2024, 01:36:15 PM

Previous topic - Next topic

0 Members and 1 Guest are viewing this topic.

Frank Brübach

Hi all

I have a question to a tabnotify.o2bas example (Demos,/winGui folder)

Its possible to Change the color Background of the whole tab Control for example to blue?

Either this must Work with WM_Ctlcolorbtn or WM_drawitem

Oxygen Code below

' how to colorize background to a tabcontrol (sdk)
' oxygen basic, 14-01-2024 by frank bruebach
'
$ filename "t.exe"
'uses rtl64

uses WinUtil
'uses console
indexbase 0


% EDGE_RAISED=5
% EDGE_SUNKEN=10
% BF_RECT=15
% WM_DRAWITEM=43
% ETO_OPAQUE=2
% ETO_CLIPPED=4
% ODS_SELECTED=1
% GWL_HINSTANCE -6

type SIZE
  long cx
  long cy
end type

type DRAWITEMSTRUCT
    UINT CtlType
    UINT CtlID
    UINT itemID
    UINT itemAction
    UINT itemState
    sys  hwndItem
    sys  hDC
    RECT rcItem
    sys  itemData        'ulong_ptr
end type


% IDB_BUTTON  100
sys hWndStdButton

% IDC_OWNERDRAWN  1000
sys hWndClrButton


% WC_TABCONTROL="SysTabControl32"
% WC_STATIC="Static"
% ICC_TAB_CLASSES = 8
% TCIF_TEXT=1
% TCIF_IMAGE=2
% TCM_INSERTITEM=4871
% TCM_GETCURSEL=4875
% TCN_SELCHANGE= -551
% TCN_SELCHANGING= -552
% SWP_SHOWWINDOW=64
% HWND_TOP=0

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

 
macro RGB(r,g,b) {r+(g<<8)+(b<<16)}
typedef dword COLORREF ' R G B bytes

function RGB(sys red,green,blue) as sys
  sys color
  color = red
  color = color + green*256
  color = color + blue*65536
  return color
end function

% DAYS_IN_WEEK 7
string day[]={"Sun","Mon","Tue","Wed","Thu","Fri","Sat"}

' Initialize common controls.
INITCOMMONCONTROLSEXt icex
    icex.dwSize = sizeof(INITCOMMONCONTROLSEX)
    icex.dwICC = ICC_TAB_CLASSES
    InitCommonControlsEx(&icex)

sys hInstance=inst
MainWindow 480,360,WS_OVERLAPPEDWINDOW


function WndProc(sys hwnd, uMsg, wParam, lParam) as sys callback
    static sys hwndTab, hwndStatic
    drawitemstruct disptr 
    DRAWITEMSTRUCT ptDrawItem

    select uMsg
   
    case WM_CREATE
        ' Get the dimensions of the parent window's client area, and
        ' create a tab control child window of that size.
        RECT rcClient
        TCITEM tie
   
        GetClientRect(hwnd, &rcClient)
        hwndTab = CreateWindowEx(0,WC_TABCONTROL, "",
             WS_CHILD | WS_CLIPSIBLINGS | WS_VISIBLE,
             0, 0, rcClient.right, rcClient.bottom,
             hwnd, null, hInstance, null)
        if (hwndTab = null) then
           mbox "Create Tab Control failed"
           return null
        end if
        ' Add tabs for each day of the week.
        tie.mask = TCIF_TEXT | TCIF_IMAGE
        tie.iImage = -1
 
        int i
        for i = 0 to <DAYS_IN_WEEK
           ' Load the day string
           tie.pszText=day[i]
           if SendMessage(hwndTab,TCM_INSERTITEM,i, @tie) = -1 then
             mbox "InsertItem Tab failed"
             DestroyWindow(hwndTab)
             return null
           end if
        next i

        ' Creates a child window (a static control) to occupy the tab control's display area.
        ' hwndTab - handle of the tab control.
        hwndStatic = CreateWindowEx(0,WC_STATIC, "",
                          WS_CHILD | WS_VISIBLE | WS_BORDER,
                          100, 100, 100, 100,        ' Position and dimensions; example only.
                          hwndTab, null, hInstance,    ' g_hInst is the global instance handle
                          null)
        SendMessage(hwndStatic, WM_SETTEXT, 0, strptr day[0]) 'Sunday
       
        case WM_SIZE
            ' Handles the WM_SIZE message for the main window by resizing the tab control.
            ' hwndTab - handle of the tab control.
            ' lParam - the lParam parameter of the WM_SIZE message.
'           RECT rc
            ' Resize the tab control to fit the client are of main window.
'           SetWindowPos(hwndTab, HWND_TOP, 0, 0, GET_X_LPARAM(lParam), GET_Y_LPARAM(lParam), SWP_SHOWWINDOW)
            int x=loword(lParam) : int y=hiword(lParam)
            SetWindowPos(hwndTab, HWND_TOP, 0,0, x,y, SWP_SHOWWINDOW)

        case WM_NOTIFY
            ' Handles notifications from the tab control, as follows:
            ' TCN_SELCHANGING - always returns FALSE to allow the user to select a different tab.
            ' TCN_SELCHANGE - loads a string resource and displays it in a
            '      static control on the selected tab.
            ' hwndTab - handle of the tab control.
            ' lParam - the lParam parameter of the WM_NOTIFY message.
            NMHDR pnmhdr at lParam
            select pnmhdr.code

            case TCN_SELCHANGING
                    ' Return FALSE to allow the selection to change.
                    return FALSE

            case TCN_SELCHANGE               
''                  int iPage = TabCtrl_GetCurSel(hwndTab)
                    int iPage = SendMessage(hwndTab, TCM_GETCURSEL, 0,0)                   
                    SendMessage(hwndStatic, WM_SETTEXT, 0, strptr day[iPage])
 
            end select
            return TRUE

  static int bcolor=RGB(128, 0, 0)  '0xaabbee
  static sys hbrush
  '------------------- //
  case WM_CTLCOLORBTN
  '------------------- //

    sys hdc=wparam
    sys hwn=lparam
    RECT rec
    if hwn=hwndStatic 'hwndTab
      GetClientRect  hwn,@rcClient
      sys hbr=CreateSolidBrush bcolor
      FillRect hdc,@rcClient,hbr
   
      SetBkColor   hdc,bcolor
      SetTextColor hdc,0x90
      DrawText hDC,"Press",-1,@rcClient,0x25
      DeleteObject hbr
      return hbr
    endif

   '----------------
   case WM_DRAWITEM
   '----------------
            select case wParam
                case if not hwndStatic then 'hwndTab
               
                    'get the pointer to the item-drawing info
                    DRAWITEMSTRUCT *ptDrawItem
                    'error ------------ //
                    'ptDrawItem=lParam
                    'error ------------ //

           hbrush=createsolidbrush(bcolor)
           SetBkColor wParam, RGB(128, 0, 0)  ' set text background color
           SetTextColor wParam, %YELLOW       ' set text color

          end select
       
        case WM_CLOSE
            DestroyWindow(hwnd)
       
        case WM_DESTROY
            PostQuitMessage(0)
       
        case else
            return DefWindowProc(hwnd, uMsg, wParam, lParam)
           
    end select
   
    return 0
end function


Help is Welcome thanks

Regards Frank


Charles Pegge

#1
Hi Frank, I think this example will help. I've also included references below.

  $filename  "t.exe"
  'uses RTL64
  uses WinUtil

  sys hchw[2] 'child windows


  function WndProc(sys hWnd, wMsg, wParam,lparam) as sys callback
  ===============================================================
 
  indexbase 0 
  static sys hdc
  static RECT r

  '==========
  select wMsg
  ===========
       
    case WM_CREATE
    '=============

      SetWindowText hwnd,"Right-Click"

      int style
      string stys
      style=WS_CHILD | WS_THICKFRAME | WS_VISIBLE
      stys="static"
      hchw[0]=CreateWindowEx(0,stys, null, style, 0,0,0,0, hwnd, 100, hinst, null)
      stys="button"
      'style=WS_CHILD | BS_TEXT | BS_PUSHBOX | WS_VISIBLE
      style=WS_CHILD | BS_OWNERDRAW | BS_NOTIFY | WS_VISIBLE
      hchw[1]=CreateWindowEx(0,stys, null, style, 0,0,0,0, hwnd, 101, hinst, null)
      stys="edit"
      style=WS_CHILD | WS_VISIBLE '| ES_READONLY
      hchw[2]=CreateWindowEx(0,stys, null, style, 0,0,0,0, hwnd, 102, hinst, null)
      SetWindowText hchw[1],"ok"
      SetWindowText hchw[2],"Message Here"
      static sys hsbr=CreateSolidBrush 0xf0ffff
      SendMessage hwnd,WM_SIZE,0,0
      ShowWindow hchw[0],0
      ShowWindow hchw[1],0
      ShowWindow hchw[2],0


    case WM_DESTROY
    ================
         
    PostQuitMessage 0
     
    case WM_MOUSEMOVE
    =================

    static short mx,my
    mx=loword lparam
    my=hiword lparam

    case WM_RBUTTONDOWN
    ===================

    static int ms
    if not ms
      ms=1
      ShowWindow hchw[0],1
      ShowWindow hchw[1],1
      ShowWindow hchw[2],1
    endif

    case WM_CTLCOLORSTATIC
    ======================

    sys hdc=wparam
    sys hwn=lparam
    if hwn=hchw[0]
      return hsbr
    endif

    case WM_CTLCOLOREDIT
    ====================

    sys hdc=wparam
    sys hwn=lparam
    int fcolor=0x880000
    int bcolor=0xf0ffff
    RECT rec
    if hwn=hchw[2]
      GetClientRect  hwn,@rec
      'sys hbr=CreateSolidBrush bcolor
      'FillRect hdc,@rec,hbr
      'DeleteObject hbr
      '
      SetBkColor   hdc,bcolor
      'SetTextColor hdc,fcolor
      'DrawText hDC,"text text",-1,@rec,0x25
      return hsbr
    endif

    case WM_CTLCOLORBTN
    ===================

    sys hdc=wparam
    sys hwn=lparam
    int bcolor=0x0020e0
    int fcolor=0xeeeeee
    RECT rec
    if hwn=hchw[1]
      GetClientRect  hwn,@rec
      sys hbr=CreateSolidBrush bcolor
      FillRect hdc,@rec,hbr
   
      SetBkColor   hdc,bcolor
      SetTextColor hdc,fcolor
      DrawText hDC,"OK",-1,@rec,0x25
      DeleteObject hbr
      return 0
    endif


    case WM_COMMAND
    ===============

    if wparam=101 'popup ok button
      ShowWindow hchw[0],0
      ShowWindow hchw[1],0
      ShowWindow hchw[2],0
      ms=0
    endif


    case WM_KEYDOWN
    ===============

    if wParam=27 then SendMessage hwnd, WM_CLOSE, 0, 0      'ESCAPE


    case WM_SIZE
    ============

    RECT rc
    GetClientRect(hwnd, rc)
    int px=rc.right \2 - 100
    int py=rc.bottom \2 -35
    'child window, position x,y  size x.y, show
    MoveWindow(hchw[0], px,py, 200, 70, TRUE)
    MoveWindow(hchw[1], px+165,py+35, 30, 30 TRUE)
    MoveWindow(hchw[2], px+5,py+5, 190, 30 TRUE)

    case WM_DESTROY

      DeleteObject hsbr
      PostQuitMessage 0


    case else
    =========
         
    function=DefWindowProc hWnd,wMsg,wParam,lParam
   
    end select
    '
  end function ' WndProc


  MainWindow 320,220,WS_OVERLAPPEDWINDOW

https://learn.microsoft.com/en-us/windows/win32/api/winuser/ns-winuser-drawitemstruct

https://learn.microsoft.com/en-us/windows/win32/controls/wm-drawitem
'
'BUTTON DEMOS USING WM_DRAWITEM
.\demos\WinDynDialogs\Ownerdrawn.o2bas
.\demos\WinGUI\ButtonColored.o2bas
.\demos\WinGUI\DragAndDropTool.o2bas
.\demos\WinGUI\UniversalButton.o2bas
.\inc\Dialogs.inc
'
'BUTTON DEMOS USING WM_CTLCOLORBTN
.\demos\WinGUI\ButtonOwnerDraw.o2bas
INCLUDING EDITBOX BACKGROUND
.\demos\WinGUI\MessageWindow.o2bas


Frank Brübach

Thank you Charles two examples in WinGui Folder I didnt know yet

1) One solution I have found already for colorizing the right click window

2) another way I have to Go with drawitem cause If I am including a tab Control the First way doesn't Work

See you nice evening

Charles Pegge

You can also colorize the main window background

At the end of WM_CREATE:
      SendMessage hwnd,WM_ERASEBKGND,0,0
then
    case WM_ERASEBKGND
    ==================
    int bcolor=0x000080
    RECT r
    GetClientRect  hwnd,@r
    sys hbr=CreateSolidBrush bcolor
    'wparam is hdc
    FillRect wparam,@r,hbr
    DeleteObject hbr   
    return 1

Zlatko Vid

Is there a way to use this :

 SendMessage hwnd,WM_ERASEBKGND,0,0

from any part of code ?

Frank Brübach

#5
Now thats my Second attempt with the tab Control Here with color and right click example but the tab Pages dont visualized correct

And I am using wm_paint too for hwndtab  control.. wm_erasebkgnd paint the Main window Here

Something is Missing or the Setup is wrong ;)


'
' test oxygen tab control and colorizing winmain and right click
' tabcontrol isn't correct visualized here, 14-15/01/2024, frank bruebach
'
$filename  "t.exe"
  'uses RTL64
  uses WinUtil

  sys hchw[2] 'child windows
'---------------------------------------------------------------

% WC_TABCONTROL="SysTabControl32"
% WC_STATIC="Static"
% ICC_TAB_CLASSES = 8
% TCIF_TEXT=1
% TCIF_IMAGE=2
% TCM_INSERTITEM=4871
% TCM_GETCURSEL=4875
% TCN_SELCHANGE= -551
% TCN_SELCHANGING= -552
% SWP_SHOWWINDOW=64
% HWND_TOP=0

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


% DAYS_IN_WEEK 7
string day[]={"Sun","Mon","Tue","Wed","Thu","Fri","Sat"}

' Initialize common controls.
INITCOMMONCONTROLSEXt icex
    icex.dwSize = sizeof(INITCOMMONCONTROLSEX)
    icex.dwICC = ICC_TAB_CLASSES
    InitCommonControlsEx(&icex)

sys hInstance=inst

 
macro RGB(r,g,b) {r+(g<<8)+(b<<16)}
typedef dword COLORREF ' R G B bytes

function RGB(sys red,green,blue) as sys
  sys color
  color = red
  color = color + green*256
  color = color + blue*65536
  return color
end function


  function WndProc(sys hWnd, wMsg, wParam,lparam) as sys callback
  ===============================================================
 
  indexbase 0
  static sys hwndTab, hwndStatic
  static sys hdc
  static RECT r

  '==========
  select wMsg
  ===========
       
    case WM_CREATE
    '=============

      SetWindowText hwnd,"Right-Click"

'--------------------------------------1) tabcontrol ------------- //
        RECT rcClient
        TCITEM tie
   
        GetClientRect(hwnd, &rcClient)
        hwndTab = CreateWindowEx(0,WC_TABCONTROL, "",
             WS_CHILD | WS_CLIPSIBLINGS | WS_VISIBLE,
             10,30,300,300, ''rcClient.right, rcClient.bottom,
             hwnd, null, hInstance, null)
        if (hwndTab = null) then
           mbox "Create Tab Control failed"
           return null
        end if
        ' Add tabs for each day of the week.
        tie.mask = TCIF_TEXT | TCIF_IMAGE
        tie.iImage = -1
 
        int i
        for i = 0 to <DAYS_IN_WEEK
           ' Load the day string
           tie.pszText=day[i]
           if SendMessage(hwndTab,TCM_INSERTITEM,i, @tie) = -1 then
             mbox "InsertItem Tab failed"
             DestroyWindow(hwndTab)
             return null
           end if
        next i

      '----------------------------------------------- //
      '------------------ 2) hwndtab in hchw[i] ------ //
      int style
      string stys
      style=WS_CHILD | WS_THICKFRAME | WS_VISIBLE
      stys="static" 'WS_EX_CLIENTEDGE
     
      hchw[0]=CreateWindowEx(0,stys, null, style, 0,0,0,0, hwndtab, 100, hinst, null)
     
      stys="button"
      'style=WS_CHILD | BS_TEXT | BS_PUSHBOX | WS_VISIBLE
      style=WS_CHILD | BS_OWNERDRAW | BS_NOTIFY | WS_VISIBLE
     
      hchw[1]=CreateWindowEx(0,stys, null, style, 0,0,0,0, hwndtab, 101, hinst, null)
     
      stys="edit"
      style=WS_CHILD | WS_VISIBLE '| ES_READONLY
     
      hchw[2]=CreateWindowEx(WS_EX_CLIENTEDGE,stys, null, style, 0,0,0,0, hwndtab, 102, hinst, null)
      SetWindowText hchw[1],"ok"
      SetWindowText hchw[2],"take a Message Here"
     
      static sys hsbr=CreateSolidBrush RGB(128, 128, 0) '0xf0ffff
      SendMessage hwnd,WM_SIZE,0,0
      ShowWindow hchw[0],0
      ShowWindow hchw[1],0
      ShowWindow hchw[2],0

      SendMessage hwnd,WM_ERASEBKGND,0,0

    case WM_DESTROY
    ================
         
    PostQuitMessage 0
     
    case WM_MOUSEMOVE
    =================

    static short mx,my
    mx=loword lparam
    my=hiword lparam

    case WM_RBUTTONDOWN
    ===================

    static int ms
    if not ms
      ms=1
      ShowWindow hchw[0],1
      ShowWindow hchw[1],1
      ShowWindow hchw[2],1
    endif

    case WM_CTLCOLORSTATIC
    ======================

    sys hdc=wparam
    sys hwn=lparam
    if hwn=hchw[0]
      return hsbr
    endif

    case WM_CTLCOLOREDIT
    ====================

    sys hdc=wparam
    sys hwn=lparam
    int fcolor=0x880000
    int bcolor= rgb(125,125,255) '0xf0ffff
    RECT rec
    if hwn=hchw[2]
      GetClientRect  hwn,@rec
      'sys hbr=CreateSolidBrush bcolor
      'FillRect hdc,@rec,hbr
      'DeleteObject hbr
      '
      SetBkColor   hdc,bcolor
      'SetTextColor hdc,fcolor
      'DrawText hDC,"text text",-1,@rec,0x25
      return hsbr
    endif

    case WM_CTLCOLORBTN
    ===================

    sys hdc=wparam
    sys hwn=lparam
    int bcolor=0x0020e0
    int fcolor= rgb(125,125,0)  '0xeeeeee
    RECT rec
    if hwn=hchw[1]
      GetClientRect  hwn,@rec
      sys hbr=CreateSolidBrush bcolor
      FillRect hdc,@rec,hbr
   
      SetBkColor   hdc,bcolor
      SetTextColor hdc,fcolor
      DrawText hDC,"OK",-1,@rec,0x25
      DeleteObject hbr
      return 0
    endif   

   '------------
    case WM_PAINT
    =============

    static as sys hdc
    static as String txt
    static as PaintStruct Paintst
    dim as rect crect 'for WndProc and TimerProc
    GetClientRect  hWndTab,cRect 'hWndTab
    hDC=BeginPaint hWndTab,Paintst
    sys hbr=CreateSolidBrush rgb(125,255,100) 'bcolor greeny
    FillRect hdc,@cRect,hbr

     SetBkColor hdc,yellow
     SetTextColor hdc,red
     DrawText hDC,"testFile for coloring text and background",-1,cRect,0x25
     EndPaint hWndTab,Paintst
     
    case WM_ERASEBKGND
    ==================
    int bcolor= rgb(255,0,0) '0x000080
    RECT r
    GetClientRect  hwnd,@r
    sys hbr=CreateSolidBrush bcolor
    'wparam is hdc
    FillRect wparam,@r,hbr
    DeleteObject hbr   
    return 1

    case WM_COMMAND
    ===============
    if wparam=101 'popup ok button
      ShowWindow hchw[0],0
      ShowWindow hchw[1],0
      ShowWindow hchw[2],0
      ms=0
    endif

    case WM_KEYDOWN
    ===============
    if wParam=27 then SendMessage hwnd, WM_CLOSE, 0, 0      'ESCAPE

    case WM_SIZE
    ============

    RECT rc
    GetClientRect(hwnd, rc)
    int px=rc.right \2 - 100
    int py=rc.bottom \2 -35
    'child window, position x,y  size x.y, show
    MoveWindow(hchw[0], px,py, 300, 170, TRUE) '200, 70 right click window size
    'MoveWindow(hchw[1], px+165,py+35, 30, 30 TRUE)
    MoveWindow(hchw[1], px+165,py+55, 40, 40 TRUE) 'ok button
    MoveWindow(hchw[2], px+15,py+15, 190, 30 TRUE)

    case WM_DESTROY
      DeleteObject hsbr
      PostQuitMessage 0

    case else
    =========
         
    function=DefWindowProc hWnd,wMsg,wParam,lParam
   
    end select
    '
  end function ' WndProc


  MainWindow 520,420,WS_OVERLAPPEDWINDOW


'You can also colorize the main window background
'At the end of WM_CREATE:
'CodeSelect
 
     'SendMessage hwnd,WM_ERASEBKGND,0,0
'then
'CodeSelect
   

Thx Zlatko but I am Not Sure Here about correct Handling yet  Charles gave this advice in His Last Post too I have included all Yesterday

Regards Frank

Charles Pegge

Hi Aurel,

this call is needed only once to create the initial background on WM_CREATE. Then windows can have full control of WM_ERASEBACKGROUND thereafter

SendMessage hwnd,WM_ERASEBKGND,0,0

Frank Brübach

Good morning all...

the Problem still remains with colorizing the tabcontrol with right click example...

If I am using for the childwindows hwnd I have Got the Grey tab Control with weekly days all OK so far...

If I am using for childwindows with hwndtab in IT and use below wm_paint in wndproc I can colorize the tab Control with createsilidbrush rgb(125,255,100) a greeny color the tab Pages dont appear

Oxygen running uncolorized tab Control example


  '--- test tabcontrol + rightclick test 2 oxygen
  '--- 14-16-012024, by frank bruebach
  '
  $filename  "t.exe"
  'uses RTL64
  uses WinUtil

' three childwindows
  sys hchw[3] 'child windows

% COLOR_WINDOW    5

% WC_TABCONTROL="SysTabControl32"
% WC_STATIC="Static"
% ICC_TAB_CLASSES = 8
% TCIF_TEXT=1
% TCIF_IMAGE=2
% TCM_INSERTITEM=4871
% TCM_GETCURSEL=4875
% TCN_SELCHANGE= -551
% TCN_SELCHANGING= -552
% SWP_SHOWWINDOW=64
% HWND_TOP=0

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

% EDGE_RAISED=5
% EDGE_SUNKEN=10
% BF_RECT=15
% WM_DRAWITEM=43
% ETO_OPAQUE=2
% ETO_CLIPPED=4
% ODS_SELECTED=1
% GWL_HINSTANCE -6

type SIZE
  long cx
  long cy
end type

type DRAWITEMSTRUCT
    UINT CtlType
    UINT CtlID
    UINT itemID
    UINT itemAction
    UINT itemState
    sys  hwndItem
    sys  hDC
    RECT rcItem
    sys  itemData        'ulong_ptr
end type

macro RGB(r,g,b) {r+(g<<8)+(b<<16)}
typedef dword COLORREF ' R G B bytes

function RGB(sys red,green,blue) as sys
  sys color
  color = red
  color = color + green*256
  color = color + blue*65536
  return color
end function

% DAYS_IN_WEEK 7
string day[]={"Sun","Mon","Tue","Wed","Thu","Fri","Sat"}
string stest="Hello Editor"

' Initialize common controls.
INITCOMMONCONTROLSEXt icex
    icex.dwSize = sizeof(INITCOMMONCONTROLSEX)
    icex.dwICC = ICC_TAB_CLASSES
    InitCommonControlsEx(icex)

sys hInstance=inst

'typedef struct _TRIVERTEX {
'long x
'long y
'COLOR16 RED
'COLOR16 GREEN
'COLOR16 BLUE
'COLOR16 Alpha
'} TRIVERTEX, *PTRIVERTEX, *LPTRIVERTEX

% GRADIENT_FILL_RECT_H  = &H00000000???
% GRADIENT_FILL_RECT_V  = &H00000001234
% GRADIENT_FILL_TRIANGLE = &H00000002???
% GRADIENT_FILL_OP_FLAG  = &H000000ff???

declare function GradientFill lib "MSIMG32.DLL" lib "GradientFill" ( _
  byval hdc as dword _                                ' __in HDC hdc
 , byref pVertex as float _ 'TRIVERTEX _                ' __in PTRIVERTEX pVertex
 , byval nVertex as dword _                            ' __in ULONG nVertex
 , byref pMesh as sys _                                ' __in PVOID pMesh
 , byval nMesh as dword _                              ' __in ULONG nMesh
 , byval ulMode as dword _                              ' __in ULONG ulMode
 ) as long                                              ' BOOL


  function WndProc(sys hWnd, wMsg, wParam,lparam) as sys callback
  ===============================================================
 
  indexbase 0
  static sys hdc
  static RECT r
  static RECT rcClient
  static sys hwndTab, hwndStatic

  '==========
  select wMsg
  ===========
     
    case WM_CREATE
    '=============
        SetWindowText hwnd,"Right-Click + gradient win + tab"

'------ 1) tabcontrol go
        ' Get the dimensions of the parent window's client area, and
        ' create a tab control child window of that size.
        RECT rcClient
        TCITEM tie
 
        GetClientRect(hwnd, rcClient)
        hwndTab = CreateWindowEx(WS_EX_CLIENTEDGE,WC_TABCONTROL, "",
            WS_CHILD | WS_CLIPSIBLINGS | WS_VISIBLE,
            10, 50, 350, 250, 'rcClient.right, rcClient.bottom
            hwnd, null, hInstance, null)
        if (hwndTab = null) then
          mbox "Create Tab Control failed"
          return null
        end if
        ' Add tabs for each day of the week.
        tie.mask = TCIF_TEXT | TCIF_IMAGE
        tie.iImage = -1
 
        int i
        for i = 0 to <DAYS_IN_WEEK
          ' Load the day string
          tie.pszText=day[i]
          if SendMessage(hwndTab,TCM_INSERTITEM,i, @tie) = -1 then
            mbox "InsertItem Tab failed"
            DestroyWindow(hwndTab)
            return null
          end if
        next i

'------ 2) right click child windows go, but not if hwnd = hwndtab ! :-)
      '
      int style
      string stys
      style=WS_CHILD | WS_THICKFRAME | WS_VISIBLE
      stys="static" 'WS_EX_CLIENTEDGE
     
      hchw[0]=CreateWindowEx(0,stys, null, style, 0,0,0,0, hwnd, 100, hinst, null)
     
      stys="button"
      'style=WS_CHILD | BS_TEXT | BS_PUSHBOX | WS_VISIBLE
      style=WS_CHILD | BS_OWNERDRAW | BS_NOTIFY | WS_VISIBLE
     
      hchw[1]=CreateWindowEx(0,stys, null, style, 0,0,0,0, hwnd, 101, hinst, null)
     
      stys="edit"
      style=WS_CHILD | WS_VISIBLE '| ES_READONLY
     
      hchw[2]=CreateWindowEx(WS_EX_CLIENTEDGE,stys, null, style, 0,0,0,0, hwnd, 102, hinst, null)
      SetWindowText hchw[1],"ok"
      SetWindowText hchw[2],"take a Message Here"
     
      static sys hsbr=CreateSolidBrush RGB(128, 128, 0) '0xf0ffff
      SendMessage hwnd,WM_SIZE,0,0
      ShowWindow hchw[0],0
      ShowWindow hchw[1],0
      ShowWindow hchw[2],0

    SendMessage hwnd,WM_ERASEBKGND,0,0

    case WM_DESTROY
    ================
       
    PostQuitMessage 0
   
    case WM_MOUSEMOVE
    =================

    static short mx,my
    mx=loword lparam
    my=hiword lparam

    case WM_RBUTTONDOWN
    ===================

    static int ms
    if not ms
      ms=1
      ShowWindow hchw[0],1
      ShowWindow hchw[1],1
      ShowWindow hchw[2],1
    endif

    case WM_CTLCOLORSTATIC
    ======================

    sys hdc=wparam
    sys hwn=lparam
    if hwn=hchw[0]
      return hsbr
    endif

    case WM_CTLCOLOREDIT
    ====================

    sys hdc=wparam
    sys hwn=lparam
    int fcolor=0x880000
    int bcolor= rgb(125,125,255) '0xf0ffff
    RECT rec
    if hwn=hchw[2]
      GetClientRect  hwn,@rec
      'sys hbr=CreateSolidBrush bcolor
      'FillRect hdc,@rec,hbr
      'DeleteObject hbr
      '
      SetBkColor  hdc,bcolor
      'SetTextColor hdc,fcolor
      'DrawText hDC,"text text",-1,@rec,0x25
      return hsbr
    endif

    case WM_CTLCOLORBTN
    ===================

    sys hdc=wparam
    sys hwn=lparam
    int bcolor=0x0020e0
    int fcolor= rgb(125,125,0)  '0xeeeeee
    RECT rec
    if hwn=hchw[1]
      GetClientRect  hwn,@rec
      sys hbr=CreateSolidBrush bcolor
      FillRect hdc,@rec,hbr
 
      SetBkColor  hdc,bcolor
      SetTextColor hdc,fcolor
      DrawText hDC,"OK",-1,@rec,0x25
      DeleteObject hbr
      return 0
    endif

  '------------
    case WM_PAINT
    =============

    static as sys hdc
    static as String txt
    static as PaintStruct Paintst
    dim as rect crect 'for WndProc and TimerProc
    GetClientRect  hWnd,cRect
    hDC=BeginPaint hWnd,Paintst   
    SetBkColor  hdc,yellow
    SetTextColor hdc,red
    DrawText hDC,"testFile for coloring text and background",-1,cRect,0x25
    EndPaint hWnd,Paintst
   
    case WM_ERASEBKGND
    ==================
    int bcolor=0x000080
    RECT r
    GetClientRect  hwnd,@r
    sys hbr=CreateSolidBrush bcolor
    FillRect wparam,@r,hbr
    DeleteObject hbr 
    return 1

    case WM_COMMAND
    ===============

    if wparam=101 'popup ok button
      ShowWindow hchw[0],0
      ShowWindow hchw[1],0
      ShowWindow hchw[2],0
      ms=0
    endif


    case WM_KEYDOWN
    ===============

    if wParam=27 then SendMessage hwnd, WM_CLOSE, 0, 0      'ESCAPE


    case WM_SIZE
    ============
    RECT rc
    GetClientRect(hwnd, rc)
    int px=rc.right \2 - 100
    int py=rc.bottom \2 -35
    'child window, position x,y  size x.y, show
    MoveWindow(hchw[0], px,py, 300, 300, TRUE) '200, 70 right click window size
    'MoveWindow(hchw[1], px+165,py+35, 30, 30 TRUE) 'ok button
    MoveWindow(hchw[1], px+165,py+95, 40, 40 TRUE)
    MoveWindow(hchw[2], px+15,py+15, 190, 30 TRUE) 'Editbox

    case WM_DESTROY
      DeleteObject hsbr
      PostQuitMessage 0

    case else
    =========
       
    function=DefWindowProc hWnd,wMsg,wParam,lParam 
    end select
    '
  end function ' WndProc

  MainWindow 520,420,WS_OVERLAPPEDWINDOW


Frank Brübach

#8
Here is my Second example with greeny tab Control but tab Pages arent correct and arent displayed Here.. right click Works too for child Windows
Help is Welcome thanks in advance

One little Thing is Not correct


  ' tabcontrol oxygen with hwndtab in childwindows
  ' test 2, 14-16/01/2024
  '
  $filename  "t.exe"
  'uses RTL64
  uses WinUtil

' three childwindows
  sys hchw[3] 'child windows


% COLOR_WINDOW    5

% WC_TABCONTROL="SysTabControl32"
% WC_STATIC="Static"
% ICC_TAB_CLASSES = 8
% TCIF_TEXT=1
% TCIF_IMAGE=2
% TCM_INSERTITEM=4871
% TCM_GETCURSEL=4875
% TCN_SELCHANGE= -551
% TCN_SELCHANGING= -552
% SWP_SHOWWINDOW=64
% HWND_TOP=0

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

% EDGE_RAISED=5
% EDGE_SUNKEN=10
% BF_RECT=15
% WM_DRAWITEM=43
% ETO_OPAQUE=2
% ETO_CLIPPED=4
% ODS_SELECTED=1
% GWL_HINSTANCE -6

type SIZE
  long cx
  long cy
end type

type DRAWITEMSTRUCT
    UINT CtlType
    UINT CtlID
    UINT itemID
    UINT itemAction
    UINT itemState
    sys  hwndItem
    sys  hDC
    RECT rcItem
    sys  itemData        'ulong_ptr
end type

macro RGB(r,g,b) {r+(g<<8)+(b<<16)}
typedef dword COLORREF ' R G B bytes

function RGB(sys red,green,blue) as sys
  sys color
  color = red
  color = color + green*256
  color = color + blue*65536
  return color
end function

% DAYS_IN_WEEK 7
string day[]={"Sun","Mon","Tue","Wed","Thu","Fri","Sat"}
string stest="Hello Editor"

' Initialize common controls.
INITCOMMONCONTROLSEXt icex
    icex.dwSize = sizeof(INITCOMMONCONTROLSEX)
    icex.dwICC = ICC_TAB_CLASSES
    InitCommonControlsEx(icex)

sys hInstance=inst

'typedef struct _TRIVERTEX {
'long x
'long y
'COLOR16 RED
'COLOR16 GREEN
'COLOR16 BLUE
'COLOR16 Alpha
'} TRIVERTEX, *PTRIVERTEX, *LPTRIVERTEX

% GRADIENT_FILL_RECT_H   = &H00000000???
% GRADIENT_FILL_RECT_V   = &H00000001234
% GRADIENT_FILL_TRIANGLE = &H00000002???
% GRADIENT_FILL_OP_FLAG  = &H000000ff???

declare function GradientFill lib "MSIMG32.DLL" lib "GradientFill" ( _
   byval hdc as dword _                                 ' __in HDC hdc
 , byref pVertex as float _ 'TRIVERTEX _                ' __in PTRIVERTEX pVertex
 , byval nVertex as dword _                             ' __in ULONG nVertex
 , byref pMesh as sys _                                 ' __in PVOID pMesh
 , byval nMesh as dword _                               ' __in ULONG nMesh
 , byval ulMode as dword _                              ' __in ULONG ulMode
 ) as long                                              ' BOOL


  function WndProc(sys hWnd, wMsg, wParam,lparam) as sys callback
  ===============================================================
 
  indexbase 0
  static sys hdc
  static RECT r
  static RECT rcClient
  static sys hwndTab, hwndStatic

  '==========
  select wMsg
  ===========
       
    case WM_CREATE
    '=============
        SetWindowText hwnd,"Right-Click + gradient win + tab"

'------ 1) tabcontrol
        ' Get the dimensions of the parent window's client area, and
        ' create a tab control child window of that size.
        RECT rcClient
        TCITEM tie
   
        GetClientRect(hwnd, rcClient)
        hwndTab = CreateWindowEx(WS_EX_CLIENTEDGE,WC_TABCONTROL, "",
             WS_CHILD | WS_CLIPSIBLINGS | WS_VISIBLE,
             10, 50, 350, 250, 'rcClient.right, rcClient.bottom
             hwnd, null, hInstance, null)
        if (hwndTab = null) then
           mbox "Create Tab Control failed"
           return null
        end if
        ' Add tabs for each day of the week.
        tie.mask = TCIF_TEXT | TCIF_IMAGE
        tie.iImage = -1
 
        int i
        for i = 0 to <DAYS_IN_WEEK
           ' Load the day string
           tie.pszText=day[i]
           if SendMessage(hwndTab,TCM_INSERTITEM,i, @tie) = -1 then
             mbox "InsertItem Tab failed"
             DestroyWindow(hwndTab)
             return null
           end if
        next i
       SendMessage hwndTab,WM_ERASEBKGND,0,0


'------ 2) child windows hwndtab in it :-)

      int style
      string stys
      style=WS_CHILD | WS_THICKFRAME | WS_VISIBLE
      stys="static" 'WS_EX_CLIENTEDGE
     
      hchw[0]=CreateWindowEx(0,stys, null, style, 0,0,0,0, hwndtab, 100, hinst, null)
     
      stys="button"
      'style=WS_CHILD | BS_TEXT | BS_PUSHBOX | WS_VISIBLE
      style=WS_CHILD | BS_OWNERDRAW | BS_NOTIFY | WS_VISIBLE
     
      hchw[1]=CreateWindowEx(0,stys, null, style, 0,0,0,0, hwndtab, 101, hinst, null)
     
      stys="edit"
      style=WS_CHILD | WS_VISIBLE '| ES_READONLY
     
      hchw[2]=CreateWindowEx(WS_EX_CLIENTEDGE,stys, null, style, 0,0,0,0, hwndtab, 102, hinst, null)
      SetWindowText hchw[1],"ok"
      SetWindowText hchw[2],"take a Message Here"
     
      static sys hsbr=CreateSolidBrush RGB(128, 128, 0) '0xf0ffff
      SendMessage hwnd,WM_SIZE,0,0
      ShowWindow hchw[0],0
      ShowWindow hchw[1],0
      ShowWindow hchw[2],0

    SendMessage hwnd,WM_ERASEBKGND,0,0

    case WM_DESTROY
    ================
         
    PostQuitMessage 0
     
    case WM_MOUSEMOVE
    =================

    static short mx,my
    mx=loword lparam
    my=hiword lparam

    case WM_RBUTTONDOWN
    ===================

    static int ms
    if not ms
      ms=1
      ShowWindow hchw[0],1
      ShowWindow hchw[1],1
      ShowWindow hchw[2],1
    endif

   '-------------
    case WM_PAINT
    =============

    static as sys hdc
    static as String txt
    static as PaintStruct Paintst
    dim as rect crect 'for WndProc and TimerProc
    GetClientRect  hWndTab,cRect
    hDC=BeginPaint hWndTab,Paintst
    sys hbr=CreateSolidBrush rgb(125,255,100) 'bcolor
    FillRect hdc,@cRect,hbr


     'SetBkColor hdc,yellow
     SetTextColor hdc,red
     DrawText hDC,"testFile for coloring text and background",-1,cRect,0x25
     EndPaint hWndTab,Paintst
   

    case WM_CTLCOLORSTATIC
    ======================

    sys hdc=wparam
    sys hwn=lparam
    if hwn=hchw[0]
      return hsbr
    endif

    if hwn=hwndTab
      return hsbr
    endif


    case WM_CTLCOLOREDIT
    ====================

    sys hdc=wparam
    sys hwn=lparam
    int fcolor=0x880000
    int bcolor= rgb(125,125,255) '0xf0ffff
    RECT rec
    if hwn=hchw[2]
      GetClientRect  hwn,@rec
      'sys hbr=CreateSolidBrush bcolor
      'FillRect hdc,@rec,hbr
      'DeleteObject hbr
      '
      SetBkColor   hdc,bcolor
      'SetTextColor hdc,fcolor
      'DrawText hDC,"text text",-1,@rec,0x25
      return hsbr
    endif

    if hwn=hwndTab
      GetClientRect  hwn,@rec
      'sys hbr=CreateSolidBrush bcolor
      'FillRect hdc,@rec,hbr
      'DeleteObject hbr
      '
      SetBkColor   hdc,bcolor
      'SetTextColor hdc,fcolor
      'DrawText hDC,"text text",-1,@rec,0x25
      return hsbr
    endif


    case WM_CTLCOLORBTN
    ===================

    sys hdc=wparam
    sys hwn=lparam
    int bcolor=0x0020e0
    int fcolor= rgb(125,125,0)  '0xeeeeee
    RECT rec
    if hwn=hchw[1]
      GetClientRect  hwn,@rec
      sys hbr=CreateSolidBrush bcolor
      FillRect hdc,@rec,hbr
   
      SetBkColor   hdc,bcolor
      SetTextColor hdc,fcolor
      DrawText hDC,"OK",-1,@rec,0x25
      DeleteObject hbr
      return 0
    endif

   if hwn=hwndTab
      GetClientRect  hwn,@rec
      sys hbr=CreateSolidBrush bcolor
      FillRect hdc,@rec,hbr
   
      SetBkColor   hdc,bcolor
      SetTextColor hdc,fcolor
      DrawText hDC,"OK2",-1,@rec,0x25
      DeleteObject hbr
      return 0
    endif

    case WM_ERASEBKGND
    ==================
    int bcolor=0x000080
    RECT r
    GetClientRect  hwnd,@r
    sys hbr=CreateSolidBrush bcolor
    'wparam is hdc
    FillRect wparam,@r,hbr
    DeleteObject hbr   
    return 1
 

    case WM_COMMAND
    ===============

    if wparam=101 'popup ok button
      ShowWindow hchw[0],0
      ShowWindow hchw[1],0
      ShowWindow hchw[2],0
      ms=0
    endif


    case WM_KEYDOWN
    ===============

    if wParam=27 then SendMessage hwnd, WM_CLOSE, 0, 0      'ESCAPE


    case WM_SIZE
    ============
    RECT rc
    GetClientRect(hwnd, rc)
    int px=rc.right \2 - 100
    int py=rc.bottom \2 -35
    'child window, position x,y  size x.y, show
    MoveWindow(hchw[0], px,py, 300, 300, TRUE) '200, 70 right click window size
    'MoveWindow(hchw[1], px+165,py+35, 30, 30 TRUE) 'ok button
    MoveWindow(hchw[1], px+165,py+95, 40, 40 TRUE)
    MoveWindow(hchw[2], px+15,py+15, 190, 30 TRUE) 'Editbox

    case WM_DESTROY
      DeleteObject hsbr
      PostQuitMessage 0

    case else
    =========
         
    function=DefWindowProc hWnd,wMsg,wParam,lParam   
    end select
    '
  end function ' WndProc

  MainWindow 520,420,WS_OVERLAPPEDWINDOW


A Screenshot of this example I couldnt built Strange

Zlatko Vid

Frank
something is wrong with your window paint and erase back
because when we move windows he tend to remove sys buttons and windows frame
at least on my win7 64 bit

Zlatko Vid

Also
you put a lot of stuff under WM_CREATE which is not
good as far as I can tell you from my experience ?

..and why is your "GLOBAL" code under Callback function?
hmm ..i will check this better   

Zlatko Vid

Frank
This is set of functions i use for TabControl
Function SetTabControl (byval _tbhwnd as INT,byval _tx as INT,byval _ty as INT,byval _tw as INT,byval _th as INT,byval _tbflag as INT,byval _ex as INT,byval cID as INT) As INT
INT _hfont
  If _tbflag=0
    _tbflag=WS_CHILD | WS_VISIBLE| TCS_HOTTRACK
  End If
 
  hTabControl = CreateWindowEx(_ex,"SysTabControl32","",_tbflag,_tx,_ty,_tw,_th,_tbhwnd,cID,0,0)
 _hfont = GetStockObject(17)
 SendMessage hTabControl,WM_SETFONT,_hfont,0
  UpdateWindow _tbhwnd
Function = hTabControl
End Function
'=====================================================================================
'AddTab
Function AddTab (byval hwnd as INT ,byval tbpos as INT,byval tbtext as String ) as INT
TC_ITEM tie
tie.mask=1
tie.pszText= strptr(tbtext)
tie.cchTextMax=Len(tbtext)
tie.iImage = -1
SendMessage(hWnd,0x1307,tbpos,&tie)

End Function
'=====================================================================================
Function SetTabText (cntID as INT,tbIndex as INT,tabText as String)
TC_ITEM tie
tie.mask=1
tie.pszText= strptr(tabText)
tie.cchTextMax=Len(tabtext)
tie.iImage = -1
SendMessage(cntID,TCM_SETITEM,tbIndex,&tie)
Return
End Function

'=====================================================================================
SUB SetSelectedTab (cntID as INT,index as INT)
Sendmessage (cntID,TCM_SETCURSEL,index,0)

'Return tbIndex
End Sub
'=====================================================================================

Function GetSelectedTab (cntID as INT) as INT
INT tbIndex
tbIndex = Sendmessage (cntID,TCM_GETCURSEL,0,0)

Return tbIndex
End Function

'=====================================================================================
Function GetTabText (cntID as INT,tbIndex as INT) as string
string tabText=Space(256)
TC_ITEM tie
tie.mask=1
tie.pszText = strptr tabText
tie.cchTextMax = 256
tie.iImage = -1
Sendmessage (cntID,TCM_GETITEM,tbIndex,&tie)
Return tabText
End Function
'=====================================================================================
Function GetTabCount (cntID as INT) as INT
INT tbCount
tbCount = Sendmessage (cntID,TCM_GETITEMCOUNT,0,0)
Return tbCount
End Function
'=====================================================================================
Function DeleteTab (cntID as INT, index as INT ) as INT
Sendmessage (cntID,TCM_DELETEITEM,index,0)
Return 0
End Function

Zlatko Vid

Frank
you declare GradientFill api function and then you don't use it ?
just create mess-up with other code ?
declare function GradientFill lib "MSIMG32.DLL" lib "GradientFill" ( _
   byval hdc as dword _                                 ' __in HDC hdc
 , byref pVertex as float _ 'TRIVERTEX _                ' __in PTRIVERTEX pVertex
 , byval nVertex as dword _                             ' __in ULONG nVertex
 , byref pMesh as sys _                                 ' __in PVOID pMesh
 , byval nMesh as dword _                               ' __in ULONG nMesh
 , byval ulMode as dword _                              ' __in ULONG ulMode
 ) as long                                              ' BOOL

Zlatko Vid

also what is this :
MainWindow 520,420,WS_OVERLAPPEDWINDOW

you don't have handler of this main window, it is too limited
kind of tik-tok style  ;D

main window should be :
hwnd = CreateWindowEx 0, ClassName, caption, style, Wx, Wy, Ww, Wh, wparent, 0, inst, 0

Zlatko Vid

oups
i just looked into WinUtil
so this is for MainWindow

  CreateMainWindow 'MACRO WITH OPENGL OVERRIDE

i think that MainWindow is just wrapper but it looks that is for openGL ?