Source Code --- Example ListView with Tooltips

[Chris Chancellor]

Hello All

i have attached an example of ListView that comes with checkboxes, statusbar and tooltips
using the latest Tooltips.inc by Roland

Thanxx to Roland

Code Select Expand


' LV_StatusbarTT.o2bas
' http://www.oxygenbasic.org/forum/index.php?topic=1480.45
' Reply #56 by Roland


'=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*
'  Modified a little bit by adding tooltips

$ filename "LV_StatusBarTT.exe"
uses RTL64

uses "corewin.inc"
uses "Tooltips.inc"
#lookahead


! SetRect lib "user32.dll" alias "SetRect" (lpRect as RECT, byVal X1 as long, byVal Y1 as long, byVal X2 as long, byVal Y2 as long) as long
! MulDiv lib "kernel32.dll" alias "MulDiv" (byVal nNumber as long, byVal nNumerator as long, byVal nDenominator as long) as long
! IsDialogMessage Lib "user32.dll" (sys hDlg,lpMsg) as sys   
! GetDeviceCaps lib "gdi32.dll" alias "GetDeviceCaps" (byVal hDc as sys, byVal nIndex as long) as long
! GetDlgItem lib "user32.dll" (sys hWnd, int nIDDlgItem) as sys
! CreateStatusWindow lib "comctl32" alias"CreateStatusWindowA" (LONG style, char* lpszText, sys hwndParent, UINT wID) as sys


'------------------------------------------------------------------------------
% COLOR_BTNFACE 15
% HWND_DESKTOP 0
% SM_CYCAPTION 4
% SM_CYHSCROLL 3
% SM_CXVSCROLL 2
% SWP_NOACTIVATE 0X10
% SWP_NOMOVE 0X2
% SWP_NOZORDER 0X4
% WM_NCCALCSIZE 0X83
% SWP_NOSIZE 0X1
% LOGPIXELSY 90
% LVS_SINGLESEL 4
% LVS_REPORT 1
% LVS_EX_CHECKBOXES 4
% LVS_EX_FULLROWSELECT 0x20
% LVIS_STATEIMAGEMASK 0xF000
% SB_SETPARTS 0x404
% SB_SETTEXT 0x401
% SBS_SIZEGRIP 16
% CCS_BOTTOM 3
% LVCF_TEXT 4
% LVIF_TEXT 1
% LVM_INSERTCOLUMN 0x101B
% LVM_INSERTITEM 0x1007
% LVM_SETCOLUMNWIDTH 0x101E
% LVM_SETBKCOLOR 0x1001
% LVM_SETITEM 0x1006
% LVM_SETEXTENDEDLISTVIEWSTYLE 0x1036
% LVM_GETITEMSTATE 0x102C
% LVN_ITEMCHANGED  -101
% NM_CLICK -2
% IMAGE_ICON 1
% LR_LOADFROMFILE 16
% ICON_SMALL 0
% ICON_BIG 1
% WM_SETICON 0x80
% GCL_HICON  -14


'structures
'commctrl.h
type LVCOLUMN
  uint  mask
  int   fmt
  int   cx
  char* pszText
  int   cchTextMax
  int   iSubItem
  int   iImage
  int   iOrder
  int   cxMin
  int   cxDefault
  int   cxIdeal
end type
typedef LVCOLUMN LV_COLUMN

type LVITEM
  uint   mask
  int    iItem
  int    iSubItem
  uint   state
  uint   stateMask
  char*  pszText
  int    cchTextMax
  int    iImage       // index of the list view item's icon
  sys    lParam       // 32-bit value to associate with item
  int    iIndent
  int    iGroupId
  uint   cColumns
  UINT   *puColumns
  int    *piColFmt
  int    iGroup
end type
typedef LVITEM LV_ITEM

type NMLISTVIEW
  NMHDR hdr
  int   iItem
  int   iSubItem
  uint  uNewState
  uint  uOldState
  uint  uChanged
  POINT ptAction
  sys   lParam
end type
typedef NMLISTVIEW NM_LISTVIEW


