/*
* MINIGUI - Harbour Win32 GUI library Demo
* Copyright 2018 Sergej Kiselev <bilance@bilance.lv>
*
* Tsbrowse: Таблица и работа с базой - Seek, Find, Scope, Complex Scope
* Tsbrowse: Table and work with the base - Seek, Find, Scope, Complex Scope
*/
#define _HMG_OUTLOG
#include "hmg.ch"
#include "TSBrowse.ch"
REQUEST DBFCDX
PROCEDURE Main
LOCAL oBrw, aAlias, hSpl, o, w, h
LOCAL cTitle := "(5) TsBrowse Demo: Seek + Find + Scope + Complex Scope"
rddSetDefault( 'DBFCDX' )
SET EPOCH TO 2000
SET DATE TO GERMAN
SET CENTURY ON
SET DELETED ON
SET AUTOPEN OFF
SET OOP ON
SET FONT TO "Arial", 10
SET DIALOGBOX CENTER OF PARENT
aAlias := UseOpenBase()
DEFINE WINDOW Form_0 ;
At 0, 0 ;
WIDTH 850 ;
HEIGHT 700 ;
TITLE cTitle ;
ICON "MG_ICO" ;
MAIN ;
NOMAXIMIZE NOSIZE ;
ON INIT ( _wPost(1, oBrw, oBrw), oBrw:SetFocus(), DoEvents() ) ;
ON RELEASE AEval(aAlias, {|wa| dbCloseArea(wa) })
DEFINE STATUSBAR
STATUSITEM "Item 1"
STATUSITEM cTitle WIDTH 390 FONTCOLOR BLUE
STATUSITEM "Order: " + HB_NtoS(INDEXORD()) + " " + OrdName(INDEXORD()) WIDTH 140
KEYBOARD
END STATUSBAR
DEFINE SPLITBOX HANDLE hSpl
DEFINE TOOLBAR ToolBar_1 CAPTION "" BUTTONSIZE 100,32 FLAT
BUTTON Seek CAPTION 'Seek' PICTURE 'n1' SEPARATOR WHOLEDROPDOWN
DEFINE DROPDOWN MENU BUTTON Seek
ITEM "Seek first 15.10.2018" IMAGE 'n1' ACTION mySeek(oBrw, 1, .F.)
ITEM "Seek last 15.10.2018" IMAGE 'n2' ACTION mySeek(oBrw, 1, .T.)
SEPARATOR
ITEM "Seek first 17.10.2018" IMAGE 'n3' ACTION mySeek(oBrw, 2, .F.)
ITEM "Seek last 17.10.2018" IMAGE 'n4' ACTION mySeek(oBrw, 2, .T.)
SEPARATOR
ITEM "Seek first 20.10.2018" IMAGE 'n5' ACTION mySeek(oBrw, 3, .F.)
ITEM "Seek last 20.10.2018" IMAGE 'n6' ACTION mySeek(oBrw, 3, .T.)
END MENU
BUTTON Find CAPTION 'Find' PICTURE 'n2' SEPARATOR WHOLEDROPDOWN
DEFINE DROPDOWN MENU BUTTON Find
ITEM 'Find first "aaa"' IMAGE 'n1' ACTION myFind(oBrw, 'aaa', .F.)
ITEM 'Find next "aaa"' IMAGE 'n2' ACTION myFind(oBrw, 'aaa', .T.)
SEPARATOR
ITEM 'Find first "ccc"' IMAGE 'n3' ACTION myFind(oBrw, 'ccc', .F.)
ITEM 'Find next "ccc"' IMAGE 'n4' ACTION myFind(oBrw, 'ccc', .T.)
END MENU
BUTTON Scope CAPTION 'Scope' PICTURE 'n3' SEPARATOR WHOLEDROPDOWN
DEFINE DROPDOWN MENU BUTTON Scope
ITEM "Scope first 15.10.2018" IMAGE 'n1' ACTION myScope(oBrw, 1, .F.)
ITEM "Scope last 15.10.2018" IMAGE 'n2' ACTION myScope(oBrw, 1, .T.)
SEPARATOR
ITEM "Scope first 17.10.2018" IMAGE 'n3' ACTION myScope(oBrw, 2, .F.)
ITEM "Scope last 17.10.2018" IMAGE 'n4' ACTION myScope(oBrw, 2, .T.)
SEPARATOR
ITEM "Scope first 20.10.2018" IMAGE 'n5' ACTION myScope(oBrw, 3, .F.)
ITEM "Scope last 20.10.2018" IMAGE 'n6' ACTION myScope(oBrw, 3, .T.)
SEPARATOR
ITEM "Scope first 15.10.2018-17.10.2018" IMAGE 'n7' ACTION myScope(oBrw, 4, .F.)
ITEM "Scope last 15.10.2018-17.10.2018" IMAGE 'n8' ACTION myScope(oBrw, 4, .T.)
SEPARATOR
ITEM "Scope first 17.10.2018-20.10.2018" IMAGE 'n9' ACTION myScope(oBrw, 5, .F.)
ITEM "Scope last 17.10.2018-20.10.2018" IMAGE 'n10' ACTION myScope(oBrw, 5, .T.)
SEPARATOR
ITEM "Reset scope first" IMAGE 'n11' ACTION myScope(oBrw, 0, .F.)
ITEM "Reset scope last " IMAGE 'n12' ACTION myScope(oBrw, 0, .T.)
END MENU
BUTTON Scope2 CAPTION 'Complex Scope' PICTURE 'n4' SEPARATOR WHOLEDROPDOWN
DEFINE DROPDOWN MENU BUTTON Scope2
ITEM "Complex Scope first Nr.=444" IMAGE 'n1' ACTION myScope2(oBrw, 1, .F.)
ITEM "Complex Scope last Nr.=444" IMAGE 'n2' ACTION myScope2(oBrw, 1, .T.)
SEPARATOR
ITEM "Complex Scope first Nr.=555" IMAGE 'n3' ACTION myScope2(oBrw, 2, .F.)
ITEM "Complex Scope last Nr.=555" IMAGE 'n4' ACTION myScope2(oBrw, 2, .T.)
SEPARATOR
ITEM "Reset scope first" IMAGE 'n5' ACTION myScope2(oBrw, 0, .F.)
ITEM "Reset scope last " IMAGE 'n6' ACTION myScope2(oBrw, 0, .T.)
END MENU
BUTTON Delete CAPTION 'Delete tag' PICTURE 'n5' SEPARATOR WHOLEDROPDOWN
DEFINE DROPDOWN MENU BUTTON Delete
ITEM "Goto first" IMAGE 'n1' ACTION myDelete(oBrw, 0, .F.)
ITEM "Goto last " IMAGE 'n2' ACTION myDelete(oBrw, 0, .T.)
SEPARATOR
ITEM "Set deleted on" IMAGE 'n3' ACTION myDelete(oBrw, 1, .F.)
ITEM "Reset view" IMAGE 'n4' ACTION myDelete(oBrw, 2, .F.)
END MENU
BUTTON InfoDb CAPTION 'Info-Dbase' PICTURE 'n0' SEPARATOR WHOLEDROPDOWN
DEFINE DROPDOWN MENU BUTTON InfoDb
ITEM "Database Information" IMAGE 'n0' ACTION InfoDbase()
END MENU
END TOOLBAR
DEFINE TOOLBAR ToolBar_2 CAPTION "" BUTTONSIZE 42,32 FLAT
BUTTON Exit CAPTION 'Exit' PICTURE 'exit' ACTION ThisWindow.Release()
END TOOLBAR
END SPLITBOX
y := x := 5
g := 2
w := 90
h := 30
y += GetWindowHeight(hSpl)
x := 5
@ y, x LABEL Label_1 WIDTH This.ClientWidth - x * 2 HEIGHT 24 VALUE ' ' ;
VCENTERALIGN
y += 24 + 2
w := This.ClientWidth - x * 2
h := This.ClientHeight - y - 2 - This.StatusBar.Height
oBrw := CreateBrowse(y, x, w, h)
oBrw:bChange := {|ob| _wPost(1, ob, ob) }
FOR EACH o IN oBrw:aColumns
o:bGotFocus := {|no,nc,ob| _wPost(1, ob, ob) }
o:nEditRow := This.Label_1.Row
o:nEditCol := This.Label_1.Col
o:nEditWidth := This.Label_1.Width
o:nEditHeight := This.Label_1.Height
o:nEditAlign := DT_LEFT
o:lEdit := .T.
NEXT
(This.Object):Event( 1, {|ots,ky,ob| ky := ob:bDataEval(ob:nCell), ;
This.Label_1.Value := cValToChar(ky) } )
END WINDOW
Form_0.Center
Form_0.Activate
RETURN
FUNCTION CreateBrowse( y, x, w, h )
LOCAL nI, aFields, oBrw
DEFINE TBROWSE oBrw AT y, x ;
OF Form_0 ;
ALIAS "TEST" ;
WIDTH w ;
HEIGHT h ;
GRID ;
COLORS { CLR_BLACK, CLR_BLUE }
:SetAppendMode( .F. ) // вставка записи запрещена (в конце базы стрелкой вниз)
:SetDeleteMode( .T., .T. ) // удаление записи разрешено
:lNoHScroll := .T. // показ горизонтального скролинга
:lCellBrw := .F.
:lInsertMode := .T. // флаг для переключения режима Вставки при редактировании
:lPickerMode := .F. // ввод формата колонки типа ДАТА сделать через цифры
END TBROWSE
ADD COLUMN TO TBROWSE oBrw DATA {|| hb_ntoc((oBrw:cAlias)->( OrdKeyNo() )) } ;
HEADER "№№" SIZE 40 ;
COLORS {CLR_BLACK, WHITE} ALIGN DT_CENTER, DT_CENTER, DT_CENTER ;
NAME NN
// initial columns
aFields := { "F2", "F1", "F0", "F5","F3", "F4" }
LoadFields( "oBrw", "Form_0", .F., aFields )
ADD COLUMN TO TBROWSE oBrw DATA {|| hb_ntoc((oBrw:cAlias)->( RecNo() )) } ;
HEADER "Recno" SIZE 70 ;
COLORS {CLR_BLACK, WHITE} ALIGN DT_CENTER ;
NAME REC
// Set columns width
oBrw:SetColSize( oBrw:nColumn( "F0" ), 60 )
oBrw:SetColSize( oBrw:nColumn( "F5" ), 60 )
oBrw:SetColSize( oBrw:nColumn( "F1" ), 80 )
oBrw:SetColSize( oBrw:nColumn( "F2" ), 200 )
oBrw:SetColSize( oBrw:nColumn( "F3" ), 80 )
oBrw:SetColSize( oBrw:nColumn( "F4" ), 70 )
// Set names for the table header
oBrw:GetColumn( "F0" ):cHeading := "Nr."
oBrw:GetColumn( "F0" ):nAlign := DT_CENTER
oBrw:GetColumn( "F5" ):cHeading := "Room"
oBrw:GetColumn( "F5" ):nAlign := DT_CENTER
oBrw:GetColumn( "F2" ):cHeading := "Text"
oBrw:GetColumn( "F1" ):cHeading := "Date"
oBrw:GetColumn( "F1" ):nAlign := DT_CENTER
oBrw:GetColumn( "F3" ):cHeading := "Number"
oBrw:GetColumn( "F4" ):cHeading := "Logical"
oBrw:GetColumn('F1'):cPicture := Nil // пустые поля отображать как пробел
oBrw:GetColumn('NN'):cFooting := {|nc, ob| nc := ob:nLen, iif( Empty( nc ), '', hb_ntos( nc ) ) }
oBrw:nWheelLines := 1
oBrw:nColOrder := 0
oBrw:nClrLine := COLOR_GRID // цвет линий между ячейками таблицы
oBrw:lNoChangeOrd := TRUE // убрать сортировку по полю
oBrw:nColOrder := 0 // убрать значок сортировки по полю
oBrw:lCellBrw := TRUE
oBrw:lNoVScroll := TRUE // отключить показ горизонтального скролинга
oBrw:hBrush := CreateSolidBrush( 242, 245, 204 ) // цвет фона под таблицей
// prepare for showing of Double cursor
AEval( oBrw:aColumns, {| oCol | oCol:lFixLite := .T., ;
oCol:lEdit := .F., ;
oCol:lOnGotFocusSelect := .T., ;
oCol:lEmptyValToChar := .T. } )
// oCol:lOnGotFocusSelect := .T. - включат засинение данных при получении фокуса
// GetBox-ом и сбрасывает, очищает поле при нажатии первого символа
// oCol:lEmptyValToChar := .T. - при .T. переводит empty(...) значение поля в ""
oBrw:nHeightCell += 10 // к высоте ячеек таблицы добавим
oBrw:nHeightHead += 5 // к высоте шапки таблицы добавим
oBrw:SetColor( { 1 }, { RGB( 0, 12, 120 ) } )
oBrw:SetColor( { 2 }, { RGB( 242, 245, 204 ) } )
oBrw:SetColor( { 5 }, { RGB( 0, 0, 0 ) } )
oBrw:SetColor( { 6 }, { { | a, b, oBr | IF( oBr:nCell == b, { RGB( 66, 255, 236 ), RGB( 111, 183, 155 ) }, ;
{ CLR_HRED, CLR_HCYAN } ) } } ) // cursor backcolor
// ставим цвет по условию
For nI := 1 To oBrw:nColCount()
oCol := oBrw:aColumns[ nI ]
oCol:nClrFore := {|| iif( DELETED(), CLR_YELLOW, CLR_BLACK ) }
oCol:nClrBack := {|| iif( DELETED(), CLR_GRAY , RGB( 242, 245, 204 ) ) }
Next
oBrw:ResetVScroll() // показ вертикального скролинга таблицы
oBrw:lFooting := .T. // использовать подвал таблицы
oBrw:lDrawFooters := .T. // рисовать подвал таблицы
oBrw:nHeightFoot := oBrw:nHeightCell-6 // высота строки подвала таблицы
oBrw:DrawFooters() // выполнить прорисовку подвала таблицы
oBrw:nFreeze := 1 // Заморозить столбец
oBrw:lLockFreeze := .T. // Избегать прорисовки курсора на замороженных столбцах
oBrw:AdjColumns()
oBrw:SetNoHoles() // убрать дырку внизу таблицы перед подвалом
oBrw:GoPos( 7,3 ) // передвинуть МАРКЕР на 5 строку и 3 колонку
RETURN oBrw
FUNCTION UseOpenBase()
LOCAL aStr := {}
LOCAL cDbf := GetStartUpFolder() + "\test5"
LOCAL cIndx := cDbf
LOCAL lDbfNo, aChr := {}
LOCAL aAlias := {}
LOCAL i, c, d, j, n := 0
LOCAL a := {'aaa','bbb','ccc','ddd','eee'}
LOCAL r := {'c','b','a',' '}
FOR i := 64 TO 240
AADD( aChr, CHR(i) )
NEXT
IF ( lDbfNo := ! File( cDbf+'.dbf' ) )
AAdd( aStr, { 'F0', 'N', 7, 0 } )
AAdd( aStr, { 'F1', 'D', 8, 0 } )
AAdd( aStr, { 'F2', 'C', 60, 0 } )
AAdd( aStr, { 'F3', 'N', 10, 2 } )
AAdd( aStr, { 'F4', 'L', 1, 0 } )
AAdd( aStr, { 'F5', 'C', 5, 0 } )
dbCreate( cDbf, aStr )
ENDIF
IF lDbfNo .OR. !File( cIndx+'.cdx' )
USE ( cDbf ) ALIAS TEST EXCLUSIVE NEW
c := CtoD('20.10.2018')
WHILE TEST->( RecCount() ) < ( 15 * 4 )
d := c - n++
TEST->( dbAppend() )
TEST->F1 := d
TEST->F2 := "Line - " + str( n, 3 ) + " " + REPL(aChr[n], 12 )
TEST->F3 := n
TEST->F4 := ( n % 2 ) == 0
For i := 1 To Len(a)
TEST->( dbAppend() )
TEST->F1 := d
TEST->F0 := i
TEST->F2 := a[ i ]
TEST->F3 := i * 10
Next
END
n := 10
c := 10
j := 1
GO TOP
DO WHILE !EOF()
i := RECNO()
TEST->F5 := HB_NtoS(n)
IF ( i % 2 ) == 0
TEST->F5 := HB_NtoS(n) + r[1]
ENDIF
IF ( i % 3 ) == 0
TEST->F5 := HB_NtoS(n) + r[2]
ENDIF
IF ( i % 4 ) == 0
TEST->F5 := HB_NtoS(n) + r[3]
ENDIF
IF ( i % 5 ) == 0
n++
ENDIF
IF ( i % 8 ) == 0 .OR. ( i % 9 ) == 0
TEST->F0 := 444
TEST->F2 := ALLTRIM(TEST->F2) + " (444)"
TEST->F5 := HB_NtoS(c) + r[j]
j++
j := IIF(j > LEN(r), 1, j)
c--
ENDIF
IF ( i % 11 ) == 0 .OR. ( i % 12 ) == 0
TEST->F0 := 555
TEST->F2 := ALLTRIM(TEST->F2) + " (555)"
TEST->F5 := HB_NtoS(c) + r[j]
c--
ENDIF
c := IIF(c < 1, 8, c)
IF ( i % 6 ) == 0
TEST->F2 := " (deleted records)"
TEST->F1 := CTOD("")
TEST->F0 := 0
TEST->F3 := 0
TEST->F4 := .F.
TEST->F5 := ""
DbDelete()
ENDIF
SKIP
ENDDO
GO TOP
INDEX ON DTOS(F1)+STR(F0) TAG DTN FOR !Deleted()
INDEX ON RECNO() TAG DEL FOR Deleted()
// Необходимо для этого индекса указать длину, иначе нет ясности к какой длине приводить
// It is necessary to specify the length for this index, otherwise it is not clear what length to bring
INDEX ON STR(F0, 7)+STR(VAL(F5), 4)+F5 TAG ROOM FOR !Deleted()
USE
ENDIF
SET AUTOPEN ON
USE ( cDbf ) ALIAS TEST SHARED NEW
If OrdCount() > 0
OrdSetFocus(1)
EndIf
GO TOP
SET AUTOPEN OFF
AADD( aAlias, ALIAS() )
RETURN aAlias
FUNCTION mySeek( oBrw, nDat, lLast )
LOCAL lRet, cDat, cVal
LOCAL aDat := { ;
CtoD('15.10.2018'), ;
CtoD('17.10.2018'), ;
CtoD('20.10.2018'), ;
}
DbSetOrder(1)
cVal := "Order: " + HB_NtoS(INDEXORD()) + " " + OrdName(INDEXORD())
SetProperty( ThisWindow.Name, "StatusBar" , "Item" , 3, cVal )
cDat := DtoS(aDat[ nDat ])
lRet := oBrw:SeekRec(cDat, .T., lLast)
oBrw:SetFocus()
RETURN lRet
FUNCTION myFind( oBrw, cTxt, lNext )
LOCAL lRet, b, l := len(cTxt)
DbSetOrder(0)
oBrw:Refresh()
cVal := "Order: " + HB_NtoS(INDEXORD()) + " " + OrdName(INDEXORD())
SetProperty( ThisWindow.Name, "StatusBar" , "Item" , 3, cVal )
b := hb_macroblock( 'left(F2, '+hb_ntos(l)+') == "'+cTxt+'"' )
lRet := oBrw:FindRec(b, lNext)
oBrw:SetFocus()
RETURN lRet
FUNCTION myScope( oBrw, nDat, lBottom )
LOCAL lRet, cDat, cEnd, cVal
LOCAL aDat := { ;
CtoD('15.10.2018'), ;
CtoD('17.10.2018'), ;
CtoD('20.10.2018'), ;
}
If empty(nDat)
ElseIf nDat == 4
cDat := DtoS(aDat[ 1 ])
cEnd := DtoS(aDat[ 2 ])
ElseIf nDat == 5
cDat := DtoS(aDat[ 2 ])
cEnd := DtoS(aDat[ 3 ])
Else
cDat := DtoS(aDat[ nDat ])
cEnd := cDat
EndIf
DbSetOrder(1)
cVal := "Order: " + HB_NtoS(INDEXORD()) + " " + OrdName(INDEXORD())
SetProperty( ThisWindow.Name, "StatusBar" , "Item" , 3, cVal )
lRet := oBrw:ScopeRec(cDat, cEnd, lBottom)
oBrw:SetFocus()
FUNCTION myScope2( oBrw, nKey, lBottom )
LOCAL lRet, cDat, cEnd, cVal
LOCAL aDat := { 444, 555 }
// INDEX ON STR(F0, 7)+STR(VAL(F5), 4)+F5 TAG ROOM FOR !Deleted()
// выражение для Scope делаем равным индексу
If empty(nKey)
ElseIf nKey == 1
cDat := STR(aDat[ 1 ], 7)
cEnd := STR(aDat[ 1 ], 7)
ElseIf nKey == 2
cDat := STR(aDat[ 2 ], 7)
cEnd := STR(aDat[ 2 ], 7)
Else
cDat := Nil // STR(aDat[ nKey ])
cEnd := Nil // cDat
EndIf
SET ORDER TO TAG ROOM
cVal := "Order: " + HB_NtoS(INDEXORD()) + " " + OrdName(INDEXORD())
SetProperty( ThisWindow.Name, "StatusBar" , "Item" , 3, cVal )
lRet := oBrw:ScopeRec(cDat, cEnd, lBottom)
DO EVENTS
oBrw:SetFocus()
RETURN lRet
FUNCTION myDelete( oBrw, nKey, lBottom )
LOCAL lRet, cDat, cEnd, cVal
DEFAULT nKey := 0
If empty(nKey); SET DELETED OFF
Else ; SET DELETED ON
EndIf
If nKey == 2
SET ORDER TO 1
SET SCOPE TO
GO TOP
oBrw:Reset()
Else
SET ORDER TO TAG DEL
cVal := "Order: " + HB_NtoS(INDEXORD()) + " " + OrdName(INDEXORD())
SetProperty( ThisWindow.Name, "StatusBar" , "Item" , 3, cVal )
lRet := oBrw:ScopeRec(cDat, cEnd, lBottom)
EndIf
DO EVENTS
oBrw:SetFocus()
RETURN lRet
FUNCTION InfoDbase()
RETURN MsgInfo( Base_Current(), "Open databases" )
#include "Dbinfo.ch"
FUNCTION Base_Current(cPar)
LOCAL cMsg, nI, nSel, nOrder, cAlias, cIndx, aIndx := {}
cAlias := ALIAS()
nSel := SELECT(cAlias)
IF nSel == 0
cMsg := "No open BASE !" + CRLF
RETURN cMsg
ENDIF
nOrder := INDEXORD()
cMsg := "Open Database - alias: " + cAlias + " RddName: " + RddName() + CRLF
cMsg += "Path to the database - " + DBINFO(DBI_FULLPATH) + CRLF + CRLF
cMsg += "Open indexes: "
IF nOrder == 0
cMsg += " (no indexes) !" + CRLF
ELSE
cMsg += ' DBOI_ORDERCOUNT: ( ' + HB_NtoS(DBORDERINFO(DBOI_ORDERCOUNT)) + ' )' + CRLF + CRLF
FOR nI := 1 TO 100
cIndx := ALLTRIM( DBORDERINFO(DBOI_FULLPATH,,ORDNAME(nI)) )
IF cIndx == ""
EXIT
ELSE
DBSetOrder( nI )
cMsg += STR(nI,3) + ') - Index file: ' + DBORDERINFO(DBOI_FULLPATH) + CRLF
cMsg += ' Index Focus: ' + ORDSETFOCUS() + ", DBSetOrder(" + HB_NtoS(nI)+ ")" + CRLF
cMsg += ' Index key: "' + DBORDERINFO( DBOI_EXPRESSION ) + '"' + CRLF
cMsg += ' FOR index: "' + OrdFor() + '" ' + SPACE(5)
cMsg += ' DBOI_KEYCOUNT: ( ' + HB_NtoS(DBORDERINFO(DBOI_KEYCOUNT )) + ' )' + CRLF + CRLF
AADD( aIndx, STR(nI,3) + " OrdName: " + OrdName(nI) + " OrdKey: " + OrdKey(nI) )
ENDIF
NEXT
DBSetOrder( nOrder )
cMsg += "Current index = "+HB_NtoS(nOrder)+" , Index Focus: " + ORDSETFOCUS()
ENDIF
cMsg += " Number of records = " + HB_NtoS(ORDKEYCOUNT()) + CRLF
RETURN cMsg
|
Отправлено: 17.06.15 10:51. Заголовок: Вопросы новичка [MiniGUI]
- участник сейчас на форуме
- участник вне форума