Новая версия Расширенного релиза библиотеки MiniGUI (часть VI ) (продолжение)

Форум » GUI » Новая версия Расширенного релиза библиотеки MiniGUI (часть VI ) (продолжение) » Ответить

Новая версия Расширенного релиза библиотеки MiniGUI (часть VI ) (продолжение)

gfilatov: Начало темы находится здесь, а теперь АНОНС * АНОНС * АНОНС * АНОНС * АНОНС Готовится к опубликованию новая сборка №48, которая выйдет в конце недели. Если у Вас есть интересные наработки для включения в новый релиз, то сейчас самое удобное время для их отправки мне Кратко, что нового: - исправление обнаруженных ошибок и неточностей кода; - новый класс HEADERIMAGE для Grid и Browse; - свойство Address в Hyperlink может теперь открывать папку или файл на диске; - добавлен NOTABSTOP класс для Browse; - поддержка пользовательских компонентов (заимствована из оффициального релиза); - расширения и исправления в библиотеках TsBrowse и PropGrid; - обновлены сборки Харбор и HMGS-IDE; - новые и обновленные старые примеры (как обычно ).

Ответов - 300, стр: 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 All

SergKis: gfilatov2002 Попробовал mgDbu, для ntx все нормально, для cdx без fpt не вышло поставить rdd dbfcdx. Изменил и смог отработать [pre2] Procedure Main( cDBFName ) Local lMaximized, nTop, nLeft, nWidth, nHeight Local cDBFPath, cFile, nW, nH, cRddName PUBLIC cFilter := "" // Harbour commands SET CENTURY ON SET DATE GERMAN //BRITISH SET EXCLUSIVE ON // MiniGUI commands SET FONT TO "Tahoma", 9 SET DEFAULT ICON TO "ICONA" IF IsVistaOrLater() SET CENTERWINDOW RELATIVE PARENT ENDIF SET AUTOSCROLL OFF SET NAVIGATION EXTENDED IF !Empty(cDBFName) cRddName := iif( upper(cDBFName) == 'CDX', 'DBFCDX', 'DBFNTX' ) cDBFName := NIL ENDIF // Input parameter processing DEFAULT cDBFName := "test" IF Empty( cDBFPath := cFilePath( cDBFName ) ) cDBFPath := GetStartupFolder() ENDIF cDBFPath += "\" // Set default RDD and open a data file IF ! Empty( cRddName ) rddSetDefault( cRddName ) ELSEIF Empty( File( cDBFPath + cFileNoExt( cDBFName ) + ".fpt" ) ) .and. ; Empty( File( cDBFPath + cFileNoExt( cDBFName ) + ".cdx" ) ) rddSetDefault( "DBFNTX" ) ELSE rddSetDefault( "DBFCDX" ) ENDIF ... PROCEDURE OpenDataTable( cFile ) ... // Set default RDD and open a data file IF File( ChangeFileExt( cFile, ".fpt" ) ) .or. ; File( ChangeFileExt( cFile, ".cdx" ) ) rddSetDefault( "DBFCDX" ) ELSE rddSetDefault( "DBFNTX" ) ENDIF ... [/pre2]

SergKis: PS При создании tag без FOR опция UNIQUE недоступна, на Key тоже может быть unique

SergKis: PPS Правильнее[pre2] IF !Empty(cDBFName) cRddName := iif( upper(cDBFName) == 'CDX', 'DBFCDX', NIL ) cDBFName := NIL ENDIF [/pre2]

gfilatov2002: SergKis пишет: Изменил и смог отработать Благодарю за помощь SergKis пишет: на Key тоже может быть unique Поправил Эти изменения будут включены в 4-ю бета-версию новой сборки

SergKis: gfilatov2002 Может в StatusBar завести item для индикации RddSetDefault() и click для установки\смены ACTION {|| RddSetDefault( iif( RddSetDefault() == 'DBFCDX', 'DBFNTX', 'DBFCDX' ) ) }

