' ================================================
' CREATION D'UN TABCONTROL 
' ------------------------------------------------
' Permet d'utiliser le Style Windows XP
'=================================================
'
$include "rapidq.inc"

DECLARE SUB Form_OnShow
DECLARE SUB CreateControls
DECLARE SUB ItIsTime
DECLARE SUB DelTAB1
DECLARE SUB AddTAB
DECLARE SUb Form_resize
DECLARE SUB WindowsProc

declare function Convert (text as string)as string
Declare Function SetParent Lib "user32" Alias "SetParent" _
                (ByVal hWndChild As Long, ByVal hWndNewParent As Long) As Long 
DECLARE FUNCTION SetWindowLong LIB "user32" ALIAS "SetWindowLongA" _
                (hWnd AS LONG,nIndex AS LONG, dwNewLong AS LONG) AS LONG
Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" _
                (ByVal hwnd As Long, ByVal nIndex As Long) As Long
Declare Function SendMessageA Lib "user32" Alias "SendMessageA" _
                (hWnd As Long, Msg As Long, wParam As Long, lParam As Long) As Long
declare Function SetWindowPos Lib "user32" Alias "SetWindowPos" _
                (ByVal hwnd As Long, ByVal hWndInsertAfter As Long, _
                 ByVal x As Long, ByVal y As Long, ByVal cx As Long, _
                 ByVal cy As Long, ByVal wFlags As Long) As Long
DECLARE FUNCTION CreateWindowEx LIB "USER32" ALIAS "CreateWindowExA" _
                (ExStyle&, ClassName$, WindowName$, Style&, X&, Y&, _
                Width&, Height&, WndParent&, hMenu&, hInstance&, Param&) AS LONG
Declare Function CallWindowProc Lib "user32" Alias "CallWindowProcA" _
                (ByVal lpPrevWndFunc As Long, ByVal hwnd As Long, _
                ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
'declare Function WindowProc(ByVal hwnd As Long, ByVal uMsg As Long,ByVal wParam As Long, _
'                ByVal lParam As Long) As Long
               
' --- Déclarations constantes
Const WS_CHILD = &H40000000
Const WS_VISIBLE = &H10000000
Const WS_CLIPSIBLINGS = &H4000000

Const TCM_FIRST = &H1300
Const TCM_GETITEMCOUNT As Long = (TCM_FIRST + 4) 
Const TCM_DELETEITEM   As Long = (TCM_FIRST + 8) 
Const TCM_GETCURSEL    As Long = (TCM_FIRST + 11)
Const TCM_SETCURSEL    As Long = (TCM_FIRST + 12)
Const TCM_GETCURFOCUS  As Long = (TCM_FIRST + 47)
Const TCM_INSERTITEM   As Long = (TCM_FIRST + 62)

CONST WM_SETFONT = &H30
Const GWL_HWNDPARENT = (-8)
Const GWL_WNDPROC = (-4)

'--- Styles
CONST TCS_VERTICAL = &H80 
CONST TCS_FLATBUTTONS = 8 
CONST TCS_SCROLLOPPOSITE = &H1 
CONST TCS_RIGHT = &H2 
CONST TCS_MULTISELECT = &H4 

CONST STYLE1 AS Long = WS_CHILD OR WS_VISIBLE OR WS_CLIPSIBLINGS
CONST STYLE2 AS Long = WS_CHILD OR WS_VISIBLE OR TCS_MULTILINE OR TCS_VERTICAL OR TCS_RIGHT

Const SWP_DRAWFRAME = &H20 
Const SWP_NOMOVE = &H2 
Const SWP_NOSIZE = &H1 
Const SWP_NOZORDER = &H4 


' Définition de la police de caractères
' du TabControl
DIM MyFont AS QFONT
MyFont.Name = "Arial"
MyFont.Size = 10

DIM TabControlHwnd AS LONG
DIM PrevProc as long

Type TC_ITEM
    mask As Integer
    lpReserved1 AS LONG
    lpReserved2 AS LONG
    pszText As LONG
    cchTextMax As Integer
    iImage As INTEGER
    lParam As Long
End Type

CREATE Form AS QFORM
    Center
    Caption = "Tab Control ..."
    OnShow = Form_OnShow
'    OnResize = Form_resize    
    WndProc = WindowsProc
    Create GroupBoxXP As QPanel
        Top = 30
        Left = 10
        visible = 0
        BevelInner = 0
        BevelOuter = 0
        Color = rgb(255,255,255)
        Create BtnGroupBoxStyleXP As QButton
            Width = 120
            Top = 5
            Left = 5
            Caption = "Ceci est un bouton"
        End Create 
    End Create
    Create Btn_DelTab as QButton
        Caption = "Delete TAB"
        Top = 20
        Left = 220
        OnClick = DelTab1
    End create
    Create Btn_AddTab as QButton
        Caption = "Add TAB"
        Left = 220
        Top = 50
        OnClick = AddTab
    end create
END CREATE

Form.ShowModal

SUB Form_OnShow
    DIM LResult as integer
    ' Ajoute le TabControl sur le form
    CreateControls
    SetWindowLong(GroupBoxXP.handle, GWL_HWNDPARENT, TabControlHwnd)
    ' Selection du 1er Tab
    LResult = SendMessageA(TabControlHwnd, TCM_SETCURSEL, 0, 0)
END SUB

SUB WindowsProc
    ' Gestion des messages windows
    dim LResult as integer
    Select Case Msg
        Case CM_TABCHANGE
        ' test le TAB sélectionné
        ' Seule façon trouvée pour ajouter des composants sur le TabControl
        ' On crée tout sur un panel et on l'affiche en fonction du TAB sélectionné ;)
            lresult = SendMessageA(TabControlHwnd, TCM_GETCURSEL, 0, 0)
            If LResult = 1 then ' TAB 2
                GroupBoxXP.Visible = 1
            else ' autres TAB
                GroupBoxXP.Visible = 0
            End if
        Case WM_SIZing
            print "size"
        case else
        
    end select
