Форум » 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:....
Andrey: Вот ещё одна непонятка для меня. Беру пример \SAMPLES\Advanced\Tsb_array_2\demo.prg Меняю: [pre2] LOCAL cFontName := "Comic Sans MS" LOCAL nFontSize := 16 DEFINE TBROWSE oBrw ; .... FONT cFontName SIZE nFontSize ; GRID [/pre2] Фонт меняется в таблице, визуально видно. Запрашиваю размер фонта так:[pre2] hFont := oBrw:hFont // считать хендл фонта ячеек таблицы //hFont := oBrw:aColumns[2]:hFont // 1-cells font If hFont != Nil aFontGet := GetFontParam(hFont) nFSize2 := aFontGet[2] // узнать истинный размер фонта в ячейке ENDIF ? "nFontSize=", nFontSize, "|nFSize2=", nFSize2, hb_ValToExp(aFontGet) Получаю: [pre2] nFontSize=16 |nFSize2=9 {"Segoe UI", 9, .F., .F., .F., .F., 0}[/pre2] Почему так получается ? Или я неправильно делаю ? Тогда подскажите пожалуйста как нужно определить размер фонта в ячейках.
SergKis: Andrey пишет Почему так получается ? Или я неправильно делаю ? Может игнорируешь исходники, для понимания ситуации ?
TimTim: Andrey пишет: Юзер хочет добавить запись под/перед курсором/маркером бровса, а не в конец базы. Haz пишет: Держи активный индекс по которому сортируются записи. Хоть вычисляемый, хоть по значению в поле. При добавлении позаботься о том чтобы у новой записи индекс получил нужное значение. Привожу пример грубой реализации - https://cloud.mail.ru/public/2CQk/xrGVyF58D В примере также реализовал "движение" записи вверх-вниз. Действительно совет Haz: далее нужно всего лишь применить новую редакцию ::gotorec() с указанием нужной строки очень помог. Я еще мало что могу в использовании MiniGui и TsBrowse в частности. А есть задача, в которой желательно реализовать следующее. Во-первых, реализовать отметку нескольких записей по SHIFT/CTRL + клик мышью (как в проводнике, например) и затем перемещение / копирование этих записей после указанной курсором записи, т.е. "привычный" copy/past. Во-вторых, хотелось бы, чтобы перемещенная запись меняла цвет шрифта или фона, например, как в Total Commander. Это только на момент работы с БД. После выхода из TsBrowse сохранять цвет измененных записей не надо.
Haz: TimTim пишет: Во-первых, реализовать отметку нескольких записей по SHIFT/CTRL + клик мышью (как в проводнике, например) Реализовать отметку можно добавив в бровс объект массив с номерами отмеченных записей. Сделать это можно так [pre2] __objAddData( oBrw, 'aRecordds' ) oBrw:aRecords := {} [/pre2] Далее по bLClick добавлять в этот массив номера записей, проверяя предварительно нажата ли CTRL или SHIFT. С SHIFT придется повозится на предмет получения не одного а списка номеров записей TimTim пишет: затем перемещение / копирование этих записей после указанной курсором записи, т.е. "привычный" copy/past. можно через контекстное меню с пересчетом ключа индекса для копируемых (перемещаемых) записей TimTim пишет: хотелось бы, чтобы перемещенная запись меняла цвет шрифта или фона, в условии oBrw:SetColor() проверять есть ли запись в массиве помеченных. См. пример TSB_CALENDAR как там сделана отметка и покраска . Правда там отметка относится к ячейке, но логика одинакова
TimTim: Спасибо за ответ. Пример с календарем посмотрю. А чем и как ловить нажатие клавиш CTRL и / или SHIFT?
Haz: TimTim пишет: А чем и как ловить нажатие клавиш CTRL и / или SHIFT? KBDSTAT() Bit Key ------------------------------------------------------------------------ 1 Right shift currently pressed 2 Left shift currently pressed 3 Ctrl currently pressed (left or right) 4 Alt currently pressed (Alt or Shift-Alt) 5 Scroll-Lock ON/OFF 6 Num-Lock ON/OFF 7 Caps-Lock ON/OFF 8 Insert ON/OFF IF ISBIT(KBDSTAT(), 3) MsgDebug("CTRL pressed") END
SergKis: Haz Что то new :GotoRec(...) как то не так срабатывает. Пример https://my-files.ru/4e57lz Работа кнопок Up, Down и перепоказ после них 1. New вариант :GotoRec положил в функцию myGotoRec 2. Old вариант oBrw:GotoRec(...) 3. галочки переключают на функцию и доп параметр nRowPos На родном (old) варианте отрабатывает ок, по показ с 1-ой строки На new варианте ломается показ, нажмем Home показ восстановится Или я что то потерял ?
SergKis: PS чуть перепутал, но это не влияет на результат[pre2] If lPos MyGotoRec(oBrw, nRec, nRow) Else MyGotoRec(oBrw, nRec) EndIf [/pre2]
Haz: SergKis пишет: new варианте ломается показ, Завтра посмотрю
Haz: SergKis пишет: Что то new :GotoRec(...) как то не так срабатывает. Сергей, вроде со скипами там косяк был [pre2] FUNC myGotoRec( oBrw, nRec, nRowPos ) LOCAL cAlias LOCAL nSkip := 0 LOCAL lMore := .T. LOCAL lSkip := .F. LOCAL lRet := .F. LOCAL lReCount := .F. with object oBrw If :lIsDbf lRet := .T. cAlias := :cAlias :nLastPos := (cAlias)->( RecNo() ) hb_default( @nRowPos, :nRowPos ) (cAlias)->( dbGoto(nRec) ) DO WHILE (cAlias)->( !EOF() ) .and. nSkip < ( :nRowCount() - nRowPos ) (cAlias)->( dbSkip(1) ) nSkip ++ ENDDO If (cAlias)->( EOF() ) lReCount := .T. nRowPos := :nRowCount() - nSkip + 1 EndIf (cAlias)->( dbGoto(nRec) ) nSkip := 0 :nRowPos := 1 DO WHILE lMore (cAlias)->( dbSkip(-1) ) nSkip ++ lMore := !(cAlias)->(BOF()) .and. nSkip < (nRowPos) // lSkip := !(cAlias)->(BOF()) ENDDO // :Refresh(lReCount, lReCount) //If lSkip :Skip( nSkip -1 ) //EndIf :Refresh(lReCount, lReCount) :nRowPos := nSkip :nAt := :nLogicPos() :Refresh(lReCount, lReCount) :ResetVscroll() If :bChange != Nil Eval( :bChange, Self, 0 ) EndIf :lHitTop := :lHitBottom := .F. DO EVENTS EndIf end with RETURN lRet [/pre2] твой пример погонял - все норм
SergKis: Haz пишет твой пример погонял - все норм Игорь добавь до 21 строки в таблице (в районе 7 к примеру) и жмем End С записью Line 15 проделываем Up, Down во всех режимах С new вариантом перескок отображения на Line 13, что не совсем правильно
Haz: SergKis пишет: добавь до 21 строки в таблице (в районе 7 к примеру) и жмем End Да, все увидел. Пару дней возьму на правку и тестирование.
Andrey: Всем привет. Сделал у себя выгрузку базы через SetArrayTo() и обломался. Оказывается таблица больше 41 колонок НЕ ДЕЛАЕТСЯ. А у меня в базе 120 колонок, есть и ещё чуть больше. Этот параметр наверное как то задан по умолчанию ? Увеличить можно сейчас ? Раньше компы были слабее, а сейчас на порядок быстрее.
SergKis: Andrey пишет Оказывается таблица больше 41 колонок НЕ ДЕЛАЕТСЯ. Странное утверждение. Tsb_array_2\demo.prg меняем слегка[pre2] STATIC FUNCTION CreateDatos() LOCAL a, i, k := 1000, aDatos, aHead, aSize, aFoot, aPict, aAlign, aName aDatos := Array( k ) FOR i := 1 TO k aDatos[ i ] := { " ", ; // 1 i, ; // 2 ntoc( i ) + "_123", ; // 3 Date() + i, ; // 4 PadR( "Test line - " + ntoc( i ), 20 ), ; // 5 Round( ( 10000 -i ) * i / 3, 2 ), ; // 6 100.00 * i, ; // 7 0.12, ; // 8 Round( 100.00 * i * 0.12, 2 ), ; // 9 Round( 1234567.00 / i, 3 ), ; // 10 PadR( "Line " + StrZero( i, 5 ), 20 ), ; // 11 Date(), ; // 12 Time(), ; // 13 i % 2 == 0 } // 14 a := AClone(aDatos[ i ]) AEval(a, {|xv| AAdd(aDatos[ i ], xv) }) AEval(a, {|xv| AAdd(aDatos[ i ], xv) }) AEval(a, {|xv| AAdd(aDatos[ i ], xv) }) AEval(a, {|xv| AAdd(aDatos[ i ], xv) }) AEval(a, {|xv| AAdd(aDatos[ i ], xv) }) AEval(a, {|xv| AAdd(aDatos[ i ], xv) }) AEval(a, {|xv| AAdd(aDatos[ i ], xv) }) AEval(a, {|xv| AAdd(aDatos[ i ], xv) }) NEXT ... [/pre2] 126 колонок есть
Haz: SergKis пишет: Странное утверждение Да, тоже не понял как клеятся слова выгрузка и setarrayto. Куда выгрузка, где эти колонки? У меня Tsbrowse был с 1000 колонок
Andrey: Haz пишет: У меня Tsbrowse был с 1000 колонок У меня почему то 41 колонка и всё, больше не идёт. SergKis пишет: 126 колонок есть У меня почему то режет в 3-х местах только на 41 колонку. Буду смотреть у себя, раз нет ограничений.
Andrey: Понял почему это происходит. Так как у меня выгружается иногда и по 40-50 тыс.записей, я сделал для того чтобы юзер не смотрел и не видел пустой экран, создание формы и показ таблицы из одной записи на 41 колонку. Потом я в ON INIT передаю новый массив. А далее делаю: [pre2] oBrw8:DeleteRow( .T. ) // Delete All oBrw8:aArray:={} // очистить массив aArray := aDim // переопределяем на новый входящий массив For nI := 1 TO Len(aArray) if ! empty(aArray[ nI ]) ADD ITEM aArray[ nI ] TO &cBrw OF &cForm EndIf Next[/pre2] Из-за этого у меня и режется до 41 колонки.
Andrey: Непонятка возникает при обновлении массива. Показываю прелодер, а он при создании таблицы не показывает лепестки - белый экран и всё. Делаю так: [pre2] // создаём окно ожидания с потоком WaitThreadCreate( 'Расчёт по отчёту ...' ) // как в SAMPLES\BASIC\WAIT_WINDOW_2\demo2.prg SetProperty(oBrw8:cParentWnd, oBrw8:cControlName, "Enabled", .F.) oBrw8:DeleteRow( .T. ) // Delete All oBrw8:aArray:={} // очистить массив aArray := aDim // переопределяем на новый входящий массив For nI := 1 TO Len(aArray) if ! empty(aArray[ nI ]) ADD ITEM aArray[ nI ] TO &cBrw OF &cForm // вариант 1 EndIf IF nI % 500 DO EVENTS // чтобы показывать прелодер из WaitThreadCreate() ENDIF Next[/pre2] Если поместить DO EVENTS то таблица на экране вся показывается и мелькает, потом подвисает ещё иногда. Если убрать DO EVENTS то таблицы на экране нет (что хорошо), но прелодер не работает, белый экран на нём, без лепестков и время сбоку в секундах стоит, отображает 00:00:00. Как можно заставить прелодер отображаться ?
Haz: Andrey пишет: таблица на экране вся показывается и мелькает, Зачем? Зачем в ts добавлять по одному элементу? Формируй массив данных любуюсь на свой прелодер. А потом добавляй целиком. Хоть через SetArray(To) или прямым присвоением в oBrw:aArray с последующей синхронизации бровса ( тоже все уже разжевано на форуме) . Даже был пример как не массив а dbf подменить на лету.
Andrey: Haz пишет: А потом добавляй целиком. Переделал это добавление. Действительно быстрее намного получилось. Только прелодер все равно белый, без лепестков. На 1-2 секунды появляется всего, потом уже Tsbrowse показывается.
полная версия страницы