I hope You help me to understand How I try to create the control Tsections for the question at this topic
viewtopic.php?f=3&t=17783
I try to create a small class but there is something not run also
the test create a first object ( a box white) into a wndchild ( from menu you must click on New option)
On the first control it not show any bitmap because I think to make a little header and on first item must not show any image
the I want insert a new item ( a new bitmap) and click on second menu first option "Append"
Now I use oTest:AddItem(".\bitmaps\secf.bmp") but on the final version the user can select the bitmap's section from a folder
this method must add a new object on the bootom of the first object with a image ( secf.bmp)
for the first Item I use the height of control = 200
when I add a new item and for each item , the height must be += 200
METHOD AddItem(oImg) CLASS TSections
local oItem
Local nvalue
Local nAltura := ::nHeight
nvalue+= nAltura
oItem := TSections():New( ::nTop+nAltura, ::nLeft, ::nWidth, ::nHeight,::oWnd,,,;
,oImg) // nuevo bitmap
aadd( ::aItems, oItem )
return oItem
where is the error ?
it make error or not found the method additem
could you help me ,thanks
test.prg
- Code: Select all Expand view
#include "FiveWin.ch"
#include "Constant.ch"
#define SRCCOPY 0xCC0020
#define COLOR_BTNFACE 15
static oWnd ,oTest
Function Test()
Local oWnd
Local oTest
local oMenu
DEFINE WINDOW oWnd ;
MDI MENU BuildMenu()
ACTIVATE WINDOW oWnd
RETURN NIL
//-------------------------------------------------------------------------------------
Function BuildMenu()
LOCAL oFont
LOCAL oMenu
DEFINE FONT oFont NAME "Tahoma" SIZE 0, -12 BOLD
MENU oMenu 2007
MENUITEM "&Sections"
MENU
MENUITEM "&New Sections" + chr(9) + "Ctrl+N" NAME "btn12" action Nuevo()
MENUITEM "&Open" + chr(9) + "Ctrl+O" NAME "btn2"
MENUITEM "&Save" + chr(9) + "Ctrl+S" NAME "btn3"
SEPARATOR
MENUITEM "Print Preview" NAME "btn6"
SEPARATOR
MENUITEM "E&xit" action oWnd:end()
ENDMENU
MENUITEM "&Edit"
MENU
MENUITEM "&Append " + chr(9) + "Ctrl+A" NAME "btn10" action (oTest:AddItem(".\bitmaps\secf.bmp") )
MENUITEM "&Insert " + chr(9) + "Ctrl+A" NAME "btn10"
MENUITEM "&Delete " + chr(9) + "Ctrl+D" NAME "btn11"
ENDMENU
ENDMENU
return oMenu
//-----------------------------------------------------------------------------------------------
Function Nuevo()
Local oTest
local oWndChild
DEFINE WINDOW oWndChild MDICHILD of oWnd;
TITLE "New Image" ;
VSCROLL
oTest:=TSections():New( , , , ,oWndChild,"nuevo")
ACTIVATE WINDOW oWndChild
return nil
///////////////////////////////////////////////////////////////////
CLASS TSections FROM TControl
DATA aItems AS ARRAY INIT {}
DATA oImg
DATA cCaption // title of groups of images
CLASSDATA lRegistered AS LOGICAL
METHOD New( nTop, nLeft, nWidth, nHeight,oWnd,cTitle)
//METHOD Default()
METHOD Display() INLINE ::BeginPaint(),::Paint(),::EndPaint(),0
//METHOD LButtonDown( nRow, nCol, nKeyFlags )
//METHOD LButtonUp( nRow, nCol, nKeyFlags )
METHOD Paint()
METHOD Destroy()
METHOD AddItem(oImg) // nuevo registro
//METHOD DelItem(oImg) borrar registro
METHOD Separator() separator registros
ENDCLASS
METHOD New( nTop, nLeft, nWidth, nHeight,oWnd,cTitle,nClrFore,;
nClrBack,oImg) CLASS TSections
DEFAULT nTop := 0, nLeft := 0,;
nClrFore := oWnd:nClrText,;
nClrBack := GetSysColor( COLOR_BTNFACE ),;
nWidth := 400, ;
nHeight := 200
::oWnd := oWnd
::nTop := nTop
::nLeft := nLeft
::nBottom := ::nTop + nHeight
::nRight := ::nLeft + nWidth
::aItems := {}
::nStyle = nOR( WS_CHILD, WS_VISIBLE)
::nId = ::GetNewId()
::oFont = TFont():New( "Arial",16, 20 )
::cCaption = cTitle
::Register()
if ! Empty( oWnd:hWnd )
::Create()
oWnd:AddControl( Self )
else
oWnd:DefControl( Self )
endif
::Default()
return Self
METHOD Destroy() CLASS TSections
if ::hWnd != 0
Super:Destroy()
endif
return nil
METHOD Paint() CLASS TSections
local aInfo
local aRect := GetClientRect( ::hWnd )
local hBmpMem,hOldBmp, hDCMem
local hBrush
local n, nItem, oItem
local nItems
nItems := len( ::aItems )
aInfo := ::DispBegin()
hDCMem = CreateCompatibleDC( ::hDC )
hBmpMem = CreateCompatibleBitmap( ::hDC, aRect[ 4 ], aRect[ 3 ] )
hOldBmp = SelectObject( hDCMem, hBmpMem )
nClrPane := CLR_WHITE
hBrush = CreateSolidBrush( nClrPane )
FillRect( hDCMem, aRect, hBrush )
// draw the bitmap if not empty
if ! Empty( ::oImg )
hBitmap = ReadBitmap( 0, ::oImg )
if hBitmap != 0
nWidth := nBmpWidth( hBitmap )
nHeight := nBmpHeight( hBitmap )
nTop := rc[1] + (rc[3]-rc[1])/2 - nHeight/2
if lTransparent
DrawMasked( hDC, hBitmap, nTop, rc[2]+2 )
else
DrawBitmap( hDC, hBitmap, nTop, rc[2]+2 )
endif
DeleteObject( hBitmap )
endif
endif
BitBlt( ::hDC, 0, 0, aRect[4], aRect[3], hDCMem, 0, 0, SRCCOPY )
SelectObject( hDCMem, hOldBmp )
DeleteObject( hBrush )
DeleteObject( hBmpMem )
DeleteDC( hDCMem )
::DispEnd( aInfo )
return NIL
METHOD AddItem(oImg) CLASS TSections
local oItem
Local nvalue
Local nAltura := ::nHeight
nvalue+= nAltura
oItem := TSections():New( ::nTop+nAltura, ::nLeft, ::nWidth, ::nHeight,::oWnd,,,;
,oImg) // nuevo bitmap
aadd( ::aItems, oItem )
return oItem
METHOD Separator() CLASS TSections
local oItem
Local nvalue
Local nAltura := 10
nvalue+= nAltura
oItem :=TSections():New( ::nTop+nAltura, ::nLeft, ::nWidth, ::nHeight,::oWnd,,, )
aadd( ::aItems, oItem )
return oItem
