PlanetSquires Forums

Please login or register.

Login with username, password and session length
Advanced search  
Pages: 1 2 [3] 4 5 ... 10
 21 
 on: May 05, 2019, 05:16:15 PM 
Started by Petrus Vorster - Last post by David Kenny
I just looked at other applications using the tab control using a "control spy" program.  It show that the tabs are all the same control. Therefore you would have to handle that during the WM_DRAWITEM message for that control (ownerdraw)

Example PB code:
Code: [Select]
#Compile Exe
#Include "win32api.inc"
#Include "commctrl.inc"
Global hinstance&
Global prevtabproc&
Function WinMain(ByVal hinst&,ByVal hprev&,ByVal cmdline As Asciiz Ptr,ByVal cmdshow&) As Long
     hinstance&=hinst&
     initcommoncontrols
''create class and register it with windows
     Dim wclassname As Asciiz*80
     Dim wcaption As Asciiz*80
     wclassname="TestColorTabs"
     Dim wclass As wndclass
     wclass.Style=%cs_hredraw Or %cs_vredraw
     wclass.lpfnwndproc=CodePtr(wndproc)
     wclass.cbclsextra=0
     wclass.cbwndextra=0
     wclass.hinstance=hinstance&
     wclass.hicon=%Null
     wclass.hcursor=loadcursor(%Null,ByVal %idc_arrow)
     wclass.hbrbackground=%Null  ''getstockobject(%gray_brush)
     wclass.lpszmenuname=%Null
     wclass.lpszclassname=VarPtr(wclassname)
     registerclass wclass
''get size - user defined size or default size
     Dim wndrect As rect
     systemparametersinfo %spi_getworkarea,0,wndrect,0
     xsize&=((wndrect.nright-wndrect.nleft)+1-64)
     ysize&=((wndrect.nbottom-wndrect.ntop)+1-64)
     xstt&=wndrect.nleft+32
     ystt&=wndrect.ntop+32
''create window
     wcaption="Test Color Tabs"
     Style&=%WS_OVERLAPPEDWINDOW Or %WS_THICKFRAME Or %WS_CLIPSIBLINGS
     hwnd&=createwindow(wclassname, _            ''window class name
                        wcaption, _              ''window caption
                        Style&, _                ''window style
                        xstt&, _                 ''initial x position
                        ystt&, _                 ''initial y position
                        xsize&, _                ''initial x size
                        ysize&, _                ''initial y size
                        %Null, _                 ''parent window handle
                        %Null, _                 ''window menu handle
                        hinstance&, _            ''program instance handle
                        %Null)                   ''creation parameters
     showwindow hwnd&,cmdshow&
     updatewindow hwnd&
     Dim wmsg As tagmsg
     While IsTrue(getmessage(wmsg,ByVal %Null,0,0))
       translatemessage wmsg
       dispatchmessage wmsg
     Wend
     Function=wmsg.wparam
End Function
Function wndproc(ByVal hwnd&,ByVal msg&,ByVal wparam&,ByVal lparam&) As Long
     Static ztext As Asciiz*256
     Static htoolbar&,hstatuswin&,htab&
     Dim rc As rect
     Dim disptr As drawitemstruct Ptr
     Dim ti As tc_item
     Select Case msg&
       Case %WM_CREATE
         ''create controls
