Отправлено: 02.03.11 11:41. Заголовок: Связанные TBROWSE

Есть два TBROWSE - с главной таблицей и с подчинённой таблицей. Используется DBFCDX и следующая процедура ON CHANGE

Subtable->(ORDSCOPE(0,cScope)) 
 Subtable->(ORDSCOPE(1,cScope)) 
 BrwSubtable:nLen:=Subtable->(ORDKEYNO()) 
 BrwSubTable:UpStable() 
 BrwSubtable:GoBottom() 
 BrwSubTable:GoTop() 
 BrwSubTable:refresh(.F.)

Всё работает, пока в подчинённой таблице есть, хоть одна строка, пропускаемая SCOPE, где SCOPE - первичный ключ главной таблицы, по которому из подчинённой таблицы выбираются строки, соответствующие выбранной записи главной таблицы.
Если же таких строк нет ORDKEYNO()=0, то почему-то главный BROWSE срывается. Выбранная строка пустеет и курсор зависает на ней и не может двигаться дальше, к другим строкам. Подскажите, пожалуйста, в чём здесь может быть проблема?

В случае NTX индексов синхронизация TBROWSE осуществляется с помощью метода SetFilter. Так в примере OneToMore.PRG И в этом примере на пустой нижний TBROWSE ничего не зависает. Как добиться таких же результатов с CDX и SET SCOPE

 Отправлено: 02.03.11 16:32. Заголовок: Попробуй так

Subtable->(ORDSCOPE(0,cScope))
Subtable->(ORDSCOPE(1,cScope))
BrwSubtable:nLen:=Subtable->(ORDKEYNO())
BrwSubTable:Reset()
BrwSubTable:refresh(.F.)

 Отправлено: 02.03.11 17:18. Заголовок: Спасибо :sm19: ..

Ура
Заработало

Спасибо

 Отправлено: 02.03.11 17:25. Заголовок: добавка.....

Это уже не надо
BrwSubtable:nLen:=Subtable->(ORDKEYNO())

Это , оставил на всякий, но метод reset и так должен вызывать рефреш
BrwSubTable:refresh(.F.)

 Отправлено: 02.03.11 17:30. Заголовок: Вот здорово :sm36: ..

Вот здорово
А я чего-то не допёр раньше до него
Вроде и в доке он есть. Надо бы ещё примерчик сделать.

 Отправлено: 02.03.11 17:37. Заголовок: Если Григория заинтересует данный пример....

Если Григория заинтересует данный пример....

Могу подготовить на основе ADSLOCAL и его AOF фильтров и ( или ) смены на лету рабочей области для tsBrowsa. Не принципиально с какой RDD далее работать.

 Отправлено: 02.03.11 18:09. Заголовок: Haz пишет: Если Гри..

Haz пишет:

цитата:

Если Григория заинтересует данный пример....

Если это будет пример общего назначения (и, желательно, без использования ADS), то я с удовольствием включу его в следующую сборку библиотеки.

Заранее благодарен

 Отправлено: 02.03.11 18:18. Заголовок: Договорились ....

Договорились ....

Сделаю простой пример для TsBrowse и CDX, хотя на ads интереснее - есть возможность комбинировать sql и xbase

 Отправлено: 03.03.11 00:21. Заголовок: Вот и примерчик ....

Пришел вечером домой и написал маленький примерчик на тему инкрементального поиска в 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

 Отправлено: 03.03.11 13:53. Заголовок: Haz пишет: написал ..

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

Единственный вопрос: как Вас представить в заголовке примера?
Автор: __________

 Отправлено: 03.03.11 14:03. Заголовок: Единственный вопрос: как Вас представить в заголовке примера? ....

gfilatov2002 пишет:

цитата:

Единственный вопрос: как Вас представить в заголовке примера? Автор: __________

"... Бонд, просто Бонд ...."(с)

Григорий, представьте меня как Igor Nazarov

 Отправлено: 09.03.11 15:17. Заголовок: Ой, обнаружил один н..

Ой, обнаружил один небольшой глючок.

Почему-то во всех подчинённых TBROWSE первая строка (на которой стоит курсор) почему-то при прокрутке главного BROWSE адекватно не изменяется, а показывает своё содержание с предыдущего раза. Но если кликнуть в подчинённое BROWSE мышью - верхняя строка принимает правильное значение. Как сделать, чтобы верхняя строка, на которой стоит курсор, сразу правильно обновлялась?

 Отправлено: 10.03.11 00:27. Заголовок: re косячок

Dr. Oldwarez пишет:

цитата:

Как сделать, чтобы

попробуй перед :reset() выполнить Subtable->(dbgotop())

 Отправлено: 10.03.11 09:51. Заголовок: Пробовал. И это прив..

Пробовал. И это приводит к той же ошибке, что и была вначале в случае если в подчинённой таблице нет ни одной строки, соответствующей выбранной строке главной таблицы. К такой же ошибке приводит и метод GoTop()

 Отправлено: 10.03.11 11:23. Заголовок: Примерчик скинуть можешь ?

Примерчик скинуть можешь ? Посмотрю что можно сделать
047545 mail.ru

 Отправлено: 14.03.11 01:45. Заголовок: Уже решил проблему

А разгадка такова

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.) 

 Отправлено: 24.08.11 10:56. Заголовок: ЭВРИКА

Очень важная деталь:
Если главная и подчинённая таблицы связаны через SET RELATION, а потом эти же таблицы используются в TBROWSE в одном окне, может быть очень пакостный глюк. Если в подчинённой таблице нет записей, соответствующих главной таблице, главный TBROWSE потом начинает зависать и строки либо исчезают, либо всюду становятся одинаковыми. А разгадка тут в том, что перед обновлением подчинённого TBROWSE, нужно запомнить номер строки главной таблицы и при неудачном поиске в подчинённой таблице быстро вернуться на исходную позицию главной таблицы.

 
 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