*+--------------------------------------------------------------------
*+
*+ Source Module => c:\fwh\0\Listview\TGRID.PRG
*+
*+ Copyright(C) 1983-2022 by Auge & Ohr
*+
*+ Functions: Procedure Main()
*+ Static Function BUILDMENU()
*+ Static Procedure DoResize()
*+ Procedure SayBar()
*+ Function VAR2CHAR()
*+ Function onDummy()
*+ Class TExplorer
*+ Class TGrid
*+
*+ Reformatted by Click! 2.05.40 on Oct-24-2022 at 10:29 am
*+
*+--------------------------------------------------------------------
#include "FiveWin.ch"
#include "Constant.ch"
#include "Directry.ch"
#include "COMMON.CH"
#include "TGRID.CH"
#define COLOR_WINDOW 5
#define COLOR_WINDOWTEXT 8
#define COLOR_BTNFACE 15
#define COLOR_BTNSHADOW 16
#define COLOR_BTNHIGHLIGHT 20
#define ID_HEADER 1
#define ID_WIDTH 2
#define ID_ALIGN 3
#define ID_TYPE 4
#define SW_SHOW 5
#define isworking
/********************************************
*
* use your HB_LANG_* and HB_CODEPAGE_*
*
********************************************/
REQUEST HB_LANG_ES
REQUEST HB_LANG_EN
REQUEST HB_LANG_FR
REQUEST HB_LANG_PT
REQUEST HB_LANG_DEWIN
REQUEST HB_LANG_RUWIN
REQUEST HB_LANG_IT
REQUEST HB_LANG_PLWIN
REQUEST HB_LANG_EU
REQUEST HB_LANG_HR852
REQUEST HB_LANG_SLWIN
REQUEST HB_LANG_CSWIN
REQUEST HB_CODEPAGE_BG866
REQUEST HB_CODEPAGE_BGISO
REQUEST HB_CODEPAGE_BGMIK
REQUEST HB_CODEPAGE_BGWIN
REQUEST HB_CODEPAGE_CS852
REQUEST HB_CODEPAGE_CS852C
REQUEST HB_CODEPAGE_CSISO
REQUEST HB_CODEPAGE_CSKAMC
REQUEST HB_CODEPAGE_CSWIN
REQUEST HB_CODEPAGE_DE850
REQUEST HB_CODEPAGE_DE850M
REQUEST HB_CODEPAGE_DEISO
REQUEST HB_CODEPAGE_DEWIN
REQUEST HB_CODEPAGE_DK865
REQUEST HB_CODEPAGE_EL437
REQUEST HB_CODEPAGE_EL737
REQUEST HB_CODEPAGE_ELISO
REQUEST HB_CODEPAGE_ELWIN
REQUEST HB_CODEPAGE_EN
REQUEST HB_CODEPAGE_ES850
REQUEST HB_CODEPAGE_ES850C
REQUEST HB_CODEPAGE_ES850M
REQUEST HB_CODEPAGE_ESISO
REQUEST HB_CODEPAGE_ESMWIN
REQUEST HB_CODEPAGE_ESWIN
REQUEST HB_CODEPAGE_FI850
REQUEST HB_CODEPAGE_FR850
REQUEST HB_CODEPAGE_FR850C
REQUEST HB_CODEPAGE_FR850M
REQUEST HB_CODEPAGE_FRISO
REQUEST HB_CODEPAGE_FRWIN
REQUEST HB_CODEPAGE_HE862
REQUEST HB_CODEPAGE_HEWIN
REQUEST HB_CODEPAGE_HR646
REQUEST HB_CODEPAGE_HR852
REQUEST HB_CODEPAGE_HRISO
REQUEST HB_CODEPAGE_HRWIN
REQUEST HB_CODEPAGE_HU852
REQUEST HB_CODEPAGE_HU852C
REQUEST HB_CODEPAGE_HUISO
REQUEST HB_CODEPAGE_HUWIN
REQUEST HB_CODEPAGE_IS850
REQUEST HB_CODEPAGE_IS861
REQUEST HB_CODEPAGE_IT437
REQUEST HB_CODEPAGE_IT850
REQUEST HB_CODEPAGE_IT850M
REQUEST HB_CODEPAGE_ITISB
REQUEST HB_CODEPAGE_ITISO
REQUEST HB_CODEPAGE_ITWIN
REQUEST HB_CODEPAGE_LT775
REQUEST HB_CODEPAGE_LTWIN
REQUEST HB_CODEPAGE_NL850
REQUEST HB_CODEPAGE_NL850M
REQUEST HB_CODEPAGE_NO865
REQUEST HB_CODEPAGE_PL852
REQUEST HB_CODEPAGE_PLISO
REQUEST HB_CODEPAGE_PLMAZ
REQUEST HB_CODEPAGE_PLWIN
REQUEST HB_CODEPAGE_PT850
REQUEST HB_CODEPAGE_PT860
REQUEST HB_CODEPAGE_PTISO
REQUEST HB_CODEPAGE_RO852
REQUEST HB_CODEPAGE_ROISO
REQUEST HB_CODEPAGE_ROWIN
REQUEST HB_CODEPAGE_RU1251
REQUEST HB_CODEPAGE_RU866
REQUEST HB_CODEPAGE_RUISO
REQUEST HB_CODEPAGE_RUKOI8
REQUEST HB_CODEPAGE_SK852
REQUEST HB_CODEPAGE_SK852C
REQUEST HB_CODEPAGE_SKISO
REQUEST HB_CODEPAGE_SKKAMC
REQUEST HB_CODEPAGE_SKWIN
REQUEST HB_CODEPAGE_SL646
REQUEST HB_CODEPAGE_SL852
REQUEST HB_CODEPAGE_SLISO
REQUEST HB_CODEPAGE_SLWIN
REQUEST HB_CODEPAGE_SR646
REQUEST HB_CODEPAGE_SR646C
REQUEST HB_CODEPAGE_SRWIN
REQUEST HB_CODEPAGE_SV437C
REQUEST HB_CODEPAGE_SV850
REQUEST HB_CODEPAGE_SV850M
REQUEST HB_CODEPAGE_SVISO
REQUEST HB_CODEPAGE_SVWIN
REQUEST HB_CODEPAGE_TR857
REQUEST HB_CODEPAGE_TRISO
REQUEST HB_CODEPAGE_TRWIN
REQUEST HB_CODEPAGE_UA1125
REQUEST HB_CODEPAGE_UA1251
REQUEST HB_CODEPAGE_UA866
REQUEST HB_CODEPAGE_UAKOI8
REQUEST HB_CODEPAGE_UTF16LE
REQUEST HB_CODEPAGE_UTF8
REQUEST HB_CODEPAGE_UTF8EX
STATIC lDebug := .T.
STATIC cVersion := "v0.1.25"
// **********************************************************************
//
// 24.10.2022 v0.1.25 1st Release
//
// **********************************************************************
MEMVAR oWnd, oExplorer, oStatusBar
*+--------------------------------------------------------------------
*+
*+ Procedure Main()
*+
*+--------------------------------------------------------------------
*+
PROCEDURE Main( cPath, cLangCode, cCodepage )
LOCAL oFont
LOCAL nHeight := 1024
LOCAL nWidth := 1280
LOCAL nTop := 0
LOCAL nLeft := 0
LOCAL nIcoLarge := 256
LOCAL nIcoSmall := 32
LOCAL cLog := cFileSetExt( ExeName(), "LOG" )
PRIVATE oWnd
PRIVATE oExplorer
PRIVATE oStatusBar
DEFAULT cPath := hb_Dirbase()
DEFAULT cLangCode := "DEWIN"
DEFAULT cCodepage := "DEWIN"
FW_SetUnicode( .T. ) // is this need ?
hb_LangSelect( cLangCode )
hb_CDPSELECT( cCodepage )
FWLOG TIME(), "Start"
SET DATE GERMAN
DEFINE FONT oFont NAME "TAHOMA" SIZE 0, - 200
#IFDEF __HMG__
END FONT
#ENDIF
DEFINE WINDOW oWnd FROM nTop, nLeft TO nHeight, nWidth PIXEL TITLE "FiveWin TGrid Listview Demo " + cVersion ICON "A1MAIN" MENU BuildMenu()
oExplorer := TExplorer() :New( oWnd, nTop, nLeft, nWidth - 20, nHeight - 20, cPath, nIcoLarge, nIcoSmall )
DEFINE STATUSBAR oStatusBar PROMPT "Hello World " OF oWnd SIZES nWidth - 100 CLOCK
// oStatusBar:SetPartText( 1, "Hello Statusbar" )
// oStatusBar:ClockOn()
#IFDEF __HMG__
END STATUSBAR
END WINDOW
#ENDIF
ACTIVATE WINDOW oWnd ON RESIZE DoResize( oWnd, oExplorer ) CENTER
FWLOG TIME(), "Ende"
// WinExec( "notepad.exe " + cLog )
IF !EMPTY( oFont )
oFont:End()
ENDIF
IF !EMPTY( oExplorer )
oExplorer:Destroy()
ENDIF
IF !EMPTY( oStatusBar )
oStatusBar:End()
ENDIF
IF !EMPTY( oWnd )
oWnd:End()
ENDIF
RETURN
*+--------------------------------------------------------------------
*+
*+ Static Function BUILDMENU()
*+
*+ Called from ( tgrid.prg ) 1 - procedure main()
*+
*+--------------------------------------------------------------------
*+
STATIC FUNCTION BUILDMENU()
LOCAL oMenu
MENU oMenu
MENUITEM "ICON " ACTION oExplorer:oGrid:SetViewStyle( LVS_ICON )
MENUITEM "SMALLICON" ACTION oExplorer:oGrid:SetViewStyle( LVS_SMALLICON )
MENUITEM "LIST " ACTION oExplorer:oGrid:SetViewStyle( LVS_LIST )
MENUITEM "REPORT " ACTION oExplorer:oGrid:SetViewStyle( LVS_REPORT )
ENDMENU
RETURN oMenu
*+--------------------------------------------------------------------
*+
*+ Static Procedure DoResize()
*+
*+ Called from ( tgrid.prg ) 1 - procedure main()
*+
*+--------------------------------------------------------------------
*+
STATIC PROCEDURE DoResize( oWnd, oExplorer )
LOCAL nHeight := oWnd:nHeight
LOCAL nWidth := oWnd:nWidth
oExplorer:oGrid:SetSize( nWidth - 20, nHeight - 80 )
RETURN
*+--------------------------------------------------------------------
*+
*+ Procedure SayBar()
*+
*+ Called from ( tgrid.prg ) 1 - class texplorer
*+
*+--------------------------------------------------------------------
*+
PROCEDURE SayBar( cText, nPart )
DEFAULT nPart := 1
// how does Statusbar work ?
//
// oStatusBar:SetPartText( nPart, cText )
// oStatusBar:SetMsg( cText )
// oWnd:SetMsg( cText )
RETURN
*+--------------------------------------------------------------------
*+
*+ Function VAR2CHAR()
*+
*+ Called from ( tgrid.prg ) 2 - function ondummy()
*+ 6 - class tgrid
*+
*+--------------------------------------------------------------------
*+
FUNCTION VAR2CHAR( cIn )
LOCAL cOut := hb_valToExp( cIn )
RETURN STRTRAN( cOut, '"', '' )
*+--------------------------------------------------------------------
*+
*+ Function onDummy()
*+
*+--------------------------------------------------------------------
*+
FUNCTION onDummy()
LOCAL iMax := PCOUNT()
LOCAL i
LOCAL cText := ""
LOCAL xValue
IF lDebug = .T.
FOR i := 1 TO iMax - 1
cText += Var2Char( PValue( i ) ) + CHR( 9 )
NEXT
cText += Var2Char( PValue( iMax ) )
IF EMPTY( cText )
cText := TIME() + " no Parameter ? " + CRLF + PROCNAME( 1 ) + STR( PROCLINE( 1 ) ) + CRLF + PROCNAME( 2 ) + STR( PROCLINE( 2 ) )
ENDIF
// Fivewin Logfile
FWLOG cText
ENDIF
RETURN NIL
// ******************************* CLASS TExplorer ****************************
*+--------------------------------------------------------------------
*+
*+ Class TExplorer
*+
*+--------------------------------------------------------------------
*+
CLASS TExplorer FROM TGrid
DATA oGrid
METHOD New( oWnd, nTop, nLeft, nWidth, nHeight, cPath, nIcoLarge, nIcoSmall ) CONSTRUCTOR
METHOD DoGetItem( nRow )
METHOD DoLastFolder( cLastPath )
METHOD DoNextFolder( cPath )
METHOD SetStyle( nView )
METHOD FillGrid()
METHOD DoSayItem( nItem )
ENDCLASS
METHOD New( oWnd, nTop, nLeft, nWidth, nHeight, cPath, nIcoLarge, nIcoSmall ) CLASS TExplorer
LOCAL nClrFore := GetSysColor( COLOR_WINDOWTEXT )
LOCAL nClrBack := GetSysColor( COLOR_WINDOW )
LOCAL lPixel := .F.
LOCAL lDesign := .F.
LOCAL cMsg := "hello Fivewin"
LOCAL bAction := nil
LOCAL aHeader := {}
LOCAL aDir
DEFAULT nIcoLarge := 32
DEFAULT nIcoSmall := 16
AADD( aHeader, { "Name", 200, LVCFMT_LEFT, "C" } )
AADD( aHeader, { "Size", 150, LVCFMT_RIGHT, "N" } )
AADD( aHeader, { "Date", 090, LVCFMT_RIGHT, "D" } )
AADD( aHeader, { "Time", 090, LVCFMT_RIGHT, "C" } )
AADD( aHeader, { "Attr", 050, LVCFMT_LEFT, "C" } )
::oGrid := TGrid() :New( nTop, nLeft, bAction, oWnd, nClrFore, ;
nClrBack, lPixel, lDesign, nWidth, nHeight, cMsg, nIcoLarge, nIcoSmall )
::oGrid:aHeader := aHeader
aDir := DIRECTORY( cPath + "*.*", "DHS" )
// remove "."
ADEL( aDir, 1 )
ASIZE( aDir, LEN( aDir ) - 1 )
::oGrid:cPath := cPath
::oGrid:aSource := aDir
::oGrid:InitTheListView()
::oGrid:bClick := { | nItem | ::DoGetItem( nItem ) }
::oGrid:bAction := { | nItem | ::DoSayItem( nItem ) }
::FillGrid()
RETURN Self
METHOD DoSayItem( nRow ) CLASS TExplorer
LOCAL cRet := ""
LOCAL hWnd := ::oGrid:hWnd
LOCAL nCol := 1 // only F_NAME
LOCAL cPath := ::oGrid:cPath
cRet := LV_GETITEMTEXT( hWnd, nRow, nCol )
// how does Statusbar work ?
//
::oGrid:cMsg := cPath + cRet
RETURN cRet
METHOD DoGetItem( nRow ) CLASS TExplorer
LOCAL cRet := ""
LOCAL hWnd := ::oGrid:hWnd
LOCAL nCol := 1 // only F_NAME
LOCAL cPath := ::oGrid:cPath
LOCAL aSource := ::oGrid:aSource
LOCAL nPosi, cAttr
// when using LVN_GETDISPINFO you NEED Source Array
// cRet := ::oGrid:aSource[nRow][nCol]
cRet := LV_GETITEMTEXT( hWnd, nRow, nCol )
nPosi := ASCAN( aSource, { | x | x[ F_NAME ] = TRIM( cRet ) } )
IF nPosi > 0
cAttr := aSource[ nPosi ] [ F_ATTR ]
DO CASE
CASE TRIM( cRet ) = ".."
::DoLastFolder( TRIM( cPath ) )
CASE TRIM( cRet ) = "."
OTHERWISE
IF "D" $ cAttr
::DoNextFolder( TRIM( cPath + cRet ) )
ELSE
// MsgInfo( cPath + cRet )
ShellExecute( oWnd:hWnd, "Open", cPath + cRet,,, SW_SHOW )
ENDIF
ENDCASE
ELSE
MsgInfo( cRet + " not found in Folder " + cPath )
ENDIF
RETURN cRet
METHOD DoLastFolder( cLastPath ) CLASS TExplorer
LOCAL cPath
LOCAL nPosi
LOCAL aToken
LOCAL cFolder
nPosi := hb_RAt( "\", cLastPath, 1, LEN( cLastPath ) - 1 )
IF nPosi > 0
cPath := SUBSTR( cLastPath, 1, nPosi - 1 )
cFolder := SUBSTR( cLastPath, nPosi )
cFolder := TRIM( STRTRAN( cFolder, "\", "" ) )
::DoNextFolder( cPath, cFolder )
ENDIF
RETURN nil
METHOD DoNextFolder( cPath, cFolder ) CLASS TExplorer
LOCAL cRet := ""
LOCAL aDir
LOCAL nPosi, nMax
DEFAULT cFolder := ""
aDir := DIRECTORY( cPath + "\*.*", "DHS" )
// remove "."
ADEL( aDir, 1 )
ASIZE( aDir, LEN( aDir ) - 1 )
::oGrid:cPath := cPath + "\"
::oGrid:aSource := aDir
::FillGrid()
nMax := LEN( ::aSource )
// need for LVS_OWNERDATA / ::OnDISPINFO()
LV_SETITEMCOUNT( ::hLv, nMax )
IF !EMPTY( cFolder )
nPosi := ASCAN( aDir, { | e | LOWER( e[ F_NAME ] ) = LOWER( cFolder ) } )
IF nPosi > 0
LV_SETITEMSELECT( ::oGrid:hLv, nPosi )
ELSE
msginfo( "not found Folder " + cFolder )
ENDIF
ENDIF
RETURN cRet
METHOD SetStyle( nView ) CLASS TExplorer
DEFAULT nView := LVS_REPORT
DO CASE
CASE nView = LVS_ICON
::oGrid:SetViewStyle( LVS_ICON )
CASE nView = LVS_SMALLICON
::oGrid:SetViewStyle( LVS_SMALLICON )
CASE nView = LVS_LIST
::oGrid:SetViewStyle( LVS_LIST )
CASE nView = LVS_REPORT
::oGrid:SetViewStyle( LVS_REPORT )
ENDCASE
RETURN self
METHOD FillGrid() CLASS TExplorer
LOCAL ii, nMax, aItem, iImage, iImage_0, cFile, hBitMap, aBitmaps, cExt
LV_HIDEWINDOW( ::oGrid:hLv )
SendMessage( ::oGrid:hLv, LVM_DELETEALLITEMS, 0, 0 )
ImageList_RemoveAll( ::oGrid:oImageListSmall )
ImageList_RemoveAll( ::oGrid:oImageListBig )
nMax := LEN( ::oGrid:aSource )
// slow Way i a loop
FOR ii := 1 TO nmax
aItem := { ::oGrid:aSource[ ii ] [ F_NAME ], STR( ::oGrid:aSource[ ii ] [ F_SIZE ] ), DTOC( ::oGrid:aSource[ ii ] [ F_DATE ] ), ::oGrid:aSource[ ii ] [ F_TIME ], ::oGrid:aSource[ ii ] [ F_ATTR ] }
cFile := ::oGrid:aSource[ ii ] [ F_NAME ]
SayBar( cFile )
// ::oGrid:cMsg := cFile
SysRefresh()
cExt := UPPER( cFileExt( cFile ) )
IF cExt $ "BMP,JPG,PNG,GIF,ICO,CUR,DLL,JPEG,TIF,TIFF,EMF,WMF"
// ******** small Icon ********
// make it +10 Pixel bigger while RESIZEBMP() do NOT change Aspect Ratio
#IFDEF isworking
aBitmaps := ::oGrid:oWnd:ReadImage( ::oGrid:cPath + cFile, { ::oGrid:nIcoSmall + 10, ::oGrid:nIcoSmall + 10 } )
iImage_0 := aBitmaps[ 1 ]
#ELSE
// return HIMAGELIST
iImage_0 := ::oGrid:oImageListSmall:ReadBitmap( ::oGrid:cPath + cFile, ::oGrid:nIcoSmall + 10, 10 )
#ENDIF
// change Aspect Ratio while else might not display
iImage_0 := RESIZEBMP( iImage_0, ::oGrid:nIcoSmall, ::oGrid:nIcoSmall, .T. )
ILADD( ::oGrid:oImageListSmall:hImageList, iImage_0 )
PalBmpFree(aBitmaps)
// ******** big Icon **********
#IFDEF isworking
aBitmaps := ::oGrid:oWnd:ReadImage( ::oGrid:cPath + cFile, { ::oGrid:nIcoLarge + ::oGrid:nIcoSmall, ::oGrid:nIcoLarge + ::oGrid:nIcoSmall } )
iImage := aBitmaps[ 1 ]
#ELSE
// return HIMAGELIST
iImage := ::oGrid:oImageListBig:ReadBitmap( ::oGrid:cPath + cFile, ::oGrid:nIcoLarge + ::oGrid:nIcoSmall, 10 )
#ENDIF
// change Aspect Ratio while else might not display
iImage := RESIZEBMP( iImage, ::oGrid:nIcoLarge, ::oGrid:nIcoLarge, .T. )
iImage := MAX( 0, ILADD( ::oGrid:oImageListBig:hImageList, iImage ) )
PalBmpFree(aBitmaps)
ELSE
// search for System Icon
iImage := Icon_Read( cFile )
ILADDICON( ::oGrid:oImageListSmall:hImageList, iImage )
iImage := MAX( 0, ILADDICON( ::oGrid:oImageListBig:hImageList, iImage ) )
ENDIF
LV_ADDITEMS( ::oGrid:hLv, aItem, iImage )
NEXT
LV_SHOWWINDOW( ::oGrid:hLv )
// SayBar("")
// ::oGrid:cMsg := ""
::oGrid:RefreshAll()
LV_SETITEMSTATE( ::oGrid:hLv, 1, nOr( LVIS_FOCUSED, LVIS_SELECTED ), nOr( LVIS_SELECTED, LVIS_FOCUSED ) )
LV_ENSUREVISIBLE( ::oGrid:hLv, 1 )
RETURN self
// ******************************* CLASS TGrid ****************************
*+--------------------------------------------------------------------
*+
*+ Class TGrid
*+
*+--------------------------------------------------------------------
*+
CLASS TGrid FROM TControl
CLASSDATA aProperties INIT { "nAlign", "nClrText", "nClrPane", "nOption", ;
"nTop", "nLeft", "nWidth", "nHeight", "Cargo" }
DATA aItems INIT {}
DATA aGroups INIT {}
DATA bAction, bDisplay
DATA bClick
DATA nOption
DATA nGroups INIT 0
DATA aSource INIT {}
DATA aHeader INIT {}
DATA oLVCol
DATA oLVItem
DATA aEvents INIT {}
DATA bOnEvent
DATA view
DATA hLv
DATA oImageListBig, oImageListSmall
DATA hFont
DATA cPath
DATA nIcoLarge INIT 32
DATA nIcoSmall INIT 16
METHOD New( nTop, nLeft, bAction, oWnd, nClrFore, ;
nClrBack, lPixel, lDesign, nWidth, nHeight, ;
cMsg, nIcoLarge, nIcoSmall ) CONSTRUCTOR
METHOD ReDefine( nId, oWnd, bAction ) CONSTRUCTOR
METHOD Notify( nIdCtrl, nPtrNMHDR )
METHOD OnEvent( nEvent, aParams, pParams )
METHOD SetImageList( oImageList, nType )
METHOD InitTheListView()
METHOD Destroy()
METHOD OnDISPINFO()
METHOD SetViewStyle()
METHOD HandleEvent( nMsg, nWParam, nLParam )
METHOD RefreshAll()
METHOD RefreshCurrent( nRec )
METHOD UnMarkAll( lAll )
ENDCLASS
METHOD New( nTop, nLeft, bAction, oWnd, nClrFore, ;
nClrBack, lPixel, lDesign, nWidth, nHeight, cMsg, nIcoLarge, nIcoSmall ) CLASS TGrid
DEFAULT nTop := 0, nLeft := 0, ;
oWnd := GetWndDefault(), ;
nClrFore := oWnd:nClrText, ;
nClrBack := GetSysColor( COLOR_BTNFACE ), ;
lPixel := .f., ;
lDesign := .f., ;
nWidth := 200, nHeight := 21, ;
nIcoLarge := 32, nIcoSmall := 16
::view := LVS_REPORT
::nStyle := nOR( LVS_SHAREIMAGELISTS, WS_CHILD, WS_VISIBLE, IF( lDesign, WS_CLIPSIBLINGS, 0 ), WS_TABSTOP, WS_BORDER, LVS_SHOWSELALWAYS, LVS_AUTOARRANGE , LVS_SINGLESEL, ::view )
// LVS_OWNERDATA
::nId := ::GetNewId()
::oWnd := oWnd
::bAction := bAction
::cMsg := cMsg
::nTop := IF( lPixel, nTop, nTop * SAY_CHARPIX_H )
::nLeft := IF( lPixel, nLeft, nLeft * SAY_CHARPIX_W )
::nBottom := ::nTop + nHeight - 1
::nRight := ::nLeft + nWidth - 1
::lDrag := lDesign
::lCaptured := .f.
::oFont := TFont() :New( "Ms Sans Serif", 0, - 20 )
::nClrText := nClrFore
::nClrPane := nClrBack
::nOption := 1
::bDisplay := { | nPtrNMHDR | ::OnDISPINFO( nPtrNMHDR ) }
::cPath := hb_Dirbase()
IF !EMPTY( oWnd:hWnd )
::Create( CTRL_CLASS )
oWnd:AddControl( Self )
ELSE
oWnd:DefControl( Self )
ENDIF
// ::Default() ???
IF lDesign // what is this ?
::CheckDots()
ENDIF
// handle of Listview
::hLv := ::hWnd
// set FONT
::hFont := ::oFont:hFont
SendMessage( ::hLv, WM_SETFONT, ::hFont, 0 )
// set FULLROWSELECT
LV_CHANGEEXTENDEDSTYLE( ::hLv, nOr( LVS_EX_GRIDLINES, LVS_EX_FULLROWSELECT, LVS_EX_DOUBLEBUFFER ) )
// Icon Size
::nIcoLarge := nIcoLarge
::nIcoSmall := nIcoSmall
::oImageListBig := TImageList() :New( nIcoLarge, nIcoLarge )
::oImageListSmall := TImageList() :New( nIcoSmall, nIcoSmall )
::SetImageList( ::oImageListBig, LVSIL_NORMAL )
::SetImageList( ::oImageListSmall, LVSIL_SMALL )
RETURN Self
METHOD ReDefine( nId, oWnd, bAction ) CLASS TGrid // unknown
DEFAULT oWnd := GetWndDefault()
::nId := nId
::oWnd := oWnd
::bAction := bAction
oWnd:DefControl( Self )
RETURN Self
METHOD Destroy() CLASS TGrid
::oImageListBig:End() // ILDESTROY ?
::oImageListSmall:End()
::Super:End()
RETURN Self
METHOD InitTheListView() CLASS TGrid
LOCAL nCol, nMax
LOCAL nWidth, cCaption, nJustify
FOR nCol := 1 TO LEN( ::aHeader )
nWidth := ::aHeader[ nCol ] [ ID_WIDTH ]
cCaption := VAR2CHAR( ::aHeader[ nCol ] [ ID_HEADER ] ) + CHR( 0 )
nJustify := ::aHeader[ nCol ] [ ID_ALIGN ]
LV_INSERTCOLUMN( ::hLv, nCol, nWidth, cCaption, nJustify ) // Call C-Level Routine (source c_grid.c)
NEXT
nMax := LEN( ::aSource )
// need for LVS_OWNERDATA / ::OnDISPINFO()
LV_SETITEMCOUNT( ::hLv, nMax )
RETURN self
METHOD Notify( nIdCtrl, nPtrNMHDR ) CLASS TGrid
LOCAL nCode := GetNMHDRCode( nPtrNMHDR )
LOCAL nKey
STATIC nOption
DO CASE
CASE nCode == NM_DBLCLK
nOption = GetNMListViewItem( nPtrNMHDR ) + 1
IF ::bClick != nil
::nOption := nOption
EVAL( ::bClick, ::nOption, Self )
ENDIF
CASE nCode == LVN_ITEMCHANGED
nOption = GetNMListViewItem( nPtrNMHDR ) + 1
IF ::nOption != nOption
::nOption := nOption
IF ::bAction != nil
EVAL( ::bAction, ::nOption, Self )
ENDIF
ENDIF
CASE nCode == LVN_GETDISPINFO
nOption = GetNMListViewItem( nPtrNMHDR ) + 1
FWLOG TIME(), "LVN_GETDISPINFO", VAR2CHAR( nOption )
IF ::bDisplay != nil
::nOption := nOption
EVAL( ::bDisplay, ::nOption, Self )
ENDIF
CASE nCode == LVN_KEYDOWN
// nOption = GetNMListViewItem( nPtrNMHDR ) + 1
nKey := LV_GETGRIDVKEY( nPtrNMHDR )
IF nKey = 13
IF ::bClick != nil
// ::nOption := nOption
// use last from LVN_ITEMCHANGED
EVAL( ::bClick, ::nOption, Self )
ENDIF
ENDIF
ENDCASE
RETURN nil
METHOD OnDISPINFO( nPtrNMHDR ) CLASS TGrid // unused
LOCAL st
LOCAL nRec
LOCAL nSub
LOCAL ctext
LOCAL bSaveError, oError
LOCAL aItem
FWLOG TIME(), "OnDISPINFO", VAR2CHAR( nPtrNMHDR )
aItem := LV_GETGRIDDISPINFOINDEX( nPtrNMHDR )
SysRefresh()
// aItem := LV_DISPINFO( nPtrNMHDR )
msgInfo( VAR2CHAR( aItem ) )
FWLOG TIME(), VAR2CHAR( nPtrNMHDR ), VAR2CHAR( aItem )
/***************************
st := LVDISPINFO():New()
st:item:pszText := REPLICATE(CHR(0),255)
st:item:cchTextMax := 255
// ZERO-based :iItem and :iSubItem
//
nRec := st:item:iItem // Array ZERO-based+1
nSub := st:item:iSubItem+1
// use Array ::aSource
//
ctext := ::aSource[nRec+1][nSub]
bSaveError := ErrorBlock()
ErrorBlock( {|e|Break(e)} )
BEGIN SEQUENCE
DO CASE
CASE VALTYPE(cText) = "C" ; cText := TRIM(cText)
CASE VALTYPE(cText) = "N" ; cText := Transform(cText, "999,999,999,999" )
CASE VALTYPE(cText) = "D" ; cText := DTOC(cText)
CASE VALTYPE(cText) = "L" ; cText := IF(cText,"Y","N")
ENDCASE
// Assign Array Text to Display
//
st:item:pszText := ctext // +CHR(0)
RECOVER USING oError
ErrorBlock( bSaveError )
END SEQUENCE
ErrorBlock( bSaveError )
***************************/
RETURN 0
METHOD OnEvent( nEvent, aParams, pParams ) CLASS TGrid // unused
LOCAL nAt := ASCAN( ::aEvents, { | aEvent | aEvent[ 2 ] == nEvent } )
LOCAL cEvent := IF( nAt != 0, ::aEvents[ nAt ] [ 1 ], "" )
IF !EMPTY( ::bOnEvent )
EVAL( ::bOnEvent, IF( !EMPTY( cEvent ), cEvent, nEvent ), aParams, pParams )
ENDIF
RETURN nil
METHOD SetImageList( oImageList, nType ) CLASS TGrid
LOCAL nResult
DEFAULT nType := LVSIL_NORMAL
nResult = SendMessage( ::hLv, LVM_SETIMAGELIST, nType, oImageList:hImageList )
SysRefresh()
RETURN nResult
METHOD SetViewStyle( nView ) CLASS TGrid
DEFAULT nView := LVS_REPORT
DO CASE
CASE nView = LVS_ICON
::nStyle := nOR( LVS_SHAREIMAGELISTS, WS_CHILD, WS_VISIBLE, WS_TABSTOP, WS_BORDER, LVS_SHOWSELALWAYS, LVS_AUTOARRANGE , LVS_SINGLESEL, LVS_ICON )
CASE nView = LVS_SMALLICON
::nStyle := nOR( LVS_SHAREIMAGELISTS, WS_CHILD, WS_VISIBLE, WS_TABSTOP, WS_BORDER, LVS_SHOWSELALWAYS, LVS_AUTOARRANGE , LVS_SINGLESEL, LVS_SMALLICON )
CASE nView = LVS_LIST
::nStyle := nOR( LVS_SHAREIMAGELISTS, WS_CHILD, WS_VISIBLE, WS_TABSTOP, WS_BORDER, LVS_SHOWSELALWAYS, LVS_AUTOARRANGE , LVS_SINGLESEL, LVS_LIST )
CASE nView = LVS_REPORT
::nStyle := nOR( LVS_SHAREIMAGELISTS, WS_CHILD, WS_VISIBLE, WS_TABSTOP, WS_BORDER, LVS_SHOWSELALWAYS, LVS_AUTOARRANGE , LVS_SINGLESEL, LVS_REPORT )
ENDCASE
SetWindowLong( ::hLv, GWL_STYLE, ::nStyle )
::view := nView
REDRAWWINDOW( ::hLv )
UpdateWindow( ::hLv )
RETURN nView
METHOD HandleEvent( nMsg, nWParam, nLParam ) CLASS TGrid // unused
DO CASE
// use for LVS_OWNERDRAWFIXED
CASE nMsg == WM_MEASUREITEM
CASE nMsg == WM_DRAWITEM
ENDCASE
RETURN ::Super:HandleEvent( nMsg, nWParam, nLParam )
METHOD RefreshAll() CLASS TGrid
LOCAL nCount := LV_GetCountPerPage( ::hLv )
LOCAL nTopNo := LV_GetTopIndex( ::hLv )
LV_RedrawItems( ::hLv, nTopNo, nTopNo + nCount )
RETURN self
METHOD RefreshCurrent( nRec ) CLASS TGrid
LV_RedrawItems( ::hLv, nRec, nRec )
RETURN self
METHOD UnMarkAll( lAll ) CLASS TGrid
LOCAL iMax := LV_GETSELECTEDCOUNT( ::hLv )
LOCAL nCount := 0
LOCAL nSel
DEFAULT lAll := .T.
// zurest den markierten
nSel := LV_GetSelectionMark( ::hLv )
LV_SETITEMSTATE( ::hLv, nSel, 0, nOr( LVIS_SELECTED, LVIS_FOCUSED ) )
iMax := LV_GETSELECTEDCOUNT( ::hLv )
IF iMax > 0
nSel := LV_GETNEXTITEM( ::hLv, - 1, nOr( LVNI_SELECTED ) )
LV_SETITEMSTATE( ::hLv, nSel, 0, nOr( LVIS_SELECTED, LVIS_FOCUSED ) )
DO WHILE .T.
nSel := LV_GETNEXTITEM( ::hLv, nSel, nOr( LVNI_SELECTED ) )
nCount ++
IF nSel > 0
LV_SETITEMSTATE( ::hLv, nSel, 0, nOr( LVIS_SELECTED, LVIS_FOCUSED ) )
ELSE
EXIT
ENDIF
IF nCount > iMax
EXIT
ENDIF
ENDDO
ENDIF
RETURN self
//
// how to use Project File and List of *.PRG ?
//
#include "HB_FUNC.PRG"