Floating toolbar ocygen

Started by Frank Brübach, December 22, 2023, 12:49:52 PM

Previous topic - Next topic

0 Members and 1 Guest are viewing this topic.

Print
Go Down Pages1
User actions

Frank Brübach

December 22, 2023, 12:49:52 PM Last Edit: December 22, 2023, 06:31:32 PM by Frank Brübach
Hi all
This is the unfixed First example I Had Made with floating toolbar...

I thought IT must be possible to use the regular simple toolbar.o2bas example from winGui folder...

I Made for this First Case with Intension No Buttons for toolbar ;) IT was only a Test to See If I can Show this way a floating toolbar


Code Select
  'http://msdn.microsoft.com/en-us/library/ms632598(VS.85).aspx
  '
  ' toolbar, floating toolbar, oxygen, by frank brübach 19-12-2023
  ' test it's not working properly
  '
  $ filename "t.exe"
  includepath "$/inc/"
  '#include "RTL32.inc"
  '#include "RTL64.inc"
  #include "MinWin.inc"

  % ID_FIRSTCHILD  100
  % ID_SECONDCHILD 101
  % ID_THIRDCHILD  102

  sys hinstance
  sys hWndMain
  sys ghInstance

  '===================================
 
  sys inst=GetModuleHandle 0
  asciiz * cmdline
  @cmdline=GetCommandLine
  string szAppName="Hello Window"
  string szconfirm="Confirm Quit"

  '===================================
 
% ICC_BAR_CLASSES =  4

% TBSTYLE_BUTTON          0x0000  // obsolete; use BTNS_BUTTON instead
% TBSTYLE_SEP             0x0001  // obsolete; use BTNS_SEP instead
% TBSTYLE_CHECK           0x0002  // obsolete; use BTNS_CHECK instead
% TBSTYLE_GROUP           0x0004  // obsolete; use BTNS_GROUP instead
% TBSTYLE_CHECKGROUP      (TBSTYLE_GROUP | TBSTYLE_CHECK)     // obsolete; use BTNS_CHECKGROUP instead
% TBSTYLE_DROPDOWN        0x0008  // obsolete; use BTNS_DROPDOWN instead
% TBSTYLE_AUTOSIZE        0x0010  // obsolete; use BTNS_AUTOSIZE instead
% TBSTYLE_NOPREFIX        0x0020  // obsolete; use BTNS_NOPREFIX instead

% TBSTYLE_TOOLTIPS        0x0100
% TBSTYLE_WRAPABLE        0x0200
% TBSTYLE_ALTDRAG         0x0400
% TBSTYLE_FLAT            0x0800
% TBSTYLE_LIST            0x1000
% TBSTYLE_CUSTOMERASE     0x2000
% TBSTYLE_REGISTERDROP    0x4000
% TBSTYLE_TRANSPARENT     0x8000

% HINST_COMMCTRL          -1
% IDB_STD_SMALL_COLOR     0
% IDB_STD_LARGE_COLOR     1
% IDB_VIEW_SMALL_COLOR    4
% IDB_VIEW_LARGE_COLOR    5
% IDB_HIST_SMALL_COLOR    8
% IDB_HIST_LARGE_COLOR    9
% IDB_HIST_NORMAL         12
% IDB_HIST_HOT            13
% IDB_HIST_DISABLED       14
% IDB_HIST_PRESSED        15


% STD_CUT        = 0
% STD_COPY       = 1
% STD_PASTE      = 2
% STD_UNDO       = 3
% STD_REDOW      = 4
% STD_DELETE     = 5
% STD_FILENEW    = 6
% STD_FILEOPEN   = 7
% STD_FILESAVE   = 8
% STD_PRINTPRE   = 9
% STD_PROPERTIES = 10
% STD_HELP       = 11
% STD_FIND       = 12
% STD_REPLACE    = 13
% STD_PRINT      = 14


% TB_ENABLEBUTTON         (WM_USER + 1)
% TB_CHECKBUTTON          (WM_USER + 2)
% TB_PRESSBUTTON          (WM_USER + 3)
% TB_HIDEBUTTON           (WM_USER + 4)
% TB_INDETERMINATE        (WM_USER + 5)
% TB_MARKBUTTON           (WM_USER + 6)
% TB_ISBUTTONENABLED      (WM_USER + 9)
% TB_ISBUTTONCHECKED      (WM_USER + 10)
% TB_ISBUTTONPRESSED      (WM_USER + 11)
% TB_ISBUTTONHIDDEN       (WM_USER + 12)
% TB_ISBUTTONINDETERMINATE (WM_USER + 13)
% TB_ISBUTTONHIGHLIGHTED  (WM_USER + 14)
% TB_SETSTATE             (WM_USER + 17)
% TB_GETSTATE             (WM_USER + 18)
% TB_ADDBITMAP            (WM_USER + 19)
% TB_ADDBUTTONS           (WM_USER + 20)
% TB_INSERTBUTTON         (WM_USER + 21)
% TB_DELETEBUTTON         (WM_USER + 22)
% TB_GETBUTTON            (WM_USER + 23)
% TB_BUTTONCOUNT          (WM_USER + 24)
% TB_COMMANDTOINDEX       (WM_USER + 25)

% TB_BUTTONSTRUCTSIZE     (WM_USER + 30)

% CMB_MASKED              0x02
% TBSTATE_CHECKED         0x01
% TBSTATE_PRESSED         0x02
% TBSTATE_ENABLED         0x04
% TBSTATE_HIDDEN          0x08
% TBSTATE_INDETERMINATE   0x10
% TBSTATE_WRAP            0x20
% TBSTATE_ELLIPSES        0x40
% TBSTATE_MARKED          0x80


% WS_EX_DLGMODALFRAME 1
% WS_TOOLWINDOW   = 0x00000080 '0x80
% WS_TOPMOST      = 0x8
% IDC_TOOLBAR      = 101

typedef byte  BYTE
typedef word  WORD
typedef dword DWORD

% _WIN32

typedef struct {
  sys     hInst;
  sys     nID;
} TBADDBITMAP, *LPTBADDBITMAP;

#ifdef _WIN32
 %n 2
#else
 %n 6
#endif

typedef struct {
  int       iBitmap;
  int       idCommand;
  BYTE      fsState;
  BYTE      fsStyle;
  BYTE      bReserved[n];
  sys   dwData;
  sys   iString;
} TBBUTTON, *PTBBUTTON, *LPTBBUTTON;

typedef struct tagINITCOMMONCONTROLSEX {
  DWORD dwSize;
  DWORD dwICC;
} INITCOMMONCONTROLSEXtype, *LPINITCOMMONCONTROLSEX;

