• Welcome to Powerbasic Museum 2020-B.
 

News:

Forum in repository mode. No new members allowed.

Main Menu

Customized Title bar demo

Started by Chris Chancellor, December 04, 2018, 08:25:52 PM

Previous topic - Next topic

0 Members and 1 Guest are viewing this topic.

Chris Chancellor

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