Форум » GUI » Связанные TBROWSE » Ответить
Связанные TBROWSE
Dr. Oldwarez: Есть два TBROWSE - с главной таблицей и с подчинённой таблицей. Используется DBFCDX и следующая процедура ON CHANGE [pre2]Subtable->(ORDSCOPE(0,cScope)) Subtable->(ORDSCOPE(1,cScope)) BrwSubtable:nLen:=Subtable->(ORDKEYNO()) BrwSubTable:UpStable() BrwSubtable:GoBottom() BrwSubTable:GoTop() BrwSubTable:refresh(.F.)[/pre2] Всё работает, пока в подчинённой таблице есть, хоть одна строка, пропускаемая SCOPE, где SCOPE - первичный ключ главной таблицы, по которому из подчинённой таблицы выбираются строки, соответствующие выбранной записи главной таблицы. Если же таких строк нет ORDKEYNO()=0, то почему-то главный BROWSE срывается. Выбранная строка пустеет и курсор зависает на ней и не может двигаться дальше, к другим строкам. Подскажите, пожалуйста, в чём здесь может быть проблема? В случае NTX индексов синхронизация TBROWSE осуществляется с помощью метода SetFilter. Так в примере OneToMore.PRG И в этом примере на пустой нижний TBROWSE ничего не зависает. Как добиться таких же результатов с CDX и SET SCOPE
Ответов - 16
Haz: Subtable->(ORDSCOPE(0,cScope)) Subtable->(ORDSCOPE(1,cScope)) BrwSubtable:nLen:=Subtable->(ORDKEYNO()) BrwSubTable:Reset() BrwSubTable:refresh(.F.)
Dr. Oldwarez: Ура Заработало Спасибо
Haz: Это уже не надо BrwSubtable:nLen:=Subtable->(ORDKEYNO()) Это , оставил на всякий, но метод reset и так должен вызывать рефреш BrwSubTable:refresh(.F.)
Dr. Oldwarez: Вот здорово А я чего-то не допёр раньше до него Вроде и в доке он есть. Надо бы ещё примерчик сделать.
Haz: Если Григория заинтересует данный пример.... Могу подготовить на основе ADSLOCAL и его AOF фильтров и ( или ) смены на лету рабочей области для tsBrowsa. Не принципиально с какой RDD далее работать.
gfilatov2002: Haz пишет: Если Григория заинтересует данный пример.... Если это будет пример общего назначения (и, желательно, без использования ADS), то я с удовольствием включу его в следующую сборку библиотеки. Заранее благодарен
Haz: Договорились .... Сделаю простой пример для TsBrowse и CDX, хотя на ads интереснее - есть возможность комбинировать sql и xbase
Haz: Пришел вечером домой и написал маленький примерчик на тему инкрементального поиска в TsBrowse. Мне показалось он подойдет под тему вопроса выше. Используется RDD DBFCDX, но в принципе пойдет любая т.к. тупо фильтрую по содержимому. Добавить могу еще то , что перед вызовом :Reset() можно даже хлопнуть базу по DbCloseArea() и открыть с тем же алиасом другую ( я использую ADS и так подпихиваю в TsBrowse результат sql запроса или ставлю его AOF фильтры ). Чтоб не скучно было тестировать пример, заполняю базу списком совта установленного на компе вот собственно тестик! #include "minigui.ch" #include "Dbstruct.ch" #include "tsbrowse.ch" #include "common.ch" Func Main() LOCAL aStr := {} LOCAL cDbf := "" LOCAL i := 0 PUBLIC aFont := {} REQUEST DBFCDX , DBFFPT SET CENTURY ON SET DELETED ON DEFINE FONT Font_1 FONTNAME "Times New Roman" SIZE 10 DEFINE FONT Font_2 FONTNAME "Times New Roman" SIZE 9 DEFINE FONT Font_3 FONTNAME "Times New Roman" SIZE 8 BOLD AAdd( aFont, GetFontHandle( "Font_1" ) ) AAdd( aFont, GetFontHandle( "Font_2" ) ) AAdd( aFont, GetFontHandle( "Font_3" ) ) cDbf :=PrgPath() + 'Test_1.dbf' DEFINE WINDOW Form_0 ; At 0, 0 ; WIDTH 600 ; HEIGHT 400 ; TITLE 'Incremental search on TsBrowse sample.' ; MAIN ; ON INIT {|| NIL }; ON RELEASE {|| DbCloseAll() }; NOSIZE; DEFINE LABEL Message ROW 10 COL 10 WIDTH 80 HEIGHT 16 VALUE 'Search for :' FONTBOLD .T. END LABEL DEFINE TEXTBOX Text_1 ROW 5 COL 90 WIDTH 330 HEIGHT 21 ON CHANGE {|| RefreshBrowse()} END TEXTBOX END WINDOW DEFINE WINDOW Form_1 ; AT 0,0 ; WIDTH 800 ; HEIGHT 40 ; TITLE '' ; CHILD ; NOSHOW ; NOSYSMENU ; NOCAPTION DEFINE LABEL Label_1 ROW 5 COL 10 WIDTH 780 HEIGHT 25 VALUE '' CENTERALIGN .T. END LABEL END WINDOW ScanSoft(cDbf) USE (cDbf) SHARED NEW ALIAS 'B1' CreateBrowse( "oBrw_1", 'Form_0', 30, 2, Form_0.Width-9, Form_0.Height-60, 'B1' ) oBrw_1:aColumns[1]:cHeading := "Date" + CRLF + "instalation" oBrw_1:SetColSize(1, 70) oBrw_1:aColumns[1]:nAlign := DT_CENTER oBrw_1:aColumns[2]:cHeading := "Name application" oBrw_1:SetColSize(2, 350) oBrw_1:aColumns[2]:nAlign := DT_LEFT oBrw_1:aColumns[3]:cHeading := "Version" oBrw_1:SetColSize(3, 120) oBrw_1:aColumns[3]:nAlign := DT_RIGHT CENTER WINDOW Form_0 ACTIVATE WINDOW Form_0, Form_1 Return Nil Func PrgPath() Return SUBSTR( Exename(), 1, RAT( '\', Exename() ) ) FUNC CreateBrowse( cBrw, cParent, nRow, nCol, nWidth, nHeight, cAlias ) LOCAL i := 0 LOCAL n := 0 LOCAL cField := "" LOCAL cHeading := "" LOCAL nMemoPos := 0 LOCAL cStr := "" PUBLIC &cBrw DEFINE TBROWSE &cBrw At nRow, nCol ALIAS cAlias ; OF &cParent ; WIDTH nWidth ; HEIGHT nHeight ; COLORS { CLR_BLACK, CLR_BLUE } ; FONT "MS Sans Serif" ; SIZE 8 ; SELECTOR .T. END TBROWSE &cBrw:LoadFields( .T. ) &cBrw:lCellBrw := .F. &cBrw:nSelWidth := 16 &cBrw:ChangeFont( aFont[ 1 ], , 1 ) &cBrw:ChangeFont( aFont[ 3 ], 1 , 1 ) &cBrw:ChangeFont( aFont[ 3 ], , 2 ) &cBrw:nHeightCell += 3 &cBrw:nWheelLines := 1 &cBrw:SetColor( { 16 }, { Rgb( 43, 149, 168 )}) // Цвет фона в суперхидере &cBrw:SetColor( { 3 }, { Rgb( 255, 255, 255 )}) // шрифт в шапке &cBrw:SetColor( { 4 }, { { || { Rgb( 43, 149, 168 ), Rgb( 0, 54, 94 )}}}) // Шапка &cBrw:SetColor( { 17 }, { Rgb( 255, 255, 255 )}) // Цвет шрифта в суперхидере &cBrw:SetColor( { 6 }, { { || { Rgb( 255, 255, 74 ), Rgb( 240, 240, 0 )}}}) // фон курсора &cBrw:SetColor( { 12 }, { { || { Rgb( 128, 128, 128 ), Rgb( 250, 250, 250 )}}}) // фон курсора неактивного &cBrw:SetColor( { 2 }, { { || Rgb( 230, 240, 255 )}}) // фон не в курсоре &cBrw:SetColor( { 1 }, { { || Rgb( 0, 0, 0 )}}) // текст в ячейках &cBrw:SetColor( { 5 }, { { || Rgb( 0, 0, 255 )}}) // текст в ячейках с фокусом &cBrw:SetColor( { 11 }, { { || Rgb( 0, 0, 0 )}}) // цвет текста в курсоре неактивном &cBrw:nClrLine := COLOR_GRID &cBrw:lNoPopUp := .T. &cBrw:SetAppendMode( .F. ) &cBrw:SetDeleteMode( .F. ) FOR i := 1 TO &cBrw:nColCount &cBrw:aColumns:lEdit := .F. &cBrw:aColumns:nEditMove := DT_DONT_MOVE END RETURN nil Func RefreshBrowse() LOCAL cExp := "'" + UPPER(Alltrim( Form_0.Text_1.Value )) + "' $ UPPER(B1->F2)" IF !Empty(Alltrim(Form_0.Text_1.Value)) B1->(DbSetFilter(&("{||" + cExp + "}"), cExp) ) ELSE B1->( DbClearFilter() ) END oBrw_1:Reset() RETURN NIL Func ScanSoft(cDbf) LOCAL oWmi, oItem LOCAL cSW_Name, dSW_InstallDate, cSW_Version LOCAL aStr := {} IF ! File(cDbf) aStr := {} AADD( aStr, { 'F1', 'D', 8, 0 }) AADD( aStr, { 'F2', 'C', 50, 0 }) AADD( aStr, { 'F3', 'C', 20, 0 }) DbCreate(cDbf, aStr ) USE (cDbf) SHARED NEW ALIAS 'B1' Form_1.Label_1.Value := 'Reading the list of installed programs... Wait please!' Form_1.Center Form_1.Show oWmi := WmiService( '127.0.0.1' ) FOR EACH oItem IN oWmi:ExecQuery( "SELECT * FROM Win32_Product" ) cSW_Name := oItem:Caption dSW_InstallDate := STOD( Left( oItem:InstallDate, 8 ) ) cSW_Version := oItem:Version B1->(DbAppend()) B1->F1 := dSW_InstallDate B1->F2 := cSW_Name B1->F3 := cSW_Version NEXT Form_1.Hide B1->(DbCloseArea()) END RETURN NIL FUNC WMIService( cComp ) Local oWmi, oItem Local oLocator oLocator := CreateObject( "wbemScripting.SwbemLocator" ) oWmi := oLocator:ConnectServer( cComp,,,,,, 128 ) RETURN oWmi
gfilatov2002: Haz пишет: написал маленький примерчик на тему инкрементального поиска в TsBrowse Большое спасибо! После небольшой шлифовки (для возможности запуска и под Win98 ) выкладываю итоговый пример ниже: #include "minigui.ch" #include "tsbrowse.ch" STATIC aFont := {} MEMVAR oBrw_1 FUNCTION Main() LOCAL cDbf := GetStartupFolder() + '\Test_1.dbf' REQUEST DBFCDX , DBFFPT SET CENTURY ON SET DELETED ON DEFINE FONT Font_1 FONTNAME "Times New Roman" SIZE 11 DEFINE FONT Font_2 FONTNAME "Times New Roman" SIZE 10 DEFINE FONT Font_3 FONTNAME "Times New Roman" SIZE 9 BOLD AAdd( aFont, GetFontHandle( "Font_1" ) ) AAdd( aFont, GetFontHandle( "Font_2" ) ) AAdd( aFont, GetFontHandle( "Font_3" ) ) DEFINE WINDOW Form_0 ; At 0, 0 ; WIDTH 600 ; HEIGHT 400 ; TITLE 'TsBrowse sample: Incremental search' ; MAIN ; NOMAXIMIZE ; NOSIZE DEFINE LABEL Message ROW 7 COL 10 WIDTH 80 HEIGHT 16 VALUE 'Search for :' FONTBOLD .T. END LABEL DEFINE TEXTBOX Text_1 ROW 5 COL 90 WIDTH 345 HEIGHT 21 ON CHANGE {|| RefreshBrowse()} END TEXTBOX ON KEY ESCAPE ACTION ThisWindow.Release END WINDOW DEFINE WINDOW Form_1 ; AT 0,0 ; WIDTH 800 ; HEIGHT 40 ; CHILD ; NOSYSMENU ; NOCAPTION DEFINE LABEL Label_1 ROW 10 COL 10 WIDTH 780 HEIGHT 24 VALUE '' CENTERALIGN .T. END LABEL END WINDOW ScanSoft(cDbf) USE (cDbf) ALIAS 'B1' READONLY NEW CreateBrowse( "oBrw_1", 'Form_0', 30, 2, Form_0.Width-9, Form_0.Height-60, 'B1' ) oBrw_1:aColumns[1]:cHeading := "Date of" + CRLF + "installation" oBrw_1:SetColSize(1, 70) oBrw_1:aColumns[1]:nAlign := DT_CENTER oBrw_1:aColumns[2]:cHeading := "Application Name" oBrw_1:SetColSize(2, 350) oBrw_1:aColumns[2]:nAlign := DT_LEFT oBrw_1:aColumns[3]:cHeading := "Version" oBrw_1:SetColSize(3, 120) oBrw_1:aColumns[3]:nAlign := DT_RIGHT Form_0.Text_1.Setfocus CENTER WINDOW Form_0 ACTIVATE WINDOW ALL RETURN Nil FUNCTION CreateBrowse( cBrw, cParent, nRow, nCol, nWidth, nHeight, cAlias ) LOCAL i PUBLIC &cBrw DEFINE TBROWSE &cBrw ; AT nRow, nCol ; ALIAS cAlias ; OF &cParent ; WIDTH nWidth ; HEIGHT nHeight ; COLORS { CLR_BLACK, CLR_BLUE } ; FONT "MS Sans Serif" ; SIZE 8 ; SELECTOR .T. END TBROWSE &cBrw:LoadFields( .F. ) &cBrw:lNoHScroll := .T. &cBrw:lCellBrw := .F. &cBrw:nSelWidth := 16 &cBrw:ChangeFont( aFont[ 1 ], , 1 ) &cBrw:ChangeFont( aFont[ 3 ], 1 , 1 ) &cBrw:ChangeFont( aFont[ 3 ], , 2 ) &cBrw:nHeightCell += 6 &cBrw:nHeightHead += 14 &cBrw:nWheelLines := 1 &cBrw:SetColor( { 16 }, { Rgb( 43, 149, 168 )}) // Цвет фона в суперхидере &cBrw:SetColor( { 3 }, { Rgb( 255, 255, 255 )}) // шрифт в шапке &cBrw:SetColor( { 4 }, { { || { Rgb( 43, 149, 168 ), Rgb( 0, 54, 94 )}}}) // Шапка &cBrw:SetColor( { 17 }, { Rgb( 255, 255, 255 )}) // Цвет шрифта в суперхидере &cBrw:SetColor( { 6 }, { { || { Rgb( 255, 255, 74 ), Rgb( 240, 240, 0 )}}}) // фон курсора &cBrw:SetColor( { 12 }, { { || { Rgb( 128, 128, 128 ), Rgb( 250, 250, 250 )}}}) // фон курсора неактивного &cBrw:SetColor( { 2 }, { { || Rgb( 230, 240, 255 )}}) // фон не в курсоре &cBrw:SetColor( { 1 }, { { || Rgb( 0, 0, 0 )}}) // текст в ячейках &cBrw:SetColor( { 5 }, { { || Rgb( 0, 0, 255 )}}) // текст в ячейках с фокусом &cBrw:SetColor( { 11 }, { { || Rgb( 0, 0, 0 )}}) // цвет текста в курсоре неактивном &cBrw:nClrLine := COLOR_GRID &cBrw:lNoPopUp := .T. &cBrw:SetAppendMode( .F. ) &cBrw:SetDeleteMode( .F. ) &cBrw:ResetVScroll() RETURN Nil Stat Func RefreshBrowse() LOCAL cSeek := Alltrim( Form_0.Text_1.Value ) LOCAL cExp := "'" + UPPER(cSeek) + "' $ UPPER(B1->F2)" IF !Empty(cSeek) B1->( DbSetFilter( &("{||" + cExp + "}"), cExp ) ) ELSE B1->( DbClearFilter() ) END oBrw_1:Reset() RETURN Nil Stat Func ScanSoft(cDbf) LOCAL oWmi, oItem LOCAL cSW_Name, dSW_InstallDate, cSW_Version LOCAL aStr := {} IF ! File(cDbf) AADD( aStr, { 'F1', 'D', 8, 0 } ) AADD( aStr, { 'F2', 'C', 50, 0 } ) AADD( aStr, { 'F3', 'C', 20, 0 } ) DbCreate( cDbf, aStr ) USE (cDbf) ALIAS 'B1' NEW Form_1.Label_1.Value := 'Reading the list of installed programs... Wait, please!' Form_1.Center Form_1.Show oWmi := WmiService() FOR EACH oItem IN oWmi:ExecQuery( "SELECT * FROM Win32_Product" ) cSW_Name := oItem:Caption dSW_InstallDate := STOD( Left( oItem:InstallDate, 8 ) ) cSW_Version := oItem:Version B1->( DbAppend() ) B1->F1 := dSW_InstallDate B1->F2 := cSW_Name B1->F3 := cSW_Version NEXT B1->( DbCloseArea() ) Form_1.Hide END RETURN Nil FUNCTION WMIService() Local oLocator Static oWmi IF oWmi == NIL oLocator := CreateObject( "wbemScripting.SwbemLocator" ) oWmi := oLocator:ConnectServer() END RETURN oWmi Единственный вопрос: как Вас представить в заголовке примера? Автор: __________
Haz: gfilatov2002 пишет: Единственный вопрос: как Вас представить в заголовке примера? Автор: __________ "... Бонд, просто Бонд ...."(с) Григорий, представьте меня как Igor Nazarov
Dr. Oldwarez: Ой, обнаружил один небольшой глючок. Почему-то во всех подчинённых TBROWSE первая строка (на которой стоит курсор) почему-то при прокрутке главного BROWSE адекватно не изменяется, а показывает своё содержание с предыдущего раза. Но если кликнуть в подчинённое BROWSE мышью - верхняя строка принимает правильное значение. Как сделать, чтобы верхняя строка, на которой стоит курсор, сразу правильно обновлялась?
Haz: Dr. Oldwarez пишет: Как сделать, чтобы попробуй перед :reset() выполнить Subtable->(dbgotop())
Dr. Oldwarez: Пробовал. И это приводит к той же ошибке, что и была вначале в случае если в подчинённой таблице нет ни одной строки, соответствующей выбранной строке главной таблицы. К такой же ошибке приводит и метод GoTop()
Haz: Примерчик скинуть можешь ? Посмотрю что можно сделать 047545 mail.ru
Dr. Oldwarez: А разгадка такова [pre2]Subtable->(ORDSCOPE(0,cScope)) Subtable->(ORDSCOPE(1,cScope)) BrwSubTable:nLen:=Subtable->(ORDKEYCOUNT()) BrwSubTable:Reset() /*А вот это надо обязательно*/ IF BrwSubTable:nLen>0 BrwSubTable:GoBottom() BrwSubTable:GoTop() ENDIF BrwSubtable:refresh(.F.) [/pre2]
Dr. Oldwarez: Очень важная деталь: Если главная и подчинённая таблицы связаны через SET RELATION, а потом эти же таблицы используются в TBROWSE в одном окне, может быть очень пакостный глюк. Если в подчинённой таблице нет записей, соответствующих главной таблице, главный TBROWSE потом начинает зависать и строки либо исчезают, либо всюду становятся одинаковыми. А разгадка тут в том, что перед обновлением подчинённого TBROWSE, нужно запомнить номер строки главной таблицы и при неудачном поиске в подчинённой таблице быстро вернуться на исходную позицию главной таблицы. [pre2] PROCEDURE UpdSubTable(cKey) LOCAL nMainRec:=MainTabl->(RECNO()),nSubLen:=0,nSum:=0 Subtable->(ORDSCOPE(0,cKey)) Subtable->(ORDSCOPE(1,cKey)) nSubLen:=SubTable->(OrdKeyCount()) //Расчёт суммы по числовому полю IF nSubLen Subtable->(DBGOTOP()) DO WHILE !(Subtable->(EOF())) nSum:=nSum+SubTable->PRICE SubTable->(DBSKIP()) ENDDO SubTable->(DBGOTOP()) ENDIF brwSubTable:nLen:=nSubLen brwSubTable:Reset() IF nSubLen>0 brwSubTable:GoBottom() brwSubTable:GoTop() ELSE MainTabl->(DBGOTO(nMainRec)) //ВАЖНО!!! ENDIF brwSubTable:refresh(.F.) //Вывод суммы в подвале brwSubTable:aColumns[6]:cFooting:=STR(nSum,10,2) //Ставим номер суммируемой колонки RETURN[/pre2]
полная версия страницы