declare InitCommonControlsEx lib "ComCtl32.dll" (INITCOMMONCONTROLSEXtype*ic) as sys
indexbase 0

  '------------------------------------------------------------ -------
  Function WinMain(sys inst, prevInst, asciiz*cmdline, sys show) as sys
  '====================================================================
                    '
  ; window handle
 
  dim a,b,c,style,hWnd as sys
  dim wc as WndClass
  dim wm as MSG

  with wc                 '
    .style=CS_HREDRAW or CS_VREDRAW
    .lpfnWndProc=@wndproc
    .cbClsExtra=0
    .cbWndExtra=0   
    .hInstance=inst
    .hIcon=LoadIcon 0, IDI_APPLICATION
    .hCursor=LoadCursor 0,IDC_ARROW
    .hbrBackground=GetStockObject WHITE_BRUSH '
    .lpszMenuName=0
    .lpszClassName=@"Wins"
  end with

  hinstance=inst

  if not RegisterClass @wc
    MessageBox 0,`Registration failed`,`Problem`,MB_ICONERROR
    exit function
  end if

  style=WS_OVERLAPPEDWINDOW
  style=WS_OVERLAPPEDWINDOW | // overlapped window
        WS_HSCROLL |          // horizontal scroll bar
        WS_VSCROLL            // vertical scroll bar

  // Create the main window.
     call InitCommonControlsEx

   hwndMain = CreateWindowEx(
    0,                      // no extended styles           
    "Wins",                 // class name                   
    "toolbar & float Window",          // window name ''Main Window 
    style,                  //               
    CW_USEDEFAULT,          // default horizontal position 
    CW_USEDEFAULT,          // default vertical position   
    CW_USEDEFAULT,          // default width               
    CW_USEDEFAULT,          // default height               
    NULL,                   // no parent or owner window   
    NULL,                   // class menu used             
    hinstance,              // instance handle             
    NULL);                  // no window creation data     


  local wclass      as WndClassEx
  local szClassName as string 'asciiz ''* 80
  local szChildName as string 'asciiz ' * 80
  local hWnd        as long

  'ghInst                 = hInstance

  szClassName          = "MYPROGRAM32"
  wclass.cbSize        = sizeof(wclass)
  wclass.style         = CS_HREDRAW or CS_VREDRAW
  wclass.lpfnWndProc   = @wndproc 'CODEPTR( WndProc )
  wclass.cbClsExtra    = 0
  wclass.cbWndExtra    = 0
  wclass.hInstance     = hInstance
  wclass.hIcon         = LoadIcon( hInstance, "PROGRAM" )
  wclass.hCursor       = LoadCursor(0, IDC_ARROW )
  wclass.hbrBackground = GetStockObject WHITE_BRUSH
  wclass.lpszMenuName  = null '0
  wclass.lpszClassName = strptr(szClassName) 'VARPTR( szClassName ) 'strptr
  'print @szClassName
  wclass.hIconSm       = LoadIcon( hInstance, IDI_APPLICATION )
  RegisterClassEx wclass

''**Register Floating toolbar window
  szChildName          = "FLOATTOOLBAR"
  wclass.cbSize        = sizeof(wclass)
  wclass.style         = CS_HREDRAW or CS_VREDRAW
  wclass.lpfnWndProc   = @FloatProc 'CODEPTR(FloatProc)
  wclass.cbClsExtra    = 0
  wclass.cbWndExtra    = 0
  wclass.hInstance     = hInstance
  wclass.hIcon         = LoadIcon(hInstance, "PROGRAM")
  wclass.hCursor       = LoadCursor(0, IDC_ARROW)
  wclass.hbrBackground = GetStockObject(WHITE_BRUSH)
  wclass.lpszMenuName  = 0
  wclass.lpszClassName = strptr(szChildName)
  'print @szChildName
  wclass.hIconSm       = LoadIcon( hInstance, IDI_APPLICATION )
  RegisterClassEx wclass


  // Show the window using the flag specified by the program
  // that started the application, and send the application
  // a WM_PAINT message.

  hwnd=hwndMain
     
  if not hWnd then
    MessageBox 0,`Unable to create window`,`problem`,MB_ICONERROR
    exit function
  end if
                         '
  ShowWindow hWnd,show
  UpdateWindow hWnd
  '
  'MESSAGE LOOP
  '
  'do while GetMessage &wm,0,0,0
  '  TranslateMessage &wm
  '  DispatchMessage &wm
  'wend
  '
  sys bRet
  '
  do while bRet := GetMessage (&wm, 0, 0, 0)
    if bRet == -1 then
      'show an error message?
    else
      TranslateMessage &wm
      DispatchMessage &wm
    end if
  wend
  '
  '
  function=wm.wparam
  end function ; end of WinMain

  WinMain inst,0,cmdline,SW_NORMAL
  end


  'STANDARD CHILD WINDOWS STYLES
  '=============================
  '
  '"Button" The class for a button.
  '"ComboBox" The class for a combo box.
  '"Edit"       The class for an edit control.
  '"ListBox" The class for a list box.
  '"MDIClient" The class for an MDI client window.
  '"ScrollBar" The class for a scroll bar.
  '"Static" The class for a static control.


  dim cRect   as rect
  dim Paintst as paintstruct
  dim hDC     as sys

  '------------------------------------------------------------------------------------
  function WndProc(dword hwnd, dword uMsg, dword wParam, dword lParam) as long callback
  '====================================================================================
  '{

    RECT rcClient
    sys i,w,px,py,lx,ly,id,idmenu,style,hWndChild
    string sty
    static sys hdc, htools, hInstance,hToolfloat
    static tbAddBmp as TBADDBITMAP
    static tbb      as TBBUTTON
    static tbbx      as TBBUTTON
    static iccx     as INITCOMMONCONTROLSEXtype
   
    '' bitmap for each button
    static tbBmp(7) as sys 'as BYTE
    static RECT r

    select umsg
 
     case WM_CREATE: // creating main window 

'--------------- floattoolbar try -------------------- //
     % CCS_TOP           = &H00000001???
     % TBSTYLES TBSTYLE_FLAT or WS_CHILD or WS_VISIBLE

      ' Create a Floating toobar window
      ' 1) not ok something is wrong
      GetClientRect hwnd, @r
      'WS_EX_TOOLWINDOW or WS_EX_WINDOWEDGE
      sys ghWndTool = CreateWindowEx(WS_EX_TOOLWINDOW or WS_EX_WINDOWEDGE or WS_EX_TOPMOST, _
                                 "FLOATTOOLBAR", _
                                 "ToolBar", WS_SYSMENU, _
                                 500, 150, 68, 240,_
                                 hWnd, null, hInstance, null)
     
      ShowWindow ghWndTool,SW_SHOW
      UpdateWindow ghWndTool
'--------------------------------------------------------------------- //
     if ghWndTool <> null then
      SendMessage( ghWndTool, TB_BUTTONSTRUCTSIZE, sizeof tbb, null )
      tbAddBmp.hInst = HINST_COMMCTRL
      tbAddBmp.nID   = IDB_STD_SMALL_COLOR
      SendMessage( ghWndTool, TB_ADDBITMAP, 0, @tbAddBmp )
      '
      '' apply bitmap to toolbar buttons
      '
      dim i,k as LONG
      for i = 0 to 6
        if i=4 then k=TBSTYLE_SEP else k=TBSTYLE_BUTTON
        with tbb
        .iBitmap   = tbBmp(i)
        .fsState   = TBSTATE_ENABLED
        .fsStyle   = k
        .idCommand = -1
        .dwData    = 0
        end with
        SendMessage( ghWndTool, TB_ADDBUTTONS, 1, @tbb)
      next
    end if
    '---------------------------------------------------- // 
