Using Win32 functions in Visual FoxPro Image Gallery
Code examples:
GDI+: custom Slider control
Wininet last error description
Obtaining names of local and global groups for current user (WinNT/XP/2K)
Using Multimedia Command Strings to play MIDI files
Confining Windows calculator inside the VFP main window
Converting twips to pixels and vice versa
Creating a device context for the specified printer
Enumerating servers of the specified type (e.g. SQL Server) in the primary domain
Extracting the name and extension parts of a path string
GDI+: saving image of FoxPro form to graphics file (BMP, GIF, JPG, PNG, TIF)
How to drag a Form not using its Titlebar or Caption
How to enumerate terminal servers within the specified Windows domain
How to get the path to a Special Folder
How to save registry key including its subkeys and values to a file
How to test file attributes (key method for FileExists and DirectoryExists routines)
Initiating Inet connection using a modem
Reading the state of mouse buttons within DO WHILE loop
Running a regular FoxPro form while main VFP window is minimized
Accessing Windows Control Panel from VFP Application
Converting path to original case
Converting a hexadecimal string to an integer
Creating hash values for the list of names
Obtaining the bounding rectangle for the specified device context
Simple MAPI: how to pick an email recipient from Outlook Express address book
GDI+: custom Slider control

User rating: 0/10 (0 votes)
Rate this code sample:
  • ~
More code examples    Listed functions    Add comment     W32 Constants      Translate this page Printer friendly version of this code sample
Before you begin:


