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
' 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
'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
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?
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 ?
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.