gfilatov2002: SergKis пишет: в StatusBar завести item для индикации RddSetDefault() и click для установки\смены Сделал, конечно Благодарю за помощь

SergKis: gfilatov2002 По мне, использовать GetStartupFolder() при работе с dbf не очень хорошо. Работаю в Far и мне нужно тек. каталог, т.е. mgDbu.exe U09.dbf или mgDbu.exe .\2019\R08.dbf а зацеплено везде GetStartupFolder()

gfilatov2002: SergKis пишет: использовать GetStartupFolder() при работе с dbf не очень хорошо Заменил эту функцию на GetCurrentFolder() Благодарю за помощь

SergKis: gfilatov2002 Немного правки[pre2] METHOD SetArrayTo( aArray, uFontHF, aHead, aSizes, uFooter, aPicture, aAlign, aName ) CLASS TSBrowse ... EndIf If hFontHead != Nil ::hFontHead := hFontHead EndIf If hFontFoot != Nil ::hFontFoot := hFontFoot EndIf ::aArray := aArray ::lPickerMode := .F. ... METHOD InsColumn( nPos, oColumn ) CLASS TSBrowse ... If oColumn:lDefineColumn oColumn:DefColor( Self, oColumn:aColors ) oColumn:DefFont ( Self ) EndIf IF ! Empty( ::hFontHead ) oColumn:hFontHead := ::hFontHead ENDIF IF ! Empty( ::hFontFoot ) oColumn:hFontFoot := ::hFontFoot ENDIF Default nPos := 1 ... [/pre2]

SergKis: PS METHOD InsColumn( nPos, oColumn ) CLASS TSBrowse Не надо править. В oColumn:DefFont( Self ) такая установка есть, не увидел.

gfilatov2002: SergKis пишет: Немного правки Поправил, конечно. Благодарю за помощь

