DLL Controls

[Michael Meeks]

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

[mark smit]

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).

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...

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!

[Michael Meeks]

Thanks Mark,

I sure will!

Regards

MWM


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

[Bob Houle]

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

------------------

[Michael Meeks]

Bob,

Change SetBackColor to SetBkColor
That should fix it!

Regards

MWM



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

[mark smit]

Oops!

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

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!

[Michael Meeks]

Mark,

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

Regards
MWM


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