'
 ' 2) usual toolbar works :-) ------------ //
    '
    'http://msdn.microsoft.com/en-us/library/windows/desktop/bb760433(v=vs.85).aspx
    iccx.dwSize = sizeof( iccx )
    iccx.dwICC  = ICC_BAR_CLASSES
    tbBmp = {STD_FILENEW, STD_FILEOPEN, STD_FILESAVE, STD_CUT, STD_COPY, STD_PASTE }
    hInstance=GetModuleHandle null
    InitCommonControlsEx( iccx )

    % TBSTYLES TBSTYLE_FLAT or WS_CHILD or WS_VISIBLE

    '------------ toolbar ok -------------------------------------- //
    hTools = CreateWindowEx( WS_EX_DLGMODALFRAME, "ToolBarWindow32",
    null,WS_CHILD or WS_VISIBLE or TBSTYLES or TBSTYLE_WRAPABLE,
    0, 0, 0, 0, hWnd, null,hInstance, null )       
    '
    ' paint toolbar buttons
    '
    if hTools <> null then
      SendMessage( hTools, TB_BUTTONSTRUCTSIZE, sizeof tbbx, null )
      tbAddBmp.hInst = HINST_COMMCTRL
      tbAddBmp.nID   = IDB_STD_SMALL_COLOR
      SendMessage( hTools, TB_ADDBITMAP, 0, @tbAddBmp )
      '
      '' apply bitmap to toolbar buttons
      '
      dim i,k as LONG
      for i = 0 to 6
        if i=3 then k=TBSTYLE_SEP else k=TBSTYLE_BUTTON
        with tbbx
        .iBitmap   = tbBmp(i)
        .fsState   = TBSTATE_ENABLED
        .fsStyle   = k
        .idCommand = -1
        .dwData    = 0
        end with
        SendMessage( hTools, TB_ADDBUTTONS, 1, @tbbx)
      next
    end if
       
'-------------------------------------------------------------------------- //
           
        case WM_SIZE:   // main window changed size
 
            // Get the dimensions of the main window's client
            // area, and enumerate the child windows. Pass the
            // dimensions to the child windows during enumeration.
 
            GetClientRect(hwnd, &rcClient);
            'EnumChildWindows(hwnd, & EnumChildProc, &rcClient);
            return 0;

        case WM_CLOSE:
          // Create the message box. If the user clicks
  // the Yes button, destroy the main window.
 
         if (MessageBox(hwnd, *szConfirm, *szAppName, MB_YESNOCANCEL) == IDYES)
           DestroyWindow(hwndMain);
         else
           return 0;
         end if

         case WM_DESTROY:
 
         // Post the WM_QUIT message to
         // quit the application terminate.
 
         PostQuitMessage(0);
         return 0;
    end select
    '
    return DefWindowProc(hwnd, uMsg, wParam, lParam);
  '}
  end function

'--------------------------------------------------- //
' dummy content must however work like in powerbasic
function FloatProc() export as long

  sys hwnd,wParam,lparam,fl
  local wMsg as msg
  select case wMsg
        '%WM_
  end select

  function = DefWindowProc(hWnd,wMsg,wParam,lParam)
end function
  •  

Frank Brübach

#1
December 22, 2023, 04:12:32 PM Last Edit: December 22, 2023, 06:33:56 PM by Frank Brübach
Second issue: with usual MS Button but No floating toolbar ;)

Oxygen:

Code Select
  'http://msdn.microsoft.com/en-us/library/ms632598(VS.85).aspx
  '
  ' toolbar, floating toolbar, oxygen, by frank brübach 19-12-2023
  ' test it's not working properly
  ' 22-12-2023, 16:06
  '
  $ filename "t.exe"
  includepath "$/inc/"
  '#include "RTL32.inc"
  '#include "RTL64.inc"
  #include "MinWin.inc"

  % ID_FIRSTCHILD  100
  % ID_SECONDCHILD 101
  % ID_THIRDCHILD  102

  sys hinstance
  sys hWndMain
  sys ghInstance

  '===================================
 
  sys inst=GetModuleHandle 0
  asciiz * cmdline
  @cmdline=GetCommandLine
  string szAppName="Hello Window"
  string szconfirm="Confirm Quit"

  '===================================
 
% ICC_BAR_CLASSES =  4

% TBSTYLE_BUTTON          0x0000  // obsolete; use BTNS_BUTTON instead
% TBSTYLE_SEP             0x0001  // obsolete; use BTNS_SEP instead
% TBSTYLE_CHECK           0x0002  // obsolete; use BTNS_CHECK instead
% TBSTYLE_GROUP           0x0004  // obsolete; use BTNS_GROUP instead
% TBSTYLE_CHECKGROUP      (TBSTYLE_GROUP | TBSTYLE_CHECK)     // obsolete; use BTNS_CHECKGROUP instead
% TBSTYLE_DROPDOWN        0x0008  // obsolete; use BTNS_DROPDOWN instead
% TBSTYLE_AUTOSIZE        0x0010  // obsolete; use BTNS_AUTOSIZE instead
% TBSTYLE_NOPREFIX        0x0020  // obsolete; use BTNS_NOPREFIX instead

% TBSTYLE_TOOLTIPS        0x0100
% TBSTYLE_WRAPABLE        0x0200
% TBSTYLE_ALTDRAG         0x0400
% TBSTYLE_FLAT            0x0800
% TBSTYLE_LIST            0x1000
% TBSTYLE_CUSTOMERASE     0x2000
% TBSTYLE_REGISTERDROP    0x4000
% TBSTYLE_TRANSPARENT     0x8000

% HINST_COMMCTRL          -1
% IDB_STD_SMALL_COLOR     0
% IDB_STD_LARGE_COLOR     1
% IDB_VIEW_SMALL_COLOR    4
% IDB_VIEW_LARGE_COLOR    5
% IDB_HIST_SMALL_COLOR    8
% IDB_HIST_LARGE_COLOR    9
% IDB_HIST_NORMAL         12
% IDB_HIST_HOT            13
% IDB_HIST_DISABLED       14
% IDB_HIST_PRESSED        15


% STD_CUT        = 0
% STD_COPY       = 1
% STD_PASTE      = 2
% STD_UNDO       = 3
% STD_REDOW      = 4
% STD_DELETE     = 5
% STD_FILENEW    = 6
% STD_FILEOPEN   = 7
% STD_FILESAVE   = 8
% STD_PRINTPRE   = 9
% STD_PROPERTIES = 10
% STD_HELP       = 11
% STD_FIND       = 12
% STD_REPLACE    = 13
% STD_PRINT      = 14


