Caption Bar Custom Control

Here is a fun project.

This is a custom control I call a Caption Bar Control.

You can put it above any other control and it will respond to mouse clicks and toggle the active state of the caption bar.

Here is the include file:

capctrl.inc

Code:

' -------------------------------------------------------------------------------------------
' Copyright Christopher R. Boss, 2000
' Alls Rights Reserved
' This code may be used ROYALTY FREE !
' You may use this code in any commercial application
' freely. You may also distribute the code to others
' and may post it on a web site for others to use,
' as long as the copyright is left in the code.
' -------------------------------------------------------------------------------------------
' -------------------------------------------------------------------------------------------
' Custom Class ControlClass Constants and Types
' -------------------------------------------------------------------------------------------
%ControlClassExtraData = 6 ' # of Extra Data Items (Long) for All Custom Window Classes
' Data Items will be indexed from 1 in GetControlData function
' -------------------------------------------------------------------------------------------
$ControlClassName = "CAPCTRL32"
' -------------------------------------------------------------------------------------------

%WM_MYCOLOR = %WM_CTLCOLORSTATIC

' -------------------------------------------------------------------------------------------
' Universal Global Variables
' -------------------------------------------------------------------------------------------

' -------------------------------------------------------------------------------------------
' EZGUI Custom Control Library Declares
' -------------------------------------------------------------------------------------------
DECLARE FUNCTION GetControlLong(BYVAL hWnd AS LONG, BYVAL N&) AS LONG
DECLARE SUB SetControlLong(BYVAL hWnd AS LONG, BYVAL N&, BYVAL V&)

' -------------------------------------------------------------------------------------------
' Custom Control Control Class Declares
' -------------------------------------------------------------------------------------------
DECLARE SUB RegisterControlClass()
DECLARE SUB ControlClassPaint(BYVAL hWnd AS LONG)
DECLARE SUB ControlClassDraw(BYVAL hWnd AS LONG)
DECLARE SUB BuildBitmap(BYVAL hWnd AS LONG, BYVAL CFlag&)

' -------------------------------------------------------------------------------------------
' -------------------------------------------------------------------------------------------

%CP_CUSTOM_MESSAGE = %WM_USER+100
%CP_GETSTATE = %WM_USER+101

' -------------------------------------------------------------------------------------------
' DLL Entrance - LibMain
' -------------------------------------------------------------------------------------------

FUNCTION LIBMAIN(BYVAL hInstance AS LONG, _
BYVAL fwdReason AS LONG, _
BYVAL lpvReserved AS LONG) EXPORT AS LONG
SELECT CASE fwdReason
CASE %DLL_PROCESS_ATTACH ' =1 - Where DLL starts
RegisterControlClass
CASE %DLL_THREAD_ATTACH
CASE %DLL_THREAD_DETACH
CASE %DLL_PROCESS_DETACH ' =0 - Where DLL exits
CASE ELSE
END SELECT
LIBMAIN=1
END FUNCTION

' -------------------------------------------------------------------------------------------
' Custom Control ControlClass Functions / Subs
' -------------------------------------------------------------------------------------------
SUB RegisterControlClass()
LOCAL windowclass AS WndClassEx
LOCAL szClassName AS ASCIIZ * 80
szClassName = $ControlClassName+CHR$(0)
windowclass.cbSize = SIZEOF(windowclass)
windowclass.style = %CS_HREDRAW OR %CS_VREDRAW OR %CS_PARENTDC OR %CS_DBLCLKS
windowclass.lpfnWndProc = CODEPTR(ControlClassWndProc)
windowclass.cbClsExtra = 0
windowclass.cbWndExtra = %ControlClassExtraData*4
windowclass.hInstance = GetModuleHandle(BYVAL %NULL)
windowclass.hIcon = %NULL
windowclass.hCursor = LoadCursor( %NULL, BYVAL %IDC_ARROW )
windowclass.hbrBackground = GetStockObject( %WHITE_BRUSH )
windowclass.lpszMenuName = %NULL
windowclass.lpszClassName = VARPTR( szClassName )
windowclass.hIconSm = %NULL
RegisterClassEx windowclass
END SUB

