PlanetSquires Forums

Please login or register.

Login with username, password and session length
Advanced search  
Pages: 1 2 [3] 4 5 ... 10
 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 ""
#Include ""
Global hinstance&
Global prevtabproc&
Function WinMain(ByVal hinst&,ByVal hprev&,ByVal cmdline As Asciiz Ptr,ByVal cmdshow&) As Long
''create class and register it with windows
     Dim wclassname As Asciiz*80
     Dim wcaption As Asciiz*80
     Dim wclass As wndclass
     wclass.Style=%cs_hredraw Or %cs_vredraw
     wclass.hcursor=loadcursor(%Null,ByVal %idc_arrow)
     wclass.hbrbackground=%Null  ''getstockobject(%gray_brush)
     registerclass wclass
''get size - user defined size or default size
     Dim wndrect As rect
     systemparametersinfo %spi_getworkarea,0,wndrect,0
''create window
     wcaption="Test Color Tabs"
     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
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
         htoolbar&=createtoolbarex(hwnd&,Style&,9000,12,%hinst_commctrl, _
                                   %idb_std_large_color,tbb(0),13, _
                                   0,0,100,30, _
         sendmessage htoolbar&,%tb_autosize,0,0
         showwindow htoolbar&,%SW_SHOW
         getwindowrect htoolbar&,rc
         getwindowrect hstatuswin&,rc
         ' this code was previously in error
         getclientrect hwnd&,rc
         htab&=createwindow("SysTabControl32","",Style&, _
         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
       Case %WM_DRAWITEM
         If wparam&=1000 Then  ''tab control
           ' -------------------
           SaveDC @disptr.hdc
           ' -------------------
           If @disptr.itemstate=%ods_selected Then
           End If
           selectobject @disptr.hdc,hbrush&
           settextcolor @disptr.hdc,fcolor&
           setbkcolor @disptr.hdc,bcolor&
           fillrect @disptr.hdc,@disptr.rcitem,hbrush&
           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
           ' -------------------
           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
         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&
         Exit Function
       Case %WM_COMMAND
       Case %WM_DESTROY
         ''remove subclass
         setwindowlong htab&,%gwl_wndproc,prevtabproc&
         postquitmessage 0
         Exit Function
     End Select
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
     If r2<0 Then r2=0
     If g2<0 Then g2=0
     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
         Exit Function
     End Select
End Function
Function inserttab(ByVal hctl&,ByVal i&,ByVal txt$) As Long
     Dim tbctl As tc_item
     Dim ztext As Asciiz*255
End Function

Coded by Jim Seekamp (fixed by Chriss Boss).  From PB's forum here:

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.

 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.

 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

 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

 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!


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

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


 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:

Test program:

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

 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.

 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_DisableButton(gfrmMainToolBarHandle, IDC_FRMMAIN_TOOLBAR_BUNDLE_BUTTON_BUNDLE)

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

 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)

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.


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