#include "FiveWin.ch"
#include "constant.ch"
static oDlgTest
static oWndMain
static oBar
static oGrid
static oSplit
#define GW_CHILD 5
#define GW_HWNDNEXT 2
#define DEFAULT_GUI_FONT 17
static WM_RESETPOS
#define WM_ERASEBKGND 20
#define SWP_NOSIZE 1
REQUEST DBFCDX
REQUEST DBFFPT
EXTERNAL ORDKEYNO,ORDKEYCOUNT,ORDCREATE,ORDKEYGOTO
FUNCTION Main()
RddSetDefault( "DBFCDX" )
SetHandleCount( 100 )
DEFINE WINDOW oWndMain ;
TITLE "TEST" ;
MENU BuildMenu() ;
COLOR CLR_BLACK, GetSysColor( 15 ) - Rgb( 30, 30, 30 )
BuildBtnBar()
SET MESSAGE OF oWndMain TO "Test>" CENTER NOINSET 2010
oWndMain:bResized := {|| ResizeWndMain() }
ACTIVATE WINDOW oWndMain maximized
RETURN NIL
//-----------------------------------------------------//
FUNCTION BuildMenu()
local oMenu
MENU oMenuMain 2015
MENUITEM i18n("&Archivi")
Menu
MENUITEM i18n( "TEST" ) ;
ACTION TEST()
ENDMENU
ENDMENU
RETURN oMenuMain
//-----------------------------------------------------//
Function ResizeWndMain()
local aClient
IF oDlgTest != NIL
aClient := GetClientRect ( oWndMain:hWnd )
oDlgTest:SetSize( aClient[4], aClient[3] - oBar:nHeight - oWndMain:oMsgBar:nHeight+1 )
IF oGrid != NIL
oGrid:SetSize( aClient[ 4 ] - oGrid:nLeft, oDlgTest:nHeight -26)
oGrid:Refresh()
ENDIF
IF oSplit != NIL
oSplit:SetSize( oSplit:nWidth, oDlgTest:nHeight)
oSplit:Refresh()
ENDIF
oWndMain:oMsgBar:Refresh()
SysRefresh()
ENDIF
return NIL
//-----------------------------------------------------//
Function TEST()
Local nSplit:= 201
oDlgTest := TFsdi():New(oWndMain)
oWndMain:oClient := oDlgTest
oDlgTest:NewFolder( nSplit )
oSplit := TSplitter():New(00,nSplit,(.not..F.) .or. .T.,{ },.not..F.,;
{oGrid},.not..F., {|| 200}, {|| 90},;
oDlgTest,,1,oDlgTest:nGridBottom ,;
.T.,.T.,,.F.,.T.,.T. )
ACTIVATE DIALOG oDlgTest NOWAIT;
ON PAINT (oSplit:AdjClient());
ON INIT(Show_raccoglitori(oGrid), oGrid:SetFocus(),ResizeWndMain())
return nil
//---------------------------------------------------------//
Function BuildBtnBar()
DEFINE BUTTONBAR oBar _3D SIZE 44, 46 OF oWndMain 2015 //36, 40
return nil
//---------------------------------------------------------//
function Show_raccoglitori(oGrid)
local oFontsmall:= TFont():New( "Tahoma", 0, -10,,.F. )
Local cCursor:= TCursor():New(,'HAND')
local nRow := 40 //+oBar:nHeight
local ncol := 10
Local nsizeW:= 120
Local nsizeh:= 150
llocal aBmp:= {".\bitmaps\fivewin.bmp" ,;
".\bitmaps\fivewin.bmp" ,;
".\bitmaps\fivewin.bmp" ,;
".\bitmaps\fivewin.bmp" ,;
".\bitmaps\fivewin.bmp" }
local n:= 1
local oBtn
local oBasket
Create_Faldoni()
USE FALDONI ALIAS RA
oBasket:=TPanelex():New( 0,;
0,;
oDlgTest:nGridBottom,;
oDlgTest:nGridRight, oGrid:aDialogs[ 1 ],,.t.)
nCount:=RA->(OrdKeyCount())
oBtn:= array(nCount)
k:= 1
RA->(dbgotop())
Do While ! Ra->(eof())
@ nrow,ncol btnbmp oBtn[n] Filename aBmp[RA->RACOLORE] ;
SIZE nsizeW,nsizeh ;
Prompt str2lines(alltrim(Ra->Radesc)," ") ;
noborder CENTER;
font ofontsmall of oBasket ;
ACTION MSGINFO()
oBtn[n]:lTransparent:=.T.
oBtn[n]:oCursor:= cCursor
ncol:= ncol+nsizeW+2
n:=n+1
k++
IF k = 5
nRow += nsizeh+20
ncol := 10
k:= 1
Endif
RA->(dbSkip())
Enddo
for n=1 to len(oBtn)
oBtn[n]:setfocus()
next
/*
oBasket:bResized := {|| rc := GetClientRect(oBasket:hWnd),;
oWnd:nWidth := rc[4],;
oWnd:nWidth := rc[4] - 20,;
oWnd:nWidth := rc[4] - 20}
*/
oGrid:aDialogs[ 1 ]:oClient := oBasket
return nil
//---------------------------------------------------------//
FUNCTION Str2Lines( string, parser )
Local cStrLines:= CRLF+"", nLenPar:= Len( parser )
Local commapos := 0
If parser == NIL .OR. parser == "e"
parser := " "
EndIf
Do While Len( string ) > 0
commapos := at( parser, string )
IF commapos > 0
cStrLines+= Left( string, commapos - 1 ) + CRLF + ""
string := SubStr( string, commapos + Len( parser ) )
ELSE
cStrLines+= string
string := ''
ENDIF
ENDDO
RETURN( cStrLines )
//---------------------------------------------------------//
Function Create_Faldoni()
Local cDir:=""
DbCreate(cDir+'RA', {{ "RACODICE" , "C", 4, 0 },;
{ "RADESC " , "C", 25, 0 },;
{ "RACOLORE" , "N", 1, 0 } } , 'DBFCDX')
close all
use &(cDir+'RA') new
select RA
if FILE(cDir+'FALDONI.DBF')
delete file &(cdir+'FALDONI.cdx')
append from &(cdir+'FALDONI')
dbcommitall()
close all
delete file &(cdir+'FALDONI.dbf')
endif
close all
rename &(cdir+'RA.dbf') to &(cdir+'FALDONI.dbf')
return nil
//---------------------------------------------------------//
CLASS TPanelEx FROM TPanel
DATA lVScroll
CLASSDATA lRegistered AS LOGICAL
METHOD New( nTop, nLeft, nBottom, nRight, oWnd, nClrPane, lVScroll ) CONSTRUCTOR
METHOD Paint()
METHOD Display() INLINE ::BeginPaint(), ::Paint(), ::EndPaint(),0
METHOD VScroll( nWParam, nLParam )
METHOD MouseWheel( nKey, nDelta, nXPos, nYPos )
METHOD HandleEvent( nMsg, nWParam, nLParam )
METHOD Disable()
METHOD Enable()
METHOD Destroy()
METHOD GetText() INLINE ::cCaption
ENDCLASS
METHOD New( nTop, nLeft, nBottom, nRight, oWnd, nClrPane, lVScroll ) CLASS TPanelEx
DEFAULT nTop := 0, nLeft := 0, nBottom := 100, nRight := 100,;
oWnd := GetWndDefault(), nClrPane := CLR_WHITE, lVScroll := .f.
::nTop := nTop
::nLeft := nLeft
::nBottom := nBottom
::nRight := nRight
::oWnd := oWnd
::nStyle := nOr( WS_CHILD, WS_VISIBLE, WS_CLIPSIBLINGS, WS_CLIPCHILDREN, WS_VSCROLL )
::lDrag := .f.
::nClrPane := nClrPane
::aControls := {}
::lVScroll := lVScroll
::cCaption := ""
#ifdef __XPP__
DEFAULT ::lRegistered := .f.
#endif
::Register()
::SetColor( 0, nClrPane )
if ! Empty( ::oWnd:hWnd )
::Create()
::oWnd:AddControl( Self )
else
::oWnd:DefControl( Self )
endif
::oVScroll := TScrollBar():WinNew( ,,, .t., self )
::oVScroll:SetRange(0,0)
WM_RESETPOS := RegisterWindowMessage( "WM_RESETPOS" )
return Self
*************************************************************************************************************************************
METHOD Destroy() CLASS TPanelEx
*************************************************************************************************************************************
return super:Destroy()
METHOD HandleEvent( nMsg, nWParam, nLParam ) CLASS TPanelEx
local n, nLen
do case
case nMsg == WM_ERASEBKGND
return 1
case nMsg == WM_RESETPOS
nLen := len( ::aControls )
for n := 1 to nLen
::aControls[n]:Move(0,0,,,.t.)
next
::oVScroll:SetPos(0)
::Refresh()
endcase
return Super:HandleEvent( nMsg, nWParam, nLParam )
***************************************************************************
METHOD Paint() CLASS TPanelEx
***************************************************************************
local cText
local hFont
local hOldFont
local nHLen
local n, nLen
local nHeight := ::nHeight
local nMaxB := 0
local nMinTop := int(nHeight / 2)
local nMaxBottom := int(nHeight / 2)
super:Paint()
if ::lVScroll
nLen := len( ::aControls )
for n := 1 to nLen
if IsWindowVisible( ::aControls[n]:hWnd )
nMinTop := min( WndTop( ::aControls[n]:hWnd ), nMinTop )
nMaxBottom := max( WndTop( ::aControls[n]:hWnd )+ ::aControls[n]:nHeight, nMaxBottom )
endif
next
if nMinTop < 0 .or. nMaxBottom > nHeight
::oVScroll:SetRange( 0, 10 )
else
::oVScroll:SetRange( 0, 0 )
endif
endif
if ::nClrPane != nil
FillSolidRect( ::hDC, GetClientRect(::hWnd), ::nClrPane )
endif
if ::bPainted != nil
Eval( ::bPainted, ::hDC, self )
endif
return nil
***************************************************************************
METHOD VScroll( nWParam, nLParam ) CLASS TPanelEx
***************************************************************************
local nScrollCode := nLoWord( nWParam )
local nPos := nHiWord( nWParam )
local n, nLen
local nTop
local nLeft
local n2, nLen2
do case
case nScrollCode == SB_LINEUP
::oVScroll:GoUp()
nPos := ::oVScroll:GetPos()
nLen := len( ::aControls )
for n := 1 to nLen
nTop := -(((::aControls[n]:nHeight - GetClientRect(::hWnd )[3])/10)*nPos)
if nTop > 3
nTop := 0
endif
nLeft := ::aControls[n]:nLeft
::aControls[n]:Move( nTop,nLeft,,,.t. )
::aControls[n]:Refresh()
next
return 0
case nScrollCode == SB_LINEDOWN
::oVScroll:GoDown()
nPos := ::oVScroll:GetPos()
nLen := len( ::aControls )
for n := 1 to nLen
nTop := -(((::aControls[n]:nHeight - GetClientRect(::hWnd )[3])/10)*nPos)
if nTop > 3
nTop := 0
endif
nLeft := ::aControls[n]:nLeft
::aControls[n]:Move( nTop,nLeft,,,.t. )
::aControls[n]:Refresh()
next
return 0
case nScrollCode == SB_PAGEUP
::oVScroll:PageUp()
nPos := ::oVScroll:GetPos()
nLen := len( ::aControls )
for n := 1 to nLen
nTop := -(((::aControls[n]:nHeight - GetClientRect(::hWnd )[3])/10)*nPos)
if nTop > 3
nTop := 0
endif
nLeft := ::aControls[n]:nLeft
::aControls[n]:Move( nTop,nLeft,,,.t. )
next
return 0
case nScrollCode == SB_PAGEDOWN
::oVScroll:PageDown()
nPos := ::oVScroll:GetPos()
nLen := len( ::aControls )
for n := 1 to nLen
nTop := -(((::aControls[n]:nHeight - GetClientRect(::hWnd )[3])/10)*nPos)
if nTop > 3
nTop := 0
endif
nLeft := ::aControls[n]:nLeft
::aControls[n]:Move( nTop,nLeft,,,.t. )
next
case nScrollCode == SB_TOP
::oVScroll:GoTop()
nPos = ::oVScroll:nMin
::oVScroll:SetPos(nPos)
nLen := len( ::aControls )
for n := 1 to nLen
nTop := -(((::aControls[n]:nHeight - GetClientRect(::hWnd )[3])/10)*nPos)
if nTop > 3
nTop := 0
endif
nLeft := ::aControls[n]:nLeft
::aControls[n]:Move( nTop,nLeft,,,.t. )
next
::Refresh( .f. )
::Refresh( .f. )
case nScrollCode == SB_BOTTOM
nPos = ::oVScroll:nMax
::oVScroll:SetPos(nPos)
nLen := len( ::aControls )
for n := 1 to nLen
nTop := -(((::aControls[n]:nHeight - GetClientRect(::hWnd )[3])/10)*nPos)
if nTop > 3
nTop := 0
endif
nLeft := ::aControls[n]:nLeft
::aControls[n]:Move( nTop,nLeft,,,.t. )
next
::Refresh( .f. )
return 0
case nScrollCode == SB_THUMBTRACK
nPos := GetScrollInfoPos( ::hWnd, 1 )
nLen := len( ::aControls )
for n := 1 to nLen
nTop := -(((::aControls[n]:nHeight - GetClientRect(::hWnd )[3])/10)*nPos)
if nTop > 3
nTop := 0
endif
nLeft := ::aControls[n]:nLeft
::aControls[n]:Move( nTop,nLeft,,,.t. )
next
case nScrollCode == SB_THUMBPOSITION
::oVScroll:ThumbPos( nPos )
otherwise
return nil
endcase
::oVScroll:SetPos( nPos )
return 0
*************************************************************************************
METHOD MouseWheel( nKeys, nDelta, nXPos, nYPos ) CLASS TPanelEx
*************************************************************************************
if ::lVScroll
if nDelta < 0
::VScroll( nMakeLong( SB_LINEUP, 0 ),0)
else
::VScroll( nMakeLong( SB_LINEDOWN, 0 ),0)
endif
endif
return nil
*************************************************************************************
METHOD Disable() CLASS TPanelEx
*************************************************************************************
local hCtrl := GetWindow( ::hWnd, GW_CHILD )
local oCtrl
while hCtrl != 0
oCtrl := oWndFromhWnd( hCtrl )
if oCtrl != nil
oCtrl:Disable()
oCtrl:Refresh()
endif
hCtrl = GetWindow( hCtrl, GW_HWNDNEXT )
end
return 0
*************************************************************************************
METHOD Enable() CLASS TPanelEx
*************************************************************************************
local hCtrl := GetWindow( ::hWnd, GW_CHILD )
local oCtrl
while hCtrl != 0
oCtrl := oWndFromhWnd( hCtrl )
if oCtrl != nil
oCtrl:Enable()
oCtrl:Refresh()
endif
hCtrl = GetWindow( hCtrl, GW_HWNDNEXT )
end
return 0
//---------------------------------------------------------//
//---------------------------------------------------------//
//---------------------------------------------------------//
// create a dialog style nor 4 into a main window
CLASS TFsdi FROM TDialog
DATA nGridBottom, nGridRight
CLASSDATA lRegistered AS LOGICAL
METHOD New( oWnd, lPixels ) CONSTRUCTOR
METHOD NewFolder(nSplit)
METHOD AdjClient()
ENDCLASS
METHOD New( oWnd ) CLASS TFsdi
local aClient
default oWnd := oWndMain // GetWndDefault()
aClient := GetClientRect (oWnd:hWnd )
::oWnd = oWnd
::nTop = oBar:nHeight
::nLeft = 0
::nBottom = aClient[3] - 1
::nRight = aClient[4]
::nStyle := nOR( WS_CHILD, 4 )
::lHelpIcon := .f.
::lTransparent := .f.
DEFINE FONT ::oFont NAME 'Tahoma' SIZE 0, -12
::nGridBottom := (::nBottom / 2) - oBar:nHeight
::nGridRight := (::nRight / 2 )
::aControls := {}
::SetColor( CLR_WHITE, GetSysColor(15) ) // GetSysColor(15)-RGB(30,30,30) )
::Register( nOr( CS_VREDRAW, CS_HREDRAW ) )
SetWndDefault( Self ) // Set Default DEFINEd Window
return Self
METHOD NewFolder( nSplit ) CLASS TFsdi
Local aPrompts:={"test"}
oGrid := TFolder():New( , , aPrompts, , oDlgTest)
oGrid:nTop := 00
oGrid:nLeft := nSplit+2
oGrid:nBottom := oDlgTest:nGridBottom
oGrid:nRight := oDlgTest:nGridRight
return nil
//---------------------------------------------------------//
METHOD AdjClient() CLASS TFsdi
return nil
//---------------------------------------------------------//
//end
I wish show all this collectors , I cannot want use xbrowse but only a list of images ( btnbmp) where the final user can click on
Return to FiveWin for Harbour/xHarbour
Users browsing this forum: Google [Bot], ShumingWang and 52 guests