Buchempfehlung
Visual Basic 6 Kochbuch
Visual Basic 6 Kochbuch
Viele praktische Tipps zum Programmieren mit Visual Basic 6, die sich oft auch auf FB übertragen lassen. [Mehr Infos...]
FreeBASIC-Chat
Es sind Benutzer im FreeBASIC-Chat online.
(Stand:  )
FreeBASIC bei Twitter
Twitter FreeBASIC-Nachrichten jetzt auch über Twitter erhalten. Follow us!

fb:porticula NoPaste

Info
Info / Hilfe
Liste
Übersicht / Liste
Neu
Datei hochladen
Suche
Quellcode suchen
Download
Dateidownload

inc\CreateRadioButton.bas

Uploader:MitgliedEternal_Pain
Datum/Zeit:20.03.2014 08:25:28
Hinweis: Dieser Quelltext ist Bestandteil des Projekts Windows Easy Gui (WEG), zu dem es auf FreeBASIC-Portal.de eine Projektseite gibt.

Type Item_RadioButton EXTENDS Item_Node
    as Item     ghwnd   'Handle to the First RadioButton in Group
    as Item     mhwnd   'Handle to the Window/GroupBox

    as Integer  FirstID 'ID to the first RadioButton
    as Integer  LastID  'ID to the last RadioButton

    as Integer  NowID   'Actually RadioButton ID

    Declare Sub Destroy()
End Type

Sub Item_RadioButton.Destroy()
    ID = "" : Title = ""
    DestroyWindow(whwnd)
    ghwnd = 0 : mhwnd = 0
    FirstID = 0 : LastID = 0 : NowID = 0
End Sub


Function CreateRadioButton(byref ItemHandle as Item     , byref GroupHandle as Item, _
                           byval px         as Integer  , byval py          as Integer, _
                           byval txt        as String="", byval GroupFlag   as Integer = 0) as Item

    Dim as UInteger ExStyle = WS_EX_TRANSPARENT
    Dim as UInteger BStyle  = WS_VISIBLE OR WS_CHILD OR WS_CLIPSIBLINGS OR BS_AUTORADIOBUTTON
    Dim as UInteger GStyle  = WS_TABSTOP OR WS_GROUP
    Dim as UInteger Style   = IIF(GroupFlag, BStyle OR GStyle, BStyle)
    Dim as Integer  RBID

    If (ItemHandle = 0) Then return NULL
    If GroupHandle Then
        If GroupHandle -> ID <> RadioButtonID Then
            LOGSTRING(Time & " | ERROR | GroupHandle is not an valid RadioButton Item.")
            return NULL
        End If
    End If

    Dim as RECT    prect
    Dim as HWND    phwnd
    Dim as Integer rx, ry

    If (ItemHandle -> ID = WindowID) Then
        phwnd = ItemHandle -> whwnd
        rx = px : ry = py
    ElseIf (ItemHandle -> ID = GroupBoxID) Then
        phwnd = GetParent(ItemHandle -> whwnd)
        GetClientRect(ItemHandle -> whwnd, @prect)
        MapWindowPoints(ItemHandle -> whwnd, phwnd, Cast(LPPOINT, @prect),2)
        rx = prect.left + px : ry = prect.top + py
    Else
        LOGSTRING(Time & " | ERROR | Parent is not an valid Item.")
        Return NULL
    End If

    Dim as SIZE     cSIZE
    Dim as HDC      cDC  = GetDC(phwnd)
    Dim as String   dtxt = " "+txt

    GetTextExtentPoint32(cDC,dtxt,len(txt),@cSIZE)
    ReleaseDC(phwnd, cDC)

    If cSIZE.cy<15 Then cSize.cy=15

    Dim as Item_RadioButton ptr newRadioButton = new Item_RadioButton

    If GroupHandle Then 'Gen/Get ID
        RBID = Cast(Item_RadioButton ptr, GroupHandle) -> LastID + 1
    Else
        RBID = Cast(Integer, newRadioButton)
    End If

    newRadioButton -> whwnd = CreateWindowEx(ExStyle, "BUTTON", txt, Style, rx, ry, 30+cSIZE.cx, cSIZE.cy, phwnd, Cast(HMENU,RBID), Globals.hInstance, newRadioButton)

    If (newRadioButton -> whwnd = 0) Then
        Delete newRadioButton
        LOGSTRING(Time & " | ERROR | Failed to create " & RadioButtonID)
        MessageBox(NULL,"Failed to create " & RadioButtonID, "Error", NULL)
        Return NULL
    End If

    If GroupFlag Then SendMessage(newRadioButton -> whwnd, BM_SETCHECK, Cast(WPARAM, BST_CHECKED), NULL)

    SendMessage(newRadioButton -> whwnd, WM_SETFONT, Cast(WPARAM, Globals.hFont), Cast(LPARAM,TRUE))

    SetWindowLongPtr(newRadioButton -> whwnd, GWLP_USERDATA, Cast(LONG_PTR, newRadioButton))

    newRadioButton -> ID    = RadioButtonID
    newRadioButton -> Title = txt
    newRadioButton -> NowID = RBID
    'First'n'Last RadioButton ID will only set to the GroupStart RadioButton
    If GroupHandle Then
        Cast(Item_RadioButton ptr, GroupHandle) -> LastID = RBID
        newRadioButton -> ghwnd   = GroupHandle
    Else
        newRadioButton -> ghwnd   = newRadioButton
        newRadioButton -> mhwnd   = ItemHandle
        newRadioButton -> FirstID = RBID
        newRadioButton -> LastID  = RBID
    End If

    LOGSTRING(Time & " | INFO  | " & RadioButtonID & " " & newRadioButton -> Title & " created on " & ItemHandle -> ID & " " & ItemHandle -> Title & ".")

    Globals.ItemList.AddItem(newRadioButton)

    return newRadioButton