% TB_ENABLEBUTTON         (WM_USER + 1)
% TB_CHECKBUTTON          (WM_USER + 2)
% TB_PRESSBUTTON          (WM_USER + 3)
% TB_HIDEBUTTON           (WM_USER + 4)
% TB_INDETERMINATE        (WM_USER + 5)
% TB_MARKBUTTON           (WM_USER + 6)
% TB_ISBUTTONENABLED      (WM_USER + 9)
% TB_ISBUTTONCHECKED      (WM_USER + 10)
% TB_ISBUTTONPRESSED      (WM_USER + 11)
% TB_ISBUTTONHIDDEN       (WM_USER + 12)
% TB_ISBUTTONINDETERMINATE (WM_USER + 13)
% TB_ISBUTTONHIGHLIGHTED  (WM_USER + 14)
% TB_SETSTATE             (WM_USER + 17)
% TB_GETSTATE             (WM_USER + 18)
% TB_ADDBITMAP            (WM_USER + 19)
% TB_ADDBUTTONS           (WM_USER + 20)
% TB_INSERTBUTTON         (WM_USER + 21)
% TB_DELETEBUTTON         (WM_USER + 22)
% TB_GETBUTTON            (WM_USER + 23)
% TB_BUTTONCOUNT          (WM_USER + 24)
% TB_COMMANDTOINDEX       (WM_USER + 25)

% TB_BUTTONSTRUCTSIZE     (WM_USER + 30)

% CMB_MASKED              0x02
% TBSTATE_CHECKED         0x01
% TBSTATE_PRESSED         0x02
% TBSTATE_ENABLED         0x04
% TBSTATE_HIDDEN          0x08
% TBSTATE_INDETERMINATE   0x10
% TBSTATE_WRAP            0x20
% TBSTATE_ELLIPSES        0x40
% TBSTATE_MARKED          0x80


% WS_EX_DLGMODALFRAME 1
% WS_TOOLWINDOW   = 0x00000080 '0x80
% WS_TOPMOST      = 0x8
% IDC_TOOLBAR      = 101

typedef byte  BYTE
typedef word  WORD
typedef dword DWORD

% _WIN32

typedef struct {
  sys     hInst;
  sys     nID;
} TBADDBITMAP, *LPTBADDBITMAP;

#ifdef _WIN32
 %n 2
#else
 %n 6
#endif

typedef struct {
  int       iBitmap;
  int       idCommand;
  BYTE      fsState;
  BYTE      fsStyle;
  BYTE      bReserved[n];
  sys   dwData;
  sys   iString;
} TBBUTTON, *PTBBUTTON, *LPTBBUTTON;

typedef struct tagINITCOMMONCONTROLSEX {
  DWORD dwSize;
  DWORD dwICC;
} INITCOMMONCONTROLSEXtype, *LPINITCOMMONCONTROLSEX;

declare InitCommonControlsEx lib "ComCtl32.dll" (INITCOMMONCONTROLSEXtype*ic) as sys
indexbase 0

  '------------------------------------------------------------ -------
  Function WinMain(sys inst, prevInst, asciiz*cmdline, sys show) as sys
  '====================================================================
                    '
  ; window handle
 
  dim a,b,c,style,hWnd as sys
  dim wc as WndClass
  dim wm as MSG

  with wc                 '
    .style=CS_HREDRAW or CS_VREDRAW
    .lpfnWndProc=@wndproc
    .cbClsExtra=0
    .cbWndExtra=0   
    .hInstance=inst
    .hIcon=LoadIcon 0, IDI_APPLICATION
    .hCursor=LoadCursor 0,IDC_ARROW
    .hbrBackground=GetStockObject WHITE_BRUSH '
    .lpszMenuName=0
    .lpszClassName=@"Wins"
  end with

  hinstance=inst

  if not RegisterClass @wc
    MessageBox 0,`Registration failed`,`Problem`,MB_ICONERROR
    exit function
  end if

  style=WS_OVERLAPPEDWINDOW
  style=WS_OVERLAPPEDWINDOW | // overlapped window
        WS_HSCROLL |          // horizontal scroll bar
        WS_VSCROLL            // vertical scroll bar

  // Create the main window.
     call InitCommonControlsEx

   hwndMain = CreateWindowEx(
    0,                      // no extended styles           
    "Wins",                 // class name                   
    "toolbar & float Window",          // window name ''Main Window 
    style,                  //               
    CW_USEDEFAULT,          // default horizontal position 
    CW_USEDEFAULT,          // default vertical position   
    CW_USEDEFAULT,          // default width               
    CW_USEDEFAULT,          // default height               
    NULL,                   // no parent or owner window   
    NULL,                   // class menu used             
    hinstance,              // instance handle             
    NULL);                  // no window creation data     


  local wclass      as WndClassEx
  local szClassName as string 'asciiz ''* 80
  local szChildName as string 'asciiz ' * 80
  local hWnd        as long

  'ghInst                 = hInstance

  szClassName          = "MYPROGRAM32"
  wclass.cbSize        = sizeof(wclass)
  wclass.style         = CS_HREDRAW or CS_VREDRAW
  wclass.lpfnWndProc   = @wndproc 'CODEPTR( WndProc )
  wclass.cbClsExtra    = 0
  wclass.cbWndExtra    = 0
  wclass.hInstance     = hInstance
  wclass.hIcon         = LoadIcon( hInstance, "PROGRAM" )
  wclass.hCursor       = LoadCursor(0, IDC_ARROW )
  wclass.hbrBackground = GetStockObject WHITE_BRUSH
  wclass.lpszMenuName  = null '0
  wclass.lpszClassName = strptr(szClassName) 'VARPTR( szClassName ) 'strptr
  'print @szClassName
  wclass.hIconSm       = LoadIcon( hInstance, IDI_APPLICATION )
  RegisterClassEx wclass