macro ListView_InsertColumn(hwnd,iCol,pcol) (SendMessage(hwnd, LVM_INSERTCOLUMN, iCol, pcol))
macro ListView_InsertItem(hwnd,pitem) (SendMessage(hwnd, LVM_INSERTITEM,0, pitem))
macro ListView_SetColumnWidth(hwnd,iCol,cx) (SendMessage(hwnd, LVM_SETCOLUMNWIDTH, iCol, cx))
macro ListView_SetItem(hwnd,pitem) (SendMessage(hwnd, LVM_SETITEM,0, pitem))
macro ListView_GetCheckState(hwnd,i) ((SendMessage(hwnd, LVM_GETITEMSTATE, i, LVIS_STATEIMAGEMASK))>>12)-1

sys hListview



'------------------------------------------------------------------------------
Declare Function WinMain ( Byval hInstance AS sys, _
                           Byval hPrevInstance AS sys, _
                           Byval szCmdLine AS ZSTRING PTR, _
                           Byval nCmdShow AS LONG) AS LONG
declare SUB UpdateStatusBar(sys hWnd)
declare sub DispListView(BYVAL hListview AS DWORD,  BYVAL lColCnt AS LONG, BYVAL lRowCnt AS LONG) AS LONG                           

'==============================================================================
    Dim cmdline As asciiz ptr, inst as sys
    &cmdline=GetCommandLine
    inst=GetModuleHandle 0
    WinMain(inst, NULL, cmdline, SW_NORMAL)
    END
'==============================================================================

% ICC_LISTVIEW_CLASSES    &h1
% ICC_TREEVIEW_CLASSES    &h2
% ICC_BAR_CLASSES         &h4
% ICC_TAB_CLASSES         &h8
% ICC_UPDOWN_CLASS        &h10
% ICC_PROGRESS_CLASS      &h20
% ICC_HOTKEY_CLASS        &h40
% ICC_ANIMATE_CLASS       &h80
% ICC_WIN95_CLASSES       &hff
% ICC_DATE_CLASSES        &h100
% ICC_USEREX_CLASSES      &h200
% ICC_COOL_CLASSES        &h400
% ICC_INTERNET_CLASSES    &h800
% ICC_PAGESCROLLER_CLASS  &h1000
% ICC_NATIVEFNTCTL_CLASS  &h2000
% ICC_STANDARD_CLASSES    &h4000
% ICC_LINK_CLASS          &h8000


'==============================================================================
Function O2CreateFont(szFaceName As Zstring,Byval lPointSize As long) As sys
    Dim tlf As LOGFONT
    Dim hdc As sys
    Dim nNum As long
    hdc = GetDc(%HWND_DESKTOP)
    nNum = GetDeviceCaps(hdc, %LOGPIXELSY)
    tlf.lfHeight         = -MulDiv(lPointSize,nNum , 72)
    tlf.lfWidth          =  0
    tlf.lfEscapement     =  0
    tlf.lfOrientation    =  0
    tlf.lfWeight         =  0
    tlf.lfItalic         =  0
    tlf.lfUnderline      =  0
    tlf.lfStrikeOut      =  0
    tlf.lfCharSet        =  %ANSI_CHARSET
    tlf.lfOutPrecision   =  %OUT_TT_PRECIS
    tlf.lfClipPrecision  =  %CLIP_DEFAULT_PRECIS
    tlf.lfQuality        =  %DEFAULT_QUALITY
    tlf.lfPitchAndFamily =  %FF_DONTCARE
    tlf.lfFaceName       =  szFaceName
    ReleaseDC(%HWND_DESKTOP, hdc)
Function = CreateFontIndirect(@tlf)
End Function

'==============================================================================
Sub O2Center(sys hwnd)
    Dim As RECT WndRect
    Dim As sys x,y
    GetWindowRect(hwnd,&WndRect)
    x = (GETSYSTEMMETRICS(%SM_CXSCREEN) - (WndRect.Right-WndRect.Left))/2
    y = (GETSYSTEMMETRICS(%SM_CYSCREEN) - (WndRect.Bottom-WndRect.Top+GETSYSTEMMETRICS(%SM_CYCAPTION)))/2
    SetWindowPos (hWnd, NULL, x, y, 0, 0, SWP_NOSIZE OR SWP_NOZORDER)
