/*
* MINIGUI - Harbour Win32 GUI library Demo
*
* Copyright 2021, Verchenko Andrey <verchenkoag@gmail.com>
* Copyright 2021, Sergej Kiselev <bilance@bilance.lv>
*
* Пример построения карточки на базе объекта Tab
* События на объектах карточки, контейнер на объектах
* Передача и обработка данных на объектах
* An example of building a card based on the Tab object
* Events at card objects, container at objects
* Transfer and processing of data at sites
*/
#define _HMG_OUTLOG
#include "hmg.ch"
Function Main
Local nG := 20
SET MSGALERT BACKCOLOR TO { 238, 249, 142 } // for HMG_Alert()
DEFINE FONT DlgFont FONTNAME "DejaVu Sans Mono" SIZE 14 // for HMG_Alert()
SET OOP ON
SET FONT TO "Arial", 14
DEFINE WINDOW Form_1 ;
AT 0,0 WIDTH 990 HEIGHT 480 ;
TITLE 'Harbour MiniGUI Demo: Tab + Button event' ;
MAIN ;
BACKCOLOR {0,155,173} ;
ON SIZE SizeTest(nG) ;
ON RELEASE _wSend(103)
(This.Object):Cargo := oKeyData() // создать объект (контейнер) для окна Form_1
(This.Object):Cargo:nBtn := 0
(This.Object):Cargo:nModify := 0
@ 5, 990 - nG - 200 BUTTON Btn_Ex CAPTION "Exit" WIDTH 150 HEIGHT 35 ;
BOLD ACTION ThisWindow.Release
SetTab_1(,nG) // построение Tab / building Tab
myThisObjectEvent() // события на объектах формы / events on form objects
ON KEY ESCAPE ACTION {|| (ThisWindow.Cargo):nModify := 0 , ;
ThisWindow.Release }
END WINDOW
Form_1.Center
Form_1.Activate
Return Nil
////////////////////////////////////////////////////////////////////////////////
Function myThisObjectEvent
(This.Object):Event( 100, {|ow,ky,cn| // обработка кнопок типа "I"
Local oBtn := This.&(cn).Cargo
Local nMod := ow:Cargo:nModify
Local cForm := ow:Name
Local aObjName := oBtn:aObjName // список наименований объектов на строке карточки
? "Event(100) PressButton=" , cn, oBtn:nObjId, oBtn:nBtn, nMod, HB_ValToExp(oBtn:aDim), HB_ValToExp(aObjName)
myPressButtonI(ky, cForm, cn, oBtn:nObjId, oBtn:nBtn, nMod, oBtn:aDim, aObjName)
SetProperty(ow:Name, cn, "Enabled", .T.)
Return Nil
})
(This.Object):Event( 102, {|ow,ky,am| // обработка menu кнопоки типа "I"
Local cn := am[1] // имя кнопки
Local nm := am[2] // номер пункта menu
Local oBtn := This.&(cn).Cargo
Local nMod := ow:Cargo:nModify
Local cForm := ow:Name
Local aObjName := oBtn:aObjName // список наименований объектов на строке карточки
? "Event(102) PressButton=" , cn, nm, oBtn:nObjId, oBtn:nBtn, nMod, HB_ValToExp(oBtn:aDim), HB_ValToExp(aObjName)
MsgDebug("Context menu=",nm," :Event=",ky, cForm, cn, nm, oBtn:nObjId, oBtn:nBtn, nMod, oBtn:aDim, aObjName)
Return Nil
})
(This.Object):Event( 103, {|ow| // Завершение работы
Local nMod := ow:Cargo:nModify
Local cForm := ow:Name, cGet, lGet
Local aGet := HMG_GetFormControls(cForm, "GETBOX")
? "Event(103) GETBOX modifycation=", nMod
IF nMod > 0
FOR EACH cGet IN aGet
lGet := This.&(cGet).Cargo:lModify
? hb_enumindex(cGet), cGet, lGet
IF !Empty(lGet)
?? This.&(cGet).Value
ENDIF
NEXT
ENDIF
Return Nil
})
Return Nil
//////////////////////////////////////////////////
Procedure SizeTest(nG)
Local nW, nH
nW := This.ClientWidth
nH := This.ClientHeight
Form_1.Tab_1.Width := nW - nG*2
Form_1.Tab_1.Height := nH - nG*2
Return
#define COLOR_BTNFACE 15
///////////////////////////////////////////////////////////////////////////////
Procedure SetTab_1( lBottomStyle, nG )
Local nColor := GetSysColor( COLOR_BTNFACE )
Local aColor := {GetRed( nColor ), GetGreen( nColor ), GetBlue( nColor )}
Local nI, nW, nH, aTabBC, aTabName, aRet, aDimCard
Default lBottomStyle := .f.
IF IsControlDefined(Tab_1, Form_1)
Form_1.Tab_1.Release
ENDIF
nW := This.ClientWidth
nH := This.ClientHeight
aTabBC := {159,191,236}
aRet := myListTab() // list of cards for tabs
aDimCard := aRet[1]
aTabName := aRet[2]
DEFINE TAB Tab_1 ;
OF Form_1 ;
AT nG,nG WIDTH nW-nG*2 HEIGHT nH-nG*2 ;
VALUE 1 ;
HOTTRACK ;
BACKCOLOR aTabBC ;
FONT "Tahona" SIZE 16 ;
ON CHANGE {|| NIL /*MsgInfo( 'Page is changed!' )*/ }
_HMG_ActiveTabBottom := lBottomStyle
FOR nI := 1 TO LEN( aTabName )
PAGE aTabName[ nI ] TOOLTIP 'Tooltip ' + aTabName[ nI ]
// Show a list of cards on a tab
ShowPageCard( nI, aDimCard[ nI ] )
END PAGE
NEXT
END TAB
Form_1.Tab_1.BACKCOLOR := aTabBC //aColor
Form_1.Tab_1.HTFORECOLOR := BLACK
Form_1.Tab_1.HTINACTIVECOLOR := Form_1.Backcolor
Return
////////////////////////////////////////////////////////////////////
Function ShowPageCard( nI, aDimLine )
Local nJ, cObj, nRow, nCol, nWName, cName, nHLine, nWidth
Local nFSize, nGLine
nRow := 20 + 40 // отступ сверху Tab_1
nCol := 20
nHLine := 33 // высота строки в карточке
nGLine := 20 // расстояние между строками в карточке
nFSize := 16
// Определение мах длины по наименованию
nWName := 0
FOR nJ := 1 TO LEN( aDimLine )
cName := aDimLine[ nJ, 2 ] + ":"
nWidth := GetTxtWidth( cName, nFSize, "Comic Sans MS" )
nWName := MAX( nWidth, nWName )
NEXT
For nJ := 1 TO LEN( aDimLine )
cObj := "Label_Name" + HB_NtoS( nJ ) + "_Page" + HB_NtoS( nI )
cName := aDimLine[ nJ, 2 ]
@ nRow, nCol LABEL &cObj VALUE cName + ":" ;
WIDTH nWName HEIGHT nHLine FONT "Comic Sans MS" SIZE nFSize ;
FONTCOLOR BLUE TRANSPARENT RIGHTALIGN VCENTER
// показать значений полей базы
myCardFieldGetBox( nI, nJ, cObj, aDimLine[nJ], nRow, nCol + nWName + 5, nHLine, nFSize )
nRow += nHLine + nGLine
Next
Return Nil
///////////////////////////////////////////////////////////////////////////////
Function myCardFieldGetBox( nI, nJ, cObj, aDim, nRow, nCol, nHLine, nFSize )
Local cFName := _HMG_DefaultFontName //, nFSize := _HMG_DefaultFontSize
Local cTypeLine, xPole, nK, xDopType, xDopRun, cRowCardAccess, xRet
Local aField, cField, cAType, cObjGbx, aDimObjAI, nWCol, nWBtn, nHBtn
Local cBtnFontI, nBtnFSizeI, cBtnCaptI, nWidth, cMsg, bBlock, xOldGet
Local cObjGbxA, nObjId, cForm := ThisWindow.Name
cTypeLine := aDim[1] // тип построения строки А-массив, CDN-обычный, M-мемополе и т.д.
xPole := aDim[3] // поля базы данных или А-массив
xDopType := aDim[4] // доп.обработка построения поля базы данных
xDopRun := aDim[5] // вызов функции для кнопки или нет вызова
cRowCardAccess := IIF( LEN(aDim) == 6, aDim[6], "?" ) // доступ юзера к строке карточки
// можно сделать проверку на доступ
nWBtn := nHBtn := nHLine // ширина и высота кнопки
cBtnFontI := "Wingdings"
nBtnFSizeI := nFSize + 6
cBtnCaptI := CHR(40) // 139
cObjGbx := cObj + "_Gbox"
IF cTypeLine == "A"
nWCol := 0 // смещение по строке карточки
aField := xPole // список полей - {"RC_abon" ,"?","RC_abon0","?"}
aDimObjAI := ARRAY( LEN(aField) ) // для типа A - список наименований объектов
// выведенных в этой стоке - передать на кнопку
FOR nK := 1 TO LEN(aField)
cField := ALLTRIM(aField[nK])
cAType := xDopType[nK]
cObjGbxA := cObj + "_A" + cAType + "_" + HB_NtoS(nK)
aDimObjAI[nK] := cObjGbxA
nObjId := nI*1000 + nJ*100 + nK
IF cAType == "D" .OR. cAType == "C" .OR. cAType == "N"
xRet := "ALIAS()->" + cField // FIELDGET(FIELDNUM(cField))
nWidth := GetTxtWidth( xRet, nFSize, cFName ) + 10
xOldGet := xRet // первоначальное значение GetBox
@ nRow , nCol + nWCol GETBOX &cObjGbxA VALUE xRet ;
WIDTH nWidth HEIGHT nHLine ; // ReadOnly ;
ON CHANGE {|| (ThisWindow.Cargo):nModify += 1, ;
_logfile(.t., This.Name, This.Cargo:lModify), ;
This.Cargo:lModify := .T., ;
_logfile(.t., This.Name, This.Cargo:lModify) } ;
ON INIT {|| This.Cargo := oKeyData(), ; // создать объект (контейнер) для этого объекта
This.Cargo:lModify := .F. }
ELSEIF cAType == "I"
(This.Cargo):nBtn := nK
@ nRow, nCol + nWCol BUTTONEX &cObjGbxA WIDTH nWBtn HEIGHT nHBtn ;
CAPTION cBtnCaptI FONT cBtnFontI SIZE nBtnFSizeI ;
NOXPSTYLE HANDCURSOR FONTCOLOR BLACK BACKCOLOR ORANGE ;
ACTION {|| This.Enabled := .F., _wPost(100, , This.Name) } ;
ON INIT {|| This.Cargo := oKeyData() ,; // создать объект (контейнер) для этой кнопки
This.Cargo:nObjId := nObjId ,;
This.Cargo:nBtn := (ThisWindow.Cargo):nBtn,;
This.Cargo:aDim := aDim ,;
This.Cargo:aObjName := aDimObjAI } // ON INIT надо задавать только блоком кода
DEFINE CONTEXT MENU CONTROL &cObjGbxA
MENUITEM "Context menu (1) this Button =" ACTION _wPost(102, , {cObjGbxA, 1})
MENUITEM "Context menu (2) this Button =" ACTION _wPost(102, , {cObjGbxA, 2})
END MENU
nWidth := nWBtn
ELSE
cMsg := "Error! No handling type ["+cAType+"] !;" + HB_ValToExp(aDim)
cMsg += ";;" + ProcNL(0)
cMsg := AtRepl( ";", cMsg, CRLF )
MsgStop( cMsg )
ENDIF
nWCol += nWidth + 2
IF nK % 2 = 0
nWCol += 20
ENDIF
NEXT
ELSEIF cTypeLine == "C" .OR. cTypeLine == "D"
xRet := "ALIAS()->" + xPole
nWidth := GetTxtWidth( xRet, nFSize, cFName ) + 10
xOldGet := xRet // первоначальное значение GetBox
@ nRow , nCol GETBOX &cObjGbx VALUE xRet ;
WIDTH nWidth HEIGHT nHLine ;
ON CHANGE {|| (ThisWindow.Cargo):nModify += 1, ;
_logfile(.t., This.Name, This.Cargo:lModify), ;
This.Cargo:lModify := .T., ;
_logfile(.t., This.Name, This.Cargo:lModify) } ;
ON INIT {|| This.Cargo := oKeyData(), ; // создать объект (контейнер) для этого объекта
This.Cargo:lModify := .F. }
ELSE
cMsg := "Error! No handling type ["+cTypeLine+"] !;" + HB_ValToExp(aDim)
cMsg += ";;" + ProcNL(0)
cMsg := AtRepl( ";", cMsg, CRLF )
MsgStop( cMsg )
ENDIF
Return Nil
////////////////////////////////////////////////////////////////////////////////////
// запись в журнал изменений GETBOX
Function myChangeGetBox(xOld,xNew,cObj)
? ProcNL(), xOld, xNew, cObj
IF VALTYPE(xOld) == "C"
xOld := ALLTRIM(xOld)
xNew := ALLTRIM(xNew)
ENDIF
IF xOld == xNew
// пропуск записи в журнал
ELSE
? " Change Getbox:" + cObj + ", [" + xOld + "] # [" + xNew + "]"
ENDIF
Return Nil
////////////////////////////////////////////////////////////////////////////////////
Function myPressButtonI(nEvent, cForm, cObj, nObjId, nBtn, nMod, aDim, aObjNameLine)
Local cMsg, cRun, cTtl, cBlock, aFunc, aParam, cRet, aFld, cField, cObjRt
cTtl := "nEvent = " + hb_NtoS(nEvent) + ";"
cTtl += "cForm = " + cForm + ";"
cTtl += "cObj = " + cObj + ";"
cTtl += "Button code in line :nObjId = " + hb_NtoS(nObjId) + ";"
cTtl += "Button number in line :nBtn = " + hb_NtoS(nBtn) + ";"
cTtl += "(This.Object):Cargo:nModify = " + hb_NtoS(nMod) + ";"
cTtl += "Card string array passed: aDim= " + hb_ValToExp(aDim) + ";"
cTtl += "The name of the constructed objects of this card line:;"
cTtl += hb_ValToExp(aObjNameLine)
aFunc := aDim[5]
aFld := aDim[3]
cRun := aFunc[nBtn]
cField := aFld[nBtn-1]
cObjRt := aObjNameLine[nBtn-1]
IF !hb_IsFunction( cRun )
cMsg := "Functions " + cRun + "() not in the EXE file!;"
cMsg += "call -" + hb_ValToExp(aDim) + ";"
cMsg := AtRepl( ";", cMsg, CRLF )
MsgStop( cMsg, "Stop!")
ELSE
cTtl := AtRepl( ";", cTtl, CRLF )
aParam := { cTtl, cField, cObjRt, nBtn, aDim }
cBlock := cRun + "(" + hb_ValToExp(aParam) + ")"
cRet := Eval( hb_macroBlock( cBlock ) )
IF LEN(cRet) > 0
SetProperty(cForm, cObjRt, "Value", cRet)
ENDIF
ENDIF
Return Nil
//////////////////////////////////////////////////////////////////////////
Function BtnTestRC(aPar)
Local cTtl, cFld, aDim, aClr, nI, nRet, cRet, aBtn, cMsg, nBtn, cObj
Default aPar := {}
cTtl := aPar[1]
cFld := aPar[2]
cObj := aPar[3]
nBtn := aPar[4]
aDim := aPar[5]
aClr := { YELLOW, RED, GREEN, ORANGE }
aBtn := {}
cRet := ""
FOR nI := 1 TO 4
AADD(aBtn, "0"+hb_ntoS(nI)+"00000"+hb_ntoS(nI) )
NEXT
cMsg := cTtl + ";;"
cMsg += "Select the desired value for the entry!;"
cMsg += "Выберите нужное значение для записи !;"
cMsg += "Запись в поле: " + cFld + " и объект: " + cObj
nRet := HMG_Alert( cMsg, aBtn, aDim[2], NIL, NIL, NIL, aClr, NIL )
IF nRet > 0
cRet := aBtn[nRet]
ENDIF
Return cRet
//////////////////////////////////////////////////////////////////
Function myListTab()
Local i, aTabName, aDim, aRetDim := {}
// TabPage 1
aDim := {}
AADD( aDim, { "A", "Personal account / Personal account-2", {"RC_abon" ,"?","RC_abon0","?"} , {"C","I","C","I"}, {NIL,"BtnTestRC",NIL,"BtnTestRC" } , "2Card:(RC+RC0)" } )
AADD( aDim, { "A", "Personal account-3/ Personal account-4", {"RC_abon3" ,"?","RC_abon4","?"} , {"C","I","C","I"}, {NIL,"BtnTestRC",NIL,"BtnTestRC" } , "2Card:(RC34)" } )
AADD( aDim, { "C", "Name of the subscriber" , "FIO" , nil , nil , "" } )
AADD( aRetDim, aDim )
// TabPage 2
aDim := {}
AADD( aDim, { "D", "Date of Birth" , "DBirth" , nil , nil , "" } )
AADD( aRetDim, aDim )
// TabPage 3
aDim := {}
For i := 1 To 5
AADD( aDim, { "C", "Example of row "+hb_NtoS(i)+" of tab 3", "CTEXT_"+hb_NtoS(i) , nil , nil , "" } )
Next
AADD( aDim, { "A", "Example of an event on a button", {"TEST22" ,"?"} , {"C","I"}, {NIL,"MyTest22"} , "3Card:Test22" } )
AADD( aRetDim, aDim )
aTabName := { "TabPage-1", "TabPage-2","TabPage-3" }
Return { aRetDim, aTabName }
///////////////////////////////////////////////////////////////////////////////
FUNCTION GetTxtWidth( cText, nFontSize, cFontName, lBold ) // получить Width текста
Local hFont, nWidth
Default cText := REPL('A', 2)
Default cFontName := _HMG_DefaultFontName // из MiniGUI.Init()
Default nFontSize := _HMG_DefaultFontSize // из MiniGUI.Init()
Default lBold := .F.
IF Valtype(cText) == 'N'
cText := repl('A', cText)
ENDIF
hFont := InitFont(cFontName, nFontSize, lBold)
nWidth := GetTextWidth(0, cText, hFont) // ширина текста
DeleteObject (hFont)
RETURN nWidth
//////////////////////////////////////////////////
FUNCTION ProcNL(nVal)
Default nVal := 0
RETURN "Call from: " + ProcName(nVal+1) + "(" + hb_ntos(ProcLine(nVal+1)) + ") --> " + ProcFile(nVal+1)
|
). 
)
- участник сейчас на форуме
- участник вне форума