'         getclientrect hwnd&,rc
         '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
         ''create tooltips
         Dim tbb(0 To 2) As Static tbbutton
         tbb(0).ibitmap=%std_filenew
         tbb(0).idcommand=9001
         tbb(0).fsstate=%TBSTATE_ENABLED
         tbb(0).fsstyle=%TBSTYLE_BUTTON
         tbb(0).dwdata=0
         tbb(0).istring=0
         tbb(1).ibitmap=%std_fileopen
         tbb(1).idcommand=9002
         tbb(1).fsstate=%TBSTATE_ENABLED
         tbb(1).fsstyle=%TBSTYLE_BUTTON
         tbb(1).dwdata=0
         tbb(1).istring=0
         tbb(2).ibitmap=%std_filesave
         tbb(2).idcommand=9003
         tbb(2).fsstate=%TBSTATE_ENABLED
         tbb(2).fsstyle=%TBSTYLE_BUTTON
         tbb(2).dwdata=0
         tbb(2).istring=0
         tbb(3).ibitmap=0
         tbb(3).idcommand=0
         tbb(3).fsstate=%TBSTATE_ENABLED
         tbb(3).fsstyle=%TBSTYLE_SEP
         tbb(3).dwdata=0
         tbb(3).istring=0
         tbb(4).ibitmap=%std_cut
         tbb(4).idcommand=9004
         tbb(4).fsstate=%TBSTATE_ENABLED
         tbb(4).fsstyle=%TBSTYLE_BUTTON
         tbb(4).dwdata=0
         tbb(4).istring=0
         tbb(5).ibitmap=%std_copy
         tbb(5).idcommand=9005
         tbb(5).fsstate=%TBSTATE_ENABLED
         tbb(5).fsstyle=%TBSTYLE_BUTTON
         tbb(5).dwdata=0
         tbb(5).istring=0
         tbb(6).ibitmap=%std_paste
         tbb(6).idcommand=9006
         tbb(6).fsstate=%TBSTATE_ENABLED
         tbb(6).fsstyle=%TBSTYLE_BUTTON
         tbb(6).dwdata=0
         tbb(6).istring=0
         tbb(7).ibitmap=%std_delete
         tbb(7).idcommand=9007
         tbb(7).fsstate=%TBSTATE_ENABLED
         tbb(7).fsstyle=%TBSTYLE_BUTTON
         tbb(7).dwdata=0
         tbb(7).istring=0
         tbb(8).ibitmap=0
         tbb(8).idcommand=0
         tbb(8).fsstate=%TBSTATE_ENABLED
         tbb(8).fsstyle=%TBSTYLE_SEP
         tbb(8).dwdata=0
         tbb(8).istring=0
         tbb(9).ibitmap=%std_properties
         tbb(9).idcommand=9008
         tbb(9).fsstate=%TBSTATE_ENABLED
         tbb(9).fsstyle=%TBSTYLE_BUTTON
         tbb(9).dwdata=0
         tbb(9).istring=0
         tbb(10).ibitmap=%std_find
         tbb(10).idcommand=9009
         tbb(10).fsstate=%TBSTATE_ENABLED
         tbb(10).fsstyle=%TBSTYLE_BUTTON
         tbb(10).dwdata=0
         tbb(10).istring=0
         tbb(11).ibitmap=%std_print
         tbb(11).idcommand=9010
         tbb(11).fsstate=%TBSTATE_ENABLED
         tbb(11).fsstyle=%TBSTYLE_BUTTON
         tbb(11).dwdata=0
         tbb(11).istring=0
         tbb(12).ibitmap=%std_help
         tbb(12).idcommand=9011
         tbb(12).fsstate=%TBSTATE_ENABLED
         tbb(12).fsstyle=%TBSTYLE_BUTTON
         tbb(12).dwdata=0
         tbb(12).istring=0
         Style&=%WS_CHILD Or %WS_BORDER Or %WS_VISIBLE Or %SBS_SIZEGRIP
         hstatuswin&=createstatuswindow(Style&,"",hwnd&,9999)
         Style&=%WS_CHILD Or %TBSTYLE_TOOLTIPS Or %TBSTYLE_FLAT
         htoolbar&=createtoolbarex(hwnd&,Style&,9000,12,%hinst_commctrl, _
                                   %idb_std_large_color,tbb(0),13, _
                                   0,0,100,30, _
                                   Len(tbbutton))
         sendmessage htoolbar&,%tb_autosize,0,0
         showwindow htoolbar&,%SW_SHOW
         getwindowrect htoolbar&,rc
         toolheight&=rc.nbottom-rc.ntop
         getwindowrect hstatuswin&,rc
         statheight&=rc.nbottom-rc.ntop
         '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
         ' this code was previously in error
         getclientrect hwnd&,rc
         x1&=0
         y1&=toolheight&
         x2&=rc.nright-rc.nleft
         y2&=(rc.nbottom-rc.ntop)-(toolheight&+statheight&)
         Style&=%WS_CHILD Or %WS_VISIBLE Or %TCS_TABS Or %TCS_OWNERDRAWFIXED _
                Or %WS_CLIPSIBLINGS Or %WS_CLIPCHILDREN
         htab&=createwindow("SysTabControl32","",Style&, _
                            x1&,y1&,x2&,y2&,hwnd&,1000,hinstance&,%Null)
         inserttab htab&,0,"Test1"
         inserttab htab&,1,"Test2"
         inserttab htab&,2,"Test3"
         inserttab htab&,3,"Test4"
         inserttab htab&,4,"Test5"
         inserttab htab&,5,"Test6"
         ''subclass the tab control
         prevtabproc&=setwindowlong(htab&,%gwl_wndproc,CodePtr(tabsubclassproc))
       Case %WM_DRAWITEM
         If wparam&=1000 Then  ''tab control
           disptr=lparam&
           ' -------------------
           SaveDC @disptr.hdc
           ' -------------------
           tabheight&=(@disptr.rcitem.nbottom-@disptr.rcitem.ntop)
           pg&=@disptr.itemid
           If @disptr.itemstate=%ods_selected Then
             @disptr.rcitem.ntop=@disptr.rcitem.ntop+2
             fcolor&=RGB(255,255,255)
             bcolor&=RGB(128,128,255)
           Else
             fcolor&=RGB(0,0,0)
             bcolor&=RGB(176,176,255)
           End If
           hbrush&=createsolidbrush(bcolor&)
           selectobject @disptr.hdc,hbrush&
           settextcolor @disptr.hdc,fcolor&
           setbkcolor @disptr.hdc,bcolor&
           fillrect @disptr.hdc,@disptr.rcitem,hbrush&
           ti.mask=%TCIF_TEXT
           ti.psztext=VarPtr(ztext)
           ti.cchtextmax=SizeOf(ztext)
           Call tabctrl_getitem(getdlgitem(hwnd&,wparam&),@disptr.itemid,ti)
           Style&=%dt_singleline Or %dt_center Or %dt_top
           drawtext @disptr.hdc,ztext,Len(ztext),@disptr.rcitem,Style&
           deleteobject hbrush&
           ' -------------------
           RestoreDC @disptr.hdc, 1
           ' -------------------
           Function=1
           Exit Function
         End If
       Case %WM_PAINT