''**Register Floating toolbar window
  szChildName          = "FLOATTOOLBAR"
  wclass.cbSize        = sizeof(wclass)
  wclass.style         = CS_HREDRAW or CS_VREDRAW
  wclass.lpfnWndProc   = @FloatProc 'CODEPTR(FloatProc)
  wclass.cbClsExtra    = 0
  wclass.cbWndExtra    = 0
  wclass.hInstance     = hInstance
  wclass.hIcon         = LoadIcon(hInstance, "PROGRAM")
  wclass.hCursor       = LoadCursor(0, IDC_ARROW)
  wclass.hbrBackground = GetStockObject(WHITE_BRUSH)
  wclass.lpszMenuName  = 0
  wclass.lpszClassName = strptr(szChildName)
  'print @szChildName
  wclass.hIconSm       = LoadIcon( hInstance, IDI_APPLICATION )
  RegisterClassEx wclass


  // Show the window using the flag specified by the program
  // that started the application, and send the application
  // a WM_PAINT message.

  hwnd=hwndMain
     
  if not hWnd then
    MessageBox 0,`Unable to create window`,`problem`,MB_ICONERROR
    exit function
  end if
                         '
  ShowWindow hWnd,show
  UpdateWindow hWnd
  '
  'MESSAGE LOOP
  '
  'do while GetMessage &wm,0,0,0
  '  TranslateMessage &wm
  '  DispatchMessage &wm
  'wend
  '
  sys bRet
  '
  do while bRet := GetMessage (&wm, 0, 0, 0)
    if bRet == -1 then
      'show an error message?
    else
      TranslateMessage &wm
      DispatchMessage &wm
    end if
  wend
  '
  '
  function=wm.wparam
  end function ; end of WinMain

  WinMain inst,0,cmdline,SW_NORMAL
  end


  'STANDARD CHILD WINDOWS STYLES
  '=============================
  '
  '"Button"    The class for a button.
  '"ComboBox"    The class for a combo box.
  '"Edit"       The class for an edit control.
  '"ListBox"    The class for a list box.
  '"MDIClient"    The class for an MDI client window.
  '"ScrollBar"    The class for a scroll bar.
  '"Static"    The class for a static control.


  dim cRect   as rect
  dim Paintst as paintstruct
  dim hDC     as sys

  '------------------------------------------------------------------------------------
  function WndProc(dword hwnd, dword uMsg, dword wParam, dword lParam) as long callback
  '====================================================================================
  '{

    RECT rcClient
    sys i,w,px,py,lx,ly,id,idmenu,style,hWndChild
    string sty
    static sys hdc, htools, hInstance,hToolfloat
    static tbAddBmp as TBADDBITMAP
    static tbb      as TBBUTTON
    static tbbx      as TBBUTTON
    static iccx     as INITCOMMONCONTROLSEXtype
   
    '' bitmap for each button
    static tbBmp(7) as sys 'as BYTE
    static RECT r

    select umsg
 
     case WM_CREATE // creating main window 
'----------------------------------------------------- //
'toolbar simple with usual ms buttons
     dim i as integer
     dim tbBmp(17) as long
     dim tbAddBmp as TBADDBITMAP
     dim tbb AS TBBUTTON
     ' Bitmaps festlegen, alles StandardIcon aus Windows
     tbBmp(0) = STD_FILENEW
     tbBmp(1) = STD_FILEOPEN
     tbBmp(2) = STD_FILESAVE
     tbBmp(3) = -1
     tbBmp(4) = STD_CUT
     tbBmp(5) = STD_COPY
     tbBmp(6) = STD_PASTE
     tbBmp(7) = STD_DELETE
     tbBmp(8) = -1
     tbBmp(9) = STD_FIND
     tbBmp(10) = STD_REPLACE
     tbBmp(11) = -1
     tbBmp(12) = STD_UNDO
     tbBmp(13) = STD_REDOW
     tbBmp(14) = -1
     tbBmp(15) = STD_PRINT
     tbBmp(16) = STD_PROPERTIES

     ' Initialisieren der common controls W32
     'InitCommonControls()
      InitCommonControlsEx( iccx )
     'ToolBar anlegen
     hTools = CreateWindowEx( WS_EX_TOOLWINDOW OR WS_EX_CLIENTEDGE, _
                              "ToolBarWindow32", "", _
                              WS_CHILD or WS_VISIBLE, _
                              0, 0, 0, 0, _
                              hWnd, null, hInstance, null )
    'Die ToolBar und Buttons zeichnen
    if ( hTools <> null ) then
      SendMessage( hTools, TB_BUTTONSTRUCTSIZE, sizeof(tbb), NULL )
      tbAddBmp.hInst = HINST_COMMCTRL
      tbAddBmp.nID   = IDB_STD_SMALL_COLOR
      SendMessage( hTools, TB_ADDBITMAP, 0, @tbAddBmp )
      for i = 0 to 16
       with tbb
        if tbBmp(i)= -1 then
        'an diesen Stellen einen Abstand zwischen die Buttons einfügen
          .fsStyle   = TBSTYLE_SEP
          .iBitmap   = 6 'bestimmt den Abstand der Button
        else
          .fsStyle   = TBSTYLE_BUTTON
          .iBitmap   = tbBmp(i)
        end if
        .fsState   = TBSTATE_ENABLED
        .idCommand = -1
        .dwData    = 0
       end with
       SendMessage( hTools, TB_ADDBUTTONS, 1, @tbb )
      next
    end if
   
'--------------- floattoolbar try -------------------- //
     % CCS_TOP           = &H00000001???
     % TBSTYLES TBSTYLE_FLAT or WS_CHILD or WS_VISIBLE

      ' Create a Floating toobar window
      ' 1) not ok something is wrong
      GetClientRect hwnd, @r
      'WS_EX_TOOLWINDOW or WS_EX_WINDOWEDGE
      sys ghWndTool = CreateWindowEx(WS_EX_TOOLWINDOW or WS_EX_WINDOWEDGE or WS_EX_TOPMOST, _
                                 "FLOATTOOLBAR", _
                                 "ToolBar", WS_SYSMENU, _
                                 500, 150, 68, 240,_
                                 hWnd, null, hInstance, null)
     
      ShowWindow ghWndTool,SW_SHOW
      UpdateWindow ghWndTool
'--------------------------------------------------------------------- //
     if ghWndTool <> null then
      SendMessage( ghWndTool, TB_BUTTONSTRUCTSIZE, sizeof tbb, null )
      tbAddBmp.hInst = HINST_COMMCTRL
      tbAddBmp.nID   = IDB_STD_SMALL_COLOR
      SendMessage( ghWndTool, TB_ADDBITMAP, 0, @tbAddBmp )
      '
      '' apply bitmap to toolbar buttons
      '
      dim i,k as LONG
      for i = 0 to 6
        if i=4 then k=TBSTYLE_SEP else k=TBSTYLE_BUTTON
        with tbb
        .iBitmap   = tbBmp(i)
        .fsState   = TBSTATE_ENABLED
        .fsStyle   = k
        .idCommand = -1
        .dwData    = 0
        end with
        SendMessage( ghWndTool, TB_ADDBUTTONS, 1, @tbb)
      next
    end if
    '---------------------------------------------------- //             
        case WM_SIZE:   // main window changed size
 
            // Get the dimensions of the main window's client
            // area, and enumerate the child windows. Pass the
            // dimensions to the child windows during enumeration.
 
            GetClientRect(hwnd, &rcClient);
            'EnumChildWindows(hwnd, & EnumChildProc, &rcClient);
            return 0;

        case WM_CLOSE:
          // Create the message box. If the user clicks
      // the Yes button, destroy the main window.
 
         if (MessageBox(hwnd, *szConfirm, *szAppName, MB_YESNOCANCEL) == IDYES)
           DestroyWindow(hwndMain);
         else
           return 0;
         end if

         case WM_DESTROY:
 
         // Post the WM_QUIT message to
         // quit the application terminate.
 
         PostQuitMessage(0);
         return 0;
    end select
    '
    return DefWindowProc(hwnd, uMsg, wParam, lParam);
  '}
  end function

