Hello All
Another new program where you can display your own customized title bar, in a dialog,
Great Thanxx to inputs from Charles and Roland to make this program happen
' Subclassing Textbox in a Dialog with a Customized Title bar
' CustomTitleDemo.o2bas
' Updated Dec 4 2018
$ filename "CustomTitleDemo.exe"
uses rtl64
'% review
uses O2Common
uses dialogs
uses O2CustTitle
' for the custom title bar ----------------------------------------------
' title bar height
TitBarHt = 24
' title bar background and text colours
TitBarColor = O2c_cyan
TitTxtColor = O2c_Dark_Green
' title bar string
TitStr = "Best New Title"
AdjFacX = -50
' Create a new font for the custom Title bar
hTitBarFont = O2ApiCreateFont("Tahoma", 15, FW_BOLD)
' Main window width
MwWidth = 252
' Main window top left point
MwTopleft = 100
'Identifiers
% IDC_EDIT1 = 1001
% IDC_LABEL1 = 1006
% IDC_EDIT2 = 1008
% IDC_LABEL2 = 1009
% IDC_ExitBtn = 1011
' Globals
sys hDlg
sys hEdit1 , hEdit2
'=================================
sub WinMain()
' For a fixed frame dialog with no resizing
sys DlgStyle, DlgStyleX
DlgStyle = WS_POPUP OR DS_SYSMODAL OR WS_VISIBLE OR DS_SETFONT OR DS_MODALFRAME
DlgStyleX = WS_EX_CLIENTEDGE
' The title is the name of the program
Dialog( MwTopleft, 100, MwWidth, 120, "Title Bar program",
DlgStyle , 8, "MS Sans Serif" ,DlgStyleX )
' Textbox 1
EDITTEXT("", IDC_EDIT1, 8, 43, 200, 14,
WS_VISIBLE | ES_WANTRETURN | ES_LEFT | WS_BORDER,
WS_EX_CLIENTEDGE)
' Label for Textbox 1
LText( "Name of user ", IDC_LABEL1, 8, 30, 150, 10)
' Textbox 2
EDITTEXT("", IDC_EDIT2, 8, 78, 200, 14,
WS_VISIBLE | ES_WANTRETURN | ES_LEFT | WS_BORDER,
WS_EX_CLIENTEDGE)
' Label for Textbox 2
LText( "Enter your school ID ", IDC_LABEL2, 8, 65, 150, 10)
PushButton( "Exit" , IDC_ExitBtn, 10, 108, 26, 10)
ClearMouseBuffers
' clears the clipboard
ClipB_Reset
' for lightcyan background
MainWindBGColor = 8
CreateModalDialog( null, @DlgProc, 0)
End Function
'=================================
' Main dialog call back function
Function DlgProc( sys hDlg, uint uMsg, sys wParam, lParam ) as sys callback
hEdit1= GetDlgItem(hDlg, IDC_EDIT1)
hEdit2= GetDlgItem(hDlg, IDC_EDIT2)
' For the flashing
tagTRACKMOUSEEVENT trackMouseNC
FLASHWINFO myFlashWinfo
STATIC Long MouseInNC
Select CASE uMsg
CASE WM_INITDIALOG
' subclass the textboxes
SetProp(hEdit1, "OldEditProc1", SetWindowLongPtr(hEdit1, GWLP_WNDPROC, @EditProc1))
SetProp(hEdit2, "OldEditProc2", SetWindowLongPtr(hEdit2, GWLP_WNDPROC, @EditProc2))
CASE WM_NCMOUSEMOVE
IF MouseInNC = FALSE THEN
MouseInNC = TRUE
trackMouseNC.cbSize = SIZEOF(trackMouseNC)
trackMouseNC.dwFlags = TME_LEAVE OR TME_HOVER OR TME_NONCLIENT
trackMouseNC.hwndTrack = hDlg
' time to start flashing
trackMouseNC.dwHoverTime = 200
TrackMouseEvent(&trackMouseNC)
END IF
CASE WM_NCMOUSEHOVER
myFlashWinfo.hwnd = hDlg
myFlashWinfo.dwflags = FLASHW_ALL
myFlashWinfo.dwTimeout = 0
myFlashWinfo.cbSize = SIZEOF(myFlashWinfo)
myFlashWinfo.ucount = 2
FlashWindowEx(&myFlashWinfo)
CASE WM_NCMOUSELEAVE
MouseInNC = FALSE
CASE WM_PAINT
' draw the title bar
PaintTitBar hDlg
CASE WM_SysCommand
IF ((WPARAM AND &HFFF0) = SC_CLOSE) THEN
'trap Alt-F4, X-button, WindowMenu/Close
'Blocks Alt-F4 from closing the program
'or close at the tray
FUNCTION = 1
END IF
CASE WM_COMMAND
select case loword(wParam)
case IDC_ExitBtn
' Exit Button is click
' display the values from Textboxes upon closing
string text1=nuls 100
GetWindowText(hEdit1, text1, 32)
mbox " textbox1 " + text1 ,0
string text2=nuls 100
GetWindowText(hEdit2, text2, 32)
mbox " textbox2 " + text2 ,0
IF hTitBarFont THEN
DeleteObject hTitBarFont
END IF
'Remove control subclassing upon exit
RemoveProp(hEdit1, "OldEditProc1", GetWindowLongPtr(hEdit1, GWLP_WNDPROC, @EditProc1))
RemoveProp(hEdit2, "OldEditProc2", GetWindowLongPtr(hEdit2, GWLP_WNDPROC, @EditProc2))
' Fade out the dialog window -- these codes must be
' placed in the Main callback function
AnimateWindow hDlg, 3200, AW_BLEND OR AW_HIDE
EndDialog( hDlg, null )
EXIT FUNCTION
End Select
CASE WM_ERASEBKGND
' added to display background color for the main window
hBGDC = wParam
' Pass the DC of the region to be repaint
DrawGradient hBGDC
FUNCTION = 1
EXIT FUNCTION
CASE WM_CTLCOLORSTATIC
' set text forecolor to Fuschia
SetTextColor(wPARAM, O2c_Fuschia)
' set background to transparent
SetBkMode(wPARAM, Transparent)
FUNCTION = GetStockObject(NULL_BRUSH)
EXIT FUNCTION
CASE WM_LBUTTONDOWN
' Force drag Main Window by the left mouse button around the screen
' Use this when you use a caption less Main Window
IF WPARAM = MK_LBUTTON THEN
SendMessage hDlg, WM_NCLBUTTONDOWN, HTCaption, BYVAL Null
END IF
End Select
Return 0
End Function
'======================================
' Subclass procedure for the Textbox 1 control
Function EditProc1(sys hDlg, uint wMsg, sys wParam, lParam) as sys callback
Select CASE wMsg
CASE WM_KEYDOWN
CASE WM_KEYUP
IF wParam = 13 THEN
' Go to the next control when enter key is pressed
SetFocus GetNextDlgTabItem(GetParent(hDlg), GetFocus, FALSE)
End if
IF wParam = 27 THEN
'ESCAPE key was pressed -- just close and exit the system
IF hTitBarFont THEN
DeleteObject hTitBarFont
END IF
SendMessage hDlg, WM_CLOSE, 0, 0
PostQuitMessage 0
End if
End Select
Return CallWindowProc(GetProp(hEdit1, "OldEditProc1"), hEdit1, wMsg, wParam, lParam)
End Function
'======================================
' Subclass procedure for the Textbox 2
Function EditProc2(sys hDlg, uint wMsg, sys wParam, lParam) as sys callback
Select CASE wMsg
CASE WM_KEYDOWN
CASE WM_KEYUP
IF wParam = 13 THEN
' Go to the next control when enter key is pressed
SetFocus GetNextDlgTabItem(GetParent(hDlg), GetFocus, FALSE)
End if
IF wParam = 27 THEN
'ESCAPE key was pressed -- just close and exit the system
IF hTitBarFont THEN
DeleteObject hTitBarFont
END IF
SendMessage hDlg, WM_CLOSE, 0, 0
PostQuitMessage 0
End if
End Select
Return CallWindowProc(GetProp(hEdit2, "OldEditProc2"), hEdit2, wMsg, wParam, lParam)
End Function
'-----------------------------------------
' Start of program
init_common_controls()
WinMain()