The code is based on:
  • custom GDI+ class
  • base GDI+ control

    Download both classes and save them as gdiplus.prg and BaseControl.prg respectively.
  • SET PROCEDURE TO gdiplus ADDITIVE 
    SET PROCEDURE TO basecontrol ADDITIVE 
    
    oForm = CREATEOBJECT("TestForm")
    oForm.Show(1)
    
    DEFINE CLASS TestForm as Form
        Width=700
        Height=500
        Autocenter=.T.
        Caption="Testing Custom Slider Control"
    
        ADD OBJECT Slider1 as CustomSlider WITH;
        Left=20, Top=20, Width=240, Height=60,;
        Axis=0, ScaleMargin=24,;
        LowValue=1, HighValue=7, Increment=1,;
        ValueNames="Mon,Tue,Wed,Thu,Fri,Sat,Sun"
    
        ADD OBJECT Slider2 as CustomSlider WITH;
        Left=20, Top=90, Width=140, Height=60,;
        Axis=0, ScaleMargin=24,;
        LowValue=1, HighValue=3, Increment=1,;
        ValueNames="Red,Green,Blue"
    
        ADD OBJECT Slider3 as CustomSlider WITH;
        Left=280, Top=20, Width=70, Height=210,;
        Axis=1, ScaleMargin=24,;
        LowValue=0, HighValue=1, Increment=0.1
    
    ENDDEFINE
    
    DEFINE CLASS CustomSlider as GdiplusControl
    PROTECTED CurStep
    
        LabelFont=NULL
        LabelFontSelected=NULL
        LabelFontHover=NULL
    
        ThumbBackColor = RGB(255,255,255)
        ThumbBorderColor = RGB(64,64,64)
        ThumbPressedBackColor = RGB(64,64,64)
        ThumbPressedBorderColor = RGB(64,64,64)
        ThumbHoverBackColor = RGB(156,156,156)
        ThumbHoverBorderColor = RGB(128,128,128)
        LabelColor = RGB(128,128,128)
        LabelHoverColor = RGB(64,64,64)
        LabelSelectedColor = RGB(0,0,0)
        ScaleInsideColor = RGB(64,64,64)
        ScaleOutsideColor = RGB(192,192,192)
        ScaleGridColor = RGB(158,158,158)
    
        LowValue=0
        HighValue=10
        Value=0
        Increment=1
        CurStep=0
    
        ThumbWidth=8
        ThumbHeight=12
        ThumbState=0
    
        ScaleMargin=16
        ScaleWidth=3
    
        Axis=0
    
        GridSizes="1"
        DIMENSION GridSizeArray[1]
    
        ValueNames=""
        DIMENSION ValueNameArray[1]
    
    PROCEDURE Init
        GdiplusControl::Init
        WITH THIS
            .BindEvents
            .Value = .Value
        ENDWITH
    
    PROCEDURE ReleaseGdiplusObjects
        WITH THIS
            .ReleaseFrontBuffer
            .oBackBuffer=NULL
            .LabelFont=NULL
            .LabelFontSelected=NULL
            .LabelFontHover=NULL
        ENDWITH
    
    PROCEDURE LowValue_ASSIGN(nValue)
        STORE m.nValue TO;
            THIS.LowValue, THIS.Value
    
    PROCEDURE Value_ASSIGN(nValue)
        IF nValue < THIS.LowValue
            nValue = THIS.LowValue
        ENDIF
    
        IF nValue > THIS.HighValue
            nValue = THIS.HighValue
        ENDIF
    
        THIS.CurStep = ROUND((nValue - THIS.LowValue) /;
            THIS.EffectiveIncrement(), 0)
    
        THIS.Value = THIS.LowValue +;
            THIS.CurStep * THIS.EffectiveIncrement()
    
        THIS.DrawFrame
    
    PROCEDURE ThumbState_ASSIGN(nValue)
        IF THIS.ThumbState <> nValue
            THIS.ThumbState = nValue
            THIS.DrawFrame
        ENDIF
    
    PROCEDURE MouseLeave
    LPARAMETERS nButton, nShift, nXCoord, nYCoord
        THIS.ThumbState = 0
    
    PROCEDURE MouseDown
    LPARAMETERS nButton, nShift, nXCoord, nYCoord
        IF NOT THIS.Enabled
            RETURN
        ENDIF
    
        IF nButton = 1
            THIS.ThumbState = 1
            THIS.SetValueFromCursorPosition(nXCoord, nYCoord)
        ENDIF
    
    PROCEDURE MouseMove
    LPARAMETERS nButton, nShift, nXCoord, nYCoord
        IF NOT THIS.Enabled
            RETURN
        ENDIF
    
        DO CASE
        CASE nButton = 0
            THIS.TestThumbState(nXCoord, nYCoord, 2)
        CASE nButton = 1
            THIS.ThumbState = 1
            THIS.SetValueFromCursorPosition(nXCoord, nYCoord)
        ENDCASE
    
    PROCEDURE TestThumbState(nXCoord, nYCoord, nValue)
        LOCAL nAbsX, nAbsY, lVisible, lEnabled
        lVisible = THIS.Visible
        lEnabled = THIS.Enabled
    
        STORE 0 TO nAbsX, nAbsY
        THIS.GetAbsolutePosition(;
            @nAbsX, @nAbsY, @lVisible, @lEnabled)
    
        nXCoord = nXCoord - m.nAbsX
        nYCoord = nYCoord - m.nAbsY
    
        LOCAL oRect
        oRect = THIS.GetThumbRectangle()
    
        IF BETWEEN(nXCoord, oRect.rleft, oRect.rleft + oRect.rwidth) AND;
            BETWEEN(nYCoord, oRect.rtop, oRect.rtop + oRect.rheight)
            nThumbState = nValue
        ELSE
            nThumbState = 0
        ENDIF
    
        THIS.ThumbState = nThumbState
    
    PROTECTED PROCEDURE GetIndexFromCursorPosition(nXCoord, nYCoord)
        LOCAL nIndex, nOffset, nMinIndex, nMinOffset
    
        LOCAL nAbsX, nAbsY, lVisible, lEnabled
        lVisible = THIS.Visible
        lEnabled = THIS.Enabled
    
        STORE 0 TO nAbsX, nAbsY
        THIS.GetAbsolutePosition(;
            @nAbsX, @nAbsY, @lVisible, @lEnabled)
    
        nXCoord = nXCoord - m.nAbsX
        nYCoord = nYCoord - m.nAbsY
    
        nMinIndex = 0
        nMinOffset = THIS.GetScaleSize()
    
        FOR nIndex = 0 TO THIS.GetElementCount() - 1
            nOffset = ABS(IIF(THIS.Axis=0, nXCoord, nYCoord) -;
                THIS.GetStepOffset(nIndex))
    
            IF nOffset < nMinOffset
                nMinOffset = nOffset
                nMinIndex = nIndex
            ENDIF
        NEXT
    RETURN m.nMinIndex
    
    PROTECTED PROCEDURE SetValueFromCursorPosition(nXCoord, nYCoord)
        LOCAL nMinIndex
        nMinIndex = THIS.GetIndexFromCursorPosition(nXCoord, nYCoord)
        THIS.Value = THIS.LowValue + nMinIndex * THIS.EffectiveIncrement()
    
    PROCEDURE GetStepCount
    RETURN IIF(THIS.Increment <> 0,;
                MAX(1, ROUND(ABS(THIS.HighValue - THIS.LowValue) /;
                    THIS.Increment, 0)), THIS.GetScaleSize())
    
    PROCEDURE GetElementCount
    RETURN THIS.GetStepCount() + 1
    
    PROCEDURE GetStepSize()
    RETURN ROUND(THIS.GetScaleSize() / THIS.GetStepCount(), 0)
    
    PROCEDURE GetStepOffset(nIndex)
    RETURN THIS.ScaleMargin + m.nIndex * THIS.GetStepSize()
    
    PROCEDURE GetScaleSize
    RETURN IIF(THIS.Axis=0, THIS.Width, THIS.Height) - THIS.ScaleMargin * 2
    
    PROCEDURE EffectiveIncrement
    RETURN IIF(THIS.Increment <> 0,;
        THIS.Increment,;
        (THIS.HighValue - THIS.LowValue) / THIS.GetScaleSize())
    
    PROCEDURE GetScaleInsideSize
    RETURN THIS.CurStep * THIS.GetStepSize()
    
    PROCEDURE GetScaleOutsideSize
    RETURN THIS.GetScaleSize() - THIS.GetScaleInsideSize()
    
    PROCEDURE GetScaleOtherPosition
    RETURN IIF(THIS.Axis=0, THIS.Height, THIS.Width) -;
        THIS.ScaleWidth - THIS.ScaleMargin
    
    PROCEDURE GetScaleRectangle(nMode)
        LOCAL nX, nY, nWidth, nHeight, oRect, nDelta
    
        nDelta = THIS.ThumbWidth/3
        IF nDelta < 2
            nDelta = 2
        ENDIF
        IF nDelta > 8
            nDelta = 8
        ENDIF
    
        IF THIS.Axis = 0
            DO CASE
            CASE nMode = 1    && inside
                nX = THIS.ScaleMargin - nDelta
                nWidth = THIS.GetScaleInsideSize() + nDelta
    
            CASE nMode = 2    && outside
                nX = THIS.ScaleMargin + THIS.GetScaleInsideSize()
                nWidth = THIS.GetScaleOutsideSize() + nDelta
            ENDCASE
    
            nY = THIS.GetScaleOtherPosition()
            nHeight = THIS.ScaleWidth
        ELSE
            DO CASE
            CASE nMode = 1    && inside
                nY = THIS.ScaleMargin - nDelta
                nHeight = THIS.GetScaleInsideSize() + nDelta
    
            CASE nMode = 2    && outside
                nY = THIS.ScaleMargin + THIS.GetScaleInsideSize()
                nHeight = THIS.GetScaleOutsideSize() + nDelta
            ENDCASE
    
            nX = THIS.GetScaleOtherPosition()
            nWidth = THIS.ScaleWidth
        ENDIF
    
        oRect = CREATEOBJECT(;
            "rect",;
            nX,;
            nY,;
            nWidth,;
            nHeight)
    RETURN oRect
    
    PROCEDURE GetThumbRectangle()
        LOCAL nX, nY, nWidth, nHeight, oRect
    
        IF THIS.Axis = 0
            nX = THIS.ScaleMargin + THIS.GetScaleInsideSize() -;
                THIS.ThumbWidth/2
    
            nY = THIS.GetScaleOtherPosition() - (THIS.ThumbHeight -;
                THIS.ScaleWidth)/2
        ELSE
            nX = THIS.GetScaleOtherPosition() - (THIS.ThumbWidth -;
                THIS.ScaleWidth)/2
    
            nY = THIS.ScaleMargin + THIS.GetScaleInsideSize() -;
                THIS.ThumbHeight/2
        ENDIF
    
        oRect = CREATEOBJECT(;
                    "rect",;
                    nX,;
                    nY,;
                    THIS.ThumbWidth,;
                    THIS.ThumbHeight)
    RETURN oRect
    
    PROCEDURE TestGridSizeArray
        IF ALEN(THIS.GridSizeArray) >= 1 AND;
            NOT EMPTY(THIS.GridSizeArray[1])
            RETURN
        ENDIF
    
        ALINES(THIS.GridSizeArray, THIS.GridSizes, ",")
    
        LOCAL nIndex, nValue
    
        FOR nIndex=1 TO ALEN(THIS.GridSizeArray)
            nValue = VAL(TRANSFORM(THIS.GridSizeArray[nIndex]))
            THIS.GridSizeArray[nIndex] = IIF(m.nValue > 0, m.nValue, 1)
        NEXT
    
        ASORT(THIS.GridSizeArray) && ascending
    
        SELECT 0
        CREATE CURSOR csTestGridSizeArray (gridsize N(18, 6))
    
        FOR EACH nValue IN THIS.GridSizeArray
            INSERT INTO csTestGridSizeArray (gridsize) VALUES (m.nValue)
        ENDFOR
    
        SELECT distinct gridsize FROM csTestGridSizeArray;
        INTO CURSOR csTestGridSizeArray ORDER BY 1
    
        DIMENSION THIS.GridSizeArray[ RECCOUNT("csTestGridSizeArray") ]
        SELECT csTestGridSizeArray
        nIndex = 1
        SCAN ALL
            THIS.GridSizeArray[nIndex] = csTestGridSizeArray.gridsize
            nIndex = nIndex + 1
        ENDSCAN
    
        USE IN csTestGridSizeArray
    
    PROCEDURE DrawGridValues
    *RETURN
        THIS.TestGridSizeArray
    
        LOCAL nIndex
        FOR nIndex = 0 TO THIS.GetElementCount() - 1
            THIS.DrawGridValue(nIndex)
        NEXT
    
    PROCEDURE DrawGridValue(nIndex)
        LOCAL nX, nY, nHeight, nWidth, nStepOffset
    
        nStepOffset = THIS.GetStepOffset(nIndex)
    
        IF THIS.Axis = 0
            nX = nStepOffset
            nY = THIS.GetScaleOtherPosition() - THIS.ThumbHeight/2
            nWidth = nX
            nHeight = nY + THIS.ThumbHeight/2 - 2
        ELSE
            nX = THIS.GetScaleOtherPosition() - THIS.ThumbWidth/2
            nY = nStepOffset
            nHeight = nY
            nWidth = nX + THIS.ThumbWidth/2 - 2
        ENDIF
    
        WITH THIS.oBackBuffer
            .Graphics.DrawLine(;
                ColorToARGB(THIS.ScaleGridColor),;
                nX,;
                nY,;
                nWidth,;
                nHeight)
        ENDWITH
    
        THIS.DisplayGridValue(nIndex, nStepOffset)
    
    PROCEDURE TestGridFonts
        IF VARTYPE(THIS.LabelFont) <> "O"
            THIS.LabelFont = CREATEOBJECT(;
                    "gdifont", "Arial", 8, 0,;
                    ColorToARGB(THIS.LabelColor))
        ENDIF
    
        IF VARTYPE(THIS.LabelFontSelected) <> "O"
            THIS.LabelFontSelected = CREATEOBJECT(;
                    "gdifont", "Arial", 8, 0,;
                    ColorToARGB(THIS.LabelSelectedColor))
        ENDIF
    
        IF VARTYPE(THIS.LabelFontHover) <> "O"
            THIS.LabelFontHover = CREATEOBJECT(;
                    "gdifont", "Arial", 8, 0,;
                    ColorToARGB(THIS.LabelHoverColor))
        ENDIF
    
    PROCEDURE TestValueNameArray
        IF ALEN(THIS.ValueNameArray) = 1 AND;
            EMPTY(THIS.ValueNameArray) AND;
            NOT EMPTY(THIS.ValueNames)
            ALINES(THIS.ValueNameArray, THIS.ValueNames, ",")
        ENDIF
    
    PROCEDURE GetValueAlias(nIndex)
        THIS.TestValueNameArray
    
        LOCAL nAdjustedIndex
        nAdjustedIndex = nIndex + 1
    
        IF ALEN(THIS.ValueNameArray) > 1 AND;
                nAdjustedIndex > 0 AND;
                nAdjustedIndex <= ALEN(THIS.ValueNameArray)
            RETURN TRANSFORM(THIS.ValueNameArray[nAdjustedIndex])
        ENDIF
    
    *    THIS.GridSizeArray[ ALEN(THIS.GridSizeArray) ]
    * todo: gridsize to be used instead of the Increment
    RETURN TRANSFORM(THIS.LowValue + nIndex * THIS.Increment)
    
    PROCEDURE DisplayGridValue(nIndex, nStepOffset)
        THIS.TestGridFonts
    
        LOCAL cStr, oStrRect, nX, nY,;
            nWidth, nHeight, oFont
    
        cStr = THIS.GetValueAlias(nIndex)
    
        WITH THIS.oBackBuffer
            oStrRect = .graphics.MeasureString(;
                cStr, THIS.LabelFont)
    
            IF THIS.Axis = 0
                cTextWidth = MIN(THIS.GetStepSize(), oStrRect.rwidth)
    
                nX = nStepOffset - cTextWidth/2
                nY = THIS.GetScaleOtherPosition() - oStrRect.rheight - 10
                nWidth = cTextWidth
                nHeight = oStrRect.rheight
            ELSE
                cTextWidth = oStrRect.rwidth
    
                nX = THIS.GetScaleOtherPosition() - oStrRect.rwidth - 10
                nY = nStepOffset - oStrRect.rheight/2
                nWidth = cTextWidth
                nHeight = oStrRect.rheight
            ENDIF
    
            oFont = IIF(nIndex = THIS.CurStep,;
                THIS.LabelFontSelected, THIS.LabelFont)
    
            .graphics.DrawText(;
                cStr,;
                m.oFont,;
                nX, nY, nWidth, nHeight)
        ENDWITH
    
    PROCEDURE DrawScale
        LOCAL oRect
    
        WITH THIS.oBackBuffer
            oRect = THIS.GetScaleRectangle(1)
    
            .graphics.FillRectangle(;
                ColorToARGB(THIS.ScaleInsideColor),;
                oRect.rleft,;
                oRect.rtop,;
                oRect.rwidth,;
                oRect.rheight)
    
            oRect = THIS.GetScaleRectangle(2)
    
            .graphics.FillRectangle(;
                ColorToARGB(THIS.ScaleOutsideColor),;
                oRect.rleft,;
                oRect.rtop,;
                oRect.rwidth,;
                oRect.rheight)
        ENDWITH
    
    PROCEDURE DrawThumb
        LOCAL oRect, nBackColor, nBorderColor
        oRect = THIS.GetThumbRectangle()
    
        DO CASE
        CASE THIS.ThumbState = 0
            nBackColor = THIS.ThumbBackColor
            nBorderColor = THIS.ThumbBorderColor
        CASE THIS.ThumbState = 1
            nBackColor = THIS.ThumbPressedBackColor
            nBorderColor = THIS.ThumbPressedBorderColor
        CASE THIS.ThumbState = 2
            nBackColor = THIS.ThumbHoverBackColor
            nBorderColor = THIS.ThumbHoverBorderColor
        ENDCASE
    
        WITH THIS.oBackBuffer
            .graphics.FillRectangle(;
                ColorToARGB(nBackColor),;
                oRect.rleft,;
                oRect.rtop,;
                oRect.rwidth,;
                oRect.rheight)
    
            .graphics.DrawRectangle(;
                ColorToARGB(nBorderColor),;
                oRect.rleft,;
                oRect.rtop,;
                oRect.rwidth,;
                oRect.rheight)
        ENDWITH
    
    PROCEDURE DrawOnBackBuffer(lEnabled as Boolean)
        WITH THIS
            .InitBuffers
            .ClearBackBuffer
            .DrawScale
            .DrawGridValues
            .DrawThumb
            .ShowEnabled(lEnabled)
        ENDWITH
    
    PROCEDURE ShowEnabled(lEnabled as Boolean)
        IF m.lEnabled
            RETURN
        ENDIF
    
        WITH THIS.oBackBuffer
            .graphics.FillRectangle(;
                ARGB(255,255,255, 128),;
                THIS.BorderWidth,;
                THIS.BorderWidth,;
                .imgwidth - THIS.BorderWidth * 2 - 1,;
                .imgheight - THIS.BorderWidth * 2 - 1)
        ENDWITH
    
    ENDDEFINE
    

    User rating: 0/10 (0 votes)
    Rate this code sample:
    • ~
    12520 bytes  
    Created: 2013-12-27 16:10:50  
    Modified: 2014-01-14 09:40:57  
    Visits in 7 days: 136  
    Listed functions:
    Printer friendly API declarations
    Word Index links for this example:
    Translate this page:
      Spanish    Portuguese    German    French    Italian  
    FreeTranslation.com offers instant, free translations of text or web pages.
    User Contributed Notes:
    There are no notes on this subject.


    Copyright 2001-2018 News2News, Inc. Before reproducing or distributing any data from this site please ask for an approval from its owner. Unless otherwise specified, this page is for your personal and non-commercial use. The information on this page is presented AS IS, meaning that you may use it at your own risk. Microsoft Visual FoxPro and Windows are trade marks of Microsoft Corp. All other trademarks are the property of their respective owners. 

    Privacy policy
    Credits: PHP (4.4.9), an HTML-embedded scripting language, MySQL (5.6.38), the Open Source standard SQL database, AceHTML Freeware Version 4, freeware HTML Editor of choice.   Hosted by Korax Online Inc.
    Last Topics Visited (54.242.250.208)
    6 sec.Example: 'Winsock: sending email messages (SMTP, port 25)'
    13 sec.Function: 'DisconnectNamedPipe'
    18 sec.Function: 'DeleteFileTransacted'
    Function group: 'File Management'
    23 sec.All Functions
    29 sec.Function: 'GetPhysicalMonitorsFromHMONITOR'
    34 sec.Example: 'Windows Shell Icons displayed and exported to ICO files (Vista)'
    40 sec.Function: 'CeRegOpenKeyEx'
    Function group: 'Remote Application Programming (RAPI)'
    46 sec.Function: 'CryptDestroyKey'
    Function group: 'Cryptography Reference'
    51 sec.Solution: 'ContextMenu ActiveX Control'
    57 sec.Function: 'GetTextMetrics'
    Function group: 'Font and Text'
    Google
    Advertise here!