' -------------------------------------------------------------------------------------------
SUB DefTrueSize(BYVAL hWnd&, AY&, ACY&)
LOCAL AWS&, AH&
AWS&=GetWindowLong(hWnd&, %GWL_EXSTYLE) AND %WS_EX_TOOLWINDOW
IF AWS&=%WS_EX_TOOLWINDOW THEN
AH&=GetSystemMetrics(%SM_CYSMCAPTION)
ELSE
AH&=GetSystemMetrics(%SM_CYCAPTION)
END IF

AY&=(AY&+ACY&)-AH&
ACY&=AY&+AH&-1
END SUB

FUNCTION GetTrueTop(BYVAL hWnd&, BYVAL Y2&) AS LONG
LOCAL AWS&, AH&
AWS&=GetWindowLong(hWnd&, %GWL_EXSTYLE) AND %WS_EX_TOOLWINDOW
IF AWS&=%WS_EX_TOOLWINDOW THEN
AH&=GetSystemMetrics(%SM_CYSMCAPTION)
ELSE
AH&=GetSystemMetrics(%SM_CYCAPTION)
END IF
FUNCTION=Y2&-AH&
END FUNCTION

FUNCTION GetHeight(BYVAL hWnd&) AS LONG
LOCAL AWS&, AH&
AWS&=GetWindowLong(hWnd&, %GWL_EXSTYLE) AND %WS_EX_TOOLWINDOW
IF AWS&=%WS_EX_TOOLWINDOW THEN
AH&=GetSystemMetrics(%SM_CYSMCAPTION)
ELSE
AH&=GetSystemMetrics(%SM_CYCAPTION)
END IF
AH&=AH&+GetSystemMetrics(%SM_CYDLGFRAME)
FUNCTION=AH&
END FUNCTION

FUNCTION ControlClassWndProc(BYVAL hWnd AS LONG, _
BYVAL Msg AS LONG, _
BYVAL wParam AS LONG, _
BYVAL lParam AS LONG) EXPORT AS LONG

LOCAL RV&, hParent AS LONG

' If message is processed then set FUNCTION=0 and then EXIT FUNCTION

SELECT CASE Msg
CASE %WM_SIZE
IF GetControlLong(hWnd,6)=0 THEN
SetControlLong hWnd,6,1
FUNCTION = DefWindowProc(hWnd,Msg,wParam,lParam)
DIM R AS RECT
GetWindowRect hWnd,R
R.nTop=R.nBottom-GetHeight(hWnd)
ScreenToClient GetParent(hWnd), BYVAL VARPTR(R)
ScreenToClient GetParent(hWnd), BYVAL VARPTR(R)+8
MoveWindow hWnd, R.nLeft, R.nTop, R.nRight-R.nLeft, R.nBottom-R.nTop, 1
SetControlLong hWnd,6,0
EXIT FUNCTION
END IF
' CASE %WM_WINDOWPOSCHANGING
' DIM WP AS WINDOWPOS PTR, AH&, AY&, AWS&
' WP=lParam
' DefTrueSize hWnd, @WP.y, @WP.cy
' @WP.flags=@WP.flags or %SWP_DRAWFRAME
' case %WM_NCCALCSIZE
' dim RR as RECT ptr, AH&
' RR=lParam
' @RR.nTop=GetTrueTop(hWnd&, @RR.nBottom)
CASE %WM_CREATE
DIM CS AS CREATESTRUCT PTR, WS&, EXS&, WP2 AS WINDOWPOS
CS=lParam
WS&=@CS.style
EXS&=@CS.dwExStyle
WS&=WS& AND (%WS_CHILD OR %WS_VISIBLE OR %WS_CLIPSIBLINGS OR %WS_CLIPCHILDREN OR %WS_SYSMENU)
WS&=WS& OR %WS_CAPTION
@CS.style=WS&
EXS&=EXS& AND %WS_EX_TOOLWINDOW
@CS.dwExStyle=EXS&
SetWindowLong hWnd, %GWL_STYLE, WS&
SetWindowLong hWnd, %GWL_EXSTYLE, EXS&
CASE %WM_NCHITTEST
FUNCTION=%HTCLIENT
EXIT FUNCTION
CASE %WM_LBUTTONDOWN
IF GetControlLong(hWnd,5)=0 THEN
SetControlLong hWnd,5,1
SendMessage hWnd, %WM_NCACTIVATE, 1,0
ELSE
SetControlLong hWnd,5,0
SendMessage hWnd, %WM_NCACTIVATE, 0,0
END IF
hParent=GetParent(hWnd)
IF hParent<>0 THEN
' Uses the Standard Static control message
SendMessage hParent, %WM_COMMAND,MAKLNG(GetWindowLong(hWnd,%GWL_ID),%STN_CLICKED), hWnd
END IF
FUNCTION=0
EXIT FUNCTION
CASE %WM_LBUTTONDOWN
FUNCTION=0
EXIT FUNCTION
CASE %CP_CUSTOM_MESSAGE
CASE %CP_GETSTATE
FUNCTION=GetControlLong(hWnd,5)
EXIT FUNCTION
CASE %WM_PAINT
CASE %WM_ERASEBKGND
' -----------------------------------------------------------
CASE %WM_SETCURSOR
CASE %WM_LBUTTONDBLCLK
hParent=GetParent(hWnd)
IF hParent<>0 THEN
' Uses the Standard Static control message
SendMessage hParent, %WM_COMMAND, MAKLNG(GetWindowLong(hWnd,%GWL_ID),%STN_DBLCLK), hWnd
END IF
CASE %WM_DESTROY
CASE ELSE
END SELECT