End Sub

'==============================================================================
Sub O2SetWindowClientSize(sys hwnd,W,H)
    Dim As RECT rc,rcTemp
    Dim As sys hMenu,swStyle, exStyle ,dwStyle
    SetRect(rc,0,0,W,H)
    hMenu = GetMenu(hwnd)
    dwStyle = GetWindowLong(hwnd,GWL_STYLE)
    AdjustWindowRectEx(rc, dwStyle, hMenu<>NULL , GetWindowLong(hwnd, GWL_EXSTYLE))
    If hMenu <> NULL Then
        @rcTemp = @rc
        rcTemp.Bottom = &H7FFF
        SendMessage(hwnd, WM_NCCALCSIZE, 0,  &rcTemp)
        rc.Bottom = rc.Bottom + rcTemp.Top
    End If
    If (dwStyle AND WS_HSCROLL) = WS_HSCROLL Then
        rc.Bottom = rc.Bottom + GetSystemMetrics(SM_CYHSCROLL)
    End If
    If (dwStyle AND WS_VSCROLL) = WS_VSCROLL Then
        rc.Right = rc.Right + GetSystemMetrics(SM_CXVSCROLL)
    End If
    sys cx,cy
    cx = rc.Right - rc.Left
    cy = rc.Bottom - rc.Top
    SetWindowPos(hwnd, NULL, 0, 0, cx, cy, SWP_NOZORDER OR SWP_NOMOVE OR SWP_NOACTIVATE)
End Sub

'==============================================================================
% IDD_Main 1000
% IDC_Statusbar 1060
% IDC_ListView 1001

int CurrentRow, CurrentCol
sys hStatus

'==============================================================================
Function WinMain(Byval hInstance as sys, _
                 Byval hPrevInstance As sys, _
                 Byval szCmdLine As ZSTRING PTR, _
                 Byval nCmdShow As LONG ) As sys
    Dim wMsg As MSG
    Dim wcls As WNDCLASS
    Dim As sys hWin,hCtl,hFont


    With wcls
       .style         = CS_HREDRAW OR CS_VREDRAW
       .lpfnWndProc   = @WndProc
       .cbClsExtra    = 0
       .cbWndExtra    = 0
       .hInstance     = hInstance
       .hbrBackground = COLOR_BTNFACE+1
       .hIcon         = LoadIcon(0, IDI_APPLICATION)
       .hCursor       = LoadCursor( NULL, IDC_ARROW )
       .lpszMenuName  = NULL
       .lpszClassName = strptr"O2SdkWindow"
    End With
    If RegisterClass (@wcls) = FALSE Then
        MessageBox( NULL, "Failed to register wcls", "Error", MB_ICONERROR )
         Exit Function
    End If
    Dim As INITCOMMONCONTROLSEXt icc
    icc.dwSize = SIZEOF(icc)
    icc.dwICC = ICC_NATIVEFNTCTL_CLASS OR ICC_COOL_CLASSES OR ICC_BAR_CLASSES OR  _
                ICC_TAB_CLASSES OR ICC_USEREX_CLASSES OR ICC_WIN95_CLASSES OR  _
                ICC_STANDARD_CLASSES OR ICC_ANIMATE_CLASS OR ICC_DATE_CLASSES OR  _
                ICC_HOTKEY_CLASS OR ICC_INTERNET_CLASSES OR ICC_LISTVIEW_CLASSES OR  _
                ICC_PAGESCROLLER_CLASS OR ICC_PROGRESS_CLASS OR ICC_TREEVIEW_CLASSES OR  _
                ICC_UPDOWN_CLASS
    InitCommonControlsEx(@icc)
    hFont = O2CreateFont("Arial",9)

    hWin = CreateWindowEx(WS_EX_TRANSPARENT|WS_EX_TOPMOST,"O2SdkWindow","ListView - check",WS_VISIBLE|WS_CLIPCHILDREN|WS_OVERLAPPEDWINDOW,0,0,234,132,0,0,hInstance,NULL)
    O2SetWindowClientSize(hWin,410,248)

    hStatus = CreateStatusWindow(WS_CHILD | WS_BORDER | WS_VISIBLE | SBS_SIZEGRIP | CCS_BOTTOM, "", hWin, IDC_Statusbar)
    'Statusbar set parts
    int statwidths[] = {100, -1}
    SendMessage(hStatus, SB_SETPARTS, 2, &statwidths)
    SendMessage(hStatus, SB_SETTEXT, 0, "Row : Col")
    UpdateStatusBar(hWin)

    hListview = CreateWindowEx(WS_EX_CLIENTEDGE, "SysListView32",NULL,WS_CHILD | WS_TABSTOP | WS_VISIBLE | WS_BORDER|LVS_SINGLESEL|LVS_REPORT,5,0,389,225,hWin,%IDC_ListView,hInstance,BYVAL %NULL)
    SendMessage(hListview,%WM_SETFONT,hFont,0)
    'Listview setup
    int lColCnt=3, lRowCnt=300
    DispListView(hListview, lColCnt,lRowCnt)


  '  set up the Tooltips
      sys hTool1=SetToolTip(hwin, "This is the Main Window", true)
      sys hTool2=SetToolTip(hStatus, "Location of clicked cell", true)
      sys hTool3=SetToolTip(hListview, "Table of information", true)

    O2Center(hWin)
    ShowWindow(hWin,nCmdShow)

    While(GetMessage(@wMsg,NULL,0,0) <> 0)
        If IsDialogMessage (hWin,@wMsg) = 0 Then
            TranslateMessage(@wMsg)
            DispatchMessage(@wMsg)
        End If
    Wend
    DeleteObject(hFont)
    Function = wMsg.wParam
