Announcement

Collapse
No announcement yet.

Custom Control Code

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

  • Custom Control Code

    Below is the complete source for a superclassed control. It modifies the
    default behaviour of a standard system button in 3 ways. It sends two
    different messages to the parent with mouse UP and mouse DOWN and it will
    drag and drop with the right mouse button. This version is implemented
    in a DLL but it need not be, the code can be put directly into an EXE
    file.

    This could not be classed as complex code yet it allows the PowerBASIC
    programmer to do something that is different and original. There is no
    need to buy or wait for other peoples custom controls when you can "Roll
    your own". For vendors who write aftermarket add-ons, this technology is
    the basis of producing your own custom control library for your product
    range so that it has different and original features.

    The Declaration of the DLL function in the calling application.

    Code:
        DECLARE FUNCTION cButton lib "Cbutton.dll" ALIAS "cButton" _
                                     (hParent as LONG, txt$, _
                                      tx as LONG,ty as LONG, _
                                      wd as LONG,ht as LONG, _
                                      align as LONG,ID as LONG) as LONG
    The message processing code in the calling application to use it.

    Code:
          Case %WM_COMMAND
            Select Case wParam
              Case 500
              Select Case lParam
                Case 0
                  SetWindowText hWin,ByCopy "Button Down"
                Case 1
                  SetWindowText hWin,ByCopy "Button Up"
              End Select
            End Select
    
          Case %WM_CREATE
            hButn1& = cButton(hWin,"Test Button",10,10,100,25,2,500)
    The complete DLL code for the superclassed control. Make sure you build it
    with the name "cbutton.bas" so it matches the declaration.

    Code:
    ' ###########################################################################
      
          #COMPILE DLL
      
          GLOBAL DLLinstance as LONG      ' the DLLs instance handle
      
          GLOBAL lpButnProc&              ' subclass address
          GLOBAL hButn&                   ' global handle
          GLOBAL mFlag  as LONG           ' button down flag
          GLOBAL xDn    as LONG           ' x co-ordinate for WM_MOUSEDOWN
          GLOBAL yDn    as LONG           ' y co-ordinate for WM_MOUSEDOWN
      
        ' -----------------------------------
        ' set correct paths for include files
        ' -----------------------------------
          #INCLUDE "d:\pb6\winapi\win32api.inc"
      
    ' ###########################################################################
      
      FUNCTION LibMain(BYVAL hInst    AS LONG, _
                       BYVAL Reason   AS LONG, _
                       BYVAL Reserved AS LONG) EXPORT AS LONG
      
          LOCAL RetVal as LONG
      
          Select Case Reason
            Case %DLL_PROCESS_ATTACH
              DLLinstance = hInst     ' set global instance global
              RetVal = 1              ' needed so DLL will start
      
            ' -------------------
            ' uncomment if needed
            ' -------------------
            ' Case %DLL_PROCESS_DETACH
            
            ' Case %DLL_THREAD_ATTACH
            
            ' Case %DLL_THREAD_DETACH
            
          End Select
      
          FUNCTION = RetVal
      
      END FUNCTION
      
    ' ###########################################################################
      
      FUNCTION cButton ALIAS "cButton"(hParent as LONG, txt$, _
                                       tx as LONG,ty as LONG, _
                                       wd as LONG,ht as LONG, _
                                       align as LONG,ID as LONG) EXPORT as LONG
      
        ' -----------------------------------------------------
        ' hButn1& = cButton(hWin,"Button 1",10,10,100,25,2,500)
        ' -----------------------------------------------------
          Select Case align
            Case 1
              align = %BS_LEFT
            Case 2
              align = %BS_CENTER
            Case 3
              align = %BS_RIGHT
          End Select
      
          hButn& = CreateWindowEx(%WS_EX_LEFT, _
                              "BUTTON",ByCopy txt$, _
                              %WS_VISIBLE or %WS_CHILD or align, _
                              tx,ty,wd,ht, _
                              hParent,ID,DLLinstance,ByVal %NULL)
      
          lpButnProc& =SetWindowLong(hButn&,%GWL_WNDPROC,_
                                     ByVal CodePtr(ButnProc))
      
          FUNCTION = hButn&
      
      END FUNCTION
      
    ' ###########################################################################
      
      FUNCTION ButnProc(BYVAL hCtl as LONG, _
                        BYVAL Msg as LONG, _
                        BYVAL wParam as LONG, _
                        BYVAL lParam as LONG) EXPORT AS LONG
      
          LOCAL CtlID   as LONG
          LOCAL hParent as LONG
          LOCAL xPos    as LONG
          LOCAL yPos    as LONG
          LOCAL hDC     as LONG
          LOCAL bWd     as LONG
          LOCAL bHt     as LONG
          LOCAL Pt      as POINTL
          LOCAL Rct     as RECT
      
          Select Case Msg
            Case %WM_LBUTTONDOWN
              CtlID = GetDlgCtrlID(hCtl)
              hParent = GetParent(hCtl)
              Sendmessage hParent,%WM_COMMAND,CtlID,0
      
            Case %WM_LBUTTONUP
              CtlID = GetDlgCtrlID(hCtl)
              hParent = GetParent(hCtl)
              Sendmessage hParent,%WM_COMMAND,CtlID,1
      
            Case %WM_MOUSEMOVE
              If mFlag = 1 Then
      
                  ! mov edx, lParam     ' put lParam in edx
                  ! mov ax, dx          ' put loword of edx in ax
                  ! cwde                ' convert it to DWORD
                  ! mov xPos, eax       ' copy it to variable
                  ! rol edx, 16         ' rotate edx by 16 bits
                  ! mov ax, dx          ' put loword of edx in ax
                  ! cwde                ' convert it to DWORD
                  ! mov yPos, eax       ' copy it to variable
        
                  Pt.x = xPos
                  Pt.y = yPos
        
                  ClientToScreen hCtl, Pt
                  hParent = getParent(hCtl)
                  ScreenToClient hParent, Pt
        
                '<< move the window >>--------------------
      
                  GetWindowRect hCtl, Rct
                  bWd = Rct.nRight - Rct.nLeft
                  bHt = Rct.nBottom - Rct.nTop
      
                  MoveWindow hCtl,Pt.x - xDn,Pt.y - yDn,bWd,bHt,%TRUE
      
                  hDC = GetDC(hCtl)
                  SendMessage hCtl,%WM_PAINT,hDC,0
                  ReleaseDC hCtl,hDC
      
              End If
      
            Case %WM_RBUTTONDOWN
              SetCapture hCtl
                mFlag = 1
      
                  ! mov edx, lParam     ' put lParam in edx
                  ! mov ax, dx          ' put loword of edx in ax
                  ! cwde                ' convert it to DWORD
                  ! mov xDn, eax        ' copy it to variable
                  ! rol edx, 16         ' rotate edx by 16 bits
                  ! mov ax, dx          ' put loword of edx in ax
                  ! cwde                ' convert it to DWORD
                  ! mov yDn, eax        ' copy it to variable
      
            Case %WM_RBUTTONUP
              ReleaseCapture
              mFlag = 0
      
          End Select
      
        FUNCTION=CallWindowProc(ByVal lpButnProc&,hCtl,Msg,wParam,lParam)
      
      END FUNCTION
      
    ' ##########################################################################
    Regards,

    [email protected]
    hutch at movsd dot com
    The MASM Forum

    www.masm32.com

  • #2
    Great job Hutch! Thankyou for putting in the time to teach!!!
    I am not always the sharpest tool in the shed, but I certainly always try hard. Information like this is extremely helpful.

    Again, Many Thanks!
    Regards, Jules
    Best regards
    Jules
    www.rpmarchildon.com

    Comment


    • #3
      Thanks Hutch for such a clear example.

      I don't know whether many know of your ProStart, however, I used
      it just now to make the following application to test the
      cButton.dll. The whole exercise took less than a minute.

      Here is the code (Header.inc is commented at the start):-
      Code:
       'HEADER.INC
        ' Comment out exclusion for required control
      
      '    %NOANIMATE    = 1
      '    %NOBUTTON     = 1
      '    %NOCOMBO      = 1
      '    %NODRAGLIST   = 1
      '    %NOHEADER     = 1
      '    %NOIMAGELIST  = 1
      '    %NOLISTVIEW   = 1
      '    %NOLIST       = 1
      '    ' %NOSTATUSBAR  = 1
      '    %NOTABCONTROL = 1
      '    %NOTOOLBAR    = 1
      '    %NOTOOLTIPS   = 1
      '    %NOTRACKBAR   = 1
      '    %NOTREEVIEW   = 1
      '    %NOUPDOWN     = 1
      '    %NOREBAR      = 1
      '    %NOEDIT       = 1
      '    %NOCOMBOEX    = 1
      '
      '    %NOPRINTDLG   = 1
      
      '    #INCLUDE "d:\pbdll60\winapi\WIN32API.INC"
      '  '  #INCLUDE "d:\pbdll60\winapi\Comdlg32.inc"
      '    #INCLUDE "d:\pbdll60\winapi\Commctrl.inc"
      '
      '    #RESOURCE "tstctrl.pbr"
      
      '    GLOBAL hInstance   AS LONG
      '    GLOBAL hWnd        AS LONG
      '    GLOBAL Sw&
      '    GLOBAL Sh&
      '    GLOBAL DisplayName$
      '    GLOBAL hMnu&
      '    GLOBAL hStatus     AS LONG
      '
      'DECLARE SUB Paint_Proc(hWin AS LONG,hDC AS LONG)
      
      'END OF HEADER.INC
      '##########################################################################
       
          $COMPILE EXE
      
          $INCLUDE "HEADER.INC"
      
      DECLARE FUNCTION cButton LIB "Cbutton.dll" ALIAS "cButton" _
                                       (hParent AS LONG, txt$, _
                                        tx AS LONG,ty AS LONG, _
                                        wd AS LONG,ht AS LONG, _
                                        align AS LONG,ID AS LONG) AS LONG
                                        
      '##########################################################################
       
      FUNCTION WINMAIN(BYVAL Instance      AS LONG, _
                       BYVAL hPrevInstance AS LONG, _
                       lpszCmdLine         AS ASCIIZ PTR, _
                       BYVAL nCmdShow      AS LONG) AS LONG
      
          LOCAL  Msg            AS tagMsg
          LOCAL  wndclass       AS WNDCLASSEX
          LOCAL  szClassName    AS ASCIIZ * 32
          LOCAL  Wid&
          LOCAL  Hgt&
          LOCAL  x&
      
          hInstance=Instance
          DisplayName$= "New Project"
      
          InitCommonControls
      
          szClassName = "Project_Class"
      
          wndclass.cbSize        = SIZEOF(wndclass)
          wndclass.style         = %CS_HREDRAW OR %CS_VREDRAW OR _
                                   %CS_BYTEALIGNCLIENT OR %CS_BYTEALIGNWINDOW
          wndclass.lpfnWndProc   = CODEPTR(WndProc)
          wndclass.cbClsExtra    = 0
          wndclass.cbWndExtra    = 0
          wndclass.hInstance     = hInstance
          wndclass.hIcon         = LoadIcon(hInstance,BYVAL 1)
          wndclass.hCursor       = LoadCursor(%NULL,BYVAL %IDC_ARROW)
          wndclass.hbrBackground = %COLOR_BTNFACE + 1
          wndclass.lpszMenuName  = %NULL
          wndclass.lpszClassName = VARPTR(szClassName)
          wndclass.hIconSm       = LoadIcon(hInstance,BYVAL 1)
      
          RegisterClassEx wndclass
      
          Sw&=GetSystemMetrics(%SM_CXSCREEN)
          Sh&=GetSystemMetrics(%SM_CYSCREEN)
      
          Wid& = Sw& * .75   ' Set width & Height to percentage of screen size.
          Hgt& = Sh& * .70
      
          ' Wid& = 300    ' For fixed width
          ' Hgt& = 300    ' For fixed height
      
         '-------------------------
         ' Window is self centering
         '-------------------------
      
          hWnd = CreateWindowEx(%WS_EX_OVERLAPPEDWINDOW, _
                              szClassName, _           ' window class name
                              BYCOPY DisplayName$, _   ' window title
                              %WS_OVERLAPPEDWINDOW, _  ' window style
                              Sw&\2-(Wid&\2), _        ' initial x position
                              Sh&\2-(Hgt&\2), _        ' initial y position
                              Wid&, _                  ' initial x size
                              Hgt&, _                  ' initial y size
                              %NULL, _                 ' parent window handle
                              %NULL, _                 ' window menu handle
                              hInstance, _             ' program instance handle
                              BYVAL %NULL)             ' creation parameters
      
         '-------------------------
      
          hMnu&=LoadMenu( hInstance,BYVAL 10)
          SetMenu hWnd, hMnu&
      
          hStatus=CreateStatusWindow(%WS_CHILD OR %WS_VISIBLE OR _
                                     %SBS_SIZEGRIP,"", hWnd, 200)
      
          ShowWindow hWnd, nCmdShow
          UpdateWindow hWnd
      
          MsgLoop:
              x&=GetMessage(Msg,%NULL,0,0)
              TranslateMessage Msg
              DispatchMessage  Msg
            ! cmp x&, 0
            ! je MsgOut
            ! jmp MsgLoop
          MsgOut:
      
        FUNCTION = Msg.wParam
      
      END FUNCTION
       
      '##########################################################################
       
      FUNCTION WndProc(BYVAL hWin   AS LONG, _
                       BYVAL Msg    AS LONG, _
                       BYVAL wParam AS LONG, _
                       BYVAL lParam AS LONG) EXPORT AS LONG
      
            LOCAL hDC       AS LONG
            LOCAL Ps        AS PaintStruct
            LOCAL Rct       AS Rect
      
        SELECT CASE Msg
      
            CASE %WM_COMMAND
              SELECT CASE wParam
                CASE 1098
                  SendMessage hWin,%WM_SYSCOMMAND,%SC_CLOSE,BYVAL %NULL
      
                CASE 1099
                x&=ShellAbout(hWin,BYCOPY "  About "+DisplayName$+"#Windows Template",_
                              BYCOPY DisplayName$+" Copyright © 1999"+CHR$(13,10)+_
                              "Your Name Email Address etc...",_
                              LoadIcon(hInstance,BYVAL 1))
      
      '      CASE %WM_COMMAND
      '        SELECT CASE wParam
                CASE 500
                SELECT CASE lParam
                  CASE 0
                    SetWindowText hWin,BYCOPY "Button Down"
                  CASE 1
                    SetWindowText hWin,BYCOPY "Button Up"
                END SELECT
              END SELECT
      '      CASE %WM_CREATE
      '        hButn1& = cButton(hWin,"Test Button",10,10,100,25,2,500)
      '        END SELECT
      
            CASE %WM_CREATE
              hButn1& = cButton(hWin,"Test Button",10,10,100,25,2,500)
      
            CASE %WM_SIZE
              GetWindowRect hStatus,Rct
              sbh&=Rct.nBottom - Rct.nTop
      
              caW&=LOWRD(lParam)
              caH&=HIWRD(lParam)
      
              MoveWindow hStatus, 0,caH&-sbh&,caW&,caH&,%TRUE
              FUNCTION=0
              EXIT FUNCTION
        
            CASE %WM_PAINT
              hDC = BeginPaint(hWin,Ps)
                GetClientRect hWin,Rct
                Paint_Proc hWin,hDC
              EndPaint hWin,Ps
              FUNCTION=0
              EXIT FUNCTION
      
            CASE %WM_CLOSE
      
            CASE %WM_DESTROY
                PostQuitMessage 0
                FUNCTION=0
                EXIT FUNCTION
      
        END SELECT
      
        FUNCTION = DefWindowProc(hWin,Msg,wParam,lParam)
      
      END FUNCTION
       
      '##########################################################################
       
      SUB Paint_Proc(hWin AS LONG,hDC AS LONG)
      
          ' This SUB is for any screen graphics
      
      END SUB
       
      '##########################################################################
       
      The Rc file is :-
       
      #include "d:\pbdll60\winapi\resource.h"
      
      1 ICON MOVEABLE PURE LOADONCALL DISCARDABLE "tstctrl.ico"
      
      10	MENUEX MOVEABLE IMPURE LOADONCALL DISCARDABLE
      BEGIN
          POPUP "&File", , , 0
          BEGIN
              MENUITEM "&Exit", 1098
          END
          POPUP "&Help", , , 0
          BEGIN
              MENUITEM "&About", 1099
          END
      END
      ------------------

      Comment

      Working...
      X