End Function

Function RadioButtonGroup(byref ItemHandle as Item, byval px as Integer, byval py as Integer, byval txt as String="") as Item
    return CreateRadioButton(ItemHandle, NULL, px, py, txt, TRUE)
End Function

Function RadioButtonAdd(byref GroupHandle as Item, byval px as Integer, byval py as Integer, byval txt as String="") as Item
    Dim as Item     ItemHandle
    If GroupHandle andalso GroupHandle -> ID = RadioButtonID Then
        ItemHandle = Cast(Item_RadioButton ptr, GroupHandle) -> mhwnd
        return CreateRadioButton(ItemHandle, GroupHandle, px, py, txt, NULL)
    End If
End Function

'Works with CheckBox and RadioButton (same as GetCheckBoxState())
Function GetRadioButtonState(byref ItemHandle as Item) as Integer
    If ItemHandle Then
        If ItemHandle -> ID = CheckBoxID orelse ItemHandle -> ID = RadioButtonID Then
            If SendMessage(ItemHandle -> whwnd, BM_GETCHECK, NULL, NULL) Then return TRUE
        End If
    End If
    return FALSE
End Function

'Works with RadioButton only
Sub SetRadioButtonState(byref ItemHandle as Item, byval State as Integer)
    'Dim as Integer              newState = IIF(State, BST_CHECKED, BST_UNCHECKED)
    Dim as Item_RadioButton ptr RadioGroup

    If ItemHandle andalso ItemHandle -> ID = RadioButtonID Then
        If State Then
            If SendMessage(ItemHandle -> whwnd, BM_GETCHECK, NULL, NULL) = 0 Then
                If Cast(Item_RadioButton ptr, ItemHandle) -> ghwnd Then
                    RadioGroup = Cast(Item_RadioButton ptr, Cast(Item_RadioButton ptr, ItemHandle) -> ghwnd)
                Else
                    RadioGroup = Cast(Item_RadioButton ptr, ItemHandle)
                End If
                CheckRadioButton(GetParent(RadioGroup -> whwnd), RadioGroup -> FirstID, RadioGroup -> LastID, Cast(Item_RadioButton ptr, ItemHandle) -> NowID)
            End If
        Else
            SendMessage(ItemHandle -> whwnd, BM_SETCHECK, Cast(WPARAM,BST_UNCHECKED), NULL)
        End If
    End If
End Sub