End Function


'==============================================================================
Function WndProc ( hWnd, wMsg, wParam, lparam ) as sys callback
  sys hIcon , hIconSm,checked

   Select Case wMsg
   case WM_CREATE
            hIcon = LoadImage(NULL, "ibeam blue.ico", IMAGE_ICON, 32, 32, LR_LOADFROMFILE)
          if hIcon then           
                SendMessage(hwnd, WM_SETICON, ICON_BIG, hIcon)           
            else           
                MessageBox(hwnd, "Could not load large icon! Is it in the current working directory?", "Error", MB_OK or MB_ICONERROR)
            end if

           hIconSm = LoadImage(NULL, "ibeam blue.ico", IMAGE_ICON, 16, 16, LR_LOADFROMFILE)
            if hIconSm then           
                SendMessage(hwnd, WM_SETICON, ICON_SMALL, hIconSm)           
            else           
                MessageBox(hwnd, "Could not load small icon! Is it in the current working directory?", "Error", MB_OK or MB_ICONERROR)
            end if

     
       
   case WM_SIZE
      RECT rcStatus
      int iStatusHeight

      // Size Status bar and ListView
      hListview = GetDlgItem(hWnd, IDC_LISTVIEW)
      MoveWindow(hListview,0, 0, loword(lParam), hiword(lParam)-20, true)
      hStatus = GetDlgItem(hWnd, IDC_Statusbar)
      SendMessage(hStatus, WM_SIZE, 0, 0)

      GetWindowRect(hStatus, &rcStatus)
      iStatusHeight = rcStatus.bottom - rcStatus.top

   case WM_NOTIFY
      'address of pnmh=lParam (keeps the notification message header )
      NMHDR pnmh at lParam
      if pnmh.idFrom = IDC_LISTVIEW then
        NM_LISTVIEW NMLV at lParam  'address

        SELECT CASE (int) NMLV.hdr.code

          CASE LVN_ITEMCHANGED
              ' when a check box is checked or unchecked it displays
              ' its status at the caption
              hListView=GetDlgItem(hWnd, IDC_LISTVIEW)
              Checked = ListView_GetCheckState(hListView, NMLV.iItem)

              IF Checked = TRUE THEN
                  SendMessage(hWnd, WM_SETTEXT, 0, "Row " + STR(NMLV.iItem+1)    +    "  Checked  " + str(Checked))
              ELSE
                ' when unchecked
                  SendMessage(hWnd, WM_SETTEXT, 0, "Row " + STR(NMLV.iItem+1)     +    " Checked: " + STR(Checked))
              END IF

          CASE NM_CLICK     ' click on a cell
                 NM_LISTVIEW lPlvNm at lParam  'address
                 CurrentRow = LpLvNm.iiTem + 1
                 CurrentCol = LpLvNm.iSubItem + 1
                 UpdateStatusBar(hWnd)

        END SELECT
      end if


   Case WM_COMMAND
      Select Case LOWORD(wParam)
          Case IDCANCEL
             If HIWORD(wParam) = BN_CLICKED Then
               SendMessage(hWnd,WM_CLOSE,0,0)
             Exit Function
          End If
      End Select
   Case WM_DESTROY
      PostQuitMessage(0)
      Exit Function
   End Select
   Function = DefWindowProc(hWnd, wMsg, wParam, lParam)
