Форум » GUI » TsBrowse в Минигуи (продолжение) » Ответить
TsBrowse в Минигуи (продолжение)
Vlad04: TsBrows определяется в виде строки ПАРМЕТРОВ объекта и их значений К примеру [quote] DEFINE TBROWSE oBrw2 ; AT 60,450 ; ALIAS cAlias ; OF Form1 ; WIDTH 330 ; HEIGHT 340 ; FONT "Verdana" ; SIZE 9 ; ON DBLCLICK CopyRec(); ON GOTFOCUS fModelo_Hab(2) ; AUTOFILTER ; CELLED EDIT; VALUE nRec; GRID [/quote] Здесь я собрал параметры из разных tBrows Можно или нет и какие парметры заменить выражением ( и каким) ? oBrw2:.... oBrw2:....
Dima: Порча с бровсом , это из примера SAMPLES\Advanced\Tsb_seek_2\ Едем вниз или колесом или стрелкой вниз и бац записи стали дублироваться. Тоже самое происходит и у меня в программе на компе заказчика (у меня норм) В примере правда происходит расчет HOLE и дальнейшие действия , у меня в коде ни чего подобного нет. Куда копать ?
Dima: Видео заказчика http://files.icq.net/get/8uYhqlxRMUWAVpabMnphKX5785d4af1ad Его лучше скачать так как в ONLINE показывает его перевернутым.
gfilatov2002: Dima пишет: Куда копать ? Это лечится в примере добавлением всего одной строки в функцию TBrw_Show() [pre2]*----------------------------------- Function TBrw_Show( oBrw, nDelta ) *----------------------------------- _EndTBrowse() If hb_IsObject(oBrw) TBrw_NoHoles( oBrw, nDelta ) oBrw:nHeightHead -= 1 EndIf [/pre2]Идея лечения состоит в том, чтобы уйти от точного соответствия высоты строк в гриде и общей высоты TBrowse
Dima: Да в примере это есть НО в нем тоже ломается я же выложил скрин. Упс строки то я и не заметил ))
sashaBG: Привет всем ! Я тоже пытаюсь разобратся с TSBROWS-ом у меня возникла следучщая проблема : имеется столбец ADD COLUMN TO BROWSE_1; HEADER "Код" ; SIZE 80 ; DATA aFld[1] ; ALIGN DT_LEFT, nMakeLong( DT_CENTER, DT_CENTER ) ; 3DLOOK FALSE, TRUE, TRUE ; EDITABLE //MOVE DT_MOVE_RIGHT BROWSE_1:aColumns[ 1 ]:bHLClicked := {||artikuli->(dbseek(prihod->kod)),artikuli( .f. )} BROWSE_1:aColumns[ 1 ]:cToolTip := "Кликнете върху хедера за да редактирате номенклатура АРТИКУЛИ." BROWSE_1:aColumns[ 1 ]:bValid:= { | uVar | FindArt( uVar ) } ; функция FindArt ищет в таблицу с артикулами есть или нет такой код . если не находит хочу показать список в другом окне и сделать правильный выбор А КАК НОВЫЙ КОД ОБРАТНО В ЯЧЕЙКУ ЗАПЕХНУТЬ НИКАК НЕ СООБРАЖУ
Haz: sashaBG пишет: А КАК НОВЫЙ КОД ОБРАТНО В ЯЧЕЙКУ ЗАПЕХНУТЬ НИКАК НЕ СООБРАЖУ не совсем понятно применение :bValid , это блок который разрешает или нет GET объекту покинуть редактирование , если Т то редактирование завершается , если F то не выпускает. То есть что бы закончить редактирование нужно по любому вернуть T В TsBrowse есть еще блоки завязанные на редакцию, это bPostEdit , bEditEnd которые выполняются после редактирования и в них можно делать проверки. Присвоить значение в ячейку можно прямым присвоением oBrw:aArray[oBrw:nAt][ 1 ] := Kod // для колонки 1 или выполнив блок выборки/записи Eval( oBrw:aColumns[1]:bData, Kod ), в результате чего значение Kod будет записано в ячейку . останется только перерисовать строку для отображения нового значения . Перерисовку делает или :Refresh( F ) или :DrawSelect() - этот предпочтительнее PS соответственно прочитать значение ячейки можно как Kod := oBrw:aArray[oBrw:nAt][ 1 ] или Kod := Eval( oBrw:aColumns[1]:bData) мне кажется это проще чем пытаться управлять буфером Get объекта через Valid
sashaBG: Да Вы правы . Я сделел то що хотел через bPostEdit А вот интересно при bValid Вы говорите що не должно выпускать из контрола , на самом деле ПИКАЕТ и выходит из редактирования не меняя ячейку.
Haz: sashaBG пишет: на самом деле ПИКАЕТ и выходит из редактирования не меняя ячейку. Да, так и есть. Если я не ошибаюсь в Clipper Valid не выпускал из редактирования пока не вернет T, думал так же и в TS Посмотрел исходники TS, в них Vald обрабатывается в методе bPostEdit т.е. после редактирования. Видимо это особенность которую автор заложил в метод :Edit() По мне как это ошибка логики, будет время попробую предложить исправление. Сейчас ушел совершенно в другой процесс, и хобби в виде программирования пока пришлось отложить
SergKis: Haz пишет По мне как это ошибка логики, будет время попробую предложить исправление Возможно ошибки логики нет: 1. можно сделать postmessage на enter при valid .F., .т.е. вкл. edit 2. можно подвесить (организовать сообщение), как в примере BASIC\COM_2, используя ф-ю ShowGetValid( hWnd, cTxt, 'Information', 'I' ), после закрытия поля edit после валид, положив в ячейку (visible .t.) узкий GetBox (контол cNam) и ... как в примере SetProperty(ThisWindow.Name, cNam, 'Visible', .T.) DoMethod(ThisWindow.Name, cNam, 'SetFocus') InkeyGui(10) // otherwise it does not have time to respond ShowGetValid( hWnd, cTxt, 'Information', 'I' ) InkeyGui(3000) // 3 sec. SetProperty(ThisWindow.Name, cNam, 'Visible', .F.) 3. потом п. 1
Haz: SergKis пишет: Возможно ошибки логики нет: 1. можно сделать Сергей, то что ты предлагаешь и есть "выпрямление" логики Ведь что говорил букварь по clipper - [pre2]If the VALID clause is specified and <lValid> evaluates to it logical true (.T.) condition the current GET will be considered valid and the get operation will continue onto the next active GET object. If not, the cursor will remain on this GET object until aborted or until the condition in <lValid> evaluates to true (.T.). [/pre2] То есть в "классике" не завершать GET при lValid == .F. было "из коробки" и не нужно было ничего доделывать.
SergKis: Haz пишет То есть в "классике" не завершать GET при lValid == .F. было "из коробки" и не нужно было ничего доделывать При клацаньи мышой где хочу "классик" уходит на 2-ой план. Как при замороженом GET validом (.F.), переключить курсор на "нужную" ячейку , не записав введенные данные ("неправильные") в поле ? Потому и говорю, что "возможно ..."
Haz: SergKis пишет: Потому и говорю, что "возможно ..." Мысль понял , логично но "осадочек остался"
Andrey: Использую стандартную функцию загрузки настроек \MiniGUI\SOURCE\TsBrowse\h_tbrowse.prg LoadFields( "oBrw1", cForm, .T.) // все поля редактируемые Поля типа: "+", "=", "^", "@" - неправильно отображаются в TBROWSE, да и в добавок редактировать разрешены. Можно там подправить в исходнике эту функцию ?
SergKis: Andrey пишет: Можно там подправить в исходнике эту функцию ? 1. Отображение идет блоком кода, через стандартный FieldWBlock(cFiled, nWorkArea), Что тут менять ? 2. Ты сам ставишь все поля редактируемые .T. или нет .F. 3. Есть расчет ширины колонки, если не задано, но как правило (для красоты) ставишь под себя (свое понимание красоты) Выход - взять метод METHOD LoadFields( lEditable ) CLASS TSBrowse преобразовать в функцию, подправить под свое понимание ситуации и предложть в использование, если будент хорошо, можно поправить старый или сделать новый метод LoadField2(...) в TsBrowse
Haz: Andrey пишет: подправить подправить надо не в исходнике. Задай нужным полям соответствующий шаблон вывода и запрети редактирование. Делов то на один выэов aEval. Если идти дорогой правки исходников, то под все RDD. Я к примеру на ADS сижу, там расширенных типов полей куча, и что тоже все туда пихать? И кому этот мусор в исходниках нужен будет ?
Andrey: Принял к сведению ваши предложения. Спасибо ! Haz пишет: Делов то на один выэов aEval. Если нетрудно, дай пожалуйста как это сделать.
Dima: Andrey Пройдись по массиву полей (или как там у тебя устроено) и в зависимости от типа поля присвой свой :cPicture , возможно придется поиграться и с :bdata
Haz: Andrey пишет: Если нетрудно, дай пожалуйста как это сделать. для запрета редактирования к примеру aEval( oBrw:aColumns, {|oCol| If( oCol:cDataType == чему_надо, oCol:lEdit := .F., NIL } )
Andrey: Haz пишет: для запрета редактирования к примеру Не работает... LoadFields( "oBrw1", cForm, .T.) // все поля редактируемые // запрет редактирования полей типа: "+", "=", "^" aEval( oBrw1:aColumns, {|oCol| If( oCol:cDataType == "+", oCol:lEdit := .F., NIL) } ) aEval( oBrw1:aColumns, {|oCol| If( oCol:cDataType == "=", oCol:lEdit := .F., NIL) } ) aEval( oBrw1:aColumns, {|oCol| If( oCol:cDataType == "^", oCol:lEdit := .F., NIL) } ) // формат вывода полей типа: "+", "=", "@" aEval( oBrw1:aColumns, {|oCol| If( oCol:cDataType == "+", oCol:cPicture := REPL("9",10), NIL) } ) aEval( oBrw1:aColumns, {|oCol| If( oCol:cDataType == "=", oCol:cPicture := REPL("x",20), NIL) } ) aEval( oBrw1:aColumns, {|oCol| If( oCol:cDataType == "@", oCol:cPicture := REPL("x",20), NIL) } )
Dima: Andrey пишет: oCol:cDataType == "+" Уверен что cDataType возвращается тот что надо ?
Andrey: Dima пишет: Уверен что cDataType возвращается тот что надо ? Даже не задумывался... Блин опять исходники Tsbrowse не то возвращают... Или не они виноваты ? Точно, проверил не работает, вернее возвращает U oBrw1:aColumns[nJ]:cDataType -> "U"
Dima: Из сырца ::cDataType = ValType( Eval( ::bData ) ) , может наведет на какие мысли
Andrey: Да какие тут мысли... Править надо исходник бровса и всё тут !
Dima: Andrey пишет: Да какие тут мысли... Править надо исходник бровса и всё тут ! Ну вообще то нет Считывать и проверять нужно не тип а ФЛАГ (тип поля). Примерно так ? dbFieldInfo( DBS_TYPE, FieldPos( "t" ) ) ? dbFieldInfo( DBS_TYPE, FieldPos( "t2" ) ) ЗЫ По ходу Петр разжевал для тебя этот вопрос в теме , Новые типы переменных , но ты снова фСё забыл
SergKis: Dima пишет Уверен что cDataType возвращается тот что надо ? Вот формирование cDataType ::cDataType = ValType( Eval( ::bData ) ) Привязываться надо к именам колонок aEval( oBrw:aColumns, {|oCol| oCol:lEdit := ! ','+oCol:cName+ ',' $ ",ID,DTM,DTM2," } )
Andrey: SergKis пишет: Привязываться надо к именам колонок aEval( oBrw:aColumns, {|oCol| oCol:lEdit := ! ','+oCol:cName+ ',' $ ",ID,DTM,DTM2," } ) Не согласен. Берём чужую базу и тупо её открываем. Я откуда знаю какие имена колонок типа: "+", "=", "^", "@" ?
SergKis: Andrey пишет Не согласен. повторяю Выход - взять метод METHOD LoadFields( lEditable ) CLASS TSBrowse преобразовать в функцию, подправить под свое понимание ситуации и предложть в использование, если будет хорошо, можно поправить старый или сделать новый метод LoadField2(...) в TsBrowse
SergKis: PS У себя так и сделал, по аналогии с ::SetArrayTo(...), написал ::SetFieldTo(...)
SergKis: Andrey пишет Берём чужую базу и тупо её открываем. Я откуда знаю какие имена колонок типа: "+", "=", "^","@ Для этого надо исп. утилиту DbEdit TsBrowse предполагает программируемую работу над таблицей. А следить за всеми новыми полями и как их обрабатывать, не уверен что надо, к примеру поле @ - TimeStamp корректировать можно, его, вроде самому заполнять надо (често подзабыл уже)
Andrey: SergKis пишет: @ - TimeStamp корректировать можно, его, вроде самому заполнять надо (често подзабыл уже) Да, это поле нормально редактируется. Из-за этого и не включил его в запрет редактирования. SergKis пишет: Выход - взять метод METHOD LoadFields( lEditable ) CLASS TSBrowse преобразовать в функцию, подправить под свое понимание ситуации и предложть в использование, если будет хорошо, можно поправить старый или сделать новый метод LoadField2(...) в TsBrowse Ну не согласен с этим. Есть нормальная функция, которая сделана для Харбора !!! Это же типы уже есть в Харборе. Чуток отредактировать и будет служить 100 лет ещё...
Dima: Andrey если по всей базе то вполне сработает такой код дарю [pre2] #include "dbstruct.ch" ..... Local Hfldtype:=hb_hash("=",nil,"+",nil,"^",nil) for i := 1 To oBrw:nColCount() if hb_hhaskey(Hfldtype,dbFieldInfo( DBS_TYPE, i )) oBrw:aColumns[ i ]:lEdit := FALSE endif next [/pre2] Или можно в AEVAL все сделать PS Не проверял :) Andrey пишет: // запрет редактирования полей типа: "+", "=", "^" aEval( oBrw1:aColumns, {|oCol| If( oCol:cDataType == "+", oCol:lEdit := .F., NIL) } ) aEval( oBrw1:aColumns, {|oCol| If( oCol:cDataType == "=", oCol:lEdit := .F., NIL) } ) aEval( oBrw1:aColumns, {|oCol| If( oCol:cDataType == "^", oCol:lEdit := .F., NIL) } ) Это по ходу бредосный подход :) Все надо делать за один подход в одном AEVAL , потому как следующий AEVAL похерит результат предыдущего
Andrey: Dima пишет: дарю Спасибо ! Хотел без цикла обойтись, но наверное лучше с ним.
SergKis: Andrey пишет Ну не согласен с этим. Взял бы текст h_tbrowse.prg и просканировал на cDataType, думаю многие вопросы отпали. В основе лежит bData отображения, как задал, так и будет работать. Если надо тебе спец. обработки, надо писать и спец. блок, т.е. TimeStamp превращать как надо для конкретного отображения, то же и по lEdit, ну или перелопатить весь TsBrowse.
Haz: SergKis пишет: TsBrowse предполагает программируемую работу над таблицей. А следить за всеми новыми полями и как их обрабатывать, я за, проще самому определить как ТСБровс будет работать с базой в каждом конкретном, чем каждый раз переопределять то что почему то сделано стандартом.
SergKis: PS Метод SetFields (совместро с заданым\нет списком указанных полей) служит для первоначального заполнения\формирования колонок (вместо исп. ADD COLUMN ...), а дальше все ручками, меняешь bData, lEdit, Size, Color, ....
Andrey: SergKis пишет: а дальше все ручками, меняешь bData, lEdit, Size, Color, .... Нет в мире совершенства ... Понял ! Спасибо !
SergKis: Andrey пишет Нет в мире совершенства ... Правильнее "Лучшее - враг хорошего"
Dima: Что то я снова в виду того что долго не юзал Tsbrowse , торможу. Есть бровс и в нем стоит фильтр по полю WB , строка фильтра WB==1. На одной из записей меняю значение WB. Эта запись из фильтра должна уйти. Что нужно корректно сказать бровсу что бы правильно его обновить ? Было показано скажем 5 записей и после того как я сменил на одной из них значение WB , осталось 4 записи. Reset() юзать не хочется.
Haz: Dima пишет: reset не хочется Дима, пишу с мобилки и поэтому коротко и по пямяти ). Глянь код в методе ::Delete (). Последовательность должна быть такой же как после dbDelete () в этом методе.
Dima: Haz пишет: Глянь код в методе ::Delete () Ты в смысле про DeleteRow() ? Покопаю завтра , спасибо.
gfilatov2002: Dima пишет: Что нужно корректно сказать бровсу что бы правильно его обновить ? См. в примере ниже использование функции myUpdate() для обновления первой колонки, которая находится под фильтром /* * MINIGUI - Harbour Win32 GUI library Demo * */ #include "minigui.ch" #include "tsbrowse.ch" #include "Dbstruct.ch" REQUEST DBFCDX FUNCTION Main() LOCAL cDbf := GetStartupFolder() + '\Test.dbf' LOCAL i, cAlias LOCAL oBrw_1 SET CENTURY ON SET DELETED ON IF ! File( cDbf ) CreateTable() ENDIF rddSetDefault( 'DBFCDX' ) cAlias := cFileNoExt( cDbf ) USE ( cDbf ) Alias ( cAlias ) SHARED NEW set filter to code > 90 go top Test->( ordSetFocus( 1 ) ) DEFINE WINDOW Form_1 ; At 0, 0 ; WIDTH 600 ; HEIGHT 470 ; TITLE 'TsBrowse sample: Order' ; MAIN ; NOMAXIMIZE ; NOSIZE END WINDOW oBrw_1 := CreateBrowse( "oBrw_1", 'Form_1', 2, 2, Form_1.Width - 10, ; Form_1.Height - GetTitleHeight() - iif( IsThemed(), 1, 2 ) * GetBorderHeight() - 2, cAlias ) // modify the default settings oBrw_1:aColumns[ 1 ]:cHeading := "Number" oBrw_1:SetColSize( 1, 94 ) oBrw_1:aColumns[ 1 ]:nAlign := DT_RIGHT // editing is available for ALL columns FOR i := 1 TO Test->( Fcount() ) - 1 oBrw_1:aColumns[ i ]:lEdit := TRUE NEXT oBrw_1:aColumns[ 1 ]:nEditMove := DT_DONT_MOVE oBrw_1:aColumns[ 5 ]:cHeading := "Birthday" oBrw_1:SetColSize( 5, 120 ) // hide the last column oBrw_1:HideColumns( 6, .T. ) CENTER WINDOW Form_1 ACTIVATE WINDOW Form_1 RETURN NIL FUNCTION CreateBrowse( cBrw, cParent, nRow, nCol, nWidth, nHeight, cAlias ) LOCAL oBrw DEFINE TBROWSE &cBrw ; AT nRow, nCol ; ALIAS cAlias ; OF &cParent ; WIDTH nWidth ; HEIGHT nHeight ; COLORS { CLR_BLACK, CLR_BLUE } ; FONT "MS Sans Serif" ; SIZE 9 :SetAppendMode( .F. ) :SetDeleteMode( .F. ) :lNoHScroll := .T. :lCellBrw := .T. :nSelWidth := 16 END TBROWSE // loading the ALL database fields LoadFields( cBrw, cParent ) oBrw := TBrw_Obj( cBrw, cParent ) WITH OBJECT oBrw :nHeightCell += 2 :nHeightHead += 18 :nWheelLines := 1 :lNoChangeOrd := TRUE :hBrush := CreateSolidBrush( 230, 240, 255 ) :SetColor( { 16 }, { RGB( 43, 149, 168 ) } ) // SyperHeader backcolor :SetColor( { 3 }, { RGB( 255, 255, 255 ) } ) // Header font color :SetColor( { 4 }, { {|| { RGB( 43, 149, 168 ), RGB( 0, 54, 94 ) } } } ) // Header backcolor :SetColor( { 17 }, { RGB( 255, 255, 255 ) } ) // Font color in SyperHeader :SetColor( { 6 }, { {|| { RGB( 255, 255, 74 ), RGB( 240, 240, 0 ) } } } ) // Cursor backcolor :SetColor( { 12 }, { {|| { RGB( 128, 128, 128 ), RGB( 250, 250, 250 ) } } } ) // Inactive cursor backcolor :SetColor( { 2 }, { {|| RGB( 230, 240, 255 ) } } ) // Grid backcolor :SetColor( { 1 }, { {|| RGB( 0, 0, 0 ) } } ) // Text color in grid :SetColor( { 5 }, { {|| RGB( 0, 0, 255 ) } } ) // Text color of cursor in grid :SetColor( { 11 }, { {|| RGB( 0, 0, 0 ) } } ) // Text color of inactive cursor in grid :nClrLine := COLOR_GRID :aColumns[1]:bPostEdit := { | uVal, oBr | myUpdate(uVal, oBr) } :ResetVScroll() END OBJECT RETURN oBrw Static Function myUpdate(Val, oBrw) local lRefresh oBrw:nLen := ( oBrw:cAlias )->( Eval( oBrw:bLogicLen ) ) ( oBrw:cAlias )->( DbSkip() ) lRefresh := ( oBrw:cAlias )->( EOF() ) ( oBrw:cAlias )->( DbSkip( -1 ) ) oBrw:nRowPos -= If( lRefresh .and. ; ! ( oBrw:cAlias )->( BOF() ), 1, 0 ) oBrw:Refresh( .T. ) Return nil Static Function TBrw_Obj( cBrw, cParent ) Local oBrw, i If ( i := GetControlIndex( cBrw, cParent ) ) > 0 oBrw := _HMG_aControlIds [ i ] EndIf Return oBrw Procedure CreateTable Local aDbf[6][4], i aDbf[1][ DBS_NAME ] := "Code" aDbf[1][ DBS_TYPE ] := "Numeric" aDbf[1][ DBS_LEN ] := 10 aDbf[1][ DBS_DEC ] := 0 // aDbf[2][ DBS_NAME ] := "First" aDbf[2][ DBS_TYPE ] := "Character" aDbf[2][ DBS_LEN ] := 25 aDbf[2][ DBS_DEC ] := 0 // aDbf[3][ DBS_NAME ] := "Last" aDbf[3][ DBS_TYPE ] := "Character" aDbf[3][ DBS_LEN ] := 25 aDbf[3][ DBS_DEC ] := 0 // aDbf[4][ DBS_NAME ] := "Married" aDbf[4][ DBS_TYPE ] := "Logical" aDbf[4][ DBS_LEN ] := 1 aDbf[4][ DBS_DEC ] := 0 // aDbf[5][ DBS_NAME ] := "Birth" aDbf[5][ DBS_TYPE ] := "Date" aDbf[5][ DBS_LEN ] := 8 aDbf[5][ DBS_DEC ] := 0 // aDbf[6][ DBS_NAME ] := "Bio" aDbf[6][ DBS_TYPE ] := "Memo" aDbf[6][ DBS_LEN ] := 10 aDbf[6][ DBS_DEC ] := 0 DBCREATE("Test", aDbf, "DBFCDX") Use test Via "DBFCDX" For i:= 1 To 100 append blank Replace code with i Replace First With 'First Name '+ Ltrim(Str(i)) Replace Last With 'Last Name '+ Ltrim(Str(i)) Replace Married With ( i/2 == int(i/2) ) replace birth with date()-Max(10000, Random(20000))+Random(LastRec()) Next i Index On field->code Tag code Use Return
Dima: Haz gfilatov2002 Спасибо ! Работает.
Haz: Dima пишет: Спасибо ! Работает. Не за что вот этот кусок из метода DeleteRow и из примера Григория все делает [pre2] oBrw:nLen := ( oBrw:cAlias )->( Eval( oBrw:bLogicLen ) ) ( oBrw:cAlias )->( DbSkip() ) lRefresh := ( oBrw:cAlias )->( EOF() ) ( oBrw:cAlias )->( DbSkip( -1 ) ) oBrw:nRowPos -= If( lRefresh .and. ; ! ( oBrw:cAlias )->( BOF() ), 1, 0 ) oBrw:Refresh( .T. ) [/pre2]
Andrey: Всем привет. Делал таблицу и полдня бился с глухим зависанием программы. Пока не стал отключал построчно создание Tsbrowse. Вот такой код вешает программу наглухо: Add Super Header To oBrw1 From Column 1 To Column 1 ; Color CLR_WHITE, { nBackForm, nHeadColor1 } ; Title "" 3DLook BITMAP LoadImage("WMenu") HORZ DT_LEFT Я тоже не понимал почему, а потом дошло... В ресурсы забыл добавить "WMenu" ... Там в сами исходники поставить проверку на наличие BITMAP можно ?
gfilatov2002: Andrey пишет: Там в сами исходники поставить проверку на наличие BITMAP можно ? Да, это возможно, в таком случае будет генерироваться минигуи-ошибка, как при отсутствии формы или контрола
Andrey: gfilatov2002 пишет: Да, это возможно, в таком случае будет генерироваться минигуи-ошибка, как при отсутствии формы или контрола Отлично !
Andrey: Всем привет ! Вывожу пустую таблицу. Потом открываю нужную базу и пытаюсь заново показать в уже построенном Tsbrowse. cAlias := ALIAS() // старая база cNewAlias := "NewBase" // удалить колонки старой базы nJ := oBrw1:nColCount() FOR nI := 1 TO nJ oBrw1:DelColumn( nI ) NEXT (cAlias)->(DbCloseArea()) // закрыть старую базу SELECT(cNewAlias) oBrw1:cAlias := cNewAlias oBrw1:Reset() LoadFields( "oBrw1", cForm, .F.) // все поля не редактируемые oBrw1:Refresh(.T.) Фигня получается... Первая колонка от старой таблицы остаётся. Цвета в таблице тоже пропадают. Курсор собранный в один - тоже пропадает. Как правильно сделать мне - открытие базы в уже построенном Tsbrowse ?
SergKis: Andrey пишет: oBrw1:cAlias := cNewAlias oBrw1:Reset() LoadFields( "oBrw1", cForm, .F.)... Фигня получается... Получается все правильно, как заказывал: - LoadFields() ставит FieldWBlock(..., Select(cAlias)), привязка к области - cNewAlias это др. область - вывод, открывать cNewAlias в той же области или переписать на свой вариант FieldWBlock(...), пример FieldABlock(bBlock, cAlias):[pre2] FUNCTION FIELDABLOCK( cFieldName, cAlias ) IF cAlias == NIL; cAlias := Alias(); ENDIF IF ISCHARACTER( cFieldName ) .AND. ISCHARACTER( cAlias ) RETURN &( "{| x | iif( x == NIL, "+ ; "(["+cAlias+"])->( FieldGet( FieldPos( ["+cFieldName+"] ) ) )"+ ; "(["+cAlias+"])->( FieldPut( FieldPos( ["+cFieldName+"] ) ) ) }" ) ENDIF RETURN NIL [/pre2]
SergKis: PS чуток пропустил "(["+cAlias+"])->( FieldPut( FieldPos( ["+cFieldName+"] ), x ) ) }" )
Andrey: SergKis пишет: Получается все правильно, как заказывал: - LoadFields() ставит FieldWBlock(..., Select(cAlias)), привязка к области - cNewAlias это др. область Не совсем понял ? Я же делаю перед этим переключение на новый алиас: SELECT(cNewAlias) oBrw1:cAlias := cNewAlias Попробую со старым... потом напишу.
Andrey: Переделал на открытие старого алиаса. Всё равно фигня получается. 1) Остаётся первая колонка из предыдущей базы, причём дублирует информацию с другой колонки. 2) Цвета определённые ранее теряются полностью. Вот скрин: Как правильно сделать мне - открытие базы в уже построенном Tsbrowse ?
SergKis: Andrey Переоткрываешь так ? dbSelectArea(cAlias) dbCloseArea() dbUseArea( .F., , cFileDbf, cAlias, ...)
Andrey: SergKis пишет: Переоткрываешь так ? Нет, не так. Но база под старым алиасом нормально открывается. Попробовал как предложил, та же самая фигня. База открыта нормально, а в таблице бардак.
Dima: Andrey пишет: oBrw1:Reset() LoadFields( "oBrw1", cForm, .F.) // все поля не редактируемые oBrw1:Refresh(.T.) А если так LoadFields( "oBrw1", cForm, .F.) // все поля не редактируемые oBrw1:Reset() Рефреш не нужен
Andrey: Dima пишет: А если так База открывается нормально. Поля показываются тоже, НО: Andrey пишет: Всё равно фигня получается. 1) Остаётся первая колонка из предыдущей базы, причём дублирует информацию с другой колонки. 2) Цвета определённые ранее теряются полностью. Вот скрин: (см. выше) Нужно удалить колонку из старой базы и восстановить все цвета и состояние сборного курсора из предыдущей базы. Если нельзя так, то скажите пожалуйста как можно.
Петр: Andrey пишет: 1) Остаётся первая колонка из предыдущей базы, причём дублирует информацию с другой колонки. 2) Цвета определённые ранее теряются полностью. Все по феншую. см. код метода DelColumn А что мешает после добавления новых столбов удалить столбец №1? Перед манипуляциями с oBrw1 cохраните цвета aColors := oBrw1:aColors и восстановите в нужный момент oBrw1:aColors := aColors Перерисуйте oBrw1
SergKis: Andrey пишет База открыта нормально, а в таблице бардак Так oBrw:LoadFields(...) создает колонки[pre2] cBlock := 'FieldWBlock("' + aStru[ nE, 1 ] + '",Select("' + ::cAlias + '"))' ::AddColumn( TSColumn():New( cHeading, FieldWBlock( aStru[ nE, 1 ], Select( ::cAlias ) ),cPicture, ; { ::nClrText, ::nClrPane }, { nAlign, DT_CENTER }, nSize,, lEditable,,, cOrder,,,, ; 5,,,, Self, cBlock ) ) [/pre2] т.е. aStru от старой базы. Структуры соответствут в базах (пустой и нормальной) ? На простом примере показал бы.
SergKis: Andrey еще [pre2] METHOD DelColumn( nPos ) CLASS TSBrowse Local oCol, nMin, nMax, nI, ; nLen := Len( ::aSuperHead ) Default nPos := 1 If Len( ::aColumns ) == 1 // cannot delete last column Return Nil // ... or Nil if last column EndIf ... [/pre2]
Петр: SergKis пишет: т.е. aStru от старой базы. С какой радости, если [pre2]SELECT(cNewAlias) oBrw1:cAlias := cNewAlias ... METHOD LoadFields( lEditable ) CLASS TSBrowse ... aStru := ( ::cAlias )->( DbStruct() ) [/pre2]
SergKis: Петр Только во всей этой катавасии со сменой структуры и колонок (SuperHeader, Footer, цветов), большого смысла не вижу. Сначала показалось, что речь идет о смене с пустого файла на нормальный, а тут ... Проще удалить контрол Tsb и пересоздать новый, чем сохранять цвета, удалять колонки (первую сделать одинаковой и удалять со второй и дальше), создавать снова колонки после первой..., заголовки, восстанавливать цвета .... По мне, больше головной боли.
Петр: SergKis пишет: Проще удалить контрол Tsb и пересоздать новый Совершенно с Вами согласен. Если уже создан контрол, то оформить его создание (удаление) в виде отдельной функции и использовать ее столько раз, сколько будет нужно - выглядит совершенно естественно. Но хозяин - барин, и время и нервы его..
Andrey: SergKis пишет: Только во всей этой катавасии со сменой структуры и колонок (SuperHeader, Footer, цветов), большого смысла не вижу. Сначала показалось, что речь идет о смене с пустого файла на нормальный, а тут ... Проще удалить контрол Tsb и пересоздать новый, чем сохранять цвета, удалять колонки Петр пишет: Если уже создан контрол, то оформить его создание (удаление) в виде отдельной функции и использовать ее столько раз, сколько будет нужно - выглядит совершенно естественно. Но хозяин - барин, и время и нервы его.. Ну теперь понятно как делать ! Спасибо за подсказку.
Andrey: Как можно сделать функцию чтения текущего цвета, чтобы его (цвет) потом передавать для другого условия ? Например, если поставить два условия:[pre2] // --- меняем цвета текста в ячейках таблицы --( oCol:nClrFore = oBrw:SetColor({1}...)--- AEval(oBrw:aColumns, {|oCol,nCol| oCol:nClrFore := { |a,b,o| ; iif( (o:cAlias)->ERR_4 == -1 , CLR_HRED, CLR_BLACK ) } }) AEval(oBrw:aColumns, {|oCol,nCol| oCol:nClrFore := { |a,b,o| ; iif( (o:cAlias)->ERR_4 == 1 , CLR_HBLUE, CLR_BLACK ) } })[/pre2] то последнее условие будет всегда исполнятся, первое условие будет игнорироваться. Можно ли как то сделать типа так: ??? [pre2] AEval(oBrw:aColumns, {|oCol,nCol| oCol:nClrFore := { |a,b,o| ; iif( (o:cAlias)->ERR_4 == -1 , CLR_HRED, MyCLR() ) } }) AEval(oBrw:aColumns, {|oCol,nCol| oCol:nClrFore := { |a,b,o| ; iif( (o:cAlias)->ERR_4 == 1 , CLR_HBLUE, MyCLR() ) } })[/pre2] Ну может ещё параметр передавать в MyCLR() нужно...
Andrey: Блин, что то я ступил... Решение то простое. Совсем заработался... AEval(oBrw:aColumns, {|oCol,nCol| oCol:nClrFore := { |a,b,o| MyTsbColorText( (o:cAlias)->ERR_4 ) } } ) .............. //////////////////////////////////////////////////////////// STATIC FUNCTION MyTsbColorText(nVal) LOCAL nColor IF nVal == -1 nColor := CLR_HRED ELSEIF nVal == 1 nColor := CLR_HBLUE ELSE nColor := CLR_BLACK ENDIF RETURN nColor
Andrey: А вы знаете, что в МиниГуи 16.09 содержится 5796 файлов - размером 85,5 Мб ? А в папке Include 90 файлов занимают 1,01 Мб ? А папка исходников SAMPLES с *.prg весит 8,85 Мб и кол-во файлов 1003 и самые первые исходники датированы 2003 годом ? Все эти сведения смотрите в новом примере Tsbrowse у Григория !
Dima: Andrey При чем тут твое сообщение и название темы ? О каком примере речь ? PS Хорошая трава у тебя однако
Петр: Dima пишет: При чем тут твое сообщение и название темы ? О каком примере речь ? Скорее всего, Андрей написал новый пример на тему использование Tsbrowse в MiniGUI и надеется, что Григорий его опубликует в новом релизе.
gfilatov2002: Петр пишет: Андрей написал новый пример на тему использование Tsbrowse в MiniGUI Так и есть Петр пишет: Григорий его опубликует в новом релизе Да, я включил этот пример после небольшой чистки в 4-ю бету. Петр Выложил 4-ю бета-сборку на ftp по прежнему адресу
krutoff: Обратил внимание h_tbrowse.prg в методе Excel2 если выводит цифровые данные по шаблону допустим 999999.99 -> то результат будет с одним знаком после запятой и меньшим в 10 раз. Раньше не обращал внимание - все работало. Крутил блок со строки 4374: if "@Z " $ ::aColumns[ nCol ]:cPicture .or. LEN(cPic) > 3 пока результата не добился...
Andrey: Петр пишет: Скорее всего, Андрей написал новый пример на тему использование Tsbrowse в MiniGUI Нет, не я написал. SergKis сделал.
Andrey: Всем привет. Вопрос возник по бровсу. На окне имею Tsbrowse с вертикальной линией скролинга и подвалом. Делаю - oBrw:Enabled( .F. ) // отключить показ TBROWSE Шапка таблицы становится серой, сама таблица пропадает, а подвал и скролинг остаются. Это должно быть так или это глюк ? Как убрать скролинг и подвал ?
SergKis: Andrey сделай SetProperty(oBrw:cParentWnd, oBrw:cControlName, "Enabled", .F.)
SergKis: Andrey Если хочешь скрыть tsb, делай oBrw:Hide()
krutoff: krutoff пишет: Обратил внимание h_tbrowse.prg в методе Excel2 если выводит цифровые данные по шаблону допустим 999999.99 -> то результат будет с одним знаком после запятой и меньшим в 10 раз. Раньше не обращал внимание - все работало. Крутил блок со строки 4374: if "@Z " $ ::aColumns[ nCol ]:cPicture .or. LEN(cPic) > 3 пока результата не добился... Неужели у всех цифровые поля с копейками нормально в Excel выводятся? Или никто в XLS TSBrowse не выводит?
Andrey: SergKis пишет: сделай SetProperty(oBrw:cParentWnd, oBrw:cControlName, "Enabled", .F.) Не помогает ! Остаётся так же: со скролингом и подвалом таблицы. Версия 16.09 ! SergKis пишет: Если хочешь скрыть tsb, делай oBrw:Hide() Это получше.... Пока пойдёт ! Но я хотел бы на дальнем фоне оставить таблицу заблокированную, на будущее...
Andrey: krutoff пишет: Неужели у всех цифровые поля с копейками нормально в Excel выводятся? У меня тоже нет второго 0. выводит только 0.0, вторую цифру после нуля обрезает.
SergKis: Andrey пишет Не помогает ! Остаётся так же: со скролингом и подвалом таблицы. Версия 16.09 ! версия 2.07. oBrw:Enabled(.F.) - как утебя, SetProperty(...) - все хорошо, таблица блокирована, отображение норма
Andrey: Опять глюк поймал... Сделал меню (2 колонки) из Tsbrowse, назначил только блок кода на обработку: [pre2]oBrw:aColumns[1]:bPrevEdit := {|| MenuRun(), FALSE } oBrw:aColumns[2]:bPrevEdit := {|| MenuRun(), FALSE } ..... STATIC FUNCTION MenuRun() .... SetProperty(oBrw:cParentWnd, oBrw:cControlName, "Enabled", .F.) oBrw:Hide() // отключить показ Tsbrowse Menu2Start("RUN new function", oBrw:nAt ) oBrw:Show() // включить показ Tsbrowse SetProperty(oBrw:cParentWnd, oBrw:cControlName, "Enabled", .T.) oBrw:Refresh(.T.) Form_2.oBrw.Setfocus RETURN Nil[/pre2] Функцию обработки при изменении позиции маркера не использую. //oBrw:bChange := { |oBrw| ChangeTable(oBrw) } В функции Menu2Start("RUN new function", oBrw:nAt ) - всё равно происходит показ таблицы oBrw ! Почему ? Мышкой по клацаешь (или стрелками с Enter используешь) и таблица вся появляется... Что нужно добавить чтобы таблица не появлялась в функции Menu2Start() ?
Dima: Andrey пишет: В функции Menu2Start("RUN new function", oBrw:nAt ) Ты ведь покажешь что в ней живет ? Телепаты в отпуске. PS Только не надо мне ее на мыло слать , сюда пиши.
Andrey: Dima пишет: Ты ведь покажешь что в ней живет ? Телепаты в отпуске. Да в той функции нет обращений к объектам таблицы. Только кнопочки и смена фона. Я разобрался с этим. Оказывается всё просто, нужно [pre2]SetProperty(oBrw:cParentWnd, oBrw:cControlName, "Enabled", .F.) oBrw:Hide() // отключить показ Tsbrowse [/pre2] поместить в саму функцию Menu2Start(), а [pre2]oBrw:Show() // включить показ Tsbrowse SetProperty(oBrw:cParentWnd, oBrw:cControlName, "Enabled", .T.) oBrw:Refresh(.T.) Form_2.oBrw.Setfocus [/pre2] поставить перед выходом из функции Menu2Start() ! И глюк пропал... Замена мест слагаемых - меняет действие глюка.
SergKis: Пример на эту тему: http://my-files.ru/catj99
SergKis: Тот же пример, с попыткой заменить метод Enabled: http://my-files.ru/w3b3nf
Dima: Ездили ездили колесом на вынь XP и бах таблица стала ломаться Перезашли в прогу , 10 минут все хорошо , потом снова такая же ерунда. У себя на вынь 7 такого не наблюдаю. Что за напасть ? PS Задача сетевая
Dima: Вот и я доездился в семерке В начале пропали все иконки , с кнопок и бровса Затем начал глючить скрол ........и понеслась После закрытия окна с бровсом в главном окне пропали картинки и иконки включая главное меню. При повторном запуске бровса ни чего изменилось , картинок и иконок нет. После закрытия , главное окно полностью потеряло все контролы и все закрасилось серым цветом. PS MiniGui 16.06 + Mingw 4.9.2 не тот что был в поставке + Harbour свой от 2016-03-10
SergKis: Dima пишет Ездили ездили колесом на вынь XP и бах таблица стала ломаться стрелками вверх\вниз, такая же ерунда ? 1. Убери горизонт. скролл, пробни 2. Уменьши высоту заголовка на 1, 2 рх
Dima: SergKis Так он нормально работает минут 15 и потом бац Попробую пересобрать с тем Mingw что шел в поставке Минигуи + Harbour от него
SergKis: Дима, если происходит сбой на 1 рх, то прорисовка может сломаться, потому проверить не мешает. от стрелок вверх\вниз через 15 мин. ломается?
Dima: Dima пишет: Попробую пересобрать с тем Mingw что шел в поставке Минигуи + Harbour от него Пытаюсь пересобрать с 16.06 на 16.10 Получаю hbmk2: Error: Referenced, missing, but unrecognized Harbour function(s): HB_LANG_RUWIN() В сырце стоит так REQUEST HB_CODEPAGE_RU1251, HB_CODEPAGE_RU866 , HB_LANG_RUWIN Что то я потерялся , да еще и файл ресурсов не собирается и валит ошибку C:/MINIGUI_MG/hmg/mingw32/bin/../lib/gcc/i686-w64-mingw32/6.2.0/../../../../i686-w64-mingw32/bin/ld.exe: .rsrc merge failure: dupl icate leaf: type: 2 (BITMAP) name: BOX16 lang: 409
Dima: И все таки какая то порча с Минигуи 16.10 под MINGW Взял пример minigui\Samples\MAINDEMO\ и собрал его с помощью Build.bat , все нормально После добавил в сырец примера строку REQUEST HB_LANG_RUWIN и снова пробнул собрать , не собирается. Куда копать ? И до кучи , UPX3.91w не жмет исполняемые файлы Minigui (16.10)+Mingw и выдает CantPackException: superfluous data between sections
Dima: SergKis пишет: стрелками вверх\вниз, такая же ерунда ? 1. Убери горизонт. скролл, пробни 2. Уменьши высоту заголовка на 1, 2 рх Да со стрелками та же ерунда , но не сразу. Минут 5 полет нормальный Заголовок уменьшил на 2 px , не помогло Г скролл выключил но после этого пропали 2 крайние колонки
SergKis: Dima пишет Да со стрелками та же ерунда , но не сразу. Попробуй, нажимая стрелку вниз\вверх, перемежать нажатием PgDn\PgUp У меня была похожая ситуевина (через 100 строк вставлял Pg... и помогло)
SergKis: PS Г скролл у меня отключен совсем, дело в том, что GetHScrollBarHeight() дает разные данные, а в расчетах тсб по другому и возникает дисбаланс рх. еще отключи noholes - без нее пробни.
Dima: SergKis пишет: еще отключи noholes - без нее пробни. выключил , снова поездил мышкой.....минут через 5 сломались хидеры в обоих бровсах , после пропали все картинки в таблицах , цвет грида (сетки) сбросился сам на дефолтный , при нажатии на кнопку вызова справочника , получил серое окно ....после путем нажатия ESC добрался до главного окна в котором главное меню уже было сломано , но если мышкой поводить там где оно должно жить , то оно появляется. Барабашки что ли завелись....не знаю что делать. Может ну его в лес MINGW и взять старый добрый BCC55 , вот только не уверен что это поможет. PS Ведь если "загулял" где то пиксель то глючить начало бы сразу. А так в течении 5-10 минут я успеваю "объезжать" всю таблицу вдоль и поперек и ни каких глюков нет. Ни чего не понимаю PS2 В одном окне живет 2 бровса , главный и подчиненный , двигаясь по главному , меняется содержимое подчиненного бровса. Такое впечатление что где то утечка памяти.......
SergKis: Dima пишет Ведь если "загулял" где то пиксель то глючить начало бы сразу. В том и дело, что не сразу. Стрелками жмем (колесо мыши) одна прорисовка, PgDn\Up другая Мне вставка Pg..., между нажатями стрелок, помогла. Если тебе, при нажатии стрелки вниз, через 50 строк пробега, отпускать и жать PgDn и снова стрелку вниз на ~50 строк и т.д. в течении 15-20 мин. не сломает, ... было бы не плохо - бороться можно. На твоей картинке видно как развалилась прорисовка, на заголовке линия и строки смещены, наложены. А когда тсб сломался, то происходит полная фигня и с др. окнами (правда не всегда), причем полная. Программа большая (много окон) без тсб (browse), работает месяцами без перезагрузки, с тсб большой нет, пока использую прогу как утилиту со многими входами (и тсб) - совмещаю с wvt. Но все время в ожидании ситуации, как у тебя выползла. Виноват ли тут MinGw ? Поможет Bcc ? я на mvc.
SergKis: Dima пишет Такое впечатление что где то утечка памяти....... Это вполне возможно с памятью, вся база минигуи это public переменные, мусоросборщик может их таскать и ... В VO это было большой проблеммой
Dima: Сергей , стрелки ни кто и не использует для движения , как правило это мышь. А конкретно где и как ты предлагаешь вставить PG....? Сейчас тупо гоняю тест в своей проге где в одном окне всего один бровс и пока глюков нет. Такое впечатление что заглючить может тогда ,когда в одном окне 2 бровса , но пока еще потестю и отпишу.
SergKis: Dima пишет В одном окне живет 2 бровса От 2-х тсб, я пока отказался (нет уверенности в нормальной\надежной работе), планирую browse+tsb или tsb+browse, в зависимости от сложных header\footer -> tsb и простых > browse.
Dima: SergKis пишет: От 2-х тсб, я пока отказался Меня только что посетила мысль. Вместо того что бы помещать 2 бровса в одно окно , можно сделать иначе. Окно , на нем еще 2 окна под размеры бровсов и уже в каждом из этих окон будет жить свой бровс. Возможно глючить не будет , но уверенности нет...........
SergKis: Dima пишет стрелки ни кто и не использует для движения , как правило это мышь Крутя колесико - посылается сообщение, в исполнение которого лежит типа нажали стрелку. Прудлагаю ручками (имитация колесика) проделать, как описал выше, стрелка нажата, пробежали 50-100 записей, PgDn ... Если поможет, покажу где что вставить.
SergKis: Dima пишет Окно , на нем еще 2 окна под размеры бровсов и уже в каждом из этих окон будет жить свой бровс. Окна с тсб без заголовков и всего, так можно пробнуть, отпишись, что выйдет.
Dima: SergKis пишет: Окна с тсб без заголовков и всего, так можно пробнуть, отпишись, что выйдет. конечно
ММК: Dima пишет: Такое впечатление что где то утечка памяти. Да, такое впечатление. Под FW с TsBrows ом у меня такие проблемы были. Отследи утечку, потом можно будет пободаться. Например убрать все фонты ....
Dima: ММК в Xбровсе FW такого нет ?
ММК: Dima пишет: в Xбровсе FW такого нет ? Нет. Xбровс это уже другой уровень, другие возможности.
Dima: ММК То есть ни чего в нем само не ломается если сам ошибок не сделал , так ?
Dima: SergKis Значит сделал я в отдельном окне. Одно окно STANDART большое на весь экран , под главный бровс внутри этого окна сделал окно WINDOWTYPE PANEL и в нем поселил главный бровс. Поездил и глюки повторились (не сразу) . Печаль......
SergKis: Dima А если не панель (там вроде не все ок), а child на каждый тсб, а сверху standart ?
Dima: SergKis Да что то я сразу не допер , так как смутил первый вылет когда я просто внутри окна определил другое окно и когда запустил , выпала месага что внутри окна можно создать только окно типа Panel Я пока что делаю чистый эксперимент , езжу только клавишами......о снова все сломалось при чем в обоих бровсах сразу. Хрен знает что делать.......а клиент уже лютует ЗЫ Чем больше ездим по бровсу , не важно как , мышка или клава , тем он быстрее дурнеет и дурнеет...... Может ему какую оздоравливающую процедуру делать по таймеру ? Вопрос в том какую... Говорю о двух бровсах в одном окне. Когда один то такого не происходит , мне не удалось это сделать.
Andrey: Dima пишет: Хрен знает что делать.......а клиент уже лютует Сочувствую... Аналогично бывает... Я только один бровс в окне использую. SergKis пишет: А если не панель (там вроде не все ок), а child на каждый тсб, а сверху standart ? Вот это интересное решение, но столько проблем начинается при перетаскивании окна. Если каждое окно - само за себя то это классное решение.
Dima: Dima пишет: Может ему какую оздоравливающую процедуру делать по таймеру ? Сунул пока что в bchange бровса doevents() , буду тестить......
SergKis: Dima пишет Может ему какую оздоравливающую процедуру делать Я тебе ее предлагал, стрелкой вниз держим, через ~50 строк отжимаем и жмем PgDn, снова стрелкой вниз держим, через ~50 строк отжимаем и жмем PgDn, ... потом стрелкой вверх тоже самое, если не рушится, то процедуру можно делать (у меня есть такое), если нет, то ... хз.
SergKis: Dima пишет Хрен знает что делать.......а клиент уже лютует Замени левый тсб (с первой картинки) browse, там только 2-х строчный заголовок -> сделай в строку для browse, места хватит. должно работать, есть разница, конено, но не смертельная, а выиграть аремя можно.
Dima: SergKis пишет: Я тебе ее предлагал, стрелкой вниз держим, через ~50 строк отжимаем и жмем PgDn Как же я на глазок определю что отмотал 50 строк руками ? :) Вообще процедура не понятна.........отмотали 50 строк вниз и зачем то нажали PgDn ....он еще отмотает страницу , как то не логично. И потом почему на твой взгляд такой подход должен решить проблему ? Что то я не до конца усекаю
SergKis: Andrey пишет но столько проблем начинается при перетаскивании окна. Совсем проблемы нет менять координаты row,col child окон при перетаскивании standart окна
SergKis: Dima пишет И потом почему на твой взгляд такой подход должен решить проблему ? Что то я не до конца усекаю У себя я именно так нащупал оздоравливающую процедуру и встроил ее в либу - пока работает. Стрелка .. работает типа скрол экрана, а PgDn прорисовывает весь лист (окно) тсб, в этом разница. ~50-100 строк я нащупал пробуя, в либу поставил 100, т.е. крутим колесико или жмем стрелку ..., через 100 строк проскакивает отжатие стрелки и PgDn или PgUp
Dima: SergKis Похоже на шаманство и танец с бубном Если не жалко , сложи на фтп + как ее правильно применить. Спасибо. PS С 7 утра пытаюсь решить эту проблему и ни как..........
SergKis: Dima пишет Похоже на шаманство и танец с бубном Так я и плясал вокруг этого не один день Просто понять поможет или нет (время на разбирательсво не тратить) жмешь чуть чуть стрелку вниз, отпускаешь, жмешь PgDn один раз и снова стрелку вниз чуть чуть и т.д. Еще пробни нажатия PgDn (с отпусканием или зажатый на срок) ломают тсб ? тексты тут положу, найду что менял.
Dima: SergKis пишет: Так я и плясал вокруг этого не один день Смотри сам , не хочешь , не выкладывай , я пойму Буду тогда сам ковыряться не один день
ММК: Dima пишет: То есть ни чего в нем само не ломается если сам ошибок не сделал , так Так нет. У меня есть пару мест , где на окне пара бровсов-жалоб не поступало. Правда не пробовал 15 минут крутить колесико :) SergKis пишет: Стрелка .. работает типа скрол экрана, а PgDn прорисовывает весь лист (окно) тсб, в этом разница. Уже не помню, поэтому могу ошибаться :) Делал что-то типа oBr:upstable() oBr:Setfocus() или oBr:upstable() oBr:Refresh(.T.) Иногда помогало :)
SergKis: Тут изменения [pre2] CLASS TSBrowse FROM TControl ... DATA nKeyDownOld AS NUMERIC INIT 0 // BK 11.08.2015 DATA nKeyDownCnt AS NUMERIC INIT 0 // BK ... METHOD HandleEvent( nMsg, nWParam, nLParam ) CLASS TSBrowse ... ElseIf nMsg == WM_KEYDOWN return ::KeyDown( nWParam, nLParam ) ElseIf nMsg == WM_KEYUP ::nKeyDownOld := 0 // BK 11.08.2015 ::nKeyDownCnt := 0 // BK Return ::KeyUp( nWParam, nLParam ) Elseif nMsg == WM_HSCROLL ... METHOD KeyDown( nKey, nFlags ) CLASS TSBrowse ... Case nKey == VK_UP ::GoUp() If ::nRowPos == 1 // BK 11.08.2015 If ::nKeyDownOld == nKey ::nKeyDownCnt += 1 EndIf If ::nKeyDownCnt >= ( ::nRowCount() ) PostMessage(::hWnd, WM_KEYUP , VK_UP , 0) PostMessage(::hWnd, WM_KEYDOWN, VK_PRIOR, 0) EndIf EndIf ::nKeyDownOld := nKey // BK 11.08.2015 Case nKey == VK_DOWN ::GoDown() If ::nRowPos == ::nRowCount() // BK 11.08.2015 If ::nKeyDownOld == nKey ::nKeyDownCnt += 1 EndIf If ::nKeyDownCnt >= ( ::nRowCount() ) PostMessage(::hWnd, WM_KEYUP , VK_DOWN, 0) PostMessage(::hWnd, WM_KEYDOWN, VK_NEXT, 0) EndIf EndIf ::nKeyDownOld := nKey // BK 11.08.2015 Case nKey == VK_LEFT ::GoLeft() Case nKey == VK_RIGHT ::GoRight() ... METHOD KeyUp( nKey, nFlags ) CLASS TSBrowse ::nKeyDownOld := 0 // BK 11.08.2015 ::nKeyDownCnt := 0 // BK If lNoAppend != Nil ... [/pre2]
SergKis: ММК пишет Иногда помогало :) Лишним такое переотображение не будет, согласен
Dima: SergKis пишет: Тут изменения Вариант понятен , снова править сырцы. Думал можно обойтись без этого. Да и результат я так понял по сообщению выше , не всегда стабилен и может заглючить. В любом случае , спасибо Попробую основной бровс с TS переписать на обычный бровс , надеюсь там есть двойной курсор и его раскраска.
Haz: Дима, в подчиненом бровсе сразу прорисовка( при смене строки) или по таймеру после прекращения навигации в главном? Пишу с мобилы. Пока нет компа под рукой
Dima: Haz пишет: Дима, в подчиненом бровсе сразу прорисовка или по таймеру после прекращения навигации в главном. Так по таймеру и делал с твоей подачи Игорь.
Haz: Попробуй задержку таймера увеличить
Haz: У меня целый день пользователь гоняет мышь вверх вниз от безделья. С тех пор как переделал на таймер все работает
Dima: Haz пишет: Попробуй задержку таймера увеличить Хорошо , отпишу завтра. Haz пишет: У меня целый день пользователь гоняет мышь вверх вниз от безделья У моего думаю так же , но не факт....
Haz: Еще при прорисовке подчиненного процедуру глянь. У тебя там скорее scope и refresh используется. Кажется мне если этот refresh закоментить то слом прекратиться, впрочем как и отображение scope Я использую reset для перерисовки
Dima: Haz Завтра выложу кусок сырца , но там вроде все правильно. У меня там RESET бровсу + серверный фильтр , Refresh нет
Softlog86: когда пошли первые непонятные подвисания и косяки с прорисовкой (пустые строки в середине таблицы) , сразу отказался от использования TSBROWSE и ушел на стандартные BROWSE . Когда допилят - попробую снова . кроме SuperHeader и раскраски элементов ничего от них не нужно было ....
Dima: Haz Вот сырцы , но там все гладко как бы. Ведь работает же первые 5-10 минут нормально. Если не клацать ни чего в бровсе и не ездить по нему , то обе таблички могут висеть хоть целый день и ни чего не ломается. Но стоит интенсивно поездить по ним какое то время , бровс начинает жить своей жизнью и может сломать жизнь другим окнам и контролам в программе. [pre2] __objAddData (oBrw3, 'nOldRecord' ) __objAddData (oBrw3, 'nNewRecord' ) __objAddData (oBrw3, 'nDellay' ) oBrw3:nDellay := 50 ... ... ... .... oBrw3:bChange := { || CheckRefresh(oBrw3) } // для главного бровса [/pre2] *------------------------------------------------------ [pre2] FUNC CheckRefresh( o ) IF ! _IsControlDefined ( o:cControlName + '_Timer', o:cParentWnd ) _DefineTimer ( o:cControlName + '_Timer' , o:cParentWnd , o:nDellay , { || OnChangeProcedure(o) } ) END o:nNewRecord := o:nLogicPos() RETURN NIL *--------------------------------------------------- FUNC OnChangeProcedure( o ) if o:nOldRecord == o:nNewRecord Myfilter(o,obrw4) IF _IsControlDefined ( o:cControlName + '_Timer', o:cParentWnd ) Domethod( o:cParentWnd, o:cControlName + '_Timer' , 'Release') ENDIF endif o:nOldRecord := o:nLogicPos() RETURN NIL *--------------------------------------------------------- Func MyFilter(o1,o2) If o1:loBrw3Ready Setproperty("SPR_REC","Message4","value","Загрузка данных.......") Flogan('rid=='+ntoc((o1:cAlias)->rid) ,o2:cAlias) // серверный фильтр ADS o2:Reset() GetTotal(.t.,o2 ) Setproperty("SPR_REC","Message4","value",alltrim((o1:cAlias)->naim) ) Setproperty("SPR_REC","Message4","tooltip",alltrim((o1:calias)->prime)) Setproperty("SPR_REC","Message5","value",getuserfio() ) FreshFoots(o2) if n_fltrecept==2 Setproperty(obrw3:cParentWnd,"Button_1","Enabled",FALSE) endif if kaka("recept") .or. idrec_user==(o1:calias)->n_user obrw3:SetDeleteMode( if (n_fltrecept==2,.f.,.t.) ,.f.,{|| del_x:=(obrw3:calias)->rid,isdel(obrw3)} , {||ClearSpec(del_x) , x:=obrw3:bchange,obrw3:bchange:=nil,obrw3:Gotorec((obrw3:calias)->(recno())),obrw3:bchange:=x,eval(obrw3:bchange) } ) obrw4:SetDeleteMode( if (n_fltrecept==2,.f.,.t.) ,.f.,{|| if( (obrw4:calias)->itg==0,msgokCancel("Удалить "+alltrim(getspr(oBrw4,"naim"))+" ?","Внимание"),FALSE) },{|| Gettotal(.t.,obrw4),FreshFoots(obrw4)} ) Setproperty(obrw3:cParentWnd,"Button_2","Enabled",if(n_fltrecept==2,FALSE, TRUE) ) Setproperty(obrw3:cParentWnd,"Button_2","Enabled",if(n_fltrecept==2,FALSE, TRUE) ) Setproperty(obrw3:cParentWnd,"Button_3","Enabled",if(n_fltrecept==2,FALSE, TRUE) ) Setproperty(obrw4:cParentWnd,"Button_1x","Enabled",if(n_fltrecept==2,FALSE, TRUE) ) Setproperty(obrw4:cParentWnd,"Button_2x","Enabled",if(n_fltrecept==2,FALSE, TRUE) ) Setproperty(obrw4:cParentWnd,"Button_3x","Enabled",if(n_fltrecept==2,FALSE, TRUE) ) Setproperty(obrw4:cParentWnd,"Button_4x","Enabled",if(n_fltrecept==2,FALSE, TRUE) ) Setproperty(obrw4:cParentWnd,"Button_6x","Enabled",if(n_fltrecept==2,FALSE, TRUE) ) Setproperty(obrw4:cParentWnd,"Button_7x","Enabled",if(n_fltrecept==2,FALSE, TRUE) ) Setproperty(obrw4:cParentWnd,"Button_8x","Enabled",if(n_fltrecept==0,kaka("prnrecept"),.t. )) else obrw3:SetDeleteMode( .f.,.f.,{|| del_x:=(obrw3:calias)->rid,isdel(obrw3)} , {||ClearSpec(del_x) , obrw3:Gotorec((obrw3:calias)->(recno())) } ) obrw4:SetDeleteMode( .f.,.f.,{|| if( (obrw4:calias)->itg==0,msgokCancel("Удалить "+alltrim(getspr(oBrw4,"naim"))+" ?","Внимание"),FALSE) },{|| Gettotal(.t.,obrw4),FreshFoots(obrw4)} ) Setproperty(obrw3:cParentWnd,"Button_2","Enabled",FALSE ) Setproperty(obrw3:cParentWnd,"Button_3","Enabled",FALSE ) DoMethod ( "SPR_REC" , "Button_5" , 'Hide' ) Setproperty(obrw4:cParentWnd,"Button_1x","Enabled",FALSE ) Setproperty(obrw4:cParentWnd,"Button_2x","Enabled",FALSE ) Setproperty(obrw4:cParentWnd,"Button_3x","Enabled",FALSE ) Setproperty(obrw4:cParentWnd,"Button_4x","Enabled",FALSE ) Setproperty(obrw4:cParentWnd,"Button_6x","Enabled",FALSE ) Setproperty(obrw4:cParentWnd,"Button_7x","Enabled",FALSE ) Setproperty(obrw4:cParentWnd,"Button_8x","Enabled",if(n_fltrecept==0,kaka("prnrecept"),.t. )) endif endif return nil *-------------------------------------------------------- func Flogan(ceri,alik) hb_default(@alik,alias()) if (alik)->(Rddname())=="ADSCDX" (alik)->(AdsSetAof(ceri,2)) else (alik)->(dbsetfilter({|| &(ceri)},ceri)) endif return nil *--------------------------------------------------------- [/pre2] Вот видео что выслал клиент. Я позже у себя тоже плотно поюзал и выпал на похожие глюки (писал выше) https://icq.com/files/8uYhqfbCuUW6BUvEZYzFSp5821d4ab1ad
SergKis: Dima пишет Вот сырцы Может не так понял, но создавать тимер в CheckRefresh и удалять в блоке кода { || OnChangeProcedure(o) } это слишком круто (через 50 млсек.) 1. По мне тимер надо вешать на окно и приостанавливать его работу на время выборок, делая тимеру Enabled := .F. и запуская на отслеживание изменения позиции\ключа данных Enabled := .T. 2. SetDeletedMode тоже поставить один раз на obrw3,obrw4 и внутри отслеживать что там надо 3. Сам тимер в работе должен ТОЛЬКО отследить, что сменился ключ\позиция (рассогласование obrw3, obrw4) и включить прорисовку obrw4, причем время реакции\работы тимер не менее 700 млсек. (в VO ставил 1000 млсек.).
SergKis: PS процедура CheckRefresh в obrw3, должна только показывать, что сменился ключ\позиция, при перемещении, а тимер, срабатывая (через сек.) переотображать, если ключ\позиция изменились Это, конечно, если правильно понял идею по тексту
Haz: SergKis удалять в блоке кода { || OnChangeProcedure(o) } это слишком круто (через 50 млсек.) Согласен , была мысль поселить таймер в бровсе и управлять прорисовкой флагами . Но до реализации не дошло. То что дал Дима , это временное решение . и как все временное живет уже почти год Идея ты понял правильно - незачем рисовать дочерний бровс пока пользователь не оторвал палец от клавиатуры или не перестал крутить колесо. Dima Вот сырцы только если смену фокуса на дочерний бровс перед прорисовкой и восстановить на главный после
gfilatov2002: SergKis пишет: тимер надо вешать на окно и приостанавливать его работу на время выборок, делая тимеру Enabled := .F. и запуская на отслеживание изменения позиции\ключа данных Enabled := .T. Полностью согласен - это оптимальный путь В противном случае каждые 50 мсек создается PUBLIC переменная для нового таймера, что и приводит к утечке памяти у Димы. Рекомендую также увеличить время срабатывания таймера минимум в 3 раза (можно и больше ) Кстати, для периодической чистки памяти по таймеру на форуме HMG рекомендуют команду DEFINE TIMER Tmr_1 INTERVAL 5000 ACTION (RELEASE MEMORY) // только для WinVista и выше Dima пишет: Вот сырцы , но там все гладко как бы. Не совсем гладко, выходит...
Dima: Не думал что таймер может так поднасрать ))) Сделал без таймера. В Bchange главного бровса o:Reset() прибил , так как при частом вызове это может привести к зависанию бровса. Вместо него сделал o:Refresh(.t.) +o:Gotop()+ o:upstable() Испытываю езду по бровсу , пока не виснет и не глючит Но посмотрим....
SergKis: Dima пишет Вместо него сделал o:Refresh(.t.) + o:upstable() Испытываю езду по бровсу , пока не виснет и не глючит От timer не отказывайся, по левому тсб бегают\остановились, а правый через 1 сек. переотображает (если сменилось), это лучше, чем на каждой смене левой записи переотображать правый тсб.
Dima: SergKis пишет: это лучше, чем на каждой смене левой записи переотображать правый тсб. Я понимаю это , но вот езжу туда сюда уже 30 минут и все нормально , косяков нет. Правый бровс думаю не умрет , ведь перед показом там идут некоторые расчеты , что и дает некую задержку. Когда там жил RESET() , могло зависнуть.
SergKis: Dima пишет Правый бровс думаю не умрет , ведь перед показом там идут некоторые расчеты , что и дает некую задержку. Т.е. получается правый тсб расчитывает потом показывает (с задержкой), а левй убежал уже куда то, т.к. на нем крутим колесо мыши, не уверен, что это правильно
SergKis: PS Если правильно понимию от правого тсб ставится scope\filter и получается правый убежал и что то ставит, а левый еще где то в прошлых установках
SergKis: надо читать левый убежал и что то ставить, а правый еще в прошлых установках, спутался чуть чуть, сори
Dima: SergKis Убедил. Только пока не совсем четко представляю как это все правильно переделать , с Минигуи работаю наскоками.
SergKis: Dima Схематично можно делать так [pre2] DEFINE WINDOW ... @ 0, 0 LABEL Buf VALUE '' WIDTH 2 HEIGHT 2 INVISIBLE This.Buf.Cargo := 0 // тут к примеру oBrw3, oBrw4 TsBrowse создаем SetProperty(ThisWindow.Name, 'oBrw4', 'Cargo', 0) DEFINE TIMER MyTimer INTERVAL 1000 ACTION DoTimer(oBrw4) This.MyTimer.Enabled := .F. END WINDOW FUNC CheckRefresh( o ) SetProperty(o:cParentWnd, 'Buf', 'Cargo', (o:cAlias)->( RecNo() )) // если есть кнопки к левому тсб, их можно тут поставить в Enabled := <что надо> RETURN NIL FUNC DoTimer( o ) LOCAL nNew := GetProperty(o:cParentWnd, 'Buf' , 'Cargo') LOCAL nOld := GetProperty(o:cParentWnd, 'oBrw4', 'Cargo') If empty(nNew) RETURN NIL EndIf If nNew != nOld SetProperty(o:cParentWnd, 'MyTimer', 'Enabled', .F.) // тут перепоказ правого тсб // ставим scope\filter и .... SetProperty(o:cParentWnd, 'oBrw4', 'Cargo', nNew) SetProperty(o:cParentWnd, 'MyTimer', 'Enabled', .T.) EndIf RETURN NIL [/pre2]
SergKis: PS забыл, после готовности окна (тсб) к работе вкл. This.MyTimer/Enabled := .T.
Dima: SergKis Сделал так [pre2] FUNC DoTimer( o3,o4 ) LOCAL nNew := GetProperty(o3:cParentWnd, 'Buf' , 'Cargo') LOCAL nOld := GetProperty(o3:cParentWnd, 'oBrw3', 'Cargo') If o3:loBrw3Ready If empty(nNew) RETURN NIL EndIf If nNew != nOld SetProperty(o3:cParentWnd, 'MyTimer', 'Enabled', .F.) Myfilter(o3,o4) // тут перепоказ правого тсб // ставим scope\filter и .... SetProperty(o3:cParentWnd, 'oBrw3', 'Cargo', nNew) SetProperty(o3:cParentWnd, 'MyTimer', 'Enabled', .T.) EndIf endif RETURN NIL [/pre2] Когда двигаюсь по бровсу o3 (главный) , то в правом o4 ни чего не меняется , так и надо. Но вот когда остановился , правый бровс начинает все время обновляться и моргать. Что не так сделал ? Где то нужно остановить таймер , не пойму где..
SergKis: Dima пишет Где то нужно остановить таймер , не пойму где.. Timer останавливать не надо, должно срабатывать nNew == nOld и выход из DoTimer надо проверить, что там
Dima: Мой косяк , баловался сам с таймером и забыл убрать свой. В общем , после того как я перестал двигаться по бровсу , правый бровс не обновился почему то
Dima: SergKis пишет: Timer останавливать не надо, должно срабатывать nNew == nOld и выход из DoTimer Понял , сделал так [pre2] FUNC DoTimer( o3,o4 ) LOCAL nNew := GetProperty(o3:cParentWnd, 'Buf' , 'Cargo') LOCAL nOld := GetProperty(o3:cParentWnd, 'oBrw3', 'Cargo') If o3:loBrw3Ready If empty(nNew) RETURN NIL EndIf If nNew != nOld //SetProperty(o3:cParentWnd, 'MyTimer', 'Enabled', .F.) Myfilter(o3,o4) // тут перепоказ правого тсб // ставим scope\filter и .... SetProperty(o3:cParentWnd, 'oBrw3', 'Cargo', nNew) // SetProperty(o3:cParentWnd, 'MyTimer', 'Enabled', .t.) EndIf endif RETURN NIL [/pre2] Но правый бровс не обновляется после как я перестал двигаться по левому
SergKis: Dima пишет Но правый бровс не обновляется после как я перестал двигаться по левому так и задумано, работай теперь с правым (по правым кнопкам) сместишь левый - получишь новый правый и т.д. разве не так надо было ?
Dima: я кажется понял в чем дело Поставил заглушку на Bchange )) Переделал на oBrw3:bChange := {|| SetProperty(obrw3:cParentWnd, 'Buf', 'Cargo', (obrw3:cAlias)->( RecNo() ))}
SergKis: PS Если не двигаемся, но через время надо перечитать с сервера, надо стелать чсетчик сек. и обновлять nOld := 0 :[pre2] FUNC DoTimer( o3,o4 ) LOCAL nNew := GetProperty(o3:cParentWnd, 'Buf' , 'Cargo') LOCAL nOld := GetProperty(o3:cParentWnd, 'oBrw3', 'Cargo') STATIC nRefr := 0 ... nRefr += 1 If nRefr > 5 nOld := 0 EndIf If nNew != nOld ... [/pre2]
Dima: Вообще была идея выключать Таймер в Bchange , вот только не понятно когда его включить , если этого не сделать и двигаться зажав кнопку вниз , правый бровс все равно будет обновляться НО с интервалом уставленным в таймере
SergKis: Dima пишет правый бровс все равно будет обновляться НО с интервалом уставленным в таймере По мне, это приемлемо - видно что все работает (главное правый тсб автономно сам ставит что надо) Реакция отображения правого тсб 1-2 сек. - это нормально
Dima: SergKis пишет: Реакция отображения правого тсб 1-2 сек. - это нормально Мне показалось это время не приемлемо большим и поставил 200 мс
SergKis: Dima пишет Мне показалось это время не приемлемо большим и поставил 200 мс Думаю, ты очень горячися и подгоняешь клиента к убыстренной работе, ему некогда подумать, попить чаю\кофе ...
Dima: Когда таймер жил прямо в бровсе , понятно что были с этим проблемы , но по крайней мере при движении по главному бровсу , подчиненный молчал как партизан. Остановил движение и правый обновился.
SergKis: Dima пишет подчиненный молчал как партизан. Остановил движение и правый обновился. Так тут тоже можно сделать такое, отображать не при nNew != nOld, а при nNew == nOld по счетчику входов, типа 3 раза вошли по тимер и nNew == nOld отображаем, надо немного усложнить тимер, мне всегда было лениво
Dima: SergKis Понял. Спасибо !
Haz: Дима, глянул твои исходники внимательно и почитал все что написали. Сорь раньше не мог. Есть пару мыслей.... Во первых таймер не убивается каждые 50 мс а лишь тогда когда юзер оторвет палец от колеса. Проблема с утечкой памяти... Возможно и есть , но у себя не наблюдаю глюков. А главная проблема мне кажется в исходнике - процедура myfilter не успевает выполниться за 50 мс и не происходит выравнивания номера записи и логикпос., это приводит к следующему тику таймера ит д.. Уверен если задержку сделать 200 и перенести майфильтр в конец ( перед return) то основная причина глюка уйдет. Что касается утечки, то можно на каждую 10 прорисовку второго бровса повесить сборщик мусора. Сори за мой французский, пишу с мобилы. У себя оставлю пока так. Позже переделаю на флаги, таймер инициализировать буду по инит бровса, а убивать при закрытии бровсе. Тогда и утечек не будет.
Dima: Haz пишет: Сори за мой французский, пишу с мобилы. Игорь все нормально , кажется проблема решена. Пошел по пути как посоветовал Сергей. Отдал клиенту , если что то он будет стучать в рельсу. Я сам долго ездил после доработки по бровсу , проблем не увидел. Haz пишет: Проблема с утечкой памяти... Может и так , но мне этот гимор надоел. Нужно было просто сделать рабочий вариант что бы ни чего не глючило. Вроде получилось.
SergKis: Делал для Andrey примеры, может кому сгодится (на одну тему, но по разному сделаны) http://my-files.ru/1quo1w http://my-files.ru/ct7m3d
SergKis: PS копипастил и забыл исправить в примере из Tsb_form_1.7z функция MyButton на всех кнопках надо заменить[pre2] ACTION ( MsgBox(This.Name+CRLF+This.BaseName.Value, cForm), ; TBrw_Obj(cBrw, cForm):SetFocus() ) ; [/pre2]
gfilatov2002: Задачка для знатоков TSBrowse Получил такой вопрос (в заголовке поста) на бразильском форуме. Текст примера см. ниже [pre2]REQUEST DBFCDX #include "minigui.ch" #include "tsbrowse.ch" #Include "fileio.ch" #Include "directry.ch" #include "miniprint.ch" #include "winprint.ch" #define KON_LIN chr( 13 ) + chr( 10 ) #define CC_FULLOPEN 2 #define CC_PREVENTFULLOPEN 4 #define CC_RGBINIT 1 #define CC_SHOWHELP 8 #define CC_SOLIDCOLOR 128 #define CC_ANYCOLOR 256 // 0x00000100 #define AZUL { 0 , 128 , 192 } #define CELESTE { 0 , 128 , 255 } #define VERDE { 0 , 128 , 128 } #define CAFE { 128 , 64 , 0 } #define nRGB( nR, nG, nB ) ( nR + ( nG * 256 ) + ( nB * 256 * 256 ) ) #define CLR_CHBLUE { 0, 128, 255 } && Azul claro #define CLR_CHGREEN { 0, 175, 85 } && Verde #define CLR_CHRED { 128, 0, 0 } && cores puras #define CLR_CHBLACK { 255, 255, 255 } && cores puras #define CLR_HRED nRGB( 128, 0, 0 ) && cores puras #define CLR_BLACK nRGB( 0, 0, 0 ) && cores puras #define CLR_CHCYAN { 0, 128, 128 } #define CLR_CHHBLUE { 100, 175, 255 } && Azul bem claro #define CLR_CHHYELLOW nRGB( 255, 255, 95 ) && Amarelo bem claro #define CLR_CHHGREEN nRGB( 200, 255, 200 ) && Verde bem claro #define CLR_HGRAY { 128, 128, 128 } && Cinza mais escuro #define CLR_TGRAY nRGB( 200, 200, 200 ) && Cinza claro #define CLR_NBLUE nRGB( 185, 220, 255 ) && Azul medio #define CLR_CBLUE nRGB( 30, 170, 220 ) && Azul medio #define CLR_BGRAY nRGB( 100, 100, 100 ) && cinza claro da tela #define VERDECL { 0, 255, 0 } #define DGRAY { 169, 169, 169 } && Cinza escuro #define GBLUE { 80, 180, 235 } #define ZBLUE { 46, 126, 159 } #define DBLUE { 3, 45, 73 } #define NBLUE { 185, 220, 255 } #define FGRAY { 168, 168, 168 } && Cinza medio mais escuro #define HGRAY { 188, 188, 188 } && Cinza medio claro #define TGRAY { 200, 200, 200 } && Cinza claro #define CLR_BACKGET { { 255, 255, 255 }, { 233, 233, 233 }, { 0, 220, 255 } } && branco, amarelo claro, azul claro #define CLR_BACKGET1 { { 255, 255, 190 }, { 255, 255, 200 }, { 200, 255, 255 } } && amarelo claro, amarelo claro, azul claro #define CLR_BACKGET2 { { 100, 175, 255 }, { 255, 255, 200 }, { 200, 255, 255 } } && azul medio, amarelo claro, azul claro #define CLR_PINK nRGB( 255, 128, 128) #define CLR_NCBLUE nRGB( 128, 128, 192) #define CLR_NBROWN nRGB( 130, 99, 53) #define CLR_1 nRGB( 190, 215, 190 ) #define CLR_2 nRGB( 230, 230, 230 ) #define CLR_3 nRGB( 217, 217, 255 ) #define CLR_VERDE { 0, 128, 128 } #define pRED 0x3300CC #define pGREEN 0x339966 #define pBLUE 0xCC0000 #define pGRAY 0xCCCCCC Function Main() Local NomArq1 := {} Local NomArq2 := {} Local NomArq3 := {} AAdd( NomArq1, { 'CODIGO', 'C', 2, 0 } ) AAdd( NomArq1, { 'DESCRI', 'C', 50, 0 } ) If !File( 'File1.DBF' ) DBCreate( 'File1.DBF', NomArq1, 'DBFCDX' ) EndIf Use File1 Alias File1 Via 'DBFCDX' Index On Codigo Tag F01 To File1.Cdx Index On Descri Tag F02 To File1.Cdx J := 0 For i = 1 To 12 File1->( DBAppend() ) File1->Codigo := StrZero( j, 2 ) File1->Descri := 'Product Name ' + StrZero( j, 2 ) j += 5 Next AAdd( NomArq2, { 'CODIGO', 'C', 4, 0 } ) AAdd( NomArq2, { 'DESCRI', 'C', 50, 0 } ) If !File( 'File2.DBF' ) DBCreate( 'File2.DBF', NomArq2, 'DBFCDX' ) EndIf Use File2 Alias File2 Via 'DBFCDX' New Index On Codigo Tag F01 To File2.Cdx Index On Descri Tag F02 To File2.Cdx J := 0 For i = 1 To 30 File2->( DBAppend() ) File2->Codigo := StrZero( j, 4 ) File2->Descri := 'Product Name ' + StrZero( j, 4 ) j += 500 Next AAdd( NomArq3, { 'CODIGO', 'C', 3, 0 } ) AAdd( NomArq3, { 'DESCRI', 'C', 50, 0 } ) If !File( 'File3.DBF' ) DBCreate( 'File3.DBF', NomArq3, 'DBFCDX' ) EndIf Use File3 Alias File3 Via 'DBFCDX' New Index On Codigo Tag F01 To File3.Cdx Index On Descri Tag F02 To File3.Cdx J := 0 For i = 1 To 24 File3->( DBAppend() ) File3->Codigo := StrZero( j, 3 ) File3->Descri := 'Product Name ' + StrZero( j, 3 ) j += 10 Next If !File( 'File4.DBF' ) DBCreate( 'File4.DBF', NomArq1, 'DBFCDX' ) EndIf Use File4 Alias File4 Via 'DBFCDX' New Index On Codigo Tag F01 To File4.Cdx Index On Descri Tag F02 To File4.Cdx J := 0 For i = 1 To 12 File4->( DBAppend() ) File4->Codigo := StrZero( j, 2 ) File4->Descri := 'Product Name ' + StrZero( j, 2 ) j += 5 Next cClassif := '10050002010' If !( IsWindowDefined( oAuxDSMG ) ) Define Window oAuxDSMG AT 0,0 Width 870 Height 519 Main NoCaption NoSysMenu NoSize On Init { || oAuxDSMGPosi() } On InteractiveClose { || oAuxDSMGCanc() } On Key ESCAPE Of oAuxDSMG Action { || oAuxDSMGCanc() } @ 0, 0 Label 1 Value '' Width 870 Height 110 BackColor BLUE @ 12, 10 Label Lb_xaa Value 'File1-File2-File3-File4' Width 600 Height 36 Font 'ARIAL' Size 24 Bold FontColor WHITE Transparent @ 14, 12 Label Lb_xab Value 'File1-File2-File3-File4' Width 600 Height 36 Font 'ARIAL' Size 24 Bold FontColor BLACK Transparent @ 13, 11 Label Lb_xac Value 'File1-File2-File3-File4' Width 600 Height 36 Font 'ARIAL' Size 24 Bold FontColor GBLUE Transparent //File1 Select("File1") @ 72, 10 Label Lb_cdv Value SubStr( cClassif, 1, 2 ) Width 30 Height 20 Font 'ARIAL' Size 10 Bold FontColor RED BackColor BLACK ClientEdge @ 72, 42 Label Lb_tdv Value 'File1' Width 178 Height 20 Font 'ARIAL' Size 10 Bold FontColor BLACK BackColor WHITE ClientEdge CenterAlign @ 94, 10 Label Lb_ddv Value File1->Descri Width 210 Height 20 Font 'ARIAL' Size 10 Bold FontColor RED BackColor BLACK ClientEdge @ 116, 10 TBrowse oBrw_Div Of oAuxDSMG Width 210 Height 346 Alias 'File1' CELLED On Change ChangeTD() Add Column To oBrw_Div Header 'Cod.' Data FieldWBlock( 'Codigo', Select() ) Picture '99' 3DLOOK FALSE,TRUE Size 40 Align DT_LEFT Add Column To oBrw_Div Header 'Descricao' Data FieldWBlock( 'Descri', Select() ) Picture '@!' 3DLOOK FALSE,TRUE Size 170 Align DT_LEFT oBrw_Div:Set3DText( .T., .F., Nil, 2, CLR_WHITE, CLR_CBLUE ) oBrw_Div:SetColor( { 1, 3, 5, 6, 13, 15 }, ; { CLR_BLACK, CLR_BLUE, CLR_WHITE, ; { CLR_BLUE, CLR_HBLUE }, ; // degraded cursor background color CLR_WHITE, CLR_BLACK } ) // text colors oBrw_Div:SetColor( { 2, 4, 14 }, ; { { || IIf( oBrw_Div:nLogicPos() % 2 == 0, { CLR_TGRAY, CLR_WHITE }, { CLR_CHHGREEN, CLR_WHITE } ) }, ; { CLR_CBLUE, CLR_NBLUE }, ; // degraded Headers backgroud color { CLR_HRED, CLR_BLACK } } ) // degraded order column background color oBrw_Div:nHeightCell += 8 oBrw_Div:nHeightHead += 11 oBrw_Div:nLineStyle := LINES_VERT oBrw_Div:SetAppendMode( .F. ) oBrw_Div:lNoHScroll := .T. //Secao Select("File2") @ 72, 223 Label Lb_csc Value SubStr( cClassif, 3, 4 ) Width 50 Height 20 Font 'ARIAL' Size 10 Bold FontColor RED BackColor BLACK ClientEdge @ 72, 275 Label Lb_tsc Value 'File2' Width 158 Height 20 Font 'ARIAL' Size 10 Bold FontColor BLACK BackColor WHITE ClientEdge CenterAlign @ 94, 223 Label Lb_dsc Value File2->Descri Width 210 Height 20 Font 'ARIAL' Size 10 Bold FontColor RED BackColor BLACK ClientEdge @ 116, 223 TBrowse oBrw_Sec Of oAuxDSMG Width 210 Height 346 Alias 'File2' CELLED On Change ChangeTS() Add Column To oBrw_Sec Header 'Cod.' Data FieldWBlock( 'Codigo', Select() ) Picture '9999' 3DLOOK FALSE,TRUE Size 40 Align DT_LEFT Add Column To oBrw_Sec Header 'Descricao' Data FieldWBlock( 'Descri', Select() ) Picture '@!' 3DLOOK FALSE,TRUE Size 170 Align DT_LEFT oBrw_Sec:Set3DText( .T., .F., Nil, 2, CLR_WHITE, CLR_CBLUE ) oBrw_Sec:SetColor( { 1, 3, 5, 6, 13, 15 }, ; { CLR_BLACK, CLR_BLUE, CLR_WHITE, ; { CLR_BLUE, CLR_HBLUE }, ; // degraded cursor background color CLR_WHITE, CLR_BLACK } ) // text colors oBrw_Sec:SetColor( { 2, 4, 14 }, ; { { || IIf( oBrw_Sec:nLogicPos() % 2 == 0, { CLR_TGRAY, CLR_WHITE }, { CLR_CHHGREEN, CLR_WHITE } ) }, ; { CLR_CBLUE, CLR_NBLUE }, ; // degraded Headers backgroud color { CLR_HRED, CLR_BLACK } } ) // degraded order column background color oBrw_Sec:nHeightCell += 8 oBrw_Sec:nHeightHead += 11 oBrw_Sec:nLineStyle := LINES_VERT oBrw_Sec:SetAppendMode( .F. ) oBrw_Sec:lNoHScroll := .T. //File3 Select("File3") @ 72, 436 Label Lb_cma Value SubStr( cClassif, 7, 3 ) Width 40 Height 20 Font 'ARIAL' Size 10 Bold FontColor RED BackColor BLACK ClientEdge @ 72, 478 Label Lb_tma Value 'File3' Width 168 Height 20 Font 'ARIAL' Size 10 Bold FontColor BLACK BackColor WHITE ClientEdge CenterAlign @ 94, 436 Label Lb_dma Value File3->Descri Width 210 Height 20 Font 'ARIAL' Size 10 Bold FontColor RED BackColor BLACK ClientEdge @ 116, 436 TBrowse oBrw_Mar Of oAuxDSMG Width 210 Height 346 Alias 'File3' CELLED On Change ChangeTM() Add Column To oBrw_Mar Header 'Cod.' Data FieldWBlock( 'Codigo', Select() ) Picture '999' 3DLOOK FALSE,TRUE Size 40 Align DT_LEFT Add Column To oBrw_Mar Header 'Descricao' Data FieldWBlock( 'Descri', Select() ) Picture '@!' 3DLOOK FALSE,TRUE Size 170 Align DT_LEFT oBrw_Mar:Set3DText( .T., .F., Nil, 2, CLR_WHITE, CLR_CBLUE ) oBrw_Mar:SetColor( { 1, 3, 5, 6, 13, 15 }, ; { CLR_BLACK, CLR_BLUE, CLR_WHITE, ; { CLR_BLUE, CLR_HBLUE }, ; // degraded cursor background color CLR_WHITE, CLR_BLACK } ) // text colors oBrw_Mar:SetColor( { 2, 4, 14 }, ; { { || IIf( oBrw_Mar:nLogicPos() % 2 == 0, { CLR_TGRAY, CLR_WHITE }, { CLR_CHHGREEN, CLR_WHITE } ) }, ; { CLR_CBLUE, CLR_NBLUE }, ; // degraded Headers backgroud color { CLR_HRED, CLR_BLACK } } ) // degraded order column background color oBrw_Mar:nHeightCell += 8 oBrw_Mar:nHeightHead += 11 oBrw_Mar:nLineStyle := LINES_VERT oBrw_Mar:SetAppendMode( .F. ) oBrw_Mar:lNoHScroll := .T. //File4 Select("File4") @ 72, 649 Label Lb_cgr Value SubStr( cClassif, 10, 2 ) Width 30 Height 20 Font 'ARIAL' Size 10 Bold FontColor RED BackColor BLACK ClientEdge @ 72, 681 Label Lb_tgr Value 'File4' Width 178 Height 20 Font 'ARIAL' Size 10 Bold FontColor BLACK BackColor WHITE ClientEdge CenterAlign @ 94, 649 Label Lb_dgr Value File4->Descri Width 210 Height 20 Font 'ARIAL' Size 10 Bold FontColor RED BackColor BLACK ClientEdge @ 116, 649 TBrowse oBrw_Gru Of oAuxDSMG Width 210 Height 346 Alias 'File4' CELLED On Change ChangeTG() Add Column To oBrw_Gru Header 'Cod.' Data FieldWBlock( 'Codigo', Select() ) Picture '99' 3DLOOK FALSE,TRUE Size 40 Align DT_LEFT Add Column To oBrw_Gru Header 'Descricao' Data FieldWBlock( 'Descri', Select() ) Picture '@!' 3DLOOK FALSE,TRUE Size 170 Align DT_LEFT oBrw_Gru:Set3DText( .T., .F., Nil, 2, CLR_WHITE, CLR_CBLUE ) oBrw_Gru:SetColor( { 1, 3, 5, 6, 13, 15 }, ; { CLR_BLACK, CLR_BLUE, CLR_WHITE, ; { CLR_BLUE, CLR_HBLUE }, ; // degraded cursor background color CLR_WHITE, CLR_BLACK } ) // text colors oBrw_Gru:SetColor( { 2, 4, 14 }, ; { { || IIf( oBrw_Gru:nLogicPos() % 2 == 0, { CLR_TGRAY, CLR_WHITE }, { CLR_CHHGREEN, CLR_WHITE } ) }, ; { CLR_CBLUE, CLR_NBLUE }, ; // degraded Headers backgroud color { CLR_HRED, CLR_BLACK } } ) // degraded order column background color oBrw_Gru:nHeightCell += 8 oBrw_Gru:nHeightHead += 11 oBrw_Gru:nLineStyle := LINES_VERT oBrw_Gru:SetAppendMode( .F. ) oBrw_Gru:lNoHScroll := .T. @ 480, 10 Label Lb_xxx Value '' Width 210 Height 32 Font 'ARIAL' Size 22 Bold FontColor RED BackColor WHITE CenterAlign @ 480, 760 ButtonEx IBTCancelar Caption '&Cancelar' Width 100 Height 32 Font 'ARIAL' Size 7 Bold FontColor GBLUE ToolTip 'Fecha janela, retorna ao navegador' Action { || oAuxDSMGCanc() } //On GotFocus Exibe( 'Click To Close Window' ) End Window Center Window oAuxDSMG Activate Window oAuxDSMG Else oAuxDSMG.SetFocus EndIf Return( .T. ) * -------------------------> Rotina para gravar dados <----------------------- * Function oAuxDSMGPosi() cClassif := oAuxDSMG.Lb_xxx.Value If cClassif <> Space( 11 ) File1->( DBSetOrder( 1 ) ) File1->( DBSeek( SubStr( cClassif, 1, 2 ) ) ) File1->( DBSetOrder( 2 ) ) oAuxDSMG.oBrw_Div.Value := File1->( RecNo() ) oBrw_Div:SetFocus() oBrw_Div:DrawSelect() oBrw_Div:Refresh( .T. ) For i = 1 To 13 oBrw_Div:RefreshARow( i ) Next File2->( DBSetOrder( 1 ) ) File2->( DBSeek( SubStr( cClassif, 3, 4 ) ) ) File2->( DBSetOrder( 2 ) ) oAuxDSMG.oBrw_Sec.Value := File2->( RecNo() ) oBrw_Sec:SetFocus() oBrw_Sec:DrawSelect() oBrw_Sec:Refresh( .T. ) For i = 1 To 13 oBrw_Sec:RefreshARow( i ) Next File3->( DBSetOrder( 1 ) ) File3->( DBSeek( SubStr( cClassif, 7, 3 ) ) ) xRec := File3->( RecNo() ) File3->( DBSetOrder( 2 ) ) oAuxDSMG.oBrw_Mar.Value := File3->( RecNo() ) oBrw_Mar:SetFocus() oBrw_Mar:DrawSelect() oBrw_Mar:Refresh( .T. ) For i = 1 To 13 oBrw_Mar:RefreshARow( i ) Next File4->( DBSetOrder( 1 ) ) File4->( DBSeek( SubStr( cClassif, 10, 2 ) ) ) File4->( DBSetOrder( 2 ) ) oAuxDSMG.oBrw_Gru.Value := File4->( RecNo() ) oBrw_Gru:SetFocus() oBrw_Gru:DrawSelect() oBrw_Gru:Refresh( .T. ) For i = 1 To 13 oBrw_Gru:RefreshARow( i ) Next EndIf oBrw_Div:SetFocus() oAuxDSMG.Lb_cdv.Value := File1->Codigo oAuxDSMG.Lb_csc.Value := File2->Codigo oAuxDSMG.Lb_cma.Value := File3->Codigo oAuxDSMG.Lb_cgr.Value := File4->Codigo oAuxDSMG.Lb_ddv.Value := File1->Descri oAuxDSMG.Lb_dsc.Value := File2->Descri oAuxDSMG.Lb_dma.Value := File3->Descri oAuxDSMG.Lb_dgr.Value := File4->Descri oAuxDSMG.Lb_xxx.Value := oAuxDSMG.Lb_cdv.Value + oAuxDSMG.Lb_csc.Value + oAuxDSMG.Lb_cma.Value + oAuxDSMG.Lb_cgr.Value Return( .T. ) * ------------------------> Rotina para atualizar dados <--------------------- * Function ChangeTD() Local xClassif := oAuxDSMG.Lb_xxx.Value oAuxDSMG.Lb_cdv.Value := File1->Codigo oAuxDSMG.Lb_ddv.Value := File1->Descri oAuxDSMG.Lb_xxx.Value := oAuxDSMG.Lb_cdv.Value + SubStr( xClassif, 3, 8 ) Return( .T. ) * ------------------------> Rotina para atualizar dados <--------------------- * Function ChangeTS() Local xClassif := oAuxDSMG.Lb_xxx.Value oAuxDSMG.Lb_csc.Value := File2->Codigo oAuxDSMG.Lb_dsc.Value := File2->Descri oAuxDSMG.Lb_xxx.Value := SubStr( xClassif, 1, 2 ) + oAuxDSMG.Lb_csc.Value + SubStr( xClassif, 7, 5 ) Return( .T. ) * ------------------------> Rotina para atualizar dados <--------------------- * Function ChangeTM() Local xClassif := oAuxDSMG.Lb_xxx.Value oAuxDSMG.Lb_cma.Value := File3->Codigo oAuxDSMG.Lb_dma.Value := File3->Descri oAuxDSMG.Lb_xxx.Value := SubStr( xClassif, 1, 6 ) + oAuxDSMG.Lb_cma.Value + SubStr( xClassif, 10, 2 ) Return( .T. ) * ------------------------> Rotina para atualizar dados <--------------------- * Function ChangeTG() Local xClassif := oAuxDSMG.Lb_xxx.Value oAuxDSMG.Lb_cgr.Value := File4->Codigo oAuxDSMG.Lb_dgr.Value := File4->Descri oAuxDSMG.Lb_xxx.Value := SubStr( xClassif, 1, 9 ) + oAuxDSMG.Lb_cgr.Value Return( .T. ) * ----------------------> Rotina para fechar janela ativa <------------------- * Function oAuxDSMGCanc() If IsWindowDefined( oAuxDSMG ) Release Window oAuxDSMG EndIf Return( .T. )[/pre2]
SergKis: gfilatov2002 пишет Получил такой вопрос ... Почему не работает поиск? [pre2] 1. J := 0 For i = 1 To 30 File2->( DBAppend() ) File2->Codigo := StrZero( j, 4 ) File2->Descri := 'Product Name ' + StrZero( j, 4 ) j += 500 // будет переполнение StrZero( j, 4 ), т.е. **** Next 2. Function oAuxDSMGPosi() cClassif := oAuxDSMG.Lb_xxx.Value _LogFile(.T., cClassif) // ==> 00000000000 If cClassif <> Space( 11 ) // это не сработает, т.к. len(cClassif) == 11 тут 3. Так работает Function Main() Local NomArq1 := {} Local NomArq2 := {} Local NomArq3 := {} PRIV cClassif, oBrw_Div, oBrw_Sec, oBrw_Mar, oBrw_Gru SET SOFTSEEK ON RDDSETDEFAULT('DBFCDX') FErase('File1.DBF') FErase('File1.CDX') FErase('File2.DBF') FErase('File2.CDX') FErase('File3.DBF') FErase('File3.CDX') FErase('File4.DBF') FErase('File4.CDX') ... Function oAuxDSMGPosi() Local nRec // cClassif := oAuxDSMG.Lb_xxx.Value // If cClassif <> Space( 11 ) File1->( DBSetOrder( 1 ) ) File1->( DBSeek( SubStr( cClassif, 1, 2 ) ) ) nRec := File1->( RecNo() ) File1->( DBSetOrder( 2 ) ) oBrw_Div:SetFocus() oBrw_Div:Reset() // если коменировать эти строки, то oBrw_Div:GotoRec(nRec) // раскоментировать которые ниже (вроде и так и так работает) // oAuxDSMG.oBrw_Div.Value := nRec // oBrw_Div:SetFocus() // oBrw_Div:DrawSelect() // oBrw_Div:Refresh( .T. ) // For i = 1 To 13 // oBrw_Div:RefreshARow( i ) // Next ... // EndIf дальше не анализировал. [/pre2]
gfilatov2002: SergKis пишет: дальше не анализировал Благодарю за проведенный анализ
nick_mi: Функции ChangeXX срабатывают раньше чем oAuxDSMGPosi соответственно oAuxDSMG.Lb_xxx.Value уже обновилось значениями с текущей позиции в DBF, т.е. нулями, затем выполняется поиск в oAuxDSMGPosi
gfilatov2002: nick_mi пишет: Функции ChangeXX срабатывают раньше чем oAuxDSMGPosi Благодарю за Ваше пояснение Но теперь другая (и основная) проблема - не обновляется при старте File2 TBROWSE Полный код исправленного примера см. ниже [pre2]REQUEST DBFCDX #include "minigui.ch" #include "tsbrowse.ch" #Include "fileio.ch" #Include "directry.ch" #include "miniprint.ch" #include "winprint.ch" #define KON_LIN chr( 13 ) + chr( 10 ) #define CC_FULLOPEN 2 #define CC_PREVENTFULLOPEN 4 #define CC_RGBINIT 1 #define CC_SHOWHELP 8 #define CC_SOLIDCOLOR 128 #define CC_ANYCOLOR 256 // 0x00000100 #define AZUL { 0 , 128 , 192 } #define CELESTE { 0 , 128 , 255 } #define VERDE { 0 , 128 , 128 } #define CAFE { 128 , 64 , 0 } #define nRGB( nR, nG, nB ) ( nR + ( nG * 256 ) + ( nB * 256 * 256 ) ) #define CLR_CHBLUE { 0, 128, 255 } && Azul claro #define CLR_CHGREEN { 0, 175, 85 } && Verde #define CLR_CHRED { 128, 0, 0 } && cores puras #define CLR_CHBLACK { 255, 255, 255 } && cores puras #define CLR_HRED nRGB( 128, 0, 0 ) && cores puras #define CLR_BLACK nRGB( 0, 0, 0 ) && cores puras #define CLR_CHCYAN { 0, 128, 128 } #define CLR_CHHBLUE { 100, 175, 255 } && Azul bem claro #define CLR_CHHYELLOW nRGB( 255, 255, 95 ) && Amarelo bem claro #define CLR_CHHGREEN nRGB( 200, 255, 200 ) && Verde bem claro #define CLR_HGRAY { 128, 128, 128 } && Cinza mais escuro #define CLR_TGRAY nRGB( 200, 200, 200 ) && Cinza claro #define CLR_NBLUE nRGB( 185, 220, 255 ) && Azul medio #define CLR_CBLUE nRGB( 30, 170, 220 ) && Azul medio #define CLR_BGRAY nRGB( 100, 100, 100 ) && cinza claro da tela #define VERDECL { 0, 255, 0 } #define DGRAY { 169, 169, 169 } && Cinza escuro #define GBLUE { 80, 180, 235 } #define ZBLUE { 46, 126, 159 } #define DBLUE { 3, 45, 73 } #define NBLUE { 185, 220, 255 } #define FGRAY { 168, 168, 168 } && Cinza medio mais escuro #define HGRAY { 188, 188, 188 } && Cinza medio claro #define TGRAY { 200, 200, 200 } && Cinza claro #define CLR_BACKGET { { 255, 255, 255 }, { 233, 233, 233 }, { 0, 220, 255 } } && branco, amarelo claro, azul claro #define CLR_BACKGET1 { { 255, 255, 190 }, { 255, 255, 200 }, { 200, 255, 255 } } && amarelo claro, amarelo claro, azul claro #define CLR_BACKGET2 { { 100, 175, 255 }, { 255, 255, 200 }, { 200, 255, 255 } } && azul medio, amarelo claro, azul claro #define CLR_PINK nRGB( 255, 128, 128) #define CLR_NCBLUE nRGB( 128, 128, 192) #define CLR_NBROWN nRGB( 130, 99, 53) #define CLR_1 nRGB( 190, 215, 190 ) #define CLR_2 nRGB( 230, 230, 230 ) #define CLR_3 nRGB( 217, 217, 255 ) #define CLR_VERDE { 0, 128, 128 } #define pRED 0x3300CC #define pGREEN 0x339966 #define pBLUE 0xCC0000 #define pGRAY 0xCCCCCC Function Main() Local NomArq1 := {} Local NomArq2 := {} Local NomArq3 := {} PRIV cClassif, oBrw_Div, oBrw_Sec, oBrw_Mar, oBrw_Gru SET SOFTSEEK ON RDDSETDEFAULT('DBFCDX') FErase('File1.DBF') FErase('File1.CDX') FErase('File2.DBF') FErase('File2.CDX') FErase('File3.DBF') FErase('File3.CDX') FErase('File4.DBF') FErase('File4.CDX') AAdd( NomArq1, { 'CODIGO', 'C', 2, 0 } ) AAdd( NomArq1, { 'DESCRI', 'C', 50, 0 } ) If !File( 'File1.DBF' ) DBCreate( 'File1.DBF', NomArq1, 'DBFCDX' ) EndIf Use File1 Alias File1 Via 'DBFCDX' Index On Codigo Tag F01 To File1.Cdx Index On Descri Tag F02 To File1.Cdx J := 0 For i = 1 To 12 File1->( DBAppend() ) File1->Codigo := StrZero( j, 2 ) File1->Descri := 'Product Name ' + StrZero( j, 2 ) j += 5 Next AAdd( NomArq2, { 'CODIGO', 'C', 4, 0 } ) AAdd( NomArq2, { 'DESCRI', 'C', 50, 0 } ) If !File( 'File2.DBF' ) DBCreate( 'File2.DBF', NomArq2, 'DBFCDX' ) EndIf Use File2 Alias File2 Via 'DBFCDX' New Index On Codigo Tag F01 To File2.Cdx Index On Descri Tag F02 To File2.Cdx J := 0 For i = 1 To 30 File2->( DBAppend() ) File2->Codigo := StrZero( j, 4 ) File2->Descri := 'Product Name ' + StrZero( j, 4 ) j += 500 Next AAdd( NomArq3, { 'CODIGO', 'C', 3, 0 } ) AAdd( NomArq3, { 'DESCRI', 'C', 50, 0 } ) If !File( 'File3.DBF' ) DBCreate( 'File3.DBF', NomArq3, 'DBFCDX' ) EndIf Use File3 Alias File3 Via 'DBFCDX' New Index On Codigo Tag F01 To File3.Cdx Index On Descri Tag F02 To File3.Cdx J := 0 For i = 1 To 24 File3->( DBAppend() ) File3->Codigo := StrZero( j, 3 ) File3->Descri := 'Product Name ' + StrZero( j, 3 ) j += 10 Next If !File( 'File4.DBF' ) DBCreate( 'File4.DBF', NomArq1, 'DBFCDX' ) EndIf Use File4 Alias File4 Via 'DBFCDX' New Index On Codigo Tag F01 To File4.Cdx Index On Descri Tag F02 To File4.Cdx J := 0 For i = 1 To 12 File4->( DBAppend() ) File4->Codigo := StrZero( j, 2 ) File4->Descri := 'Product Name ' + StrZero( j, 2 ) j += 5 Next cClassif := '40950020055' If !( IsWindowDefined( oAuxDSMG ) ) Define Window oAuxDSMG AT 0,0 Width 870 Height 519 Main NoCaption NoSysMenu NoSize On Init { || oAuxDSMGPosi() } On InteractiveClose { || oAuxDSMGCanc() } On Key ESCAPE Of oAuxDSMG Action { || oAuxDSMGCanc() } @ 0, 0 Label 1 Value '' Width 870 Height 110 BackColor BLUE @ 12, 10 Label Lb_xaa Value 'File1-File2-File3-File4' Width 600 Height 36 Font 'ARIAL' Size 24 Bold FontColor WHITE Transparent @ 14, 12 Label Lb_xab Value 'File1-File2-File3-File4' Width 600 Height 36 Font 'ARIAL' Size 24 Bold FontColor BLACK Transparent @ 13, 11 Label Lb_xac Value 'File1-File2-File3-File4' Width 600 Height 36 Font 'ARIAL' Size 24 Bold FontColor GBLUE Transparent //File1 Select("File1") @ 72, 10 Label Lb_cdv Value SubStr( cClassif, 1, 2 ) Width 30 Height 20 Font 'ARIAL' Size 10 Bold FontColor RED BackColor BLACK ClientEdge @ 72, 42 Label Lb_tdv Value 'File1' Width 178 Height 20 Font 'ARIAL' Size 10 Bold FontColor BLACK BackColor WHITE ClientEdge CenterAlign @ 94, 10 Label Lb_ddv Value File1->Descri Width 210 Height 20 Font 'ARIAL' Size 10 Bold FontColor RED BackColor BLACK ClientEdge @ 116, 10 TBrowse oBrw_Div Of oAuxDSMG Width 210 Height 346 Alias 'File1' CELLED On Change ChangeTD() Add Column To oBrw_Div Header 'Cod.' Data FieldWBlock( 'Codigo', Select() ) Picture '99' 3DLOOK FALSE,TRUE Size 40 Align DT_LEFT Add Column To oBrw_Div Header 'Descricao' Data FieldWBlock( 'Descri', Select() ) Picture '@!' 3DLOOK FALSE,TRUE Size 170 Align DT_LEFT oBrw_Div:Set3DText( .T., .F., Nil, 2, CLR_WHITE, CLR_CBLUE ) oBrw_Div:SetColor( { 1, 3, 5, 6, 13, 15 }, ; { CLR_BLACK, CLR_BLUE, CLR_WHITE, ; { CLR_BLUE, CLR_HBLUE }, ; // degraded cursor background color CLR_WHITE, CLR_BLACK } ) // text colors oBrw_Div:SetColor( { 2, 4, 14 }, ; { { || IIf( oBrw_Div:nLogicPos() % 2 == 0, { CLR_TGRAY, CLR_WHITE }, { CLR_CHHGREEN, CLR_WHITE } ) }, ; { CLR_CBLUE, CLR_NBLUE }, ; // degraded Headers backgroud color { CLR_HRED, CLR_BLACK } } ) // degraded order column background color oBrw_Div:nHeightCell += 8 oBrw_Div:nHeightHead += 11 oBrw_Div:nLineStyle := LINES_VERT oBrw_Div:SetAppendMode( .F. ) oBrw_Div:lNoHScroll := .T. //Secao Select("File2") @ 72, 223 Label Lb_csc Value SubStr( cClassif, 3, 4 ) Width 50 Height 20 Font 'ARIAL' Size 10 Bold FontColor RED BackColor BLACK ClientEdge @ 72, 275 Label Lb_tsc Value 'File2' Width 158 Height 20 Font 'ARIAL' Size 10 Bold FontColor BLACK BackColor WHITE ClientEdge CenterAlign @ 94, 223 Label Lb_dsc Value File2->Descri Width 210 Height 20 Font 'ARIAL' Size 10 Bold FontColor RED BackColor BLACK ClientEdge @ 116, 223 TBrowse oBrw_Sec Of oAuxDSMG Width 210 Height 346 Alias 'File2' CELLED On Change ChangeTS() Add Column To oBrw_Sec Header 'Cod.' Data FieldWBlock( 'Codigo', Select() ) Picture '9999' 3DLOOK FALSE,TRUE Size 40 Align DT_LEFT Add Column To oBrw_Sec Header 'Descricao' Data FieldWBlock( 'Descri', Select() ) Picture '@!' 3DLOOK FALSE,TRUE Size 170 Align DT_LEFT oBrw_Sec:Set3DText( .T., .F., Nil, 2, CLR_WHITE, CLR_CBLUE ) oBrw_Sec:SetColor( { 1, 3, 5, 6, 13, 15 }, ; { CLR_BLACK, CLR_BLUE, CLR_WHITE, ; { CLR_BLUE, CLR_HBLUE }, ; // degraded cursor background color CLR_WHITE, CLR_BLACK } ) // text colors oBrw_Sec:SetColor( { 2, 4, 14 }, ; { { || IIf( oBrw_Sec:nLogicPos() % 2 == 0, { CLR_TGRAY, CLR_WHITE }, { CLR_CHHGREEN, CLR_WHITE } ) }, ; { CLR_CBLUE, CLR_NBLUE }, ; // degraded Headers backgroud color { CLR_HRED, CLR_BLACK } } ) // degraded order column background color oBrw_Sec:nHeightCell += 8 oBrw_Sec:nHeightHead += 11 oBrw_Sec:nLineStyle := LINES_VERT oBrw_Sec:SetAppendMode( .F. ) oBrw_Sec:lNoHScroll := .T. //File3 Select("File3") @ 72, 436 Label Lb_cma Value SubStr( cClassif, 7, 3 ) Width 40 Height 20 Font 'ARIAL' Size 10 Bold FontColor RED BackColor BLACK ClientEdge @ 72, 478 Label Lb_tma Value 'File3' Width 168 Height 20 Font 'ARIAL' Size 10 Bold FontColor BLACK BackColor WHITE ClientEdge CenterAlign @ 94, 436 Label Lb_dma Value File3->Descri Width 210 Height 20 Font 'ARIAL' Size 10 Bold FontColor RED BackColor BLACK ClientEdge @ 116, 436 TBrowse oBrw_Mar Of oAuxDSMG Width 210 Height 346 Alias 'File3' CELLED On Change ChangeTM() Add Column To oBrw_Mar Header 'Cod.' Data FieldWBlock( 'Codigo', Select() ) Picture '999' 3DLOOK FALSE,TRUE Size 40 Align DT_LEFT Add Column To oBrw_Mar Header 'Descricao' Data FieldWBlock( 'Descri', Select() ) Picture '@!' 3DLOOK FALSE,TRUE Size 170 Align DT_LEFT oBrw_Mar:Set3DText( .T., .F., Nil, 2, CLR_WHITE, CLR_CBLUE ) oBrw_Mar:SetColor( { 1, 3, 5, 6, 13, 15 }, ; { CLR_BLACK, CLR_BLUE, CLR_WHITE, ; { CLR_BLUE, CLR_HBLUE }, ; // degraded cursor background color CLR_WHITE, CLR_BLACK } ) // text colors oBrw_Mar:SetColor( { 2, 4, 14 }, ; { { || IIf( oBrw_Mar:nLogicPos() % 2 == 0, { CLR_TGRAY, CLR_WHITE }, { CLR_CHHGREEN, CLR_WHITE } ) }, ; { CLR_CBLUE, CLR_NBLUE }, ; // degraded Headers backgroud color { CLR_HRED, CLR_BLACK } } ) // degraded order column background color oBrw_Mar:nHeightCell += 8 oBrw_Mar:nHeightHead += 11 oBrw_Mar:nLineStyle := LINES_VERT oBrw_Mar:SetAppendMode( .F. ) oBrw_Mar:lNoHScroll := .T. //File4 Select("File4") @ 72, 649 Label Lb_cgr Value SubStr( cClassif, 10, 2 ) Width 30 Height 20 Font 'ARIAL' Size 10 Bold FontColor RED BackColor BLACK ClientEdge @ 72, 681 Label Lb_tgr Value 'File4' Width 178 Height 20 Font 'ARIAL' Size 10 Bold FontColor BLACK BackColor WHITE ClientEdge CenterAlign @ 94, 649 Label Lb_dgr Value File4->Descri Width 210 Height 20 Font 'ARIAL' Size 10 Bold FontColor RED BackColor BLACK ClientEdge @ 116, 649 TBrowse oBrw_Gru Of oAuxDSMG Width 210 Height 346 Alias 'File4' CELLED On Change ChangeTG() Add Column To oBrw_Gru Header 'Cod.' Data FieldWBlock( 'Codigo', Select() ) Picture '99' 3DLOOK FALSE,TRUE Size 40 Align DT_LEFT Add Column To oBrw_Gru Header 'Descricao' Data FieldWBlock( 'Descri', Select() ) Picture '@!' 3DLOOK FALSE,TRUE Size 170 Align DT_LEFT oBrw_Gru:Set3DText( .T., .F., Nil, 2, CLR_WHITE, CLR_CBLUE ) oBrw_Gru:SetColor( { 1, 3, 5, 6, 13, 15 }, ; { CLR_BLACK, CLR_BLUE, CLR_WHITE, ; { CLR_BLUE, CLR_HBLUE }, ; // degraded cursor background color CLR_WHITE, CLR_BLACK } ) // text colors oBrw_Gru:SetColor( { 2, 4, 14 }, ; { { || IIf( oBrw_Gru:nLogicPos() % 2 == 0, { CLR_TGRAY, CLR_WHITE }, { CLR_CHHGREEN, CLR_WHITE } ) }, ; { CLR_CBLUE, CLR_NBLUE }, ; // degraded Headers backgroud color { CLR_HRED, CLR_BLACK } } ) // degraded order column background color oBrw_Gru:nHeightCell += 8 oBrw_Gru:nHeightHead += 11 oBrw_Gru:nLineStyle := LINES_VERT oBrw_Gru:SetAppendMode( .F. ) oBrw_Gru:lNoHScroll := .T. @ 480, 10 Label Lb_xxx Value cClassif Width 210 Height 32 Font 'ARIAL' Size 22 Bold FontColor RED BackColor WHITE CenterAlign @ 480, 760 ButtonEx IBTCancelar Caption '&Cancelar' Width 100 Height 32 Font 'ARIAL' Size 7 Bold FontColor GBLUE ToolTip 'Fecha janela, retorna ao navegador' Action { || oAuxDSMGCanc() } //On GotFocus Exibe( 'Click To Close Window' ) End Window Center Window oAuxDSMG Activate Window oAuxDSMG Else oAuxDSMG.SetFocus EndIf Return( .T. ) * -------------------------> Rotina para gravar dados <----------------------- * Function oAuxDSMGPosi() Local nRec // cClassif := oAuxDSMG.Lb_xxx.Value If !Empty( cClassif ) //<> Space( 11 ) File1->( DBSetOrder( 1 ) ) File1->( DBSeek( SubStr( cClassif, 1, 2 ) ) ) nRec := File1->( RecNo() ) File1->( DBSetOrder( 2 ) ) oBrw_Div:SetFocus() oBrw_Div:Reset() oBrw_Div:GotoRec(nRec) /* oAuxDSMG.oBrw_Div.Value := nRec oBrw_Div:SetFocus() oBrw_Div:DrawSelect() oBrw_Div:Refresh( .T. ) For i = 1 To 13 oBrw_Div:RefreshARow( i ) Next */ File2->( DBSetOrder( 1 ) ) File2->( DBSeek( SubStr( cClassif, 3, 4 ) ) ) nRec := File2->( RecNo() ) File2->( DBSetOrder( 2 ) ) oBrw_Sec:SetFocus() oBrw_Sec:Reset() oBrw_Sec:GotoRec(nRec) /* oAuxDSMG.oBrw_Sec.Value := File2->( RecNo() ) oBrw_Sec:SetFocus() oBrw_Sec:DrawSelect() oBrw_Sec:Refresh( .T. ) For i = 1 To 13 oBrw_Sec:RefreshARow( i ) Next */ File3->( DBSetOrder( 1 ) ) File3->( DBSeek( SubStr( cClassif, 7, 3 ) ) ) nRec := File3->( RecNo() ) File3->( DBSetOrder( 2 ) ) oBrw_Mar:SetFocus() oBrw_Mar:Reset() oBrw_Mar:GotoRec(nRec) /* oAuxDSMG.oBrw_Mar.Value := File3->( RecNo() ) oBrw_Mar:SetFocus() oBrw_Mar:DrawSelect() oBrw_Mar:Refresh( .T. ) For i = 1 To 13 oBrw_Mar:RefreshARow( i ) Next */ File4->( DBSetOrder( 1 ) ) File4->( DBSeek( SubStr( cClassif, 10, 2 ) ) ) nRec := File4->( RecNo() ) File4->( DBSetOrder( 2 ) ) oBrw_Gru:SetFocus() oBrw_Gru:Reset() oBrw_Gru:GotoRec(nRec) /* oAuxDSMG.oBrw_Gru.Value := File4->( RecNo() ) oBrw_Gru:SetFocus() oBrw_Gru:DrawSelect() oBrw_Gru:Refresh( .T. ) For i = 1 To 13 oBrw_Gru:RefreshARow( i ) Next */ EndIf oBrw_Div:SetFocus() oAuxDSMG.Lb_cdv.Value := File1->Codigo oAuxDSMG.Lb_csc.Value := File2->Codigo oAuxDSMG.Lb_cma.Value := File3->Codigo oAuxDSMG.Lb_cgr.Value := File4->Codigo oAuxDSMG.Lb_ddv.Value := File1->Descri oAuxDSMG.Lb_dsc.Value := File2->Descri oAuxDSMG.Lb_dma.Value := File3->Descri oAuxDSMG.Lb_dgr.Value := File4->Descri oAuxDSMG.Lb_xxx.Value := oAuxDSMG.Lb_cdv.Value + oAuxDSMG.Lb_csc.Value + oAuxDSMG.Lb_cma.Value + oAuxDSMG.Lb_cgr.Value Return( .T. ) * ------------------------> Rotina para atualizar dados <--------------------- * Function ChangeTD() Local xClassif := oAuxDSMG.Lb_xxx.Value oAuxDSMG.Lb_cdv.Value := File1->Codigo oAuxDSMG.Lb_ddv.Value := File1->Descri oAuxDSMG.Lb_xxx.Value := oAuxDSMG.Lb_cdv.Value + SubStr( xClassif, 3, 8 ) Return( .T. ) * ------------------------> Rotina para atualizar dados <--------------------- * Function ChangeTS() Local xClassif := oAuxDSMG.Lb_xxx.Value oAuxDSMG.Lb_csc.Value := File2->Codigo oAuxDSMG.Lb_dsc.Value := File2->Descri oAuxDSMG.Lb_xxx.Value := SubStr( xClassif, 1, 2 ) + oAuxDSMG.Lb_csc.Value + SubStr( xClassif, 7, 5 ) Return( .T. ) * ------------------------> Rotina para atualizar dados <--------------------- * Function ChangeTM() Local xClassif := oAuxDSMG.Lb_xxx.Value oAuxDSMG.Lb_cma.Value := File3->Codigo oAuxDSMG.Lb_dma.Value := File3->Descri oAuxDSMG.Lb_xxx.Value := SubStr( xClassif, 1, 6 ) + oAuxDSMG.Lb_cma.Value + SubStr( xClassif, 10, 2 ) Return( .T. ) * ------------------------> Rotina para atualizar dados <--------------------- * Function ChangeTG() Local xClassif := oAuxDSMG.Lb_xxx.Value oAuxDSMG.Lb_cgr.Value := File4->Codigo oAuxDSMG.Lb_dgr.Value := File4->Descri oAuxDSMG.Lb_xxx.Value := SubStr( xClassif, 1, 9 ) + oAuxDSMG.Lb_cgr.Value Return( .T. ) * ----------------------> Rotina para fechar janela ativa <------------------- * Function oAuxDSMGCanc() If IsWindowDefined( oAuxDSMG ) Release Window oAuxDSMG EndIf Return( .T. )[/pre2]
SergKis: Может не очень врубаюсь в сущность примера, но когда и от чего должны происходить переотображения тсб и в какой последовательности, т.е. где паровоз\лошадь ? Вроде пример на создание\расшифровку составного кода, если да, то должна была бы быть база его откуда плясать (изменение позиции с ключом меняет все тсб). Если это просто передвигаем любой тсб и что то должно произойти во ВСЕХ тсб, то это другое и должно происходить по таймеру (сменилось в label, сменилось в тсб).
SergKis: PS или onchange label, в который пишем
gfilatov2002: SergKis пишет: когда и от чего должны происходить переотображения тсб Судя по логике примера, чел хочет, чтобы при инициализации окна корректно обновлялись все четыре TBROWSE. Он заметил, что если мало строк до конца списка в окошке, то TBROWSE корректно не обновляется, что и демонстрирует этот пример для случая File2. Если лучше обновлять по таймеру, то возможно ли отрехтовать данный пример для корректного отображения данных после поиска при инициализации окна
nick_mi: SergKis пишет: не очень врубаюсь в сущность примера SergKis пишет: должна была бы быть база его откуда плясать (изменение позиции с ключом меняет все тсб) Там, похоже, из 4-х разных таблиц набирают какие-то коды характеристик, независимые от предыдущих и последующих характеристик gfilatov2002 пишет: Но теперь другая (и основная) проблема - не обновляется при старте File2 TBROWSE Объяснить не могу но если добавить строку - обзначена красным, то вроде все нормально [pre2] File2->( DBSetOrder( 1 ) ) File2->( DBSeek( SubStr( cClassif, 3, 4 ) ) ) nRec := File2->( RecNo() ) File2->( DBSetOrder( 2 ) ) oBrw_Sec:SetFocus() oBrw_Sec:Reset() oBrw_Sec:GotoRec(nRec) oBrw_Sec:Skip(0)[/pre2]
SergKis: gfilatov2002 пишет Судя по логике примера, чел хочет, чтобы при инициализации окна корректно обновлялись все четыре TBROWSE. Т.е. это расшифровка составного кода, т.к. сами тсб между собой не связаны. Попробую порихтовать с этой позиции.
SergKis: nick_mi пишет Объяснить не могу но если добавить строку - обзначена красным, то вроде все нормально Если это годится, то рихтовать не буду. nick_mi
Петр: SergKis пишет: сами тсб между собой не связаны. Вот-вот gfilatov2002 пишет: чел хочет, чтобы при инициализации окна корректно обновлялись все четыре TBROWSE. Так вы посоветуйте челу изучить азы ООП если он создал 4 объекта browse, то пускай их и спользует через доступные методы, а не напрямую File2->( DBSetOrder( 1 ) ) File2->( DBSeek( SubStr( cClassif, 3, 4 ) ) ) Да это чаще всего будет работать - но при этом вы игнорируете всю внутреннюю логику работы browse. И не позволит обнаружить ошибки в логике такой роботы - если они там есть. Для синхронизации связанных browse есть метод SyncChild (я что-то нигде не увидел примера его использования), так будет корректнее чем через таймер (ИМХО здесь таймер - извращение). Не ищите костыль
gfilatov2002: nick_mi пишет: вроде все нормально Благодарю за помощь Обновляется, однако... Петр пишет: вы посоветуйте челу изучить азы ООП Вот с этим как раз проблема - программируют на минигуи, в основном, люди старой школы Не по теме. На мой взгляд, это во многом объясняет использование Минигуи вместо полноценных ООП-систем типа HwGUI, на изучение корректной работы которых требуется время
Петр: Так обьясните ему, что ошибку он сотворил сам, не проводя процедур синхронизации состояния обьектов. Но мой пост адресовался не только ему [pre2] File1->( DBSetOrder( 1 ) ) File1->( DBSeek( SubStr( cClassif, 1, 2 ) ) ) nRec := File1->( RecNo() ) File1->( DBSetOrder( 2 ) ) _SyncObject( oBrw_Div, nRec ) File2->( DBSetOrder( 1 ) ) File2->( DBSeek( SubStr( cClassif, 3, 4 ) ) ) nRec := File2->( RecNo() ) File2->( DBSetOrder( 2 ) ) _SyncObject( oBrw_Sec, nRec ) ... static procedure _SyncObject( o, nRec ) o:SetFocus() o:Reset() o:GotoRec(nRec) o:Skip(0) // and more return [/pre2]
SergKis: Петр пишет так будет корректнее чем через таймер (ИМХО здесь таймер - извращение). Достаточно спорное утверждение. Крутим колесико и мелькание связанных тсб обеспечено. У Димы, недавно, была задачка на эту тему.Для синхронизации связанных browse есть метод SyncChild Особых преимуществ метод не дает. Он связывает ведущий тсб с подчинеными, соответствующими блоками кода. Это мило и симпатично, но тоже самое можно решить и др. способами. На любителя ООП (их тут мало с МиниГуи работающих)
Петр: SergKis пишет: Достаточно спорное утверждение. Там было ИМХО, а потом здесь. Про проблемы Димы читал, но утверждать, что решить их нельзя и др. способами не буду Смысл моего поста - нельзя игнорировать логику поведения обьекта. А потом еще и удивляться (или, не дай бог, возмущаться). Для любителей ООП в этом случае есть возможность наследования, для остальных - костыль или не пользоваться SergKis пишет: Особых преимуществ метод не дает. Он связывает ведущий тсб с подчинеными, соответствующими блоками кода. Это мило и симпатично, но тоже самое можно решить и др. способами. На любителя ООП (их тут мало с МиниГуи работающих) Нет-нет, спора не будет
Andrey: Вопрос возник уже давно решить не могу ! Как бороться с не показом вертикального скролинга (стрелка внизу отгрызана) ? Юзера прикалываются.... При показе таблицы делаю: oBrwX:lNoHScroll := .T. // НЕТ показа горизонтального скролинга oBrwX:ResetVScroll() // показ вертикального скролинга Первый раз таблица отображается нормально. После перепоказа по другим индексам делаю типа так: nOrder := IIF(lCity,2,1) SELECT(cAlias) DBSetOrder(nOrder) SetProperty(oBrwX:cParentWnd, oBrwX:cControlName, "Enabled", .F.) oBrwX:lNoHScroll := .T. // НЕТ показа горизонтального скролинга oBrwX:ResetVScroll() // показ вертикального скролинга oBrwX:Reset() oBrwX:Refresh(.T.) oBrwX:Upstable() SetProperty(oBrwX:cParentWnd, oBrwX:cControlName, "Enabled", .T.) oBrwX:Setfocus() Показывается вертикальный скролинг и стрелка внизу отгрызана..... Да и в добавок потом НИКАК не убирается горизонтальный скролинг. Что не так делаю ?
Dima: Andrey пишет: Как бороться с не показом вертикального скролинга oBrw4:bChange := {|| oBrw4:oVScroll:SetRange( 0, 0 ) }
Andrey: Спасибо Дима ! Чудо свершилось, чуток переделал и горизонтальный скролинг пропал, а вертикальный стал нормально показываться: [pre2]SetProperty(oBrwX:cParentWnd, oBrwX:cControlName, "Enabled", .F.) oBrwX:bChange := {|| oBrwX:oHScroll:SetRange( 0, 0 ) } oBrwX:Reset() oBrwX:Refresh(.T.) oBrwX:Upstable() SetProperty(oBrwX:cParentWnd, oBrwX:cControlName, "Enabled", .T.) oBrwX:Setfocus() [/pre2]
Vlad04: Есть основная база, к примеру, MIBLP.dbf. Есть вторая база - INFEKZII.dbf, это источник данных Пример, заготовка здесь - TsBrows И COMBOBOX Хотелось , бы 1) чтобы в TsBrows в поля 'KRANK1','KRANK2','KRANK3' был подключены COMBOBOX и можно было бы производить выбор данных из второй базы (подобное возможно, но примеры которые есть сильно перегружены лишней информацией) 2)в Combo_1, который на поле формы отображалось значение , к примеру поля 'KRANK1' базы MIBLP.dbf. Но в то же время была-бы возможность изменить данные выбором из сомбо
SergKis: Vlad04 пишет Хотелось , бы Тут вариант http://my-files.ru/q9hcvw
Vlad04: Не просто.Если программа большая, запутаться легко. Почему-то в Browse в подстановке в поле базы данных из массива через комбобох нет особых проблем.
SergKis: Vlad04 Может так проще http://my-files.ru/ltps9w
SergKis: Vlad04 Т.к. TBROWSE_1 private, может быть public, то упростить можно еще так[pre2] FUNC Combo_Enter() Local cForm := ThisWindow.Name Local cComb := This.Name Local oBrw := TBROWSE_1 // Local cBrw := "TBROWSE_1" // Local oBrw := _HMG_aControlIds[ GetControlIndex(cBrw, cForm) ] Local oCol := oBrw:GetColumn[cComb] Local nVal, cVal nVal := This.&(cComb).Value cVal := This.&(cComb).Item(nVal) Eval(oCol:bPostEdit, cVal, oBrw) oBrw:SetFocus() RETURN NIL [/pre2] и в блоках кода вместо obr использовать TBROWSE_1 Я не исп. Public\Private потому использую параметры блоков кода
SergKis: Vlad04 подправил, с учетом уст. курсора тсб на любой колонке и модификация инф. из combobox [pre2] FUNC TBrowse_1_Sets() ... :GetColumn('KRANK3'):bPostEdit := bPost :GoPos(1, 1) :SetFocus() END WITH ... FUNC Combo_Enter() Local cForm := ThisWindow.Name Local cComb := This.Name Local oBrw := TBROWSE_1 Local oCol := oBrw:GetColumn(cComb) Local nVal, cVal nVal := This.&(cComb).Value cVal := This.&(cComb).Item(nVal) (oBrw:cAlias)->( FieldPut(FieldPos(cComb), cVal) ) oBrw:SetFocus() RETURN NIL [/pre2]
Vlad04: SergKis Спасибо Пока остановился на таком варианте: По горячей клавише или Клику открывается вспомогательная форма, там редактирую и т.д. И все таки , почему же в Browse проще?
SergKis: Vlad04 пишет И все таки , почему же в Browse проще? Обманчивая видимость простоты. Мои клиенты категорически отказались работать с InplaceEdit, т.к. оно реализовано на модальном окне и мелькание фокуса с бровсе на ячейку - глаз\нервы не держат. Выделение на мод. окно объекта коректировки, позволяет разделить сообщения управления бровсе и контрола коректировки. Вот кусочек текста.[pre2] DEFINE WINDOW _InPlaceEdit ; AT This.CellRow + GridRow - _HMG_aControlRow [ i ] - 1 , This.CellCol + GridCol - _HMG_aControlCol [ i ] + 2 ; WIDTH This.CellWidth ; HEIGHT This.CellHeight + 6 + Ldelta ; MODAL ; NOCAPTION ; NOSIZE ON KEY CONTROL + U ACTION iif( _IsWindowActive( '_InPlaceEdit' ), ; _InPlaceEdit.Control_1.Value := iif( ControlType == 'L', iif ( CellData , 1 , 2 ), CellData ), NIL ) ON KEY RETURN ACTION iif( _IsWindowActive( '_InPlaceEdit' ), ; _InPlaceEditOk ( i , _InPlaceEdit.Control_1.Value , aValid , CellColIndex , ; sFieldName , _GridWorkArea , aValidMessages , lock , ControlType , aInputItems ), NIL ) ON KEY ESCAPE ACTION ( _HMG_IPE_CANCELLED := .T. , iif( lock == .T. , dbUnlock(), NIL ) , ; iif( _IsWindowActive( '_InPlaceEdit' ), _InPlaceEdit.Release, NIL ) ) IF lInputItems == .T. // Fill Items Array AEval( aInputItems [ CellColIndex ] , { |p| AAdd ( aItems , p [1] ) } ) // Fill Values Array AEval( aInputItems [ CellColIndex ] , { |p| AAdd ( aValues , p [2] ) } ) r := AScan ( aValues , CellData ) DEFINE COMBOBOX Control_1 ROW 0 COL 0 ITEMS aItems WIDTH This.CellWidth VALUE iif ( Empty( r ) , 1 , r ) FONTNAME _hmg_aControlFontName [ i ] FONTSIZE _hmg_aControlFontSize [ i ] ON LISTDISPLAY Eval( bOnDisplay ) ON LISTCLOSE Eval( bOnCloseUp ) END COMBOBOX [/pre2] В тсб все управление сообщениями таблицы и контрола edit заложено в объект блоками кода. Думаю, немного попривыкнув\изучив, сложности не будет в понимании.
SergKis: Vlad04 По поводу краткости записи. Пример тот же [pre2] #include <minigui.ch> #include "tsbrowse.ch" REQUEST DBFCDX , DBFFPT REQUEST HB_CODEPAGE_RU866 REQUEST HB_CODEPAGE_RU1251 FUNCTION Main Local nArea, oBrw Local aKRANK1 := {}, aKRANK2 := {}, aKRANK3 := {} hb_SetCodepage("RU1251") SET DELETED ON SET DATE BRITISH SET CENTURY ON SET EPOCH TO 1925 SET BROWSESYNC ON PRIVATE TBROWSE_1 USE INFEKZII Via "DBFCDX" NEW CODEPAGE 'RU866' nArea := select() dbEval({|| aAdd(aKRANK1, (nArea)->NAME), ; aAdd(aKRANK2, (nArea)->NAME), ; aAdd(aKRANK3, (nArea)->NAME) }) GO TOP USE MIBLP Via "DBFCDX" NEW CODEPAGE 'RU866' DEFINE WINDOW FrmGL AT 0, 0 WIDTH 650 HEIGHT 578 MAIN DEFINE TBROWSE TBROWSE_1 AT 30, 10 ; WIDTH This.ClientWidth - 10 * 2 ; HEIGHT This.ClientHeight - 30 * 2 ; COLSIZES 50,130,130,130,130,130 ; WORKAREA 'MIBLP' ; CELL ; COLUMNS 'CODE','MIBP','KRANK1','KRANK2','KRANK3' :LoadFields(.T.) // Edit :nClrLine := COLOR_GRID :nWheelLines := 1 :SetColor( { CLR_FOCUSB }, { { |nAt,nNr,oBr| nAt := Nil, ; If( oBr:nCell == nNr, RGB(166, 202, 240), RGB(220, 220, 220) ) } } ) AEval( :aColumns, {|oCol| oCol:lFixLite := .T., ; oCol:lOnGotFocusSelect := .T.} ) // :GetColumn("CODE"):lEdit := .F. :SetData('KRANK1', , aKRANK1) :SetData('KRANK2', , aKRANK2) :SetData('KRANK3', , aKRANK3) END TBROWSE END WINDOW FrmGL.Center FrmGL.Activate RETURN( NIL ) [/pre2]
Andrey: SergKis пишет: :SetData('KRANK1', , aKRANK1) Что за параметр :SetData() ?
Петр: Andrey пишет: Что за параметр :SetData() ? SetData это метод - функция с 3-мя параметрами Это мило и симпатично, но тоже самое можно решить и др. способами. На любителя ООП (их тут мало с МиниГуи работающих)
SergKis: Петр :GetColumn('KRANK1'):aItems := aKRANK1 :GetColumn('KRANK1'):lComboBox := .T.
Vlad04: SergKis По поводу краткости записи Да уж, на счет краткости слов нет. 1) Почему-то периодически вылетает программа (ваша редакция) с ошибкой - Выход за границы массива. Связь не уловил. 2) Перенес код с тестовой в настоящую программу. Комбобокс создается , но почему-то на первом слева поле, где его не должно быть
Vlad04: Колонки я добавляю так ... ADD COLUMN TO Brw_1 DATA FieldWBlock(.. ...
gfilatov2002: Vlad04 пишет: Почему-то периодически вылетает программа (ваша редакция) с ошибкой Проверь эту строку в примере COLSIZES 50,130,130,130,130,130 TBROWSE имеет 5 колонок, а размеры установлены для шести колонок Отсюда имеем вылет в методе :nAtColl() P.S. Поправил эту бяку в исходнике библиотеки TsBrowse, теперь не вылетает
Vlad04: gfilatov2002 теперь не вылетает Да, всё нормально. А что же определяет привязку комбобокса к колонкам ?
SergKis: Vlad04 пишет А что же определяет привязку комбобокса к колонкам ? :SetData( nColumn, bData, aList ) nColumn (номер колонки) может быть задано симв. именем колонки из ADD .... NAME ... :GetColumn(5):cName := "..." :LoadFields(.T.\.F.) ставит :cName от имени поля
Vlad04: SergKis Все хорошо. Если указываешь НОМЕР колонки - происходит правильная привязка комбобокса .
Vlad04: TsBrowse и дизайнер Работа с компонентами оказывается отличается, если форму вы построили в дизайнере или описали в программном коде. Это возможно связано с видимостью переменных. Вот пример построения TsBrowse в IDE, который идет в поставке MiniGui. Добавим на форму компоненты, связанные с TsBrowse (вполне обычная ситуация) [url=https://cloud.mail.ru/public/4taw/Yc13QvLBM]TsBrowseTsBrowse[/url] Компилируется без ошибок, но при запуске не работает
Vlad04: Ссылка
SergKis: Vlad04 пишет Компилируется без ошибок, но при запуске не работает Проверяйте наличие контроллов в процедуре Chang_Tbr() или перенесите TSB в конец (перед END WINDOW) в fmg файле. В каком то примере выше, я уже проделывал такую штуку и не забывайте объявлять переменную PUBLIC\PRIVATE TBROWSE_1 для DEFINE TBROWSE, в ней созданный объект tsb
Vlad04: SergKis Однако ! Про объявление переменных думал, а вот это перенесите TSB в конец (перед END WINDOW) в fmg новость.На такую тонкость в каком-то примере не обратил внимания.
SergKis: Vlad04 пишет новость При создании тсб (прорисовка строк) срабатывает :bChange, в нем обращение к несуществующим еще контроллам. Без него было бы все ок! Перед END WINDOW (после IDE) можно ставить вызов функции\процедуры для инициализации созданных IDE контроллов и для тсб устанавливать все блоки кода, например TBROWSE_1:bChange := {|| Change_Tsb() }
Vlad04: SergKis Посмотрите. Как комбо подключить к какому- нибудь полю бровзе? Может где-то в коде? Или Value в сомбо это индекс Item?
SergKis: Vlad04 пишет Как комбо подключить к какому- нибудь полю бровзе? Был пример Tsb_combo_demo2.7z и в нем 3-и поля с 3-мя сомбо связаны [pre2] :bChange := {|obr,oCol,cNam,cVal,nPos| ; cNam := 'KRANK1', ; oCol := obr:GetColumn(cNam), ; cVal := Eval(oCol:bData), ; nPos := ascan(oCol:aItems, cVal), ; nPos := iif( nPos > 0, nPos, 1 ), ; SetProperty(obr:cParentWnd, cNam, "Value", nPos), ; cNam := 'KRANK2', ; oCol := obr:GetColumn(cNam), ; cVal := Eval(oCol:bData), ; nPos := ascan(oCol:aItems, cVal), ; nPos := iif( nPos > 0, nPos, 1 ), ; SetProperty(obr:cParentWnd, cNam, "Value", nPos), ; cNam := 'KRANK3', ; oCol := obr:GetColumn(cNam), ; cVal := Eval(oCol:bData), ; nPos := ascan(oCol:aItems, cVal), ; nPos := iif( nPos > 0, nPos, 1 ), ; SetProperty(obr:cParentWnd, cNam, "Value", nPos) } [/pre2] Value в сомбо это индекс Item? Да
Vlad04: Если задача только отображать данные в комбобоксе, то можно применить свойство DISPLAYEDIT .T. click here
Vlad04: click here
Dima: SergKis В общем снова полезли глюки , если интенсивно ездить по бровсу. По началу пропали все иконки в бровсе , после того как из бровса вышел , в главном окне потерялся IMAGE и перекалапуцало главное меню. Таймер сделан как ты и советовал. Беда с этим бровсом...
Петр: Dima пишет: перекалапуцало главное меню. Это как?
Dima: Петр пишет: Это как? Да все посдвигалось , фон главного окна куда то пропал , картинка в главном окне улетела в пятое измерение , статус бар главного окна хаотично сменил цвета...... При чем по TsBrowse я поездил минут 5 и оставил , поработал в другой проге , затем вернулся туда же , снова поездил хаотично то клавишами то колесом мыши , вышел покурить....снова поездил ...пошел сделал кофе , ну и тд и после только начав ездить ......понеслись глюки.
Петр: А с меню что? Фон главного окна как задается? BKBRUSH? Картинка как выводится, какой командой? В TsBrowse живет таймер постоянно? Он срабатывает даже если комп переходит в режим ожидания (кофе с перекуром)? А без кофе такое случается?
Dima: Петр Вопросы понял , обмозгую завтра и отвечу. Спасибо !
Dima: Петр пишет: Фон главного окна как задается? BKBRUSH? BACKCOLOR { 99,99,99 } Петр пишет: Картинка как выводится, какой командой? DEFINE IMAGE внутри описания окна Петр пишет: В TsBrowse живет таймер постоянно? Таймер живет в окне (WINDOWTYPE STANDARD) а уже в этом окне живут 2 TsBrowse После закрытия окна таймер должен я так понимаю , сам самоликвидироваться Петр пишет: Он срабатывает даже если комп переходит в режим ожидания (кофе с перекуром)? Получается что да [pre2] DEFINE TIMER MyTimer INTERVAL 400 ACTION DoTimer(oBrw3,obrw4) This.MyTimer.Enabled := .t. END WINDOW [/pre2] Как только заглючил TsBrowse , начинаются глюки во всей проге.
Петр: По мне, так некорректно обрабатываются сообщения, в часности WM_PAINT, а вот дальше без исходников - гадание на кофейной гуще. Dima пишет: Получается что да И вот этот момент немного меня смущает. А на утечку ресурсов приложения смотрели GDIView Самодостаточный пример с глюками нужен.
Dima: С GDIView ранее не работал. Не понятно где смотреть утечку. Вероятно показывать счетчики изменений. После "падения" уже , вижу следующее. Так в колонке BRUSH вижу 27 [+4] Bitmap 9746 [+9568] Шрифт 42 [+4] В диспетчере задач после загрузки получил на задаче цифирь 3788 а когда все рухнуло 3948 (использование памяти) При этом проц грузануло на 25 % , после чуть отпустило до 8 % , но нормально выйти не смог , снял задачу. Петр пишет: Самодостаточный пример с глюками нужен. Согласен. Не много по текущей работе разберусь и попробую сделать.
ММК: Петр пишет: По мне, так некорректно обрабатываются сообщения, в часности WM_PAINT, а вот дальше без исходников - гадание на кофейной гуще. Складывается впечатление, что "теряется" активное окно. Конечно таймер к этой ситуации это от лукавого :)) Ошибке уже лет десять, поэтому вот в этих исходниках она уже есть. https://cloud.mail.ru/public/8Xve/UTv9YCg65 Это первоисточник, так что может что и даст :)
Петр: Dima пишет: Вероятно показывать счетчики изменений. Да, сравнение до и после. Если все сделано аккуратно и правильно, то создали кисточку нарисовали что-то - удалили, тоже с картинками и т.д. - ресурсы нужно использовать экономно. Значит если есть разница счетчиков - ресурсы освобождаются некорректно, это в MiniGUI еще встречается - теперь нужно по возможности локализировать место утечки.
Dima: Петр Понял , поиграюсь еще.
Петр: ММК пишет: Ошибке уже лет десять, поэтому вот в этих исходниках она уже есть. И что не нашли? :HandleEvent() можно (нужно) трасить
Dima: Долго играть не пришлось. Открыл бровс. Показания BITMAP в GDIVIEW 234 [0] Опустился стрелкой вниз на 5 строк в бровсе , получил 234 [+56] Еще 5 строк , 472 [+274] Похоже утечка с показом иконок и картинок в TsBrowse , но спешить с выводами не буду и проверю на примерах из поставки Минигуи.
Dima: Поигрался в свое проге + GDIVIEW В некоторых полях использую вывод BMP из ресурса. Заявлено примерно так [pre2] oBrw3:GetColumn( "dels" ):uBmpCell :={|| if( (oBrw3:calias)->dels,LOADIMAGE("wcanc"),NIL) } ......... oBrw3:GetColumn( "prm" ):uBmpCell :={|| if( !empty((oBrw3:calias)->prime),LOADIMAGE("rss_brw"),NIL) } [/pre2] В этом случае в GDIVIEW в колонке BitMap цифра постоянно растет , даже если закрыть окно с бровсом а после войти туда снова. При езде по самому бровсу эта цифра так же растет. Пробнул в LoadImage сунуть имя не существующего ресурса , показа картинок в этом случае нет что и понятно , но и утечки нет однако. Поюзал в такой связке примеры из Минигуи где картинка в бровс помещается не из ресурса а из файла на диске , в этом случае утечки так же нет.
Dima: Кажись понял Вот так не совсем верно oBrw3:GetColumn( "dels" ):uBmpCell :={|| if( (oBrw3:calias)->dels,LOADIMAGE("wcanc"),NIL) } Необходимо в самом начале проги сделать примерно так Public abmp3:={LOADIMAGE("wcanc"),LOADIMAGE("rss_brw")} а далее oBrw3:GetColumn( "dels" ):uBmpCell :={|| if( (oBrw3:calias)->dels,abmp3[1],NIL) } В этом случае таких глобальных утечек не будет. А так при езде по бровсу без этих изменений постоянно грузился новый экземпляр пикчи. PS Лень делать проверку , но думаю если устроить цикл от 1 до 5 тыщ (может больше) и в нем грузить одну и туже пикчу из ресурса с помощью LOADIMAGE , то прога "ляжет"..... Примеры типа TSB_CURSOR если долго их "напрягать" тоже лягут , так как при любом сдвиге записи в таблице постоянно грузится новый экземпляр Calendar.BMP , это хорошо видно в GDIVIEW.
ММК: Петр пишет: И что не нашли? TsBrows перестали использовать т.к. появился xBrows и вопросы отпали :)
gfilatov2002: Dima пишет: Примеры типа TSB_CURSOR если долго их "напрягать" тоже лягут Благодарю за сообщение! Поправил этот пример для новой сборки (см.ниже) [pre2]/* * MINIGUI - Harbour Win32 GUI library Demo * * Author: Igor Nazarov * * Revised by Grigory Filatov <gfilatov@inbox.ru> */ #include "minigui.ch" #include "TSBrowse.ch" MEMVAR aFont PROCEDURE Main PUBLIC aFont := {}, aBmp[ 1 ] SET DATE FORMAT 'DD.MM.YYYY' DEFINE FONT Font_1 FONTNAME "Times New Roman" SIZE 11 DEFINE FONT Font_2 FONTNAME iif( _HMG_IsXP, "Comic Sans MS", "MV Boli" ) SIZE 14 BOLD AAdd( aFont, GetFontHandle( "Font_1" ) ) AAdd( aFont, GetFontHandle( "Font_2" ) ) DEFINE WINDOW Form_0 ; TITLE "TsBrowse Double Cursor Demo" ; MAIN ; NOMAXIMIZE NOSIZE ; ON RELEASE DeleteObject( aBmp[ 1 ] ) DEFINE STATUSBAR STATUSITEM "Item 1" WIDTH 0 FONTCOLOR BLACK STATUSITEM "Item 2" WIDTH 230 FONTCOLOR BLACK STATUSITEM "Item 3" WIDTH 230 FONTCOLOR BLACK STATUSITEM "Item 4" WIDTH 230 FONTCOLOR BLACK DATE CLOCK KEYBOARD END STATUSBAR CreateBrowse() END WINDOW DoMethod( "Form_0", "Activate" ) RETURN FUNCTION CreateBrowse() LOCAL oBrw LOCAL i LOCAL aDatos := {} FOR i := 1 TO 1000 AAdd( aDatos, { i, RandStr( 30 ), Date() - i, if( i % 2 == 0, TRUE, FALSE ) } ) NEXT aBmp[ 1 ] := LoadImage( "Calendar.BMP" ) DEFINE TBROWSE oBrw AT 17, 0 ; OF Form_0 ; WIDTH Form_0.WIDTH - 2 * GetBorderWidth() ; HEIGHT Form_0.HEIGHT - GetTitleHeight() - GetTitleHeight() - ; GetProperty( "Form_0", "StatusBar", "Height" ) - 2 * GetBorderHeight() ; GRID ; SELECTOR TRUE; FONT "Arial" SIZE 12 oBrw:SetArray( aDatos, .T. ) oBrw:nWheelLines := 1 oBrw:nClrLine := COLOR_GRID oBrw:lNoChangeOrd := TRUE oBrw:lCellBrw := TRUE oBrw:lNoVScroll := TRUE oBrw:hBrush := CreateSolidBrush( 242, 245, 204 ) // prepare for showing of Double cursor AEval( oBrw:aColumns, {| oCol| oCol:lFixLite := oCol:lEdit := TRUE } ) // assignment of column's names oBrw:aColumns[ 1 ]:cName := "NUMBER" oBrw:aColumns[ 2 ]:cName := "TEXT" oBrw:aColumns[ 3 ]:cName := "DATE" oBrw:aColumns[ 4 ]:cName := "LOGIC" // the reference to columns by names oBrw:SetColSize( "NUMBER", 100 ) oBrw:SetColSize( "TEXT", 500 ) oBrw:SetColSize( "DATE", 200 ) // Checking the method nColumn() oBrw:SetColSize( oBrw:nColumn( "LOGIC" ), 300 ) // image with white backcolor looks similar to transparent oBrw:GetColumn( 'DATE' ):uBmpCell := {|| If( oBrw:lDrawSelect, aBmp[ 1 ], NIL ) } oBrw:GetColumn( 'NUMBER' ):nAlign := DT_CENTER oBrw:GetColumn( 'TEXT' ):nAlign := DT_LEFT oBrw:GetColumn( 'DATE' ):nAlign := DT_CENTER oBrw:GetColumn( 'LOGIC' ):nAlign := DT_CENTER oBrw:nAdjColumn := 3 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, c| IF( c:nCell == b, { RGB( 66, 255, 236 ), RGB( 111, 183, 155 ) }, ; { RGB( 255, 255, 255 ), RGB( 200, 200, 200 ) } ) } } ) // cursor backcolor oBrw:ChangeFont( {|| IF( oBrw:lDrawSelect, aFont[ 2 ], aFont[ 1 ] ) },, ) END TBROWSE RETURN NIL FUNCTION RandStr( nLen ) LOCAL cSet := "qwertyuiopasdfghjklzxcvbnmQWERTYUIOPASDFGHJKLZXCVBNM" LOCAL cPass := "" LOCAL i := 0 FOR i := 1 TO nLen cPass += SubStr( cSet, Random( 52 ), 1 ) NEXT RETURN cPass[/pre2]
Петр: Dima пишет: Кажись понял Глюки ушли совсем? P.S. Поздравляю с освоением нового инструмента - GDIVIEW
Andrey: ММК пишет: т.к. появился xBrows и вопросы отпали А портировать xBrows в МиниГуи возможно ? Ну там лицензия и т.д.
Петр: Andrey пишет: А портировать xBrows в МиниГуи возможно ? Ну там лицензия и т.д. Если у вас есть такая возможность, то портируйте, пожалуйста, click here или click here Там и лицензия позволяет, и многие были бы вам благодарны
Dima: Петр пишет: Глюки ушли совсем? P.S. Поздравляю с освоением нового инструмента - GDIVIEW Косяков больше не смог найти . Долго "ездил" , глюков нет. Отдал заказчику , пусть обкатают. Спасибо за наводку
Петр: Dima пишет: Косяков больше не смог найти . Долго "ездил" , глюков нет. Извините, конечно, за назойливость Костыль в виде таймера убран? Или еще нужен?
Dima: Петр пишет: Костыль в виде таймера убран? Или еще нужен? Как бы костыля и не было. Изначально таймер жил в Tsbrowse а после поселился в окне где живут дружно два бровса TS. Вся ситуация как бы была описана выше. На что намекаешь то ? :) Косяков и утечек не увидел.
Haz: Да по сути это и есть костыль т. к. заменяет обработку "отпускания" кнопки. И пока этот костыль нужен. и вариантов кроме таймера не предвидится Без этого "костыля" не понятно как организовать перерисовку подчиненных бровсоов, а если их "сто пятьсот" - главный бровс возмет приз Гинеса по тормозам при скипе
Петр: Dima пишет: На что намекаешь то ? :) Ни на что. Честно ! Если таймер используется только для синхронизации, то такое решение имеет право на существование.
Петр: Haz пишет: Без этого "костыля" не понятно как организовать перерисовку подчиненных бровсоов, Как бы задумывалось через SyncChild, а вот рациональный алгоритм для наступления этого события продумать не мешало бы.
Haz: Петр пишет: продумать не мешало бы. Петр, да ктож против. Мы все локально и у себя, пытаемся этот алгоритм найти. Многое предложил Сергей, кое что по мелочам я накидал, проф поправки есть и от тебя (сорь на брудершафт пока не пили, уверен не обидел) . Это все не системно. Может открыть тему Проблема TS - варианты - решение. Григорий один не вытянет. К примеру подтема "как сделать отображение подчиненного бровса по ОТПУСКАНЮ кнопки или отрыву пальца от колеса мыши? Один из вариантов - именно таймер, но ведь есть и другие. Вот в этой теме их и собирать. Пока по факту TS один из самых сильных инструментов в Minigui и.... один из самых непредсказуемых, применрно половина времени на разработку ПО уходит на борьбу с его сюрпризами
SergKis: Петр пишет Как бы задумывалось через SyncChild, а вот рациональный алгоритм для наступления этого события продумать не мешало бы. SyncChild метод ставит ::bChange, т.е. портит установленный, а практически в каждом тсб он занят. Даже этого достаточно, что бы метод не использовать. Haz пишет К примеру подтема "как сделать отображение подчиненного бровса по ОТПУСКАНЮ кнопки или отрыву пальца от колеса мыши? Тут больше гемороя, т.к. надо знать какому тсб и в какой ситуации, что посылать. По мне, наличие таймера на контроле (тсб в частности), вполне приемлемое решение. Принцип "все свое ношу с собой" в объекте, т.е. каждый тсб знает, что и при каких условиях надо делать\переотображать.
SergKis: PS По поводу обработчика в тсб. Можно добавить[pre2] DATA bEvents METHOD HandleEvent( nMsg, nWParam, nLParam ) CLASS TSBrowse Local nDelta, ix Default ::lNoPaint := .F., ; ::lDontChange := .F. If hb_IsBlock(::bEvents) If ! empty( EVal(::bEvents, Self, nMsg, nWParam, nLParam) ) RETURN 1 EndIf EndIf ... [/pre2]
ММК: Петр пишет: Если таймер используется только для синхронизации, то такое решение имеет право на существование. Для синхронизации есть ON CHANGE. С учетом того , что все другие бровсы работают нормально есть смысл посмотреть их и сравнить с TS. Ситуация меняется , если изменить алгоритм перерисовки. Менется , если убирать утечки памяти , хотя возникает она и без использования иконок. Мне кажется правильнее искать причину :) Ведь если оставлять этот бровс , то в него еще придется много чего добавлять , а с такими глюками это замок на песке.
Haz: ММК пишет: Для синхронизации есть ON CHANGE. к нему претензий, за исключением одной - не ловит ситуёвину ногда пользователь сел на кнопку и едет к примеру вниз не отпуская. Блок отрабатывает честно на каждом скипе, а если там перерисовка другого бровса или их несколько.... И пока вся эта гирлянда не отработает bChange не пустит на следующую запись. Причём это вполне рабочая ситуация, есть например реестр заказов, с каждым заказом связан его состав ( отдельный бровс) и графики платежей ( еще один). С каждым элементом состава заказа может быть связан технологический маршрут ( бровс по рабочим операциям на элемент заказа с контролем готовности). Чтото подобное делал и стандартный bChange доводил пользователя до истерики, ну не удобно ему поиском.... хочет нажать на кнопочку и следить глазами если не увидел сразу то так и будет ездить туда сюда. Все подчиненные запросы ( сижу на ADS SQL) отработывают мгновенно, а перерисовка всех бровсов не дает быстро ездить да и постоянное мелькание начинает бесить. Вот и возникает необходимость чтобы за этим bChange была слежка со стороны и игнорились слишком частые вызовы, а выполнялся только последний. Вот так и появился таймер.
Петр: SergKis пишет: SyncChild метод ставит ::bChange, т.е. портит установленный, а практически в каждом тсб он занят. Даже этого достаточно, что бы метод не использовать. " А в каких случаях можно использовать SyncChild()? Вот bChange с компанией используется как navigation codeblocks DATA bLine, bSkip, bGoTop, bGoBottom, ; bLogicLen, bChange // navigation codeblocks bLine, bLogicLen, bChange - это navigation codeblocks - ну тоже мало понятно
Петр: Haz пишет: Это все не системно. Может открыть тему Проблема TS - варианты - решение. Как-то я не могу правильно сформулировать свое отношение к предложению. Ну во-первых, скажу честно, tsbrowse я не использую. Поэтому о проблемах TS могу прочитать только на форуме. Т.е. допустим смотрю в код - да, возможно я бы не так написал, но ведь работает.. Или, допустим вопрос поднятый Димой, он вообще-то не к TS относился, за использование ресурсов GUI приложением отвечает разработчик. Во-вторых, вроде никто и не запрещает и сейчас открывать темы - но как-то не задалось, наверное. И так что-бы кто-то внятно описал проблему да еще привел пример - нет не видел
Петр: ММК пишет: С учетом того , что все другие бровсы работают нормально есть смысл посмотреть их и сравнить с TS. Это не о MiniGUI, все остальные бровсы построены на LISTVIEW и обладают ограниченой функциональностью в сравнении с TS или другими словами в MiniGUI есть над чем поработать ММК пишет: Менется , если убирать утечки памяти , хотя возникает она и без использования иконок. Утечка памяти это не абстрактное понятие, все утечки (памяти, USER - GDI object) можно как-то выявить и попытаться локализировать. ММК пишет: Ведь если оставлять этот бровс , то в него еще придется много чего добавлять Опять же, мне кажется, что это не про MiniGUI, на текущем этапе развития TS нет чем заменить.
ММК: Петр пишет: цитата: С учетом того , что все другие бровсы работают нормально есть смысл посмотреть их и сравнить с TS. Это не о MiniGUI, все остальные бровсы построены на LISTVIEW и обладают ограниченой функциональностью в сравнении с TS или другими словами в MiniGUI есть над чем поработать TS был написан лет десять назад для FW. Мануэль Меркадо красиво написал, выложил все исходники , но довести уже не хватило здоровья ( в прямом смысле ). В FW это не единственный бровс поэтому есть с чем сравнивать и ,наверное, есть смысл т.к. эта проблема сохранилась с тех времен. Петр пишет: Утечка памяти это не абстрактное понятие, все утечки (памяти, USER - GDI object) можно как-то выявить и попытаться локализировать. Конечно. Здесь все понятно. Это просто моя неудачная попытка донести свое мнение :) Что проблема связана не с утечкой и не с временной задержкой. Петр пишет: Опять же, мне кажется, что это не про MiniGUI, на текущем этапе развития TS нет чем заменить. :)
Andrey: Всем привет ! Как отцентровать шапку таблицы ? Для ячеек таблицы нашёл как сделать: [pre2] oBrw1:aColumns[5]:nAlign := nMakeLong( DT_CENTER, DT_CENTER ) oBrw1:aColumns[5]:nHAlign := nMakeLong( DT_CENTER, DT_CENTER ) [/pre2]
Dima: Andrey пишет: oBrw1:aColumns[5]:nHAlign := nMakeLong( DT_CENTER, DT_CENTER ) сам и ответил
Andrey: Dima пишет: сам и ответил Не центрует в шапке таблицы картинку ! Может по другому надо ?
Dima: у меня примерно так и вроде ж по центру. oBrw3:GetColumn("prm"):uBmpHead :=abmp3h[2] oBrw3:GetColumn("prm"):cHeading :="" oBrw3:SetColSize("prm", 25 ) oBrw3:GetColumn("prm"):nhAlign :=nMakeLong( DT_CENTER, DT_CENTER )
Andrey: Dima пишет: у меня примерно так и вроде ж по центру. Попробуй 3 штуки (картинки) подряд вывести в заголовок таблицы. Как получиться ? У меня 1-я картинка центрируется, остальные нет.
Dima: Andrey пишет: У меня 1-я картинка центрируется, остальные нет что то не так закодил Пример для одной колонки [pre2] oBrw3:GetColumn( "dels" ):uBmpCell :={|| if( (oBrw3:calias)->dels,abmp3[1],NIL) } oBrw3:GetColumn( "dels" ):lCheckBox := FALSE oBrw3:GetColumn( "dels" ):nAlign :=nMakeLong( DT_CENTER, DT_CENTER ) oBrw3:GetColumn( "dels" ):bdata:={||""} oBrw3:GetColumn("dels"):uBmpHead :=abmp3h[1] oBrw3:GetColumn("dels"):cHeading :="" oBrw3:SetColSize("dels", 25 ) // пробовал 125 - центрует норм oBrw3:GetColumn("dels"):nhAlign :=nMakeLong( DT_CENTER, DT_CENTER ) [/pre2] В бровсе у меня 2 колонки у которых в Header живет BMP , все по центру. Возможно сама BMP у тебя "широкая"
Andrey: Dima пишет: Возможно сама BMP у тебя "широкая" Да нет - все одинаковые 28 пикселей. У меня 4 колонки с картинками. В ячейках нормально центрируются, в шапке таблицы 2 центрируются, 2 нет. Поменял местами и ГЛЮК вылез опять - центрирование в шапке работает только на 2 колонки ! Попробуй у себя добавить (сделать дубль) ещё 2х колонок с картинками....
Dima: Дай полный код 2 и 4 колонки
Andrey: Вот код, обработка полей в цикле: [pre2] FOR nI := 1 TO LEN(aPole) nJ++ ADD COLUMN TO TBROWSE oBrw1 // добавить новую колонку в TBROWSE ........ oBrw1:aColumns[nJ]:lEdit := .T. ........ If cTypeField == "L" // для полей Logic oBrw1:aColumns[nJ]:cHeading := "" // заголовок колонки обнулить oBrw1:SetColSize( nJ, 48 ) // ширина колонкм oCol := oBrw1:aColumns[nJ] oCol:lCheckBox := .T. // virtual checkbox oCol:nEditMove := 0 oCol:cPicture := "" // шаблон колонки убрать oCol:cDataType := "L" // !!! IF cField == "MARK" oCol:uBmpCell := {|| IF( (ALIAS())->MARK, LoadImage("tbCheckT28"), ) } oCol:uBmpHead := {|| LoadImage( "tbCheckF28" ) } // картинка шапки таблицы oCol:aBitMaps := { LoadImage("tbCheckT28") } ELSEIF cField == "PRINT" oCol:uBmpCell := {|| IF( (ALIAS())->PRINT, LoadImage( "TBPRINT32" ), ) } oCol:uBmpHead := {|| LoadImage( "tbPrint32" ) } // картинка шапки таблицы oCol:aBitMaps := { LoadImage("TBPRINT32") } ELSEIF cField == "MAIL1" oCol:uBmpCell := {|| IF( (ALIAS())->MAIL1, LoadImage( "tbMail32" ), ) } oCol:uBmpHead := {|| LoadImage( "tbMail32" ) } // картинка шапки таблицы oCol:aBitMaps := { LoadImage( "tbMail32" ) } ELSEIF cField == "MAIL2" oCol:uBmpCell := {|| IF( (ALIAS())->MAIL2, LoadImage( "tbMail32R" ), ) } // картинка в ячейке oCol:uBmpHead := {|| LoadImage( "tbMail32R" ) } // картинка шапки таблицы oCol:aBitMaps := { LoadImage( "tbMail32R" ) } ENDIF oCol:bData := {||Nil} oCol:cData := '{||Nil}' oCol:nAlign := nMakeLong( DT_CENTER, DT_CENTER ) oCol:nHAlign := nMakeLong( DT_CENTER, DT_CENTER ) // обработка до ввода // обработка после ввода Else ......... NEXT [/pre2]
Dima: Andrey пишет: oCol:uBmpHead := {|| LoadImage( "tbMail32" ) } // картинка шапки таблицы oCol:aBitMaps := { LoadImage( "tbMail32" ) } А вот при таком подходе у тебя будет утечка памяти и уже в этой теме обсуждали. Сделай не в цикле , что то там не стыкуется. Ты ведь в начале писал что центруется правильно только второй Header , остальные нет. По факту правильно отцентрованы 2 и 3 Header
Andrey: Dima пишет: Сделай не в цикле , что то там не стыкуется. Поля все в настройках, без цикла сделать не возможно.... Dima пишет: По факту правильно отцентрованы 2 и 3 Header На картинках же видно 3 и 4 Header не отцентрованы !
Dima: Andrey пишет: nJ++ ADD COLUMN TO TBROWSE oBrw1 // добавить новую колонку в TBROWSE ........ oBrw1:aColumns[nJ]:lEdit := .T. Перенеси это код после Andrey пишет: If cTypeField == "L" // для полей Logic + после ELSE скопируй Весь код не видно ........я не телепат
Andrey: Dima пишет: Весь код не видно ........я не телепат Код как в Tsb_config.
Dima: Andrey Сколько ты там сутки уже справиться не можешь ? Смейся дальше... Сделай простой пример без цикла и убедись что Header с BMP нормально центруется.
Andrey: Dima пишет: Сделай простой пример без цикла и убедись что Header с BMP нормально центруется. Этот пример уже сделал. Центрируется нормально. В цикле не центрируется... Пока бросил с этим разбираться, другая работа появилась.
Dima: Andrey пишет: Этот пример уже сделал. Центрируется нормально. В цикле не центрируется...
i3t4j6: Добрый день! Начиная с декабрьской версии стала появляться такая ошибка: Error BASE/5001 MiniGUI Error: SENDMESSAGE Called from SENDMESSAGE(0) Called from TSBROWSE:RESIZE(9982) Called from TCONTROL:HANDLEEVENT(923) ... Ошибка появляется при вводе новой записи в стандартном TsBrowse. Если забить строку 9982, то ошибка не появляется
gfilatov2002: i3t4j6 пишет: стала появляться такая ошибка Благодарю за сообщение! Добавил дополнительную проверку в строке 9981
Haz: Григорий можно правочку небольшую в METHOD TSBrowse:Edit() Было: [pre2] 3749: If oCol:bPrevEdit != Nil If ::lIsArr .and. ( ::lAppendMode .or. ::nAt > Len( ::aArray ) ) // append mode for arrays ElseIf nKey != VK_RETURN // GF 15-10-2015 Eval( oCol:bPrevEdit, uValue, Self ) EndIf EndIf [/pre2] Хочу: [pre2] 3749: If oCol:bPrevEdit != Nil If ::lIsArr .and. ( ::lAppendMode .or. ::nAt > Len( ::aArray ) ) // append mode for arrays ElseIf nKey != VK_RETURN // GF 15-10-2015 IF !Eval( oCol:bPrevEdit, uValue, Self ) nKey := VK_RETURN END EndIf EndIf [/pre2] PS Привык пользовать ::PrevEdit() и если он возвращает F не пускать в редактирование. В случае с чекбоксом этот прием не работает пока не внести изменения в код
gfilatov2002: Haz пишет: пользовать ::PrevEdit() и если он возвращает F не пускать в редактирование Благодарю за Ваше предложение! Добавил это изменение со следующим комментарием: - a cell with checkbox will respect of return value of bPrevEdit block in the method Edit(). Suggested and contributed by Igor Nazarov.
SergKis: gfilatov2002 пишет Добавил это изменение возможно, делать надо как в методе KeyDown :[pre2] Local uVal ... Line 6562 uVal := Eval( ::aColumns[ nCol ]:bPrevEdit, uVal, Self ) If ValType( uVal ) == "L" .and. ! uVal nKey := VK_RETURN EndIf [/pre2]
SergKis: PS uVal := Eval( ::aColumns[ nCol ]:bPrevEdit, uValue, Self )
gfilatov2002: SergKis пишет: делать надо как в методе KeyDown Благодарю за внимание! Именно так и сделал (с проверкой типа возвращаемого блоком значения): [pre2]... uVar := Eval( oCol:bPrevEdit, uValue, Self ) If ValType( uVar ) == "L" .and. ! uVar nKey := VK_RETURN EndIf [/pre2]
SergKis: gfilatov2002 такую правку предлагаю [pre2] METHOD GoToRec( nRec ) CLASS TSBrowse ... If ( ::cAlias )->( EoF() ) ... Else ( ::cAlias )->( DbGoTo( nRecNo ) ) ::nLastPos := nRecNo ::nAt := ::nLogicPos() While ::nRowPos > 1 ::Skip( -1 ) ::nRowPos -- EndDo While nRecNo != ( ::cAlias )->( RecNo() ) ::Skip( 1 ) ::nRowPos ++ EndDo EndIf ... [/pre2]
Haz: SergKis пишет: такую правку предлагаю Сергей, а зачем аверх вниз гонять? PS просто из любопытства спрашиваю)))
Dima: Haz пишет: Сергей, а зачем аверх вниз гонять? Тоже не понял....
SergKis: Для правильной установки ::nRowPos Просмотр по тегу, ::nRowPos = 18 (::nRowCount() = 20) Добавили запись или переходим на recno выше, к примеру ::nRowPos должен стать 3 Без добавки сейчас (у меня так) запись добавилась выше, а ::nRowPos остался 18
Haz: SergKis пишет: Для правильной установки ::nRowPos В принципе пробег туда - сюда делается оч быстро и если это снимает проблему то почему бы и нет. У меня новая запись почти всегда не в конец добавляется т. к. используется механизм выбора из удаленных.
SergKis: Haz пишет т. к. используется механизм выбора из удаленных. У меня так же, и если тег по наименованию и ситуация как выше, то nRowPos не становился на новую запись, а оставался где были. Два цикла можно, наверно оптимизировать
Haz: SergKis пишет: nRowPos не становился на новую запись Сергей а так ? oBrw:nLen := Eval( oBrw::bLogicLen ) oBrw:Refresh(.T., .T.) // <------------------ на счет этого не уверен тут может моргать таблица oBrw:GotoRecNo( nRec ) Скинь самодостаточный, но проверить смогу под RDDADS тк только им пользуюсь из за SQL
SergKis: Haz пишет Скинь самодостаточный Наконец сделал пример. GotoRec работатет нормально в тек. версии, немного не привычно - выталкивает первую строку экрана (привычнее последнюю) за пределы при заполнении экрана строками полностью, т.е. с GotoRec - в моей версии что то не так (так что исправление это только у меня) - это хорошо. Пример тут http://my-files.ru/vooru4
gfilatov2002: SergKis пишет: сделал пример. GotoRec работает нормально в тек. версии Благодарю за интересный пример
SergKis: gfilatov2002 надо подправить строки (не работает конструкция oCol:cFooting := {|nKol,oBr| ... }) [pre2] Static Function SetHeights( oBrw ) ... line 13090 cHeading := If( Valtype( oColumn:cHeading ) == "B", Eval( oColumn:cHeading ), oColumn:cHeading ) на cHeading := If( Valtype( oColumn:cHeading ) == "B", Eval( oColumn:cHeading, nEle, oBrw ), oColumn:cHeading ) line 13137 cHeading := If( Valtype( oColumn:cFooting ) == "B", Eval( oColumn:cFooting ), oColumn:cFooting ) на cHeading := If( Valtype( oColumn:cFooting ) == "B", Eval( oColumn:cFooting, nEle, oBrw ), oColumn:cFooting ) [/pre2] Григорий, может функ. SetNoHoles(...) сделать методом TsBrowse ? [pre2] CLASS TSBrowse FROM TControl ... METHOD SetNoHoles ( nDelta, lSet ) // BK ... METHOD SetNoHoles( nDelta, lSet ) CLASS TSBrowse LOCAL nH, nK, nHeight, nHole, nHScrollBarHeight := GetHScrollBarHeight() DEFAULT nDelta := 2, lSet := .T. nHole := ::nHeight - ::nHeightHead - ::nHeightSuper - ; ::nHeightFoot - ::nHeightSpecHd - ; If( ::lNoHScroll, 0, nHScrollBarHeight ) nHole -= ( Int( nHole / ::nHeightCell ) * ::nHeightCell ) nHole -= nDelta nHeight := nHole If lSet nH := If( ::nHeightSuper > 0, 1, 0 ) + ; If( ::nHeightHead > 0, 1, 0 ) + ; If( ::nHeightSpecHd > 0, 1, 0 ) + ; If( ::nHeightFoot > 0, 1, 0 ) If nH > 0 nK := int( nHole / nH ) If ::nHeightFoot > 0 ::nHeightFoot += nK nHole -= nK EndIf If ::nHeightSuper > 0 ::nHeightSuper += nK nHole -= nK EndIf If ::nHeightSpecHd > 0 ::nHeightSpecHd += nK nHole -= nK EndIf If ::nHeightHead > 0 ::nHeightHead += nHole EndIf Else SetProperty(::cParentWnd, ::cControlName, "Height", ; GetProperty(::cParentWnd, ::cControlName, "Height") - nHole) EndIf ::Display() EndIf RETURN nHeight [/pre2]
Haz: Сергей - отличный пример я бы сказал что он не сколько на ::GotoRec() сколько на понимание подхода к TS и его составляющим как к объектам SergKis пишет: выталкивает первую строку экрана (привычнее последнюю) за пределы при заполнении экрана строками полностью Выталкивает вверх потому что подбирается к нужной записи снизу If ( ::cAlias )->( EoF() ) означает что ниже нужной записи нет их необходимого количества чтоб заполнить весь бровс начиная с верхней строки Вот тут [pre2]( ::cAlias )->( DbSkip( nLines - ::nRowPos ) ) [/pre2] при этом ::nRowPos всегда 1 после ::Reset() выше и если записей недостаточно то встает на самый конец и скипает вверх. в принципе можно подумать как переделать чтобы всегда подбирался сверху. т.е. проверять есть ли достаточное количество записей перед и после чтобы ::RowPos остался прежним Не знаю насколько это принципиально, но технически исполнимо Алгоритм зависит от воросов 1) Какой ::nRowPos ставить если перед нужной ( той куда идем) записей меньше чем текущий ::nRowPos - вариантов два - ::nRowPos == 1 или логический новой номер нужной записи 2) Какой ::nRowPos ставить если после нужной ( той куда идем) записей меньше чем текущий ::nRowCount - вариантов три - ::nRowPos == 1 (с обрезанием бровса), поледний ::nRowPos == nRowCount или как сейчас текущий с выпихиванием верха
gfilatov2002: SergKis пишет: надо подправить строки Сделал, конечно (поправил функцию SetHeights() и добавил новый метод SetNoHoles(), и Ваш новый пример). Благодарю за помощь P.S. Выход новой мартовской сборки запланирован на следующей неделе
SergKis: Haz пишет Не знаю насколько это принципиально Для пользователя это может быть важным, т.к. имея сорт. по наим. А1 А2 ... А7 Б1 Б2 добавляя А8, А9 выталкиваться будет А1 и А2 вместо Б... а с др. стороны при полном экране на А... верх будет выдавливаться так же
SergKis: gfilatov2002 пишет и Ваш новый пример там убрать над лишнее [pre2] STATIC FUNC Add_Rec( oBrw ) Local cBrw, hBrw, cAls, cPic Local nHgh, nWdt, nPos, cCol, oCol, nLen Local nRow, nCol, oCel, cGet, cVal, nRec Local cKods, cName, cKodP, cNamP, lRefr Local nY , nX , nW , nH Local nX1, nW1, nH1 Local nX2, nW2, nH2 Local cWnd := oBrw:cParentWnd Local hWnd := GetFormHandle(cWnd) Local hInpl := _HMG_InplaceParentHandle _HMG_InplaceParentHandle := hWnd PRIVATE aResult WITH OBJECT oBrw cBrw := :cControlName cAls := :cAlias hBrw := GetWindowRow(GetControlHandle(cBrw, cWnd)) [/pre2]
gfilatov2002: SergKis пишет: там убрать над лишнее Почистил также и другие неиспользуемые переменные, и добавил в заголовке следующие строки для подавления ненужных предупреждений [pre2] FIELD KODS, NAME, ID MEMVAR oBrw, aResult [/pre2]
SergKis: gfilatov2002
SergKis: gfilatov2002 Может в пример добавить использование функции ShowGetValid(...) (сообщение в getbox valid об ошибке) ? Изменения такие [pre2] STATIC FUNC VldNewRec() ... If lSek Tone(500, 1) ShowGetValid(GetControlHandle(cGkd, cWnd), "Kod dublicate", "Error", 'E') // можно 'E'\'I'\'W' InkeyGui(4000) _SetValue(cGkd, cWnd, GetNewKod()) _SetFocus(cGkd, cWnd) ... и добавить #pragma BEGINDUMP #define _WIN32_WINNT 0x0600 #include <windows.h> #include "hbapi.h" #include "hbapicdp.h" #include <commctrl.h> typedef struct _tagEDITBALLOONTIP { DWORD cbStruct; LPCWSTR pszTitle; LPCWSTR pszText; INT ttiIcon; // From TTI_* } EDITBALLOONTIP, *PEDITBALLOONTIP; #define EM_SHOWBALLOONTIP (ECM_FIRST + 3) // Show a balloon tip associated to the edit control #define Edit_ShowBalloonTip(hwnd, peditballoontip) \ (BOOL)SNDMSG((hwnd), EM_SHOWBALLOONTIP, 0, (LPARAM)(peditballoontip)) #define EM_HIDEBALLOONTIP (ECM_FIRST + 4) // Hide any balloon tip associated with the edit control #define Edit_HideBalloonTip(hwnd) \ (BOOL)SNDMSG((hwnd), EM_HIDEBALLOONTIP, 0, 0) // ToolTip Icons (Set with TTM_SETTITLE) #define TTI_NONE 0 #define TTI_INFO 1 #define TTI_WARNING 2 #define TTI_ERROR 3 #if (_WIN32_WINNT >= 0x0600) #define TTI_INFO_LARGE 4 #define TTI_WARNING_LARGE 5 #define TTI_ERROR_LARGE 6 #endif // (_WIN32_WINNT >= 0x0600) #define ECM_FIRST 0x1500 // Edit control messages /* ShowGetValid( hWnd, cText [ , cTitul ] [ , cTypeIcon ] ) */ #if ( HB_VER_MAJOR == 3 ) #define _hb_cdpGetU16( cdp, fCtrl, ch) hb_cdpGetU16(cdp, ch ) #define _hb_cdpGetChar(cdp, fCtrl, ch) hb_cdpGetChar(cdp, ch) #else #define _hb_cdpGetU16( cdp, fCtrl, ch) hb_cdpGetU16(cdp, fCtrl, ch ) #define _hb_cdpGetChar(cdp, fCtrl, ch) hb_cdpGetChar(cdp, fCtrl, ch) #endif HB_FUNC( SHOWGETVALID ) { int i,k; char *tp, *s; WCHAR Text[512]; WCHAR Title[512]; EDITBALLOONTIP bl; PHB_CODEPAGE s_cdpHost = hb_vmCDP(); HWND hWnd = ( HWND ) hb_parnl( 1 ); if( ! IsWindow( hWnd ) ) return; bl.cbStruct = sizeof( EDITBALLOONTIP ); bl.pszTitle = NULL; bl.pszText = NULL; bl.ttiIcon = TTI_NONE; if( HB_ISCHAR( 2 ) ){ ZeroMemory( Text, sizeof(Text) ); k = hb_parclen(2); s = (unsigned char *) hb_parc(2); for(i=0;i<k;i++) Text = _hb_cdpGetU16( s_cdpHost, TRUE, s ); bl.pszText = Text; } if( HB_ISCHAR( 3 ) ){ ZeroMemory( Title, sizeof(Title) ); k = hb_parclen(3); s = (unsigned char *) hb_parc(3); for(i=0;i<k;i++) Title = _hb_cdpGetU16( s_cdpHost, TRUE, s ); bl.pszTitle = Title; } tp = ( char * ) hb_parc(4); switch( *tp ){ case 'E' : bl.ttiIcon = TTI_ERROR_LARGE; break; case 'e' : bl.ttiIcon = TTI_ERROR; break; case 'I' : bl.ttiIcon = TTI_INFO_LARGE; break; case 'i' : bl.ttiIcon = TTI_INFO; break; case 'W' : bl.ttiIcon = TTI_WARNING_LARGE; break; case 'w' : bl.ttiIcon = TTI_WARNING; break; } Edit_ShowBalloonTip( hWnd, &bl ); } #pragma ENDDUMP [/pre2]
SergKis: PS опять пропустил [ i ]. повтор [pre2] #pragma BEGINDUMP #define _WIN32_WINNT 0x0600 #include <windows.h> #include "hbapi.h" #include "hbapicdp.h" #include <commctrl.h> typedef struct _tagEDITBALLOONTIP { DWORD cbStruct; LPCWSTR pszTitle; LPCWSTR pszText; INT ttiIcon; // From TTI_* } EDITBALLOONTIP, *PEDITBALLOONTIP; #define EM_SHOWBALLOONTIP (ECM_FIRST + 3) // Show a balloon tip associated to the edit control #define Edit_ShowBalloonTip(hwnd, peditballoontip) \ (BOOL)SNDMSG((hwnd), EM_SHOWBALLOONTIP, 0, (LPARAM)(peditballoontip)) #define EM_HIDEBALLOONTIP (ECM_FIRST + 4) // Hide any balloon tip associated with the edit control #define Edit_HideBalloonTip(hwnd) \ (BOOL)SNDMSG((hwnd), EM_HIDEBALLOONTIP, 0, 0) // ToolTip Icons (Set with TTM_SETTITLE) #define TTI_NONE 0 #define TTI_INFO 1 #define TTI_WARNING 2 #define TTI_ERROR 3 #if (_WIN32_WINNT >= 0x0600) #define TTI_INFO_LARGE 4 #define TTI_WARNING_LARGE 5 #define TTI_ERROR_LARGE 6 #endif // (_WIN32_WINNT >= 0x0600) #define ECM_FIRST 0x1500 // Edit control messages /* ShowGetValid( hWnd, cText [ , cTitul ] [ , cTypeIcon ] ) */ #if ( HB_VER_MAJOR == 3 ) #define _hb_cdpGetU16( cdp, fCtrl, ch) hb_cdpGetU16(cdp, ch ) #define _hb_cdpGetChar(cdp, fCtrl, ch) hb_cdpGetChar(cdp, ch) #else #define _hb_cdpGetU16( cdp, fCtrl, ch) hb_cdpGetU16(cdp, fCtrl, ch ) #define _hb_cdpGetChar(cdp, fCtrl, ch) hb_cdpGetChar(cdp, fCtrl, ch) #endif HB_FUNC( SHOWGETVALID ) { int i,k; char *tp, *s; WCHAR Text[512]; WCHAR Title[512]; EDITBALLOONTIP bl; PHB_CODEPAGE s_cdpHost = hb_vmCDP(); HWND hWnd = ( HWND ) hb_parnl( 1 ); if( ! IsWindow( hWnd ) ) return; bl.cbStruct = sizeof( EDITBALLOONTIP ); bl.pszTitle = NULL; bl.pszText = NULL; bl.ttiIcon = TTI_NONE; if( HB_ISCHAR( 2 ) ){ ZeroMemory( Text, sizeof(Text) ); k = hb_parclen(2); s = (unsigned char *) hb_parc(2); for(i=0;i<k;i++) Text[ i ] = _hb_cdpGetU16( s_cdpHost, TRUE, s[ i ] ); bl.pszText = Text; } if( HB_ISCHAR( 3 ) ){ ZeroMemory( Title, sizeof(Title) ); k = hb_parclen(3); s = (unsigned char *) hb_parc(3); for(i=0;i<k;i++) Title[ i ] = _hb_cdpGetU16( s_cdpHost, TRUE, s[ i ] ); bl.pszTitle = Title; } tp = ( char * ) hb_parc(4); switch( *tp ){ case 'E' : bl.ttiIcon = TTI_ERROR_LARGE; break; case 'e' : bl.ttiIcon = TTI_ERROR; break; case 'I' : bl.ttiIcon = TTI_INFO_LARGE; break; case 'i' : bl.ttiIcon = TTI_INFO; break; case 'W' : bl.ttiIcon = TTI_WARNING_LARGE; break; case 'w' : bl.ttiIcon = TTI_WARNING; break; } Edit_ShowBalloonTip( hWnd, &bl ); } #pragma ENDDUMP [/pre2]
gfilatov2002: SergKis пишет: Может в пример добавить использование функции ShowGetValid Благодарю за Ваши усилия, но, думаю, что в данном случае нет необходимости в усложнении этого примера Кстати, эта функция уже использовалась в одном из примеров, которые прислал Андрей: - в папке Basic\COMM_2
Haz: SergKis пишет: GotoRec работатет нормально в тек. версии, немного не привычно - выталкивает первую строку экрана (привычнее последнюю) Сергей, посмотрел исходнички и вот чего увидел: GotoRec ничего не знает о том что сделали с базой ( добавили запись , фильтранули или просто скипнули куда то и пр)., соответственно проблематично отследить что на рабочем поле бровса появилать новая запись и выталкивать нужно вниз от новой записи. Можно сохранить тот же ::RowPos т.к. он известен достоверно, но корректно сохранить первую строку я не придумал как. Пример ( база отсортирована по отображаемому полю): в базе есть пять значений C текущее , в бровсе 4 строки ( видим с A до D ) ----- A B C <- D ----- E Добавили значение C1 через dbAppend и оно стало текущей записью вместо С и встало после С Если сделать у С1 ::RowPos = 3 то вытолкнем А вверх за пределы бровса и проанализировать то нечего т.к. в данном случае мы знаем только 1) номер записи текущей после добавления 2) номер записи С как ::nLastPos но не знаем какая была первой (если анализировать сверху ) или последней (если снизу) в бровсе, чтобы понять куда и что вытолкнуть , не заем сколько записей добавили или удали. Все что можно сделать в GoToRec так это на выбор 1) Сохранить ::nRowPos 2) Сделать его = 1 2) Сделать его = ::nRowCount() PS я бы предпочел вариант 1 и новый метод ::AddRec() который добавляет запись и правильно ее позиционирует с учетом установок до добавления. И то при совместной работе возможны сюрпризы типа ... рассчитал нужный RowPos , а тебя опередил кто то и впихнул пачку записей
SergKis: gfilatov2002 пишет эта функция уже использовалась в одном из примеров, которые прислал Андрей По тому примеру не очень ясно основное назначение функции - работа в valid GetBox-ов. Но если усложняет, то тогда не надо.
SergKis: Haz пишет возможны сюрпризы типа ... рассчитал нужный RowPos , а тебя опередил кто то и впихнул пачку записей Игорь, в тек. версии миниГуи GotoRec работает приемлемо и действительно управляется через установку nRowPos до GotoRec. Просто в моей версии тсб 7.0 в базе и доводка мной до приближения к тсб 9.0. Получается при всей похожести кода есть разница, но это уже моя головная боль. GotoRec у себя уже подправил и управление через nRowPos тоже работает, может, в некоторых случаях, не так как в тсб 9.0, но похоже. Спасибо за участие.
SergKis: Для информации. В представленном выше примере, после добавления записи для включения Edit на след. колонке надо сделать :[pre2] If ! empty(aResult) dbSelectArea(cAls) dbAppend() If ! NetErr() .and. RLock() nRec := RecNo() REPL KODS with aResult[1], ; NAME with aResult[2] if oBrw:nLen == oBrw:nRowCount() oBrw:oHScroll:SetRange(0,0) EndIf oBrw:GotoRec(nRec) nCol := oBrw:nColumn("NAM") If nCol != oBrw:nCell oBrw:nCell := nCol oBrw:DrawSelect() EndIf oBrw:lChanged := .T. oBrw:PostEdit(aResult[2], nCol, Nil ) DO EVENTS oBrw:PostMsg(WM_KEYDOWN, VK_F4, 0) EndIf EndIf [/pre2]
SergKis: Сделал Tsb_addrecord_3 с удалением F3. [pre2] /* * MINIGUI - Harbour Win32 GUI library Demo * */ #include "minigui.ch" #include "tsbrowse.ch" REQUEST DBFCDX FIELD KODS, NAME, ID MEMVAR oBrw, aResult *----------------------------------- PROCEDURE Main() *----------------------------------- LOCAL i, oCol, aStru, cAls, cBrw LOCAL cFile := "datab" RddSetDefault("DBFCDX") SET CENTURY ON SET DATE GERMAN SET DELETED ON SET EXCLUSIVE ON SET EPOCH TO 2000 SET AUTOPEN ON SET EXACT ON SET SOFTSEEK ON SET NAVIGATION EXTENDED SET FONT TO "Arial", 11 aStru := { ; { "KODS", "C", 10, 0 }, ; { "NAME", "C", 15, 0 }, ; { "EDIZ", "C", 10, 0 }, ; { "KOLV", "N", 15, 3 }, ; { "CENA", "N", 15, 3 }, ; { "ID" , "+", 4, 0 } ; } IF ! hb_FileExists( cFile + ".dbf" ) dbCreate( cFile, aStru ) ENDIF USE datab ALIAS base NEW IF LastRec() == 0 FOR i := 10 TO 1 STEP -1 APPEND BLANK REPLACE KODS WITH hb_ntos(i), ; NAME WITH RandStr(15), ; EDIZ WITH 'kg', ; KOLV WITH RecNo() * 1.5, ; CENA WITH RecNo() * 2.5 NEXT ENDIF dbGoTop() IF ! hb_FileExists( cFile + IndexExt() ) INDEX ON TR0(KODS) TAG KOD FOR ! deleted() INDEX ON UPPER(NAME) TAG NAM FOR ! deleted() INDEX ON ID TAG FRE FOR deleted() EndIf OrdSetFocus("NAM") dbGoTop() cALs := Alias() GO TOP DEFINE FONT FontBold FONTNAME _HMG_DefaultFontName ; SIZE _HMG_DefaultFontSize BOLD // Default for TsBrowse PRIVATE oBrw DEFINE WINDOW win_1 AT 0, 0 WIDTH 650 HEIGHT 500 ; MAIN TITLE "TSBrowse Add Record Demo" ; NOMAXIMIZE NOSIZE ; ON INIT NIL ; ON RELEASE dbCloseAll() DEFINE TBROWSE oBrw AT 40, 10 ALIAS cAls WIDTH 620 HEIGHT 418 CELL WITH OBJECT oBrw cBrw := :cControlName :hFontHead := GetFontHandle( "FontBold" ) :hFontFoot := :hFontHead :lCellBrw := .T. :aColSel := { "KODS", "NAME", "KOLV", "CENA", "ID" } :LoadFields(.T.) :SetColor( { 6 }, { { |a,b,c| If( c:nCell == b, {Rgb( 66, 255, 236), Rgb(209, 227, 248)}, ; {Rgb(220, 220, 220), Rgb(220, 220, 220)} ) } } ) oCol := :GetColumn('KODS') oCol:lEdit := .F. oCol:cHeading := "Product"+CRLF+"code" oCol:cOrder := "KOD" oCol:lNoDescend := .T. oCol:nAlign := 1 oCol:nFAlign := 1 oCol:cFooting := {|nc| nc := (oBrw:cAlias)->( OrdKeyNo() ), ; iif( empty(nc), '', '#'+hb_ntos(nc) ) } oCol := :GetColumn('NAME') oCol:cHeading := "Denomination" oCol:cOrder := "NAM" oCol:nWidth := 190 oCol:lNoDescend := .T. oCol:lOnGotFocusSelect := .T. oCol:lEmptyValToChar := .T. oCol:bPrevEdit := { |val,brw| Prev(val,brw) } oCol:bPostEdit := { |val,brw| Post(val,brw) } oCol := :GetColumn('KOLV') oCol:cHeading := "Amount" oCol:lOnGotFocusSelect := .T. oCol:lEmptyValToChar := .T. oCol:bPrevEdit := { |val,brw | Prev(val,brw ) } oCol:bPostEdit := { |val,brw,add| Post(val,brw,add) } oCol := :GetColumn('CENA') oCol:cHeading := "Price"+CRLF+"for unit" oCol:lOnGotFocusSelect := .T. oCol:lEmptyValToChar := .T. oCol:bPrevEdit := { |val,brw | Prev(val,brw ) } oCol:bPostEdit := { |val,brw,add| Post(val,brw,add) } oCol := :GetColumn('ID') oCol:lEdit := .F. oCol:nWidth := 60 oCol:cHeading := "Id" oCol:cPicture := '99999' oCol:nAlign := 1 oCol:nFAlign := 1 oCol:cFooting := {|nc| nc := (oBrw:cAlias)->( OrdKeyCount() ), ; iif( empty(nc), '', hb_ntos(nc) ) } :aSortBmp := { LoadImage("br_up.bmp"), LoadImage("br_dn.bmp") } :SetIndexCols( :nColumn('KODS'), :nColumn('NAME') ) :SetOrder( :nColumn('NAME') ) AEval( :aColumns, {|oCol| oCol:lFixLite := .T. } ) :lNoGrayBar := .T. :nWheelLines := 1 :nClrLine := COLOR_GRID :nHeightCell += 5 :nHeightHead += 5 :nHeightFoot := :nHeightCell + 5 :lDrawFooters := .T. :lFooting := .T. :lNoVScroll := .F. :lNoHScroll := .T. :nFreeze := 1 :lLockFreeze := .T. :SetDeleteMode(.T., .F.) :bChange := {|oBr| oBr:DrawFooters() } :bUserKeys := {|nKy,nFl,oBr| OnKeyDown(nKy, nFl, oBr) } :bLDblClick := {|uP1,uP2,nFl,oBr| uP1 := Nil, uP2 := Nil, nFl := Nil, ; oBr:PostMsg( WM_KEYDOWN, VK_F4, 0 ) } :nFireKey := VK_F4 // default Edit if :nLen > :nRowCount() :ResetVScroll( .T. ) :oHScroll:SetRange(0,0) EndIf END WITH END TBROWSE @ 06, 10 BUTTON BADD CAPTION "Add F2" ACTION oBrw:PostMsg( WM_KEYDOWN, VK_F2, 0 ) @ 06, 110 BUTTON BDEL CAPTION "Del F3" ACTION oBrw:PostMsg( WM_KEYDOWN, VK_F3, 0 ) @ 06, 210 BUTTON BEDIT CAPTION "Edit F4" ACTION oBrw:PostMsg( WM_KEYDOWN, VK_F4, 0 ) @ 06, 310 BUTTON BORD CAPTION "Order F6" ACTION oBrw:PostMsg( WM_KEYDOWN, VK_F6, 0 ) @ 0, 0 GETBOX DELETE HEIGHT 5 WIDTH 7 VALUE "" ; BACKCOLOR {RED, RED, RED} INVISIBLE END WINDOW oBrw:SetNoHoles() oBrw:SetFocus() CENTER WINDOW win_1 ACTIVATE WINDOW win_1 RETURN FUNCTION TR0( c ) RETURN PADL(AllTrim(c), len(c)) *----------------------------------- FUNCTION RandStr( nLen ) *----------------------------------- LOCAL cSet := "qwertyuiopasdfghjklzxcvbnmQWERTYUIOPASDFGHJKLZXCVBNM" LOCAL cPass := "" LOCAL i If pCount() < 1 cPass := " " Else FOR i := 1 TO nLen cPass += SubStr( cSet, Random( 52 ), 1 ) NEXT EndIf RETURN cPass *----------------------------------- STATIC FUNCTION Prev( uVal, oBrw ) *----------------------------------- Local nCol, oCol WITH OBJECT oBrw nCol := :nCell oCol := :aColumns[ nCol ] oCol:Cargo := uVal // old value END WITH RETURN .T. *----------------------------------- STATIC FUNCTION Post( uVal, oBrw ) *----------------------------------- Local nCol, oCol, cNam, uOld, lMod, cAls WITH OBJECT oBrw nCol := :nCell oCol := :aColumns[ nCol ] cNam := oCol:cName uOld := oCol:Cargo // old value lMod := ! uVal == uOld // .T. - modify value cAls := :cAlias END WITH RETURN .T. *----------------------------------- STATIC FUNC OnKeyDown( nKey, nFlg, oBrw ) *----------------------------------- Local uRet, cOrd nFlg := Nil If nKey == VK_RETURN uRet := .F. oBrw:SetFocus() ElseIf nKey == VK_F2 Add_Rec(oBrw) oBrw:SetFocus() ElseIf nKey == VK_F3 Del_Rec(oBrw) oBrw:SetFocus() uRet := .F. ElseIf nKey == VK_F4 oBrw:SetFocus() ElseIf nKey == VK_F6 WITH OBJECT oBrw cOrd := (:cAlias)->( OrdSetFocus() ) :SetOrder( :nColumn(iif( cOrd == "KOD", 'NAME', 'KODS' )) ) :SetFocus() END WITH EndIf RETURN uRet *----------------------------------- STATIC FUNC Del_Rec( oBrw ) *----------------------------------- Local oCel, nY, nX, nH, nK, lNoG WITH OBJECT oBrw lNoG := :lNoGrayBar oCel := :GetCellInfo(:nRowPos, :nColumn("KODS")) nY := oCel:nRow nX := oCel:nCol nH := oCel:nHeight :lNoGrayBar := .F. win_1.DELETE.Row := nY + 2 win_1.DELETE.Col := nX + 2 win_1.DELETE.Height := nH - 4 win_1.DELETE.Show() win_1.DELETE.SetFocus() DO EVENTS ShowGetValid( win_1.DELETE.Handle, " Y - delete ", 'DELETE RECORD', 'E' ) nK := InkeyGui(10 * 1000) win_1.DELETE.Hide() :lNoGrayBar := lNoG If nK == 89 // .or. nK == 13 :DeleteRow(.F.) EndIf END WITH RETURN Nil *----------------------------------- STATIC FUNC Add_Rec( oBrw ) *----------------------------------- Local cBrw, cAls Local nWdt, nPos, nLen Local nRow, nCol, nRec, oCel Local cKods, cName, cKodP, cNamP Local nY , nX , nW , nHgt Local nX1, nW1 Local nX2, nW2 Local cWnd := oBrw:cParentWnd Local hWnd := GetFormHandle(cWnd) Local hInpl := _HMG_InplaceParentHandle _HMG_InplaceParentHandle := hWnd PRIVATE aResult WITH OBJECT oBrw cBrw := :cControlName cAls := :cAlias nRow := :nTop + GetWindowRow(hWnd) - GetBorderHeight() nCol := :nLeft + GetWindowCol(hWnd) - GetBorderWidth () + 1 nPos := iif( :nLen < :nRowCount(), :nLen, :nRowCount() ) oCel := :GetCellInfo(nPos, :nColumn("KODS")) nY := oCel:nRow + :nHeightCell nX := oCel:nCol nW := oCel:nWidth nHgt := :nHeightCell nWdt := nW nW1 := nW - 4 nX1 := 1 oCel := :GetCellInfo(nPos, :nColumn("NAME")) nW := oCel:nWidth nW2 := nW nWdt += nW END WITH nRow += nY nCol += nX nLen := len( (cAls)->KODS ) cKods := GetNewKod() cKodP := "@K "+repl('9', nLen) nLen := len( (cAls)->NAME ) cName := space(nLen) cNamP := "@K "+repl('X', nLen) DEFINE WINDOW wNewRec ; AT nRow, nCol WIDTH nWdt HEIGHT nHgt TITLE '' ; MODAL NOSIZE NOSYSMENU NOCAPTION ; ON INIT ( This.Topmost := .T., InkeyGui(10), ; This.Topmost := .F. ) ; @ 0, nX1 GETBOX KODS HEIGHT nHgt WIDTH nW1 VALUE cKods PICTURE cKodP VALID VldNewRec() nX2 := This.KODS.Width + nX1 + 1 @ 0, nX2 GETBOX NAME HEIGHT nHgt WIDTH nW2 VALUE cName PICTURE cNamP VALID VldNewRec() ON KEY ESCAPE ACTION ThisWindow.Release END WINDOW ACTIVATE WINDOW wNewRec _HMG_InplaceParentHandle := hInpl If ! Empty(aResult) dbSelectArea(cAls) dbAppend() If ! NetErr() .and. RLock() nRec := RecNo() REPL KODS with aResult[1], ; NAME with aResult[2] If oBrw:nLen == oBrw:nRowCount() oBrw:oHScroll:SetRange(0,0) EndIf oBrw:GotoRec(nRec) nCol := oBrw:nColumn("NAME") If nCol != oBrw:nCell oBrw:nCell := nCol oBrw:DrawSelect() EndIf oBrw:lChanged := .T. oBrw:PostEdit(aResult[2], nCol, Nil) DO EVENTS oBrw:PostMsg(WM_KEYDOWN, VK_F4, 0) EndIf EndIf RETURN Nil *----------------------------------- STATIC FUNC GetNewKod() *----------------------------------- Local cAls := oBrw:cAlias Local nLen := len( (cAls)->KODS ) RETURN left(hb_ntos((cAls)->( OrdKeyCount() )+1)+space(nLen), nLen) *----------------------------------- STATIC FUNC VldNewRec() *----------------------------------- Local cWnd := _HMG_ThisFormName Local cGet := _HMG_ThisControlName Local cAls := oBrw:cAlias Local lRet := .T., lSek, cOrd Local cVal := _GetValue(cGet, cWnd) Local cGkd := 'KODS', cKod If empty(cVal) lRet := .F. ElseIf cGet == cGkd ElseIf cGet == 'NAME' cKod := _GetValue(cGkd, cWnd) cOrd := OrdSetFocus("KOD") lSek := (cAls)->( dbSeek(TR0(cKod)) ) OrdSetFocus(cOrd) If lSek Tone(500, 1) _SetValue(cGkd, cWnd, GetNewKod()) _SetFocus(cGkd, cWnd) aResult := NIL Else aResult := { cKod, cVal } DoMethod(cWnd, 'Release') EndIf EndIf RETURN lRet #pragma BEGINDUMP #define _WIN32_WINNT 0x0600 #include <windows.h> #include "hbapi.h" #include "hbapicdp.h" #include <commctrl.h> typedef struct _tagEDITBALLOONTIP { DWORD cbStruct; LPCWSTR pszTitle; LPCWSTR pszText; INT ttiIcon; // From TTI_* } EDITBALLOONTIP, *PEDITBALLOONTIP; #define EM_SHOWBALLOONTIP (ECM_FIRST + 3) // Show a balloon tip associated to the edit control #define Edit_ShowBalloonTip(hwnd, peditballoontip) \ (BOOL)SNDMSG((hwnd), EM_SHOWBALLOONTIP, 0, (LPARAM)(peditballoontip)) #define EM_HIDEBALLOONTIP (ECM_FIRST + 4) // Hide any balloon tip associated with the edit control #define Edit_HideBalloonTip(hwnd) \ (BOOL)SNDMSG((hwnd), EM_HIDEBALLOONTIP, 0, 0) // ToolTip Icons (Set with TTM_SETTITLE) #define TTI_NONE 0 #define TTI_INFO 1 #define TTI_WARNING 2 #define TTI_ERROR 3 #if (_WIN32_WINNT >= 0x0600) #define TTI_INFO_LARGE 4 #define TTI_WARNING_LARGE 5 #define TTI_ERROR_LARGE 6 #endif // (_WIN32_WINNT >= 0x0600) #define ECM_FIRST 0x1500 // Edit control messages /* ShowGetValid( hWnd, cText [ , cTitul ] [ , cTypeIcon ] ) */ #if ( HB_VER_MAJOR == 3 ) #define _hb_cdpGetU16( cdp, fCtrl, ch) hb_cdpGetU16(cdp, ch ) #define _hb_cdpGetChar(cdp, fCtrl, ch) hb_cdpGetChar(cdp, ch) #else #define _hb_cdpGetU16( cdp, fCtrl, ch) hb_cdpGetU16(cdp, fCtrl, ch ) #define _hb_cdpGetChar(cdp, fCtrl, ch) hb_cdpGetChar(cdp, fCtrl, ch) #endif HB_FUNC( SHOWGETVALID ) { int i,k; char *tp, *s; WCHAR Text[512]; WCHAR Title[512]; EDITBALLOONTIP bl; PHB_CODEPAGE s_cdpHost = hb_vmCDP(); HWND hWnd = ( HWND ) hb_parnl( 1 ); if( ! IsWindow( hWnd ) ) return; bl.cbStruct = sizeof( EDITBALLOONTIP ); bl.pszTitle = NULL; bl.pszText = NULL; bl.ttiIcon = TTI_NONE; if( HB_ISCHAR( 2 ) ){ ZeroMemory( Text, sizeof(Text) ); k = hb_parclen(2); s = (unsigned char *) hb_parc(2); for(i=0;i<k;i++) Text[ i ] = _hb_cdpGetU16( s_cdpHost, TRUE, s[ i ] ); bl.pszText = Text; } if( HB_ISCHAR( 3 ) ){ ZeroMemory( Title, sizeof(Title) ); k = hb_parclen(3); s = (unsigned char *) hb_parc(3); for(i=0;i<k;i++) Title[ i ] = _hb_cdpGetU16( s_cdpHost, TRUE, s[ i ] ); bl.pszTitle = Title; } tp = ( char * ) hb_parc(4); switch( *tp ){ case 'E' : bl.ttiIcon = TTI_ERROR_LARGE; break; case 'e' : bl.ttiIcon = TTI_ERROR; break; case 'I' : bl.ttiIcon = TTI_INFO_LARGE; break; case 'i' : bl.ttiIcon = TTI_INFO; break; case 'W' : bl.ttiIcon = TTI_WARNING_LARGE; break; case 'w' : bl.ttiIcon = TTI_WARNING; break; } Edit_ShowBalloonTip( hWnd, &bl ); } #pragma ENDDUMP [/pre2]
Dima: SergKis пишет: nCol := oBrw:nColumn("NAM") Вероятно нужно oBrw:nColumn("NAME")
SergKis: Dima пишет Вероятно нужно oBrw:nColumn("NAME") Да, c Григорием уже сегодня cписались http://clipper.borda.ru/?1-1-0-00000495-000-100-0-1490094063 и в пред. посте подправлено тоже
Andrey: Слушайте, а почему бы не добавить возможность в Tsb прорисовку пустой таблицы ? Или фон таблицы сделать из картинки ?
Vlad04: пустой таблицы Нет данных или структура не определена ?
Andrey: Хочется несколько вариантов: 1) Данные есть, структура определена, но при первом показе хочется открывать базу с пустыми графами таблицы. 2) Если нет данных по фильтру по базе - то показывается таблица без граф (разделительных линей нет) - не совсем красиво, юзер не понимает почему таблица пустая... Вот в этом случае и нужно выводить пустую таблицу или картинку-фон в таблице.
Haz: Andrey пишет: Хочется несколько вариантов: А как объяснить пользователю почему курсор не идет ниже последней заполненной ??? там же еще много пустых По сути вопроса сделать то очень легко [pre2] в METHOD Paint() после этого If ::lAppendMode .and. ::nLen == ::nRowPos .and. ::nRowPos < nLines ::DrawLine( ++ ::nRowPos ) EndIf Добавить это If ::nLen < ::nRowCount() n := ::nRowPos m := (::cAlias)->(RecNo()) k := ::nLen ::nRowPos := ::nLen (::cAlias)->(dbGoBottom()) (::cAlias)->(dbSkip(1)) While ::nRowPos < ::nRowCount() ::nLen++ ::DrawLine( ++ ::nRowPos ) END ::nRowPos := n (::cAlias)->(dbGoto(m)) ::nLen := k EndIf ЗЫ и не забыть в начале метода объявить переменные local m,n,k можно еще и флаг добавить ::lPhantomGrid := .F. чтобы код выше выполнялся только когда obrw:lPhantomGrid := .T. [/pre2] мне как сейчас больше нравится Ну а с картинками и сам справишься - окно бровса известно, если фильтр выдал пусто то рисуй или пиши в это окно чего надо
Dima: Haz пишет: мне как сейчас больше нравится +1
SergKis: Haz пишет А как объяснить пользователю почему курсор не идет ниже последней заполненной ??? там же еще много пустых Полностью согласен У себя делаю принудительно :nLen := 1 (при пустой базе\выборке) ставлю в колонках oCol:lEmptyValToChar := .T. и в процедурах на клавишах (кроме добавления новой записи) делаю проверку IF (:cAlias)->( BOF() ) .and. (:cAlias)->( EOF() ); RETURN .F. ENDIF тогда одна пустая (Selected) линия есть всегда в тсб. Еще можно оставаться на окне запроса к выборке, выдав сообщение "Нет дааных запроса" и не входить в процедуру с тсб.
Andrey: Haz , SergKis - СПАСИБО БОЛЬШОЕ !
Andrey: Всем привет ! Вот возник вопрос - как закрасить виртуальный столбец другим цветом ? А то этот столбец наверное использует цвет последнего столбца в таблице.
полная версия страницы