fb:porticula NoPaste

Info / Hilfe Liste
Übersicht / Liste Neu
Datei hochladen Suche
Quellcode suchen
Dateidownload
inc\CreateSpinBox.bas

Uploader:	Eternal_Pain
Datum/Zeit:	19.03.2014 04:40:39
Hinweis: Dieser Quelltext ist Bestandteil des Projekts Windows Easy Gui (WEG), zu dem es auf FreeBASIC-Portal.de eine Projektseite gibt.
Sub Item_Spin.Destroy()

    ID = "" : Title = ""

    DestroyWindow(whwnd)

    DestroyWindow(shwnd)

    minVal = 0 : maxVal = 0

    whwnd = 0 : shwnd = 0

End Sub



'***********************************************************************************



                            'parent item (Window)

Function CreateSpinBox(byref ItemHandle as Item, byval px     as Integer      , byval py      as Integer, _

                                                 byval iWidth as UInteger = 70, byval iHeight as UInteger =  25, _

                                                 byval minVal as Integer  =  0, byval maxVal  as Integer  = 255, byval curVal as Integer = 0) as Item



    Dim as UInteger ExStyle = WS_EX_CLIENTEDGE

    Dim as UInteger eStyle  = WS_VISIBLE OR WS_CHILD OR ES_LEFT OR ES_NUMBER OR WS_CLIPSIBLINGS OR WS_TABSTOP

    'Dim as UInteger uStyle  = WS_VISIBLE OR WS_CHILD OR WS_CLIPSIBLINGS OR UDS_ARROWKEYS OR UDS_ALIGNRIGHT OR UDS_NOTHOUSANDS OR UDS_SETBUDDYINT

    Dim as UInteger uStyle  = WS_VISIBLE OR WS_CHILD OR UDS_ARROWKEYS OR UDS_NOTHOUSANDS OR UDS_AUTOBUDDY OR UDS_ALIGNRIGHT OR UDS_SETBUDDYINT

    If (ItemHandle = 0) Then return NULL



    Dim as RECT    prect

    Dim as HWND    phwnd

    Dim as Integer rx, ry



    Dim as Integer XPFix = 0



    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 Item_Spin ptr newSpinBox = new Item_Spin

    Dim as Integer       scurVal    = IIF(curVal < minVal, minVal, IIF(curVal > maxVal, maxVal, curVal))

    Dim as Integer       VLen       = IIF(Len(str(minVal))>Len(str(maxVal)),Len(str(minVal)),Len(str(maxVal)))



    Dim as HWND ed = CreateWindowEx(ExStyle, "EDIT", str(scurVal), eStyle, rx, ry, iWidth, iHeight, phwnd, NULL, Globals.hInstance, newSpinBox)

    'Dim as HWND up = CreateWindowEx(NULL   , UPDOWN_CLASS, "", uStyle, rx, ry, iWidth, iHeight, phwnd, NULL, Globals.hInstance, newSpinBox)

    Dim as HWND up = CreateWindowEx(ExStyle, UPDOWN_CLASS, "", uStyle, rx, ry, iWidth, iHeight, NULL , NULL, Globals.hInstance, NULL)



    'try as XP Fix

    If (up = 0) Then

        XPFix = 1

        up = CreateUpDownControl(uStyle, rx, ry, iWidth, iHeight, phwnd, NULL, Globals.hInstance, ed, maxVal, minVal, scurVal)

    End If



    If (ed = 0) or (up = 0) Then

        If ed<>0 Then DestroyWindow(ed)

        If up<>0 Then DestroyWindow(up)

        Delete newSpinBox

        LOGSTRING(Time & " | ERROR | Failed to create " & SpinBoxID)

        MessageBox(NULL,"Failed to create " & SpinBoxID, "Error", NULL)

        Return NULL

    End If



    SetWindowLongPtr(ed, GWLP_USERDATA, Cast(LONG_PTR, newSpinBox))

    SetWindowLongPtr(up, GWLP_USERDATA, Cast(LONG_PTR, newSpinBox))



    SendMessage(ed, WM_SETFONT, Cast(WPARAM, Globals.hFont), Cast(LPARAM,TRUE))



    If XPFix = 0 Then

        SendMessage(up, UDM_SETBUDDY  , cast(WPARAM,ed), NULL)

        SendMessage(up, UDM_SETRANGE32, minVal,  maxVal)         'range

        SendMessage(up, UDM_SETPOS32  , NULL  , scurVal)         'current

    End If



    SendMessage(ed, EM_LIMITTEXT, Cast(WPARAM, VLen), NULL) 'Set Char Limit

    SendMessage(ed, DM_SETDEFID, Cast(wParam,IDOK), NULL)



    newSpinBox -> ID     = SpinBoxID

    newSpinBox -> Title  = str(ed)

    newSpinBox -> whwnd  = ed

    newSpinBox -> shwnd  = up



    newSpinBox -> minVal = minVal

    newSpinBox -> maxVal = maxVal



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



    Globals.ItemList.AddItem(newSpinBox)



    return newSpinBox

End Function



'***********************************************************************************



Function GetSpinBoxValue(byval SpinBox as Item) as Integer

    Dim as Integer SBVal

    Dim as String  gs



    If SpinBox andalso SpinBox -> ID = SpinBoxID Then

        gs = space(255)

        gs = left(gs,GetWindowText(SpinBox -> whwnd, gs, len(gs)))



        SBVal = Val(gs)



        If (SBVal < (Cast(Item_Spin ptr, SpinBox) -> minVal)) Then

            SBVal = Cast(Item_Spin ptr, SpinBox) -> minVal

            SetWindowText(SpinBox -> whwnd,str(Cast(Item_Spin ptr, SpinBox) -> minVal))

            SendMessage(Cast(Item_Spin ptr, SpinBox) -> shwnd, UDM_SETPOS32  , NULL  , SBVal)

        ElseIf (SBVal > (Cast(Item_Spin ptr, SpinBox) -> maxVal)) Then

            SBVal = Cast(Item_Spin ptr, SpinBox) -> maxVal

            SetWindowText(SpinBox -> whwnd,str(Cast(Item_Spin ptr, SpinBox) -> maxVal))

            SendMessage(Cast(Item_Spin ptr, SpinBox) -> shwnd, UDM_SETPOS32  , NULL  , SBVal)

        Else

            SetWindowText(SpinBox -> whwnd,str(SBVal))

            SendMessage(Cast(Item_Spin ptr, SpinBox) -> shwnd, UDM_SETPOS32  , NULL  , SBVal)

        End If



        Function = SBVal

    End If

End Function