fb:porticula NoPaste
inc\CreateRadioButton.bas
Uploader: | Eternal_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