'         dim ps as paintstruct
'         hdc&=beginpaint(hwnd&,ps)
'
'         endpaint hwnd&,ps
       Case %WM_MOVE
         invalidaterect hwnd&,ByVal %Null,%false
         updatewindow hwnd&
       Case %WM_NOTIFY
         Dim nmh As nmhdr Ptr
         nmh=lparam&
         Select Case @nmh.idfrom
           Case 1000  ''main tabs
             Select Case @nmh.code
               Case %TCN_SELCHANGING
               Case %TCN_SELCHANGE
             End Select
         End Select
       Case %wm_syscommand
         If (wparam& And &hfff0)<>%SC_CLOSE Then Exit Select
         destroywindow hwnd&
         Function=1
         Exit Function
       Case %WM_COMMAND
       Case %WM_DESTROY
         ''remove subclass
         setwindowlong htab&,%gwl_wndproc,prevtabproc&
         postquitmessage 0
         Function=0
         Exit Function
     End Select
     Function=defwindowproc(hwnd&,msg&,wparam&,lparam&)
End Function
Function SetColor (ByVal Color As Byte) As Word
    ' the windows api GradientFill routine wants r/g/b colors to be
    ' 16 bit words with the 8 bit color values left shifted 8 bits.
    ' this takes care of that.
    Local clr As Word
    clr = Color
    Shift Left clr, 8
    Function = clr
