Форум » 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:....
SergKis: Andrey пишет Есть такой метод ? Берешь запускаешь hbedit.exe h_tbrowse.prg, делаешь Alt+L, в полученном списке набираешь что хочешь найти, к примеру, "draw" и смотришь содержимое найденных ф-й. Начни смотреть DrawHeaders() и другие. Потратишь несколько минут
Andrey: Пробовал в шапке/подвале разные картинки: bmp, png - очень некрасиво получаются: Если шапку/подвал делать белым или серым, без градиента, то более менее нормально. В нумераторе bmp красиво выглядит. Вопрос: можно ли как то сделать, чтобы картинки не делались цветом фона (убрать цвет фона), т.е. ключ какой то прикрутить, типа: [pre2]oBrw:lImgBackcolor := .T. / .F. [/pre2] Или это можно уже сейчас делать, а я и не знаю ?
Haz: Andrey пишет: Или это можно уже сейчас делать, а я и не знаю ? Можно , в си модуле поиграть с маской вывода.
Andrey: Haz пишет: Можно , в си модуле поиграть с маской вывода. Хоть напиши где этот модуль... А как протащить свой переключатель ?
Haz: Andrey пишет: Хоть напиши где этот модуль... единственный с мидуль в исходниках tsb, функция вроде tsdrawcell . в ней штук 5 вызовов вставки картинки , используется константа SCRAND . Можно поставить SCRCOPY и прозрачность фона и картинки уйдет . Вставь этот модуль на си целиком в свой проект через #pragma и меняй как хочешь. Ps.что означают эти константы в справке микрософт есть.
Haz: Andrey пишет: А как протащить свой переключатель ? править си и prg исходники. Сейчас не могу , перегруз
Andrey: Haz пишет: Вставь этот модуль на си целиком в свой проект через #pragma и меняй как хочешь. Для себя поставить один раз, да можно. Но хотелось бы нормального решения. [pre2] C:\borland\BCC55\Include\wingdi.h /* Ternary raster operations */ #define SRCCOPY (DWORD)0x00CC0020 /* dest = source */ #define SRCPAINT (DWORD)0x00EE0086 /* dest = source OR dest */ #define SRCAND (DWORD)0x008800C6 /* dest = source AND dest */ #define SRCINVERT (DWORD)0x00660046 /* dest = source XOR dest */ #define SRCERASE (DWORD)0x00440328 /* dest = source AND (NOT dest ) */ #define NOTSRCCOPY (DWORD)0x00330008 /* dest = (NOT source) */ #define NOTSRCERASE (DWORD)0x001100A6 /* dest = (NOT src) AND (NOT dest) */ #define MERGECOPY (DWORD)0x00C000CA /* dest = (source AND pattern) */ C:\MiniGUI\SOURCE\TsBrowse\c_TBrowse.c HB_FUNC( TSDRAWCELL ) { HWND hWnd = ( HWND ) HB_PARNL( 1 ); HDC hDC = ( HDC ) HB_PARNL( 2 ); int nRow = hb_parni( 3 ); int nColumn = hb_parni( 4 ); int nWidth = hb_parni( 5 ); .... DrawBitmap( hDC, hBitMap, nTop, nLeft, 0, 0, bSelec ? 0 : SRCAND ); [/pre2]
Andrey: Поставил целиком исправленный c_TBrowse.c в проект Вот что получилось: Спасибо БОЛЬШОЕ Haz
SergKis: Andrey пишет Поставил целиком исправленный c_TBrowse.c в проект Если не изменяет память, давно, в какой то версии, уже была замена с SRCCOPY на SRCAND
Andrey: А вот про это я тоже забыл. Некрасиво выглядит картинка в ячейках: Тогда нужно два переключателя, для шапки/подвала/суперхидера/номератора и для ячеек. [pre2]oBrw:lImgNoCellTransparency := .T. / .F. oBrw:lImgCellTransparency := .T. / .F. [/pre2]
Haz: SergKis пишет: Если не изменяет память, давно, в какой то версии, Да , несколько лет назад была именно по причине непрозрачного вывода. На тот момент замена немного сгладила вывод, потом появилась поддержка PNG с прозрачным фоном, может еще что то менялось. На моей памяти этот модуль менялся всего 2 раза, это изменение в скролле с целью убрать лишние прорисовку и эта маска с целью хоть как то получить прозрачность. В большинстве случаев отображение корректное, но бывает маску вывода нужно менять. Это единственное место где идет вывод графики в ячейку и параметр маски туда не передается. Если это требуется, просто включаю этот си модуль в проект и подбираю локально нужное значение. По хорошему эту маску нужно передавать параметром с установкой нужного значения по умолчанию, но подгрузить си модуль проще
Haz: Andrey пишет: Тогда нужно два переключателя, для шапки/подвала/суперхидера/номератора и для ячеек. oBrw:lImgNoCellTransparency := .T. / .F. oBrw:lImgCellTransparency := .T. / .F. Не нужны переключатели, нужно явное задание маски примерно так oCol:nCellBitmapMask := SCRAND и пр.
SergKis: Haz пишет нужно явное задание маски примерно так oCol:nCellBitmapMask := ... В HB_FUNC( TSDRAWCELL ) свободен 27 параметр или добавить 33-й[pre2] //HBRUSH wBrush = ( HBRUSH ) HB_PARNL( 27 ); BOOL b3DInv = ( HB_ISNIL( 28 ) ? FALSE : ! hb_parl( 28 ) ); BOOL b3D = ( HB_ISNIL( 28 ) ? FALSE : TRUE ); COLORREF nClr3DL = hb_parnl( 29 ); COLORREF nClr3DS = hb_parnl( 30 ); long lCursor = hb_parnl( 31 ); BOOL bSelec = ( HB_ISNIL( 32 ) ? FALSE : hb_parl( 32 ) ); [/pre2] а для колонок надо маску для каждого элемента определять oCol:nCellBmpMask oCol:nHeadBmpMask oCol:nFootBmpMask oCol:nSpcHdBmpMask AAdd( ::aSuperHead, { nFromCol, nToCol, uHead, nClrText, nClrBack, l3dLook, hFont, uBitMap, lAdjust, nLineStyle, ; nClrLine, nHAlign, nVAlign, lTransp, nSupHdBmpMask } ) //Super Header Вместо Bmp слово Image использовать в имени (Bmp короче) PS Есть еще void DrawMasked( HDC hDC, HBITMAP hbm, int wRow, int wCol ) с масками, с ней как ? PS2 Значение маски может задаваться блоком кода ?
Andrey: SergKis пишет: а для колонок надо маску для каждого элемента определять Отличная идея !
Haz: SergKis пишет: В HB_FUNC( TSDRAWCELL ) свободен 27 параметр или добавить 33-й думаю лучше добавить 33. Новая сущность , новый параметр
Haz: SergKis пишет: а для колонок надо маску для каждого элемента определять oCol:nCellBmpMask oCol:nHeadBmpMask oCol:nFootBmpMask oCol:nSpcHdBmpMask Вот поэтому мне проще было си модуль прицепить
SergKis: Вот поэтому мне проще было си модуль прицепить Понимаю, но вроде и описанные элементы, 33-ий параметр и немного добавить в методах :Draw...() для опр. 33-го параметра. В целом немного. Скажи что в С модуле менял, я туда не лазил
Haz: SergKis пишет: Скажи что в С модуле менял, я туда не лазил [pre2] else { if( bAdjBmp ) { DrawBitmap( hDC, hBitMap, rct.top, rct.left - 2, rct.right - rct.left + 3, rct.bottom - rct.top - 1, bSelec ? 0 : SRCAND ); hBitMap = 0; if( ! bOpaque ) MaskRegion( hDC, &rct, GetPixel( hDC, nLeft, nTop ), GetBkColor( hDC ) ); } else if( bOpaque ) DrawBitmap( hDC, hBitMap, nTop, nLeft, 0, 0, bSelec ? 0 : SRCAND ); // вот это отвечает за вывод uBmpCell в ячейке else DrawMasked( hDC, hBitMap, nTop, nLeft ); } } [/pre2]
SergKis: Игорь А это место (из текста выше) как ?[pre2] DrawBitmap( hDC, hBitMap, rct.top, rct.left - 2, rct.right - rct.left + 3, rct.bottom - rct.top - 1, bSelec ? 0 : SRCAND ); [/pre2]
Haz: SergKis пишет: А это место (из текста выше) как ? да просто ставил нужную маску вместо SRCAND и собирал проект. Если менять системно, то надо вводить 33 параметр в эту функцию int nMask = hb_parni( 33 ); и примерно DrawBitmap( hDC, hBitMap, rct.top, rct.left - 2, rct.right - rct.left + 3, rct.bottom - rct.top - 1, bSelec ? 0 : nMask ); В си тоже не особо силен, и по этой причине не стал делать тоже
SergKis: Haz пишет Если менять системно, то надо вводить 33 параметр в эту функцию Сделал без блока кода. Кинул Андрею тестировать. Назвал переменные[pre2] DATA nBmpMaskCell INIT 0x008800C6 // SRCAND DATA nBmpMaskHead INIT 0x008800C6 // SRCAND DATA nBmpMaskFoot INIT 0x008800C6 // SRCAND DATA nBmpMaskSpcHd INIT 0x008800C6 // SRCAND Установка такая работает STATIC FUNCTION myBrwEnum( oBrw, nOneCol ) LOCAL oCol, nI := 0, nCnt := 0 DEFAULT nOneCol := 1 FOR EACH oCol IN oBrw:aColumns nI++ oCol:cSpcHeading := NIL oCol:cSpcHeading := IIF( nI == nOneCol, "#" , "+" ) IF nI > nOneCol IF oCol:lVisible oCol:cSpcHeading := hb_ntos( ++nCnt ) oCol:nBmpMaskHead := 0x00CC0020 // SRCCOPY oCol:nBmpMaskSpcHd := 0x00CC0020 // SRCCOPY ENDIF ENDIF NEXT Для Super Header добавился 15 элемент, т.е. oBrw:aSuperHead[ nI, 15 ] := 0x00CC0020 // SRCCOPY [/pre2]
Haz: SergKis пишет: Сделал без блока кода. Кинул Андрею тестировать. Назвал переменные вроде должно все пройти нормально . Пробовал в СИ правку что выше давал. тоже работает
Andrey: Сергей сделал задание константы для маски показа картинки. Я прикрутил менюшку для проверки этих масок. Есть несколько интересных масок. Выглядит вот так:
krutoff: Понадобилось длинный заголовок колонки разделить на строки и показать меньшим шрифтом. Но высота заголовка получилась как для стандартного фонта oBrw. И в итоге половина высоты заголовка - пустая. Если поменять Height потом в OnInit - сдвигаются все строки. Нашел ошибку в h_tbrowse.prg: функция STATIC FUNCTION SetHeights( oBrw ) Строка 15787: hFont := iif( hFont == NIL, 0, oBrw:hFont ) -> высоту заголовка по любому расчитывает по стандартному фонту. Самому менять каждый раз - не выход, прошу поменять, хотя бы на такое: hFont := iif( hFont == NIL, 0, hFont )
gfilatov2002: krutoff пишет: hFont := iif( hFont == NIL, 0, hFont ) Поправил, конечно (в трех местах - заголовок, подвал и ячейка). Благодарю за помощь
Andrey: Смотрю код в терминалке [pre2]hb_cdpSelect( "RU1251" ) use STREET new Browse() use[/pre2] А можно так же сделать для ТСБ ? Определить параметры по умолчанию и открывать для просмотра базу. А то чтобы просто показать базу, кода приходиться просто немеренно писать. Колонку SELECTOR и ORDKEYNO и ENUMERATOR включать сразу
Haz: Andrey пишет: use STREET new Browse() use Все тоже самое [pre2] Use street new Sbrowse() Use [/pre2] Andrey пишет: Колонку SELECTOR и ORDKEYNO и ENUMERATOR включать сразу Тогда немеряно кода придется писать всем, кому селекторы и нумераторы нафиг не нужны. Не нравится sBrowse(), в чем проблема написать один раз смотровой тсб под себя, оформить в виде библиотеки чтоб не таскать исходник по проектам.
SergKis: Andrey пишет Колонку SELECTOR и ORDKEYNO и ENUMERATOR включать сразу Ты же сам всегда хочешь их иметь[pre2] DEFINE TBROWSE &cTabl OBJ oBrw CELL ; AT nYBrw, nXBrw ALIAS cAls WIDTH nWBrw HEIGHT nHBrw ; FONT aTsbFont ; // все фонты для таблицы BRUSH aBrush ; // цвет фона под таблицей COLORS aColors ; // все цвета таблицы BACKCOLOR aBackColor ; // фон таблицы - совпадает с фоном окна HEADERS aHeader ; // список шапки колонок таблицы JUSTIFY aAlign ; // список отбивки колонок таблицы COLUMNS aField ; // список наименований колонок таблицы NAMES aNames ; // список полей базы колонок таблицы EDITCOLS aEdit ; // массив данных для редактирования колонок .T.\.F.\Nil>\.T\.F.\NIL FOOTERS aFooter ; // список подвала колонок таблицы SIZES aFSize ; // ширина колонок таблицы LOADFIELDS ; // автоматическое создание столбцов по полям активной базы данных GOTFOCUSSELECT ; EMPTYVALUE ; FIXED ; // активирует функцию двойного курсора на закрепленных столбцах COLNUMBER aNumer ; // виртуальная колонка с нумерацией ENUMERATOR ; // нумерация колонок LOCK ; // автоматическая блокировка записи при вводе в базу данных SELECTOR xSelector ; // первая колонка - селектор записей ON INIT {|ob| myBrwInit( ob ) } // настройки таблицы - смотреть ниже [/pre2] Поставь в nil все задаваемые параметры в DEFINE ... кроме ON INIT ... и начиная с FONT ... Должен сработать :LoadFields(), возможно надо задать цвет для правильной работы, что то такое [pre2] aColors := {} AAdd(aColors, { CLR_FOCUSB, { |a,b,c| If( c:nCell == b, n_RGB1, n_RGB3 ) } } ) AAdd(aColors, { CLR_SELEF , GetSysColor( COLOR_WINDOWTEXT ) } ) AAdd(aColors, { CLR_SELEB , { |a,b,c| If( c:nCell == b, n_RGB2, n_RGB3 ) } } ) [/pre2] PS. Точно не помню, вроде были правки, но может путаю со своей версией (все NIL у меня работают), а в hmg нет, не стыковка по aHeader := NIL и aField := NIL, т.к. они идут внутри aHeader := {NIL} и aField := {NIL} - это ломало тсб. Надо заполнить их массивами от имен полей. Начни с NIL все, если свалится заполни aHeader := {...} и aField := {...} от полей
krutoff: Я сформировал динамически TSBrowse и шапка из-за большого к-ва строк заняла почти все место. В итоге - показывается только одна строка из нескольких. Когда я на первой строке нажимаю клавишу Up а потом Down -> то TSBrowse рисует эту первую строку в заголовке таблицы. Нашел место, где можно поправить. Прошу изменить в h_tbrowse.prg строку 7464 ::nRowPos := nLines на -> ::nRowPos := nLines + IIF(nLines==1,1,0)
gfilatov2002: krutoff пишет: можно поправить. Прошу изменить в h_tbrowse.prg Ok
SergKis: Haz Игорь, ты вроде, разбирался с VScrollBar, HScrollBar тсб, как их активировать в примере Tsb_2tsb ? На 1-м тсб место под них есть, а отображения нет, перемещение ячейки в фокусе мало что дает. Я не смотрел V\H Bar, т.к. в моей версии (тсб 7.0) два тсб на окне не фурычат. Может подскажешь что ?
SergKis: Игорь Все норм, понял, "где собака порылась". Надо DO EVENTS поставить, дать возможность отрисовать все [pre2] ... oBrw1 := _TBrowse( NIL, "CUST1", "Brw_1", nY, nX, nW, nH ) AEval( oBrw1:aColumns, {| oCol | oCol:lFixLite := .T., ; oCol:lEdit := .T., ; oCol:lOnGotFocusSelect := .T., ; oCol:lEmptyValToChar := .T. } ) DO EVENTS nY += nH + 1 nH -= 1 oBrw2 := _TBrowse( NIL, "CUST2", "Brw_2", nY, nX, nW, nH ) AEval( oBrw2:aColumns, {| oCol | oCol:lFixLite := .T., ; oCol:lEdit := .T., ; oCol:lOnGotFocusSelect := .T., ; oCol:lEmptyValToChar := .T. } ) DO EVENTS oBrw1:SetFocus() //oBrw1:Refresh() DO EVENTS ... [/pre2]
krutoff: Столкнулся со странной ситуацией, когда TSBrowse вылелает по ошибке в строке 9627 Error BASE/1132 Переполнение массива: Ошибочное количество аргументов Args: [1] = A { ... } length: 6 [2] = N 0 Ошибка плавающая и возникает не всегда. Прошу немного изменить код в этой строке, он практически ничего не меняет, но ошибка пропадает: old: ELSEIF nMsg == WM_DESTROY .AND. ! Empty( ::aColumns ) .AND. ::aColumns[ ::nCell ]:oEdit != NIL New: ELSEIF nMsg == WM_DESTROY .AND. ! Empty( ::aColumns ) .AND. ::nCell > 0 .AND. ::aColumns[ ::nCell ]:oEdit != NIL
SergKis: krutoff пишет .AND. ::nCell > 0 А как вы получаете :nCell := 0 ? У вас ! Empty( ::aColumns ), т.е. колонки заданы ... У меня не было таких случаев. Даже :nColumn(<имя отсутствует>) дает 1 По мне, правка, мало что дает, в др. местах конструкция, типа, :aColumns[ :nCell ] много где применяется.
krutoff: SergKis пишет: А как вы получаете :nCell := 0 Сергей, сам не понимаю. CHILD форму создаю динамически, на ней 2 броуза ( два алиаса ) и куча контролов get, editbox и т.д. Причем обработка броузов делает одна и та же функция, но все переменные (алиасы, названия броузов и т.д. ) внутри броуза навесил на oKeyData(). Если в моей форме создается динамически один броуз - все отрабатывает нормально, а если 2 - вылетает. Сделал кучу отладки - и вышел на эту строку. ::nCell в отладке показывает ненулевое значение, oEdit = NiL Причем, если строку разделяю, откусываю подстроку .AND. ::aColumns[ ::nCell ]:oEdit != NIL и прописываю ниже, как отдельное условие IF ::aColumns[ ::nCell ]:oEdit != NIL - все тоже проходит Ок... Кроме этого места нигде не вылетает, может DESTROY цепляет?, но опять же вылет идет уже на 1-м броузе, а не на 2-м.
SergKis: krutoff пишет один броуз - все отрабатывает нормально, а если 2 - вылетает. Попробуйте добавить DO EVENS или DoEvents() в блоки кода, возможно, что то не успевает отработать, прорисовать, т.е. :nCell == 0 не должно быть. Посмотрите завершение Edit, т.к. идет WM_DESTROY при ::aColumns[ ::nCell ]:oEdit != NIL, созданном объекте для edit, т.е. работа в :Edit и его завершение. Может oBrw:IsEdit применить надо ? Например, если открыт TGetBox и даем oBrw:SetFocus(), он закрывается, но :nCell в :Edit и завершающих :Edit..., меняется только для перестановки от oCol:nEditMove - может там что то происходит. Правку, предложенную, сделать не трудно, но :nCell := 0 не должно быть, источник надо бы найти Вместо CHILD MODAL можете попробовать ?
Haz: krutoff пишет: сам не понимаю Кажется мне, что это накладки локальной переменной в каком то из блоков кода. Оба бровса в одной функции создаются скорее всего и на переменных экономите ( к примеру oBrw используется в обоих бровсах и в блоках кода )
krutoff: SergKis пишет: Вместо CHILD MODAL можете попробовать ? Спасибо, MODAL отрабатывает, я это уже проверил, но если модал, то внутренние окна у меня сделаны CHILD ( для seek ) - и тогда не откроются, и надо тоже только модальные, а не ice. DoEvents() и oBrw:IsEdit буду тестировать, спасибо за подсказку, я на основе oBrw строю форму для редактирования и поэтому oBrw:IsEdit думаю, всегда .F.
krutoff: Haz пишет: Кажется мне, что это накладки локальной переменной в каком то из блоков кода. Спасибо!, мог конечно, и не заметить, но доп.переменные только в классе TBrowse (добавлял __objAddData() ) и oKeyData(). Проверял, проверю еще раз, спасибо. А oBrw -> имени у меня нет, вообще имя oBE - и то, только в параметрах функций. И везде перепроверил на соответствие oBE:cParentWnd и oBE:cControlName. показали два разных Brows'a.
SergKis: krutoff MODAL отрабатывает, я это уже проверил, но если модал, то внутренние окна у меня сделаны CHILD ( для seek ) - и не открываются, а тогда надо тоже только модальные, а не ice Желательно, перейти на MODAL (мной замечено, что они понадежнее\стабильнее CHILD) + по child можно "неожиданно" перереключаться не туда и завершать окна с вопросом .... Надо добавлять установку родителя перед и восстанавливать после, переменная _hmg_InplaceParentHandle (первое окно modal после MAIN, STANDARD, этого делать не надо). я на основе oBrw строю форму для редактирования Это как в примере Tsb_DemoMdi - карточка-запись в тсб ( ф-я MdiChildCard() ) ? поэтому oBrw:IsEdit думаю, всегда .F. Если в oCol:oEdit не NIL, то внешние попытки что то делать, требуют проверки oBrw:IsEdi, например [pre2] ON KEY TAB ACTION {|cf| cf := ThisWindow.FocusedControl, ; iif( cf == "Brw_1", This.Brw_2.SetFocus, This.Brw_1.SetFocus ) } ON KEY SHIFT+TAB ACTION {|cf| cf := ThisWindow.FocusedControl, ; iif( cf == "Brw_1", This.Brw_2.SetFocus, This.Brw_1.SetFocus ) } ON KEY ESCAPE ACTION ( iif( oBrw1:IsEdit, oBrw1:SetFocus(), ; iif( oBrw2:IsEdit, oBrw2:SetFocus(), ; ThisWindow.Release ) ) ) [/pre2] TAB и SHIFT+TAB при включенной ячейки на :Edit() отработают нормально, а ESCAPE надо проверять и при вкл. :Edit() сначала закрывать, что бы не потерять данные, введенные в др. контролы
Andrey: Опять старая проблема вылезла, несколько лет назад такое было и не решили как исправить. Глюк показа в левом нижнем углу колонки SELECTOR - при условии что цвет фона ПОДВАЛА последней колонки отличается от основного цвета. Вот так на картинке: Т.е. цвет фона последней колонки ОРАНЖЕВЫЙ и он перескакивает на SELECTOR - кружок (2). Вот код как это происходит: [pre2] // цвета изменить nClrNoDbf := GetSysColor( COLOR_BTNFACE ) oCol := oBrw:GetColumn("ORDKEYNO") oCol:nClrBack := nClrNoDbf // цвет фона шапки таблицы + подвала списка колонок - (1) FOR nI := oBrw:nColumn("ORDKEYNO") TO Len( oBrw:aColumns ) oCol := oBrw:aColumns[ nI ] cCol := oCol:cName cTyp := oCol:cFieldTyp IF cTyp $ "+=^" // Type: [+] [=] [^] oCol:nClrHeadBack := CLR_ORANGE oCol:nClrFootBack := CLR_ORANGE ENDIF NEXT // Левый верхний уголок - (3) исправление фона oBrw:nClrSelectorHdBack := nClrNoDbf [/pre2] Как исправить уголок (2) ? Может можно сделать в коде ТСБ примерно такую переменную ? [pre2] // Левый нижний уголок oBrw:nClrSelectorHdFoot := nClrNoDbf [/pre2]
SergKis: Andrey пишет Как исправить уголок (2) ? Может можно сделать в коде ТСБ примерно такую переменную ? Можно использовать ту же переменную, что и для Header, т.е. сделать такую правку [pre2] METHOD DrawHeaders( lFooters, lDrawCell ) CLASS TSBrowse ... IF ::lFooting .AND. ::lDrawFooters ... If !( nJ == 1 .AND. ::lSelector ) // JP nClrBack := iif( oColumn:nClrFootBack != NIL, oColumn:nClrFootBack, nClrFootBack ) ELSEIF ::nClrSelectorHdBack != NIL nClrBack := ::nClrSelectorHdBack ELSE nClrBack := ATail( ::aColumns ):nClrFootBack ENDIF nClrBack := ::GetValProp( nClrBack, nClrBack, nJ ) [/pre2]
krutoff: SergKis пишет: Желательно, перейти на MODA Сергей, спасибо за такой детальный совет, буду копать у себя. PS: Помогло DO EVENTS. Нет, не помогло. SergKis пишет: А как вы получаете :nCell := 0 ? Нашел ошибку! Да, у меня перед Activate формы с броузом, стоял блок восстанова параметров из INI-файла - там был ноль и тупо присвоило ::nCell := 0 У себя я, конечно, исправил, но, может для присвоения ::nCel сделать метод класса с проверкой?
Andrey: Пытаюсь положить окно в размер ТСБ, не получается... Окно больше и со сдвигом идёт ... Делаю так:[pre2] cForm := oBrw:cParentWnd nRow := GetProperty(cForm, "Row") + GetTitleHeight() + oBrw:nTop nCol := GetProperty(cForm, "Col") + GetBorderWidth() + oBrw:nLeft nH := oBrw:nBottom - oBrw:nTop nW := oBrw:nRight - oBrw:nLeft DEFINE WINDOW Forma_Zero AT nRow, nCol CLIENTAREA nW, nH MODAL NOCAPTION ; BACKCOLOR aBColor ON LOSTFOCUS oWnd:Release() oWnd := ThisWindow.Object[/pre2] Подскажите пожалуйста, где промахнулся...
Haz: Andrey пишет: где промахнулся.. В алгоритме, берешь oBrw:hWnd и по его координатам (getwindowrect() ) рисуешь свое
Andrey: Haz пишет: берешь oBrw:hWnd и по его координатам (getwindowrect() ) рисуешь свое Спасибо БОЛЬШОЕ ! Вот пример. Когда окно по ценру, то окно wZero по таблице закрывается пиксель в пиксель !!! А если окно сдвинуть, то наступает фигня... Может команда нужна типа SET DIALOGBOX CENTER OF PARENT ? Как исправить ? Вот исходник - [pre2]/* * MINIGUI - Harbour Win32 GUI library Demo * * Copyright 2021 Sergej Kiselev <bilance@bilance.lv> */ #include "hmg.ch" #include "tsbrowse.ch" REQUEST DBFCDX, DBFFPT Function Main() LOCAL cFont := "Arial" LOCAL nSize := 12 LOCAL cForm := "wMain" LOCAL oBrw1, oBrw2, nY, nX, nH, nW, nG, oTsb1, oTsb2 RddSetDefault("DBFCDX") SET OOP ON SET EPOCH TO 2000 SET DATE TO GERMAN SET CENTURY ON SET AUTOPEN OFF SET DELETED OFF SET NAVIGATION EXTENDED SET DEFAULT ICON TO "HMG_ICO" SET FONT TO cFont, nSize USE ( "CUSTOMER" ) ALIAS CUST1 NEW SHARED USE ( "CUSTOMER" ) ALIAS CUST2 NEW SHARED DEFINE WINDOW &cForm TITLE "Demo 2 TBrowse" MAIN TOPMOST ; ON INIT ( This.Topmost := .F. ) ; ON RELEASE ( dbCloseAll() ) This.Maximize nY := nX := nG := 20 nW := This.ClientWidth - nG * 2 nH := Int( This.ClientHeight / 2 ) - nG - nG/2 oTsb1 := oHmgData() oTsb1:lDrawSpecHd := .T. oTsb1:uSelector := .T. @ 0, 5 LABEL Label_1 VALUE "F1-window to table" FONTCOLOR RED SIZE 8 AUTOSIZE TRANSPARENT oBrw1 := _TBrowse( oTsb1, "CUST1", "Brw_1", nY, nX, nW, nH ) ; DO EVENTS nY += nH + 1 + nG nH -= 1 oTsb2 := oHmgData() oTsb2:lDrawSpecHd := .T. oTsb2:uSelector := .T. @ nH + 22, 5 LABEL Label_2 VALUE "F2-window to table" FONTCOLOR RED SIZE 8 AUTOSIZE TRANSPARENT oBrw2 := _TBrowse( oTsb2, "CUST2", "Brw_2", nY, nX, nW, nH ) ; DO EVENTS oBrw1:SetFocus() ; DO EVENTS ON KEY F1 ACTION NIL ON KEY TAB ACTION { |cf| cf := ThisWindow.FocusedControl, ; iif( cf == "Brw_1", This.Brw_2.SetFocus, This.Brw_1.SetFocus ) } ON KEY ESCAPE ACTION ( iif( oBrw1:IsEdit, oBrw1:SetFocus(), ; iif( oBrw2:IsEdit, oBrw2:SetFocus(), ; ThisWindow.Release ) ) ) (This.Object):Event(1, {|ow| myWin(ow, "Brw_1", .F.) }) (This.Object):Event(2, {|ow| myWin(ow, "Brw_2", .T.) }) ON KEY F1 ACTION _wPost(1) ON KEY F2 ACTION _wPost(2) END WINDOW //CENTER WINDOW wMain ACTIVATE WINDOW wMain RETURN NIL FUNCTION myWin(oWnd, cBrw, lHead) Local ob, hb, nY, nX, nW, nH, nRow, nCol SET WINDOW THIS TO oWnd:Name ob := This.&(cBrw).Object hb := ob:hWnd nY := GetWindowRow(hb) nX := GetWindowCol(hb) nW := GetWindowWidth(hb) nH := GetWindowHeight(hb) nRow := iif( oWnd:Row >= 0, oWnd:Row, 0 ) + nY nCol := iif( oWnd:Col >= 0, oWnd:Col, 0 ) + nX IF !Empty(lHead) nRow += ( ob:nHeightHead + 1 + ob:nHeightSpecHd ) // + 1 это линия сверху nH -= ( ob:nHeightHead + 1 + ob:nHeightSpecHd + GetHScrollBarHeight() + 1 ) // и снизу nCol += ( ob:GetColumn("SELECTOR"):nWidth + 1 ) // + 1 это линия слева nW -= ( ob:GetColumn("SELECTOR"):nWidth + 1 + GetVScrollBarWidth() + 1 ) // и справа ENDIF SET DIALOGBOX CENTER OF PARENT DEFINE WINDOW wZero AT nRow, nCol WIDTH nW HEIGHT nH MODAL NOCAPTION NOSIZE BACKCOLOR YELLOW This.Cargo := oHmgData() This.Cargo:oParent := oWnd This.Cargo:cBrw := cBrw This.Cargo:oBrw := ob @ 20, 20 LABEL Label_0 VALUE "ESC - exit" FONTCOLOR RED SIZE 28 AUTOSIZE TRANSPARENT ON KEY F1 ACTION NIL ON KEY ESCAPE ACTION ThisWindow.Release END WINDOW ACTIVATE WINDOW wZero SET WINDOW THIS TO ob:SetFocus() Return Nil[/pre2]
SergKis: Andrey пишет Как исправить ? Вспомнил, что с Игорем сделали недавно метод :GetCellSize(), применил [pre2] FUNCTION myWin(oWnd, cBrw, lHead) Local ob, nY, nX, nW, nH, nRow, nCol, oc1, oc2 SET WINDOW THIS TO oWnd:Name ob := This.&(cBrw).Object oc1 := ob:GetCellSize(1, 1) oc2 := ob:GetCellSize(ob:nRowCount(), 1) nRow := oc1:nRow nRow -= ( ob:nHeightSpecHd + ob:nHeightHead ) nCol := oc1:nCol + 1 nW := GetWindowWidth (ob:hWnd) - 2 nH := GetWindowHeight(ob:hWnd) - 2 DEFINE WINDOW wZero AT nRow, nCol WIDTH nW HEIGHT nH MODAL NOCAPTION NOSIZE BACKCOLOR YELLOW This.Cargo := oHmgData() This.Cargo:oParent := oWnd This.Cargo:cBrw := cBrw This.Cargo:oBrw := ob ON KEY F1 ACTION NIL ON KEY ESCAPE ACTION ThisWindow.Release END WINDOW ACTIVATE WINDOW wZero SET WINDOW THIS TO ob:SetFocus() Return Nil [/pre2]
Haz: SergKis пишет: применил необычное решение
Andrey: Супер !
SergKis: Andrey Обработаем lHead и передадим параметры [pre2] /* * MINIGUI - Harbour Win32 GUI library Demo * * Copyright 2021 Sergej Kiselev <bilance@bilance.lv> */ #include "hmg.ch" #include "tsbrowse.ch" REQUEST DBFCDX, DBFFPT Function Main() LOCAL cFont := "Arial" LOCAL nSize := 12 LOCAL cForm := "wMain" LOCAL oBrw1, oBrw2, nY, nX, nH, nW, nG, oTsb1, oTsb2 RddSetDefault("DBFCDX") SET OOP ON SET EPOCH TO 2000 SET DATE TO GERMAN SET CENTURY ON SET AUTOPEN OFF SET DELETED OFF SET NAVIGATION EXTENDED SET DEFAULT ICON TO "HMG_ICO" SET FONT TO cFont, nSize USE ( "CUSTOMER" ) ALIAS CUST1 NEW SHARED USE ( "CUSTOMER" ) ALIAS CUST2 NEW SHARED DEFINE WINDOW &cForm TITLE "Demo 2 TBrowse" MAIN TOPMOST ; ON INIT ( This.Topmost := .F. ) ; ON RELEASE ( dbCloseAll() ) This.Maximize nY := nX := nG := 20 nW := This.ClientWidth - nG * 2 nH := Int( This.ClientHeight / 2 ) - nG - nG/2 oTsb1 := oHmgData() oTsb1:lDrawSpecHd := .T. oTsb1:uSelector := .T. oTsb1:nBrw := 1 @ 0, 5 LABEL Label_1 VALUE "F1-window to table" FONTCOLOR RED SIZE 8 AUTOSIZE TRANSPARENT oBrw1 := _TBrowse( oTsb1, "CUST1", "Brw_1", nY, nX, nW, nH ) ; DO EVENTS nY += nH + 1 + nG nH -= 1 oTsb2 := oHmgData() oTsb2:lDrawSpecHd := .T. oTsb2:uSelector := .T. oTsb2:nBrw := 2 @ nH + 22, 5 LABEL Label_2 VALUE "F2-window to table" FONTCOLOR RED SIZE 8 AUTOSIZE TRANSPARENT oBrw2 := _TBrowse( oTsb2, "CUST2", "Brw_2", nY, nX, nW, nH ) ; DO EVENTS oBrw1:SetFocus() ; DO EVENTS ON KEY F1 ACTION NIL ON KEY TAB ACTION { |cf| cf := ThisWindow.FocusedControl, ; iif( cf == "Brw_1", This.Brw_2.SetFocus, This.Brw_1.SetFocus ) } ON KEY ESCAPE ACTION ( iif( oBrw1:IsEdit, oBrw1:SetFocus(), ; iif( oBrw2:IsEdit, oBrw2:SetFocus(), ; ThisWindow.Release ) ) ) (This.Object):Event(1, {|ow| myWin(ow, "Brw_1", .F.) }) (This.Object):Event(2, {|ow| myWin(ow, "Brw_2", .T.) }) ON KEY F1 ACTION _wPost(1) ON KEY F2 ACTION _wPost(2) END WINDOW //CENTER WINDOW wMain ACTIVATE WINDOW wMain RETURN NIL FUNCTION myWin( oWnd, cBrw, lHead ) Local oBrw, nBrw, nY, nX, nW, nH, nRow, nCol, oTsb, oc1, oc2, nw1 SET WINDOW THIS TO oWnd:Name oBrw := This.&(cBrw).Object oTsb := oBrw:Cargo:oParam // parameters oTsb1 or oTsb2 nBrw := oTsb:nBrw oc1 := oBrw:GetCellSize(1, 1) oc2 := oBrw:GetCellSize( oBrw:nRowCount(), 1 ) nw1 := oBrw:GetColumn( "SELECTOR" ):nWidth nRow := oc1:nRow nCol := oc1:nCol + 1 nW := GetWindowWidth ( oBrw:hWnd ) - 2 nH := GetWindowHeight( oBrw:hWnd ) - 2 IF Empty( lHead ) nRow -= ( oBrw:nHeightSpecHd + oBrw:nHeightHead ) nRow += 1 nCol += 1 nW -= 1 ELSE nCol += nw1 nRow += 1 nCol += 1 nW -= ( nw1 + GetVScrollBarWidth() + 1 ) nH -= ( oBrw:nHeightHead + oBrw:nHeightSpecHd + GetHScrollBarHeight() + 1 ) ENDIF DEFINE WINDOW wZero AT nRow, nCol WIDTH nW HEIGHT nH MODAL NOCAPTION NOSIZE BACKCOLOR YELLOW This.Cargo := oHmgData() This.Cargo:oParent := oWnd This.Cargo:cBrw := cBrw This.Cargo:oBrw := oBrw This.Cargo:nBrw := nBrw This.Cargo:oTsb := oTsb ON KEY F1 ACTION NIL ON KEY ESCAPE ACTION ThisWindow.Release END WINDOW ACTIVATE WINDOW wZero SET WINDOW THIS TO oBrw:SetFocus() RETURN Nil [/pre2]
Andrey: Непонятка возникла по ТСБ. Ставлю отключение вывода суперхидера/шапки/нумератора/подвала [pre2]oBrw:lDrawHeaders := .F.[/pre2] Всё скрывается, отлично но: (1) теряется формат полей "T=@" (2) размеры ТСБ уменьшаются снизу Вот картинка: И ещё один вопрос. Как мне можно оставить Нумератор и Подвал в ТСБ ? Или только отдельно Подвал ? Или только отдельно Нумератор ?
krutoff: Никто не копировал объект OBRW TSBrowse? Я сформировал TSBrowse на одной форме со всеми картинками, блоками кода и т.д. и хотел бы скопировать(клонировать) этот объект на другую форму, это возможно?
SergKis: krutoff пишет Я сформировал TSBrowse на одной форме со всеми картинками, блоками кода и т.д. и хотел бы скопировать(клонировать) этот объект на другую форму, это возможно? Чисто технически копировать можно, но колонки это объекты и в скопированном варианте будут ссылки на одни и те же колонки, при lEdit := .T. каждый тсб будет создавать каждый свои :oEdit, хорошо это или плохо, хз. Делал копирование колонок[pre2] aColOld := {} FOR EACH oCol IN oBrw:aColumns AADD( aColOld, oCol:Clone() ) NEXT [/pre2] менял колонки в oBrw:aColumns (добавлял переменные в oCol) и потом восстанавливал обратно из aColOld. Можно создать новый DEFINE TBROWSE ... и методом oBrw:AddColumn( oCol ) перегнать туда массив aColOld, но надо помнить, что в колонках в :bData, через FieldWBlock("FieldName", select(oBrw:cAlias)), заложена область dbf файла. Можно создать базу колонок и потом исп. ее для создания разных тсб (алиас для тсб задается). Примеры: app_oopcolumns и app_ooptsbbox Если исп. _TBrowse(...) с oTsb := oHmgData() ... параметрами, то для др. разных тсб можно использовать параметры настройки одного объекта oTsb, возможно, это неплохой вариант.
SergKis: Пример из серии Crazy https://TransFiles.ru/w6x7n Возможно будет кому то интересен.
alex_II: Имеется код: DEFINE TBROWSE Br_sch AT h_tlbar,0 ALIAS 'sch' WIDTH w_br HEIGHT h_br BOLD CELLED ... ADD COLUMN TO Br_sch HEADER 'Ввод в'+CRLF+'работу' SIZE w_dtv ; DATA FieldWBlock('dtuse', Select('sch')) ; ALIGN DT_CENTER, DT_CENTER ; PREEDIT {|uVar| oldVal := uVar, IF(Status = 1, .T., .F.)} ; POSTEDIT {|uVar| postMod(uVar,'введен'), Br_sch:DrawSelect()} ; EDITABLE ... Пользователи недовольны тем, как приходится набирать дату, процесс получается довольно протяженный пока выберешь год, потом месяц и наконец дату. В примере d:\MiniGUI\SAMPLES\Advanced\Tsb_Basic дата вводится простыми цифрами, но как это сделать в моём случае я так и не сообразил. Помогите люди добрые.
Dima: у меня так примерно oBrw3:SetColSize("data_c", 85 ) oBrw3:GetColumn("data_c"):cHeading :="Дата"+CRLF+"создания" oBrw3:GetColumn("data_c"):cPicture :="@D" oBrw3:GetColumn( "data_c"):lEdit := kaka("master") obrw3:GetColumn("data_c"):bPrevEdit := { |a, b, lLock| SetGetAdjustBrw(b,{2,0,-2,-3}) , If( lLock := (b:cAlias)->(RLock()), (b:cAlias)->(dbUnLock()), Msgstop("Запись заблокирована","Внимание")), lLock } oBrw3:GetColumn("data_c"):nAlign:=DT_CENTER oBrw3:lPickerMode := .F.
alex_II: Dima пишет: oBrw3:lPickerMode := .F. Спасибо, помогла данная установка.
alex_II: Наткнулся на непонятную ситуацию DEFINE TBROWSE ... ... ADD COLUMN TO Br_sch HEADER '' SIZE w_lod ; DATA FieldWBlock('lm1', Select('sch')) ; CHECKBOX ; PREEDIT {|| preMod('lm1')} ; EDITABLE ... У меня редактирование логического поля происходит по уcловию из preMod. Всё работает, когда используется клавиатура, но когда используется мышь то двойной клик по полю хоть и вызывает выполнение функции preMod, её возврат не анализируется и поле lm1 всегда меняет своё значение на противоположное. Такое впечатление, что двойной клик мышью вызывает сначала безусловное редактирование логического поля, а потом обработку из PREEDIT.
SergKis: alex_II пишет PREEDIT {|| preMod('lm1')} Что возвращает эта конструкция и какие значения имеют oCol:lCheckBoxNoReturn .OR. ::lCheckBoxAllReturn ? То о чем спрашиваете тут (метод :Edit(...))[pre2] ... IF oCol:bPrevEdit != NIL IF ::lIsArr .AND. ( ::lAppendMode .OR. ::nAt > Len( ::aArray ) ) // append mode for arrays ELSEIF nKey != VK_RETURN // GF 15-10-2015 uVar := Eval( oCol:bPrevEdit, uValue, Self, nCell, oCol ) IF ValType( uVar ) == "A" uVar := uVar[ 1 ] uValue := uVar[ 2 ] ENDIF IF ValType( uVar ) == "L" .AND. ! uVar nKey := VK_RETURN ENDIF ENDIF ENDIF ::FastDrawClear( hb_ntos( ::nAtPos ) + "." + hb_ntos( oCol:nId ) ) cMsg := iif( ValType( cMsg ) == "B", Eval( cMsg, Self, nCell ), cMsg ) IF cType == "L" .AND. oCol:lCheckBox IF nKey != VK_RETURN .OR. ! oCol:lCheckBoxNoReturn .OR. ::lCheckBoxAllReturn IF Upper( Chr( nKey ) ) $ "YCST1" ::lChanged := ( uVar == .F. ) uVar := .T. ELSEIF Upper( Chr( nKey ) ) $ "FN0" ::lChanged := ( uVar == .T. ) uVar := .F. ELSEIF nKey == VK_SPACE .OR. nKey == VK_RETURN uVar := ! uValue ::lChanged := .T. ELSE RETURN 0 ENDIF ::lHasChanged := iif( ::lChanged, .T., ::lHasChanged ) ::oWnd:nLastKey := VK_RETURN ::PostEdit( uVar, nCell ) ::lPostEdit := .F. RETURN 0 ELSE ::lPostEdit := .T. ::lChanged := .F. ::oWnd:nLastKey := nKey ::PostEdit( uValue, nCell ) ::lPostEdit := .F. RETURN 0 ENDIF ENDIF [/pre2]
alex_II: PREEDIT возвращает .F. oCol:lCheckBoxNoReturn = .T. ::lCheckBoxAllReturn = .T.
SergKis: alex_II тогда попадете в выделенный цветом код, см. Скрытый текст выше, т.к. двойной клик выполняет[pre2] IF ValType( ::bDataEval( ::aColumns[ nCol ] ) ) == "L" .AND. ; ::aColumns[ nCol ]:lCheckBox // virtual checkbox ::PostMsg( WM_CHAR, VK_SPACE, 0 ) [/pre2]
alex_II: Пардон, может я что-то не догоняю Как выбраться из этой ситуации?
SergKis: alex_II Если объект oBrw Public\Private\Static, то PREEDIT {|| oBrw:lCheckBoxAllReturn := preMod('lm1')} ; POSTEDIT {|| oBrw:lCheckBoxAllReturn := .T. } Если oBrw Local, то надо исп. внутренние переменные параметры блоков кода :bPrevEdit и :bPostEdit
alex_II: SergKis Большое спасибо за помощь, всё заработало корректно Только маленькая поправка: PREEDIT {|| oBrw:lCheckBoxAllReturn := preMod('lm1')} но это уже детали.
krutoff: После того, как я включил блок кода ::bFilter, метод GotoRec( nRec, nRowPos ) Игоря Назарова стал работать некорректно. Сам крутил - не получилось. Игорь, если будет возможность - гляньте, плз.
SergKis: krutoff пишет я включил блок кода ::bFilter Используйте лучше методы: :FilterData( cFilter, lBottom, lFocus ) :FilterFTS( cFind, lUpper, lBottom, lFocus, lAll )
krutoff: SergKis Сергей, спасибо за ответ. Но в моей ситуации я хотел уйти от DbSetFilter, чтобы Seek работало по всей базе без фильтра (тут мне важны все записи), а через TSBrowse показывать фильтрованые записи.
SergKis: krutoff пишет Но в моей ситуации я хотел уйти от DbSetFilter, чтобы Seek работало по всей базе без фильтра (тут мне важны все записи),а через TSBrowse показывать фильтрованые записи. Используя :bFilter вам надо исп. все установки окружения тсб в ручном режиме (:nLen входящих строк в просмотр ...), если глянуть метод DbSkipper( nToSkip ) видно - все делается руками, т.е.[pre2] ELSEIF nToSkip < 0 .AND. !( ::cAlias )->( Bof() ) // going up WHILE nSkipped > nToSkip ( ::cAlias )->( dbSkip( -1 ) ) IF ::bFilter != NIL .AND. !( ::cAlias )->( Bof() ) While ! Eval( ::bFilter ) .AND. !( ::cAlias )->( Bof() ) ( ::cAlias )->( dbSkip( -1 ) ) ENDDO IF ( ::cAlias )->( Bof() ) ( ::cAlias )->( dbGoto( nRecNo ) ) RETURN nSkipped ENDIF ENDIF IF ( ::cAlias )->( Bof() ) ( ::cAlias )->( dbGoTop() ) EXIT ENDIF nSkipped-- ENDDO [/pre2] по мне, :GotoRec(...) не имеет к :bFilter никакого отношения. Почему бы после Seek не накапливать RecNo() в объекте контейнере (oRec := oHmgData() ; iif( dbSeek(...), oRec:Set(RecNo(), RecNo()), ) ) или в строке (cRec := "," ; cRec += iif(dbSeek(...), hb_ntos(RecNo())+',', "")) (oRec или cRec private\public). потом ставить :FilterData("oRec:Get(RecNo(), 0) > 0",...) или на строку :FilterData("','+hb_ntos(RecNo())+',' $ cRec", ...) PS Если из RecNo() или ID записей сделать в mem:file.dbf , то тсб простым способом, с SET RELATION ... на осн. базу можно показывать нужные поля, т.е. ваш просмотр
krutoff: SergKis Сергей, спасибо за подсказку! Поправил метод GotoRec( nRec, nRowPos ) -> включил ::DbSkipper Протестировал. Все работает! METHOD GotoRec( nRec, nRowPos ) CLASS TSBrowse LOCAL cAlias LOCAL nSkip LOCAL n LOCAL nRecSave LOCAL lRet := .F. LOCAL lReCount := .F. IF ::lIsDbf lRet := .T. cAlias := ::cAlias ::nLastPos := ( cAlias )->( RecNo() ) IF HB_ISLOGICAL( nRowPos ) .AND. nRowPos .AND. ::nLen > ::nRowCount() nRecSave := ::nLastPos ( cAlias )->( dbGoto( nRec ) ) ::DbSkipper( ::nRowCount() - ::nRowPos ) IF ( cAlias )->( Eof() ) Eval( ::bGoBottom ) ::nRowPos := ::nRowCount() DO WHILE ::nRowPos > 1 .AND. ( cAlias )->( RecNo() ) != nRec ::DbSkipper( -1 ) ::nRowPos-- ENDDO ELSE ( cAlias )->( dbGoto( nRecSave ) ) ENDIF ENDIF hb_default( @nRowPos, ::nRowPos ) ( cAlias )->( dbGoto( nRec ) ) nSkip := ABS( ::DbSkipper( -(nRowPos-1) ) ) nRecSave := ( cAlias )->( RecNo() ) nRowPos := Min( nSkip + 1, nRowPos ) ( cAlias )->( dbGoto( nRec ) ) n := ::DbSkipper( ::nRowCount()-nRowPos ) IF n < ::nRowCount() - nRowPos lReCount := .T. ENDIF ( cAlias )->( dbGoto( nRecSave ) ) ::nRowPos := nRowPos ::Refresh( lReCount, lReCount ) ::DbSkipper( nSkip ) ::ResetVscroll() IF ::bChange != NIL Eval( ::bChange, Self, 0 ) ENDIF ::lHitTop := ::lHitBottom := .F. SysRefresh() ENDIF RETURN lRet
SergKis: krutoff пишет Поправил метод GotoRec( nRec, nRowPos ) -> включил ::DbSkipper Протестировал. Все работает! Попробуйте пример Tsb_addrecord cо старым\родным вариантом :Gotorec(...) и вариант с вашими поправками. Родной метод работает после кнопки "AddRecord" (курсор, например, на 3-й строке) правильно, ваш вариант - нет
gfilatov2002: SergKis пишет: Родной метод работает после кнопки "AddRecord" (курсор, например, на 3-й строке) правильно, ваш вариант - нет Я уже поправил код Олега (тестировал на том же примере Tsb_addrecord). Хочу включить эти изменения в новую сборку.
Andrey: Заметил у себя две бяки в ТСБ. 1) Если делаем так в ON INIT окна [pre2] oBrw:Enabled( .F. ) // блокировка таблицы ...удаляем столбцы, ставим свои размеры колонок oBrw:Enabled( .T. ) // разблокировка таблицы [/pre2] То в ТСБ размер колонок и сами колонки восстанавливаются ДО ПЕРВОНАЧАЛЬНЫХ значений. Это так должно быть ? Тогда это не есть хорошо, т.к. построение окна с таблицей занимает время и нужна блокировка всего окна от шаловливых ручек юзера. 2) Использую у себя условную индексацию. Очень удобно. Но на больших базах 1 тыс.записей и выше при смене текущего индекса курсор ТСБ впадает в ступорт, вешает ТСБ. До сих пор лечу это таким кодом после создания условного индекса: [pre2] // ------------- добавка обязательна ---------- nTags := ( oBrw_2:cAlias )->( ordCount() ) oBrw_2:aTags := {} FOR nI := 1 TO nTags AAdd( oBrw_2:aTags, { ( ALIAS() )->( ordName( nI ) ), ( ALIAS() )->( ordKey( nI ) ) } ) NEXT oBrw_2:uLastTag := ( ALIAS() )->( ordName( nTags ) ) // без этого индекс слетает[/pre2] А можно этот код добавить сразу в ТСБ ? Раньше, года 2-3 назад такого не было, ТСБ работал без этого.
SergKis: Andrey пишет Если делаем так в ON INIT окна ...удаляем столбцы, ставим свои размеры колонок На мой взгляд это неправильно, надо формировать список рабочих колонок на уровне DEFINE TBROWSE ... ...удаляем столбцы, ставим свои размеры колонок END TBROWSE или делать не обрамляя методом :Enabled, т.к., если смотреть метод :Enabled, то увидишь сохранение\восстановление данных колонок [pre2] ... IF ::lEnabled ::aOldEnabled := { ::hBrush, {}, ::nClrPane, {}, ::nClrLine } FOR nI := 1 TO Len( ::aColumns ) AAdd( ::aOldEnabled[ 2 ], ::aColumns[ nI ]:Clone() ) ::aColumns[ nI ]:SaveColor() NEXT ... IF ! ::lEnabled FOR nI := 1 TO Len( ::aColumns ) ::aColumns[ nI ]:RestColor() SetColor( , ::aColumns[ nI ]:aColors, nI ) NEXT IF ! Empty( ::oPhant ) ::oPhant:RestColor() ENDIF IF HB_ISARRAY( ::aOldEnabled ) .AND. ! Empty( ::aOldEnabled[ 1 ] ) AEval( ::aOldEnabled[ 2 ], {| oc, nc | ::aColumns[ nc ] := oc:Clone() } ) ... [/pre2]Использую у себя условную индексацию что это ? Очень удобно. Все в мире относительно
Andrey: Вопрос по ТСБ, возмём пример Tsb_composite ! Для сортировки ПО СТОЛБЦАМ там нужно создавать ОДИН индекс по колонкам. 1) Почему нужно делать ТОЛЬКО ОДИН файл ? При использование нескольких индексных файлов сортировка не работает. 2) Если мне надо свой индекс сделать, то как тогда сделать чтобы сортировка работала ? Типа STR(KCity)+UPPER(STREET) Раньше (года 2 назад) сортировка работала по нескольким индексным файлам, теперь нет. Что нужно прикрутить в ТСБ чтобы вернулась прежняя сортировка ?
Andrey: Опять непонятка в ТСБ с массивом. Таблица построена, делаю сортировку по колонке с датой вот так: [pre2]STATIC FUNCTION myTsbSort(oBrw) LOCAL nCol := oBrw:nColumn("NAME_3") LOCAL oCol, lDescend := .F. oBrw:lNoChangeOrd := .F. // включить сортировку oBrw:nColOrder := 4 // поставить значок сортировки по колонке oBrw:SetOrder(nCol, , lDescend) RETURN Nil [/pre2] И нифига не получаю - т.е. правильной сортировки нет ! Вот так в таблице: Как победить эту сортировку ?
Andrey: Танцы с бубном показали, что использование виртуальной колонки в ТСБ с массивом - ПРОТИВОПОКАЗАНО !!! Т.е. в ТСБ НЕ НАДО использовать COLNUMBER { 1, 20 } - если нужна сортировка по колонке. Не помогают всякие ухищрения типа: [pre2] IF oBrw:nColumn("ARRAYNO") > 0 nCol -= 1 ENDIF IF oBrw:lSelector nCol -= 1 ENDIF [/pre2] Придётся делать как и в 2015 году - свою собственную виртуальную колонку и отслеживать самому нумерацию этой колонки.
Andrey: Всем привет ! Что посоветуете делать для хранения и показа картинки в ТСБ ? Нужно показывать в одной колонке ТСБ картинки из базы. Картинки небольшие BMP или PNG размером 48х48 или 64х64. Есть 2 варианта: загонять все картинки в массив и показывать в ТСБ, или записывать эти картинки в поле базы, а потом уже показывать. Количество записей в базе может быть и 100 записей, а может и 10-20 тыс. Как показывать картинки из массива - знаю: [pre2] oBrw:aBitMaps := M->ahPubBmp oBrw:GetColumn(2):lBitMap := .T. // колонка с картинками oBrw:aColumns[2]:uBmpCell := {|| M->ahPubBmp[oBrw:nAt] } oBrw:aColumns[2]:uBmpHead := {|| Nil } oBrw:aColumns[2]:bData := {||Nil} oBrw:aColumns[2]:cData := '{||Nil}' oBrw:aColumns[2]:nAlign := nMakeLong( DT_CENTER, DT_CENTER ) oBrw:aColumns[2]:nHAlign := nMakeLong( DT_CENTER, DT_CENTER )[/pre2] А как делать показ напрямую из мемо-поля не делал или уже забыл.... Подскажите как это сделать ?
gfilatov2002: Andrey пишет: как делать показ напрямую из мемо-поля Можно попробовать использовать BLOB мемо-поля для хранения картинок. В Харборе есть такие функции для этой цели: BLOBDirectExport( <nPointer>, <cTargetFile> [, <kMode>] ) BLOBDirectGet( <nPointer> [, <nStart> [, <nCount> ]] ) BLOBDirectImport( <nOldPointer>, <cSourceFile> ) BLOBDirectPut( [<nOldPointer>], <xBlob> ) BLOBGet( <nFieldNo> [, <nStart> [, <nCount>]] ) BLOBExport( <nFieldNo>, <cTargetFile>, <nMode> ) BLOBImport( <nFieldNo>, <cSourceFile> ) В поставке Минигуи есть рабочий пример в папке \SAMPLES\BASIC\BLOBfiles
Andrey: Есть ещё такой пример - MiniGUI\SAMPLES\Advanced\Tsb_BitMaps Но там не совсем понятно, грузятся картинки из файла. А как сделать показ из мемо-поля уже записанную туда картинку ?
Andrey: gfilatov2002 пишет: Можно попробовать использовать BLOB мемо-поля для хранения картинок Спасибо ! Сделал пример и загрузил в базу картинки (bmp). Как показать эти картинки в ТСБ - не знаю ? Пример тут - https://cloud.mail.ru/public/FvKA/sFktSMppQ и сделан на базе примера MiniGUI\SAMPLES\Advanced\Tsb_BitMaps Народ, отзовитесь ... Как это можно реализовать ?
Haz: Andrey пишет: Народ, отзовитесь ... Как это можно реализовать ? FreeImage в помощь. Смотри примеры , как минимум Advanced\Freeimage , там как раз загрузка картинки из базы.
Andrey: Спасибо за ссылку. Посмотрел примеры, ну там и наворочено... Не знаю как и прикрутить это к ТСБ...
Haz: Andrey пишет: Посмотрел примеры, ну там и наворочено... Не знаю как и прикрутить это к ТСБ Ты притворяешься? Один из самых мелких примеров. Получить картинку из базы, грузнуть в память и получив хендл указать в uBmpCell. В примере картинку берут из базы sql запросом , с этой строки чуть ниже всего одна строчка кода для получения хендла. Удачи.
Andrey: Haz пишет: Ты притворяешься? Да нет. Не совсем ясен будет механизм показа. Haz пишет: Получить картинку из базы, грузнуть в память и получив хендл указать в uBmpCell И как это сделать - грузнуть в память ? Если в базе будет 10 тыс. записей, то все картинки нужно будет грузить в память ? А она выдержит столько ? Пример давал выше - там все картинки уже в базе. Если не сложно, покажи пожалуйста на примере, как это сделать. Думаю, что и другим будет интересно.
Haz: Andrey пишет: Если в базе будет 10 тыс. записей, то все картинки нужно будет грузить в память Хендл картинки нужен в момент прорисовки строки.Нет надобности весь миллиард держать в памяти. При желании можно динамичную подкачку сделать и загрузку хендлов в хеш по номеру записи на пару страниц бровса вверх и вниз и отслеживать диапазон по событиям бровса.
Haz: Andrey пишет: Не совсем ясен будет механизм показа. LoadImage() в блоке ubmpCell вопросов же не вызовет с механизмом. И тут тоже самое, вместо LoadImage() функция freeimage которая выдаёт хендл по строке.
Haz: Haz пишет: FreeImage в помощь. Андрей! Плохие новости , через FI не получится в ТСБ скормить хендл картинки, ТСБ не понимает хендл возвращаемый FI_LoadImage...() Не трать время, ищи другой способ
Andrey: Haz пишет: Плохие новости , через FI не получится в ТСБ скормить хендл картинки, ТСБ не понимает хендл возвращаемый FI_LoadImage...() Не трать время, ищи другой способ Огромное СПАСИБО за то что проверил это. А то я бы ... и нифига бы не понял.
Haz: В FW есть функция загрузки битмапа из строки, в MG нет такой. Здесь только LoadImage() из файла или ресурсов. Поэтому решение будет кривым : Из блоба писать в файл , а из Файла LoadImage() Более того, сам код TsBrowse использует именно такой подход. Функция StockBmp() из ТСБ для графических иконок пользует последовательность кода [pre2] nHandle := FCreate( cBmpFile ) nWrite := FWrite( nHandle, cBmp, Len( cBmp ) ) FClose( nHandle ) hBmp := LoadImage( cBmpFile ) FErase( cBmpFile ) [/pre2]
Andrey: Haz пишет: В FW есть функция загрузки битмапа из строки, в MG нет такой. А взять такую функцию и добавить в МиниГуи можно ? Или кто-то поможет это сделать ? Без нарушения авторских прав FW....
Haz: Andrey пишет: А взять такую функцию и добавить в МиниГуи можно ? Ну если кто возьмётся с код править, то можно добавить.
Andrey: Буду думать над этим вопросом. Может кто из наших форумчан поможет ?
Andrey: Ещё один вопрос по ТСБ. При первом показе ТСБ делаю показ ПУСТОЙ таблицы (ну юзер так привык), как а Экселе. Мешают/раздражают значки логического поля. Как их можно убрать на время ?
Haz: Andrey пишет: Как их можно убрать на время oCol:bDecode := { lxl if( время не прошло, nil, x )}
Andrey: Спасибо ! Нашёл ещё одно решение. При старте делаю так: [pre2] oBrw:aCheck := { LoadImage("CheckT28"), /*LoadImage("CheckF28")*/ } // заменяем колонку CHECKBOX на свои картинки[/pre2] А потом, после заполнения таблицы делаю так: [pre2] IF oBrw:Cargo:n1Start > 0 // не пустая таблица oBrw:aCheck := { LoadImage("CheckT28"), LoadImage("CheckF28") } ENDIF [/pre2]
Andrey: Что то не получается сделать ширину в экселе при экспорте в ТСБ штатными средствами. Вот такой код: [pre2] oBrw:ExcelOle( cXlsFile, lActivate, hProgress, aTitle, hFont, lSave, bExternXls, aColSel, bPrintRow ) For nI := 1 To oBrw:nColCount() oCol := oBrw:aColumns[ nI ] nW := oCol:nWidth oSheet:Columns(nI):ColumnWidth := nW // строка 246 Next[/pre2] Вылет вот такой:[pre2] Error BASE/1004 Метод не экспортирован: COLUMNS Args: [1] = U [2] = N 1 --------------------------------- Stack Trace --------------------------------- Called from COLUMNS(0) Called from TOEXCEL2(246) in module: Form_7Btn.prg Called from (b)MYCONTEXMENUEXPORT(48) in module: Form_7Btn.prg Called from _DOCONTROLEVENTPROCEDURE(0) [/pre2] Эксель не закрыт, на экране висит. Перезапускать эксель не хочется. Что ещё забыл ? Там в исходнике METHOD ExcelOle() вот это стоит: [pre2] IF bExtern != NIL Eval( bExtern, oSheet, Self ) ENDIF oRange:Borders():LineStyle := xlContinuous oRange:Columns:AutoFit()[/pre2] Т.е. если я дам функцию в bExtern, свои размеры колонок, эксель потом сам переформатирует колонки ?
SergKis: Andrey пишет Эксель не закрыт, на экране висит. Может и висит, но сообщение говорит, что в переменной oSheet нет объекта или он, метод, написан неверно, т.е. метод Columns не найден. Почему сразу не задаешь размеры, при описании колонок Header ? В конце формирования Sheet обычно делают AutoFit для выравнивания размеров колонок к размеру текстов в них
Andrey: SergKis пишет: Почему сразу не задаешь размеры, при описании колонок Header ? Да в штатном oBrw:ExcelOle() это вроде нельзя... SergKis пишет: Может и висит, но сообщение говорит, что в переменной oSheet нет объекта Да там в этом методе все переменные локальные: [pre2]METHOD ExcelOle( cXlsFile, lActivate, hProgress, cTitle, hFont, lSave, bExtern, aColSel, bPrintRow ) CLASS TSBrowse LOCAL oExcel, oBook, oSheet, nRow, nCol, uData, nEvery, oRange, cRange, cCell, cLet, nColHead, ;[/pre2] Были бы переданны в PUBLIC - было бы хорошо.... Но это опять править исходники МиниГуи надо.
SergKis: Andrey пишет Да там в этом методе все переменные локальные: Тебе дан ТВОЙ блок кода с параметрами, в нем и НАДО все делать Eval( bExtern, oSheet, Self ), т.е. Задай bExtern, а oSheet, oBrw получишь. Твое oBrw:ExcelOle( cXlsFile, lActivate, hProgress, aTitle, hFont, lSave, bExternXls, aColSel, bPrintRow ) For nI := 1 To oBrw:nColCount() oCol := oBrw:aColumns[ nI ] nW := oCol:nWidth oSheet:Columns(nI):ColumnWidth := nW // строка 246 Next конечно нет объекта в oSheet
Andrey: SergKis пишет: Задай bExtern, а oSheet, oBrw получишь. Твое oRange:Columns:AutoFit() стоит после Eval( bExtern, oSheet, Self ) Наверное моя ширина колонок замениться ? Вот я про это и спрашиваю...
SergKis: Andrey пишет Наверное моя ширина колонок замениться ? Не знаю, т.к. никогда не использую Excel Ole. Возможно, получишь все нормально или вставив в длинный текст заменитель CRLF (сколько надо для ширины) получишь нужное. Или Wrap отключи, то же что то получишь
Haz: Всем привет, терзает меня давно один вопрос . При редактировании поля в ТСБ курсор скачет на первую позицию и обратно. На сам процесс не влияет , но не эстетично. Порыл по исходникам и нашел причину : в методе UpStable() 14778: ::GoTop() - вызывает видимый прыжок на начало таблицы с прорисовкой курсора. По коду нет необходимости здесь использовать метод , достаточно будет (::cAlias)->(dbGoTop()) -и быстрее , и без дерганья курсора. Вроде когда то не было такого, или просто не обращал внимания чуть ниже два вызова ::Skip() - их тоже можно заменить на (::cAlias)->(dbSkip()), но они хоть на экране не мелькают Поменял, погонял - полет нормальный
SergKis: Haz пишет 14778: ::GoTop() У меня 14772 и последняя версия. чуть ниже два вызова ::Skip() ты имеешь ввиду строки (для понимания)[pre2] ELSE ( ::cAlias )->( dbSkip( 1 ) ) //!!! ::Skip( 1 ) ENDIF ... IF lSkip ( ::cAlias )->( dbSkip( -::nRowPos ) ) //!!! ::Skip( -::nRowPos ) ENDIF [/pre2]
Haz: SergKis пишет: ты имеешь ввиду строки ( Да эти. Только у меня они не заменены на dbSkip
SergKis: Haz пишет чуть ниже два вызова ::Skip() - их тоже можно заменить на (::cAlias)->(dbSkip()), но они хоть на экране не мелькают Только у меня они не заменены на dbSkip т.е. не меняем, ты меня не путай, я на таблетках, плохо соображаю "Скажи точно, сколько класть"
Haz: SergKis пишет: Скажи точно, сколько класть" Меняем все. Просто в твоем сообщении уже увидел замену, подумал что у меня не самая последняя версия. ::GoTop() точно под замену ::Skip() 99% что да. Посмотрел код погонял, у меня все норм на рабочем проекте. Еще на всякий случай завтра с фильтрами проверю и отпишусь. Себе все поменял
Haz: SergKis пишет: я на таблетках, Выздоравливай
Haz: Вобщем потестировал и с фильтрами и со сменой индекса, все работает при всех заменах
SergKis: Haz пишет Вобщем потестировал и с фильтрами и со сменой индекса, все работает при всех заменах Игорь, а как будет при применении :DbSkipper(n), разве не будет конфликта с (:cAlias)->( dbSkip(n) ) ? Наверно, :Skip(n) метод надо оставить, в нем нет отображений и он не мешает. Замена ( ::cAlias )->( dbGoTop() ) //!!! 23.03.23 ::GoTop() тоже не совсем корректна, т.к. :GoTop() выполняет свои алгоритмы, например Eval( ::bGotop } ... Ты не пробовал перед "При редактировании поля в ТСБ" сделать ::lPainted := .F., потом вернуть, если надо. Все прорисовки идут при ::lPainted := .T. Может тогда курсор скакать не будет ?
Haz: SergKis пишет: Замена ( ::cAlias )->( dbGoTop() ) //!!! 23.03.23 ::GoTop() тоже не совсем корректна, т. В этом месте не важно, тут простой подсчет строк с начала и все остальные вычисления только тормозят процесс. :Skip() можно и оставить, , но при обычном использовании тоже не критично, в коде полно и функций dbSkip() и методов :Skip() Завтра посмотрю на :dbSkipper() уверен не повлияет. Есть где нибудь в инете актуальные исходники MG ? А то не всегда комп под рукой и по телефону не посмотреть
SergKis: Haz пишет Есть где нибудь в инете актуальные исходники MG ? тут "Download" http://hmgextended.com/
Haz: SergKis пишет: тут "Download" Про тут я знаю, мне не скачивать , и просматривать исходник хотелось бы с браузера ( без скачивания и установки) . в последнее время часто езжу на общественном транспорте и есть время полистать в телефоне. Можно конечно и с компа папку MG в телефон кинуть и не забывать обновлять.
Haz: SergKis пишет: Игорь, а как будет при применении :DbSkipper(n), разве не будет конфликта с (:cAlias)->( dbSkip(n) ) ? Наверно, :Skip(n) метод надо оставить, в нем нет отображений и он не мешает. Сергей , ты прав для корректной отработки ::bFilter (если он есть ) ::Skip() тогда лучше оставить Замена ( ::cAlias )->( dbGoTop() ) //!!! 23.03.23 ::GoTop() тоже не совсем корректна, т.к. :GoTop() выполняет свои алгоритмы, например Eval( ::bGotop } ... в этом месте Eval( ::bGotop } ... и пр. точно не нужны , тут по коду просто подсчет строк, но есть но ... при ( ::cAlias )->( dbGoTop() ) опять таки не учитывается ::bFilter , значит тоже нельзя просто замкнутый круг получается. Ты не пробовал перед "При редактировании поля в ТСБ" сделать ::lPainted := .F., потом вернуть, если надо. Все прорисовки идут при ::lPainted := .T. Может тогда курсор скакать не будет ? Да , это скорее всего решит проблему , но это нагружает код разработчика для исправления косяка в MG может в самом ::Upstable() перед ::GoTop() поставить ::lPainted := .F. , а после ::lPainted := .T. Попробовал, решает вопрос с прыганьем и позволяет корректно выполнить функционал ::bFilter
SergKis: Haz пишет Попробовал, решает вопрос с прыганьем и позволяет корректно выполнить функционал Осталось решить эти строки нужны ?[pre2] METHOD UpStable() CLASS TSBrowse ... IF ::lPainted ::Refresh( iif( ::nLen < nRows, .T., .F. ) ) ENDIF [/pre2] Посмотрел код на :UpStable() и :Refresh() после него. Во многих местах этот метод есть, но небольшой процент вероятности, что где то его не хватает есть. Думаю "поставить ::lPainted := .F. , а после ::lPainted := .T." хорошая мысль, т.к. выкинется, возможно, лишний :Refresh(), будет меньше мелькания
Haz: SergKis пишет: Осталось решить эти строки нужны ? сегодня посмотрю тоже
Haz: SergKis пишет: Осталось решить эти строки нужны ? Просто так не выкинуть. В самом методе upstable , можно GoTop() обрамить выключением и включёнием lPainted и это уберёт видимость прыжка. Дальше по логике метода вызывается перерисовка если есть несоответствие строк . Это в принципе правильно. Метод проверяет строки сверху и снизу окна бровса. Без перерисовки тут не обойтись. Вызываемые далее в исходнике рефрешы после upstable не всегда учитывают что нужна полная перерисовка. Тут скорее путь такой, upstable всегда перерисовывает, а код исходников чистить от лишних рефрешей после upstable. Это уберёт и дерганье и повысит скорость
SergKis: Haz пишет Тут скорее путь такой, upstable всегда перерисовывает, а код исходников чистить от лишних рефрешей после upstable. Это повторение ситуации, :Upstable() должен давать сообщение, что нужна прорисовка, но сам делать не должен. Прорисовка нужна вне :UpStable(), а почистить код и оптимизировать :Refresh() идея хорошая, но трудно выполнимая, слишком много условий и вариантов, которые и тестировать надо. Вынести на какой нибудь счетчик потребности :Refresh() (заменив вызовы текущие) и если он > 0 и new переменная .T. - делать :Refresh() и счетчик в 0. Вынести бы :Refresh() на событие, но слишком разбросан он по текстам PS Я стараюсь делать так, например, после (Edit) изменений в нескольких строках Row [pre2] oCol:bPostEdit := {|xv,ob| ... IF xv != oc:xOldEditValue DO EVENTS ; _wPost(55, ob:cParentWnd, ob) ENDIF Return Nil } (This.Object):Event(55, {|ow,ky,ob| DoEvents(), ky := ow, ob:Refresh(), DoEvents() }) [/pre2] Использую событие всегда по потребности, используя _wPost(55...), _wSend(55...) и для др. окна с тсб тоже (работая на тек. окне). Такая метода с постановкой :lPainted := .T.\.F., думаю будет работать
Haz: SergKis пишет: Это повторение ситуации, :Upstable() должен давать сообщение, Да , согласен , поэтому и написал что просто так не выкинуть. Просто процитирую твои слова, т.к. полностью согласен :Upstable() должен выполнять все внутренние установки и выставлять флаг для :Refresh(), сам вызывать :Refresh() не должен при этом флаг для рефреш имеет признаки 1) с очисткой , 2) без очистки Именно так работает метод :Refresh() 1. с очисткой - сначала очищается текущее окно , а потом по чистенькому прорисовка. Это вызывает моргание но без него не обойтись если после фильтра строк стало меньше чем было. 2. без очистки - рисует поверх моргания нет Может имеет смысл пересмотреть метод и сделать третий вариант 3. перерисовка полностью без очистки. Суть в том , что если :nLen < :nRowCount то до :nLen рисуем поверх, а дальше просто рисуем пустые строки ( с сеткой или без ). Это визуально добавит плавности.
SergKis: Haz пишет Может имеет смысл пересмотреть метод и сделать третий вариант Игорь, я за "любой кипишь", если он на пользу. Не уверен, что получится реализовать, т.к. разбросано сильно по текстам и режимам, которые не применял никогда. Тут бы получить вариант простенький, счетчик :Refresh() (знать сколько раз подряд вызывался в том или ином режиме), отключить\включить :Refresh() (кроме, может быть, перемещения, PgUp, PgDn, Up, Dn, ...), что бы самому управлять :Refresh() в др. случаях, с очисткой или нет это уже техника, параметры есть. А "третий вариант" это событие 55 (выше), оно может быть простым или более сложным, но оно работает когда мне надо, а не тсб за меня, что то пытается изобразить. Такое событие не сунешь в тсб, т.к. оно внешнее по отношению к тсб и может работать как с кнопок, мышек, ..., других окон и даже др. процесса. Такие мысли
Haz: SergKis пишет: Не уверен, что получится реализовать, т.к. разбросано Ну как метод сделать можно, черновик попробовал , мелькает меньше ( только на DrawSelect )
SergKis: Haz пишет Ну как метод сделать можно, черновик попробовал , мелькает меньше ( только на DrawSelect ) На DrawSelect не должна моргать, там же ничего нет, после всех DrawLine одна строка поверх с др. атрибутами цвета ... и все "Дойдешь до кондиции" выложи на посмотреть
Haz: SergKis пишет: На DrawSelect не должна моргать Должна, сначала рисуются все строки drawline а потом drawselect и эта прорисовка со стандарта на селект видна на плохой сети. Но это решаемо алгоритмом
Haz: SergKis пишет: третий вариант" это событие 55 (выше Сделал контрольный, чуть косметики и выложу. Это не совсем событие 55, там у тебя Refresh без очистки. Это значит , что при установке фильтра и не полном заполнении окна бровса, строки из фильтра перерисуются, а остальные остаются мусором на экране. В данном случае нужна очистка, но ее видно мельканием, т.к. сначала полностью очищается окно, а потом все рисуем заново Чисто теоретически , при неполном заполнении окна бровса с очисткой работает быстрее ( меньше строк рисовать ) а с дорисовкой плавнее и плюс бонусом опционально сетка на незанятой область бровса ( любым цветом ). Я сделал пример не с очисткой , а с дорисовкой всего окна бровса
SergKis: Haz пишет Это значит , что при установке фильтра и не полном заполнении окна бровса, строки из фильтра перерисуются, а остальные остаются мусором на экране. Ты не понял, событие 55 может быть разным, простым, более сложным, Например такое :Event(55, {|ow,ky,ob| DoEvents(), ky := ow, ob:Refresh(ob:nLen < ob:nRowCount(), .T.), DoEvents() }) то, что было ранее это из примера, где фиксированное кол-во строк в тсб, который служит для установки\снятия галочек как в RedioGroup и вызывается в :bPostEdit, т.е. давая завершить работе методов :Edit... и прорисовкой тек. строки и только потом сработает 55 событие, которое перерисует все строки, для показа состояния галочек др. строк. PS И если откл. внутреннее исп. :Refresh() (в :UpStable или др. варанты), то 55 событие позволяет мне управлять когда перепоказывать окно тсб
Haz: SergKis пишет: Ты не понял, событие 55 может быть разным, простым, более сложным, Да понял я, вопрос в том что есть два варианта рефреш. Первый не чистит мусор, второй моргает. А так да , согласен на 55 можно понаписать свой h_tbrowse целиком
SergKis: Haz пишет вопрос в том что есть два варианта рефреш. Первый не чистит мусор, второй моргает Написанный выше дает только один вариант, на все случаи и :nLen ставит и чистит когда надо, по мне вопроса тут нет. То что моргает, так это уровень C, туда не лезем, т.к. DoubleBuffer не будет реализован. Т.е. что есть, то и используем
Andrey: Всем привет ! У меня есть иконки в ресурсах ехе-ника. Можно организовать показ этих иконок в ТСБ ? bmp как показывать знаю....
gfilatov2002: Andrey пишет: Можно организовать показ этих иконок в ТСБ ? Да, можно Выложил рабочий пример по адресу click here Он сделан на базе примера MiniGUI\SAMPLES\Advanced\Tsb_BitMaps
Andrey: gfilatov2002 пишет: Выложил рабочий пример по адресу Спасибо БОЛЬШОЕ ! И в своей библиотеке подправь этот пример. Будет тогда отлично !
Andrey: А иконку в контекстное меню можно сразу выводить ? Без всякой замены на лету ? А то приходилось делать в два этапа, вывести пустой ресурс, а потом менять его на иконку. Сложно это, давно перестал делать.
gfilatov2002: Andrey пишет: А иконку в контекстное меню можно сразу выводить ? Уже можно... Благодарю за запрос
alex_II: Столкнулся с несоответствием в описании структуры массива aColors. Использовал superheader и захотел поменять цвета через SetColor, в описании это 16 и 17 элементы массива, а на деле оказалось надо указывать 15 и 16 элемент. Глянул в TSBROWSE.CH. там тоже 16 и 17, непонятно Использую HMG Extended Edition version 22.12 (Update 2).
SergKis: alex_II пишет захотел поменять цвета через SetColor, в описании это 16 и 17 элементы массива Кусочек со старого примера (версии старше указанной), работает на 16 и 17 элементы[pre2] STATIC FUNCTION mySupHdTsb( oBrw, aSupHd ) LOCAL O := oBrw:Cargo // использовать из контейнера свои переменные ADD SUPER HEADER TO oBrw FROM 1 TO oBrw:nColCount() TITLE " "+aSupHd[1] HORZ DT_LEFT WITH OBJECT oBrw // задать цвета суперхидеру :SetColor( {16}, { O:nClr16 } ) // 16, фона :SetColor( {17}, { O:nClr17 } ) // 17, текста END WIDTH RETURN NIL [/pre2]
Andrey: Если я ставлю фильтр на базу oBrw:FilterData( cFilter ), то у меня при перемещении по базе на линии ВЕРТИКАЛЬНОГО скролинга бегунок неправильно отображается. Как починить его ?
Haz: Andrey пишет: Как починить его ? разбираться со значением :bLogicLen после вызова фильтра. Там устанавливается конкретное значение , отличное от изначального в :setdbf() Ошибка. bLogicLen. не учтена работа в шаред режиме при которой коллеги могут внести правки в базу , влияющие на фильтр , а так же удаление и добавление новых записей и то что фильтр можно поставить вне бровса. И при значении :bLogicLen == {|| 1000} после последнего вызова метода получим ерунду. А так же, не применимо для логики ads в целом , с его AOF фильтрами.
Andrey: Иконки рисуются красиво на светлых тонах. Но если выводить на тёмном фоне, на иконках появляются "зазубрины": Это можно как то исправить ? P.S. Пробовал ставить темные иконки - не проходит.... Хотя в меню такие иконки нормально выглядят...
Andrey: Собираю коллекцию показа ресурсов в ТСБ ! Не могу понять как можно загрузить bmp, png, jpg из внешней dll + с изменением размеров ? Т.е. картинки в dll могут быть любых размеров, а мне в ТСБ нужно выводить нужный размер, допустим 90х90. С иконками разобрался, их можно загружать в ТСБ любых размеров. Работа с ресурсами в ТСБ: [pre2]#include "minigui.ch" #define LOAD_LIBRARY_AS_DATAFILE 0x00000002 ////////////////////////////////////////////////////////// .... oBrw:GetColumn( "FLD1" ):aCheck := { LoadImage( ".\RES\check1.bmp" ), LoadImage( ".\RES\check0.bmp" ) } oBrw:GetColumn( "FLD2" ):aCheck := { GETICONFROMRES( ".\RES\Edit32.ico" ), NIL } // файл иконки 32x32 oBrw:GetColumn( "FLD3" ):aCheck := { GETICONFROMRES( "iFolder32" ) , NIL } // ресурс иконки в ехе-файле 32x32 oBrw:GetColumn( "FLD4" ):aCheck := { myLoadIconByName( "iSave128", 48 ), NIL } // 48x48 - ресурс иконки 128x128 в ехе-файле oBrw:GetColumn( "FLD5" ):aCheck := { myLoadIconByName( ".\RES\Edit32.ico", 64 ), NIL } // файл иконки 32x32 увеличим 64x64 oBrw:GetColumn( "FLD6" ):aCheck := { myLoadLibraryEx("Image.Dll", "iExit", 90 ), NIL } // ресурс иконки в dll-файле любые размеры oBrw:GetColumn( "FLD7" ):aCheck := { LoadImage( ".\RES\Save32.png" ), NIL } oBrw:GetColumn( "FLD8" ):aCheck := { LoadImage( ".\RES\Mail32.jpg" ), NIL } oBrw:GetColumn( "FLD9" ):aCheck := { myLoadImageDll( "Image.Dll", "png_Mail", 64 ), NIL } oBrw:GetColumn( "FLD6" ):lBitMap := .T. oBrw:GetColumn( "FLD6" ):aBitMaps := { LoadImage( ".\RES\edit_delete.bmp" ), ; LoadImage( ".\RES\edit_cancel.bmp" ), ....... } ..... FUNCTION myLoadIconByName( cIcon, nWH) LOCAL hIcon, hBmp hIcon := myLoadIconByName( cIcon, nWH, nWH ) hBmp := BmpFromIcon( hIcon ) DestroyIcon(hIcon) RETURN hBmp FUNCTION myLoadLibraryEx( cIconDll, cIcon, nWH ) LOCAL hIcon, hLib, hIconFromDll, hBmp := 0 If !File( cIconDll ) MsgStop("There is no resource file for the program!" + CRLF + cIconDll ) Return hBmp Endif hLib := LoadLibraryEx( cIconDll, 0, LOAD_LIBRARY_AS_DATAFILE ) if ! Empty( hLib ) hIconFromDll := LoadIconByName( cIcon, nWH, nWH, hLib ) if ! Empty( hIconFromDll ) hIcon := CopyIcon( hIconFromDll ) hBmp := BmpFromIcon( hIcon ) DestroyIcon( hIconFromDll ) DestroyIcon( hIcon ) endif FreeLibrary( hLib ) endif RETURN hBmp[/pre2] Замечания по коду приветствуются. Если хендл не получился, возвращаю 0, может и неправильно, но зато потом можно убить сразу все хендлы: [pre2] ON RELEASE {|| AEval(ahBmp, {|h| DestroyIcon( h ) }) }[/pre2] Как можно сделать функцию - myLoadImageDll( "Image.Dll", "png_Mail", 64 ) ? где "png_Mail" - имя ресурса, 64 - нужный размер показа
Andrey: В новой версии МиниГуи 23.09 (Update 2) сделать просмотр dbf-файла просто. Минимальный код для открытия базы: [pre2] #include "minigui.ch" REQUEST DBFCDX, DBFFPT FUNCTION Main() LOCAL cDbf := GetStartUpFolder() + '\test_Engl.dbf' RddSetDefault("DBFCDX") SET FONT TO "DejaVu Sans Mono", 13 USE (cDbf) NEW EXCLUSIVE TsbViewer() RETURN NIL // добавить при сборке библиотеку TsbViewer.lib[/pre2] Внешний вид окна:
Dima: Andrey пишет: В новой версии МиниГуи 23.09 (Update 2) сделать просмотр dbf-файла просто. Да мы в курсе , читаем ChangeLog.txt PS C:\MiniGUI\SAMPLES\Advanced\Tsb_Viewer\demo5.prg
Dima: Правда есть ньюанс при запуске
Andrey: Dima пишет: Правда есть ньюанс при запуске Странно и непонятно. Такое впечатление что берется старая TsbViewer.lib Так как в новой TsbViewer.lib MAIN окно включено по умолчанию. Пересобрал заново TsbViewer.lib - поправил пути в tsbviewer.hbp, т.к. я делаю свой путь для каждой версии МиниГуи [pre2]-workdir=c:/minigui-23.09.2/lib/hbmk/obj -oc:/minigui-23.09.2/lib/TsbViewer -Ic:/minigui-23.09.2/include [/pre2]Перепроверил ещё раз у себя, собирается и запускается без ошибок.
Dima: Andrey пишет: Странно и непонятно. TsbViewer.lib от 04.07.23 TsbViewer.prg от 06.01.22
Andrey: Вот в новой версии у меня так:
Dima: Andrey пишет: Такое впечатление что берется старая TsbViewer.lib Да , так и есть , лежала либа в папке C:\MiniGUI\SAMPLES\Advanced\Tsb_Viewer\ , убил её и пересобрал , работает
Andrey: Ну и отлично !
alex_II: Есть ряд одинаковых по структуре файлов. Можно как-то в открытом TsBrowse на лету поменять DBF-файл?
SergKis: alex_II Переоткройте др. dbf с тем же alias, можно и в той же области
alex_II: Забыл уточнить, все файлы открыты.
SergKis: alex_II пишет Забыл уточнить, все файлы открыты. SergKis пишет Переоткройте ... [pre2] oBrw:UserKeys( VK_F6, {|ob| myNewOpen(ob) } ) ... FUNC myNewOpen(oBrw) Local cNewDbf := ... dbSelectArea(oBrw:cAlias) USE USE (cNewDbf) ALIAS (oBrw:cAlias) SHARED oBrw:Reset() RETURN Nil [/pre2]
Andrey: Построил таблицу. Как можно поменять фон цвета шапки и подвала у столбца SELECTOR (1) ?
SergKis: Andrey А посмотреть метод :DrawHeaders слабо и поискать F7 в far "lSelect" ? Там несколько строк всего
Andrey: SergKis пишет: А посмотреть метод :DrawHeaders слабо и поискать F7 в far "lSelect" ? Там несколько строк всего Посмотрел, ни фига не понял
SergKis: Andrey пишет Посмотрел, ни фига не понял Странно выбор данных для переменной nClrBack из переменных oBrw и oColumn[pre2] IF !( nJ == 1 .AND. ::lSelector ) // не 1-я колонка IF ( nClrBack := iif( ::nColOrder == nI, oColumn:nClrOrdeBack, oColumn:nClrHeadBack ) ) == NIL nClrBack := iif( ::nColOrder == nI, nClrOrdeBack, nClrHeadBack ) ENDIF ELSE // 1-я колонка nClrBack := iif( ::nClrSelectorHdBack == NIL, ATail( ::aColumns ):nClrHeadBack, ::nClrSelectorHdBack ) ENDIF ниже есть и для Footer IF ::lFooting .AND. ::lDrawFooters ... IF !( nJ == 1 .AND. ::lSelector ) // JP nClrBack := iif( oColumn:nClrFootBack != NIL, oColumn:nClrFootBack, nClrFootBack ) ELSEIF ::nClrSelectorHdBack != NIL nClrBack := ::nClrSelectorHdBack ELSE nClrBack := ATail( ::aColumns ):nClrFootBack ENDIF ... [/pre2]
Andrey: [pre2] ELSEIF cCol == "SELECTOR" oCol:nClrHeadBack := oTsb:n12Clr4Back // фона шапки селектора колонка 1 oCol:nClrFootBack := oTsb:n12Clr10Back // фона подвала селектора колонка 1 [/pre2] Так не работает. Если делаем так, то вылет ! [pre2] ELSEIF cCol == "SELECTOR" oCol:nClrSelectorHdBack := oTsb:n12Clr4Back // фона шапки селектора колонка 1 oCol:nClrFootBack := oTsb:n12Clr10Back // фона подвала селектора колонка 1 [/pre2]
SergKis: Andrey Копипастишь и придумываешь, ты просто посмотри внимательно код выше, по названиям видно
Andrey: Вот ещё пример ТСБ в папке \MiniGUI-23.10\SAMPLES\Advanced\APP_OOPTEMPLATE Окно и таблица строится из ини-файла Demo_timer.cfg Смотреть секцию - [ТАБЛИЦЯ_БД_АБОНЕНТИ] Правая кнопка мышки на ячейке вызывает меню для работы с буфером: Копировать в буфер/Вставить из буфера/Удалить в зависимости от языка. Предусмотрен вызов меню по клику мышки на суперхидере. Повторное открытие базы в другой кодировке на "лету", без закрытия таблицы.
krutoff: Всех с Новым Годом! Прошу в h_tbrowse.prg сделать изменения в строке 5266 IF ::lIsArr .AND. oCol:cDataType # ValType( uValue ) // GF 15/07/2009 cType := ValType( uValue ) oCol:cDataType := cType ENDIF В моем случае, если cDataType = 'M', то этот блок переводит cDataType в 'C' и дальше не отрабатывает строка 5451 ELSEIF ( cType == "C" .AND. Chr( 13 ) $ uValue ) .OR. cType == "M" .OR. oCol:lEditBox и редактирование переводит на GetBox. Я, конечно, вручную поставил oCol:lEditBox := .T., но хотелось бы автоматически.
gfilatov2002: krutoff пишет: в h_tbrowse.prg сделать изменения в строке 5266 Благодарю за подсказку. Поправил эту строку для учета "М" типа данных. Мой контрольный пример см. ниже: [pre2] /* * MINIGUI - Harbour Win32 GUI library Demo * * Copyright 2021 Sergej Kiselev <bilance@bilance.lv> */ #include "minigui.ch" #include "tsbrowse.ch" #include "dbinfo.ch" STATIC cParent // ----------------------------------- FUNCTION Main() // ----------------------------------- LOCAL cTitle := "Test Browse: Right Click For Record View", ; bSetup := {| oBrw, lAft | SetMyBrowser( oBrw, lAft ) }, ; cFont := "Tahoma", nSize := 10, aArr if !file("test.dbf") CreateTable() endif USE ( hb_dirBase() + "test.dbf" ) NEW aArr := Test->( HMG_DbfToArray() ) SET AUTOADJUST ON NOBUTTONS SET FONT TO cFont, nSize DEFINE FONT Normal FONTNAME cFont SIZE nSize DEFINE FONT Bold FONTNAME cFont SIZE nSize BOLD SET DEFAULT ICON TO GetStartupFolder() + "\demo.ico" DEFINE WINDOW sample AT 0, 0 WIDTH 640 HEIGHT 480 ; TITLE "Open Table via SBrowse" ; MAIN NOSHOW ; ON INIT ( This.Timer_1.Enabled := .T., SBrowse( aArr, cTitle, bSetup,, 950, 430,,, .T. ) ) ; ON RELEASE ( Test->( dbZap() ), Test->( HMG_ArrayToDBF( aArr ) ), dbCloseArea( "Test" ) ) DEFINE TIMER Timer_1 INTERVAL 1000 ACTION iif( Empty( CountChildWindows() ), ThisWindow.Release(), ) This.Timer_1.Enabled := .F. DEFINE TIMER Timer_2 INTERVAL 250 ; ACTION iif( _IsControlDefined( "Btn_1", cParent ), ; ( SetProperty( cParent, "Btn_1", "Enabled", .F. ), ; SetProperty( cParent, "Btn_2", "Enabled", .F. ) ), ) ONCE END WINDOW sample.Center() sample.Activate() RETURN NIL // ----------------------------------- FUNCTION CreateTable // ----------------------------------- dbCreate( "Test", { { "CODE", "C", 3, 0 }, { "NAME", "C", 50, 0 }, { "RESIDENTS", "N", 11, 0 }, { "NOTES", "M", 10, 0 } },, .T. ) dbAppend() REPLACE CODE WITH 'LTU', NAME WITH 'Lithuania', RESIDENTS WITH 3369600 dbAppend() REPLACE CODE WITH 'USA', NAME WITH 'United States of America', RESIDENTS WITH 305397000 dbAppend() REPLACE CODE WITH 'POR', NAME WITH 'Portugal', RESIDENTS WITH 10617600 dbAppend() REPLACE CODE WITH 'POL', NAME WITH 'Poland', RESIDENTS WITH 38115967 dbAppend() REPLACE CODE WITH 'AUS', NAME WITH 'Australia', RESIDENTS WITH 21446187 dbAppend() REPLACE CODE WITH 'FRA', NAME WITH 'France', RESIDENTS WITH 64473140 dbAppend() REPLACE CODE WITH 'RUS', NAME WITH 'Russia', RESIDENTS WITH 141900000 USE RETURN NIL // ----------------------------------- FUNCTION SetMyBrowser( oBrw, lAft ) // ----------------------------------- LOCAL cFormName := oBrw:cParentWnd, cTitle, oCol, ; hFont := GetFontHandle( "Bold" ) IF Empty( lAft ) SetProperty( cFormName, "MinWidth", 950 ) SetProperty( cFormName, "MinHeight", 430 ) cParent := cFormName WITH OBJECT oBrw :nHeightCell += 5 :nHeightHead += 12 :nClrFocuFore := CLR_BLACK :nClrFocuBack := COLOR_GRID :hFontSupHd := hFont :nHeightSuper := oBrw:nHeightHead END WITH cTitle := "Code" ADD SUPER HEADER TO oBrw FROM 1 TO 2 TITLE " Array" ADD SUPER HEADER TO oBrw FROM 3 TO oBrw:nColCount() TITLE cTitle FOR EACH oCol IN oBrw:aColumns oCol:hFontHead := hFont if hb_enumindex(oCol) == 4 oCol:cDataType := "M" endif NEXT ELSE oBrw:GetColumn( "ORDKEYNO" ):hFontFoot := hFont oCol := ATail( oBrw:aColumns ) ATail( oBrw:aSuperHead )[ 2 ] := oBrw:nColumn( oCol:cName ) IF oBrw:nLen > oBrw:nRowCount() oBrw:ResetVScroll( .T. ) ENDIF oBrw:SetNoHoles() oBrw:SetFocus() ENDIF RETURN .T. // editable browse (return .F. is readonly) // ----------------------------------- FUNCTION CountChildWindows // ----------------------------------- LOCAL i, nFormCount := Len ( _HMG_aFormHandles ), nCnt := 0 FOR i := 1 TO nFormCount IF _HMG_aFormType[ i ] <> "A" IF _IsWindowDefined ( _HMG_aFormNames[ i ] ) nCnt++ ENDIF ENDIF NEXT RETURN nCnt [/pre2]
krutoff: Я так понимаю, что динамическая высота строк TSBrowse не предусмотрена? Бывает очень длинная строка и ячейка ее не показывает, обрезает, даже если показывать через CRLF.
SergKis: krutoff пишет Я так понимаю, что динамическая высота строк TSBrowse не предусмотрена? есть немного с memo полями, переменные смотрите в коде[pre2] DATA nMemoHE // memo sizes on edit and view mode DATA nMemoWE // Height in lines and Width in pixels DATA nMemoHV // default: 3 lines height and 200 pixels width DATA nMemoWV и STATIC FUNCTION SetHeights( oBrw ) ... // Now for cells ... IF Empty( oBrw:nMemoHV ) IF At( Chr( 13 ), cHeading ) > 0 oBrw:nMemoHV := Len( hb_ATokens( cHeading, Chr( 13 ) ) ) ENDIF ENDIF DEFAULT oBrw:nMemoHV := 2 [/pre2] Предусмотреть динамическую высоту автоматом, по мне, трудно (тип С), т.к. каждому надо по разному от ширины колонки. Например, я часто использую схему ширина не > 45 символов и на tooltip ячейки вешаю полное содержимое, что бы получить больше колонок в просмотре и не исп. для поля С вставки CRLF для вертикального разбиения показа ячейки, т.к. это съедает строки в просмотре и в др. строках будут пустоты в ячейки, текст короче. PS Проще выделить место на окне показа или отдельное окно, в котором организовать показ длинных полей, при перемешении по тсб в Label-ах, GetBox-ах ReadOnly или EditBox ReadOnly или тсб с вертикальной раскладеой, как по полям одной записи в SBrowse. Ситуация с отдельным окном может оказаться предпочтительней, т.к. вызывать просмотр можно по кнопке или R\L клику
Andrey: Есть длинная строка адреса. В ТСБ естественно будет показываться только то кол-во символов, которые заданы в picture. Допустим 30 символов. А можно сделать чтобы показывало последние 30 символов из строки в колонке ?
SergKis: А можно сделать чтобы показывало последние 30 символов из строки в колонке ? oCol:bDecode := {|ca| ca := trim(ca), iif( Len(ca) > 30, "..."+right(ca, 30), ca ) }
Andrey: Спасибо БОЛЬШОЕ !
alex_II: ТСБ работает с массивом ... s1 := 0 aKv - массив [4,11] ... Br:SetArrayTo(aKv,,aZg,aWi,aFoot,aPict,aAlgn) Хочу при старте заполнить подвал второй колонки, в этой колонке цифры и надо подсчитать сумму Делаю так: Br:aColumns[2]:cFooting := {|| aEval(Br:aArray, {|aVal,nElm| s1 += aVal[2]}), str(s1,10,2)} но aEval почему-то проходит по массиву 4 раза, т.е сумма получается в четыре заза больше.
SergKis: alex_II Тсб - это просто рисование данных в таблице по настройке, ничего не считает. В данном случае прошло 4-е прохода прорисовки. Надо посчитать и записать в нужные колонки :cFooting := cValToChar(...) или в переменные, поля dbf, ... и в :cFooting := блок кода для получения строки из них (для каждой колонки), тогда по каким то действиям меняете значения данных для этих блоков кода и делаете переотображение тсб всех строк oBrw:Refresh(...), курсора oBrw:DrawSelect(), oBrw:DrawFooters()
alex_II: Я извиняюсь, но ничего не понял. Я описал ситуацию, которая происходит при старте программы, когда еще никаких действий не производилось. ТСБ прорисовывает таблицу по данным из массива и я пытаюсь заполнить подвал до всех действий. Тут вопрос думаю не к ТСБ, а а к блоку кода, тем более он у меня вложенный.
SergKis: alex_II 1. Тсб - это просто рисование данных в таблице по настройке, ничего не считает. 2. Выносите свой блок кода, подсчета итоговых сумм, из тсб отдельно 3. Создаете массив для показа в тсб 4. Запускаете подсчет сумм по колонкам массива, т.е. исполняете свой блок кода, итоги запомнили 5. DEFINE TBROWSE ... => в колонки переносите итоги oCol:cFooting := <итоги из массива, как строка> END TBROWSE 6. Тсб нарисуется вместе с итогами (за 4-ре раза, потому в вашей ситуации учетверение сумм, так не надо делать) Если делаем правку строк с суммами в строках массива тсб :lEdit := .T., то итоги надо пересчитать, т.е. запускаем блок кода подсчета сумм п.2, получив новые итоги, заносим их результаты в нужные oCol:cFooting и делаем oBrw:DrawFooters() - перерисовать подвал. Если, например, у вас есть массив итогов aItig, то можно исп. блок кода в oCol:cFooting := {|| hb_ntos(aItog[3]) } и так во все колонки. Блок кода будет обеспечивать данные дли Footers по выполнению oBrw:DrawFooters() PS Примеры APP_OOPREPORT смотрите, там есть итоги в массивах, создаваемых по кнопкам
alex_II: Спасибо за развёрнутый ответ
Andrey: SergKis пишет: Примеры APP_OOPREPORT смотрите, там есть итоги в массивах, создаваемых по кнопкам Можно ещё глянуть этот пример - SAMPLES\Advanced\Tsb_array_4 там тоже идёт подсчёт итогов !
alex_II: Пример: ...\MiniGUI\SAMPLES\Advanced\Tsb_array_2\demo5.prg Сперва думал, что сам как-то повлиял своими настройками, убил на это день. У меня белый фон и вид получается удручающий
Andrey: alex_II пишет: У меня белый фон и вид получается удручающий Картинку в студию ! Красивый и продвинутый ТСБ смотри \SAMPLES\Advanced\Tsb_5Win
alex_II: Нужен именно такой вид, максимально приближенный к распечатке. Там. где была корректировка, сетка нарушается. В 21 году вроде эта тема обсуждалась, но с ходу не нашел когда.
Andrey: Попробуй увеличить высоту ячеек. [pre2] oBrw:nHeightCell += 6 [/pre2]
Haz: alex_II пишет: Там. где была корректировка, сетка нарушается. В методе Edit() координаты окна редактирования рассчитываются не пойми как и для каждого контрола отдельно. Погрешность выравнивается подгонкой через массив из 4 значений. Выхода из положения два 1 править edit() 2 перед редактированием задавать сдвиги в массиве корректировки координат окна редактирования. Высота строки бровса тут не при чем т ее изменение не поможет
Andrey: Пример - SAMPLES\Advanced\Tsb_Basic\demo.prg [pre2] oBrw:nHeightCell += 10 // к высоте ячеек таблицы добавим oBrw:nHeightHead += 5 // к высоте шапки таблицы добавим // GetBox встраиваем в ячейку, задаем отступы oBrw:aEditCellAdjust[1] += 4 // cell_Y + :aEditCellAdjust[1] oBrw:aEditCellAdjust[2] += 2 // cell_X + :aEditCellAdjust[2] oBrw:aEditCellAdjust[3] -= 5 // cell_W + :aEditCellAdjust[3] oBrw:aEditCellAdjust[4] -= 8 // cell_H + :aEditCellAdjust[4] [/pre2]
alex_II: С высотой ячеек и не только я игрался целый день, ничего не помогает. Править метод Edit() нет ни желания ни возможности, много работы. Печалька.
SergKis: alex_II пишет Там. где была корректировка, сетка нарушается oBrw:DrawSelect(), oBrw:Refresh() перерисовывают строку курсора и все окно, не понимаю проблему совсем Не нравится oBrw:aEditCellAdjust, положите на ячейку[и] modal окно в размеры или больше со своим вводом Править метод Edit() нет ни желания ни возможности, много работы Метод Edit править нет нужды, даже мыслей на это нет, а сделать свой ввод (можно даже красивый) один раз и использовать везде ЭТО и есть работа над проектом (hmg это продукт как есть и использование его вами это ваш риск ...)
Haz: alex_II пишет: Править метод Edit() нет ни желания ни возможности, много работы. Печалька. Там править ничего не надо, нужно просто подменить. У себя , когда лень менять исходники делаю замену [pre] После определения бровса ( DEFINE BROWSE .. OBJ oBrw ...) подменяю методы на свои и нет нужды каждый раз править oBrw := __objModMethod( oBrw, 'edit', @edit() ) oBrw := __objModMethod( oBrw, 'GetCellinfo', @Cell() ) А вот исходники функций #include "minigui.ch" #include "tsbrowse.ch" #include "ads.ch" #include "common.ch" Func Edit( uVar, nCell, nKey, nKeyFlags, cPicture, bValid, nClrFore, nClrBack ) LOCAL nRow, nHeight, cType, uValue, nI, aGet, oCol, cMsg, aRct, bChange, lSpinner, bUp, bDown, ; bMin, bMax, nStartX, nWidth, lCombo, lMulti, nCol, lLogicDrop, lPicker, nTxtHeight, hFont, ix LOCAL oBrw := QSelf() LOCAL cWnd := oBrw:cControlName LOCAL nK, aKey, oGet, cTmp, oCell DEFAULT nCell := oBrw:nCell, ; oBrw:lPostEdit := .F., ; oBrw:lNoPaint := .F. IF oBrw:lPhantArrRow RETURN NIL ENDIF oCol := oBrw:aColumns[ nCell ] oCol:xOldEditValue := oBrw:bDataEval( oCol, , nCell ) // Igor Nazarov DEFAULT oBrw:nHeightSuper := 0, ; nKey := VK_RETURN, ; nKeyFlags := 0, ; uVar := oBrw:bDataEval( oCol ), ; cPicture := oCol:cPicture, ; bValid := oCol:bValid, ; nClrFore := oCol:nClrEditFore, ; nClrBack := oCol:nClrEditBack IF ValType( oBrw:lInsertMode ) == "L" // Igor Nazarov IF IsInsertActive() != oBrw:lInsertMode iif( _HMG_IsXPorLater, KeyToggleNT( VK_INSERT ), KeyToggle( VK_INSERT ) ) ENDIF ENDIF uValue := uVar cType := iif( Empty( oCol:cDataType ), ValType( uValue ), oCol:cDataType ) IF cType != "M" .AND. oBrw:lIsArr .AND. oCol:cDataType # ValType( uValue ) // GF 15/07/2009 cType := ValType( uValue ) oCol:cDataType := cType ENDIF cMsg := oCol:cMsgEdit bChange := oCol:bChange lSpinner := oCol:lSpinner bUp := oCol:bUp bDown := oCol:bDown bMin := oCol:bMin bMax := oCol:bMax nStartX := 0 lCombo := lMulti := .F. oBrw:oGet := oBrw:bValid // JP oBrw:bValid := {|| ! oBrw:lEditing } // JP 1.58 IF ! oCol:lVisible oBrw:lChanged := .F. oBrw:lPostEdit := .F. oBrw:oWnd:nLastKey := VK_RIGHT oBrw:PostEdit( uVar, nCell, bValid ) RETURN NIL ENDIF // End IF oCol:bPassWord != NIL IF ! Eval( oCol:bPassWord, uValue, nCell, oBrw:nAt, Self ) RETURN NIL ENDIF ENDIF lLogicDrop := oBrw:lLogicDrop lPicker := oBrw:lPickerMode // MWS Sep 20/07 IF cType == 'T' lPicker := ( hb_Hour( uValue ) == 0 .AND. hb_Minute( uValue ) == 0 .AND. hb_Sec( uValue ) == 0 ) ENDIF oBrw:lEditing := .T. oBrw:lHitBottom := .F. IF oBrw:nLen > 0 oBrw:lNoPaint := .T. ENDIF IF oCol:bPrevEdit != NIL IF oBrw:lIsArr .AND. ( oBrw:lAppendMode .OR. oBrw:nAt > Len( oBrw:aArray ) ) // append mode for arrays ELSEIF nKey != VK_RETURN // GF 15-10-2015 uVar := Eval( oCol:bPrevEdit, uValue, Self, nCell, oCol ) IF ValType( uVar ) == "A" uVar := uVar[ 1 ] uValue := uVar[ 2 ] ENDIF IF ValType( uVar ) == "L" .AND. ! uVar nKey := VK_RETURN ENDIF ENDIF ENDIF oBrw:FastDrawClear( hb_ntos( oBrw:nAtPos ) + "." + hb_ntos( oCol:nId ) ) cMsg := iif( ValType( cMsg ) == "B", Eval( cMsg, Self, nCell ), cMsg ) IF cType == "L" .AND. oCol:lCheckBox IF nKey != VK_RETURN .OR. ! oCol:lCheckBoxNoReturn .OR. oBrw:lCheckBoxAllReturn IF Upper( Chr( nKey ) ) $ "YCST1" oBrw:lChanged := ( uVar == .F. ) uVar := .T. ELSEIF Upper( Chr( nKey ) ) $ "FN0" oBrw:lChanged := ( uVar == .T. ) uVar := .F. ELSEIF nKey == VK_SPACE .OR. nKey == VK_RETURN uVar := ! uValue oBrw:lChanged := .T. ELSE RETURN 0 ENDIF oBrw:lHasChanged := iif( oBrw:lChanged, .T., oBrw:lHasChanged ) oBrw:oWnd:nLastKey := VK_RETURN oBrw:PostEdit( uVar, nCell ) oBrw:lPostEdit := .F. RETURN 0 ELSE oBrw:lPostEdit := .T. oBrw:lChanged := .F. oBrw:oWnd:nLastKey := nKey oBrw:PostEdit( uValue, nCell ) oBrw:lPostEdit := .F. RETURN 0 ENDIF ENDIF IF oCol:bExtEdit != NIL // external edition oBrw:lNoPaint := oBrw:lEditing := .F. uVar := Eval( oCol:bExtEdit, uValue, Self ) oBrw:lChanged := ( ValType( uVar ) != ValType( uValue ) .OR. uVar != uValue ) oBrw:lPostEdit := .T. oBrw:oWnd:nLastKey := VK_RETURN oBrw:PostEdit( uVar, nCell, bValid ) RETURN NIL ENDIF hFont := iif( oCol:hFontEdit != NIL, oCol:hFontEdit, ; iif( oCol:hFont != NIL, oCol:hFont, oBrw:hFont ) ) IF oCol:oEdit != NIL oCol:oEdit:End() oCol:oEdit := NIL ENDIF 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 nClrFore := iif( ValType( nClrFore ) == "B", ; Eval( nClrFore, oBrw:nAt, nCell, Self ), nClrFore ) nClrBack := iif( ValType( nClrBack ) == "B", ; Eval( nClrBack, oBrw:nAt, nCell, Self ), nClrBack ) oCell := oBrw:GetCellInfo() nRow := oCell:nRow nCol := oCell:nCol nWidth := oCell:nWidth nHeight := oCell:nHeight IF oCol:nEditWidthDraw > 0 nWidth := oCol:nEditWidthDraw IF ! oBrw:lNoVScroll nWidth -= GetVScrollBarWidth() ENDIF ENDIF IF oCol:cResName != NIL .OR. oCol:lBtnGet nRow += oBrw:aEditCellAdjust[ 1 ] nCol += oBrw:aEditCellAdjust[ 2 ] nWidth += oBrw:aEditCellAdjust[ 3 ] nHeight += oBrw:aEditCellAdjust[ 4 ] IF oCol:nEditWidth > 0 nWidth := oCol:nEditWidth ENDIF IF oCol:nEditHeight > 0 nHeight := oCol:nEditHeight ENDIF IF oCol:nEditRow > 0 nRow := oCol:nEditRow ENDIF IF oCol:nEditCol > 0 nCol := oCol:nEditCol ENDIF oBrw:cChildControl := GetUniqueName( "BtnBox" ) oCol:oEdit := TBtnBox():New( nRow, nCol, bSETGET( uValue ), Self, nWidth, nHeight, ; cPicture, nClrFore, nClrBack, hFont, oBrw:cChildControl, cWnd, ; cMsg, bChange, bValid, oCol:cResName, oCol:bAction, ; lSpinner .AND. cType $ "ND", bUp, bDown, ; bMin, bMax, oCol:nBmpWidth, nCell ) oCol:oEdit:lAppend := oBrw:lAppendMode oCol:oEdit:Hide() ELSEIF ( cType == "C" .AND. Chr( 13 ) $ uValue ) .OR. cType == "M" .OR. oCol:lEditBox IF oCol:lEditBox .AND. ! Empty( uValue := Trim( uValue ) ) IF Len( oCol:cEditBoxSep ) > 0 .AND. oCol:cEditBoxSep != CRLF .AND. oCol:cEditBoxSep $ uValue uValue := StrTran( uValue, oCol:cEditBoxSep, CRLF ) ENDIF IF oCol:nEditBoxWrap > 0 cTmp := uValue nK := MLCount( cTmp, oCol:nEditBoxWrap, , .T. ) uValue := "" FOR nI := 1 TO nK uValue += Trim( MemoLine( cTmp, oCol:nEditBoxWrap, nI, , .T. ) ) IF nI != nK uValue += CRLF ENDIF NEXT ENDIF ENDIF IF oBrw:nMemoHE == NIL IF ! Empty( uValue ) nHeight := Max( 5, StrCharCount( uValue, Chr( 10 ) ) ) ELSE nHeight := 5 ENDIF ELSE nHeight := oBrw:nMemoHE ENDIF aRct := oBrw:GetCliRect( oBrw:hWnd ) IF oBrw:nMemoWE == NIL .OR. Empty( oBrw:nMemoWE ) nWidth := Max( nWidth, GetTextWidth( 0, SubStr( uValue, 1, ; At( Chr( 13 ), uValue ) - 1 ), ; iif( hFont != NIL, hFont, 0 ) ) ) nWidth := Min( nWidth, Int( aRct[ 3 ] * .8 ) ) ELSE nWidth := oBrw:nMemoWE ENDIF nTxtHeight := SBGetHeight( oBrw:hWnd, iif( hFont != NIL, hFont, 0 ), 0 ) WHILE ( nRow + ( nTxtHeight * nHeight ) ) > aRct[ 4 ] nRow -= nTxtHeight ENDDO nI := nCol + nWidth - aRct[ 3 ] nCol -= iif( nI <= 0, 0, nI ) nCol := Max( 10, nCol ) nHeight *= nTxtHeight nRow += oBrw:aEditCellAdjust[ 1 ] nCol += oBrw:aEditCellAdjust[ 2 ] nWidth += oBrw:aEditCellAdjust[ 3 ] nHeight += oBrw:aEditCellAdjust[ 4 ] oBrw:cChildControl := GetUniqueName( "EditBox" ) oCol:oEdit := TSMulti():New( nRow, nCol, bSETGET( uValue ), Self, nWidth, nHeight, ; hFont, nClrFore, nClrBack, oBrw:cChildControl, cWnd ) oCol:oEdit:bGotFocus := {|| oCol:oEdit:HideSel(), oCol:oEdit:SetPos( 0 ) } lMulti := .T. IF oCol:lEditBoxROnly oCol:oEdit:SendMsg( EM_SETREADONLY, 1, 0 ) ENDIF oCol:oEdit:Hide() ELSEIF ( cType == "L" .AND. lLogicDrop ) .OR. oCol:lComboBox lCombo := .T. IF oCol:lComboBox aGet := oCol:aItems IF Empty( aGet ) RETURN NIL ENDIF IF nKey == VK_RETURN IF oCol:cDataType != NIL .AND. oCol:cDataType == "N" IF oCol:aData <> NIL uValue := Max( 1, AScan( aGet, uValue ) ) ELSE uValue := iif( uValue < 1 .OR. uValue > Len( aGet ), 1, uValue ) ENDIF ELSE uValue := Max( 1, AScan( aGet, uValue ) ) ENDIF ELSE uValue := Max( 1, AScan( aGet, Upper( Chr( nKey ) ) ) ) ENDIF IF ValType( oBrw:bDataEval( oCol ) ) == "N" nWidth := 0 AEval( aGet, {| x | nWidth := Max( Len( x ), nWidth ) } ) nWidth := Max( GetTextWidth( 0, Replicate( 'B', nWidth ), hFont ), oCol:nWidth ) ENDIF nHeight := Max( 10, Min( 10, Len( aGet ) ) ) * oBrw:nHeightCell ELSE aGet := { oBrw:aMsg[ 1 ], oBrw:aMsg[ 2 ] } IF nKey == VK_RETURN uValue := iif( uValue, 1, 2 ) ELSE uValue := Max( 1, AScan( aGet, Upper( Chr( nKey ) ) ) ) ENDIF nHeight := oBrw:nHeightCell * 4 // 1. ENDIF nRow += oBrw:aEditCellAdjust[ 1 ] nCol += oBrw:aEditCellAdjust[ 2 ] nWidth += oBrw:aEditCellAdjust[ 3 ] nHeight += oBrw:aEditCellAdjust[ 4 ] IF oCol:nEditWidth > 0 nWidth := oCol:nEditWidth ENDIF IF oCol:nEditHeight > 0 nHeight := oCol:nEditHeight ENDIF IF oCol:nEditRow > 0 nRow := oCol:nEditRow ENDIF IF oCol:nEditCol > 0 nCol := oCol:nEditCol ENDIF oBrw:cChildControl := GetUniqueName( "ComboBox" ) oCol:oEdit := TComboBox():New( nRow, nCol, bSETGET( uValue ), aGet, nWidth, nHeight, ; Self, bChange, nClrFore, nClrBack, hFont, cMsg, oBrw:cChildControl, cWnd ) oCol:oEdit:lAppend := oBrw:lAppendMode ELSEIF ( cType $ "DT" ) .AND. lPicker // MWS Sep 20/07 nRow -= 2 nHeight := Max( oBrw:nHeightCell, 19 ) nRow += oBrw:aEditCellAdjust[ 1 ] nCol += oBrw:aEditCellAdjust[ 2 ] nWidth += oBrw:aEditCellAdjust[ 3 ] nHeight += oBrw:aEditCellAdjust[ 4 ] IF oCol:nEditWidth > 0 nWidth := oCol:nEditWidth ENDIF IF oCol:nEditHeight > 0 nHeight := oCol:nEditHeight ENDIF IF oCol:nEditRow > 0 nRow := oCol:nEditRow ENDIF IF oCol:nEditCol > 0 nCol := oCol:nEditCol ENDIF oBrw:cChildControl := GetUniqueName( "DatePicker" ) oCol:oEdit := TDatePicker():New( nRow, nCol, bSETGET( uValue ), Self, nWidth, nHeight, ; cPicture,, nClrFore, nClrBack, hFont, oBrw:cChildControl,, cWnd, ; cMsg,,,,, bChange,,, oBrw:lShowNone, oBrw:lUpDown ) oCol:oEdit:Hide() ELSE ix := GetControlIndex ( cWnd, oBrw:cParentWnd ) IF _HMG_aControlContainerRow[ ix ] == -1 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 IF oCol:nEditWidth > 0 nWidth := oCol:nEditWidth ENDIF IF oCol:nEditHeight > 0 nHeight := oCol:nEditHeight ENDIF IF oCol:nEditRow > 0 nRow := oCol:nEditRow ENDIF IF oCol:nEditCol > 0 nCol := oCol:nEditCol ENDIF IF oCol:cEditPicture != NIL cPicture := oCol:cEditPicture ENDIF oBrw:cChildControl := GetUniqueName( "GetBox" ) oCol:oEdit := TGetBox():New( nRow, nCol, bSETGET( uValue ), oBrw, nWidth, nHeight, ; cPicture,, nClrFore, nClrBack, hFont, oBrw:cChildControl, cWnd, ; cMsg,,,,, bChange, .T.,, lSpinner .AND. cType $ "ND", bUp, bDown, ; bMin, bMax, oCol:lNoMinus ) IF oCol:nEditAlign != NIL _SetAlign( oBrw:cChildControl, oBrw:cParentWnd, { "LEFT", "CENTER", "RIGHT" }[ oCol:nEditAlign + 1 ] ) ENDIF IF ! Empty( oCol:aKeyEvent ) oGet := oCol:oEdit:oGet FOR nK := 1 TO Len( oCol:aKeyEvent ) aKey := oCol:aKeyEvent[ nK ] IF HB_ISNUMERIC( aKey[ 1 ] ) oGet:SetKeyEvent( aKey[ 1 ], aKey[ 2 ], aKey[ 3 ], aKey[ 4 ], aKey[ 5 ] ) ENDIF NEXT ENDIF ENDIF IF oCol:oEdit != NIL oCol:oEdit:oBrw := oBrw oCol:oEdit:oCol := oCol oCol:oEdit:nCol := nCell oCol:oEdit:bLostFocus := {| nKey | oBrw:EditExit( nCell, nKey, uValue, bValid, .F. ) } oCol:oEdit:bKeyDown := {| nKey, nFlags, lExit | iif( lExit != NIL .AND. lExit, ; oBrw:EditExit( nCell, nKey, uValue, bValid ), Nil ), HB_SYMBOL_UNUSED( nFlags ) } DO CASE CASE "TBTNBOX" $ Upper( oCol:oEdit:ClassName() ) oCol:oEdit:bLostFocus := NIL CASE "TGETBOX" $ Upper( oCol:oEdit:ClassName() ) ix := GetControlIndex ( oBrw:cChildControl, oBrw:cParentWnd ) _HMG_InteractiveCloseStarted := .T. IF ix > 0 IF oCol:lOnGotFocusSelect IF ValType( uValue ) == "C" _HMG_aControlGotFocusProcedure[ ix ] := {|| SendMessage( _HMG_aControlHandles[ ix ], EM_SETSEL, 0, iif( Empty( uValue ), -1, Len( Trim(uValue ) ) ) ) } ELSEIF ValType( uValue ) $ "ND" _HMG_aControlGotFocusProcedure[ ix ] := {|| SendMessage( _HMG_aControlHandles[ ix ], EM_SETSEL, 0, -1 ) } ENDIF ENDIF _HMG_aControlLostFocusProcedure[ ix ] := {| nKey | oBrw:EditExit( nCell, nKey, uValue, bValid, .F. ) } ENDIF IF Empty( oBrw:bLostFocus ) oBrw:bLostFocus := {|| iif( _HMG_InteractiveCloseStarted, _HMG_InteractiveCloseStarted := .F., ) } ENDIF ENDCASE oCol:oEdit:SetFocus() IF nKey != NIL .AND. nKey > 31 IF ! lCombo .AND. ! lMulti oBrw:KeyChar( nKey, nKeyFlags ) // 1.53 ENDIF ENDIF IF oCol:oEdit != NIL oCol:oEdit:Show() ENDIF oBrw:SetMsg( oCol:cMsgEdit ) IF oCol:bEditing != NIL Eval( oCol:bEditing, uValue, Self ) ENDIF ENDIF Return nil Func Cell() LOCAL nI, nStartX := 0, oCol, cBrw, cForm, nRowPos, nCell, lColSpecHd, oBrw LOCAL nRow, nCol, nWidth, nHeight LOCAL lHead := .F., lFoot := .F. LOCAL oCell := TSBcell():New() oBrw:= QSelf() nRowPos := oBrw:nRowPos nCell := oBrw:nCell lColSpecHd := oBrw:nColSpecHd != 0 IF HB_ISLOGICAL( nRowPos ) IF nRowPos ; lHead := .T. ELSE ; lFoot := .T. ENDIF nRowPos := NIL lColSpecHd := .F. ENDIF DEFAULT nRowPos := oBrw:nRowPos, ; nCell := QnCell, ; 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 nRow := oBrw:nHeightHead + oBrw:nHeightSuper + iif( oCol:l3DLook, 2, 0 ) nCol := nStartX + iif( oCol:l3DLook, 2, 0 ) nWidth := oBrw:GetColSizes()[ nCell ] - iif( oCol:l3DLook, 2, 1 ) nHeight := oBrw:nHeightSpecHd - iif( oCol:l3DLook, 1, -1 ) ELSE nRow := nRowPos - 1 nRow := ( nRow * oBrw:nHeightCell ) + oBrw:nHeightHead + ; oBrw:nHeightSuper + oBrw:nHeightSpecHd + iif( oCol:l3DLook, 2, 0 ) nCol := nStartX + iif( oCol:l3DLook, 2, 0 ) nWidth := oBrw:GetColSizes()[ nCell ] - iif( oCol:l3DLook, 2, 0 ) nHeight := oBrw:nHeightCell - iif( oCol:l3DLook, 1, -1 ) ENDIF IF oCol:nEditWidthDraw > 0 nWidth := oCol:nEditWidthDraw IF ! oBrw:lNoVScroll nWidth -= GetVScrollBarWidth() ENDIF ENDIF IF lHead nRow := oBrw:nHeightSuper + iif( oCol:l3DLook, 2, 0 ) + 1 nHeight := oBrw:nHeightHead ELSEIF lFoot nRow := _GetClientRect( oBrw:hWnd )[ 4 ] - oBrw:nHeightFoot + 1 nHeight := oBrw:nHeightFoot ENDIF oCell:nRow := nRow oCell:nCol := nCol - 1 oCell:nWidth := nWidth oCell:nHeight := nHeight - 3 RETURN oCell [/pre]
SergKis: Haz пишет У себя , когда лень менять исходники делаю замену А мне всегда лень это делать, обхожусь вариантом modal окон как в примере Tsb_addrecord_3 ф-я STATIC FUNCTION Add_Rec( oBrw ) только для всех вариантов ведения (Add, Add+Copy, Del, Edit) и окно может быть как для одной Cell так и нескольких, а GETBOX-ы иметь встроенные кнопки для ACTION и ACTION2
Haz: SergKis пишет: А мне всегда лень это делать, обхожусь вариантом modal окон как в примере Tsb_addrecord_3 ф-я STATIC FUNCTION Add_Rec( oBrw ) только для всех вариантов ведения (Add, Add+Copy, Del, Edit) и окно может быть как для одной Cell так и нескольких, а GETBOX-ы иметь встроенные кнопки для ACTION и ACTION2 Сергей , привет. Согласен, с твоей подачи тоже использую MODAL, подмены метода использую для быстрого моделирования. ну чтоб не совсем стыдно было черновик показывать Потом можно бесконечно наводить красоту.
Andrey: Схема расчёта итогов на лету, после установки фильтра на базу. Может кому будет интересно. Т.е. набираем буквы в поиске, и получаем итого в подвале таблицы. Спасибо ОГРОМНОЕ Сергею. [pre2]* Построение таблицы справочника/поиск по буквам и подсчёт итогов "на лету" ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 1) LOCAL aFldSum := {"F3", "F4"} // поля базы числовые !!! ... DbSelectArea(cAls) aItogo := Itogo_Dbf(aFldSum, Alias(), .T.) // расчёт итого по базе DEFINE WINDOW Report AT .... ; ON INIT _wPost( 0) ; ON RELEASE _wSend(90) ... This.Cargo := oHmgData() ; owc := This.Cargo // для окна создаем объект без переменных (условно пустой) owc:aFldSum := aFldSum // для подвала таблицы - итого owc:nCount := aItogo[1] owc:aItogo := aItogo[2] owc:aReturn := {} // для возврата выбранных значений ... DEFINE TBROWSE oRpt OBJ oRpt AT nY, nX ALIAS cAls .... ; ... ; ON INIT {|ob| myTsbInit( ob ) } // настройки таблицы - смотреть ниже myTsbTune(oRpt) // настроить myTsbColor(oRpt,oBrw) // цвета изменить myTsbKeys(oRpt) // обработка клавиш // не должно быть нигде, кроме события ! myTsbItogo() // показ подвала END TBROWSE ON END {|ob| ob:SetNoHoles(), ob:SetFocus() } This.Cargo:oRpt := oRpt // положить объект oRpt (таблицу) на окно // GetBox в подвале таблицы - можно сделать и через меню @ nY-nG, nX+nG GETBOX GB_Find OBJ oGet WIDTH nW-nG HEIGHT nH VALUE space(30) ; PICTURE "@K" NOTABSTOP INVISIBLE ; ON LOSTFOCUS {|| This.Cargo := .F., This.Value := space(30), This.Hide } ; ON CHANGE {|| iif( Empty( This.Cargo ), NIL, Search_TSB( ThisWindow.Object, .T. ) ) } ; ON INIT {|| This.Cargo := .T. } This.Cargo:oGet := oGet This.Cargo:cGet := "GB_Find" // запомнить для дальнейшего использования /////////////////////////////////// o := This.Object o:Event( 0, {|ow| _wPost(22, ow) } ) // инициализация после построения окна o:Event( 22, {|ow| myTsbItogo(ow) } ) // итого refresh o:Event( 90, {| | aReturn := (This.Cargo):aReturn } ) // возврат LOCAL aReturn o:Event( 99, {|ow| ow:Release() } ) END WINDOW RETURN aReturn 2) // GetBox в подвале таблицы STATIC FUNCTION Search_TSB(oWnd, aWait) // поиск по базе LOCAL oRpt, cVal, cGet, aItg Default oWnd := ThisWindow.Object Default aWait := .F. oRpt := oWnd:Cargo:oRpt cGet := oWnd:Cargo:cGet // это "GB_Find" IF !Empty(aWait) IF HB_ISLOGICAL(aWait) aWait := "Расчёт ИТОГОВ ..." ENDIF // нельзя срабатывает LOSGFOCUS getbox //WaitWindow( aWait, .T. , 600, 16, NIL, BLUE, App.Cargo:aBClrMain ) ENDIF SET WINDOW THIS TO oWnd This.&(cGet).Show cVal := Trim( This.&(cGet).Value ) SET WINDOW THIS TO oRpt:FilterFTS( cVal, .T. ) // Empty(cVal) обработка внутри метода aItg := Itogo_Dbf(oWnd:Cargo:aFldSum, oRpt:cAlias) // расчёты итого oWnd:Cargo:nCount := aItg[1] oWnd:Cargo:aItogo := aItg[2] // нельзя срабатывает LOSGFOCUS getbox //IF !Empty(aWait) ; WaitWindow() //ENDIF _wSend( 22, oWnd ) // вывод в подвал //но можно и //_wPost( 22, oWnd ) // вывод в подвал RETURN .T. 3) // расчёт итого по базе STATIC FUNCTION Itogo_Dbf(aFld, cAls, aWait) // расчёты итого LOCAL nLen := 0, nRec, aItg, aPos, nPos LOCAL nOld := Select(), nCnt := 0, nSum Default cAls := Alias(), aWait := .F. IF !Empty(aWait) IF HB_ISLOGICAL(aWait) aWait := "Wait processing ..." ENDIF WaitWindow( aWait, .T. , 600, 16, NIL, BLUE, App.Cargo:aBClrMain ) ENDIF dbSelectArea( cAls ) nRec := RecNo() aItg := Array(Len(aFld)) ; aFill(aItg, 0) aPos := {} ; AEval(aFld, {|cn| AAdd(aPos, FieldPos(cn)) }) DO EVENTS GO TOP DO WHILE ! EOF() nCnt++ DO EVENTS FOR EACH nPos IN aPos IF nPos > 0 .and. HB_ISNUMERIC( nSum := FieldGet( nPos ) ) aItg[ hb_EnumIndex(nPos) ] += nSum ENDIF NEXT SKIP ENDDO DbGoTo( nRec ) ; DO EVENTS IF !Empty(aWait) ; WaitWindow() ENDIF dbSelectArea( nOld ) ; DO EVENTS RETURN { nCnt, aItg } 4) STATIC FUNCTION myTsbItogo( oWnd ) // подвал - ТОЛЬКО показ LOCAL aItg := oWnd:Cargo:aItogo Local oRpt := oWnd:Cargo:oRpt oRpt:aColumns[1]:cFooting := {|nc,ob| nc := ob:nLen, iif( Empty(nc), "", hb_NtoS(nc) ) } oRpt:aColumns[3]:cFooting := {|nc | nc := aItg[1], iif( Empty(nc), "", hb_NtoS(nc) ) } oRpt:aColumns[4]:cFooting := {|nc | nc := aItg[2], iif( Empty(nc), "", hb_NtoS(nc) ) } oRpt:Cargo:cKeyLang := '('+KB_LANG()+')' // -> util_keychar.prg oRpt:aColumns[5]:cFooting := oRpt:Cargo:cKeyLang oRpt:DrawFooters() ; DO EVENTS RETURN Nil[/pre2]
Andrey: Открываю базу, устанавливаю индекс, делаю SCOPE на базу. После правки (ENTER) ячейки - теряется SCOPE... Почему ? Что там хитрого сделано после правки ячейки ?
SergKis: Andrey пишет После правки (ENTER) ячейки - теряется SCOPE... Почему ? Что там хитрого сделано после правки ячейки ? При создании тсб надо ставить правильный тэг индекса, тсб его удерживает, если не используешь привязку тэгов к колонкам.
Andrey: SergKis пишет: При создании тсб надо ставить правильный тэг индекса, тсб его удерживает, если не используешь привязку тэгов к колонкам. Да кто же знал об этом ... Спасибо БОЛЬШОЕ ! Заработало !
полная версия страницы