'--------------------------------------------------- //
' dummy content must however work like in powerbasic
function FloatProc() export as long

  sys hwnd,wParam,lparam,fl
  local wMsg as msg
  select case wMsg
        '%WM_
  end select

  function = DefWindowProc(hWnd,wMsg,wParam,lParam)
end function


If there is a little more time Here I make IT with new Image buttons and toolbar with floating toolbar like I know from Powerbasic examples
  •  

Zlatko Vid

#2
December 22, 2023, 07:51:26 PM
omg
why you use typedef struct
i don't remember when i use it for ..maybe intitCommonControlsEx
something like that ..hmmm...ok
  •  

Zlatko Vid

#3
December 22, 2023, 08:40:41 PM
Maybe something like this  ;D

Code Select
'Tool window with awinh037.inc include file by Aurel
$ filename "ToolWindow.exe"
include "rtl32.inc" : include "awinh037.inc" : #lookahead
'globals
INT win,twin,toolwin=0
INT x=200,y=200,w=400,h=300,wstyle = WS_MINMAXSIZE
' open window with message loop...
win = SetWindow("Main Window",x,y,w,h,0,wstyle)

'create fake tool window
twin = SetWindow("TOOL 1",x+w+10 ,y, 300,86, 0,wstyle)
'add icon buttons----------------------------------------------------------------
'IconButton( bhwnd ,_bx , _by , _bw, _bh, _ibicon , _bflag , _ext , _cID )
INT button1, b1ID = 100 : % ICONBUTTON = 1409351744
button1 = SetButton(twin,2,2,36,36,"", ICONBUTTON, 0,b1ID)
INT icon1 = LoadImage(0, "OpenApp.ico", 1, 24, 24, 24) 'load icon...
SendMessage( button1, 247, 1, icon1)                        'add icon to button...

if twin <> 0 : toolwin = 1 : endif

Wait()  '/// message loop function ///


Function WndProc(sys hwnd,wmsg,wparam,lparam) as sys Callback

SELECT hwnd
   CASE win

      Select wmsg
        CASE WM_CLOSE
        CloseWindow(win)
        'CloseWindow(twin) 'this could be changed
        EndProgram
     End Select

   CASE twin
      Select wmsg
         CASE WM_CLOSE
         if toolwin = 1
            CloseWindow(twin)
            toolwin = 0
         end if
      End Select

END SELECT

RETURN Default
End Function
  •  

Zlatko Vid

#4
December 22, 2023, 08:55:53 PM
Or maybe this one ...add XMass tool button maybe  ;D

Code Select
'Tool window with awinh037.inc include file by Aurel
$ filename "ToolWindow.exe"
include "rtl32.inc" : include "awinh037.inc" : #lookahead
'globals
INT win,twin,toolwin=0
INT x=200,y=200,w=400,h=300,wstyle = WS_MINMAXSIZE
' open window with message loop...
win = SetWindow("Main Window",x,y,w,h,0,wstyle)

'create fake tool window
twin = SetWindow("TOOL 1",x+w+10 ,y, 300,86, 0,wstyle)
'add icon buttons----------------------------------------------------------------
'IconButton( bhwnd ,_bx , _by , _bw, _bh, _ibicon , _bflag , _ext , _cID )
INT button1, b1ID = 100 : % ICONBUTTON = 1409351744
button1 = SetButton(twin,2,2,36,36,"", ICONBUTTON, 0,b1ID)
INT icon1 = LoadImage(0, "OpenApp.ico", 1, 24, 24, 24) 'load icon...
SendMessage( button1, 247, 1, icon1)                        'add icon to button...

INT button2, b2ID = 100
button2 = SetButton(twin,40,2,36,36,"", ICONBUTTON, 0,b1ID)
INT icon2 = LoadImage(0, "PenTool.ico", 1, 24, 24, 24) 'load icon...
SendMessage( button2, 247, 1, icon2)                        'add icon

if twin <> 0 : toolwin = 1 : endif

Wait()  '/// message loop function ///


Function WndProc(sys hwnd,wmsg,wparam,lparam) as sys Callback

SELECT hwnd
   CASE win

      Select wmsg
        CASE WM_CLOSE
        CloseWindow(win)
        'CloseWindow(twin) 'this could be changed
        EndProgram
     End Select

   CASE twin
      Select wmsg
         CASE WM_CLOSE
         if toolwin = 1
            CloseWindow(twin)
            toolwin = 0
         end if
      End Select

END SELECT

RETURN Default
End Function
  •  

Charles Pegge

#5
December 23, 2023, 07:28:21 PM
It may not be possible to float the toolbar over an active OpenGl surface. It does not work with child windows but menus and message boxes work okay by automatically freezing the underlying opengl.
  •  

Frank Brübach

#6
December 23, 2023, 09:31:52 PM Last Edit: December 23, 2023, 09:49:07 PM by Frank Brübach
Thanks Zlatko for your example IT Works Here :)  but I didnt have time enough to Work at my example and its frustrating to translate Code snippets from Powerbasic to oxygen its wasting time in my eyes

In 2017 I Made my private oxygen oxide.o2bas with toolbar Buttons See Pic below

Yes thx Charles for your new oxygen Update First of all and that was my Idea to place a floating toolbar in an OpenGL Scene... But IT Works with window Menues AS I know already

More to come later

Regards Frank
  •  

Charles Pegge

#7
December 24, 2023, 12:06:10 AM Last Edit: December 24, 2023, 12:09:46 AM by Charles Pegge
A simple moveable toolbar box using ConsoleGl.

It is just a slice of icons from the AppTools image (below). By changing the color r,g,b,a the box can be tinted or made transparent. The next step would be to individuate the icons into separate buttons on the panel.

Code Select
BeginScript

  sub QuadTex(float xp=0.0,yp=0.0,xq=1.0,yq=1.0)
  ==============================================
  'Configured As Front Face
  glBegin GL_TRIANGLE_STRIP
  glNormal3f   0.0 , 0.0  , 1.0
  float u=1.0
  float n=0.0
  glTexCoord2f xp , yp
  glVertex3f -u , -u , n
  glTexCoord2f xq , yp
  glVertex3f  u , -u , n
  glTexCoord2f xp , yq
  glVertex3f -u ,  u , n
  glTexCoord2f xq , yq
  glVertex3f  u ,  u , n
  glEnd
  end sub

  procedure main()
  ================
  if opening
    CreateTexture imgn,"AppTools.png"
  end if
  cls ' .3,.3,.5
  move 20,-15

  pushstate
  UserMovement m1,100 'for moveable box
  '
  'display toolbar
  '
  flat
  color 1,1,1,.9
  texture imgn
  scale 10
  scale 1.0, 0.10*imgnHt/imgnWi, 1.0 'dimensions of box strip
  quadtex(0,.68,1,.78) 'portion of image
  texture 0
  popstate
  '
  end procedure 'main

  EndScript

  •  

Charles Pegge

#8
December 24, 2023, 01:43:03 AM
A few more steps.