SergKis: gfilatov2002 Предложение. У себя сделал для многострочных колонок, прошло на ура.[pre2] CLASS TSColumn ... DATA nEditRow AS NUMERIC // DATA nEditCol AS NUMERIC // DATA nEditHeight AS NUMERIC // DATA nEditWidth AS NUMERIC // ... METHOD Edit( uVar, nCell, nKey, nKeyFlags, cPicture, bValid, nClrFore, nClrBack ) CLASS TSBrowse ... ::cChildControl := GetUniqueName( "GetBox" ) nRow += ::aEditCellAdjust[1] nCol += ::aEditCellAdjust[2] nWidth += ::aEditCellAdjust[3] nHeight += ::aEditCellAdjust[4] If oCol:nEditHeight > 0 nHeight := oCol:nEditHeight IF oCol:nEditRow > 0 nRow := oCol:nEditRow ENDIF IF oCol:nEditCol > 0 nCol := oCol:nEditCol ENDIF EndIf oCol:oEdit := TGetBox():New( nRow, nCol, bSETGET( uValue ), Self, nWidth, nHeight, ; ... Применение. Двухстрочная строка тсб. Есть 2е колонки с ценой, 1ая показ в первой строке, 2ая во второй. Цены надо править, т.е GetBox там где своя цена соответсвено. В программе дл тсб :InsColumn( 1, gCols( ArrayNo )) // первая цена oCol := :GetColumn("R_10") oCol:bDecode := {|nv| hb_ntos(nv)+CRLF+' ' } oCol:bPrevEdit := {|nv,ob| Prev_Cena0(ob, 1 ) } oCol:bPostEdit := {|nv,ob| Post_Cena0(ob, 1, nv) } oCol:lEdit := .T. // вторая цена, вторая строка oCol := :GetColumn("R_12") oCol:bDecode := {|nv| ' ' + CRLF + hb_ntos(nv) } oCol:bPrevEdit := {|nv,ob| Prev_Cena0(ob, 2 ) } oCol:bPostEdit := {|nv,ob| Post_Cena0(ob, 2, nv) } oCol:lEdit := .T. ADD SUPER HEADER TO oBrw FROM 1 TO :nColumn("R_2") TITLE "Excel" ADD SUPER HEADER TO oBrw FROM :nColumn("R_2" )+1 TO :nColumn("R_10")-1 TITLE gTxt(Material) ADD SUPER HEADER TO oBrw FROM :nColumn("R_10") TO :nColCount() TITLE gTxt(Ucen) ... *-----------------------------------------------------------------------------* STAT FUNC Prev_Cena0( oBrw, nLine ) *-----------------------------------------------------------------------------* LOCAL oCol, aLine, cPic := '99999.9999' WITH OBJECT oBrw IF nLine == 1 oCol := :GetColumn("R_10") oCel := :GetCellSize( :nColumn("R_10"), :nRowPos ) oCol:nEditHeight := int( oCel:nHeight / 2 ) + 2 oCol:nEditRow := oCel:nRow oCol:nEditCol := oCel:nCol - 1 oCol:cPicture := cPic Else aLine := :aArray[ :nAt ] If Empty( aLine[ Len(aLine) - 1 ] ) ; RETURN .F. // нет кода материала EndIf oCol := :GetColumn("R_12") oCel := :GetCellSize( :nColumn("R_12"), :nRowPos ) oCol:nEditHeight := int( oCel:nHeight / 2 ) + 2 oCol:nEditRow := oCel:nRow + ( oCel:nHeight - oCol:nEditHeight ) oCol:nEditCol := oCel:nCol - 1 oCol:cPicture := cPic EndIf END WITH RETURN .T. *-----------------------------------------------------------------------------* STAT FUNC Post_Cena0( oBrw, nLine, nCena ) *-----------------------------------------------------------------------------* LOCAL aLine, cKodK, nCenK, cKod, nCnt LOCAL nColC := oBrw:nCell - 1 // 7 LOCAL nColK := Len(oBrw:aArray[1]) - 1 // 9 nCenK := Val( StrZero(nCena, 11, 4) ) WITH OBJECT oBrw If nLine == 1 :aArray[ :nAt ][ nColC ] := nCenK :DrawSelect() Else cKodK := :aArray[ :nRowPos ][ nColK ] nCnt := 0 FOR EACH aLine IN :aArray nCnt += 1 cKod := aLine[ nColK ] If ! Empty( cKod ) .and. cKodK == cKod :aArray[ nCnt ][ nColC ] := nCenK EndIf NEXT :Refresh() EndIf END WITH RETURN .T. ... [/pre2] В методе :Edit() сделанное для GetBox можно распространить для всех контролов, кроме EditBox

gfilatov2002: SergKis пишет: В методе :Edit() сделанное для GetBox можно распространить для всех контролов, кроме EditBox Добавил эти изменения, хотя у меня создается впечатление, что кроме Вас никто это не будет использовать Благодарю за помощь в любом случае...

SergKis: gfilatov2002 пишет Добавил эти изменения, хотя у меня создается впечатление, что кроме Вас никто это не будет использовать Ради только меня не стоит это делать. В моей версии это есть. TBrowse таблица, как бы, осноаной рабочий инструмент. Разве не возникает потребности организовать ввод в отдельной строке (задаем заранее в каждой колонке координаты) или все колонки вводить в одних координатах (как в Excel) ? Это все без доп. GetBox и ... в связке с тсб. PS В TSCOLUMN добавлен еще, т.к. Picture отображения тсб колонки и Edit ее могут быть разными. DATA cEditPicture [pre2] ... METHOD Edit( uVar, nCell, nKey, nKeyFlags, cPicture, bValid, nClrFore, nClrBack ) CLASS TSBrowse ... If oCol:nEditHeight > 0 nHeight := oCol:nEditHeight IF oCol:nEditRow > 0 nRow := oCol:nEditRow ENDIF IF oCol:nEditCol > 0 nCol := oCol:nEditCol ENDIF EndIf If oCol:cEditPicture != Nil cPicture := oCol:cEditPicture EndIf ... [/pre2]