FUNCTION = DefWindowProc(hWnd,Msg,wParam,lParam)

END FUNCTION

' -------------------------------------------------------------------------------------------
' EZGUI Custom Control Library
' -------------------------------------------------------------------------------------------

FUNCTION GetControlLong(BYVAL hWnd AS LONG, BYVAL N&) AS LONG
LOCAL I&, RV&
RV&=0
IF N&>=1 AND N&<=%ControlClassExtraData THEN
I&=(N&-1)*4
IF IsWindow(hWnd) THEN
RV&=GetWindowLong(hWnd, I&)
END IF
END IF
FUNCTION=RV&
END FUNCTION

' -------------------------------------------------------------------------------------------

SUB SetControlLong(BYVAL hWnd AS LONG, BYVAL N&, BYVAL V&)
LOCAL I&
IF N&>=1 AND N&<=%ControlClassExtraData THEN
I&=(N&-1)*4
IF IsWindow(hWnd) THEN
SetWindowLong hWnd, I&, V&
END IF
END IF
END SUB

' -------------------------------------------------------------------------------------------

Here is a sample DDT program which uses the control:

Code:

' ***************************************************************
' This code can be used Royalty Free and Freely Distributed !
' ***************************************************************

#COMPILE EXE
#REGISTER NONE
#DIM ALL ' This is helpful to prevent errors in coding

#INCLUDE "win32api.inc" ' Must come first before other include files !
' *************************************************************
' Constants and Declares (#1)
' *************************************************************
#INCLUDE "capctrl.inc"

DECLARE SUB LIB_InitFonts()
DECLARE SUB LIB_InitColors()
DECLARE SUB LIB_DeleteBrushes()

' --------------------------------------------------
DECLARE SUB ShowDialog_Form1(BYVAL hParent&)
DECLARE CALLBACK FUNCTION Form1_DLGPROC
' --------------------------------------------------
' ------------------------------------------------

' *************************************************************
' Application Globals Variables (#2)
' *************************************************************

GLOBAL App_Brush&()
GLOBAL App_Color&()
GLOBAL App_Font&()

GLOBAL hForm1& ' Dialog handle

' *************************************************************
' Application Entrance
' *************************************************************

FUNCTION PBMAIN
LOCAL Count&
LIB_InitColors
LIB_InitFonts
' -----------------------
RegisterControlClass ' must register the new class
' -----------------------
ShowDialog_Form1 0
DO
DIALOG DOEVENTS TO Count&
LOOP UNTIL Count&=0

LIB_DeleteBrushes
END FUNCTION

' *************************************************************
' Application Dialogs (#3)
' *************************************************************