1. The icons are separated into buttons
2. They are positioned on a toolbar panel
3. The buttons are each assigned an identity
4. The buttons can be picked and highlighted

Code Select
uses consoleG
 
  BeginScript

  procedure QuadTex(float xp=0.0,yp=0.0,xq=1.0,yq=1.0)
  ====================================================
  'Configured As Front Face
  glBegin GL_TRIANGLE_STRIP
  glNormal3f   0.0 , 0.0  , 1.0
  float u=1.0
  float n=0.0
  glTexCoord2f xp , yp
  glVertex3f -u , -u , n
  glTexCoord2f xq , yp
  glVertex3f  u , -u , n
  glTexCoord2f xp , yq
  glVertex3f -u ,  u , n
  glTexCoord2f xq , yq
  glVertex3f  u ,  u , n
  glEnd
  end procedure


  procedure main()
  ================
  if opening
    CreateTexture imgn,"AppTools.png"
  end if
  cls ' .3,.3,.5
  move 20,-15

  pushstate
  UserMovement m1,100 'for moveable box
  '
  'display toolbar
  '
  flat
  color 1,1,1,.4 'translucent panel
  texture 0
  pushstate
  move 6,0
  scale 10,1.25,1
  quadtex()
  popstate
  move 0,0,.0001
  color 1,1,1,.9
  texture imgn
  'scale 1.0, 1.0*imgnHt/imgnWi, 1.0 'dimensions of box strip
  'separate button icons
  int i
  static int k
  float x=0.015
  for i=1 to 5 'each button
    if picked=200+i
      k=200+i
    endif
    if k=200+i
      color 1,.5,1,.9
    else
      color 1,1,1,.9
    endif
    picklabel 200+i
    quadtex(x,.68,x+.1,.78) 'portion of image
    x+=.2
    move 3,0
  next 'button
  texture 0
  popstate
  '
  end procedure 'main

  EndScript
  •  

Frank Brübach

#9
December 25, 2023, 01:20:34 PM Last Edit: December 25, 2023, 01:32:32 PM by Frank Brübach
Thank you Charles good Idea... I Had a similar Idea some weeks ago with triangle Data example but didnt know how to load an Image with consoleG OpenGL :)

Just for a Test to understand I build an example with two toolbars (Panels) and a different Image (tassecafe.png) as Background

I know various Icons are better to use for certain function later AS Well

Oxygen consoleG (OpenGL) example

Code Select
'A few more steps.
'CodeSelect Expand
'23-12-2023, charles
'25-12-2023 frank
'
% ExplicitMain
% Title = "Toolbar openGL / consoleG"
uses consoleG

  BeginScript

  procedure QuadTex(float xp=0.15,yp=0.0,xq=1.0,yq=1.0)
  ====================================================
  'Configured As Front Face
  glBegin GL_TRIANGLE_STRIP
  glNormal3f  0.0 , 0.0  , 1.0
  float u=1.25 '1.0
  float n=0.0
  glTexCoord2f xp , yp
  glVertex3f -u , -u , n
  glTexCoord2f xq , yp
  glVertex3f  u , -u , n
  glTexCoord2f xp , yq
  glVertex3f -u ,  u , n
  glTexCoord2f xq , yq
  glVertex3f  u ,  u , n
  glEnd
  end procedure


  procedure QuadTex2(float xp=0.15,yp=0.0,xq=1.0,yq=1.0)
  ====================================================
  'Configured As Front Face
  glBegin GL_TRIANGLE_STRIP
  glNormal3f  0.0 , 0.0  , 1.0
  float u=1.25 '1.0
  float n=0.0
  glTexCoord2f xp , yp
  glVertex3f -u , -u , n
  glTexCoord2f xq , yp
  glVertex3f  u , -u , n
  glTexCoord2f xp , yq
  glVertex3f -u ,  u , n
  glTexCoord2f xq , yq
  glVertex3f  u ,  u , n
  glEnd
  end procedure


  procedure main()
  ================
  if opening
    CreateTexture imgn, "Tassecafe.png" ''"AppTools.png"
  end if
  cls ' .3,.3,.5
  'move 20,-15
  move 5,-5
  pushstate
  UserMovement m1,100 'for moveable box
  '
  'display toolbar
  '
  flat
  color 1,1,1,.4 'translucent panel
  texture 0
  pushstate
  'move 6,0
  move 8,0
  scale 10,1.25,1
  quadtex()
  popstate
  move 0,0,.0001
  color 1,1,1,.9

  texture imgn
  'scale 1.0, 1.0*imgnHt/imgnWi, 1.0 'dimensions of box strip
  'separate button icons
  int i
  static int k
  float x=0.015
  for i=1 to 6 'each button
    if picked=200+i
      k=200+i
    endif
    if k=200+i
      color 1,.5,1,.9
    else
      color 1,1,1,.9
    endif
    picklabel 200+i
    'quadtex(x,.68,x+.1,.78) 'portion of image
    quadtex(x,.68,x+.1,.78) 'portion of image
    x+= .15 '.2
    move 3.25,0 ' place between buttons with icons
  next 'button
  texture 0
  popstate

'
'display toolbar2 -------------------------------- //
'
  cls ' .3,.3,.5
  'move 20,-15
  move 5,-5
  pushstate
  UserMovement m1,300 'for moveable box
    '
  flat
  'color 1,1,1,.4 'translucent panel
  color 0.5,0.9,0.95,.4 'translucent panel
  texture 0
  pushstate
  'move 6,0
  move 8,-4
  scale 10,1.25,1
  quadtex2()
  popstate
  move 0,-4,.0001
  color 1,1,1,.9

  texture imgn
  'scale 1.0, 1.0*imgnHt/imgnWi, 1.0 'dimensions of box strip
  'separate button icons
  int ii
  static int kk
  float xx=0.015
  for ii=1 to 6 'each button
    if picked=300+ii
      kk=300+ii
    endif
    if kk=300+ii
      color 1,.5,1,.9
    else
      color 1,1,1,.9
    endif
    picklabel 300+ii
    'quadtex(x,.68,x+.1,.78) 'portion of image
    quadtex(xx,.68,xx+.1,.78) 'portion of image
    xx+= .15 '.2
    move 3.25,0 ' place between buttons with icons

  next 'button
  texture 0
  popstate
  end procedure 'main

  EndScript

  'MainWindow width,height,WS_OVERLAPPEDWINDOW

'cup of Coffee - tasse cafe  (German)
  •  

Frank Brübach

#10
December 25, 2023, 07:22:31 PM Last Edit: December 25, 2023, 07:24:09 PM by Frank Brübach
Little more with Button click Print (gprint) nothing Else

Info: you can move both toolbars at every place in the Scene If you want

