Форум » 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: Andrey пишет: Народ, подскажите как убрать белизну Решил вопрос ? Тоже попал на это
Dima: Подсказали добрые люди oBrw:hBrush := CreateSolidBrush( 210, 210, 210 ) // заливаем чем надо
Dima: Понадобилось сделать полноэкранный курсор. Сделал oBrw:lCellBrw :=.F. Пашет , но пропал курсорчик который на CELL , то есть нужен курсор внутри полноэкранного курсора , что бы видеть в какой колонке стоим. В консоли без проблем а тут как ? Сделал авторастяжение колонки 6 oBrw:nAdjColumn := 6 Это не работает если oBrw:lNoHScroll := TRUE , какая связь nAdjColumn с гор. скролом не пойму.
SergKis: Dima пишет: нужен курсор внутри полноэкранного надо работать в режиме CELL и красить нужным цвеьом тек. строку row
Dima: SergKis красить через Method TSBrowse: SetColor() ? Вот это в каком положении должно быть oBrw:lCellBrw ?
SergKis: Dima oBrw:lCellBrw := .T. SetColor() см. надо для 1,2,5,6,11,12 сам только думал попробовать - реально не делал
Dima: SergKis Что то пока понять не могу как это правильно сделать. В примерах (все пересмотрел) ни чего подобного нет а оно надо.
SergKis: Dima Farом поищи в samples\advanced :SetColor( будет список применения на разные ситуации - надо смотреть эти примеры
SergKis: Dima oBrw:SetColor( { 1 }, { { || CLR_BLACK } } ) // 1 , текста в ячейках таблицы oBrw:SetColor( { 2 }, { { || MyRGB(aBack2) } } ) // 2 , фона в ячейках таблицы oBrw:SetColor( { 5 }, { { || CLR_BLACK } } ) // 5 , текста курсора, текст в ячейках с фокусом oBrw:SetColor( { 6 }, { { || { 4915199,255} } } ) // 6 , фона курсора oBrw:SetColor( { 11 }, { { || CLR_GRAY } } ) // 11, текста неактивного курсора (selected cell no focused) oBrw:SetColor( { 12 }, { { || { RGB(255,255,74), RGB(240,240,0)}} } ) // 12, фона неактивного курсора (selected cell no focused) у Andrey в примере есть такое
Dima: SergKis пишет: oBrw:SetColor( { 11 }, { { || CLR_GRAY } } ) // 11, текста неактивного курсора (selected cell no focused) oBrw:SetColor( { 12 }, { { || { RGB(255,255,74), RGB(240,240,0)}} } ) // 12, фона неактивного курсора (selected cell no focused) Вот эти фичи как раз и не срабатывают......
Andrey: Dima пишет: Вот эти фичи как раз и не срабатывают...... Я тоже наткнулся на не срабатывания этого кода. Нужно ставить эти цвета ПОСЛЕ всех обработок до выхода из процедуры. Типа: oBrw3:bKeyDown := { | nKey | MyKeyAction3(nKey,oBrw9, ThisWindow.Name, 0), lOk := nKey != VK_ESCAPE } oBrw3:bLDblClick:= { || MyAction3(oBrw9, ThisWindow.Name, 0) } // Двойной клик мышки на МАРКЕРЕ oBrw3:SetColor( { 16 }, { { || { RGB(0,54,94) , RGB(aBack2[1],aBack2[2],aBack2[3]) } } } ) oBrw3:SetColor( { 17 }, { { || CLR_WHITE } } ) // 17, текста спецхидер oBrw3:Refresh(.T.) //oBrw3:nAt := 5 // передвинуть МАРКЕР на 5 строку oBrw3:nCell := 4 // передвинуть МАРКЕР на 3 колонку //oBrw3:GoPos( 5,3 ) // передвинуть МАРКЕР на 5 строку и 3 колонку SetProperty(ThisWindow.Name, "oBrw3", "Setfocus" ) RETURN NIL Смотри пример с многострочным браузером - https://cloud.mail.ru/public/DkoH/nSzvMbeCh
SergKis: Dima наверно тут, усложнив, выражение надо копать (раскраска четных\нечетных строк) oBrw5:SetColor( { 2 }, { { || iif( oBrw5:nAt % 2 == 0, RGB(255,255,255), RGB(230, 230, 230) ) }})
SergKis: PS. и ON CHANGE
Dima: SergKis пишет: наверно тут, усложнив, выражение надо копать (раскраска четных\нечетных строк) oBrw5:SetColor( { 2 }, { { || iif( oBrw5:nAt % 2 == 0, RGB(255,255,255), RGB(230, 230, 230) ) }}) Видимо да , только условие там правильное надо задать. Типа бровс в фокусе и NROW == не понятно с чем сравнить ЗЫ Has предлагает все делать в скипере.......это просто идея.
Dima: Вот так красит строку oBrw:SetColor( { 2 }, { { || iif( obrw:nat == obrw:nRowPos, RGB(255, 255, 159),RGB(255,255,255) ) }}) Но курсор вниз (вверх) и окраска остается..........на строках где ранее полежал курсор...
SergKis: Dima добавь к этому oBrw:bChange := {|| oBrw:Refresh(.F.) }
Dima: SergKis пишет: oBrw:bChange := {|| oBrw:Refresh(.F.) } Спасибо ! Работает . Но фон курсора на ячейке синий и белые буковки........я это не назначал. Где крутить гайки ?
SergKis: Dima пишет:Где крутить гайки ? тут oBrw:SetColor( { 5 }, { { || CLR_BLACK } } ) // 5 , текста курсора, текст в ячейках с фокусом oBrw:SetColor( { 6 }, { { || { 4915199,255} } } ) // 6 , фона курсора назначены по умолчанию в oBrw:New(...) aTmpColor[ 5 ] := GetSysColor( COLOR_CAPTIONTEXT ), ; // nClrForeFocu aTmpColor[ 6 ] := GetSysColor( COLOR_ACTIVECAPTION ) // nClrFocuBack
Dima: SergKis С этим разобрался. Сенкс. А как быть с oBrw:nAdjColumn , вроде ж должно автоматом выравнивать ширину колонки под ширину бровса и все колонки должны вписаться в ширину бровса. Колонок не много 10 штук с суперхеадером. Но нормально не вписывается да и часть колонок уходит за пределы видимости и нужно скролить вправо что бы их увидеть. Задача простая , вписать все колонки четко в ширину бровса. На ум приходит следующая идея. Задать фиксированную ширину 9-и колонкам а затем присвоить ширину 10-ой колонке которая будет равна Ширина бровса - ширины 9-и колонок. Правильный подход или можно как то проще реализовать ?
SergKis: Dima пишет:Правильный подход или можно как то проще реализовать ? Я TsBrowse, как ты Mdi отложил в ящик, использую Browse без горизонтального скролинга колонок (но на mdi окнах). oBrw:nAdjColumn не пробовал (руки не дошли), но она на одну колонку (может и не так), т.е. на первом экране, а следующие - уже твои проблеммы. Можно ли подключать блоки кода на горизонт. скролинг (клавиши\мыша, для пересчета размеров видимых\невидимых колонок) не знаю. В Browse (модиф. своя версия) делаем так: - определяем колонки для скролинга (размер колонки для "нормального" показа всех прокручиваемых данных) - width размер browse от колонок по окну (всегда, когда нет других контролов справа от browse) или считаем %-том от размера поля ширину в пиксклях, или просто задать от балды - поправят как надо мышой. - клиент мышой может менять ширину любой колонки - это сохраняется в cfg под именем окна+browse и при след. входе в окно размеры колонок беруться от cfg (с mdi main окном и modal окнами, также размеры можно менять, сохраняются в cfg под именем окна) - и при горизонт. скролинге (от номера скролинга) меняется выражение показа всей строки
Dima: SergKis Понял !
Dima: Не очень понял как цеплять к ячейке BMP[ICO] из ресурса по условию. Может кто покажет простой пример или намек ?
Andrey: Допустим в базе есть поле Field->NEVENT (1,2,3,4,...) и по условию нужно показывать разные иконки. Можно так: ////////////////////////////////////////////////////////////// // Выбор отображаемой иконки FUNCTION SetNumIcons() LOCAL RetBmp, mNEVENT := Field->NEVENT, ii ,RetIcon STATIC arrBmp:={},arrNameBmp:={} DO CASE CASE NEVENT = 0 RetIcon:="bEVENT0" CASE NEVENT = 1 RetIcon:="bEVENT1" CASE NEVENT = 2 RetIcon:="bEVENT2" CASE NEVENT = 3 RetIcon:="bEVENT3" OTHERWISE RetIcon:="bEVENT0" ENDCASE ii:=ascan(arrNameBmp,Reticon) if ii>0 RetBmp:=arrBmp[ii] else RetBmp:= LOADIMAGE(RetIcon) if !empty(RetBmp) aadd(arrBmp,RetBmp) aadd(arrNameBmp,RetIcon) endif endif RETURN RetBmp Тогда в бровсе назначай поле показа на 4 поле: // "Массив иконок bmp" aBmp := {,,,"SetNumIcons()"} IF LEN(aBmp) > 0 For ii:=1 to Len(aBmp) if !Empty(aBmp[ii]) &cBrw:aColumns[ii]:uBmpCell := &("{||"+aBmp[ii]+"}") &cBrw:aColumns[ii]:nAlign := nMakeLong( DT_CENTER, DT_CENTER ) endif Next ENDIF Но у меня пример уж очень мудрённый, через ини-файл считывание полей, обработки и т.д. Посмотри сам - https://cloud.mail.ru/public/Qimr/KjE9KUhcN
Dima: Andrey Сенкс. Надо было сразу суть объяснить (это 3 строки ) , ну да ладно сам понял.
Dima: Подсунул прозрачный BMP и вывел в колонке , упс а у него есть свой фон. Если ту же BMP вывести на кнопке , все нормально. Как избавится от фона в бровсе для BMP ?
Haz: Andrey пишет: Но у меня пример уж очень мудрённый, и более того , в процедуре по ON CHANGE есть вызов Refresh() , что 100% приводит к зависаниюбровса стоит его прогнать стрелками вниз/вверх
SergKis: Dima Haz пишет: по ON CHANGE есть вызов Refresh() , что 100% приводит к зависаниюбровса стоит его прогнать стрелками вниз/вверх Мой (твой) пример Refresh(.F.) к зависанию не приводит, но по pgup или up ниже последней и назад - ломается веделенная закраска всей строки с фокусно ячейкой. Как то похитрее надо делать, может быть мтодом DrawLine(xRow) с цветами на пред.стоку и тек., без бутылки сразу не разберешься
Dima: Помогите с BMP разобраться О первой колонке с галей говорю. На скрине прозрачный фон (игрался с черным и белым) , все до лампочки
Haz: SergKis пишет: Мой (твой) пример Refresh(.F.) к зависанию не приводит Сергей, это пример с двойным курсором ? Сделайте в нем строк поболее ( я тупо нагенерил 1000 ) и нажав стрелку вниз НЕ отпуская до конца , потом так же вверх и глюк как на блюдечке Если отпускать стрелку вовремя - не проявляется. Двойной курсор как оказалось - очень просто делается , у меня на работе пример , в понедельник кину Или лучше Дима может сейчас кинуть. Dima пишет: О первой колонке с галей говорю. если разговор только про галю , то тут БМП не нужна т.к есть стандартная галя по логическому полю oBrw:aColumns[x]:lCheckBox := .T. ЗЫ. с фоном БМП уже пытался разобраться - не вышло , бросил (((
Dima: Haz Не , галя не подходит. Нужна BMP. Подумал было что вот это ,что то изменит , но нет. oBrw:lTransparent:=TRUE Понятно что можно фон сделать который надо , но гиморно больно. Для каждого фона для одного и того же BMP , держать кучку клонов Оно как бы можно сырец ковырнуть и посмотреть что там происходит , но сходу правильное место не нашел. Похоже все рисуется в Сишнике в процедуре TSDrawCell Haz пишет: Двойной курсор как оказалось - очень просто делается , у меня на работе пример , в понедельник кину Или лучше Дима может сейчас кинуть. Да если надо выложу.
SergKis: Dima пишет:Да если надо выложу Выложи. Пока TsBrowse отложил, но VO прогу переделывать придется, так что лучше сразу, потом сложнее будет.
SergKis: Haz пишет:Сделайте в нем строк поболее так сделал и увидел
Dima: SergKis пишет: Выложи. Колонкам делаем экзекуцию [pre2] for i := 1 To oBrw:nColCount() oBrw:aColumns[ i ]:lFixLite := TRUE next [/pre2] Красим так примерно (на вкус и цвет товарищей нет ) [pre2] oBrw:SetColor( { 6 }, { { |a,b,c| IF( c:nCell == b,{ RGB(198, 226, 255), RGB(0,196,196) },; { Rgb( 198, 226, 255 ), Rgb( 159, 207, 255 ) }) } } ) [/pre2]
SergKis: Да, работает. Спасибо. Видел в TSBrowse.chm DBLCURSOR DOUBLE CURSOR FIXED Activates the double cursor feature on the freezed columns. Но догадаться, для чего это Активизирует функцию двойного курсора на отмороженных колонок Google translit(c)
Dima: В общем нашел я место где происходит вывод картинок Это c_TBrowse.c Функция void DrawBitmap ( HDC hDC, HBITMAP hBitmap, int wRow, int wCol, int wWidth, int wHeight, DWORD dwRaster ) Есть там переменная dwRaster = SRCCOPY; Заменил ее на , с фоном порядочек , но цвет изображения инвертированный получился , по жизни он зеленый (галя на скрине выше) а вышла фиолетовая dwRaster = SRCINVERT; Скрин ;) У кого есть мысли ?
Haz: Dima пишет: У кого есть мысли а с этим пробовал SRCAND ?
Dima: Haz пишет: а с этим пробовал SRCAND ? конечно , результат черный фон. пробовал даже комбинации ........
Dima: Игорь это у меня такой кривой Axialis IconWorkshop оказывается. Пишет что прозрачный фон у картинки а на самом деле нет. Взял чужую картинку с прозрачным фоном , все отлично. Посему сделать в сырце нужно вот так dwRaster = SRCAND;
Haz: Dima пишет: Посему сделать в сырце нужно вот так dwRaster = SRCAND; Погоняю завтра на работе ...
Dima: я уже погонял. короче , фон BMP надо делать белый а не прозрачный. интересно что у тебя получится. вот с белым фоном PS Вот 2 BMP для теста Один с прозрачным фоном , другой с белым https://cloud.mail.ru/public/DMPk/TVHRgFZy6 https://cloud.mail.ru/public/AW9h/4igB1QSbr
SergKis: Dima пишет: фон BMP надо делать белый Попробовал из VO bmp с белым фоном - полет нормальный.
Dima: SergKis пишет: Попробовал из VO bmp с белым фоном - полет нормальный. OK Снова о Double Cursor. Вот так выглядит , без особого тюнинга. Но не трудно заметить что фон в 4 ячейке красится по условию и когда курсор там лежит , то этой окраске труба Делаем тюнинг. Еще вопрос: [pre2] Full oBrw:nLineStyle := 1 Only vertical lines oBrw:nLineStyle := 2 Only horizontal lines oBrw:nLineStyle := 4 No lines oBrw:nLineStyle := 0 [/pre2] Пока стоит у меня 1 , вроде ни чего так. В консоли если сравнивать была бы 2. В общем пробнул все варианты включая 5 и 3 И так и не понял как лучше и как быстрее будет для самого бровса. Быстрее будет конечно с nLineStyle := 0 , но выглядит как то вяло все Кто как юзает ? PS Смотрел таблички в задачах на DELPHI , там летает все и ни чего не "подмаргивает" , просто хотелось улучшить Tsbrowse в плане прорисовки и скорости.
Andrey: Dima пишет: Смотрел таблички в задачах на DELPHI , там летает все и ни чего не "подмаргивает" Там двойная буферизация при выводе на экран. Кто нам сделает такое же в МиниГуи - вопрос открыт ! Dima пишет: просто хотелось улучшить Tsbrowse в плане прорисовки и скорости. Аналогично. Мне бы тоже хотелось иметь готовые примеры как нужно делать то или иное в Tsbrowse.
Dima: Andrey пишет: Там двойная буферизация Ну по идее (хотя в си я валенок) надо в сырцах TsBrowse где идут вызовы SendMessage(...) 4-ым параметром передавать LVS_EX_DOUBLEBUFFER Только надо знать в каком из них (SendMessage) это сделать. Хотя, нет....... В Tsbrowse есть InitDialogBrowse , вот надо как то перед его вызовом поиграть с doublebuffer := _HMG_aControlMiscData1 [i,19] Возможно в Function _DefineTBrowse в _HMG_aControlMiscData1 [k] := 0 , вместо этого сделать так _HMG_aControlMiscData1 [k] := { , , , , , , , , , , , , , , , , , , TRUE }
SergKis: Dima если меняем исходники TsBrowse, вопросик А ты делел, по совету Haz, добавление cName (своего имени колонки) в TSColumn ? CLASS TSColumn DATA cName INIT "" ... Я да, и еще тронул [pre2] METHOD GetColumn( nCol ) CLASS TSBrowse Default nCol := 1 IF hb_IsString( nCol ) nCol := Max( AScan( ::aColumns, {|oCol| Upper(oCol:cName)==Upper(nCol) } ), 1) RETURN ::aColumns[ nCol ] // returns a Column object ENDIF If nCol < 1 nCol := 1 ElseIf nCol > Len( ::aColumns ) nCol := Len( ::aColumns ) EndIf Return ::aColumns[ nCol ] // returns a Column object [/pre2] может и еще надо было бы пройтись, но пока этим обхожусь
Dima: SergKis Нет этого не делал. О DoubleBuffer читал , мыслю верно ? Я о _HMG_aControlMiscData1 [k] := 0 функции _DefineTBrowse
SergKis: Dima так глубоко еще не лазил (как устроено не копал), по простым методам не прошел даже. Получается, как ты говорил "зашел на 5 минут", а вышел через неделю и не заметил. В Browse и вернулся по этим причинам.
SergKis: Dima пишет:Я о _HMG_aControlMiscData1 [k] := 0 функции _DefineTBrowse В др.контролах это контейнер внутренних данных, в TsBrowse нашел только это METHOD EditExit line 3950 [pre2] If ValType( oCol:oEdit ) == "O" DO CASE CASE "TGETBOX" $ Upper( oCol:oEdit:ClassName() ) ix := GetControlIndex ( ::cChildControl, ::cParentWnd ) nKey := _HMG_aControlMiscData1 [ix][3] SetFocus( ::hWnd ) // JP 1.59 CASE "TBTNBOX" $ Upper( oCol:oEdit:ClassName() ) .and. lSpinner [/pre2] не считая функции _DefineTBrowse
Dima: Тогда не понятно как корректно в 19 элемент сложить TRUE
SergKis: Dima LVS_EX_DOUBLEBUFFER - это для ListView, т.е. дл Browse, Grid
Haz: SergKis пишет: может и еще надо было бы пройтись, но пока этим обхожусь Сергей, я еще это менял ( номера строк примерные т.к. дома не актуальные исходники ) добавил код чтобы по ENTER и SPACE вызывался код дабл клика мышкой в широком курсоре 6396 Case !::lCellbrw .And. (nKey == 13 .Or. nKey == 32 ) If ::bLDblClick != Nil Eval( ::bLDblClick ) EndIf Otherwise Выход из редактирования при потере фокуса ячейкой с СОХРАНЕНИЕМ редакции ( как Excel ) // if nKey == 0 3915 // lLostFocus := .T. Закоментировал и изменил условие ниже с nKey > 0 на nKey >= 0 // endif 3919 If ! lLostFocus .and. nKey >= 0 .and. (nKey != VK_ESCAPE .or. ::nColSpecHd != 0) .and. ;
SergKis: Haz Спасибо.
Dima: SergKis пишет: LVS_EX_DOUBLEBUFFER - это для ListView, т.е. дл Browse, Grid То есть не для TSBROWSE......??? , который в свою очередь юзает InitDialogBrowse из h_browse.prg в котором и считывается doublebuffer := _HMG_aControlMiscData1 [i,19] и затем скармливается SendMessage. Можно тупо закоментить doublebuffer := _HMG_aControlMiscData1 [i,19] и написать doublebuffer := TRUE
SergKis: Dima это где ? не вижу, ткни который в свою очередь юзает InitDialogBrowse из h_browse.prg в котором и считывается doublebuffer := _HMG_aControlMiscData1 [i,19] и затем скармливается SendMessage.
Dima: Вызов InitDialogBrowse есть в SOURCE\TsBrowse\h_tbrowse.prg Сам InitDialogBrowse живет в сырцах Минигуи в h_browse.prg , строка примерно 296 Там чуть ниже и считывается doublebuffer из массива _HMG_aControlMiscData1
SergKis: туда попадаем при if _HMG_BeginDialogActive а унас ситуация else и oBrw := TSBrowse():New( ControlName, nRow, nCol, nWidth, nHeight,;
Dima: SergKis Попробовал сделать по аналогии с обычным бровсом в Function _DefineTBrowse в самом конце перед Return [pre2] if .Not. _HMG_DialogInMemory SendMessage( ControlHandle, LVM_SETEXTENDEDLISTVIEWSTYLE, 0, LVS_EX_DOUBLEBUFFER) endif [/pre2] Пересобрал , видимого эффекта не обнаружил , все по старому............ Наверное там не все так просто если Григорий этого не сделал после того как в Grid и бровсе был введен DOUBLEBUFFER. Фсё , у меня мысли кончились в плане DOUBLEBUFFER
SergKis: Dima LVS_EX_DOUBLEBUFFER это ListView контрол от Мвйкрософта и появилось то ли с Висты, то ли с 7ки, раньше вроде не было. а TsBrowse типа самописный, так что ...
Dima: SergKis Понял. Последняя попытка ;) Пробнул вот так еще в своем сырце после END WINDOW ListView_ChangeExtendedStyle ( GetControlHandle('oBrwm','MAGAZIN'), LVS_EX_DOUBLEBUFFER, NIL ) Эффекта не увидел. Тут не катит такое ? PS Похоже не катит........
Dima: SergKis А в обычном бровсе не TS , супер хидер возможен ? Сделать двойной курсор можно ?
SergKis: Dima пишет:Похоже не катит Можно пробовать через WM_SETREDRAW, но это копать надо (и прокатит ли): [pre2] // BAA HB_FUNC( LOCKREDRAW ) { HWND hWnd = ( HWND ) hb_parnl( 1 ); if( hb_parl(2) ) SendMessage( hWnd, WM_SETREDRAW, 0, 0); // .T. - блокировать else SendMessage( hWnd, WM_SETREDRAW, 1, 0); // .F. - разблокировать } [/pre2]
SergKis: Dima пишет:А в обычном бровсе не TS , супер хидер возможен ? Сделать двойной курсор можно ? Нет и многострочную строку тоже нельзя. Я горожу (1,2 места) простенький суперхидер от размеров колонок на базе ButtonEx, но сам понимаешь ...
Dima: Прокатило LOCKREDRAW(GetControlHandle('oBrwm','MAGAZIN'),.T.) только после этого бровс не рисуется совсем. куда ее правильно пристроить ?
SergKis: Dima пишет:куда ее правильно пристроить ? Вот тут и копать начинать надо Я не очень влез в тексты TsBrowse, что бы ответить
Dima: Ладно пробну пихнуть ее METHOD Display() CLASS TSBrowse [pre2] ::BeginPaint() ::Paint() ::EndPaint() [/pre2] Перед ::Paint() включу а после выключу
Dima: Сделал , шустрее бровс не стал ))))
SergKis: Dima пишет:Сделал , шустрее бровс не стал И не должен. Этим можно убрать мелькание.
Dima: SergKis пишет: Этим можно убрать мелькание. Оно осталось ;) Таблица не мерцает а вот курсор да.
SergKis: Dima Pasha писал Еще tbrowse любит все время опрашивать RecCount(), на каждой записи... может еще в эту сторону смотреть для увеличения быстроты А по поводу мерцания ничего не скажу - нет мыслей
Dima: SergKis пишет: Еще tbrowse любит все время опрашивать RecCount(), я пока на массиве юграю , поэтому RecCount() не при делах. Всё мысли и у меня кончились......с утра думал минут 5 поиграть а уже скоро 16-00 ))
SergKis: Dima пишет:с утра думал минут 5 поиграть а уже скоро 16-00 Вот и я волевым усилием отложил TsBrowse, а то сядешь играть ..., а неделя прошла. Работа стоит, а время идет (c)
Dima: SergKis пишет: сядешь играть ..., а неделя прошла. Это точно Смотрю там всем рисованием занимается сишная функция HB_FUNC( TSDRAWCELL ) возможно надо там копать , но в сях я не силен.
Dima: Еще вопрос по TS Если зажать и держать PGDN , то листается не весь бровс целиком как ожидалось а только в пределах строки курсора. Этот эффект как то отключается ? Смотрел oBrw:lPageMode , это не то. PS Глянул , не отключается. Только лишь переделкой лечится.
Andrey: Стрес-тест для TBROWSA. Открываю базу через инет (Leto) - 5 миллионов записей, при создании окна и TBROWSA тормозит немного 5-7 сек., но ничего открывает по выбору 97 тыс. записей... маркер немного вальяжно ходит... Но этоже всётаки 97 тыс. записей в бровсе.... Единственно глюк - на скролинге не отображается положение в базе и если за него подвигать вверх/вниз - ВИСНЕТ НАГЛУХО ! Что там можно исправить ? Исходники здесь - https://cloud.mail.ru/public/6Tw4/JGGSA941Q
Dima: Andrey пишет: Открываю базу через инет (Leto) Лето не у всех установлен , так что давай тест под CDX PS Копирайт рано вешать )))
Andrey: Dima пишет: Лето не у всех установлен , так что давай тест под CDX Там переключатель есть на DBFCDX, будет работать стандартный драйвер. Только при первом запуске надо кнопку "колёсико" выбрать и указать кол-во записей для создания базы ! Если заново нужно создать базу, то нужно удалить уже созданную базу. Копирайт потом общий повешу, без вашей общей помощи - не создал бы такой тест !
SergKis: Andrey пишет:Что там можно исправить ? -установить RddInfo( RDDI_BUFKEYCOUNT, <lSet>,, [nConnection] ) По умолчаниюю флаг RDDI_BUFKEYCOUNT не установлен. Если он не установлен, функция ordKeyCount() запращивает значение количества ключей с сервера, если установлен - использует последнее значение, полученное с сервера. RddInfo( RDDI_BUFKEYNO, <lSet>,, [nConnection] ) По умолчаниюю флаг RDDI_BUFKEYNO не установлен. Если он не установлен, функция ordKeyNo() запращивает значение сервера, если установлен - использует последнее значение, полученное с сервера. -убрать OdKeyCount из on change -не знаю как skip буффер заполняется данными из fpt, но я бы мах избавился от memo полей, с инф. типа адрес, телефон, ...
Andrey: SergKis пишет: -не знаю как skip буффер заполняется данными из fpt, но я бы мах избавился от memo полей, с инф. типа адрес, телефон, ... Ну это сложно. Юзера вечно хотят свои примечания писать. Адрес, телефон в этом тесте просто выступают как образец. А так конечно согласен, чем меньше мемо, тем лучше. SergKis пишет: RddInfo( RDDI_BUFKEYCOUNT, <lSet>,, [nConnection] ) А в каком месте программы ? Там где Leto коннектится или в другом месте ?
SergKis: Andrey пишет:Ну это сложно. Юзера вечно хотят свои примечания писать У нас "хвост управляет собакой" или наоборот ? Я делаю поле через разделитель ~0.5k-3k как для aTokens Там где Leto коннектится или в другом месте ? RddInfo - инф. для rdd, вот и ставь соответственно
Dima: Сергей а ништяки типа RDDI_BUFKEYNO , RDDI_BUFKEYCOUNT это для Leto только ? Посмотрел DBINFO.CH там нет такого.
Haz: Andrey пишет: Стрес-тест для TBROWSA. Тест конечно стресс но не для бровса,, а для автора т.к. надо немного менять код 1. Переписать так чтобы не было везде понатыкано MyFocusBrw() , как минимум в ON CHANGE - это место крайне чувствительно ко всяким лишним действиям 2. Когда ставиться Scope - бровс об это ничего не знает , ему не сказали что логическая длина базы съехала. Отсюда и косяк на скролере ( пример как сказать есть в TSBFilter , что фильтр что скоп итог один - бровсу кормят не то количество на которое он инициализировался ) - нужен :Reset() 3. Нагенерил 100 000 на локальном компе тормозов нет PS. Сергей верно сказал - мемо поля это помойка в которой тяжело искать , и уменьшай объем передаваемых данных в буфер записи при Skip. Узкое место скорость передачи PPS Вспомнил позднее - по поводу мемо полей мы уже говорили и ты что то делал подобное - мемо показывать не в бровсе а в отдельной области окна , и только для текущей записи . Читать мемо можно c задержкой , чтоб не тормозил бровс при навигации . Я у себя тупо через таймер и массив комманд реализовал , по ON CHANGE в массив комманд пишется N записи по которой перечитать мемо и обнуляется счетчик задержки примерно 500 мс. При контроле этого счетчика , если он достиг 500 читаем последнее значение из массива и по нему мемо, при этом обнуляя массив. Т.е мемо подчитывается через пол секунды после того как пользователь перестал давить на кнопки управления
SergKis: Dima пишет: ништяки типа RDDI_BUFKEYNO , RDDI_BUFKEYCOUNT это для Leto только ? Ты совершенно прав, цитата и ништяки из letodb, а cdx и без них тянет.
Dima: SergKis пишет: а cdx и без них тянет Да меня больше ADSCDX интересовал.
SergKis: Haz пишет:и уменьшай объем передаваемых данных в буфер записи при Skip. Узкое место скорость передачи Для browse лучше skip буфер делать в кол-во строк browse, иначе идет набор рывками (особенно видно в модемном соединении), для TSB, думаю тоже, не пробовал с letodb (пока с cdx вопросы)
SergKis: Dima пишет:Да меня больше ADSCDX интересовал. Думаю, надо править сырец TSB, ввести переменную и заносить значение OrdKeyCount() при создании TSB, а в блоках кода по умолчанию (и своих) использовать ее, когда надо, самому обновлять значение переменной.
Andrey: Haz пишет: Тест конечно стресс но не для бровса,, а для автора т.к. надо немного менять код Для этого и вас всех просил посмотреть ! Haz пишет: 3. Нагенерил 100 000 на локальном компе тормозов нет Нужно по сетке хотя бы проверить.... И побольше базу ....
Dima: Haz пишет: Когда ставиться Scope - бровс об это ничего не знает А вот с этого места можно поподробнее как для домохозяек ? Если я работаю по сети и в базе 100 записей. Завел новую запись 101 а по сети в это время добавили запись 102 , я ее не увижу ? В консоли с этим нет проблем. Молчу уже про Scope , Фильтра.........
Haz: Dima пишет: В консоли с этим нет проблем. думаю и в консоли при сформированном бровсе по полной базе , а какая то прцудура выставит фильтр , то бровсу как минимум :RefreshAll() потребуется . Проблемы такие же как и в консоли , к примеру если коллега отредактирует запись которая у меня висит перед глазами в бровсе , я не увижу изменений пока не обновлю запись
Haz: SergKis пишет: Для browse лучше skip буфер делать в кол-во строк browse, Спасибо, проверю !
Dima: Haz пишет: то бровсу как минимум :RefreshAll() потребуется . Конечно я его делаю и в консоли , когда это требует логика проги. Все понял !
SergKis: Смотрю проблема cValToChar(xValue) для чисел так и не решилась с давних времен http://clipper.borda.ru/?1-20-0-00000485-000-0-0-1150783273 Пост N: 191 [pre2] FUNCTION cValToChar( xValue ) LOCAL cType := ValType( xValue ) LOCAL cValue := "", nDecimals if cType == 'N' if xValue == int(xValue) nDecimals := 0 else nDecimals := Set( _SET_DECIMALS ) endif endif DO CASE CASE cType $ "CM"; cValue := xValue CASE cType == "N" ; cValue := LTrim( Str( xValue, 20, nDecimals ) ) ... на мой взгляд применение (убрав строки определения nDecimals) CASE cType == "N" ; cValue := hb_ntos( xValue) работают правильнее для разных значений дробной части числа [/pre2]
gfilatov2002: SergKis пишет: проблема cValToChar(xValue) для чисел так и не решилась Благодарю за напоминание! Поправил для следующей сборки
SergKis: Подскажите (не вижу), есть ли в MiniGui готовая функция для получения объекта TSBrowse по имени контрола и формы. Типа [pre2] FUNCTION _GetObjTSBrowse( ControlName, ParentForm, nIndex) LOCAL oBrw LOCAL i := iif(pCount() > 2, nIndex, GetControlIndex(ControlName,ParentForm)) IF i > 0; oBrw:= _HMG_aControlIds [ i ] ENDIF RETURN oBrw [/pre2]
gfilatov2002: SergKis пишет: есть ли в MiniGui готовая функция для получения объекта TSBrowse Нет такой функции
SergKis: gfilatov2002 пишет:Нет такой функции Выпадает TsBrowse из общей организации MiniGui. Нет тогда и min псевдообъекта oTSB := wForma.Magazin.Object
Andrey: Всем привет. Тестирую TBROWSE через сервер на медленном соединение... Не очень приятно видеть как TBROWSE медленно перерисовывает окно и саму таблицу. В терминалке была команда DispBegin() и DispEnd(). Есть ли такая команда для МиниГуи TBROWSE ?
Dima: Andrey пишет: Тестирую TBROWSE через сервер на медленном соединение... Тут тема про TSBROWSE... ЗЫ А по вопросу , коли медленный коннект повесь какой то индикатор или типа того...
Andrey: Dima пишет: Тут тема про TSBROWSE... Как читаю, так и написал: DEFINE TBROWSE oBrw3 ; AT 160,2 ; WIDTH nWinWidth-2*2 ; HEIGHT nWinHeight - 160*2 ; ON CHANGE { || ChangeBrowse("oBrw3") } ; ON GOTFOCUS ChangeBrowse("oBrw3") ; BACKCOLOR aBackColor ; CELL и т.д.
Dima: Andrey Думаешь DispBegin() и DispEnd() ......аналоги...помогут ? Что то сомневаюсь. PS Есть там BeginPaint() и EndPaint()
Andrey: Dima пишет: А по вопросу , коли медленный коннект повесь какой то индикатор или типа того... Во первых не знаю как определить - медленный коннект или нет ? Во вторых - видно как TSBROWSE строит по ячейкам таблицу - визуально, медленно и не спеша. А при нажатии на стрелки- вверх/вниз видно как перерисовывается маркер/курсор. Для терминального TBROWSE были команды DispBegin() и DispEnd(), т.е. саму перерисовку пользователь не видел. Это классные команды ! Вот и хотелось бы узнать как провернуть такой же финт для TSBROWSE ?
Dima: Andrey Сделай проще ))) Напиши , идет загрузка данных в лейбе индикатора а уж после загрузки покажи бровс. Не то ?
Andrey: Dima пишет: Напиши , идет загрузка данных в лейбе индикатора а уж после загрузки покажи бровс. Не то ? То что надо. А как сделать то ? Я сейчас на медленном коннекте вижу как прорисовывается вся таблица.
SergKis: Andrey пишет:Я сейчас на медленном коннекте вижу как прорисовывается вся таблица. Все верно, tbrows ходит (skip-ует) по базе, время обновления skip-буф. мало, он снова заполняется и получаешь то, что видишь То что надо. А как сделать то ? Твой же пример WAIT_WINDOW с потоком и без, сделай аналогично, повесь анимацию, отбери в массив или memio и показывай.
Andrey: Помогите разобраться с глюком мышки. Пример MiniGUI\SAMPLES\Advanced\Tsb_config На самом Tsbrowse нажимаем правую кнопку мышки и выбираем "Enable display of deleted records" Клавиша PgDown до последней странице - нумерация строк (1-я колонка) в Tsbrowse - нормальная. Если крутить колёсиком мышки - нумерация строк (1-я колонка) неправильная. Как исправить ?
Andrey: Собрал в новой версии MiniGUI 2.5.1 - глюк тоже есть ! Вот так выглядит на экране: Если листать клавишей PageDown - то глюка нет ! Помогите пожалуйста исправить, юзера будут просто ВОПИТЬ - куда делись договора...
Haz: Andrey пишет: Если листать клавишей PageDown - то глюка нет Это не глюк , минигуй тут не причем. Это ошибки алгоритма заложенного в пример. Меняй алгоритм и не переназначай внутренние переменные бровса если не уверен в том как это работает. Нет времени заниматься поиском косяков в чужом коде , вот куски кода которые корректно работают [pre2] SET DELETED OFF .... INDEX ON Number TAG "ALL" INDEX ON Number TAG "DEL" FOR ( !Deleted() ) .... oBrw:bChange := { || oBrwChange() } .... STATIC FUNCTION oBrwChange() LOCAL cVal := HB_NToS( (oBrw:cAlias)->(OrdKeyNo()) ) + ' / ' + HB_NToS( (oBrw:cAlias)->(OrdKeyCount()) ) Form_0.StatusBar.Item(3) := " RecnO: " + cVal Form_0.oBrw.Setfocus RETURN Nil .... FUNCTION RecnoViewDel(lVal) LOCAL cMsg IF lVal (oBrw:cAlias)->(DbSetOrder("ALL")) cMsg := "Included a display of deleted records !" ELSE (oBrw:cAlias)->(DbSetOrder("DEL")) cMsg := "Offline mode display of deleted records !" ENDIF oBrw:Reset() MsgInfo(cMsg ) Eval( oBrw:bChange ) RETURN Nil [/pre2]
Andrey: Haz Спасибо ! Буду переделывать.... И еще заметил странность, если подёргать клавишами PageDown, PageUP а потом погонять клавишей стрелка вниз, то TsBrowse вешает программу наглухо.
Haz: Andrey пишет: TsBrowse вешает программу наглухо. Все верно, так и должно быть Перечитай эту ветку, один форумчанин примерно месяц назад. уже указывал тебе на эти грабли в твоем примере.
Andrey: Haz пишет: Перечитай эту ветку, один форумчанин примерно месяц назад. уже указывал тебе на эти грабли в твоем примере. Да пока сам на грабли еще раз не наткнёшься, ни фига не запомнишь ! Только не всегда это происходит... Пост N: 586 Haz пишет: и более того , в процедуре по ON CHANGE есть вызов Refresh() , что 100% приводит к зависаниюбровса стоит его прогнать стрелками вниз/вверх Пост N: 717 SergKis пишет: Мой (твой) пример Refresh(.F.) к зависанию не приводит, но по pgup или up ниже последней и назад - ломается веделенная закраска всей строки с фокусно ячейкой. Как то похитрее надо делать, может быть мтодом DrawLine(xRow) с цветами на пред.стоку и тек., без бутылки сразу не разберешься Так же ломается счетчик записей левой колонки. Можно туда прикрутить в саму БИБЛИОТЕКУ - чтобы это не ломалось ?
Haz: в чем проблема ? показывай в первой колонке OrdKeyNo()
Haz: Andrey пишет: Только не всегда это происходит... Это происходит ВСЕГДА если в ON CHANGE есть Refresh() и бежать по длинной базе не отрывая пальца по стрелки вниз или вверх достаточно долго. Если почитать дальше 717 714 поста то там есть и пост 587 и ответ на него 716 . Читать надо внимательнее
Haz: Andrey пишет: Так же ломается счетчик записей левой колонки. в DBFCDX нет логического нумератора строк , кроме как номер ключа при наличии индекса. в TSBrowse ::nAt - тоже не нумератор , он может и отрицательные значения принимать Поэтому как отобразить логический номер - головняк разработчика программы где используется TSBrowse PS nAt совпадает с логическим номером только при бровсе по массиву.
Andrey: Понял. Спасибо БОЛЬШОЕ ! Вопрос по ломке нумерации - это происходит ТОЛЬКО мышкой и клавишей стрелка вниз, когда находишься на последней строке в бровсе. Как то можно отловить этот момент и не давать маркеру/курсору скакнуть вниз ? Тогда и ломаться нумерация не будет. Но может я и не прав...
Dima: Andrey Что бы не флудить еще пару-тройку страниц , самодостаточный пример. Ни чего не глючит , не виснет и "ездит" как нужно Да простит меня Has [pre2] #include "minigui.ch" #include "tsbrowse.ch" MEMVAR oBrw FUNCTION Main() LOCAL cDbf := 'Test.dbf' LOCAL i := 0 REQUEST DBFCDX SET CENTURY ON SET DELETED OFF RDDSETDEFAULT('DBFCDX') if !file(cDbf) DBCreate( cDbf , {{"String", "C", 50 , 0}, {"number", "N", 5, 0} } ) USE (cDbf) Excl New Alias "TEST" FOR i := 1 TO 200 TEST->(DbAppend()) TEST->String := RandStr(50) TEST->Number := Random( 200) IF( i % 3 == 0, TEST->(DbDelete()) , NIL ) END INDEX ON Number TAG "ALL" TO ("TEST") INDEX ON Number TAG "DEL" TO ("TEST") FOR ( !Deleted() ) USE end DEFINE WINDOW Form_0 ; At 0, 0 ; WIDTH 800 ; HEIGHT 450 ; TITLE 'TsBrowse sample' ; ICON 'lupa.ico' ; MAIN ; DEFINE STATUSBAR SIZE 10 BOLD STATUSITEM "" STATUSITEM "Right mouse button - the popup menu TBROWSE" WIDTH 380 STATUSITEM " Recno: 0/0" WIDTH 200 STATUSITEM "Alias: "+ ALIAS() WIDTH 115 DATE END STATUSBAR END WINDOW USE (cDbf) Shared New Alias "TEST" INDEX ("TEST.CDX") TEST->(OrdSetFocus("DEL")) CreateBrowse( "oBrw", 'Form_0', 30, 2, Form_0.Width-20, Form_0.Height-95, 'TEST' ) AEval( oBrw:aColumns, { |oCol| oCol:lEdit := oCol:lFixLite := TRUE } ) oBrw:SetColor( { 6 }, { { |a,b,c| IF( c:nCell == b, { Rgb( 66, 255, 236 ), Rgb( 111, 183, 155 ) } , { Rgb( 220, 220, 220 ), Rgb( 220, 220, 220 ) }) } } ) // фон курсора oBrw:bChange := { || oBrwChange() } oBrw:lNoChangeOrd := .T. oBrw:SetColSize( "String", 600 ) oBrw:SetColSize( "Number", 150 ) oBrw:Display() DEFINE CONTEXT MENU CONTROL oBRW OF FORM_0 MENUITEM "Enable display of deleted records" ACTION { || RecnoViewDel(.T.) } NAME A1 MENUITEM "Disable display of deleted records" ACTION { || RecnoViewDel(.F.) } NAME A2 END MENU CENTER WINDOW Form_0 ACTIVATE WINDOW Form_0 RETURN Nil FUNCTION CreateBrowse( cBrw, cParent, nRow, nCol, nWidth, nHeight, cAlias ) LOCAL i PUBLIC &cBrw DEFINE TBROWSE &cBrw ; AT nRow, nCol ; ALIAS cAlias ; OF &cParent ; WIDTH nWidth ; HEIGHT nHeight ; COLORS { CLR_BLACK, CLR_BLUE } ; FONT "MS Sans Serif" ; SIZE 8 :SetAppendMode( .F. ) :SetDeleteMode( .F. ) :lNoHScroll := .T. :lCellBrw := .F. END TBROWSE LoadFields( cBrw, cParent ) &cBrw:nHeightCell += 6 &cBrw:nHeightHead += 14 &cBrw:nWheelLines := 1 &cBrw:SetColor( { 3 }, { RGB( 255, 255, 255 )}) &cBrw:SetColor( { 4 }, { { || { RGB( 43, 149, 168 ), RGB( 0, 54, 94 )}}}) &cBrw:SetColor( { 12 }, { { || { RGB( 128, 128, 128 ), RGB( 250, 250, 250 )}}}) &cBrw:SetColor( { 2 }, { { || IF( !(oBrw:cAlias)->(Deleted()), RGB( 230, 240, 255 ), RGB( 130, 140, 155 )) }}) &cBrw:SetColor( { 1 }, { { || IF( !(oBrw:cAlias)->(Deleted()), RGB( 0, 0, 0 ), RGB( 130, 40, 55 )) }}) &cBrw:SetColor( { 5 }, { { || RGB( 0, 0, 255 )}}) &cBrw:SetColor( { 11 }, { { || RGB( 0, 0, 0 )}}) &cBrw:nClrLine := COLOR_GRID &cBrw:ResetVScroll() RETURN Nil FUNCTION RandStr( nLen ) LOCAL cSet := "qwertyuiopasdfghjklzxcvbnmQWERTYUIOPASDFGHJKLZXCVBNM" LOCAL cStr := "" LOCAL i := 0 FOR i := 1 TO nLen cStr += SubStr( cSet, Random( 52 ), 1 ) NEXT RETURN cStr STATIC FUNCTION oBrwChange() LOCAL cVal := HB_NToS( (oBrw:cAlias)->(OrdKeyNo()) ) + ' / ' + HB_NToS( (oBrw:cAlias)->(OrdKeyCount()) ) Form_0.StatusBar.Item(3) := " RecnO: " + cVal Form_0.oBrw.Setfocus RETURN Nil FUNCTION RecnoViewDel(lVal) LOCAL cMsg IF lVal TEST->(DbSetOrder("ALL")) cMsg := "Included a display of deleted records !" ELSE TEST->(DbSetOrder("DEL")) cMsg := "Offline mode display of deleted records !" ENDIF oBrw:Reset() MsgInfo(cMsg ) Eval( oBrw:bChange ) RETURN Nil [/pre2] PS Пример не мой. https://www.youtube.com/watch?v=p0-TYMZ4iRE
Haz: Dima пишет: Да простит меня Has Слил военную тайну тока так Теперь все узнают что TsBrowse работает нормально
Dima: Haz пишет: Слил военную тайну тока так Чисто на благо форума (темы). Все , к стенке меня... PS Могу убрать если надо
Haz: Dima пишет: Все , к стенке меня... ))) Ага, через оформление примера для минигуя жаль для примера этого маловато. В следующий раз - по всей строгости
Dima: Haz пишет: жаль для примера этого маловато. Пример в порядке что бы исправить другой пример. PS По ходу можно назначить тебя админом что бы иногда разгребать.......ну ты понял что. Если готов скажи
Haz: Dima пишет: разгребать.......ну ты понял что.
Dima: Haz
Andrey: Dima пишет: Что бы не флудить еще пару-тройку страниц , самодостаточный пример. Спасибо Дима ! Только жалко, что там нет 1-ой колонки с нумерацией DATA oBrw:nLogicPos .... ----- Помнишь, говорили в этом фильме : Да гранаты у него не той системы... Жалко на ютубе не нашёл этого кусочка... Ну да ладно, буду смотреть.
Haz: Andrey пишет: Ну да ладно, буду смотреть. Ну куда там еще смотреть , все разжевано - пережевано дальше некуда жалко, что там нет 1-ой колонки с нумерацией DATA oBrw:nLogicPos .... так добавь с DATA ( oBrw:cAlias)->(OrdkeyNo()) , это же можно сделать самостоятельно
Andrey: Всем привет ! Можно ли при построение узнать размер пустой строки перед подвалом ?
Dima: Andrey Типа так [pre2] Func GetHole(obrw) local WorkHeight := oBrw:nHeight-oBrw:nHeightHead-oBrw:nHeightSuper-; oBrw:nHeightFoot-oBrw:nHeightSpecHd-if(!oBrw:lNoHScroll,16,0) RETURN (WorkHeight-Int(WorkHeight/oBrw:nHeightCell)*oBrw:nHeightCell) [/pre2]
Andrey: Dima пишет: Типа так Спасибо ! А как узнать кол-во строк в бровсе ? Хочу размер дырки/на кол-во строк в бровсе и добавить в oBrw:nHeightCell
SergKis: Andrey пишет:Хочу размер дырки/на кол-во строк в бровсе и добавить в oBrw:nHeightCell Если бы ровно делилось - не было бы дырки. Разницу надо относить к header, footer или менять размер по высоте tsb
Dima: Andrey пишет: Хочу размер дырки/на кол-во строк в бровсе и добавить в oBrw:nHeightCell типа так [pre2] ngh:=GetHole(oBrw) END TBROWSE oBrw:nHeightHead+=ngh+1 [/pre2]
Andrey: Dima пишет: oBrw:nHeightHead+=ngh+1 Нет, так не пойдёт. Нужно ngh/ кол-во строк бровса ! Так как узнать кол-во строк в бровсе ?
Dima: Andrey пишет: Так как узнать кол-во строк в бровсе ? Да писали тебе уже 100 раз oBrw:nrowcount()
Andrey: Dima пишет: oBrw:nrowcount() Спасибо ! Получилось ! Дырки больше нет !
Andrey: Показываю массив в Tsbrowse. 4 элемент массива логический T/F Как сделать блок кода для цвета, чтобы с F была окраска другим цветом ? oBrwF:SetColor( { 2 }, { ????
Haz: Andrey пишет: Как сделать блок кода для цвета, чтобы с F была окраска другим цветом ? oBrwF:SetColor( { 2 }, { ???? Ты это серьезно , а что непонятно в примере который Dima неделю назад сюда же кидал показ/непоказ удаленных записей ? Там же если Deleted() красилось серым. Заменить Deleted() на oBrw:aArray[oBrw:nAt][4] проблема ... Или настолько лень читать что тебе же и пишут ...
Andrey: Haz пишет: oBrw:aArray[oBrw:nAt][4] проблема Вот в этом и была проблема. Не понимал логику нумерации в массиве. Теперь буду знать ! Читать не лень. Не всегда нужно сразу что обсуждается, а потом забывается. Спасибо БОЛЬШОЕ !
Dima: Andrey пишет: Вот в этом и была проблема. Не понимал логику нумерации в массиве. Теперь буду знать ! Ага и потом спросишь тоже самое спустя месяц. "Все" развивается по спирали. Похоже ты вышел на новый виток Может тебе в отпуск нужно.....отдохни , сил наберись , мозги до кучи собери. Andrey пишет: Читать не лень. Не всегда нужно сразу что обсуждается, а потом забывается. Так ты же и спрашиваешь а потом БАЦ и оно у тебя забылось. Зачем спрашивал то ? PS Ни чего личного.
Andrey: Dima пишет: Так ты же и спрашиваешь а потом БАЦ и оно у тебя забылось. Зачем спрашивал то ? Спросил, не ответили. Потом другим отвлекли на работе. Взялся опять за то что не сделал. Вот и ещё раз спрашиваю. Всё как у всех, работа отвлекает от освоения нового... Так что не обижайтесь, на повторное расспрашивание. Спасибо за помощь ! А в отпуск бы я с удовольствием уехал... Пока не отпускает работа... Новое приходиться осваивать уже дома, по вечерам-ночам...
Haz: Andrey пишет: Не понимал логику нумерации в массиве. Теперь буду знать ! Хочется верить что надолго Tsb_Config - твой же пример [pre2] FUNCTION ColorPicker(oBrw) LOCAL aColor := {} aColor := n2RGB(oBrw:aArray[oBrw:nAt][oBrw:nCell] ) // получить цвет из текущей ячейки aColor := GetColor(aColor) // стандартное меню цвета IF aColor[1] # NIL // поместить новый цвет в текущую ячейку oBrw:aArray[oBrw:nAt][oBrw:nCell] := RGB(aColor[1], aColor[2], aColor[3] ) ENDIF RETURN NIL [/pre2] что то быстро забывается в отпуск
Andrey: Haz пишет: что то быстро забывается Забыл ! Точно, сам же делал... Из совместного примера с тобой - \MiniGUI\SAMPLES\Advanced\Tsb_colors_2 Да, надо бы в отпуск...
Andrey: Остался еще непонятен один вопрос. Есть ли в TsBrowse переменная ведущая подсчёт кол-ва ОТОБРАЖАЕМЫХ записей в зависимости от условий показа ? Допустим стоит режим SET DELETED ON в бровсе отображается 3 записи, если SET DELETED OFF - то 4 записи. Если использовать (oBrw:cAlias)->(OrdKeyCount()) или oBrw:nLen то они показывают ОБЩЕЕ кол-во записей в индексе и базе. Держать специально индекс (как в примере что дал Дима) - думаю не совсем верно, доп.расходы на ресурсы и под Leto - не нужно вообще. Самому считать/пересчитывать - как будет вести на больших базах не знаю... Как быть ?
Haz: Andrey пишет: Есть ли в TsBrowse переменная ведущая подсчёт кол-ва ОТОБРАЖАЕМЫХ записей в зависимости от условий показа TsBrowse тут не приделах , сам подумай где TS брать данные ? Если ты знаешь как получить это число напрямую из RDD DBFCDX - используй его. Я знаю только метод тупого пересчета или OrdKeyCount() по условному индексу. Другие RDD , например ADS позволяют дернуть количество записей в фильтре или получить нумератор в SQL запросе. Andrey пишет: Как быть ? Если хочешь что бы было сделано хорошо - сделай сам. Так что или считай или индексуй сам PS Вспомнил еще метод для подсчета удаленки - чтение файла FRead() блоками = длинне записи и подсчет '*' в заголовке записей
Andrey: Haz пишет: TsBrowse тут не приделах , сам подумай где TS брать данные ? А завести в TsBrowse специальную функцию, чтобы возвращала кол-во записей в TsBrowse ? Там же есть переменные типа oBrw:nLogicPos() В примере Tsb_Config.prg - Григорий делал подсчет: oBrw:bLogicLen := {|| iif( Empty(( oBrw:cAlias )->( DbFilter() )), ; ( oBrw:cAlias )->( LastRec() ), ; ( oBrw:cAlias )->( DbEval( { || M->nRecnoDbFilter++ }, &("{||" + ( oBrw:cAlias )->( DbFilter() ) + "}") ) ) ) } но он ломается, если стоишь на последней записи и нажимаешь стрелку вниз или мышкой вниз... Разве только у меня такая проблема стоит - показать общее кол-во выбранных записей ? Всем нужно !
Haz: Andrey пишет: А завести в TsBrowse специальную функцию а нафиг она там нужна ? с таким же успехом и сам посчитать можешь через dbEval()
Haz: Поясню почему "специальная функция" НЕ НУЖНА и бровс тут не причем. 1. Это НЕ функционал бровса который может и не знать какие условия (ограничения) наложены на базу ( фильтры, скопы, условные индексы , удаленные записи и пр и их комбинации ). Функционал бровса отображать то что ему кормят. Эта задача RDD, который, в данном случае ее не поддерживает ни в каком виде. 2. При смене индекса, фильтра, скопа эта "специальная функция" должна будет пересчитать всю таблицу, а если в таблице несколько миллионов записей ? Все готовы ждать пока посчитает перед прорисовкой ? 3. Всем или не всем это нужно ... Мне например - нет , а если потребуется посчитаю своей функцией прямиком базе. 4. Гораздо полезнее была бы возможность авто суммы в футинги по выбранным колонкам и если кто то заглядывал в сырцы TS - та там это возможность закладывалась, но была брошена в силу п.1 и п.2. 5 Главное от этой "специальной функции" главное назначение бровса - отображать записи, ну никак не улучшается, только растет размер паразитного кода т.к. должен учитывать все особенности возможных RDD ( dbf, ado, array, text те - которые туда сейчас заложены ). Вообщем, рекомендую не путать "теплое" с "мягким" и наращивать функционал TS только полезными дополнениями именно для TS
Andrey: Haz пишет: Поясню почему "специальная функция" НЕ НУЖНА и бровс тут не причем. Спасибо !
Andrey: Tsbrowse открыт, на экране записи есть. Делаю условную индексацию, кол-во записей 0. На экране Tsbrowse пустая "фантомная" запись. Как сделать, чтобы такая запись не отображалась ?
Dima: Andrey пишет: Делаю условную индексацию, кол-во записей 0 Сюда продублируй свой код который ниже индексации. PS Не думаю что там две сотни строк кода
Andrey: Dima пишет: Сюда продублируй свой код который ниже индексации. Спасибо Дима ! Понял где копать. Сделал и заработало ! oBrw:Reset() oBrw:aColumns[1]:cFooting := { || LTrim( Transform( (oBrw:cAlias)->(OrdKeyCount()), "### ###" ) ) } oBrw:DrawFooters() oBrw:Refresh(.T.) Eval( oBrw:bChange ) Form_9.oBrw.Setfocus
SergKis: Сделал в своем проекте следующее h_tsbrowse.prg [pre2] ... Function _EndTBrowse () Local i, oBrw if _HMG_BeginTBrowseActive i := ascan ( _HMG_aControlHandles , _HMG_ActiveTBrowseHandle ) if i > 0 oBrw := _HMG_aControlIds [ i ] oBrw:lRePaint := .t. oBrw:Display() oBrw:SetNoHole() // убрать дырку от oBrw:lNoHole _HMG_ActiveTBrowseName := "" _HMG_ActiveTBrowseHandle := 0 _HMG_BeginTBrowseActive := .F. endif endif Return Nil ... CLASS TSBROWSE ... ... DATA lNoHole AS LOGICAL INIT .T. // убрать дырку при .T. (у себя сразу поставил .T., т.к. пока в основном тесты) ... METHOD SetNoHole( lNoHole ) ... ENDCLASS ... METHOD SetNoHole( lNoHole ) CLASS TSBrowse Local nI, nK, nHeight Local nHole := ::nHeight - ::nHeightHead - ::nHeightSuper - ; ::nHeightFoot - ::nHeightSpecHd - If( ! ::lNoHScroll, 16, 0 ) DEFAULT lNoHole := ::lNoHole nHole -= ( Int( nHole / ::nHeightCell ) * ::nHeightCell ) nHole -= 1 nHeight := nHole If lNoHole // убираем дырку nI := If( ::nHeightSuper > 0, 1, 0 ) + ; If( ::nHeightHead > 0, 1, 0 ) + ; If( ::nHeightSpecHd > 0, 1, 0 ) + ; If( ::nHeightFoot > 0, 1, 0 ) If nI > 0 // есть заголовки nK := int( nHole / nI ) // на nI - заголовки разделим дырку If ::nHeightSuper > 0 ::nHeightSuper += nK nHole -= nK EndIf If ::nHeightHead > 0 ::nHeightHead += nK nHole -= nK EndIf If ::nHeightSpecHd > 0 ::nHeightSpecHd += nK nHole -= nK EndIf If ::nHeightFoot > 0 ::nHeightFoot += nHole EndIf Else // нет заголовков, уменьшаем размер Height SetProperty(::cParentWnd, ::cControlName, "Height", ; GetProperty(::cParentWnd, ::cControlName, "Height") - nHole) EndIf ::Display() EndIf RETURN nHeight пересобрал свои тесты - работает нормально. Потестируйте у себя в проектах, а то может косяк есть. Для теста используйте функцию (после END TBROWSE): FUNCTION SetNoHole( oBrw ) // убрать дырку LOCAL nI, nK, nHeight LOCAL nHole := oBrw:nHeight - oBrw:nHeightHead - oBrw:nHeightSuper - ; oBrw:nHeightFoot - oBrw:nHeightSpecHd - ; If( ! oBrw:lNoHScroll, 16, 0 ) nHole -= ( Int( nHole / oBrw:nHeightCell ) * oBrw:nHeightCell ) nHole -= 1 nHeight := nHole nI := If( oBrw:nHeightSuper > 0, 1, 0 ) + ; If( oBrw:nHeightHead > 0, 1, 0 ) + ; If( oBrw:nHeightSpecHd > 0, 1, 0 ) + ; If( oBrw:nHeightFoot > 0, 1, 0 ) If nI > 0 // есть заголовки nK := int( nHole / nI ) // на nI - заголовки разделим дырку If oBrw:nHeightSuper > 0 oBrw:nHeightSuper += nK nHole -= nK EndIf If oBrw:nHeightHead > 0 oBrw:nHeightHead += nK nHole -= nK EndIf If oBrw:nHeightSpecHd > 0 oBrw:nHeightSpecHd += nK nHole -= nK EndIf If oBrw:nHeightFoot > 0 oBrw:nHeightFoot += nHole EndIf Else // нет заголовков, можно уменьшить размер tsb на размер nHole SetProperty(oBrw:cParentWnd, oBrw:cControlName, "Height", ; GetProperty(oBrw:cParentWnd, oBrw:cControlName, "Height") - nHole) EndIf oBrw:Display() RETURN nHeight [/pre2]
SergKis: SergKis пишет:Сделал в своем проекте следующее h_tsbrowse.prg немного подправил[pre2] в методе If nI > 0 // есть заголовки nK := int( nHole / nI ) // на nI - заголовки разделим дырку If ::nHeightSuper > 0 ::nHeightSuper += nK nHole -= nK EndIf If ::nHeightSpecHd > 0 ::nHeightSpecHd += nK nHole -= nK EndIf If ::nHeightFoot > 0 ::nHeightFoot += nK nHole -= nK EndIf If ::nHeightHead > 0 ::nHeightHead += nHole EndIf Else // нет заголовков, уменьшаем размер Height ... в функции If oBrw:nHeightSuper > 0 oBrw:nHeightSuper += nK nHole -= nK EndIf If oBrw:nHeightSpecHd > 0 oBrw:nHeightSpecHd += nK nHole -= nK EndIf If oBrw:nHeightFoot > 0 oBrw:nHeightFoot += nK nHole -= nK EndIf If oBrw:nHeightHead > 0 oBrw:nHeightHead += nHole EndIf ... [/pre2]
Andrey: Всем привет ! Вот нашел проблему в Tsb с фонтами.... Делаю так: DEFINE WINDOW &cFormName ; ..... FONT cFont SIZE nFontSize ; ..... DEFINE TBROWSE oBrw ; ..... FONT cFont SIZE nTblFSize ; ..... END TBROWSE ..... CreateBrowseTable(cFormName,nTable,cFont,nTblFSize) //////////////////////////////////////////////////////////// STATIC FUNCTION CreateBrowseTable(cForm,nTable,cFont,nFontSize) ..... aTableFont := LoadTbrwFonts(oBrw) // "Фонты таблицы:" DEFINE CONTEXT MENU CONTROL oBrw MENUITEM cMenuFont ACTION { || MsgDebug("Фонты таблицы:",aTableFont) } ..... ..... Использую везде один фонт: cFont := 'Tahoma' , nFontSize := ModeSizeFont() Под ХР фонты грузяться правильно, под 8-кой нет ! Кто с таким сталкивался ?
Dima: Andrey пишет: Кто с таким сталкивался ? gfilatov2002 пишет: С учетом этого обсуждения изменил определение размера шрифта на цитата: _HMG_DefaultFontSize := Max( 9, GetDefaultFontSize () ) Не оно ?
SergKis: Dima пишет:Не оно ? С фонтами есть не увязочки. см. h_windows.prg line 181 [pre2] _HMG_ActiveFontName := hb_defaultValue( FontName, "" ) // вместо "" надо _HMG_DefaultFontName _HMG_ActiveFontSize := hb_defaultValue( FontSize, 0 ) // вместо 0 надо _HMG_DefaultFontSize см. h_tbrowse.prg Function _DefineTBrowse (...) ... if ( FontHandle := GetFontHandle( FontName ) ) != 0 aFont := GetFontParam(FontHandle) FontName := aFont[1] FontSize := aFont[2] bold := aFont[3] italic := aFont[4] underline := aFont[5] strikeout := aFont[6] endif ... т.е. если фонт не задали, то FontName NIL и FontSize NIL, попадаем с такими значениями на line 244 oBrw := TSBrowse():New( ControlName, nRow, nCol, nWidth, nHeight,; см. метод New(...) line 1006 Default nRow := 0, ; ... cFont := _HMG_ActiveFontName,; nFontSize := _HMG_ActiveFontSize,; ... и далее ::cFont := cFont ::nFontSize := nFontSize т.е. если не задали фонт на окне и TSB получим пустые значения в ::cFont, ::nFontSize вернемся в Function _DefineTBrowse (...) line 303 if valtype(fontname) == "U" FontName := _HMG_DefaultFontName endif if valtype(fontsize) == "U" FontSize := _HMG_DefaultFontSize endif oBrw:hFont := _SetFont (ControlHandle,FontName,FontSize,bold,italic,underline,strikeout) эти строки (без oBrw:hFont), наверно надо перенести, чтобы было if ( FontHandle := GetFontHandle( FontName ) ) != 0 aFont := GetFontParam(FontHandle) FontName := aFont[1] FontSize := aFont[2] bold := aFont[3] italic := aFont[4] underline := aFont[5] strikeout := aFont[6] else if valtype(fontname) == "U" FontName := _HMG_DefaultFontName endif if valtype(fontsize) == "U" FontSize := _HMG_DefaultFontSize endif endif тогда в создание TSB попадут не NIL значения, правда ::cFont используется только в METHOD Excel2(...), везде работа ::hFont, но для порядка ... [/pre2] Andrey пишет:Использую везде один фонт: Почему установка oBrw:hFont := _SetFont (ControlHandle,FontName,FontSize,bold,italic,underline,strikeout) ADD COLUMN TO TBROWSE oBrw // добавить новую колонку в TBROWSE и получение hFont := oBrw:aColumns[ 1 ]:hFont // 1-cells font If hFont != Nil aFontTmp := GetFontParam(hFont) AADD( aFonts, aFontTmp ) ENDIF вместо Tahoma 18 дал, что видим - не понял. попробуй сделать вариант DEFINE FONT Font_Tsb FONTNAME "Tahoma" SIZE 18 что бы сработали строки if ( FontHandle := GetFontHandle( FontName ) ) != 0 aFont := GetFontParam(FontHandle) ...
SergKis: gfilatov2002 Предлагаю для фонтов в class TsBrowse добавить [pre2] DATA hFontEdit AS NUMERIC // edition font DATA hFontHead AS NUMERIC // header font DATA hFontFoot AS NUMERIC // footer font DATA hFontSpcHd AS NUMERIC // special header font в метод METHOD TSColumn:New(...) line 290 было ::hFontHead := oBrw:hFont ::hFontFoot := oBrw:hFont ::hFontEdit := oBrw:hFont ::hFontSpcHd := oBrw:hFont сделать ::hFontHead := If( empty(oBrw:hFontHead ), oBrw:hFont, oBrw:hFontHead ) ::hFontFoot := If( empty(oBrw:hFontFoot ), oBrw:hFont, oBrw:hFontFoot ) ::hFontEdit := If( empty(oBrw:hFontEdit ), oBrw:hFont, oBrw:hFontEdit ) ::hFontSpcHd := If( empty(oBrw:hFontSpcHd), oBrw:hFont, oBrw:hFontSpcHd ) что бы после DEFINE TSBROWSE уст. handle фонтов на все колонки [/pre2]
gfilatov2002: SergKis пишет: Предлагаю для фонтов в class TsBrowse добавить Благодарю за дельное предложение Уже добавил эти CLASSDATA ...
Andrey: SergKis пишет: т.е. если фонт не задали, то FontName NIL и FontSize NIL, Да я же задаю: DEFINE TBROWSE oBrw ; ..... FONT cFont SIZE nTblFSize ; ..... END TBROWSE В доке так написано ! Или не верить что в доке написано ? Или не так для Tsb задавать фонты нужно ?
SergKis: Andrey А вот это: попробуй сделать вариант DEFINE FONT Font_Tsb FONTNAME "Tahoma" SIZE 18 что бы сработали строки if ( FontHandle := GetFontHandle( FontName ) ) != 0 aFont := GetFontParam(FontHandle) ... т.е. работа по handle фонтов в tsb
Andrey: Вопрос по подвалам Tsb. Как идёт подсчёт итого по подвалам (один раз или несколько) ? Вот такой код. aFieldItog := { 4, "{ || ALLTRIM( Transform( GetCountFieldFilter('Prixod'), '999 999 999.99' ) ) }" } // для примера IF nRecAll > 5000 // создаём окно ожидания с потоком WaitThreadCreate( 'Подсчёт ИТОГО ...' ) ENDIF FOR nI := 1 TO LEN(aFieldItog) nCol := aFieldItog[nI,1] cFooting := aFieldItog[nI,2] oBrw:aColumns[nCol]:cFooting := &(cFooting) NEXT IF nRecAll > 5000 WaitThreadClose() // закрыть окно "ожидания" ENDIF oBrw:DrawFooters() // выполнить прорисовку подвала GetCountFieldFilter() из Tsb_config На маленьких базах всё летает, если больше 100 тыс. - начинаются тормоза... Если убрать подсчёт, то тормозов нет.
Dima: Andrey Ты снова о том о чем спрашивал. Ну скажи зачем в журнале или что там у тебя , считать сумму по полю , если заведомо знаешь что записей там может быть достаточно много ? Примени похожий подход к терминалке и тоже будет тормоз. Нужна цифирка нужная , сделай отчет или выведи цифирку в окно по какой то педали. Не мучай бровс такими вещами иначе позже тебя будут мучать кошмары юзеры твоей программы
Andrey: Dima пишет: Не мучай бровс такими вещами иначе позже тебя будут мучать кошмары юзеры твоей программы Нет, ты не прав ! Нашёл решение, не надо совать кодовый блок туда ! Нужно просто текст (расчёт) засовывать... Вот так: cVal := EVAL(&(cFooting)) oBrw:aColumns[nCol]:cFooting := cVal И тормоза пропали ! А в терминалке, когда ввод записей идёт, внизу всегда итого стоит, чтобы сразу сравнивать, сколько накладных ввели и какая сумма ввода. Да и по поиску: (за день, за месяц и т.д.) расчёт нужен. Вообще мне скорость работы в Tsbrowse - нравится ! 450 тыс.записей считает быстро, 3 сек. и итого по колонке уже есть. Юзер не будет напрягаться. По сетке пока не знаю. Но там уже по другому делать надо - на Лето !!!
Haz: Andrey пишет: 450 тыс.записей считает быстро, 3 сек. Андрей, сам TS ничего не считает, он показывает то что ему кормят. Если перед показом нужно оценить блок кода, то разумеется, на это уйдет время. Но TS то тут при чем ? Это тормозит алгоритм , по которому TS должен показывать значения. PS Кстати 3 сек на 450 тыс записей - это тоже очень долго к примеру SQL запрос в ADS сумма по одному полю выполнится примерно за 100 - 200 мс. Это зависит от RDD от быстродействия компа и алгоритма, .... и, при чем тут TS Это равносильно тому , если в :bChange присвоить { || Millisec(1000) } и утверждать что в TS тормозит навигация
Andrey: Пробую показ Tsb на разных разрешениях экрана. Нашёл такую бяку при включённых больших фонтах в системе: Как считать размеры при включённом LargeFonts() ? //////////////////////////////////////////////////////////// // высота дырки внизу таблицы перед подвалом Function GetHoleBrowse(cBrw) Local nWorkHeight := cBrw:nHeight-cBrw:nHeightHead-cBrw:nHeightSuper-; cBrw:nHeightFoot-cBrw:nHeightSpecHd-if(!cBrw:lNoHScroll,16,0) RETURN (nWorkHeight-Int(nWorkHeight/cBrw:nHeightCell)* cBrw:nHeightCell)
Haz: Andrey пишет: Нашёл такую бяку 1 Вопрос : Что сначала ? 1 Считаем размер дырки 2 Делаем все установки для бровса ( шрифты, высоты и пр ) Думаю сейчас порядок такой 1, 2 2 Вопрос : Что покажет функция GetHoleBrowse() после oBrw:Display() ?
Andrey: Haz пишет: 1 Вопрос : Что сначала ? 1 Считаем размер дырки 2 Делаем все установки для бровса ( шрифты, высоты и пр ) Нет ! Делаю как положено: 1) Делаем все установки - ( шрифты, высоты и пр. ) 2) oBrw:Display() // прорисовать второй раз для подсчёта остатка дырки 3) nHole := GetHoleBrowse(oBrw) - 1 При обычном шрифте считает правильно ! При включении БФ (большого фонта) в системе - считает неправильно !
Haz: Andrey пишет: Нет ! Делаю как положено: Андрей выведи чему равно то чего не хватает: 1) cBrw:nHeight := ? 2) cBrw:nHeightHead := 75 3) cBrw:nHeightSuper := ? 4) cBrw:nHeightFoot := 22 5) cBrw:nHeightSpecHd :=? 6) cBrw:nHeightCell := 50 ЗЫ визуально горизонтальный скроллер у тебя тоже 22 ( в расчете дырки он забит как 16 , 6 пикселей не много но есть ) Остального не видно из твоей картинки. Целиком ее дай с шапкой
Andrey: Вот, сделал... 1) Height=516 2) HeightHead=75 3) HeightSuper=0 4) HeightFoot=22 5) HeightSpecHd=0 6) HeightCell=50 GetHoleBrowse()=3 Кол-во строк=7
Haz: Andrey пишет: Вот, сделал... при подстановке цифирь в функцию GetHoleBrowse(... ) дает 19 а никак не 3 !! проверил - реально 3 Ищи что не так передается PS строк должно быть 8 а не 7 Скролл какой высоты ? в расчете дыры забит 16, а на кортинке явно больше чем подвал. Короче капай в сторону высоты скрола и ставь эту высоту в свою функцию, тогда должно все срастись
Andrey: Haz пишет: Короче капай в сторону высоты скрола и ставь эту высоту в свою функцию, тогда должно все срастись Спасибо БОЛЬШОЕ за совет ! Получилось ! Вот функция: //////////////////////////////////////////////////////////// // высота дырки внизу таблицы перед подвалом Function GetHoleBrowse(cBrw) Local nWorkHeight, nHScroll := IIF( LargeFonts(), 24, 16) nWorkHeight := cBrw:nHeight-cBrw:nHeightHead-cBrw:nHeightSuper-; cBrw:nHeightFoot-cBrw:nHeightSpecHd-if(!cBrw:lNoHScroll,nHScroll,0) RETURN (nWorkHeight-Int(nWorkHeight/cBrw:nHeightCell)* cBrw:nHeightCell)
Andrey: Привет всем ! Как получить массив уже созданного суперхидера в таблице ? Поля таблицы знаю как получить. For nI := 1 To oBrw:nColCount() cPole := oBrw:aColumns[nI]:cHeading
SergKis: Andrey так он образуется: AAdd( ::aSuperHead, { nFromCol, nToCol, uHead, nClrText, nClrBack, l3dLook, hFont, uBitMap, lAdjust, nLineStyle, nClrLine, nHAlign, nVAlign, lTransp } )
Andrey: SergKis пишет: так он образуется: AAdd( ::aSuperHead, { nFromCol, nToCol, uHead, nClrText, nClrBack, l3dLook, hFont, uBitMap, lAdjust, nLineStyle, nClrLine, nHAlign, nVAlign, lTransp } ) А как тогда в цикле вывести значения суперхидера ?
SergKis: Andrey Как ты получаешь элементы массива {{...},{...},...} ? глянь MsgDebug(oBrw:aSuperHead)
Andrey: SergKis пишет: глянь MsgDebug(oBrw:aSuperHead) Понял ! Спасибо БОЛЬШОЕ !
Andrey: Всем привет. Как сделать вставку из буфера винды в поля таблицы по клавишам Shift+Insert ?
SergKis: Andrey пишет:Как сделать вставку из буфера винды в поля таблицы по клавишам Shift+Insert ? [pre2] ... oBrw:bUserKeys := {|nKy,nFl,oBr| UserKeyDown(nKy, nFl, oBr) } ... STATIC FUNC UserKeyDown( nKey, nFlag, oBrw ) Local lRet, cBuf If nKey == VK_INSERT .and. _GetKeyState( VK_SHIFT ) cBuf := System.Clipboard // тут обработка cBuf lRet := .F. EndIf RETURN lRet [/pre2]
Andrey: Спасибо БОЛЬШОЕ ! Только наверное это нужно делать в GET - когда ячейка уже редактируется.
Andrey: Как сделать в САМОМ TSBROWSE при редактировании ячеек (только при УЖЕ редактировании, при наличии курсора) вставку/сохранения кармана WINDOWS как во всех других приложениях по клавишам Shift+Insert/Ctrl+Insert и Ctrl+V/Ctrl+С ?
Haz: Andrey пишет: Как сделать в САМОМ TSBROWSE при редактировании ячеек (только при УЖЕ редактировании, при наличии курсора) вставку/сохранения кармана WINDOWS как во всех других приложениях п И так работает , ничего не делел
Andrey: Haz пишет: И так работает , ничего не делел А у меня нет... MiniGUI\SAMPLES\Advanced\Tsb_config - в текстовое поле пытаюсть вставить что в буфере, не вставляется. А в Фаре вставляется... Где и что править ?
Haz: Andrey пишет: не вставляется. в текстовом поле жму Enter - входит в режим GET. потом Shift+Ins CTRL+V и вставляется то что в буфере обмена было. Ничего не правил вообще, продвинутые (которым лень набирать) пользователи с этим работают не один год PS тестил именно в TSB_Config
Andrey: Хрень какая то... В мемо-поле (колонка List) - всё вставляется. Если берем текстовую колонку - Ctrl+V/Ctrl+С РАБОТАЕТ, а Shift+Insert/Ctrl+Insert НЕТ.... У меня 8.1 Буду пробовать на других системах...
SergKis: подтверждаю Ctrl+V тоже работатет. Tsb_config
Dima: Shift+INS у меня тоже не сработал в этом примере , меняется только форма курсора , CTRL+V пашет зы Win7
Haz: Andrey пишет: Shift+Insert/Ctrl+Insert НЕТ.... Да с шифтом не работает . Сергей пару постов назад сказал куда копать ... Лови нажатие шифт+инс и пихай содержимое буфера Хотя .... ловить кнопки скорее надо уже в объекте oGet который создался в бровсе после нажатия ентер
Andrey: Haz пишет: Лови нажатие шифт+инс и пихай содержимое буфера Хотя .... ловить кнопки скорее надо уже в объекте oGet который создался в бровсе после нажатия ентер А нельзя сделать это в самих исходниках TsBrowse ? Чтобы не делать велосипед... Всем же это нужно !
Dima: Andrey пишет: Чтобы не делать велосипед... Всем же это нужно ! Не знаю как всем , лично мне хватает стандарта CTRL+V
Haz: Тоже в основном пользую ctrl-c/v До ins тянуться через всю клаву надо ... лень
Andrey: Работаю с SetArrayTo() SergKis писал где-то, что после ввода в ячейку таблицы (для отображения границ ячеек таблицы) нужно делать oBrw1:Refresh(FALSE) А в SetArrayTo() - это oBrw1:Refresh(FALSE) не работает ! oCol:bPostEdit := { || AADD( aStatExit, nYear ), AADD( aStatXTbr, cTbrName ),; MyPostEdit(), oBrw1:Refresh(FALSE) } Что делать или что использовать взамен ?
Haz: Andrey пишет: в SetArrayTo() - это oBrw1:Refresh(FALSE) не работает Не совсем понял про :SetArrayTo(), мне казалось этот метод просто позволяет сразу назначать шрифты , размеры , хидинги и футинги при инициализации массива. В отличие от :SetArray() , где это все нужно делать позже. как связаны разные методы :Refresh(...) и :SetArrayTo(...) не уловил
SergKis: Andrey пишет:SergKis писал где-то, что после ввода в ячейку таблицы (для отображения границ ячеек таблицы) нужно делать oBrw1:Refresh(FALSE) Запусти Tsb_array_2 и в строке ниже первой включи коректировку по Enter и пройди по нескольким полям и увидишь, что не прорисовываются линии между тек. строкой и предыдущей. Если воставить в bPostedit oBrw:Refresh(.F.), то линии прорисуются. Вот о чем я говорил. Возможно на dbf будет такое же поведение - не помню
gfilatov2002: SergKis пишет: пройди по нескольким полям и увидишь, что не прорисовываются линии между тек. строкой и предыдущей. Благодарю за наводку Вроде удалось поправить прорисовку разделительной линии в методах GoRight и GoDown
Andrey: Делаю растяжку последней колонки в SetArrayTo() nColSpace := LEN(aDim) oBrw1:nAdjColumn := nColSpace // растянуть колонку до заполнения пустоты в бровсе справа Не растягивается.... Почему ?
Dima: Andrey Длина массива aDim равна кол-ву видимых колонок ?
Andrey: Dima пишет: Длина массива aDim равна кол-ву видимых колонок ? Да ! На экране 14 колонок, последняя пустая и некрасиво из-за этого.
Andrey: Привет всем ! Опять небольшая проблема с цветами в SetArrayTo(). Делаю так: LOCAL oBrw1 ....... oBrw1:SetColor( { 2 }, { { |a,b,o| iif( Month(o:aArray[o:nAt][5]) % 2 == 0, ; MyRGB( {0, 204, 255} ) ,; MyRGB(aBackClr) ) } } ) Потом беру эти цвета помещаю в массив AADD( aStatColorTable, { oBrw1:cControlName, 1, oBrw1:nClrText, NIL } ) AADD( aStatColorTable, { oBrw1:cControlName, 2, MyRGB({0,204,255}), MyRGB(aBackClr) } ) и записываю в ини-файл: ObjTable_1={"Set_Columns1", 1, 0, NIL} ObjTable_2={"Set_Columns1", 2, 16763904, 15515551} ObjTable_3={"Set_Columns1", 13, 255, NIL} Потом в ON INIT формы делаю считывание из ини-файла (массив aIni4Clr) и вывожу цвет в бровс: LOCAL oBrw52 ............... oBrw52 := gBrw52(cForm,"Set_Columns1") // считываю объект SetArrayTo() в локал переменную FOR nJ := 1 TO LEN(aIni4Clr) nVal := aIni4Clr[nJ,2] nColor := aIni4Clr[nJ,3] nColor2 := aIni4Clr[nJ,4] IF nVal == 2 oBrw52:SetColor( { 2 }, { { |a,b,o| iif( Month(o:aArray[o:nAt][5]) % 2 == 0, ; nColor , nColor2 ) } } ) ELSE IF nColor2 == NIL // если один цвет используется oBrw52:SetColor( { nVal }, { { || nColor } } ) ELSE oBrw52:SetColor( { nVal }, { { || { nColor , nColor2 } } } ) ENDIF ENDIF NEXT Цвета становятся ну просто светофор .... Чего я не учитываю ? Какая тонкость при восстановлении цветов ? Уже 3 день бьюсь... Помогите пожалуйста.
Haz: Andrey пишет: Чего я не учитываю Не проверял , но уверен что с блоком кода не учитываешь. В блок кода передаются локальные переменные и когда этот блок исполняется при прорисовке бровса , значения этих переменных непредсказуемы , отсюда и ну просто светофор ЗЫ. Опять небольшая проблема с цветами в SetArrayTo(). не верно локализован источник проблемы
Andrey: Haz пишет: В блок кода передаются локальные переменные и когда этот блок исполняется Почему ? При первом построении тоже использую локал: LOCAL aBackClr Сделал так: PRIVATE nTsbColor, nTsbColor2 Ну и дальше все переменные переименовал. Всё равно цвета - светофор !
Haz: При чем тут local ... Private говорю в блоке кода , к примеру в этом oBrw52:SetColor( { nVal }, { { || nColor } } ) . Чему равно nColor в момент прорисовки бровса при навигации по нему ? 100000% что не значению, которое было в цикле инициализации .... вот этим значением и рисует ЗЫ сделай так и удивись oBrw52:SetColor( { nVal }, { { || msgDebug(nVal, nColor), nColor } } )
Andrey: Haz пишет: ЗЫ сделай так и удивись oBrw52:SetColor( { nVal }, { { || msgDebug(nVal, nColor), nColor } } ) Удивился... А как тогда правильно сделать ?
Haz: Andrey пишет: А как тогда правильно сделать ? делал же ... TSB_CONFIG глянь
Andrey: Haz пишет: делал же ... TSB_CONFIG глянь Да, только там цветной блок попроще был.
Haz: Andrey пишет: Да, только там цветной блок попроще был. какая разница какой блок, важно как реализовано . или тут http://clipper.borda.ru/?1-1-0-00000399-000-240-0 твой пост N 3712 и два ответа ниже тоже с этой же ошибкой при вызоаве блока связаны
Andrey: Понял... Спасибо ! Кстати насчёт Tsb_config. Можно исправить ( класс oBrw:Excel2(...) h_tbrowse.prg) вывод чисел ? Если использовать для вывода в таблице формат "999" или "@Z 999", то в Экселе колонка с числами - пустая. В Tsb_config пришлось ставить: IF aPole[nI,6] <> "N" // не использовать шаблон для числовых полей, т.к. // при печати в Excel поле будет пустое !!! oBrw:aColumns[nJ]:cPicture := aPole[nI,4] // шаблон колонки ENDIF Сейчас такая же беда в рабочих программах....
Andrey: Ещё вопрос созрел по Tsbrowse. Как можно запретить юзеру смену колонок местами, но оставить возможность юзеру изменить размеры колонок ? Нашёл флаги: oBrw:lNoMoveCols := TRUE oBrw:lMChange := .F. Но они запрещают и изменение размеров колонок...
Haz: Andrey пишет: Как можно запретить юзеру смену колонок местами Простого способа похоже нет -или менять исходник , вводя и контролируя новые флаги -или на ON DRAW повесить процедуру, которая будет проверять нужный порядок колонок и приводить его в норму если юзер там чего поменял Посмотрел исходник и нашел один костыль ... Если у колонки есть суперхидер то размеры менять можно , а двигать нельзя. Сделай один суперхидер на все колонки с высотой 0 и будет тебе счастье ( правда супрхид будет не нулевой высоты )
Andrey: Haz пишет: Если у колонки есть суперхидер У меня есть он в программе. Haz пишет: нашел один костыль Какой он и как его использовать ?
Haz: Andrey пишет: Какой он и как его использовать ? читай по слогам Если у колонки есть суперхидер то размеры менять можно , а двигать нельзя. Сделай один суперхидер на все колонки с высотой 0 и будет тебе счастье
Andrey: Суперхидер в таблице есть с 1 по 13 колонки высотой 38. Колонки местами меняются. Ставлю запрет на обмен колонками oBrw:lNoMoveCols := TRUE или oBrw:lMChange := .F. Колонки местами не меняются и нельзя уже изменить размер колонок !
Haz: Andrey пишет: Суперхидер в таблице есть. Убери его , и добавь только такой ( для колонки 1 ) oBrw:AddSuperHead( 1 , 1 , '' ) После этого все колонки перестанут меняться местами PS. Говорю же , это "костыль" На счет всех, я не прав, не проверял а на одну работает! Советую лучше сюда смотреть -или менять исходник , вводя и контролируя новые флаги -или на ON DRAW повесить процедуру, которая будет проверять нужный порядок колонок и приводить его в норму если юзер там чего поменял
Andrey: Понял ! Спасибо БОЛЬШОЕ ! Haz пишет: Советую лучше сюда смотреть -или менять исходник , вводя и контролируя новые флаги -или на ON DRAW повесить процедуру, которая будет проверять нужный порядок колонок и приводить его в норму если юзер там чего поменял Боюсь пока не осилить данное предложение. Опыта пока маловато...
Haz: Andrey пишет: Боюсь пока не осилить данное предложение. Опыта пока маловато. какой тут опыт нужен ? Используется имя колонки, если оно не присвоено - работать не будет [pre2] // Сохранения порядка колонок по их именам Func SaveColPos( oBrw ) Local aSave := {} aEval( oBrw:aColumns, { |oCol| AADD( aSave, oCol:cName ) } ) Return aSave // Восстановление порядка колонок по их именам Func RestColPos( oBrw, aSave ) aEval( aSave, { |cName| oBrw:MoveColumn( oBrw:nColumn(cName), Ascan( aSave, cName)) } ) Return nil [/pre2] При первой прорисовке бровса запоминаешь порядок в массив Проверку на соответствие текущего порядка и сохраненного в массиве уверен сделаешь. И если порядок нарушен по ON DRAW восстанавливаешь как oBrw:bOnDraw := {|| IF( ЕслиНарушен(), RestColPos( oBrw, aSave), NIL ) } Пользователь после этого может таскать колонки куда хочет, но при этом быстро устает т.к. они сразу возвращаются на место. PS. НЕ ПРОВЕРЯЛ , просто описал идею. Должна работать PPS проверку нужно в том же он драу поводить )))
Andrey: Всем привет. Как заменить ОДНУ картинку в уже созданной таблице ? Допустим есть LOCAL ahBmpPlus := { LoadImage( "bFolder48.bmp" ) } LOCAL ahBmpMinus:= { LoadImage( "bFolder48x2.bmp" ) } ..... // создать первую колонку с картинкой ADD COLUMN TO oBrwP HEADER "" ; DATA { || ahBmpPlus } ; SIZE 50 BITMAP ; ..... EDITABLE oBrwP:aColumns[1]:bPrevEdit := {|| MenuPlusMinus(ahBmpPlus,ahBmpMinus), FALSE } ............... Function MenuPlusMinus(ahBmpPlus,ahBmpMinus) ..... // вот здесь заменить одну картинку на другую. Как написать ?
Andrey: Всем привет ! Пытаюсь для отладки добавить в свой проект h_tbrowse.prg Не собирается проект: Error: Unresolved external '_HB_FUN_GETSYSMETRICS' referenced from W:\HB_PROJECT\ Откуда взять эту функцию GETSYSMETRICS ? Раньше собиралось всё нормально.
Dima: Andrey пишет: Откуда взять эту функцию GETSYSMETRICS ? в TSBROWSE.CH он заявлен
Andrey: Dima пишет: в TSBROWSE.CH он заявлен Положил этот файл в свой проект. Всё равно пишет, нет такой функции... P.S. Удалил все obj - проект собрался !
Andrey: Отлавливаю ошибку для SetArrayTo(). Вот такая ошибка: Error BASE/1122 Неверный аргумент: TRANSFORM Called from TRANSFORM(0) Called from TSBROWSE:DRAWLINE(2925) Called from TSBROWSE:PAINT(8713) Called from TSBROWSE:DISPLAY(2306) Called from _ENDTBROWSE(367) Called from CREATEBROWSEUSE(430) Лезу в исходник и хочу там установить просмотр. Как это сделать, чтобы ручками не считать какую строку ProcName(5) смотреть ? IF UPPER(ProcName( 5 )) == "CREATEBROWSEUSE" MsgDebug(uData, VALTYPE(uData), cPicture) ENDIF uData := If( uData == NIL, "", Transform( uData, cPicture ) )
Andrey: Странно, отладка работает ОДНУ строку из массива, а потом прога сваливается: Called from TRANSFORM(0) Called from TSBROWSE:DRAWLINE(2928) Called from TSBROWSE:PAINT(8701) Called from TSBROWSE:DISPLAY(2306) Called from _ENDTBROWSE(367) Called from CREATEBROWSEUSE(430) Called from FORM_USEDBF(220) ..... Else IF UPPER(ProcName( 5 )) == "CREATEBROWSEUSE" MsgDebug(uData, VALTYPE(uData), cPicture) ENDIF uData := If( uData == NIL, "", Transform( uData, cPicture ) ) // строка 2928 EndIf Как поймать ошибку ?
Dima: Andrey Сунь массив в MsgDebug и позырь что в нем живет.
Andrey: Dima пишет: Сунь массив в MsgDebug и позырь что в нем живет. Позырил... До этого смотрел, не увидел. Один элемент вместо строки - массив.... И как такие ошибки в будущем отлавливать ? Может проверку какую сделать в самом исходнике ? Function SetArrayTo( ControlName, ParentForm, Arr, uFontHF, aHead, aSizes, uFooter, aPicture, aAlign, aName ) Local ix, oBrw ix := GetControlIndex (ControlName,ParentForm) oBrw:= _HMG_aControlIds [ix] oBrw:SetArrayTo(Arr, uFontHF, aHead, aSizes, uFooter, aPicture, aAlign, aName) Return oBrw
Dima: Andrey пишет: И как такие ошибки в будущем отлавливать ? Чрезмерно не косячить при написании
Andrey: Привет всем... Делаю новую таблицу на Tsbrowse. Ширину таблицы меняю в зависимости от окна, как Tsb_config. DEFINE WINDOW Form_0 AT 0,0 WIDTH nDesktopWidth HEIGHT nDesktopHeight ; MINWIDTH 780 MINHEIGHT 500 ; .......... WINDOWTYPE STANDARD TOPMOST ; ........ ON SIZE { || ResizeTable() } ; ON MAXIMIZE { || ResizeTable() } ; ////////////////////////////////////////////////////////////////// FUNCTION ResizeTable() LOCAL cForm := _HMG_ThisFormName LOCAL hWnd := GetFormHandle(cForm) // По методу Move() запускается ReSize() - описание параметров см. ???, // который запускает в конце работы кодовый блок bResized - в нем можно что-то еще подвигать oBrw:Move( oBrw:nLeft ,oBrw:nTop , GetClientWidth(hWnd), ; GetClientHeight(hWnd) - oBrw:nTop, .t.) //oBrw:Display() oBrw:Paint() // Иначе не перерисовываются вертикальные разделители MyToolBarTable(,,.T.) // перепостроить кнопки на форме Return Nil При изменения размера окна мышкой, какие то артефакты вылазят: Как исправить ?
Andrey: Добился такого же эффекта (расползания подвала таблицы) в примере MiniGUI\SAMPLES\Advanced\Tsb_config Разница небольшая: 1) Окно WINDOWTYPE STANDARD TOPMOST ; При первом запуске "расползание подвала" нет. Если мышкой перейти в ячейки, а потом попробовать изменить размер экрана, то начинается "расползание подвала" : Вот исправленный проект с демонстрацией - https://cloud.mail.ru/public/FBzx/BzqAUUxZz Вопрос остается таким же: как исправить (убрать расползание подвала таблицы ) ?
SergKis: Andrey пишет: расползание подвала таблицы Это эффект фантомной строки (обсуждали в теме о ней), т.е. если строк сделать больше, высоту tsb меньше и увеличивать постепенно, проявляется фант. строка, когда строк становится меньше - остается прорисованный ранее подал, т.е. нет метода очистить часть экрана, после факт. строк :nRowCount() и подвалом. Как лечить ? Не менять высоту tsb, если реальная высота (расчет см. в SetNoHole(oBrw) ) всех строк и заголовков\подвалов меньше\равно new высоте после Resize окна и в расчете new высоты использовать :nRowCount() * :nHeightCell + высоты заголовков\подвалов (что бы те было фантомной строки).
Haz: SergKis пишет: Это эффект фантомной строки Сергей, тут другая проблема. Глядя на скрины до фантома еще далеко т.к. строк в таблице мало. Тут лекарство к другому месту прикладывать надо. Andrey пишет: Как исправить ? Во первых внимательно посмотреть на код и задать себе вопрос по каждой строке зачем это написано. 1) [pre2] // По методу Move() запускается ReSize() - описание параметров см. ???, [/pre2] По этому методу никакой Resize() не запускается, в исходниках метод 4 строки , где там Resize()?, кокое описание параметров [pre2] METHOD Move( nTop, nLeft, nWidth, nHeight, lRepaint ) CLASS TControl MoveWindow( ::hWnd, nTop, nLeft, nWidth, nHeight, lRepaint ) ::CoorsUpdate() return nil [/pre2] 2) это зачем ? есть же простой и понятный метод Refresh(.T.) [pre2] //oBrw:Display() oBrw:Paint() // Иначе не перерисовываются вертикальные разделители [/pre2] 3) в примере ColorConfig еще какой то вызов CorrectFirstLast() ? Какого художника ... он вообще нужен ? Это была не совсем удачная попытка избавиться от залипания последней строки, как показала практика - не помогает. В теме про дырку , все расписали как надо с этим бороться и Сергей и Дима там все доступно рассказали Резюме Убрать неправильные комменты вместо паинта и дисплая поставить рефреш( Т) и чуть не забыл ... повыкидывать везде этот корректфёстласт
SergKis: Haz Я использовал [pre2] FUNCTION ResizeBrowse() LOCAL cForm := oBrw:cParentWnd LOCAL hWnd := GetFormHandle(cForm) LOCAL nHStBar := GetWindowHeight(GetControlHandle('STATUSBAR', cForm)) // height StatusBar Local actpos:={0,0,0,0} Local i, w, h GetClientRect(hWnd, actpos) w := actpos[3]-actpos[1] h := actpos[4]-actpos[2] - nHStBar - oBrw:nTop IF w !=0 .and. h != 0 SetProperty(oBrw:cParentWnd, oBrw:cControlName, "Enabled", .F.) _SetControlHeight( oBrw:cControlName, oBrw:cParentWnd, h) _SetControlWidth ( oBrw:cControlName, oBrw:cParentWnd, w) oBrw:Paint() SetProperty(oBrw:cParentWnd, oBrw:cControlName, "Enabled", .T.) // oBrw:Display() Endif Return Nil [/pre2] все видно в работе exe, как, я описал
Haz: SergKis пишет: oBrw:Paint() SetProperty(oBrw:cParentWnd, oBrw:cControlName, "Enabled", .T.) // oBrw:Display() Сергей, в примере у Андрея Tsb_config это код видимо с тебя списан , как и написал Андрей - в этом же примере приводит к залипанию футингов. При замене на банальный рефреш - залип исчезает
SergKis: Haz пишет:банальный рефреш - залип исчезает работает я пробнул display() - не то (а с фантомной решалось через это), а Paint() перерисовал, но криво, на рефреш и не подумал - оказывается зря
Andrey: Haz пишет: Сергей, в примере у Андрея Tsb_config это код видимо с тебя списан Мне этот код Григорий помогал писать. Если окно MAIN - работает без проблем. Я сделал окно WINDOWTYPE STANDARD - появился этот эффект. CorrectionFirstLast() убрал совсем, я Григорию предлагал новую версию этого примера для библиотеки, он не захотел. Из-за этого в старом примере и делал этот эффект, чтобы всем другим было понятней, от чего я исходил. Haz пишет: При замене на банальный рефреш - залип исчезает Да действительно исчез. Спасибо БОЛЬШОЕ !
Haz: Andrey пишет: Из-за этого в старом примере и делал этот эффект, чтобы всем другим было понятней, от чего я исходил. Андрей , Вот это главное. Не важно кто кому помогал, но если пример для обучения тех кто вообще впервые минигуи видит , то там не стоит оставлять комментарии которые могут запутать. Пример у тебя получился объемный и сложный, всего не углядишь и косяки могут вылезти внезапно. По мне , так вместо одного глобального примера - лучше 10 маленьких узко тематических И для понимания проще и поиграться проще при изучении. Вот ресайз тока что накидал , ничего лишнего и все понятно [pre2] #include "minigui.ch" #include "tsbrowse.ch" FUNC Main() Local aArray := { ; {'AAAAAAAAAAAAAAAA', 1, Date() }, ; {'BBBBBBBBBBBBBBBB', 2, Date() }, ; {'CCCCCCCCCCCCCCCC', 3, Date() }, ; {'DDDDDDDDDDDDDDDD', 4, Date() }, ; {'EEEEEEEEEEEEEEEE', 5, Date() }, ; {'FFFFFFFFFFFFFFFF', 6, Date() }, ; {'GGGGGGGGGGGGGGGG', 7, Date() } ; } DEFINE WINDOW Form_1 ; AT 0,0 ; WIDTH 400 ; HEIGHT 300 ; TITLE "TsBrowse ReSize Test" ; MAIN ; FONT 'Tahoma' SIZE 9; ON SIZE { || ResizeBrw( oBrw )} ; ON MINIMIZE { || ResizeBrw( oBrw )} ; ON MAXIMIZE { || ResizeBrw( oBrw )} DEFINE TBROWSE oBrw ; AT 5,5 ; OF Form_1 ; WIDTH GetProperty("Form_1", 'Width') - 25 ; HEIGHT GetProperty("Form_1", 'Height') - 50 ; FONT "Tahoma" ; SIZE 9 ; GRID ; EDIT oBrw:SetArray( aArray, .T. ) oBrw:nAdjColumn := 1 oBrw:aColumns[1]:cFooting := "STRING" oBrw:aColumns[2]:cFooting := "NUM" oBrw:aColumns[3]:cFooting := "DATE" oBrw:aColumns[1]:nFAlign := DT_LEFT oBrw:aColumns[2]:nFAlign := DT_LEFT oBrw:aColumns[3]:nFAlign := DT_CENTER oBrw:lFooting := .T. oBrw:lDrawFooters := .T. oBrw:nHeightFoot := 20 oBrw:DrawFooters() END TBROWSE END WINDOW ACTIVATE WINDOW Form_1 RETURN NIL FUNC ReSizeBrw( oBrw ) local nTop := GetProperty("Form_1", 'Row') + 5, ; nLeft := GetProperty("Form_1", 'Col') + 5, ; nWidth := GetProperty("Form_1", 'Width') - 25, ; nHeight := GetProperty("Form_1", 'Height') - 50 oBrw:Move( nTop,nLeft, nWidth, nHeight, .T. ) Return oBrw:Refresh(.T.) [/pre2]
Andrey: Haz пишет: По мне , так вместо одного глобального примера - лучше 10 маленьких узко тематических И для понимания проще и поиграться проще при изучении. Вот ресайз тока что накидал , ничего лишнего и все понятно Пример классный ! То что нужно для изучения новичку ! Когда делал свой пример, много не понимал. Что сделал - то сделал, нужно править. Выкладывал на форуме пробную версию - писал: комментарии и исправления приветствуются ! Haz пишет: nTop := GetProperty("Form_1", 'Row') + 5, ; nLeft := GetProperty("Form_1", 'Col') + 5, Только вместо этого лучше oBrw:nLeft ,oBrw:nTop ( новичку понятней буде как можно делать)
Andrey: SergKis пишет: IF w !=0 .and. h != 0 SetProperty(oBrw:cParentWnd, oBrw:cControlName, "Enabled", .F.) _SetControlHeight( oBrw:cControlName, oBrw:cParentWnd, h) _SetControlWidth ( oBrw:cControlName, oBrw:cParentWnd, w) oBrw:Paint() SetProperty(oBrw:cParentWnd, oBrw:cControlName, "Enabled", .T.) // oBrw:Display() Endif Уточни пожалуйста для чего это нужно ?
Haz: Andrey пишет: Уточни пожалуйста для чего это нужно ? так тут все и так все понятно oBrw:cParentWnd вернет имя формы в которой бровс определен oBrw:cControlName вернет имя самого бровса А дальше если ширина и высота после ресайса больше нуля, то бровсу говорят Enabled := F, затем меняют его размеры, прорисовывают и Enabled := T Видимо так тоже сработает, мне больше через :Move() нравится PS: Andrey пишет: Только вместо этого лучше oBrw:nLeft ,oBrw:nTop ( новичку понятней буде как можно делать) В примере nTop , nLeft и пр. это координаты формы Form_1 , а не самого бровса. Тогда уж не oBrw:nTop , а Form_1.Row. Мне больше через GetProperty нравится , т.к. универсально ( не требуется DECLARE WINDOW указывать если окно не объявлено выше по тексту ), но это дело привычки
Andrey: Привет всем ! Как работать с TBROWSE при перепоказе записей ? Описание проблемки: Установлен условный индекс по полю метка, меняем это значение, кол-во записей в TBROWSE изменилось. Указатель записи нужно поставить на следующую запись. cAlias := (oBrw:cAlias) .... CASE nKey == VK_SPACE cField := "MARK" IF FIELDNUM(cField) > 0 // есть ли такое поле в БД nRecno := (oBrw:cAlias)->(OrdKeyNo()) xVal := mFieldGet(cField, cAlias) xVal := ! xVal mFieldPut(cField, xVal, cAlias) oBrw:DrawSelect() IF LEN(aCargoFilter) > 0 // если стоит индекс-фильтр по этому полю, то обнулить бровс IF AT( cField, UPPER(aFilter[2]) ) > 0 oBrw:Reset() //oBrw:GoToRec( nRecno-1 ) // вот здесь не знаю как делать.... ENDIF ENDIF oBrw:Refresh(.F.) EndIf
Haz: Andrey пишет: Указатель записи нужно поставить на следующую запись. Посмотри как это делает TSBrowse при удалении записи , т.к. суть одинакова
Andrey: Haz пишет: Посмотри как это делает TSBrowse при удалении записи Вот это - METHOD TSBrowse:DeleteRow() ?
Haz: Andrey пишет: Вот это - METHOD TSBrowse:DeleteRow() ? Да, именно это
Andrey: Спасибо ! И ещё один вопрос созрел. Делаю: Add Super Header To oBrw1 From Column 1 To Column 8 ; Color CLR_BLACK, { CLR_RED , CLR_YELLOW } ; Title "Мой СУПЕРХИДЕР таблицы" 3DLook Можно ли на него создать обработку своей функции ? Как это сделать ? И как поменять центровку строк в этом суперхидере ?
Haz: Andrey пишет: Можно ли на него создать обработку своей функции какую обработку ? если клик по хидеру - то вроде есть такая Andrey пишет: И как поменять центровку строк в этом суперхидере опять таки какую центровку - горизонтальная есть
Andrey: Haz пишет: если клик по хидеру - то вроде есть такая Да, клик по хидеру. Я не нашел как повесить, допустим MsgDebug("Мой СУПЕРХИДЕР таблицы") ? Haz пишет: опять таки какую центровку - горизонтальная есть А мне нужно влево центровать, а не по центру.
Haz: Andrey пишет: А мне нужно влево центровать, а не по центру. влево вправо по центру - это все ГОРИЗОНТАЛЬНОЕ выравнивание По сути вопроса -гляну в исходниках позже
SergKis: Andrey пишет:А мне нужно влево центровать, а не по центру. [pre2] #command ADD [ SUPER ] HEADER TO <oBrw> ; FROM [ COLUMN ] <nFrom> ; TO [ COLUMN ] <nTo> ; [ <head:TITLE, HEADER> <cHead> ] ; [ HEIGHT <nHeight> ] ; [ <color:COLOR, COLORS> <aColors,...> ] ; [ <l3dLook: 3DLOOK, LOOK3D> ] ; [ FONT <uFont> ] ; [ <lGrid:NOGRID, NOLINES> ] ; [ BITMAP <uBmp> ] ; [ <lAdj:ADJUST> ] ; [ <lTra:TRANSPARENT> ] ; [ <horz:HORZ, HORZ ALIGN> <nHAlign> ] ; [ <vert:VERT, VERT ALIGN> <nVAlign> ] ; => ; <oBrw>:AddSuperHead( <nFrom>, <nTo>, <cHead>, [ <nHeight> ], ; [ \{<aColors>\} ], <.l3dLook.>, <uFont>, ; <uBmp>, <.lAdj.>, <.lTra.>, <.lGrid.>, ; <nHAlign>, <nVAlign> ) * ============================================================================ * METHOD TSBrowse:AddSuperHead() Version 9.0 Nov/30/2009 * ============================================================================ Method AddSuperHead( nFromCol, nToCol, uHead, nHeight, aColors, l3dLook, uFont, uBitMap, lAdjust, lTransp, ; lNoLines, nHAlign, nVAlign ) CLASS TSBrowse Local cHeading, nAt, nLheight, nOcurs, cRest, nLineStyle, nClrText, nClrBack, nClrLine, ; hFont := If( ::hFont != Nil, ::hFont, 0 ) Default lAdjust := .F., ; l3DLook := ::aColumns[ nFromCol ]:l3DLookHead, ; nHAlign := DT_CENTER, ; nVAlign := DT_CENTER, ; lTransp := .T., ; uHead := "" ... [/pre2]
Andrey: Делаю: Add Super Header To oBrw1 From Column 1 To Column 8 ; Color CLR_BLACK, { CLR_RED , CLR_YELLOW } ; Title "Мой СУПЕРХИДЕР таблицы" 3DLook HORZ DT_LEFT Ура, заработало ! И как еще повесить при нажатии на этот "Super Header", допустим MsgDebug("Мой СУПЕРХИДЕР таблицы") ?
SergKis: Andrey ... HORZ ALIGN DT_LEFT // Default DT_CENTER
SergKis: Andrey пишет:И как еще повесить при нажатии на этот "Super Header" есть блоки кода на колонку oCol:bHLClicked := {|nRowPix, nColPix, nAt| MsgDebug(nRowPix, nColPix, nAt) } // Block to be evaluated on header left clicked oCol:bHRClicked := {|nRowPix, nColPix, nAt| MsgDebug(nRowPix, nColPix, nAt) } // Block to be evaluated on header right clicked пикселы в nRow, nCol: nRow := oBrw:GetTxtRow( nRowPix ) nCol := oBrw:nAtCol( nColPix ) выведи их и по ним орентировка где кликали на header или SuperHeader вроде так в тестах делал.
Andrey: Я так понял, что можно заменять картинки для сортировки Tsbrowsa даже на PNG ! Сделал тест - работает ! Спасибо SergKis !!! Замена: // --------- заменяем сортировку на свои картинки индикации --------- oBrw5:aSortBmp := { LoadImage("Arrow_down.png"), LoadImage("Arrow_up.png") } И не обязательно делать картинки квадратными. Для того чтобы круг (см.картинку) не касался шапки заголовка справа я сделал картинки размером 30х34. А высоту шапки заголовка сделал чуть больше - oBrw5:nHeightHead := 32
Andrey: Перешёл на новую версию 16.02 и сразу вопрос: Почему перестало в шапке таблицы сдвигаться влево заголовок шапки при активации сортировки на этой шапке ? Вот картинка:
SergKis: Andrey http://clipper.borda.ru/?1-1-0-00000465-000-20-0-1455697477 пост 848 и далее
Andrey: Как сделать, чтобы в контекстном меню высвечивалась текущая строка колонки на которой стоит маркер ? Т.е. делаю так: // по правой кнопки мышки - контекстное меню TBROWSE DEFINE CONTEXT MENU CONTROL oBrw1 MENUITEM "File open 1: " + InfoFile(1,oBrw1:nAt) ACTION { || RunFile(1,oBrw1:nAt) } MENUITEM "File open 2: " + InfoFile(2,oBrw1:nAt) ACTION { || RunFile(2,oBrw1:nAt) } SEPARATOR .....
Haz: Andrey пишет: высвечивалась текущая строка колонки не проверял , но примерно так Eval( oBrw:aColumns[oBrw:nCell]:bData )
Andrey: Andrey пишет: Так ? Нет. Вот так:
Andrey: Haz пишет: не проверял , но примерно так Eval( oBrw:aColumns[oBrw:nCell]:bData ) Не прокатило.... DEFINE CONTEXT MENU CONTROL oBrw1 MENUITEM "File open 1: " + SUBSTR( Eval( oBrw1:aColumns[4]:bData ) ,1,60) ACTION { || RunFile(1) } MENUITEM "File open 2: " + SUBSTR( Eval( oBrw1:aColumns[4]:bData ) ,61 ) ACTION { || RunFile(2) } SEPARATOR Мне нужно из 4 колонки выбрать первую строчку, а потом вторую строчку. колонка сборная из 2х полей базы собрана: ADD COLUMN TO oBrw1 HEADER "Файлы" ; ......... DATA {|| (cAlias)->DIR1 + (cAlias)->FILE1 + CRLF + ; (cAlias)->DIR2 + (cAlias)->FILE2 }
Haz: Andrey пишет: Не прокатило.... ты по простому скажи , тебе надо чтоб в меню показывалось значение из текущей строки бровса ? ( то что строка составная сути не меняет, ловишь по разделителю )
Andrey: Haz пишет: ты по простому скажи , тебе надо чтоб в меню показывалось значение из текущей строки бровса ? Да !
Haz: чтобы сменить строку меню есть функция _SetMenuItemCaption ( cName , cWin , cCaption ) где cName задается при MENUITEM cCaption ACTION bAction NAME cName IMAGE cImage в твоем случае получается _SetMenuItemCaption() нужно вешать на ::bChange
Andrey: Спасибо БОЛЬШОЕ !
Andrey: Сделал так: MENUITEM "File open 1: " ACTION { || RunFile(1) } NAME MYNAMEOPENFILE1 MENUITEM "File open 2: " ACTION { || RunFile(2) } NAME MYNAMEOPENFILE2 ........ cCaption1 := "File open 1: " + (oBrw1:cAlias)->FILE1 _SetMenuItemCaption ( "MYNAMEOPENFILE1" , cForm , cCaption1 ) // строка 496 cCaption2 := "File open 2: " + (oBrw1:cAlias)->FILE2 _SetMenuItemCaption ( "MYNAMEOPENFILE2" , cForm , cCaption2 ) Выдаёт ошибку: Error BASE/1132 Переполнение массива: Неверное количество аргументов Called from _GETMENUIDS(561) Called from _SETMENUITEMCAPTION(757) Called from CHANGETABLE(496) Called from (b)MYCREATETABLE(432) Called from TSBROWSE:PAINT(8746) Called from TSBROWSE:DISPLAY(2306) Полез в h_menu.prg LOCAL x := GetControlIndex ( ItemName , FormName ) LOCAL h := _HMG_aControlPageMap [ x ] // строка 561 Я пока не знаю что это такое .... Что делать ?
Haz: Andrey пишет: Я пока не знаю что это такое .... это скорее всего значит что нет такого меню еще т.е на момент вызова bChange ничего не известно про меню примерный порядок DEFINE TSBROWSE END BROWSE DEFINE MENU END MENU oBrw:bChange := .......
Andrey: Haz пишет: примерный порядок Да и у меня тоже такой же: DEFINE TBROWSE oBrw1 ; ............... ON CHANGE { || ChangeTable() } ; ON GOTFOCUS ChangeTable() ; BACKCOLOR aBackColorTbr ; CELL END TBROWSE MyCreateTable() MyCreateTableMenu() STATIC FUNCTION ChangeTable() .....
Haz: Andrey пишет: Да и у меня тоже такой же Разный , бровс который обращается к меню в ON СHANGE объявляется когда этого меню еще и нет обрати внимание где у меня oBrw:bChange := .......
Andrey: Тогда нужно так: DEFINE TBROWSE oBrw1 ; END TBROWSE MyCreateTable() MyCreateTableMenu() oBrw1:bChange := { |oBrw| ChangeTable(oBrw) } ....... STATIC FUNCTION ChangeTable()
Haz: Andrey пишет: Тогда нужно так: так скорее всего получиться
Andrey: Нет, не пашет... Валится сразу при входе в программу. А как проверить наличие "MYNAMEOPENFILE1" ? LOCAL cForm := oBrw1:cParentWnd MsgLog( cForm , cCaption1, cCaption2 ) _SetMenuItemCaption ( "MYNAMEOPENFILE1" , cForm , cCaption1 ) _SetMenuItemCaption ( "MYNAMEOPENFILE2" , cForm , cCaption2 )
Andrey: Победил сваливание так: IF nStaticViewRecno # 0 // при первом показе - не выводить cCaption1 := "File open 1: " + (oBrw1:cAlias)->FILE1 cCaption2 := "File open 2: " + (oBrw1:cAlias)->FILE2 _SetMenuItemCaption ( "MYNAMEOPENFILE1" , cForm , cCaption1 ) _SetMenuItemCaption ( "MYNAMEOPENFILE2" , cForm , cCaption2 ) oBrw1:aColumns[1]:cFooting := { || ALLTRIM(Transform( nLen, "9 999" )) } cText := IIF( M->nPubLang == 1, " Записи: ", " Recno: ") oBrw1:aColumns[4]:cFooting := { || cText + cVal + "/" + cLen } oBrw1:DrawFooters() // выполнить прорисовку подвала TblFocus() ENDIF Но всё равно в контекстном меню нет имени файла ? В лог-файл выводится имена файлов, а в менюшку нет.
Haz: Andrey пишет: Но всё равно в контекстном меню нет имени файла ? В лог-файл выводится имена файлов, а в менюшку нет. Дарю ( вместо _SetMenuItemCaption ), вешай на ::bChange. Проверил на своем примере , все работает как надо [pre2] Func MenuCaptionSet( ItemName , FormName, Caption ) LOCAL a := _GetMenuIds ( ItemName , FormName ) LOCAL x := GetControlIndex ( ItemName , FormName ) LOCAL Id := _HMG_aControlIds [ x ] ModifyMenuItem ( a [1] , a [2] , Id , Caption ) return nil [/pre2] PS. подсмотрено в исходниках minigui - h_menu.prg - FUNCTION _ModifyMenuItem ( ItemName , FormName , Caption , action , name , Image )
Andrey: Haz пишет: Дарю ( вместо _SetMenuItemCaption ), вешай на ::bChange. Благодарю ! Сделаю пример - выложу. Только функцию _GetMenuIds() придётся тоже тащить из исходников к себе в проект. Там она STATIC FUNCTION _GetMenuIds().
Haz: Andrey пишет: Только функцию _GetMenuIds() придётся тоже тащить из исходников к себе в проект. Там она STATIC FUNCTION _GetMenuIds(). да придется
Andrey: Кодировка базы 866. Выводил таблицу всю сразу на экран, было отлично. Юзера захотели чтобы последний поиск (фильтр по базе) сохранялся и потом сразу показывался вместо всей базы. Сделал. Использую условную индексацию, т.е. показ базы по индексу. Теперь при показе таблицы на несколько секунд все записи в кракозябах (другая кодировка), потом строится индекс и всё записи показываются нормально ! Вопрос - как убрать показ этих кракозяб на экран ? Пробовал делать: SetProperty(oBrw:cParentWnd, oBrw:cControlName, "Enabled", .F.) TsbNewIndex(cForm,nTable,aFilter[2], aFilter[1], aFilter[3] ) SetProperty(oBrw:cParentWnd, oBrw:cControlName, "Enabled", .T.) Если ставишь отладку через MsgDebug() - кракозяб не видно !
Haz: Andrey пишет: Вопрос - как убрать показ этих кракозяб на экран ? Зачем в windows задаче кодировка 866 ? перекодируй в 1251 и проблема сама исчезнет. А по сути вопроса - лучше выложи самодостаточный, а то не получается угадать какой код и где что не так
Andrey: Haz пишет: Зачем в windows задаче кодировка 866 ? перекодируй в 1251 и проблема сама исчезнет. Не могу. Терминалку перевожу постепенно, сразу все таблицы не перевести. Некоторые не хотят нового интерфейса, оставь им старый, привычный. Так что год-два придётся использовать базы с 866 кодировкой. Проблему решил таким кодом: InkeyGui(10) и всё .... Я сам в шоке от такой простоты.
Haz: Andrey пишет: Проблему решил таким кодом: InkeyGui(10) и всё .... Заплатку поставил. Ведь причина глюка осталась неясной, значит выскочит в другом месте. Andrey пишет: Не могу. Терминалку перевожу постепенно, сразу все таблицы не перевести. Некоторые не хотят нового интерфейса, оставь им старый, привычный. Так что год-два придётся использовать базы с 866 кодировкой. Если консольную программу уже не развивать то нет и смысла сползать с 866 Я уже много много лет не использую 866 , а только 1251 и никаких проблем ни в консоли ни в гуи. Правда с консолью почти не работаю , только мелкие сервисные утилиты, да и базы у меня все нативные от RDDADS. в ADS кодировка ANSI используется по умолчанию , а OEM требует вызова перекодирования, это по исходникам видно.
Andrey: 1) Как в Tsbrowse заменить картинки для oCol:lCheckBox := .T. // virtual checkbox ? 2) Как организовать в Tsbrowse свои дополнительные поля со своими картинками ? т.е. в одной таблице нужен стандартный CheckBox и еще 2 дополнительных CheckBox со своими картинками. Примерно так же как в The Bat! И менюшку обработки по мышке:
Haz: Andrey пишет: 1) Как в Tsbrowse заменить картинки для oCol:lCheckBox := .T. // virtual checkbox ? 2) Как организовать в Tsbrowse свои дополнительные поля со своими картинками ? т.е. в одной таблице нужен стандартный CheckBox и еще 2 дополнительных CheckBox со своими картинками. Примерно так же как в The Bat! элементарно только не чеквокс это Организовать в базе 3 логических поля и по значению в них показывать или не показывать картинку см в примерах tsb_cursor я там календарь в текущей строке рисовал, замени lDrawSelect на значение из поля значение в поле должно инвертиться в bPrevEdit , который должен вернуть ложь чтоб не пустить в редактирование PS. если картинок в поле должно быть много то логическое поле не подойдет, сделай числовое и показывай нужную картинку в зависимости от числа в поле PSS в чекбоксе картинки определены из массива функции StockBmp() менять их там еще тот гемор ... но если есть желание - то желающие могут попробовать.
SergKis: Haz пишет: в чекбоксе картинки определены из массива функции StockBmp() менять их там еще тот гемор это не совсем так [pre2] METHOD DrawLine( xRow ) CLASS TSBrowse ... If lCheck Default ::aCheck := { StockBmp( 6 ), StockBmp( 7 )} hBitMap := ::aCheck[ If( Upper( uData ) == "T", 1, 2 ) ] [/pre2] делаем просто oBrw:aCheck := {LoadImage(<для .T.>), LoadImage(<для .F.>)} и все работает с новыми "галочками" (это может быть и файл и ресурс)
SergKis: Andrey пишет:InkeyGui(10) и всё .... Я сам в шоке от такой простоты. ты просто дал возможность обработать очередь, приостановив код на 10 мс., DO EVENTS тоже помогло бы, надо в гуи иногда давать возможность обрабатывать очередь сообщений
Haz: Andrey пишет: И менюшку обработки по мышке: мат в форуме запрещен ? тогда иди пожалуйста почитай хелп по контекстному меню
Haz: SergKis пишет: делаем просто oBrw:aCheck := {LoadImage(<для .T.>), LoadImage(<для .F.>)} и все работает с новыми "галочками" (это может быть и файл и ресурс) Сергей , это да... но позволяет задать общий aCheck на все колонки, а Андрею нужны свои на каждую если бы было так aColumns[]:aCheck := ... надо подумать над этой идеей
Andrey: Haz пишет: мат в форуме запрещен ? тогда иди пожалуйста почитай хелп по контекстному меню Да понял я.... Не надо матерится. Пример ты давал, я реализовал эту идею. Просто хотелось бы попроще эти галочки в контекстном меню реализовать. Может что то изменить в самом Tsbrowse ? Уж больно код выглядит не очень понятно для новичков ! Тестовый пример делаю. Как сделаю - выложу.
Dima: Haz пишет: мат в форуме запрещен ? Нет
Haz: Andrey пишет: Просто хотелось бы попроще эти галочки в контекстном меню реализовать. Может что то изменить в самом Tsbrowse ? я и не матерюсь контекстное меню реализовано проще некуда. А с картинками в колонках - только так , я пока не вижу как проще сделать кроме как Сергей навел на мысль про aColumns[]:aCheck И потом TS не для новмчков , также как browse класс в clipper / harbour т.к. не только новички а и некоторые старички в этот класс не лезут. То что имеет внутри множество инструментов для реализации почти любой хотелки - простым быть не может.
Haz: Dima пишет: Нет а чего ты молчал? теперь многие посты на форуме будут короткими и четкими как выстрел )
SergKis: Haz пишет:если бы было так aColumns[]:aCheck := ... надо подумать над этой идеей так вроде не сложно:[pre2] 1. добавляем в TsColumn DATA aCheck 2. чуть правим METHOD DrawLine( xRow ) CLASS TSBrowse ... If lCheck Default ::aCheck := { StockBmp( 6 ), StockBmp( 7 )} If Valtype(oColumn:aCheck) =="A" .and. Len(oColumn:aCheck) > 1 hBitMap := oColumn:aCheck[ If( Upper( uData ) == "T", 1, 2 ) ] Else hBitMap := ::aCheck[ If( Upper( uData ) == "T", 1, 2 ) ] EndIf [/pre2] и все
SergKis: SergKis пишет:и все надо добавить [pre2] METHOD Destroy() CLASS TSBrowse ... If ::aCheck != Nil //V90 DeleteObject ( ::aCheck[ 1 ] ) DeleteObject ( ::aCheck[ 2 ] ) EndIf AEval(::aColumns, {|oCol| If( Valtype(oCol:aCheck) == "A", AEval(oCol:aCheck, {|hBmp| DeleteObject (hBmp) }), ) }) [/pre2]
Haz: SergKis пишет: так вроде не сложно: Сергей, отлично все сделал и реально не сложно. Я под "подумать" имел ввиду, а нужен ли такой функционал вообще. Да он дает гибкость чекбоксам , но в силу логики тогоже чекбокса имеет только 2 состояния. Думаю все же полезен будет т.к. на будущее не оставляю идею сделать раскрывающееся дерево на базе TS а там значки [+] и [-] будут. Так же на потом оставил чекбокс с тремя состояниями true. false. nil т.к. работаю с ADS а там как порядочной SQL есть NULL Подождем что скажет Григорий про aColumns:[]:aCheck
SergKis: Haz пишет: а нужен ли такой функционал вообще .. ... чекбокс с тремя состояниями true. false. nil функционал нужен (разные image в колонках) и с тремя состояниями тоже вот доработал по случаю[pre2] METHOD DrawLine( xRow ) CLASS TSBrowse ... Local cCheckType, nCheckLen ... было lCheck := oColumn:lCheckBox .and. ValType( uData ) == "L" //V90 If lCheck .and. ValType( uData ) == "L" cPicture:= "" nVertText := If( uData, 3, 4 ) EndIf стало lCheck := oColumn:lCheckBox cCheckType := ValType( uData ) If lCheck .and. cCheckType == "L" cPicture:= "" nVertText := If( uData, 3, 4 ) EndIf было If lCheck Default ::aCheck := { StockBmp( 6 ), StockBmp( 7 )} hBitMap := ::aCheck[ If( Upper( uData ) == "T", 1, 2 ) ] nAlign := nMakeLong( DT_CENTER, DT_CENTER ) uData := "" EndIf стало If lCheck Default ::aCheck := { StockBmp( 6 ), StockBmp( 7 )} If Valtype(oColumn:aCheck) =="A" nCheckLen := Len(oColumn:aCheck) If cCheckType == "L" .and. nCheckLen > 1 hBitMap := oColumn:aCheck[ If( Upper( uData ) == "T", 1, 2 ) ] ElseIf nCheckLen > 2 hBitMap := oColumn:aCheck[ 3 ] EndIf ElseIf cChecType == "L" hBitMap := ::aCheck[ If( Upper( uData ) == "T", 1, 2 ) ] EndIf nAlign := nMakeLong( DT_CENTER, DT_CENTER ) uData := "" EndIf [/pre2]
SergKis: PS. ошибочка закралась[pre2] ElseIf cCheckType == "L" hBitMap := ::aCheck[ If( Upper( uData ) == "T", 1, 2 ) ] EndIf [/pre2]
Andrey: Прикрутил к полю выбор из меню: Через DEFINE CONTEXT MENU OF &cForm
Andrey: Вот вопрос возник:
SergKis: Andrey пишет:Вот вопросик ... вот ответик, в TsColumn.prg ... DATA uBmpCell // bitmap in cell (oBmp, hBmp or bBlock) DATA uBmpFoot // bitmap in footer (oBmp, hBmp or bBlock) DATA uBmpHead // bitmap in header (oBmp, hBmp or bBlock) DATA uBmpSpcHd // bitmap in special header (oBmp, hBmp or bBlock)
ММК: Haz пишет: Думаю все же полезен будет т.к. на будущее не оставляю идею сделать раскрывающееся дерево на базе TS а там значки [+] и [-] будут. Вот такой бровс с деревом в FWH если надо , могу исходник бровса прислать :)
Andrey: SergKis пишет: вот ответик, в TsColumn.prg Спасибо ! Не сообразил сразу там посмотреть ! Сделал ! Только страшновато выглядит: Использую прозрачный PNG. Может по другому надо ?
Haz: ММК пишет: если надо , могу исходник бровса прислать :) Ага Скинь в почту 047545(собака)mail(точка)ru плиз или ссылку на облако дай. Скачаю с интересом гляну как там реализовано. Мне нужно дерево с ветвями до восьмого уровня, пока не пойму как его сделать , пока на фильтрах пытаюсь делать
Andrey: Григорий ! Предлагаю код, который сделал SergKis поместить в исходник TsBrowsa ! Function GetCellSize( oBrw, nRowPos, nCell, lColSpecHd ) // координаты и размеры ячейки TsBrowse LOCAL nI, ix, nStartX := 0, oCol, cBrw, cForm LOCAL nRow, nCol, nWidth, nHeight Default nRowPos := oBrw:nRowPos, ; nCell := oBrw:nCell, ; lColSpecHd := .F. cForm := oBrw:cParentWnd cBrw := oBrw:cControlName oCol := oBrw:aColumns[ nCell ] If oBrw:nFreeze > 0 For nI := 1 To Min( oBrw:nFreeze , nCell - 1 ) nStartX += oBrw:GetColSizes()[ nI ] Next EndIf For nI := oBrw:nColPos To nCell - 1 nStartX += oBrw:GetColSizes()[ nI ] Next IF lColSpecHd // ячейка в SpecHeader nRow := oBrw:nHeightHead + oBrw:nHeightSuper + If( oCol:l3DLook, 2, 0 ) nCol := nStartX + If( oCol:l3DLook, 2, 0 ) nWidth := oBrw:GetColSizes()[ nCell ] - If( oCol:l3DLook, 2, 1 ) nHeight := oBrw:nHeightSpecHd - If( oCol:l3DLook, 1, -1 ) else // ячейка в таблице nRow := nRowPos - 1 nRow := ( nRow * oBrw:nHeightCell ) + oBrw:nHeightHead + ; oBrw:nHeightSuper + oBrw:nHeightSpecHd + If( oCol:l3DLook, 2, 0 ) nCol := nStartX + If( oCol:l3DLook, 2, 0 ) nWidth := oBrw:GetColSizes()[ nCell ] - If( oCol:l3DLook, 2, 0 ) nHeight := oBrw:nHeightCell - If( oCol:l3DLook, 1, -1 ) endif ix := GetControlIndex ( cBrw, cForm ) // размеры и координаты как для if _HMG_aControlContainerRow [ix] == -1 // TGETBOX !!! nRow += oBrw:nTop - 1 nCol += oBrw:nLeft else nRow += _HMG_aControlRow [ix] - 1 nCol += _HMG_aControlCol [ix] endif nRow += oBrw:aEditCellAdjust[1] nCol += oBrw:aEditCellAdjust[2] nWidth += oBrw:aEditCellAdjust[3] + 2 nHeight += oBrw:aEditCellAdjust[4] + 2 Return { nRow, nCol, nWidth, nHeight } Я в своё время намучился, но так и не сделал такую функцию.
Haz: Andrey пишет: // координаты и размеры ячейки TsBrowse Два вопроса : 1) а если ячейка за пределами окна бровса , что вернет ? 2) Для чего нужно ?
SergKis: Haz пишет:1) а если ячейка за пределами окна бровса , что вернет ? 2) Для чего нужно ? /quote] 1) проверяешь сам видима\не видима колонка 2) для доп. действий на Edit 3) для реализации external edition ... [pre2] If oCol:bExtEdit != Nil // external edition ::lNoPaint := ::lEditing := .F. uVar := Eval( oCol:bExtEdit, uValue, Self ) ::lChanged := ValType( uVar ) != ValType( uValue ) .or. uVar != uValue ::lPostEdit := .T. ::oWnd:nLastKey := VK_RETURN ::PostEdit( uVar, nCell, bValid ) Return Nil EndIf [/pre2] пример на базе Tsb_array_2 [pre2] #include "minigui.ch" #include "TSBrowse.ch" PROCEDURE MAIN LOCAL oBrw, aDatos, aArray, aHead, aSize, aFoot, aPict, aAlign, aName, aFontHF LOCAL aFont := {} // Local hFontHead, hFontFoot LOCAL cFontName := _HMG_DefaultFontName LOCAL nFontSize := 11 LOCAL nY, nX, oCol SET DECIMALS TO 4 SET DATE TO GERMAN SET EPOCH TO 2000 SET CENTURY ON SET EXACT ON DEFINE FONT Font_1 FONTNAME cFontName SIZE nFontSize DEFINE FONT Font_2 FONTNAME cFontName SIZE nFontSize BOLD AAdd( aFont, GetFontHandle( "Font_1" ) ) AAdd( aFont, GetFontHandle( "Font_2" ) ) DEFINE WINDOW test ; TITLE "SetArray For Report Demo" ; MAIN ; NOMAXIMIZE NOSIZE DEFINE STATUSBAR FONT cFontName SIZE nFontSize STATUSITEM "0" // WIDTH 0 FONTCOLOR BLACK STATUSITEM "Item 1" WIDTH 230 // FONTCOLOR BLACK STATUSITEM "Item 2" WIDTH 230 // FONTCOLOR BLACK STATUSITEM "Item 3" WIDTH 230 // FONTCOLOR BLACK END STATUSBAR nY := test.HEIGHT - GetProperty( "test", "StatusBar", "Height" ) - 70 nX := 20 @ nY, nX LABEL Lbl_Test VALUE "" WIDTH 200 HEIGHT 40 BACKCOLOR { 35, 179, 15} DEFINE TBROWSE oBrw ; AT 1 + iif( IsVistaOrLater(), GetBorderWidth()/2, 0 ), ; 1 + iif( IsVistaOrLater(), GetBorderHeight()/2, 0 ) ; WIDTH test.WIDTH - 2 * GetBorderWidth() ; HEIGHT test.HEIGHT - GetTitleHeight() - ; GetProperty( "test", "StatusBar", "Height" ) - ; 2 * GetBorderHeight() - 50 ; ENUMERATOR ; FONT cFontName SIZE nFontSize ; GRID EDIT aDatos := CreateDatos() aArray := aDatos[ 1 ] aHead := aDatos[ 2 ] aSize := aDatos[ 3 ] aFoot := aDatos[ 4 ] aPict := aDatos[ 5 ] aAlign := aDatos[ 6 ] aName := aDatos[ 7 ] // hFontHead := aFont[1] // normal Header // hFontFoot := aFont[2] // bold Footer // aFontHF := { hFontHead, hFontFoot } // aFontHF := aFont[1] // normal Header, Footer aFontHF := aFont[2] // bold Header, Footer oBrw := SetArrayTo( "oBrw", "test", aArray, aFontHF, aHead, aSize, aFoot, aPict, aAlign, aName ) // oBrw:nLineStyle := LINES_NONE oBrw:nWheelLines := 1 oBrw:nClrLine := COLOR_GRID oBrw:nHeightCell += 5 oBrw:nHeightHead += 5 IF ! Empty( aFoot ) oBrw:nHeightFoot += 5 ENDIF IF oBrw:lEnum oBrw:nHeightSpecHd := oBrw:nHeightCell ENDIF oCol := oBrw:GetColumn("ColName_7") oCol:bPrevEdit := {|uVl,oBr | mPrevEdit(uVl, oBr) } oCol:bPostEdit := {|uVl,oBr,lAp| mPostEdit(uVl, oBr, lAp) } END TBROWSE END WINDOW DoMethod( "test", "Activate" ) RETURN * ====================================================================== STATIC FUNCTION CreateDatos() LOCAL i, k := 1000, aDatos, aHead, aSize, aFoot, aPict, aAlign, aName aDatos := Array( k ) FOR i := 1 TO k aDatos[ i ] := { " ", ; // 1 i, ; // 2 ntoc( i ) + "_123", ; // 3 Date() + i, ; // 4 PadR( "Test line - " + ntoc( i ), 20 ), ; // 5 Round( ( 10000 -i ) * i / 3, 2 ), ; // 6 100.00 * i, ; // 7 0.12, ; // 8 Round( 100.00 * i * 0.12, 2 ), ; // 9 Round( 1234567.00 / i, 3 ), ; // 10 PadR( "Line " + StrZero( i, 5 ), 20 ), ; // 11 Date(), ; // 12 Time(), ; // 13 i % 2 == 0 } // 14 NEXT aHead := AClone( aDatos[ 1 ] ) // AEval(aHead, {|x,n| aHead[ n ] := "Head_" + hb_ntos(n) }) AEval( aHead, {| x, n| aHead[ n ] := "Head" + hb_ntos( n ) + ; iif( n % 2 == 0, CRLF + "SubHead" + hb_ntos( n ), "" ) } ) aFoot := Array( Len( aDatos[ 1 ] ) ) AEval( aFoot, {| x, n| aFoot[ n ] := n } ) // aFoot := .T. // подножие есть с пустыми значениями aPict := Array( Len( aDatos[ 1 ] ) ) // можно не задавать, формируются aPict[ 10 ] := "99999999999.999" // автоматом для C,N по мах значению aSize := Array( Len( aDatos[ 1 ] ) ) // можно не задавать, формируются aSize[ 10 ] := aPict[ 10 ] // автоматом по мах значению в колонке aAlign := Array( Len( aDatos[ 1 ] ) ) // тип поля C - DT_LEFT aAlign[ 2 ] := DT_CENTER // D,L - DT_CENTER // N - DT_RIGHT aName := Array( Len( aDatos[ 1 ] ) ) AEval( aName, {| x, n| aName[ n ] := "ColName_" + hb_ntos( n ) } ) RETURN { aDatos, aHead, aSize, aFoot, aPict, aAlign, aName } Function GetCellSize( oBrw, nRowPos, nCell, lColSpecHd ) // координаты и размеры ячейки TsBrowse LOCAL nI, ix, nStartX := 0, oCol, cBrw, cForm LOCAL nRow, nCol, nWidth, nHeight Default nRowPos := oBrw:nRowPos, ; nCell := oBrw:nCell, ; lColSpecHd := .F. cForm := oBrw:cParentWnd cBrw := oBrw:cControlName oCol := oBrw:aColumns[ nCell ] If oBrw:nFreeze > 0 For nI := 1 To Min( oBrw:nFreeze , nCell - 1 ) nStartX += oBrw:GetColSizes()[ nI ] Next EndIf For nI := oBrw:nColPos To nCell - 1 nStartX += oBrw:GetColSizes()[ nI ] Next IF lColSpecHd // ячейка в SpecHeader nRow := oBrw:nHeightHead + oBrw:nHeightSuper + If( oCol:l3DLook, 2, 0 ) nCol := nStartX + If( oCol:l3DLook, 2, 0 ) nWidth := oBrw:GetColSizes()[ nCell ] - If( oCol:l3DLook, 2, 1 ) nHeight := oBrw:nHeightSpecHd - If( oCol:l3DLook, 1, -1 ) else // ячейка в таблице nRow := nRowPos - 1 nRow := ( nRow * oBrw:nHeightCell ) + oBrw:nHeightHead + ; oBrw:nHeightSuper + oBrw:nHeightSpecHd + If( oCol:l3DLook, 2, 0 ) nCol := nStartX + If( oCol:l3DLook, 2, 0 ) nWidth := oBrw:GetColSizes()[ nCell ] - If( oCol:l3DLook, 2, 0 ) nHeight := oBrw:nHeightCell - If( oCol:l3DLook, 1, -1 ) endif ix := GetControlIndex ( cBrw, cForm ) // размеры и координаты как для if _HMG_aControlContainerRow [ix] == -1 // TGETBOX !!! nRow += oBrw:nTop - 1 nCol += oBrw:nLeft else nRow += _HMG_aControlRow [ix] - 1 nCol += _HMG_aControlCol [ix] endif nRow += oBrw:aEditCellAdjust[1] nCol += oBrw:aEditCellAdjust[2] nWidth += oBrw:aEditCellAdjust[3] + 2 nHeight += oBrw:aEditCellAdjust[4] + 2 Return { nRow, nCol, nWidth, nHeight } STATIC FUNCTION mPrevEdit( uVal, oBrw ) LOCAL cForm := oBrw:cParentWnd LOCAL cBrw := oBrw:cControlName LOCAL nRowPos := oBrw:nRowPos LOCAL nCell := oBrw:nCell LOCAL oCol := oBrw:aColumns[ nCell ] LOCAL lRet := .T., aS, nY, nX, nW, nH, cLbl := "Lbl_Test" LOCAL lSH := .T. // .T. - SpecHead, .F. - Cell, меняем тут If oCol:cName == "ColName_7" aS := GetCellSize(oBrw, nRowPos, nCell, lSH) nY := aS[1] + If( lSH, 0, aS[4] ) nX := aS[2] nW := aS[3] nH := aS[4] SetProperty(cForm, cLbl, "Row" , nY) SetProperty(cForm, cLbl, "Col" , nX) SetProperty(cForm, cLbl, "Width" , nW) SetProperty(cForm, cLbl, "Height" , nH) SetProperty(cForm, cLbl, "Visible", .T.) SetProperty(cForm, cLbl, "Value" , "") EndIf RETURN lRet STATIC FUNCTION mPostEdit( uVal, oBrw, lApp ) LOCAL cForm := oBrw:cParentWnd LOCAL cBrw := oBrw:cControlName LOCAL nCell := oBrw:nCell LOCAL oCol := oBrw:aColumns[ nCell ] LOCAL lRet := .T., cLbl := "Lbl_Test" If oCol:cName == "ColName_7" SetProperty(cForm, cLbl, "Visible", .F.) EndIf RETURN lRet [/pre2]
SergKis: PS вкл. Edit на колонке 7
Haz: Сергей привет SergKis пишет: проверяешь сам видима\не видима колонка 1) а не проще сразу ::nCell использовать ? ( сам отвечу, проще но так универсальнее ) 2) как использовать и для чего я сразу понял , т. к. делал почти тоже но уже из oEdit объекта PS Пример хороший , сам присматривался к получению координат по аналогии с методом ::Edit() ,как раз то что ты реализовал. PSS правда не увидел в нем внешнего редактирования ) Григорий , действительно полезная функция, добавьте в библиотеку пожалуйста Пра мыслей как можно ее использовать 1) Организация всплывающий подсказок при редактировании ячейки 2) Псевдо комбобоксы под ячейкой ( бровс по вариантам )
SergKis: Haz пишет: а не проще сразу ::nCell использовать ? не всегда нужен ::nCell иногда нужен nCell - 2 и т.д. и т.п. Haz пишет: делал почти тоже но уже из oEdit объекта в bPrevEdit, bExtEdit нет oEdit, потому нужен механизм размеров (в моем проекте это метод ::GetCellSize(...)) Haz пишет: правде не увидел в нем внешнего редактирования под BROWSE такой механизм (несколько GetBox на Label) работает, почему тут не будет ? что исп. для внешнего редактирования GetBox или др. TSB - по ситуации
Haz: SergKis пишет: потому нужен механизм размеров (в моем проекте это метод ::GetCellSize(...)) Сергей , раз уж начал ..... Может в метод переделаешь METHOD GetCellInfo() Возвращает объект oCell c данными ( примерно эти , дальше нарастет по необходимости ) ::nRow ::nCol ::nWidth ::nHeight и код из твоего примера станет таким oCell := oBrw:GetCellinfo(nRowPos, nCell, lSH) nY := oCell:nRow + If( lSH, 0, oCell:nHeight ) nX := oCell:nCol nW := oCell:nWidth nH := oCell:nHeight
SergKis: Haz пишет:Может в метод переделаешь METHOD GetCellInfo() хорошее название - сделаю пример на 2-а GetBox для ввода в 7-ю колонку (Label не прикрутил - прорисовка линий на нем от TSB) [pre2] #include "minigui.ch" #include "TSBrowse.ch" PROCEDURE MAIN LOCAL oBrw, aDatos, aArray, aHead, aSize, aFoot, aPict, aAlign, aName, aFontHF LOCAL aFont := {} // Local hFontHead, hFontFoot LOCAL cFontName := _HMG_DefaultFontName LOCAL nFontSize := 11 LOCAL nY, nX, oCol LOCAL cForm := "test" SET DECIMALS TO 4 SET DATE TO GERMAN SET EPOCH TO 2000 SET CENTURY ON SET EXACT ON DEFINE FONT Font_1 FONTNAME cFontName SIZE nFontSize DEFINE FONT Font_2 FONTNAME cFontName SIZE nFontSize BOLD AAdd( aFont, GetFontHandle( "Font_1" ) ) AAdd( aFont, GetFontHandle( "Font_2" ) ) DEFINE WINDOW test ; TITLE "SetArray For Report Demo" ; MAIN ; NOMAXIMIZE NOSIZE DEFINE STATUSBAR FONT cFontName SIZE nFontSize STATUSITEM "0" // WIDTH 0 FONTCOLOR BLACK STATUSITEM "Item 1" WIDTH 230 // FONTCOLOR BLACK STATUSITEM "Item 2" WIDTH 230 // FONTCOLOR BLACK STATUSITEM "Item 3" WIDTH 230 // FONTCOLOR BLACK END STATUSBAR DEFINE TBROWSE oBrw ; AT 1 + iif( IsVistaOrLater(), GetBorderWidth()/2, 0 ), ; 1 + iif( IsVistaOrLater(), GetBorderHeight()/2, 0 ) ; WIDTH test.WIDTH - 2 * GetBorderWidth() ; HEIGHT test.HEIGHT - GetTitleHeight() - ; GetProperty( "test", "StatusBar", "Height" ) - ; 2 * GetBorderHeight() - 50 ; ENUMERATOR ; FONT cFontName SIZE nFontSize ; GRID EDIT aDatos := CreateDatos() aArray := aDatos[ 1 ] aHead := aDatos[ 2 ] aSize := aDatos[ 3 ] aFoot := aDatos[ 4 ] aPict := aDatos[ 5 ] aAlign := aDatos[ 6 ] aName := aDatos[ 7 ] // hFontHead := aFont[1] // normal Header // hFontFoot := aFont[2] // bold Footer // aFontHF := { hFontHead, hFontFoot } // aFontHF := aFont[1] // normal Header, Footer aFontHF := aFont[2] // bold Header, Footer oBrw := SetArrayTo( "oBrw", "test", aArray, aFontHF, aHead, aSize, aFoot, aPict, aAlign, aName ) // oBrw:nLineStyle := LINES_NONE oBrw:nWheelLines := 1 oBrw:nClrLine := COLOR_GRID oBrw:nHeightCell += 5 oBrw:nHeightHead += 5 IF ! Empty( aFoot ) oBrw:nHeightFoot += 5 ENDIF IF oBrw:lEnum oBrw:nHeightSpecHd := oBrw:nHeightCell ENDIF oCol := oBrw:GetColumn("ColName_7") oCol:bPrevEdit := {|uVl,oBr| mPrevEdit(uVl, oBr) } // oCol:bPostEdit := {|uVl,oBr,lAp| mPostEdit(uVl, oBr, lAp) } // oCol:bExtEdit := {|uvl,oBr | mExtEdit (uVl, oBr ) } END TBROWSE // контролы ОБЯЗАТЕЛЬНО после TsBrowse, что бы z-ордер был большим у них, чем у TSB nY := test.HEIGHT - GetProperty( "test", "StatusBar", "Height" ) - 80 nX := 20 @ nY, nX LABEL Lbl_Test VALUE "" WIDTH 40 HEIGHT 40 BACKCOLOR { 35, 179, 15} nX += 40 + 10 @ nY, nX GETBOX Get_Sum1 WIDTH 40 HEIGHT 20 VALUE 0 PICTURE "999.99" ; VALID mGet_Sum() ON LOSTFOCUS mLostFocus() nX += 40 + 10 @ nY, nX GETBOX Get_Sum2 WIDTH 40 HEIGHT 20 VALUE 0 PICTURE "999.99" ; VALID mGet_Sum() ON LOSTFOCUS mLostFocus() test.Get_Sum1.Cargo := oBrw test.Get_Sum2.Cargo := oBrw oBrw:SetFocus() END WINDOW DoMethod( "test", "Activate" ) RETURN * ====================================================================== STATIC FUNCTION CreateDatos() LOCAL i, k := 1000, aDatos, aHead, aSize, aFoot, aPict, aAlign, aName aDatos := Array( k ) FOR i := 1 TO k aDatos[ i ] := { " ", ; // 1 i, ; // 2 ntoc( i ) + "_123", ; // 3 Date() + i, ; // 4 PadR( "Test line - " + ntoc( i ), 20 ), ; // 5 Round( ( 10000 -i ) * i / 3, 2 ), ; // 6 100.00 * i, ; // 7 0.12, ; // 8 Round( 100.00 * i * 0.12, 2 ), ; // 9 Round( 1234567.00 / i, 3 ), ; // 10 PadR( "Line " + StrZero( i, 5 ), 20 ), ; // 11 Date(), ; // 12 Time(), ; // 13 i % 2 == 0 } // 14 NEXT aHead := AClone( aDatos[ 1 ] ) // AEval(aHead, {|x,n| aHead[ n ] := "Head_" + hb_ntos(n) }) AEval( aHead, {| x, n| aHead[ n ] := "Head" + hb_ntos( n ) + ; iif( n % 2 == 0, CRLF + "SubHead" + hb_ntos( n ), "" ) } ) aFoot := Array( Len( aDatos[ 1 ] ) ) AEval( aFoot, {| x, n| aFoot[ n ] := n } ) // aFoot := .T. // подножие есть с пустыми значениями aPict := Array( Len( aDatos[ 1 ] ) ) // можно не задавать, формируются aPict[ 10 ] := "99999999999.999" // автоматом для C,N по мах значению aSize := Array( Len( aDatos[ 1 ] ) ) // можно не задавать, формируются aSize[ 10 ] := aPict[ 10 ] // автоматом по мах значению в колонке aAlign := Array( Len( aDatos[ 1 ] ) ) // тип поля C - DT_LEFT aAlign[ 2 ] := DT_CENTER // D,L - DT_CENTER // N - DT_RIGHT aName := Array( Len( aDatos[ 1 ] ) ) AEval( aName, {| x, n| aName[ n ] := "ColName_" + hb_ntos( n ) } ) RETURN { aDatos, aHead, aSize, aFoot, aPict, aAlign, aName } Function GetCellSize( oBrw, nRowPos, nCell, lColSpecHd ) // координаты и размеры ячейки TsBrowse LOCAL nI, ix, nStartX := 0, oCol, cBrw, cForm LOCAL nRow, nCol, nWidth, nHeight Default nRowPos := oBrw:nRowPos, ; nCell := oBrw:nCell, ; lColSpecHd := .F. cForm := oBrw:cParentWnd cBrw := oBrw:cControlName oCol := oBrw:aColumns[ nCell ] If oBrw:nFreeze > 0 For nI := 1 To Min( oBrw:nFreeze , nCell - 1 ) nStartX += oBrw:GetColSizes()[ nI ] Next EndIf For nI := oBrw:nColPos To nCell - 1 nStartX += oBrw:GetColSizes()[ nI ] Next IF lColSpecHd // ячейка в SpecHeader nRow := oBrw:nHeightHead + oBrw:nHeightSuper + If( oCol:l3DLook, 2, 0 ) nCol := nStartX + If( oCol:l3DLook, 2, 0 ) nWidth := oBrw:GetColSizes()[ nCell ] - If( oCol:l3DLook, 2, 1 ) nHeight := oBrw:nHeightSpecHd - If( oCol:l3DLook, 1, -1 ) else // ячейка в таблице nRow := nRowPos - 1 nRow := ( nRow * oBrw:nHeightCell ) + oBrw:nHeightHead + ; oBrw:nHeightSuper + oBrw:nHeightSpecHd + If( oCol:l3DLook, 2, 0 ) nCol := nStartX + If( oCol:l3DLook, 2, 0 ) nWidth := oBrw:GetColSizes()[ nCell ] - If( oCol:l3DLook, 2, 0 ) nHeight := oBrw:nHeightCell - If( oCol:l3DLook, 1, -1 ) endif ix := GetControlIndex ( cBrw, cForm ) // размеры и координаты как для if _HMG_aControlContainerRow [ix] == -1 // TGETBOX !!! nRow += oBrw:nTop - 1 nCol += oBrw:nLeft else nRow += _HMG_aControlRow [ix] - 1 nCol += _HMG_aControlCol [ix] endif nRow += oBrw:aEditCellAdjust[1] nCol += oBrw:aEditCellAdjust[2] nWidth += oBrw:aEditCellAdjust[3] + 2 nHeight += oBrw:aEditCellAdjust[4] + 2 Return { nRow, nCol, nWidth, nHeight } STATIC FUNCTION mLostFocus() LOCAL ix, lSum, hFocus := GetFocus() LOCAL cForm := _HMG_ThisFormName LOCAL cSm1 := "Get_Sum1" LOCAL cSm2 := "Get_Sum2" If hFocus != 0 ix := ascan(_HMG_aControlHandles, hFocus) If ix > 0 lSum := _HMG_aControlNames[ ix ] == cSm1 .or. ; _HMG_aControlNames[ ix ] == cSm2 If ! lSum SetProperty(cForm, cSm1, "Visible", .F.) SetProperty(cForm, cSm2, "Visible", .F.) EndIf EndIf EndIf RETURN Nil STATIC FUNCTION mGet_Sum() LOCAL lRet := .T., nCell, oCol, nSm1, nSm2, nSum LOCAL cForm := _HMG_ThisFormName LOCAL cName := _HMG_ThisControlName LOCAL oBrw := GetProperty(cForm, cName, "Cargo") LOCAL cSm1 := "Get_Sum1" LOCAL cSm2 := "Get_Sum2" If Valtype(oBrw) == "O" nCell := oBrw:nCell oCol := oBrw:GetColumn(nCell) If cName == "Get_Sum2" nSm1 := GetProperty(cForm, cSm1, "Value") nSm2 := GetProperty(cForm, cSm2, "Value") nSum := nSm1 * nSm2 mPostEdit(nSum, oBrw) EndIf EndIf RETURN lRet STATIC FUNCTION mPrevEdit( uVal, oBrw ) LOCAL cForm := oBrw:cParentWnd LOCAL cBrw := oBrw:cControlName LOCAL nRowPos := oBrw:nRowPos LOCAL nCell := oBrw:nCell LOCAL oCol := oBrw:aColumns[ nCell ] LOCAL lRet := .T., aS, nY, nX, nW, nH, nD := 4 LOCAL cLbl := "Lbl_Test" LOCAL cSm1 := "Get_Sum1" LOCAL cSm2 := "Get_Sum2" If oCol:cName == "ColName_7" aS := GetCellSize(oBrw, nRowPos, nCell - 1) nY := aS[1] nX := aS[2] nW := aS[3] nH := aS[4] SetProperty(cForm, cSm1, "Row" , nY) SetProperty(cForm, cSm1, "Col" , nX) SetProperty(cForm, cSm1, "Width" , nW) SetProperty(cForm, cSm1, "Height" , nH) SetProperty(cForm, cSm1, "Visible", .T.) SetProperty(cForm, cSm1, "Value" , 0) nY := aS[1] + aS[4] nX := aS[2] nW := aS[3] nH := aS[4] SetProperty(cForm, cSm2, "Row" , nY) SetProperty(cForm, cSm2, "Col" , nX) SetProperty(cForm, cSm2, "Width" , nW) SetProperty(cForm, cSm2, "Height" , nH) SetProperty(cForm, cSm2, "Visible", .T.) SetProperty(cForm, cSm2, "Value" , 0) DoMethod(cForm, cSm1, "SetFocus") lRet := .F. EndIf RETURN lRet STATIC FUNCTION mPostEdit( uVal, oBrw, lApp ) LOCAL cForm := oBrw:cParentWnd LOCAL cBrw := oBrw:cControlName LOCAL nCell := oBrw:nCell LOCAL oCol := oBrw:aColumns[ nCell ] LOCAL lRet := .T. LOCAL cLbl := "Lbl_Test" LOCAL cSm1 := "Get_Sum1" LOCAL cSm2 := "Get_Sum2" LOCAL nSum If oCol:cName == "ColName_7" SetProperty(cForm, cSm2, "Visible", .F.) SetProperty(cForm, cSm1, "Visible", .F.) nSum := EVal(oCol:bData) If uVal != nSum oBrw:aArray[oBrw:nAt][nCell] := uVal oBrw:DrawSelect() EndIf EndIf RETURN lRet [/pre2]
SergKis: Haz переделал [pre2] CLASS TSBcell VAR nRow AS NUMERIC INIT 0 VAR nCol AS NUMERIC INIT 0 VAR nWidth AS NUMERIC INIT 0 VAR nHeight AS NUMERIC INIT 0 METHOD New() INLINE ( Self ) ENDCLASS METHOD GetCellInfo( nRowPos, nCell, lColSpecHd ) CLASS TSBrowse LOCAL nI, ix, nStartX := 0, oCol, cBrw, cForm LOCAL nRow, nCol, nWidth, nHeight LOCAL oCell := TSBcell():New() Default nRowPos := ::nRowPos, ; nCell := ::nCell, ; lColSpecHd := .F. cForm := ::cParentWnd cBrw := ::cControlName oCol := ::aColumns[ nCell ] If ::nFreeze > 0 For nI := 1 To Min( ::nFreeze , nCell - 1 ) nStartX += ::GetColSizes()[ nI ] Next EndIf For nI := ::nColPos To nCell - 1 nStartX += ::GetColSizes()[ nI ] Next IF lColSpecHd nRow := ::nHeightHead + ::nHeightSuper + If( oCol:l3DLook, 2, 0 ) nCol := nStartX + If( oCol:l3DLook, 2, 0 ) nWidth := ::GetColSizes()[ nCell ] - If( oCol:l3DLook, 2, 1 ) nHeight := ::nHeightSpecHd - If( oCol:l3DLook, 1, -1 ) else nRow := nRowPos - 1 nRow := ( nRow * ::nHeightCell ) + ::nHeightHead + ; ::nHeightSuper + ::nHeightSpecHd + If( oCol:l3DLook, 2, 0 ) nCol := nStartX + If( oCol:l3DLook, 2, 0 ) nWidth := ::GetColSizes()[ nCell ] - If( oCol:l3DLook, 2, 0 ) nHeight := ::nHeightCell - If( oCol:l3DLook, 1, -1 ) endif ix := GetControlIndex ( cBrw, cForm ) if _HMG_aControlContainerRow [ix] == -1 nRow += ::nTop - 1 nCol += ::nLeft else nRow += _HMG_aControlRow [ix] - 1 nCol += _HMG_aControlCol [ix] endif nRow += ::aEditCellAdjust[1] nCol += ::aEditCellAdjust[2] nWidth += ::aEditCellAdjust[3] + 2 nHeight += ::aEditCellAdjust[4] + 2 oCell:nRow := nRow oCell:nCol := nCol oCell:nWidth := nWidth oCell:nHeight := nHeight Return oCell [/pre2]
Haz: SergKis пишет: переделал отлично теперь с форума будем собирать идеи по наполнению класса CLASS TSBcell
gfilatov2002: SergKis пишет: переделал Благодарю за помощь Подключил новый метод к классу, проверил работу примера с этим методом - полет нормальный
полная версия страницы