SUB ShowDialog_Form1(BYVAL hParent&)
LOCAL Style&, ExStyle&
LOCAL N&, CT& ' Variables used for Reading Data in Arrays for Listbox and Combobox
' hParent& = 0 if no parent Dialog
Style& = %WS_POPUP OR %DS_MODALFRAME OR %WS_CAPTION OR %WS_MINIMIZEBOX OR %WS_SYSMENU OR %DS_CENTER
ExStyle& = 0
DIALOG NEW hParent&, "Your Dialog", 0, 0, 400, 170, Style&, ExStyle& TO hForm1&
CONTROL ADD "CAPCTRL32", hForm1&, 100, "Click me!", 20, 20, 160, 20, %WS_CHILD OR %WS_VISIBLE CALL MyCtrnFunc
CONTROL ADD "CAPCTRL32", hForm1&, 101, "Click me too!", 200, 20, 160, 20, %WS_CHILD OR %WS_VISIBLE CALL MyCtrnFunc
CONTROL ADD LABEL , hForm1&, 900, "I am a placeholder", 20,40,160,120, %WS_VISIBLE OR %SS_CENTER OR %SS_CENTERIMAGE OR %WS_BORDER
CONTROL ADD LABEL , hForm1&, 901, "I am a placeholder", 200,40,160,120, %WS_VISIBLE OR %SS_CENTER OR %SS_CENTERIMAGE OR %WS_BORDER
CONTROL SET COLOR hForm1&, 900, RGB(0,0,0), RGB(128,128,128)
CONTROL SET COLOR hForm1&, 901, RGB(0,0,0), RGB(128,128,128)
DIALOG SHOW MODELESS hForm1& , CALL Form1_DLGPROC
END SUB

' *************************************************************
' Dialog Callback Procedure
' for Form Form1
' uses Global Handle - hForm1&
' *************************************************************
CALLBACK FUNCTION MyCtrnFunc AS LONG
IF CB.CTLMSG=%STN_CLICKED THEN
' this handles both custom controls
LOCAL ID&, ST&
ID&=CB.CTL
CONTROL SEND hForm1&, ID&, %CP_GETSTATE,0,0 TO ST&
ID&=ID&+800 ' ID of companion label controls
IF ST&=0 THEN
CONTROL SET COLOR hForm1&, ID&, RGB(0,0,0), RGB(128,128,128)
CONTROL REDRAW hForm1&, ID&
ELSE
CONTROL SET COLOR hForm1&, ID&, RGB(0,0,255), RGB(128,128,255)
CONTROL REDRAW hForm1&, ID&
END IF
END IF
END FUNCTION

CALLBACK FUNCTION Form1_DLGPROC
SELECT CASE CBMSG
CASE ELSE
END SELECT
END FUNCTION

' *******************************************************************
' * Library Code *
' ********************************************************************

SUB LIB_InitFonts()
REDIM App_Font(0 TO 5)
App_Font(0)=GetStockObject(%SYSTEM_FONT)
App_Font(1)=GetStockObject(%SYSTEM_FIXED_FONT)
App_Font(2)=GetStockObject(%ANSI_VAR_FONT)
App_Font(3)=GetStockObject(%ANSI_FIXED_FONT)
App_Font(4)=GetStockObject(%DEFAULT_GUI_FONT) ' MS Sans Serif
App_Font(5)=GetStockObject(%OEM_FIXED_FONT) ' Terminal Font
' Fonts 0 to 5 do not need to be deleted since they are System Fonts
END SUB

' -------------------------------------------------------------

SUB LIB_InitColors()
DATA 0, 8388608, 32768, 8421376, 196, 8388736, 16512, 12895428
DATA 8421504, 16711680, 65280, 16776960, 255, 16711935, 65535, 16777215
DATA 10790052, 16752768, 10551200, 16777120, 10526975, 16752895, 10551295, 13948116
DATA 11842740, 16768188, 14483420, 16777180, 14474495, 16768255, 14483455, 15000804
LOCAL T&, RGBVal&
REDIM App_Brush&(0 TO 31)
REDIM App_Color&(0 TO 31)
FOR T&=0 TO 31
RGBVal&=VAL(READ$(T&+1))
App_Brush&(T&)=CreateSolidBrush(RGBVal&)
App_Color&(T&)=RGBVal&
NEXT T&
END SUB

' -------------------------------------------------------------

SUB LIB_DeleteBrushes()
LOCAL T&
FOR T&=0 TO 31
DeleteObject App_Brush&(T&)
NEXT T&
END SUB

' -------------------------------------------------------------

' *************************************************************
' Application Callback Functions (or Subs) for Controls (#4)
' *************************************************************

' *************************************************************
' Other Common Procedures and Functions
' *************************************************************

Notice the control generates the %STN_CLICKED notification message just like a Label control does.
You can process it in the controls callback function.

It also has a message %CP_GETSTATE which allows you to get the current state of the control (active or inactive).

Have fun.

Enjoy!