Buchempfehlung
Windows-Programmierung. Das Entwicklerhandbuch zur WIN32-API
Windows-Programmierung. Das Entwicklerhandbuch zur WIN32-API
"Der" Petzold, das über 1000 Seiten starke Standardwerk zum Win32-API - besonders nützlich u. a. bei der GUI-Programmierung in FreeBASIC! [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\CreateSpinBox.bas

Uploader:MitgliedEternal_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