Source Code -- Dialogs with Tooltips

[Chris Chancellor]

Hello all

i have created a dialog with tooltips example which can help you to
translate PB programs to O2

Code Select Expand


' DialogTT.o2bas


' Dialog with Tooltips


$ filename "DialogTT.exe"
uses rtl64

uses corewin
uses dialogs
uses user
#lookahead



' tooltips constants
% TTF_IDISHWND=1
% TTF_SUBCLASS=16
% TTM_ADDTOOL=1028
% TTM_SETTIPBKCOLOR=1043
% TTM_SETTIPTEXTCOLOR=1044
% TTS_ALWAYSTIP=1
% TTS_BALLOON=64

type TOOLINFO
  UINT      cbSize
  UINT      uFlags
  sys       hwnd
  sys       uId    'UINT_PTR
  RECT      rect
  sys       hinst
  char*     lpszText
  sys       lParam
  sys      *lpReserved
end type




% ID_Button     = 1003
% IDC_LABEL1 = 1006
% IDC_TxtBox    = 1008

def varptr @ %1

macro MakeLong(lo,hi) { ( (lo) or ( (hi)<<16 ) ) }


' for painting the dialog background
! WindowFromDC lib "user32.dll" (sys hDc) as sys
! DestroyWindow lib "user32.dll" (sys hWnd) as bool
! CreateSolidBrush lib "GDi32.dll" (byte COLORREF crColor)
! GetStockObject lib "GDi32.dll" (int fnObject)





sys hInstance = GetModuleHandle(null)
sys  hToolTip , hDlg
sys hButton , hTxtBox




'============================
        ' RGB function for O2
         function RGB(int rcc, gcc, bcc) as int
                    return (rcc + gcc*256 + bcc*65536)
        end Function




'=====================================
sub winmain()

init_common_controls()

    ' Display the dialog,  while its repainting is done in the DialogProc()
  Dialog( 0, 0, 300, 200, "Dialog with Tooltips",
          WS_OVERLAPPEDWINDOW or DS_CENTER or DS_SETFONT,
          10, "Arial")

         PushButton("Button1", ID_Button, 50,80,65,15)

       ' for labeling  text on the screen  -- note that the coloring
      '  or painting is done in the DialogProc()
        LText("Hover mouse over the controls to see tooltips", IDC_LABEL1, 20,170, 250,10)

       '  for text box data entry
         EDITTEXT("", IDC_TxtBox, 55, 120, 80, 10)

        CreateModalDialog( null, @DialogProc, 0)
end sub





==========================================================
function DialogProc( sys hDlg, uint uMsg, sys wParam, lParam ) as sys callback
 
' for the Text box control
  string  datentry
  sys    nLen


' for painting background of dialog
  LOCAL hDC  AS sys


  select case uMsg
 
    case WM_INITDIALOG
   
             hButton =  GetDlgItem(hDlg, ID_Button)
         '   display the tooltips  for button1
             SetToolTip( hButton,"The Button 1 will do some thing")

             hTxtBox =  GetDlgItem(hDlg, IDC_TxtBox)
         '   display the tooltips  for text box
             SetToolTip( hTxtBox,"please enter some thing")

 
    case WM_DESTROY
   PostQuitMessage(WM_QUIT)


      'graphic/drawing events
       'sent when the window background must be erased such as resizing
       CASE  WM_ERASEBKGND     
          hDC = wParam
        ' Pass the DC of the region to repaint
          DrawGradient hDC           
          FUNCTION = 1
          EXIT FUNCTION


     CASE   WM_CTLCOLORSTATIC
            'lParam is static handle
            ' this make the background of the  label transparent
            IF GetDlgCtrlID(lParam) = IDC_Label1 THEN
                'wPARAM id device context DC
                '  set text to midnight blue
               SetTextColor(wPARAM, RGB(25,25,112))
                 ' set background to transparent
               SetBkMode(wPARAM, TRANSPARENT)
               FUNCTION = GetStockObject(NULL_BRUSH)
               EXIT FUNCTION
            END IF                         


    case WM_COMMAND
        select case loword(wParam)

           case IDCANCEL
                     EndDialog( hDlg, null )

           case ID_Button
                  '  Allocate the length of buffer string with a max length of 20   
                    datentry = nuls(20)
                   ' Note if user type in a string exceeding 20 then string would be trucated to 20
                    nLen = GetDlgItemText(hDlg, IDC_TxtBox,  STRPTR( datentry),20)
                    if nLen > 0 then
                       mbox "Button1 was clicked  and its data entry "  + chr(13,10) +  datentry
                   else
                      mbox "Button1 was clicked"
                   end if

      end select
     

    case WM_CLOSE
         EndDialog( hDlg, null )
               
  end select

  return 0
end function



'==========================================
' Repaint background with a color gradient
SUB DrawGradient (BYVAL hDC AS DWORD)
   LOCAL rectFill AS RECT, rectClient AS RECT, fStep AS SINGLE
   local hBrush AS DWORD, lOnBand AS LONG
   GetClientRect WindowFromDC(hDC), rectClient
   fStep = rectClient.bottom / 75

   FOR lOnBand = 0 TO 199
      SetRect rectFill, 0, lOnBand * fStep, rectClient.right + 1, (lOnBand + 1) * fStep
      ' paint the background -- change the first 2 colors R and G
      ' to vary the color gradient
      hBrush = CreateSolidBrush(rgb(228, 240, 230 - lOnBand))
      Fillrect hDC, rectFill, hBrush
      DeleteObject hBrush
   NEXT

END SUB



'=======================================
sub SetToolTip(sys hControl, string TipText)

    TOOLINFO TI

    sys hToolTip = CreateWindowEx(0, "tooltips_class32", "", TTS_ALWAYSTIP | %TTS_BALLOON,
                                  0, 0, 0, 0, hDlg, null, GetModuleHandle(null), null)

    ' set the text color
    SendMessage (hToolTip, TTM_SETTIPTEXTCOLOR, MAGENTA,0)
   ' for the background color
    int AzureColor = RGB(240,255,255)
    SendMessage (hToolTip, TTM_SETTIPBKCOLOR, AzureColor,0)

   ' do NOT use LEN(TI) as use by PB
     TI.cbSize    = sizeof(TI)

     TI.uFlags     = TTF_SUBCLASS | TTF_IDISHWND
     TI.hWnd      = GetParent(hToolTip)
     TI.uId          = hControl
     TI.lpszText  = strptr TipText
     SendMessage (hToolTip, TTM_ADDTOOL, 0, &ti)
end sub






' Start of program
winmain()