gfilatov2002: SergKis пишет: В TSCOLUMN добавлен еще, т.к. Picture отображения тсб колонки и Edit ее могут быть разными. DATA cEditPicture Добавил такое свойство (и его обработку) также. Благодарю за помощь

Andrey: gfilatov2002 пишет: Добавил эти изменения, хотя у меня создается впечатление, что кроме Вас никто это не будет использовать Я буду использовать. Сталкивался с таким, и не знал как сделать. Только бы надо примерчик небольшой сделать или показать уже в готовом примере как такое можно использовать. SergKis пишет: TBrowse таблица, как бы, осноаной рабочий инструмент. Просто отличный инструмент !!! Вот так можно сделать TBrowse-таблицу:

SergKis: gfilatov2002 Немного изменил, что бы не перекрывались :nEditWidth при перерисовке с :llAdjColumns и заданным :nEditWidth для Edit[pre2] DATA cEditPicture // DATA nEditRow AS NUMERIC // DATA nEditCol AS NUMERIC // DATA nEditHeight AS NUMERIC // DATA nEditWidth AS NUMERIC // DATA nEditWidthDraw AS NUMERIC // DATA nEditMove AS NUMERIC // post editing cursor movement ... METHOD DrawSelect( xRow, lDrawCell ) CLASS TSBrowse ... oColumn:nEditWidthDraw := 0 If nDeltaLen > 0 oColumn:nEditWidthDraw := aColSizes[ nJ ] + nDeltaLen EndIf If lDrawCell ... METHOD DrawSuper() CLASS TSBrowse ... For nI := 1 To Len( ::aColumns ) oCol := ::aColumns[ nI ] If oCol:nEditWidthDraw > 0 aColSizes[ nI ] := oCol:nEditWidthDraw - iif( ::lNoVScroll, GetVScrollBarWidth(), 0 ) Else aColSizes[ nI ] := oCol:nWidth EndIf Next ... METHOD GetCellInfo( nRowPos, nCell, lColSpecHd ) CLASS TSBrowse ... If oCol:nEditWidthDraw > 0 nWidth := oCol:nEditWidthDraw If ! ::lNoVScroll nWidth -= GetVScrollBarWidth() EndIf EndIf If lHead ... METHOD Edit( uVar, nCell, nKey, nKeyFlags, cPicture, bValid, nClrFore, ; ... If oCol:nEditWidthDraw > 0 nWidth := oCol:nEditWidthDraw If ! ::lNoVScroll nWidth -= GetVScrollBarWidth() EndIf EndIf If oCol:cResName != Nil .or. oCol:lBtnGet ... [/pre2] Пример использования на базе Advanced\Tsb_Basic_2\demo5.prg [pre2] /* * 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 800 ; HEIGHT 720 ; 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: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 [/pre2]

gfilatov2002: SergKis пишет: Немного изменил Благодарю за помощь и тестовый пример

SergKis: gfilatov2002 Лучше сделать так [pre2] METHOD Edit( uVar, nCell, nKey, nKeyFlags, cPicture, bValid, nClrFore, ; ... nRow += ::aEditCellAdjust[1] nCol += ::aEditCellAdjust[2] nWidth += 2+::aEditCellAdjust[3] nHeight += 2+::aEditCellAdjust[4] If oCol:nEditWidth > 0 nWidth := oCol:nEditWidth EndIf If oCol:nEditHeight > 0 nHeight := oCol:nEditHeight EndIf If oCol:nEditRow > 0 nRow := oCol:nEditRow EndIf If oCol:nEditCol > 0 nCol := oCol:nEditCol EndIf If oCol:cEditPicture != Nil cPicture := oCol:cEditPicture EndIf oCol:oEdit := TGetBox():New( nRow, nCol, ; bSETGET( uValue ), Self, nWidth, nHeight, ; ... [/pre2]

gfilatov2002: SergKis пишет: Лучше сделать так OK, сделал Благодарю за подсказку

полная версия страницы