End Function
Sub PaintTabBg(ByVal hCtl As Long,ByVal hdc As Long,ByVal r As Long, ByVal g As Long, ByVal b As Long)
    ' this paints the actual tab body
     Local rc As Rect
     Local Xin As Long
     Local Yin As Long
     Local r2 As Long, g2 As Long, b2 As Long, offset As Long
     Dim vert(1) As TRIVERTEX
     Dim gRect As GRADIENT_RECT
     GetClientRect hCtl, rc
     Xin = rc.nRight - rc.nLeft
     Yin = rc.nBottom - rc.nTop
     vert(0).x      = 0
     vert(0).y      = 0
     vert(0).Red    = SetColor(r)
     vert(0).Green  = SetColor(g)
     vert(0).Blue   = SetColor(b)
     vert(0).Alpha  = &h0000
     vert(1).x      = Xin
     vert(1).y      = Yin
     offset=128
     r2=r-offset
     If r2<0 Then r2=0
     g2=g-offset
     If g2<0 Then g2=0
     b2=b-offset
     If b2<0 Then b2=0
     vert(1).Red    = SetColor(r2)
     vert(1).Green  = SetColor(g2)
     vert(1).Blue   = SetColor(b2)
     vert(1).Alpha  = &h0000
     gRect.UpperLeft  = 0
     gRect.LowerRight = 1
     GradientFill hDc, vert(0), 2, gRect, 1, %GRADIENT_FILL_RECT_v
End Sub
Function tabsubclassproc(ByVal hwnd&,ByVal msg&,ByVal wparam&,ByVal lparam&) As Long
     Dim rc As rect
     Select Case msg&
       Case %wm_erasebkgnd
         PaintTabBg hwnd&,wparam&,128,128,255
         Function=1
         Exit Function
 
     End Select
     Function=callwindowproc(prevtabproc&,hwnd&,msg&,wparam&,lparam&)
End Function
Function inserttab(ByVal hctl&,ByVal i&,ByVal txt$) As Long
     Dim tbctl As tc_item
     Dim ztext As Asciiz*255
     ztext=txt$
     tbctl.mask=%TCIF_TEXT
     tbctl.psztext=VarPtr(ztext)
     tbctl.cchtextmax=Len(txt$)
     tbctl.iimage=%Null
     Function=sendmessage(hctl&,%tcm_insertitem,i&,VarPtr(tbctl))
End Function

Coded by Jim Seekamp (fixed by Chriss Boss).  From PB's forum here: https://forum.powerbasic.com/forum/user-to-user-discussions/powerbasic-for-windows/37127-tab-control-and-gradient-shading-problem

It is very doable in FF.  As a bonus, the PB code also shows how you can gradient fill the entire tab as use any color you wish.

 22 
 on: May 05, 2019, 04:10:42 PM 
Started by Petrus Vorster - Last post by David Kenny
Could you supply some test code that shows the problem?  I will look at it and probe it with some tools and report back what I found (if anything) and how I found it.

 23 
 on: May 05, 2019, 06:08:42 AM 
Started by Petrus Vorster - Last post by Petrus Vorster
Hi All

Thanks for the help with the previous post.
I am now going forward by leaps and bounds.

One more question please.
I see a lot of old post on this, but perhaps someone had found the solution by now.

The tabcontrol is something i use extensively.
But it has a background i cannot get rid off or change the colour.
(See the Image)

It would be great if one could modify that to just plain white to blend in with the rest of the tool.

Anyone of you did something like that in the past perhaps?

-Thanks Peter

 24 
 on: May 02, 2019, 05:47:17 PM 