End Function


'=====================
' The status bar displaying the current position of cursor
' and help text for each column
SUB UpdateStatusBar(sys hWnd)

   hStatus=GetDlgItem(hWnd, IDC_Statusbar)
   SendMessage(hStatus, SB_SETTEXT, 0, "Row " & str(CurrentRow) & "  :  " & "Col " & str(CurrentCol))

' Help text for each column when a particular column is clicked
   SELECT CASE CurrentCol
       CASE 1
            SendMessage(hStatus, SB_SETTEXT, 1, "Enter characters only")
       CASE 2
            SendMessage(hStatus, SB_SETTEXT, 1, "Enter numbers only")
       CASE 3
            SendMessage(hStatus, SB_SETTEXT, 1, "Enter Alphanumeric here")
   END SELECT
END SUB

'===============================
' Display and load in the data for the ListView
sub DispListView(BYVAL hListview AS DWORD,  BYVAL lColCnt AS LONG, _
        BYVAL lRowCnt AS LONG) AS LONG
   LOCAL lCol , i  , r  AS LONG
   LOCAL lRow   AS LONG

   SendMessage(hListView, LVM_SETEXTENDEDLISTVIEWSTYLE, 0, LVS_EX_CHECKBOXES OR LVS_EX_FULLROWSELECT )

  indexbase 0

  ' Load column headers.
   LV_COLUMN lvc
   lvc.mask = LVCF_TEXT

'  Headers
   dim as string Column$[3]
    Column$[0] = " Column 1"
   Column$[1] = " Column 2"
   Column$[2] = " Column 3"

   FOR i = 0 TO 2
      lvc.mask = LVCF_TEXT
      lvc.pszText = Column$[i]
      ListView_InsertColumn(hListview, i, lvc)
   NEXT

   for i=0 to 2
      ListView_SetColumnWidth(hListview, i, 65)
   next



'==========================
  LV_ITEM lvItem
'==========================

  lvItem.mask      =  LVIF_TEXT
  string text

'  populate the listview
  for r = lRowCnt to 1 step -1
    text= " Row " & r    &  "  Col 1 "
    lvItem.pszText   = text
    lvItem.iSubItem  =  0
    ListView_InsertItem(hListview, &lvItem)

    text= " Row " & r    &  "  Col 2 "
    lvItem.pszText   = text
    lvItem.iSubItem  =  1
    ListView_SetItem(hListview, &lvItem)

    text=  " Row " & r     &  "  Col 3 "
    lvItem.pszText   = text
    lvItem.iSubItem  =  2
    ListView_SetItem(hListview, &lvItem)

  next r

  ' Auto size columns.
  for i=0 to 2
     ListView_SetColumnWidth(hListview, i, -2)
  next

end sub




and the  tooltips.inc