Code Select
'CodeSelect Expand
'23-12-2023, charles
'25-12-2023, frank, plus btn click print
'
% ExplicitMain
% Title = "Toolbars consoleG -> pick and move + buttonclick"
uses consoleG

  BeginScript

  procedure QuadTex(float xp=0.15,yp=0.0,xq=1.0,yq=1.0)
  ====================================================
  'Configured As Front Face
  glBegin GL_TRIANGLE_STRIP
  glNormal3f  0.0 , 0.0  , 1.0
  float u=1.25 '1.0
  float n=0.0
  glTexCoord2f xp , yp
  glVertex3f -u , -u , n
  glTexCoord2f xq , yp
  glVertex3f  u , -u , n
  glTexCoord2f xp , yq
  glVertex3f -u ,  u , n
  glTexCoord2f xq , yq
  glVertex3f  u ,  u , n
  glEnd
  end procedure


  procedure QuadTex2(float xp=0.15,yp=0.0,xq=1.0,yq=1.0)
  ====================================================
  'Configured As Front Face
  glBegin GL_TRIANGLE_STRIP
  glNormal3f  0.0 , 0.0  , 1.0
  float u=1.25 '1.0
  float n=0.0
  glTexCoord2f xp , yp
  glVertex3f -u , -u , n
  glTexCoord2f xq , yp
  glVertex3f  u , -u , n
  glTexCoord2f xp , yq
  glVertex3f -u ,  u , n
  glTexCoord2f xq , yq
  glVertex3f  u ,  u , n
  glEnd
  end procedure


  procedure main()
  ================
  if opening
    CreateTexture imgn, "Tassecafe.png" ''"AppTools.png"
  end if
  cls ' .3,.3,.5
  'move 20,-15
  'move 5,-5
  move 2,-2
  pushstate
  UserMovement m1,100 'for moveable box
  '
  'display toolbar 1 ------------------- //
  '
  flat
  color 1,1,1,.4 'translucent panel
  texture 0
  pushstate
  'move 6,0
  move 8,0
  scale 10,1.25,1
 
  quadtex()
  popstate
  move 0,0,.0001
  color 1,1,1,.9

  texture imgn
  'scale 1.0, 1.0*imgnHt/imgnWi, 1.0 'dimensions of box strip
  'separate button icons
  int i
  static int k
  float x=0.015
  for i=1 to 6 'each button
    if picked=200+i
      k=200+i
      pushstate
      move -1.5,-2.5
      color 0.5,0.8,0,.9
      scale 1.25,1.25
      gprint "btn: "+ k
      popstate
    endif
    if k=200+i
      color 1,.5,1,.9
    else
      color 1,1,1,.9
    endif
    picklabel 200+i
    'quadtex(x,.68,x+.1,.78) 'portion of image
    quadtex(x,.68,x+.1,.78) 'portion of image
    x+= .15 '.2
    move 3.25,0 ' place between buttons with icons
  next 'button
  texture 0
  popstate

'
'display toolbar2 -------------------------------- //
'
  cls ' .3,.3,.5
  'move 20,-15
  move 0.5,-20
  pushstate
  UserMovement m1,300 'for moveable box
    '
  flat
  'color 1,1,1,.4 'translucent panel
  color 0.5,0.9,0.95,.4 'translucent panel
  texture 0
  pushstate
  'move 6,0
  move 8,-4
  scale 10,1.25,1
  quadtex2()
  popstate
  move 0,-4,.0001
  color 1,1,1,.9

  texture imgn
  'scale 1.0, 1.0*imgnHt/imgnWi, 1.0 'dimensions of box strip
  'separate button icons
  int ii
  static int kk
  float xx=0.015
  for ii=1 to 6 'each button
    if picked=300+ii
      kk=300+ii
      pushstate
      move -1.5,-2.5
      color 0.5,0.8,0,.9
      scale 1.25,1.25
      gprint "btn: "+ kk
      popstate
    endif
    if kk=300+ii
      color 1,.5,1,.9
    else
      color 1,1,1,.9
    endif
    picklabel 300+ii
    'quadtex(x,.68,x+.1,.78) 'portion of image
    quadtex(xx,.68,xx+.1,.78) 'portion of image
    xx+= .15 '.2
    move 3.25,0 ' place between buttons with icons

  next 'button
  texture 0
  popstate
  '
  end procedure 'main
  EndScript

  'MainWindow width,height,WS_OVERLAPPEDWINDOW
  •  

Charles Pegge

#11
December 25, 2023, 07:41:16 PM Last Edit: December 25, 2023, 07:42:55 PM by Charles Pegge
You can also use separate images for each button:

This example works in demos\opengl\consoleG\ and uses jpegs from demos\images\

Code Select
uses consoleG
 
  BeginScript

  procedure QuadTex(float xp=0.0,yp=0.0,xq=1.0,yq=1.0)
  ====================================================
  'Configured As Front Face
  glBegin GL_TRIANGLE_STRIP
  glNormal3f  0.0 , 0.0  , 1.0
  float u=1.0
  float n=0.0
  glTexCoord2f xp , yp
  glVertex3f -u , -u , n
  glTexCoord2f xq , yp
  glVertex3f  u , -u , n
  glTexCoord2f xp , yq
  glVertex3f -u ,  u , n
  glTexCoord2f xq , yq
  glVertex3f  u ,  u , n
  glEnd
  end procedure


  procedure main()
  ================
  if opening
    'sub LoadTexture(optional string fi, int n,res,*wi,*ht,*pflip)
    '
    texe=5
    static int imgn[]={1,2,3,4,5}
    static int wi[5],ht[5]
    LoadTexture  ("..\..\images\star.jpg",imgn[1],0,Wi[1],Ht[1])
    LoadTexture  ("..\..\images\head1.jpg",imgn[2],0,Wi[2],Ht[2])
    LoadTexture  ("..\..\images\mud.jpg",imgn[3],0,Wi[3],Ht[3])
    LoadTexture  ("..\..\images\fruitfly1.jpg",imgn[4],0,Wi[4],Ht[4])
    LoadTexture  ("..\..\images\glass.jpg",imgn[5],0,Wi[5],Ht[5])
  end if
  cls ' .3,.3,.5
  move 20,-15

  pushstate
  UserMovement m1,100 'for moveable box
  '
  'display toolbar
  '
  flat
  color 1,1,1,.4 'translucent panel
  texture 0
  scale 1.5
  pushstate
  move 6,0
  scale 8,1.25,1
  quadtex()
  popstate
  move 0,0,.0001
  color 1,1,1,.9
  'separate button icons
  int i
  static int k
  float x=0.015
  for i=1 to 5 'each button
    if picked=200+i
      k=200+i
    endif
    if k=200+i
      color 1,.5,1,.9
    else
      color 1,1,1,.9
    endif
    texture imgn[i]
    picklabel 200+i
    quadtex(0.0,.0.0,1.0,1.0) 'whole images
    texture 0
    move 3,0
  next 'button
  popstate
  '
  end procedure 'main

  EndScript
  •  

Frank Brübach

#12
December 25, 2023, 08:42:03 PM
Thank you Charles its running Well with different jpgs too :)

Nice merry Christmas for you and family... Hope you are fit and healthy

Regards Frank
  •  
Print
Go Up Pages1
User actions