Started by Petrus Vorster - Last post by Petrus Vorster
Hi all

Just had to figure it out myself.
Now it seem obvious.

First a handle to the toolbar.
Then use the handle to get the Rebar handle.
Then use that to get the button.

Code: [Select]
Dim rebarhandle As Dword
  Dim toolbarhandle As Dword
  Rebarhandle = GetDlgItem(HWND_FORM1,IDC_FORM1_REBAR)
  Toolbarhandle = GetDlgItem(Rebarhandle,IDC_FORM1_TOOLBAR1)
  ToolBar_DisableButton(Toolbarhandle, IDC_FORM1_TOOLBAR1_BUTTON5)   

I appreciate your patience and help.

Regards, Peter

 25 
 on: May 02, 2019, 05:15:16 PM 
Started by Petrus Vorster - Last post by Petrus Vorster
I see, the person had exactly the same idea as i had.
Well, its bed-time now, and i will give this a good crack over the weekend.

Much appreciated for all the help!

-Peter

 26 
 on: May 02, 2019, 05:07:21 PM 
Started by Petrus Vorster - Last post by Petrus Vorster
Cool.

Something like this?

Code: [Select]
Toolbarhandle = GetDlgItem(HWND_Form1, IDC_FORM1_REBAR)
  ToolBar_DisableButton(Toolbarhandle, IDC_FORM1_TOOLBAR1_BUTTON5)

Ok, still no success.
I am still working through the other examples.

Thanks again

Peter

 27 
 on: May 02, 2019, 04:56:27 PM 
Started by Petrus Vorster - Last post by Eros Olmi
Put together something to test and modify from PB sources.

Dynamic icon drawing:
https://forum.powerbasic.com/forum/user-to-user-discussions/powerbasic-for-windows/11906-dynamic-icon-in-task-bar

Test program:
https://forum.powerbasic.com/forum/user-to-user-discussions/powerbasic-for-windows/776881-change-icon-colors-on-the-fly?p=776902#post776902

Final result with executable and source code (PB10.4) attached, press button to increment number inside icon

 28 
 on: May 02, 2019, 04:05:08 PM 
Started by Petrus Vorster - Last post by Eros Olmi
i'm sure i will use it one day... but for freebasic no more for powerbasic.
I'm trying to make the switch too.

 29 
 on: May 02, 2019, 04:03:59 PM 
Started by Petrus Vorster - Last post by Eros Olmi
I use something like:
gfrmMainToolBarHandle = GetDlgItem(HWND_FRMMAIN, IDC_FRMMAIN_REBAR)
...
ToolBar_EnableButton(gfrmMainToolBarHandle, IDC_FRMMAIN_TOOLBAR_BUNDLE_BUTTON_BUNDLE)
ToolBar_DisableButton(gfrmMainToolBarHandle, IDC_FRMMAIN_TOOLBAR_BUNDLE_BUTTON_BUNDLE)

Where:
HWND_FRMMAIN is the handle of the main window
IDC_FRMMAIN_REBAR is the ControlId of the toolbar
gfrmMainToolBarHandle is the handle of the toolbar
IDC_FRMMAIN_TOOLBAR_BUNDLE_BUTTON_BUNDLE is the ControlId of the button

 30 
 on: May 02, 2019, 03:35:00 PM 
Started by Petrus Vorster - Last post by Petrus Vorster
Sorry for being such a moron sometimes.

But should this not work to enable or disable the button:
Code: [Select]
htoolbar = GetDlgItem( HWND_FORM1, IDC_FORM1_TOOLBAR1)
   SendMessage hToolBar, %TB_SETSTATE, IDC_FORM1_TOOLBAR1_BUTTON5, %TBSTATE_DISABLED 

From what i read on the forum this is how you call a button on a toolbar to disable it, but it has absolutely no effect.
Probably why i never bothered with the Toolbars in the past.

-Peter

Pages: 1 2 [3] 4 5 ... 10