end sub

SUb Form_resize
    SetWindowPos (TabControlHwnd, 0, 5, 5, Form.ClientWidth -50, ClientHeight -5, SWP_NOMOVE OR SWP_NOZORDER OR SWP_NOACTIVATE)
End sub

SUB AddTAB
    DIM Tie AS TC_ITEM
    DIM LResult as integer
    DIM MyText AS STRING
    ' Compte le nombre de TAB existant dans le TABControl
    LResult = SendmessageA (TabControlHwnd,TCM_GETITEMCOUNT,0,0)
    ' -- Ajoute 1 TAB
    tie.mask = 1 OR 2
    tie.iImage = -1
    MyText = convert("TAB " + Str$(LResult +1))
    Tie.cchTextMax = LEN(MyText)
    Tie.pszText = VARPTR(MyText)
    SendMessageA (TabControlHwnd, TCM_INSERTITEM, LResult + 1, tie)
END SUB

SUB DelTab1
    DIM tie AS TC_ITEM
    DIM LResult as integer
    ' recherche le Tab qui a le focus
    LResult = SendMessageA (TabControlHwnd, TCM_GETCURFOCUS, 0, 0)
    ' Supprime le TAB sélectionné
    SendMessageA (TabControlHwnd, TCM_DELETEITEM, LResult, 0)
end sub

'========================== TAB CONTROL =========================
SUB CreateControls
    DIM MyText AS STRING
    DIM tie AS TC_ITEM
    DIM tabindex as long
    
    TabControlHwnd = CreateWindowEx(0,"SysTabControl32","", STYLE2,5,5,200,200,Form.Handle,0,Application.hinstance,0)

    tie.mask = 1 OR 2 'TCIF_TEXT | TCIF_IMAGE
    tie.iImage = -1

    ' -- TAB 1
    MyText = convert("TAB 1")
    tie.cchTextMax = LEN(MyText)
    tie.pszText = VARPTR(MyText)
    SendMessageA (TabControlHwnd, TCM_INSERTITEM, 1, tie)

    ' -- TAB 2
    MyText = convert("TAB 2")
    tie.cchTextMax = LEN(MyText)
    tie.pszText = VARPTR(MyText)
    SendMessageA (TabControlHwnd, TCM_INSERTITEM, 2, tie)
    
    ' Application de la police Arial
    SendMessageA (TabControlHwnd, WM_SETFONT, MyFont.Handle, 1)
END SUB

Function Convert (Text as string)as string
    ' Permet de mettre un chr$(0) entre chaque caractère
    ' Ne pas oublier d'en rajouter 1 à la fin de la chaine
    ' cela corrige mon erreur :)
    DIM I AS Integer, Chaine as string
    chaine = ""
    For I = 1 to Len(Text)
       Chaine = chaine + mid$(text,i,1) + chr$(0)
    next
    result = chaine+ chr$(0)
End Function