Code Select Expand


    'ToolTips.inc
    'https://docs.microsoft.com/de-de/windows/desktop/Controls/tooltip-control-reference
     'https://www.oxygenbasic.org/forum/index.php?PHPSESSID=oeqf5lmiprivqr5uadgkijer94&topic=1751.msg19014;topicseen#msg19014
   
     
    ' tooltips constants
    % TTF_IDISHWND=1
    % TTF_CENTERTIP=2
    % TTF_SUBCLASS=16
    % TTI_NONE  0
    % TTI_INFO  1
    % TTI_WARNING  2
    % TTI_ERROR  3
    % TTI_INFO_LARGE  4
    % TTI_WARNING_LARGE  5
    % TTI_ERROR_LARGE  6
    % TTM_ADDTOOL=1028
    % TTM_DELTOOL=1029
    % TTM_SETTIPBKCOLOR=1043
    % TTM_SETTIPTEXTCOLOR=1044
    % TTM_SETMAXTIPWIDTH=1048
    % TTM_SETTITLE=1056
    % TTS_ALWAYSTIP=1
    % TTS_BALLOON=64
     
    type TOOLINFO
      UINT      cbSize
      UINT      uFlags
      sys       hwnd
      sys       uId    'UINT_PTR
      RECT      rect   'must be checked
      sys       hinst
      char*     lpszText
      sys       lParam
      sys      *lpReserved
    end type
     
    '============================
    ' RGB function for O2
    function RGB(int rcc, gcc, bcc) as int
       return (rcc + gcc*256 + bcc*65536)
    end Function
    '=======================================
     
    function SetToolTip(sys hwnd, string TipText, optional bool Balloon=false, bCentered=false) as sys
     
        TOOLINFO TI
        sys flags=TTS_ALWAYSTIP
        uint uFlags=TTF_SUBCLASS or TTF_IDISHWND
     
        if Balloon then flags=flags or TTS_BALLOON
        if bCentered then uflags=uflags or TTF_CENTERTIP
     
        sys hToolTip = CreateWindowEx(0, "tooltips_class32", "", flags,
                                      0, 0, 0, 0, hwnd, null, GetModuleHandle(null), null)
     
        TI.cbSize    = sizeof(TI)
        TI.uFlags    = uflags
        TI.hWnd      = GetParent(hToolTip)
        TI.uId       = hwnd
        TI.lpszText  = strptr TipText
        SendMessage (hToolTip, TTM_ADDTOOL, 0, &ti)
     
         return hToolTip
    end function
     
    'set the text color
    sub setTooltipTextColor(sys hTool, int FGcolor)
        SendMessage (hTool, TTM_SETTIPTEXTCOLOR, FGcolor, 0)
    end sub
     
    'for the background color
    sub setTooltipBackColor(sys hTool, int BKcolor)
        SendMessage (hTool, TTM_SETTIPBKCOLOR, BKcolor)
    end sub
     
    'set a title for the tooltip
    sub setTooltipTitle(sys hTool, string Text, optional sys icon=TTI_INFO)
       SendMessage(hTool, TTM_SETTITLE, icon, Text)
    end sub
     
    'limit Tooltip max width
    sub setTooltipWidth(sys hTool, int maxwidth)
       SendMessage(hTool, TTM_SETMAXTIPWIDTH, 0, maxwidth)
    end sub     
     


[Karen Zibowski]

Thank you Chris, that is a splendid program

However, I noticed that you were compiling from  set o2dir=C:\OxygenBasicProgressSep4
in your bat file.

but the current link for the latest OxygenBasicProgress.zip is  at Jul 21 ?  where did you get the Sep 4  zip from?

[Chris Chancellor]

Hello Karen

i have actually downloaded the Jul 21  (the most current) oxygenbasic progress. zip file
and place into the  folder called Sep4  (the date which i have downloaded).

so it is the same as the Jul 21 package which you had downloaded

maybe Charles can add some light to it.  as far as i know Charles is busy making the self compiling O2
so there is no new upgrade since Jul 21 ?

[Zlatko Vid]

Well this program compile on 32bit but not work ...
and whatr is that ..do we need 100 version of includes files 
yeah
creating programs only for 64bit don't hold the water for ordinary windows user.