Announcement

Collapse
No announcement yet.

DLL Controls

Collapse
X
 
  • Filter
  • Time
  • Show
Clear All
new posts

  • DLL Controls

    Hi,

    I downloaded source-code a week or so ago. The label control was
    turned into a hyperlink, so when clicked it would either take you
    to a site, or popup your email client...etc.

    However, many or all of the examples on this site are for exe's.
    Are there any dll's control examples, or is someone willing to show
    us what the main difference is, beside having a program call the
    dll?

    Any info would be appreciate, or posted simple example would stop
    me from beating my brains against the wall. So close, but yet so far
    away! heard that song before!

    Regards
    MWM


    ------------------
    mwm
    mwm

  • #2
    Hello Michael,

    Give this example a try. Make sure you save each of the two files as there proper name (Button32.bas and ButtonTest.bas).


    Code:
    rem 
    rem Button32.bas  ****MAKE SURE YOU SAVE THE FILE AS THIS NAME****
    rem This files creates the Button32.dll
    rem 
    #compile dll
    #register none
    #include "win32api.inc"
     
     
     
    %MAXTEXT            = 2048
    %MAXCLASS           = 32
    %FONTSIZE           = 14
    %GWL_POINTER        = 0
     
     
     
     
    type BUTTONSTRUCT
        rgbText     as long
        rgbBack     as long
        lPressed    as long
    end type
     
     
     
     
    rem function declares
    declare function RegisterClasses(byval hInstance as long) as long
    declare function UnregisterClasses(byval hInstance as long) as long
    declare sub InitButton32
     
     
     
    sub InitButton32 export
        rem stub subroutine
    end sub
     
     
     
    rem main dll entry point
    function LibMain(byval hInstance as long,byval fwdReason as long,byval lpvReserved as long) export as long
        select case (fwdReason)
            case %DLL_PROCESS_ATTACH:function = RegisterClasses(hInstance)
            case %DLL_PROCESS_DETACH:function = UnregisterClasses(hInstance)
            case %DLL_THREAD_ATTACH
            case %DLL_THREAD_DETACH
        end select
    end function
     
     
     
    rem register custom class
    function RegisterClasses(byval hInstance as long) as long
        local szClass as asciiz * %MAXCLASS
        local wcex as WNDCLASSEX
     
     
        rem setup class name
        szClass = "Button32"
     
     
        rem setup class structure
        wcex.cbSize = len(WNDCLASSEX)
        wcex.style = %CS_HREDRAW or %CS_VREDRAW or %CS_GLOBALCLASS
        wcex.lpfnWndProc = codeptr(ButtonProc)
        wcex.cbClsExtra = 0
        wcex.cbWndExtra = 4
        wcex.hInstance = hInstance
        wcex.hIcon = %NULL
        wcex.hIconSm = %NULL
        wcex.hCursor = LoadCursor(%NULL,byval %IDC_ARROW)
        wcex.hbrBackground = %COLOR_APPWORKSPACE
        wcex.lpszClassName = varptr(szClass)
        wcex.lpszMenuName = %NULL
     
     
        rem register control class
        function = RegisterClassEx(wcex)
    end function
     
     
     
     
     
    rem unregister custom class
    function UnregisterClasses(byval hInstance as long) as long
        rem unregister control classes
        UnregisterClass "Button32",hInstance
     
        rem success
        function = %TRUE
    end function
     
     
     
     
    rem custom control handler
    function ButtonProc(byval hWnd as long,byval message as long,byval wParam as long,byval lParam as long) export as long
        local lpButton as BUTTONSTRUCT ptr
        local szText as asciiz * %MAXTEXT
        local hFont as long
        local ps as PAINTSTRUCT
        local rc as RECT
        local hDC as long
     
     
     
        rem setup button struct pointer
        lpButton = GetWindowLong(hWnd,%GWL_POINTER)
     
     
        select case (message)
            case %WM_CREATE:
                rem allocate button memory
                lpButton = GlobalAlloc(%GPTR,len(BUTTONSTRUCT))
     
                if (lpButton) then
                    rem store memory pointer
                    SetWindowLong hWnd,%GWL_POINTER,lpButton
     
                    rem setup defaults
                    @lpButton.rgbText = GetSysColor(%COLOR_BTNTEXT)
                    @lpButton.rgbBack = GetSysColor(%COLOR_BTNFACE)
                    @lpButton.lPressed = %FALSE
                end if
     
     
            case %WM_DESTROY:
                if (lpButton) then
                    rem release memory
                    GlobalFree lpButton
                end if
     
     
            case %WM_LBUTTONDOWN:
                if (lpButton) then
                    SetFocus hWnd
                    SetCapture hWnd
     
                    @lpButton.lPressed = %TRUE
                    InvalidateRect hWnd,byval %NULL,%FALSE
                end if
     
     
            case %WM_LBUTTONUP:
                if (lpButton) then
                    ReleaseCapture
                    @lpButton.lPressed = %FALSE
                    SendMessage GetParent(hWnd),%WM_COMMAND,maklng(GetWindowLong(hWnd,%GWL_ID),%BM_CLICK),hWnd
                    InvalidateRect hWnd,byval %NULL,%TRUE
                end if
     
     
            case %WM_SETFOCUS:
                if (lpButton) then
                    @lpButton.rgbText = rgb(0,0,255)
                    @lpButton.rgbBack = GetSysColor(%COLOR_BTNFACE)
                    InvalidateRect hWnd,byval %NULL,%FALSE
                end if
     
     
            case %WM_KILLFOCUS:
                if (lpButton) then
                    @lpButton.lPressed = %FALSE
                    @lpButton.rgbText = GetSysColor(%COLOR_BTNTEXT)
                    @lpButton.rgbBack = GetSysColor(%COLOR_BTNFACE)
                    InvalidateRect hWnd,byval %NULL,%FALSE
                end if
     
     
            case %WM_PAINT:
                if (lpButton) then
                    hDC = BeginPaint(hWnd,ps)
                    'hFont = GetStockObject(%ANSI_VAR_FONT)
                    hFont = CreateFont(%FONTSIZE,0,0,0,%FW_BOLD,%FALSE,%FALSE,%FALSE,%ANSI_CHARSET,%OUT_DEFAULT_PRECIS,%CLIP_DEFAULT_PRECIS,%PROOF_QUALITY,%DEFAULT_PITCH,"Arial")
                    hFont = SelectObject(hDC,hFont)
     
                    GetWindowText hWnd,szText,sizeof(szText)
                    GetClientRect hWnd,rc
     
                    SetBackColor hDC,@lpButton.rgbBack
                    SetTextColor hDC,@lpButton.rgbText
     
                    FillRect hDC,rc,GetSysColorBrush(%COLOR_BTNFACE)
     
     
                    if (@lpButton.lPressed) then
                        rem button pressed
                        DrawEdge hDC,rc,%BDR_SUNKENOUTER,%BF_ADJUST or %BF_RECT
                    else
                        rem button released
                        DrawEdge hDC,rc,%BDR_RAISEDINNER,%BF_ADJUST or %BF_RECT
                    end if
     
                    DrawText hDC,szText,len(szText),rc,%DT_CENTER or %DT_SINGLELINE or %DT_VCENTER
     
                    hFont = SelectObject(hDC,hFont)
                    DeleteObject hFont
                    EndPaint hWnd,ps
                    exit function
                end if
        end select
     
        rem call default window procedure
        function = DefWindowProc(hWnd,message,wParam,lParam)
    end function

    And here is the test program...
    Code:
    rem 
    rem ButtonTest.bas ****MAKE SURE YOU SAVE THE FILE AS THIS NAME****
    rem This code will test the button32.dll
    rem 
    #compile exe
    #include "win32api.inc"
     
     
    rem declare functions
    declare sub InitButton32 lib "button32.dll"
     
    rem equates
    %IDC_CLOSE = 100
    %IDC_SEND = 101
     
     
    callback function DlgProc as long
        select case cbmsg
            case %WM_COMMAND:
                select case hiwrd(cbwparam)
                    case %BM_CLICK:
                        select case lowrd(cbwparam)
                            case %IDC_CLOSE:SetWindowText cbhndl,"Close"
                            case %IDC_SEND:SetWindowText cbhndl,"Send"
                        end select
                end select
     
        end select
    end function
     
     
    function pbmain as long
        dim hDlg as long
     
    
        InitButton32
     
        dialog new 0,"Button Test",0,0,268,148,%DS_CENTER or %WS_CAPTION or %WS_SYSMENU, %WS_EX_TOOLWINDOW to hDlg
        control add "Button32",hDlg,%IDC_CLOSE,"Close",4,4,40,12,%WS_TABSTOP or %WS_CHILD or %WS_VISIBLE
        control add "Button32",hDlg,%IDC_SEND,"Send",4,16,40,12,%WS_TABSTOP or %WS_CHILD or %WS_VISIBLE
        dialog show modal hDlg call DlgProc
    end function
    ------------------
    Cheers!

    Comment


    • #3
      Thanks Mark,

      I sure will!

      Regards

      MWM


      ------------------
      mwm
      mwm

      Comment


      • #4
        Mark,
        Great example!

        Just a small glitch, the DLL won't compile...
        line 183
        the SetBackColor function needs to be changed to SetBkColor

        Regards,
        --Bob

        ------------------
        "It was too lonely at the top".

        Comment


        • #5
          Bob,

          Change SetBackColor to SetBkColor
          That should fix it!

          Regards

          MWM



          ------------------
          mwm
          mwm

          Comment


          • #6
            Oops!

            sorry about that guys... I made a wrapper function for that just so the two would line up and look nice and readable.

            Code:
            function SetBackColor(byval hDC as long,byval crColor as long) as long
                function = SetBkColor(hDC,crColor)
            end function
             
             
            SetBackColor hDC,&H00FFFFFF
            SetTextColor hDC,&h00000000

            I hope you know what I mean by that


            ------------------
            Cheers!

            Comment


            • #7
              Mark,

              Bob, Sorry...read your lines to quickly,
              Mark, Appreciate the source- thanks a bunch!

              Regards
              MWM


              ------------------
              mwm
              mwm

              Comment

              Working...
              X