Форум » 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: Haz пишет Может обработку bEditLog поднять перед этой подготовкой? По мне, не стоит. Это в If ... else ... min 2 раза вставлять. Не пробовал, но если :nEditMove := 0, то :nCell и nCol должны быть равными. Достаточно, по мне, сохранить, установить и восстановить :nCell, как показал выше
SergKis: PS Но если :nEditMode будет с перескоком на другую строку тсб, то RecNo(), (:cAlias)->ID, ... будут неверными. И поэтому, Игорь, твое предложение будет, наверно, правильнее.
SergKis: Haz пишет Может обработку bEditLog поднять перед этой подготовкой? Поднял [pre2] METHOD PostEdit( uTemp, nCol, bValid ) CLASS TSBrowse ... ( cAlias )->( DbSkip( 0 ) ) // refresh relations just in case that a relation field changes xNewEditValue := ::bDataEval( ::aColumns[ nCol ], , nCol ) //Igor Nazarov If hb_isBlock( ::bEditLog ) .and. ::aColumns[ nCol ]:xOldEditValue != xNewEditValue Eval( ::bEditLog, ::aColumns[ nCol ]:xOldEditValue, xNewEditValue, Self ) EndIf ::SetFocus() If nLastKey == VK_UP .and. ::lPostEditGo ... If lAppend .and. ::bChange != Nil Eval( ::bChange, Self, ::oWnd:nLastKey ) EndIf xNewEditValue := ::bDataEval( ::aColumns[ nCol ], , nCol ) //Igor Nazarov If hb_isBlock( ::bEditLog ) .and. ::aColumns[ nCol ]:xOldEditValue != xNewEditValue Eval( ::bEditLog, ::aColumns[ nCol ]:xOldEditValue, xNewEditValue, Self ) EndIf ::SetFocus() If nLastKey == VK_UP .and. ::lPostEditGo ... // xNewEditValue := ::bDataEval( ::aColumns[ nCol ], , nCol ) //Igor Nazarov // If hb_isBlock( ::bEditLog ) .and. ::aColumns[ nCol ]:xOldEditValue != xNewEditValue // Eval( ::bEditLog, ::aColumns[ nCol ]:xOldEditValue, xNewEditValue, Self ) // EndIf Return Nil ... [/pre2] Пример отработал нормально
Haz: SergKis пишет: Пример отработал нормально Сергей, спасибо за помощь.
Andrey: Наверное всё таки журнал правки лучше держать в виде базы ? А то за несколько лет текстовый лог разрастётся непомерно и поиск в нем будет идти долго.
Vlad04: А то за несколько лет текстовый лог разрастётся Веди в разрезе года. Новый год, новый файл
Andrey: Искал, искал и не нашёл. Как убрать в таблице в колонках дата пустые даты - ". ." ?
SergKis: Andrey пишет Как убрать в таблице в колонках дата пустые даты - ". ." ? oCol:lEmptyValToChar := .T. нули тоже убирает
Andrey: SergKis пишет: oCol:lEmptyValToChar := .T. нули тоже убирает Не совсем понял... Это по колонкам нужно пробежаться ? А сразу на всю таблицу нет команды ? Как например oBrw:lPickerMode := .F. P.S. Да проверил, нужно самому пробежаться по колонкам. [pre2] For nI := 1 To :nColCount() oCol := :aColumns[ nI ] // центровка подвала таблицы oCol:nFAlign := DT_CENTER If oCol:cName == 'Name_1' oCol:nAlign := DT_CENTER // центровка колонки 'Name_1' EndIf // фонты для строк таблицы oCol:hFont := {|nr,nc,ob| TsbFont(nr, nc, ob)} // убрать пустую дату и 0 в колонках oCol:lEmptyValToChar := .T. Next[/pre2] СПАСИБО БОЛЬШОЕ !
SergKis: Andrey пишет Это по колонкам нужно пробежаться ? Да. А сразу на всю таблицу нет команды ? AEval(oBrw:aColumns, {|oc| oc:lEmptyValToChar := .T. }) У меня в tscolumns.prg стоит DATA lEmptyValToChar AS LOGICAL INIT .T. // .F. True if show of empty string for empty values of D,N,T,L types
Andrey: Очередная непонятка с SetArrayTo() Создаю массив для него, создается 9 элементов. Когда считываю его размер oBrw:nLen, пишет что 8. Как такое может быть ? Что неправильно делаю ? Вот код: [pre2]? "-----------------", cBrw , cForm ?v aArray aMassiv := aArray // переопределяем массив на сокращённый ? "LEN(aMassiv)=",LEN(aMassiv) oBrw:DeleteRow( .T. ) // Delete All oBrw:aArray := {} // очистить массив oBrw:reset() FOR nI := 1 TO LEN(aMassiv) // нужно сделать массив на +1 больше aRows := Array(1, 13) aRows[1][1] := 0 aRows[1][2] := 0 aRows[1][3] := CTOD("") aRows[1][4] := 0 aRows[1][5] := CTOD("") aRows[1][6] := SPACE(20) aRows[1][7] := 0 aRows[1][8] := 0 aRows[1][9] := CTOD("") aRows[1][10] := 0 aRows[1][11] := "" aRows[1][12] := "" aRows[1][13] := "" oBrw:AddItem( aRows[1] ) ? "-AddItem-", nI, HB_ValToExp(aRows[1]) NEXT oBrw:Reset() oBrw:Refresh(.T.) ? " oBrw:nLen=", oBrw:nLen, " LEN(aMassiv)=", LEN(LEN(aMassiv)) [/pre2] Вот лог-файл: [pre2]----------------- Set_Columns1 Form_AYC 1 {40.00, 0d20190331, 120.00, 0d20190130, ... } 2 {40.00, 0d20190331, 0.00, 0d20190131, ... } 3 {40.00, 0d20190331, 0.00, 0d20190228, ... } 4 {40.00, 0d20190331, 40.00, 0d20190322, ... } 5 {40.00, 0d20190331, 0.00, 0d20190331, ... } 6 {40.00, 0d20190831, 40.00, 0d20190416, ... } 7 {40.00, 0d20190831, 0.00, 0d20190430, ... } 8 {40.00, 0d20190831, 0.00, 0d20190531, ... } 9 {40.00, 0d20190831, 0.00, 0d20190630, ... } LEN(aMassiv)= 9 -AddItem-1 {0, 0, 0d00000000, 0, 0d00000000, "", ...} -AddItem-2 {0, 0, 0d00000000, 0, 0d00000000, "", ...} -AddItem-3 {0, 0, 0d00000000, 0, 0d00000000, "", ...} -AddItem-4 {0, 0, 0d00000000, 0, 0d00000000, "", ...} -AddItem-5 {0, 0, 0d00000000, 0, 0d00000000, "", ...} -AddItem-6 {0, 0, 0d00000000, 0, 0d00000000, "", ...} -AddItem-7 {0, 0, 0d00000000, 0, 0d00000000, "", ...} -AddItem-8 {0, 0, 0d00000000, 0, 0d00000000, "", ...} -AddItem-9 {0, 0, 0d00000000, 0, 0d00000000, "", ...} oBrw:nLen= 8 LEN(aMassiv)= 9 [/pre2]
SergKis: Andrey пишет Очередная непонятка с SetArrayTo() Что то ты мутишь с массивами. Вот пример https://TransFiles.ru/bq2op Работает
Andrey: SergKis пишет: Что то ты мутишь с массивами. Вот пример Работает Что то в коде у тебя не наблюдаю: [pre2] oBrw:DeleteRow( .T. ) // Delete All [/pre2] И нет конструкции создания массива... У меня не пойдёт - oBrw:AddItem(aDim), нужно увеличить на 1 элемент массив.
SergKis: Andrey пишет Что то в коде у тебя не наблюдаю: oBrw:DeleteRow( .T. ) // Delete All Как бы и не надо, заново массив создаем У меня не пойдёт - oBrw:AddItem(aDim), нужно увеличить на 1 элемент массив. 1. Можно иметь больше колонок и не нужным сделать oCol:Visible := .F. или :nWidth := 1 или 2 пикселя 2. Можно попробовать использовать вместо :AddItem(...) метод:SetArray( aArray, lAutoCols, aHead, aSizes )
SergKis: Andrey пишет У меня не пойдёт - oBrw:AddItem(aDim), нужно увеличить на 1 элемент массив Немного модифицировал пример https://TransFiles.ru/5zbz9 На кнопке All на 1 колонку больше, чем на др. кнопках Вместо :AddItem использовал :SetArray
SergKis: Andrey Забыл про :HideColumns(...). С ним еще проще и можно на несколько колонок распространить [pre2] *-----------------------------------------------------------------------------* STATIC FUNC Report( oWnd, nEvent, aSelect ) *-----------------------------------------------------------------------------* LOCAL aDatos, aArray, aHead, aSize, oCol, nCol, nLen LOCAL cCapt := 'All' oWnd:Action := .F. oWnd:StatusBar:Say('W A I T') If aSelect[1] != Nil cCapt := hb_ntos(aSelect[1])+'-'+hb_ntos(aSelect[2]) EndIf This.E0.Caption := cCapt DO EVENTS aDatos := AgeSelect( aSelect[1], aSelect[2] ) aArray := aDatos[1] aHead := aDatos[2] aSize := aDatos[3] WITH OBJECT oWnd:GetObj('Report'):Tsb // oBrw :Hide() ; nCol := :nColumn('STREET') ; oCol := :GetColumn(nCol) AEval(:aColumns, {|oc,nc| oc:nWidth := aSize[ nc ], ; oc:cHeading := aHead[ nc ] }) :HideColumns( nCol, ! 'All' $ cCapt ) :Display() ; :AdjColumns() ; DO EVENTS :SetArray(aArray, .T.) :Reset() ; :GetColumn('AGE'):cFooting := hb_ntos(:nLen) :ResetVScroll( .T. ) ; :oHScroll:SetRange( 0, 0 ) :Show() ; DO EVENTS ; :SetFocus() END WITH oWnd:StatusBar:Say('') oWnd:Action := .T. RETURN Nil [/pre2]
Andrey: SergKis пишет: 2. Можно попробовать использовать вместо :AddItem(...) метод:SetArray( aArray, lAutoCols, aHead, aSizes ) Дошли руки разбираться дальше. Не понял как в моём случае это поможет. Куда в мой код это вставить, что заменить и т.д. Код примера Tsb_ReportAge.7z трудно читаемый для меня. Пока у себя сделал просто (работает однако): [pre2]FOR nI := 1 TO LEN(aMassiv) + 1 // нужно сделать массив на +1 больше aRows := Array(1, 13) [/pre2]
Andrey: Всем привет ! Делаю новый пример на базе примера MiniGUI\SAMPLES\Advanced\Tsb_Basic\demo2.prg Поймал вот такой косяк с таймером (2 окна одной и той же программы): Т.е. таймер не пашет и Refresh по таймеру не происходит. Перезапустил, пропало. А частенько так таймер работает в МиниГуи ?
SergKis: Andrey пишет Код примера Tsb_ReportAge.7z трудно читаемый для меня. Что конкретно (какое место) трудно читается ? Хочется знать, что бы пояснить. Куда в мой код это вставить, что заменить и т.д. Формируй тсб с max кол-вом колонок (чтобы не делать Insert\Add\Delete columns) и массивы в мах кол-ве колонок (нужны надписи Header, Footer для колонок) и лишние колонки делай :HideColumns(...) в примере см. AgeReport() ф-ю, там[pre2] ... :SetArray(aArray, .T.) // замена предыдущего массива в тсб массивом aArray :Reset() :GetColumn('AGE'):cFooting := hb_ntos(:nLen) // последнюю колонку убираем :ResetVScroll( .T. ) :oHScroll:SetRange(0,0) ... [/pre2]
SergKis: PS Извини с HidColumns др. кусок кода[pre2] nCol := :nCell AEval(:aColumns, {|oc,nc| oc:nWidth := aSize[ nc ] }) // восстанавливаем размеры колонок базовые :HideColumns( 'STREET', ! 'All' $ cCapt ) // убираем колонку не нужную // :cTextSupHdSet( 1, This.ToolBar_1.Caption + ' ' + cCapt ) :aSuperHead[1][3] := This.ToolBar_1.Caption + ' ' + cCapt // навание в superheader :Display() :AdjColumns() // растягиваем колонки до размеров тсб [/pre2]
Andrey: SergKis пишет: Что конкретно (какое место) трудно читается ? Хочется знать, что бы пояснить. Не могу использовать его для своего случая. Свой код привел выше. Как его модифицировать ?
SergKis: Andrey пишет Не могу использовать его для своего случая Ты даже не попробовал разобраться. Как его модифицировать ? Сделай 2а массива 1-ый используй при создании тсб 2-ой на замену (без изм. nWidth колонок), у меня он aArray в AgeReport
Andrey: Правлю свои таблицы. До этого сделал временно и оставил. Как сделать авторасширение всех столбцов таблицы чтобы справа фантомного столбца не было видно ? Что-то ранее видел, но не успел попробовать. Читал про oBrw:lAdjColumn := .T. и oBrw:AdjColumns() Не совсем понял как их применять ?
SergKis: Andrey С тек. версии hmg стало 2а алгоритма по растягиванию колонок - :AdjColumns() // если ширина всех колонок < ширины тсб, - :lAdjColumn := .F.\.T. // если есть горизонтальный скролинг колонок, при .T. предпоследняя колонка растягивается до конца ширины тсб, если последняя не вмещается
Andrey: Спасибо ! :AdjColumns() - отработал очень хорошо. :lAdjColumn := .F.\.T. - никак не отработал, хотя версия 19.08 (Update 1)
Andrey: Всем привет ! Что то опять бровс чудит. Вот такая ошибка: [pre2]Error BASE/1004 Message not found: NIL:GOTO --------------------------------- Stack Trace --------------------------------- Called from __ERRRT_SBASE(0) Called from NIL:ERROR(0) Called from (b)HBOBJECT(0) Called from NIL:MSGNOTFOUND(0) Called from NIL:GOTO(0) Called from LOADSITEPASSDIM(236) in module: Source\form_transferM1pass.prg Called from MYINITM1SITEPASS(129) in module: Source\form_transferM1pass.prg [/pre2] Куда копать ?
SergKis: Andrey пишет Error BASE/1004 Message not found: NIL:GOTO Ты потерял объект oBrw в переменной NIL:GOTO
Andrey: Всем привет ! А можно сделать выгрузку всего объекта бровса на диск в файл, а потом в другой программе просто загрузить этот файл ? Именно весь, с цветами, полями, значениями и т.д. Это нужно для небольших таблиц. Типа такого:[pre2] TsbrowseSave( M->oBrw3, "fileBrw3.obrw" ) TsbrowseRestore( "fileBrw3.obrw", M->oBrw3 )[/pre2] P.S. Можно и без цветов для начала.
SergKis: Andrey пишет Именно весь, с цветами, полями, значениями и т.д. Поиграйся ф-ями объкта ( А.Кресин http://www.kresin.ru/hrbfaq_3.html#Doc3 ) Далее следует список функций для манипуляции классами и объектами: смотрим и пробуем + ф-ии сохранения\восстановления блоков кода (забыл названия в ночи, но тема была где то) или организовывать их строковое представление для сохранения\восстановления
Andrey: SergKis пишет: смотрим и пробуем Я до сих пор так и не пользуюсь классами... Раньше считал что не особо нужно, потом уже мозги не те, не понимаю как ими пользоваться. Начинал с твоей помощью, так и забросил.
SergKis: PS При исп. :SetArrayTo(...) сохраняй\восстанавливай массивы - уже практичечки все готово, делай В примере о курсах валют от ЦБ РФ (во флайме) у меня сделано [pre2] DEFINE TBROWSE oBrw AT nY, nX ALIAS cAlias WIDTH nW HEIGHT nH GRID ; FONT { "Normal", "Header", "Footer" } ; COLORS { CLR_BLACK, CLR_BLUE } ; HEADERS { "Char;Code", "Num;Code", "Name" , "Nominal", "Value" } ; COLSIZES { 40 , 40 , 250 , 50 , 50 } ; PICTURE { , , "@R "+Repl('X',50), , } ; JUSTIFY { DT_CENTER , DT_CENTER , DT_LEFT , DT_CENTER, DT_CENTER } ; COLUMNS { "CHARCODE" , "NUMCODE" , "NAME" , "NOMINAL", "VALUE" } ; COLNAMES { "CHAR" , "NUM" , "NAME" , "NOM" , "VAL" } ; FOOTERS { "Char;Code", "Num;Code", "Name" , "Nominal", "Value" } ; BRUSH { 255, 255, 240 } ; LOADFIELDS FIXED :InsColumn( 1, oColsData( cAlias ):Get('OrdKeyNo') ) // колонку # добавили :GetColumn( 1 ):nWidth := 30 :nCell := 2 :nFreeze := 1 :lLockFreeze := .T. :nHeightFoot := :nHeightCell :nHeightCell += 4 :nClrLine := RGB(180,180,180) // COLOR_GRID // :SetColor( { 11 }, { { || RGB( 255, 255, 255 ) } } ) :SetColor( { 11 }, { { || RGB(0,0,0) } } ) :SetColor( { 2 }, { { || RGB(255,255,240) } } ) :SetColor( { 5 }, { { || RGB(0,0,0) } } ) :SetColor( { 6 }, { { |a,b,c| iif( c:nCell == b, -CLR_HRED , -RGB(128,225,225) ) } } ) :SetColor( { 12 }, { { |a,b,c| iif( c:nCell == b, -RGB(128,225,225), -RGB(128,225,225) ) } } ) :AdjColumns() END TBROWSE [/pre2] Тоже практически все готово для save\restore (кроме блоков кода цветов) Цветом выделена строка (как пример), которая есть в ch файле, но нет в программе из флайма
Andrey: Дали задачку, создать таблицу и экспортировать его в Эксель. Вопрос возник, как делать ? Писать в Dbf-файл, а потом показывать в бровсе или сразу делать через массив с помощью SetArrayTo(). Что будет быстрей по скорости для Экспорта ? База небольшая, 2500-3000 записей, кол-во столбцов примерно 50 штук.
Haz: Andrey пишет: Что будет быстрей по скорости Само собой чтение массива быстрее чем чтение файла dbf. Но это ничтожная разница по сравнению с самим экспортом.
Andrey: Спасибо ! А какая разница будет по времени по экспорту из DBF и SetArrayTo() ? Всё равно данные уже в бровсе. Я думаю что в SetArrayTo() быстрей будет строится (так всегда делаю). Но интересно знать бы насколько быстрей...
Andrey: А как отсортировать SetArrayTo() по колонке дата только в обратном порядке ? В обычном знаю:[pre2] // --------- функции сортировки колонок --------- oBrw:nColOrder := oBrw:nColumn("FDATE")[/pre2]
SergKis: Andrey Добавь или поправь (Advanced\Tsb_array_2\demo.prg)[pre2] ... oBrw:lNoChangeOrd := .F. END TBROWSE [/pre2] Делай двойной click на заголовке колонки, сортировка будет тудой-сюдой
Andrey: SergKis пишет: Делай двойной click на заголовке колонки, сортировка будет тудой-сюдой Нельзя, нужно сразу юзеру таблицу предоставить отсортированной по дате в обратном порядке. Спасибо !
Andrey: А как в SetArrayTo() удалять строки в таблице. На отдельную кнопку повесил функцию удаления TsbDeleteMemo() , не работает. [pre2] IF MG_YesNo( cMsg, , "Удаление записи" ) oStatBrw:DeleteRow( ) // Delete selected row oStatBrw:Reset() oStatBrw:SetOrder(3, , .T. ) // сортировка по столбцу ItogoNN(oStatBrw) // GetColumn("NN") oStatBrw:Refresh(.T.) ENDIF[/pre2] Если подключить следующий код: [pre2] // --------- блок удаления записи --------- bDelete := { | nAt, oBrw | nAt:=nil, ItogoNN(oBrw) } // отрабатыват после DEL !!! oBrw:SetDeleteMode( .T., .F., bDelete ) // так включаем клавишу DEL !!![/pre2] То удаление работает, но у меня отдельные проверки в TsbDeleteMemo(), при некоторых условиях удалять запись НЕЛЬЗЯ ! Как запретить удаление по клавише DEL и оставить отдельную кнопку удаления ?
SergKis: Andrey пишет Как запретить удаление по клавише DEL и оставить отдельную кнопку удаления ? Делай массив (строка) на несколько элементов больше (по потребности). К примеру 2 доп. элемента 1 .T.\.F. - можно ли удалять 2 RecNo() в таблице dbf из которой создавался массив (для внесения изменений из массива в dbf) Тогда в массиве Head пишешь только нужные колонки без 2х последних На кнопку и в bDelete пишешь ф-ю, которая контролирует можно ли удалять (предпоследний элемент строки\записи массива) и далее удаляешь или нет
Andrey: SergKis пишет: 2 RecNo() в таблице dbf из которой создавался массив (для внесения изменений из массива в dbf) Тогда в массиве Head пишешь только нужные колонки без 2х последних На кнопку и в bDelete пишешь ф-ю, которая контролирует можно ли удалять (предпоследний элемент строки\записи массива) и далее удаляешь или нет Нет вообще DBF, чистый массив из мемо-поля. Допустим написал отдельную функцию проверки - CheckDel(), возвращает T.\.F. - можно ли удалять Как её использовать в коде ? [pre2] // --------- блок удаления записи --------- bDelete := { | nAt, oBrw | nAt:=nil, ItogoNN(oBrw) } // отрабатыват после DEL !!! oBrw:SetDeleteMode( .T., .F., bDelete ) // так включаем клавишу DEL !!![/pre2]
SergKis: Andrey смотри METHOD DeleteRow( lAll ) CLASS TSBrowse там для dbf, array удаление, как работает :bDelete Нет вообще DBF, чистый массив из мемо-поля. 2е колонки я давал для примера, добавляй одну для .T.\.F. и читай ее в bDelete, если .T., к примеру, удалять можно, если .F., то нельзя. Т.е. возвращай это значение из блока bDelete
Andrey: SergKis пишет: если .F., то нельзя. Т.е. возвращай это значение из блока bDelete Спасибо ! Получилось методом тыка ! [pre2] // --------- блок удаления записи --------- bDelete := { | nAt, oBrw, lDel | nAt:=nil, lDel := TsbDostupMemo(oBrw), ItogoNN(oBrw), lDel } oBrw:SetDeleteMode( .T., .F., bDelete ) // так включаем клавишу DEL !!! [/pre2]
Andrey: Всем доброго утра ! Сделал рабочий код для SetArrayTo(): [pre2] oBrw:aColumns[2]:bPostEdit := {|xVal | xVal := oBrw:aArray[oBrw:nAt][oBrw:nCell] ,; xVal := CharRepl( "|\", xVal, " " ) ,; oBrw:aArray[oBrw:nAt][oBrw:nCell] := xVal } [/pre2] А по другому написать можно это действие ? И как сделать такое же действие для Dbf
SergKis: Andrey пишет А по другому написать можно это действие ? oBrw:aColumns[2]:bPostEdit := {|xv,ob,ncol| xv := CharRepl("|\", xv, " "), ob:SetValue(ncol,xv) } И как сделать такое же действие для Dbf Есть методы и ты их использовал в своих примерах, но подзабыл xVal := oBrw:GetValue(nCol) oBrw:SetValue(nCol, xVal)
SergKis: PS В качестве nCol (номера колонки) могут быть и имена колонок, т.е. xVal := oBrw:GetValue("FDATE") oBrw:SetValue("FDATE", xVal)
Andrey: Фонты не работаю в SetArrayTo() Нашёл по хелпу типов таблицы: [ CELL | CELLED | GRID ] - а разница в чём между ними... Как тогда для SetArrayTo() использовать фонты чтобы всегда работало ? Фонты использую так:[pre2] cTbrName := "oBrwTxt" DEFINE TBROWSE &cTbrName ; AT nY, nX ; WIDTH nW ; HEIGHT nH ; GRID ; // это oBrw:lCellBrw := TRUE EDIT // все колонки с lEdit := .T. END TBROWSE // cell, head, foot aFont := { GetFontHandle("Italic"), GetFontHandle("Bold"), GetFontHandle("Norm") } // создаём таблицу из массива oBrw := SetArrayTo( cTbrName, "test", aArray, aFont, aHead,; aSize, aFoot, aPict, aAlign, aName )[/pre2] Можно на лету изменять типы таблицы ?
SergKis: Andrey Может повнимательнее посмотришь на исп. SetArrayTo() с фонтами Tsb_array_2\demo.prg[pre2] // hFontHead := aFont[1] // normal Header // hFontFoot := aFont[2] // bold Footer // aFontHF := { hFontHead, hFontFoot } // aFontHF := aFont[1] // normal Header, Footer aFontHF := aFont[2] // bold Header, Footer oBrw := SetArrayTo( "oBrw", "test", aArray, aFontHF, aHead, aSize, aFoot, aPict, aAlign, aName ) [/pre2] в aFontHF мах 2а элемента, если задан не массивом, то это один handle font для Header и Footer 1 handle font Header 2 habdle font Footer Для строк в DEFINE TBROWSE ... есть FONT cFontName SIZE nFontSize Если вместо имени хочешь исп. handle font, то это переносится после DEFINE TBROWSE ... в уст. свойства объекта oBrw:hFont := GetFontHandle(cFontName)
SergKis: PS Твой вариант должен выглядеть, к примеру так[pre2] DEFINE FONT Italic FONTNAME "DejaVu Sans Mono" SIZE 11 BOLD ITALIC DEFINE FONT Norm FONTNAME _HMG_DefaultFontName SIZE _HMG_DefaultFontSize DEFINE FONT Bold FONTNAME _HMG_DefaultFontName SIZE _HMG_DefaultFontSize BOLD ... aFont := { GetFontHandle("Bold"), GetFontHandle("Norm") } ... cTbrName := "oBrwTxt" DEFINE TBROWSE &cTbrName OBJ oBrw ; AT nY, nX ; WIDTH nW ; HEIGHT nH ; FONT "Italic" ; CELL /*GRID*/ ; // это oBrw:lCellBrw := TRUE EDIT // все колонки с lEdit := .T. mySetTsb(oBrw) :SetArrayTo( aArray, aFont, aHead, aSize, aFoot, aPict, aAlign, aName ) :AdjColumns() END TBROWSE ON END {|obr| obr:SetNoHoles(), obr:SetFocus() } ... [/pre2]
Andrey: SergKis пишет: Твой вариант должен выглядеть, к примеру так Спасибо ! Дошло наконец то до меня... Может в примере demo3.prg показать под комментариями:[pre2] /* 1 вариант написания aFont := { "Italic", "Bold", "Norm" } // cell, head, foot DEFINE TBROWSE oBrw ; AT nY, nX ALIAS aArray WIDTH nW HEIGHT nH CELL ; FONT aFont ; BRUSH { 255, 255, 240 } ; HEADERS aHead ; COLSIZES aSize ; PICTURE aPict ; JUSTIFY aAlign ; COLNAMES aName ; COLNUMBER { 1, 40 } ; COLUMNS aField ; FOOTERS aFoot ; FIXED ADJUST COLEMPTY ; ENUMERATOR ; EDIT GOTFOCUSSELECT mySetTsb( oBrw ) myColorTsb( oBrw ) END TBROWSE ON END {|ob| ob:SetNoHoles(), ob:SetFocus() } */ // 2 вариант написания aFont := { GetFontHandle("Bold"), GetFontHandle("Norm") } // head, foot cTbrName := "oBrwTxt" DEFINE TBROWSE &cTbrName OBJ oBrw ; AT nY, nX ; WIDTH nW ; HEIGHT nH ; FONT "Italic" ; // cell CELL /*GRID CELLED */ ; EDIT // все колонки с lEdit := .T. mySetTsb(oBrw) :SetArrayTo( aArray, aFont, aHead, aSize, aFoot, aPict, aAlign, aName ) :AdjColumns() END TBROWSE ON END {|obr| obr:SetNoHoles(), obr:SetFocus() } [/pre2] Попробовал компилировать пример demo3.prg с CELL /*GRID CELLED */ ; Не увидел разницы. На внешний вид таблицы одинаковые. Зачем такое разнообразие ?
Haz: Andrey пишет: А какая разница будет по времени по экспорту из DBF и SetArrayTo() ? Всё равно данные уже в бровсе. Не хотел отвечать, но надо для всех. Что значит данные в бровсе? Если это бровс по массиву, то да, массив передаётся в бровс. Если по базе, то рабочая область передаётся в бровс. Следует изучить наконеец исходники бровса, чтобы понять - бровс только рисует на экране окно данных и все. И сам бровс через свои методы может читать только текущую запись или строку массива, при этом выполняя очень много технических операций ( прорисовка, скрытые столбцы, блоки выборки данных и пр.) Если говорить о том., что данные получаем средствами бровса, то это значит что тратиться время на все эти операции и это в разы дольше прямой выборки из источника. Всё примеры типа tsb_export показавают только возможность работы с источником данных методами бровса, но ценой производительности. Разница в скорости между массивом и дбф в разнице доступа к элементу массива и полю базы, дальше математика, сколько запросов во столько раз умножение. И на закуску, SetArrayTo это всего лишь метод, позволяющий удобно инициализировать бровс по МАССИВУ. Это как что быстрее работает с дбф МиниГуи или харбур? Андрей, Вами проделана огромная работа по подготовке примеров новичкам, но такие речевые обороты сносят мозг тем же новичкам напрочь. Будьте внимательнее, хотя-бы на правах ветерана этого форума
Andrey: Спасибо за пояснения. Я это и хотел услышать и для других тоже !
Andrey: видишь суслика нет и я не вижу а он есть Использую последнюю версию МиниГуи 20.04 Сделал отдельный модуль .prg - работает отлично. Таблица просто загляденье, столбики цветом подсвечены, шапка и подвал есть. Добавляю его к себе в большой проект, просто его копирую в папку проекта и добавляю его в МуПроект.hbp После сборки тестирую эту менюшку. Таблица есть, шапка есть, а подвала НЕТ !!! Вместо него дырка и всё... Кто шаманский бубен продаст ?
Andrey: Andrey пишет: Таблица есть, шапка есть, а подвала НЕТ !!! Разобрался я с этой загадкой. Как сделать это научился, а как исправить нет ! По коду это происходит так: [pre2] .... aRet := myMenu(...) // отдельный prg, в нём 2 тсб, где указываю :nHeightFoot := 0 // высота подвала таблицы .... // работа с базой .... myTsb(...) // отдельный prg, в нём тсб, где указываю :nHeightFoot := 30 ...[/pre2] Вот так подвал в myTsb(...) не показывается. Если в myMenu(...) поставить :nHeightFoot := 10, то и в myTsb(...) будет 10 и больше не делается. Почему ?
Dima: Andrey пишет: Почему ? Объект тсб по разному хоть называется ?
SergKis: Andrey пишет:Почему ? Видимость переменной тсб Public ?
Andrey: Dima пишет: Объект тсб по разному хоть называется ? SergKis пишет: Видимость переменной тсб Public ? [pre2] Для myMenu(...) LOCAL oBrw1, oBrw2, cTbrName1, cTbrName2 ... ///////////////////// первая таблица //////////////////////////////// aDatos := CreateDatosAdres() aArray := aDatos[ 1 ] ..... cTbrName1 := "oBrwTxt1" DEFINE TBROWSE &cTbrName1 OBJ oBrw1 ; ... :SetArrayTo( aArray, aFontHF, aHead, aSize, aFoot, aPict, aAlign, aName ) :AddSuperHead(1, 2, "Выбор адреса" ) // суперхидер :aColumns[2]:lEdit := .F. // НЕ редактировать mySetTsb( oBrw1 ) TsbColor( oBrw1, , , , , ) ... ///////////////////// вторая таблица //////////////////////////////// aDatos := CreateMonthYears() aArray := aDatos[ 1 ] ..... cTbrName2 := "oBrwTxt2" DEFINE TBROWSE &cTbrName2 OBJ oBrw2 ; .... :SetArrayTo( aArray, aFontHF, aHead, aSize, aFoot, aPict, aAlign, aName ) :AddSuperHead(1, 3, "Выбор месяца/года" ) // суперхидер mySetTsb( oBrw2 ) TsbColor( oBrw2, , , , , ) .... Для myTsb(...) LOCAL oBrw, .... DEFINE TBROWSE oBrw ; ... mySetTsb( oBrw ) // настройки таблицы myColorTsb( oBrw ) // цвета на таблицу mySumTsb( oBrw ) // суммирование колонок таблицы myColorTsbElect( oBrw ) // цвета избранные [/pre2]
SergKis: Andrey Поставь значения в myMenu() oBrw1:lFooting := .F. и oBrw1:lDrawFooters := .F. oBrw2:lFooting := .F. и oBrw2:lDrawFooters := .F. в myTsb() oBrw:lFooting := .T. и oBrw:lDrawFooters := .T. oBrw:nHeightFoot := 30 Что получишь ?
Andrey: SergKis пишет: Что получишь ? Нет подвала ! Наверное нужно отдельный пример делать...
Andrey: Разобрался я с этой загадкой !!! Опять моя ошибка. [pre2] aRet := myMenu(...) // отдельный prg, в нём 2 тсб, где указываю :nHeightFoot := 0 // высота подвала таблицы myTsb(...) // отдельный prg, в нём тсб, где указываю :nHeightFoot := 30 [/pre2] В обоих отдельных prg есть одинаковая функция. [pre2]FUNCTION mySetTsb() .......[/pre2] Забыл сделать в обоих случаях STATIC FUNCTION mySetTsb() А при сборке проекта линковщик-зараза, ошибку не выдавал ! Сейчас заработало !
SergKis: Andrey пишет В обоих отдельных prg есть одинаковая функция. FUNCTION mySetTsb() Эта функция + myColorTsb() были специально оставлены FUNCTION, чтобы применять во всех тсб. mySetTsb() - задание общих переменных для всех тсб myColorTsb() - задание общих цветов тсб, что бы выглядели одинаково на всех окнах Все частные установки для тсб конкретного окна, делаешь в STATIC FUNCTION своего prg файла К примеру mySet_Tsb() - задание значений переменных для конкретного тсб myColor_Tsb() - задание значений цветов для конкретного тсб
Andrey: А зачем в demo7.prg в конце функций my0(oBrw) и my1(oBrw) ставится вот этот код: [pre2] :lDrawLine := .T. :Reset() AEval( :aColumns ,{|oc| oc:oCell := NIL, ; oc:oCellHead := NIL, ; oc:oCellEnum := NIL, ; oc:oCellFoot := NIL } )[/pre2]
SergKis: Andrey пишет А зачем в demo7.prg в конце функций my0(oBrw) и my1(oBrw) ставится вот этот код: Эти переменные, после :DarawLine(, .F.), :DrawHeader(, .F.), DrawFooters(, .F.) хранят данные, которые можно убрать, что и делается в AEval(), т.к. с тсб можно работать еще долго. Если этого не делать, ничего страшного, повисят до окончания работы этого тсб.
Andrey: Всем привет ! Нашёл тут большую непонятку в примере. Если кол-во колонок равно 45 и стрелками вправо-влево до конца и начала таблицы, то всё, таблица ломается и пример вешается. Если сделать 44 или 46 колонок, то всё нормально. Почему так ? Цифру 45 нашёл в mySet2Tsb(), может из-за этого ?
SergKis: Andrey пишет Почему так ? Ты пропустил, почитай http://clipper.borda.ru/?1-1-0-00000559-000-60-0 Пост 1 Отправлено: 29.11.19 10:25 и далее ChangeLog.txt 2019/12/12: HMG Extended Edition version 19.12. ... * Updated: Adaptation FiveWin Class TSBrowse 9.0 in HMG: - added the new variable :lMoreFields in the TSBrowse class; - added the new method MoreFields( nMsg, nWParam ). ... Надо подбирать кол-во полей или переменную DATA nMaxKeysLR AS NUMERIC INIT 3 Значение для MySet2Tsb() взял (see demo in folder \Utils\mgDBU) У меня с такими значениями работает норм.
Andrey: SergKis пишет: Ты пропустил, почитай А как тогда сделать этот пример чтобы всегда работал ? Сломал на 34 колонках... Проект положил к тебе.
SergKis: Andrey пишет Уменьшил 45 на 30 и у меня работает, т.е. :lMoreFields := ( :nColCount() > 30 )
Andrey: SergKis пишет: Уменьшил 45 на 30 и у меня работает, т.е. Да, так заработало ! Спасибо !
Andrey: Если делать цвета через контейнер: [pre2] FUNCTION mySetTsb( oBrw ) WITH OBJECT oBrw :Cargo := oKeyData() // создает объект без переменных (условно пустой) используем ниже по коду ..... FUNCTION myColorTsb( oBrw ) LOCAL O WITH OBJECT oBrw:Cargo :nText := GetSysColor( COLOR_WINDOWTEXT ) :nPane := GetSysColor( COLOR_WINDOW ) ....[/pre2] то начинает ломаться экспорт в эксель. Выдаёт такую ошибку: [pre2]Error BASE/1004 Метод не экспортирован: CARGO Args: [1] = N 10 --------------------------------- Stack Trace --------------------------------- Called from CARGO(0) Called from MYTSBCOLORBACKFOOT(552) in module: demo7.prg Called from (b)MYCOLORTSBELECT(278) in module: demo7.prg Called from MYCOLORN(785) in module: Tsb5xlsOle1.prg Called from EXCELOLE4EXTERN(706) in module: Tsb5xlsOle1.prg Called from (b)TOEXCEL5(86) in module: Excel5.prg Called from BRW4XLSOLE(357) in module: Tsb5xlsOle1.prg [/pre2] И как теперь быть ?
SergKis: Andrey пишет Да, так заработало ! Если бы ты вставил команду[pre2] :lNoHScroll := .F. // добавить\вкл. ползунок горизонтальный ? procname(), :nColCount() ? :lMoreFields := ( :nColCount() > 45 ) [/pre2] то по результату все увидел бы сам MYSET2TSB 44
SergKis: Andrey пишет И как теперь быть ? Переделать на oCol:oСell ( :DrawLine(, .F.) ), все брать оттуда и :hFont, цвета, :cValue, :uValue, valtype(:uValue) Там все готовые данные к выводу, бери нужные, формат excel от них ...
Andrey: SergKis пишет: Переделать на Понял...
Andrey: Всем доброго утра ! Возникли вопросы по tsbrowse 1) Почему при создании тсб нельзя сразу задать все фонты ? вот так: [pre2] aFont := { "TsbCellNorm", "TsbHeadBold", "TsbFootBold", "TsbSpHd" } DEFINE TBROWSE oBrw ; AT nY, nX ALIAS aArray WIDTH nWTsb HEIGHT nHTsb CELL ; FONT aFont ; .....[/pre2] Сейчас 3 фонта работают. Добавить 4 фонт возможно ? 2) Сейчас в тсб можно добавить первую виртуальную колонку для tsbrowse-Dbf и tsbrowse-Array А можно ещё сделать добавление своих доп.колонок ? Для tsbrowse-Array понятно, что делать этого не нужно. А вот для tsbrowse-Dbf иногда нужно, допустим когда нельзя править структуры базы. Можно создавать свое поле в базе, но иногда этого делать нельзя, допустим при работе с чужой базой. Если это сложно сделать, то вопрос можно пропустить.
SergKis: Andrey пишет А можно ещё сделать добавление своих доп.колонок ? Сколько угодно [pre2] LOCAL oCol DEFINE COLUMN oCol ... ... oBrw:InsColumn( nPos, oCol ) // nPos номер перед которой вставить ... Для dbf в списке полей одно имя поля повторяешь 2 раза (можешь 3 и ...), потом для колонки по номеру меняешь oCol:bData или oCol:bValue и даешь новое имя oCol:cName := "...". можно поправить oCol:cField и т.д. если надо Сейчас 3 фонта работают. Добавить 4 фонт возможно ? Куда ? Есть oBrw:hFont, oBrw:hFontHead, oBrw:hFontFoot. Для колонок, SuperHead, SpecHd есть переменные в своих местах [/pre2]
SergKis: PS Если ты говоришь о заполнении, выделенное цветом DATA hFontEdit AS NUMERIC // edition font DATA hFontHead AS NUMERIC // header font DATA hFontFoot AS NUMERIC // footer font DATA hFontSpcHd AS NUMERIC // special header font то надо добавлять в массив в каком то порядке и присваивать в _DefineTBrowse ()
Andrey: SergKis пишет: то надо добавлять в массив в каком то порядке и присваивать в _DefineTBrowse () Ну да, я про это. При создании ТСБ задать сразу все фонты 4 штуки, таблица же из 4 секций состоит. Для основных задач будет простое и понятное заполнение. Ну а потом, кто хочет делает фонты какие сам захочет.
SergKis: Andrey пишет При создании ТСБ задать сразу все фонты 4 штуки, таблица же из 4 секций состоит. Для этого поправить немного надо[pre2] FUNCTION _DefineTBrowse( ControlName, ParentFormName, nCol, nRow, nWidth, nHeight, ; ... IF ! Empty( FontName ) .and. HB_ISARRAY( FontName ) AEval( FontName, { |cf| AAdd( aFonts, cf ) } ) aFont := ASize( aFonts, 4 ) FontName := aFont[1] ... oBrw := TSBrowse():New( ControlName, nRow, nCol, nWidth, nHeight, ; bFields, aHeaders, aWidths, ParentFormName, ; change, bDblClick, bRClick, fontname, fontsize, ; hCursor, aTmpColor, aBmp, cMsg, update, uAlias, uWhen, value, cell, ; nStyle, bLClick, aFlds, aHeadClick, nLineStyle, lRePaint, ; Delete, aJust, lock, appendable, lEnum, ; lAutoSearch, uUserSearch, lAutoFilter, uUserFilter, aPicture, ; lTransparent, uSelector, lEditable, lAutoCol, aColSel, tooltip ) IF HB_ISARRAY( aFont ) .and. Len(aFont) > 3 .and. HB_ISCHAR(aFont[ 4 ]) oBrw:hFontSpcHd := GetFontHandle(aFont[ 4 ]) ENDIF ... [/pre2] Проверил, работает
Andrey: SergKis пишет: Ты, наверно, путаешь SpecHeader (ENUMERATOR) и SuperHeader - это две разницы Да, я наверное путаю. Имеется таблица, в ней 4 части: ячейки, подвал, шапка и та часть над шапкой. Я её называю суперхидером. Или я неправ ? Вот для неё и нужно сразу задавать фонт. Хотя идея автора наверное была что суперхидер имеет одинаковый шрифт как у шапки таблицы. Но это для юзера не наглядно ! Заголовок таблицы нужно делать крупней для юзера, чтобы в глаза бросалась. Из-за этого и возник вопрос.
Andrey: SergKis пишет: Проверил, работает Да я тоже проверил. Так лучше ! Но тогда напрашивается вопрос размещения 5 фонта. [pre2] aFont := { "TsbNorm", "TsbBold", "TsbBold", "TsbSpecH", "TsbSuperH" } [/pre2] Можно ли это реализовать ?
SergKis: Andrey пишет Я её называю суперхидером. Это специальный заголовок, для нумерации колонок SuperHeader это над Header, объединяет колонки. Используй для фонта для него команду #command ADD [ SUPER ] HEADER TO <oBrw> ; ... [ FONT <uFont> ] ; ... или метод с параметрами :AddSuperHead( nFromCol, nToCol, uHead, nHeight, aColors, l3dLook, uFont, uBitMap, lAdjust, lTransp, ...)
Andrey: SergKis пишет: SuperHeader это над Header, объединяет колонки. Ну да, я так и пишу - "шапка и та часть над шапкой." SergKis пишет: или метод с параметрами или после :AddSuperHead(...) :hFontSupHdSet( nCol, hFontSuper ) А как можно отдельно задать фонт для суперхидера, сразу. Пробовал так: :hFontSupHdSet := GetFontHandle("CardSuperH") // 5-доп.фонт Прога вылетает с ошибкой:[pre2] Error BASE/1005 Message not found: TSBROWSE:_HFONTSUPHDSET Args: [1] = O TSBROWSE --------------------------------- Stack Trace --------------------------------- Called from __ERRRT_SBASE(0) Called from TSBROWSE:ERROR(0) Called from (b)HBOBJECT(0) Called from TSBROWSE:MSGNOTFOUND(0) Called from TSBROWSE:_HFONTSUPHDSET(0) Called from MYSUPERHEADER(595) in module: cardcomp.prg Called from MAIN(159) in module: cardcomp.prg [/pre2] Там 2 параметра в METHOD hFontSupHdSet( nCol, uFont ) А как правильно задать мне в :hFontSupHdSet := ???????
SergKis: Andrey пишет А как можно отдельно задать фонт для суперхидера, сразу. Пробовал так: :hFontSupHdSet := GetFontHandle("CardSuperH") // 5-доп.фонт Прога вылетает с ошибкой: У тебя богатая фантазия Делай так как написал выше, команда и метод
Andrey: SergKis пишет: У тебя богатая фантазия Да не фантазия, а простая невнимательность. Слишком тороплюсь сделать. Понял в чём дело, нужно так: [pre2] :hFontSupHdSet( , GetFontHandle("TsbSuperH") ) // 5-доп.фонт [/pre2] Спасибо !
SergKis: Andrey Это будет на 1-ю колонку, а остальные ... + высота у фонта будет другая, т.е. этого мало. Лучше команда или метод AddSuperHeader(), в них "букав больше"
Andrey: SergKis пишет: Лучше команда или метод AddSuperHeader(), в них "букав больше" Тогда так примерно ? [pre2] // суперхидер //:AddSuperHead( nFromCol, nToCol, uHead, nHeight, aColors, l3dLook, uFont, uBitMap, lAdjust, lTransp, ...) :AddSuperHead( 1 , :nColCount() , aSupHd[1], , , , GetFontHandle("TsbSuperH") ) [/pre2]
SergKis: Andrey пишет Понял в чём дело, нужно так: :hFontSupHdSet( , GetFontHandle("TsbSuperH") ) // 5-доп.фонт 5-ый фонт и 6-ой можно сделать тоже, в целом, наверно, удобно будет[pre2] FUNCTION _DefineTBrowse( ControlName, ParentFormName, nCol, nRow, nWidth, nHeight, ; ... IF ! Empty( FontName ) .and. HB_ISARRAY( FontName ) AEval( FontName, { |cf| AAdd( aFonts, cf ) } ) aFont := ASize( aFonts, 6 ) FontName := aFont[1] ... oBrw := TSBrowse():New( ControlName, nRow, nCol, nWidth, nHeight, ; bFields, aHeaders, aWidths, ParentFormName, ; change, bDblClick, bRClick, fontname, fontsize, ; hCursor, aTmpColor, aBmp, cMsg, update, uAlias, uWhen, value, cell, ; nStyle, bLClick, aFlds, aHeadClick, nLineStyle, lRePaint, ; Delete, aJust, lock, appendable, lEnum, ; lAutoSearch, uUserSearch, lAutoFilter, uUserFilter, aPicture, ; lTransparent, uSelector, lEditable, lAutoCol, aColSel, tooltip ) IF HB_ISARRAY( aFont ) .and. Len(aFont) > 3 IF HB_ISCHAR(aFont[ 4 ]) oBrw:hFontSpcHd := GetFontHandle(aFont[ 4 ]) ENDIF IF HB_ISCHAR(aFont[ 5 ]) oBrw:hFontSupHd := GetFontHandle(aFont[ 5 ]) ENDIF IF HB_ISCHAR(aFont[ 6 ]) oBrw:hFontEdit := GetFontHandle(aFont[ 6 ]) ENDIF ENDIF ... CLASS TSBrowse FROM TControl ... DATA hFontSpcHd AS NUMERIC // special header font DATA hFontSupHd // super header font ... Method AddSuperHead( nFromCol, nToCol, uHead, nHeight, aColors, l3dLook, uFont, uBitMap, lAdjust, lTransp, ; ... Default lAdjust := .F., ; ... uHead := "", ; uFont := ::hFontSupHd ... [/pre2]
Andrey: SergKis пишет: 5-ый фонт и 6-ой можно сделать тоже, в целом, наверно, удобно будет Да удобней и логичней ! И проще программировать, один раз задать и не делать потом различных манипуляций ! Везде параметры задал и всё, а с фонтами фокусами нужно заниматься...
Andrey: Григорий, а можно описать порядок загрузки фонтов по новому в ChangeLog.txt ? А то сейчас помню, а потом забуду. А так будет напоминалка для всех !
Dima: Andrey пишет: А то сейчас помню, а потом забуду. Ты по любому забудешь
krutoff: Не могу побороть в TBrowse один неприятный момент: Если установлен SET AUTOADJUST ON -> изменяю (увеличиваю Height) размеры окна -> затем при редактировании ячейка улетает вверх! Я хочу програмно увеличить окно в зависимости от разрешения монитора - и тут такой казус ): Протестировал от h_tbrowse.prg - > TGetBox.prg -> h_getbox.prg -> координаты передает правильные. Пример: miniGui\SAMPLES\Advanced\Tsb_BitMaps\demo.prg - сделал поле "Name" редактируемым и вот результат:
Haz: Andrey пишет: Григорий, а можно описать порядок загрузки фонтов по новому в ChangeLog.txt ? А то сейчас помню, а потом забуду. А так будет напоминалка для всех ! можно, начинай пока не забыл.
Andrey: Подскажите как можно самому ПРАВИЛЬНО рассчитать высоту ТСБ. Что-то не учитываю в расчётах. Задаю фонты для таблицы: [pre2] DEFINE FONT TsbNorm FONTNAME "DejaVu Sans Mono" SIZE 12 DEFINE FONT TsbBold FONTNAME "Tahona" SIZE 12 BOLD DEFINE FONT TsbSuperH FONTNAME "Comic Sans MS" SIZE 18 BOLD aTsbFont := { "TsbNorm", "TsbBold", "TsbBold", "TsbSpecH", "TsbSuperH", "TsbEdit" } DEFINE TBROWSE oBrw ; ............ FONT aTsbFont ;[/pre2] Высота одной строки таблицы: [pre2] nHCell := GetTextHeight( 0, "B", GetFontHandle( "Norm" ) ) + 10 [/pre2]Кол-во строк в таблице nTsbMaxRow = 8 Добавляем высоту суперхидера + шапки + подвала: [pre2] nHFSupHd := GetTextHeight( 0, "B", GetFontHandle( "TsbSuperH" ) ) nHFHead := GetTextHeight( 0, "B", GetFontHandle( "TsbBold" ) ) nHFFoot := 0 nTsbHeight := nHCell * nTsbMaxRow + nHFSupHd + nHFHead + nHFFoot nHFntSupHd = 35 nHFntHead = 19 nTsbHeight = 303 [/pre2] При создании ТСБ прописываю любые параметры, кроме высоты ячейки, всё равно они игнорируются кроме 0: [pre2] :nHeightSuper := 16 // можно задать, если не определен фонт при построении :nHeightHead := 20 // можно задать, если не определен фонт при построении :nHeightFoot := 0 // можно задать, если не определен фонт при построении :nHeightCell := nHCell // высота ячейки берется ТОЛЬКО отсюда // :nHeightCell := 0 - прога повисает и всё, нет проверки на 0[/pre2] Вывод отладки из таблицы на форме: [pre2] 1) :nHeight = 303 2) :nHeightSuper = 49 3) :nHeightHead = 32 4) :nHeightFoot = 0 5) :nHeightSpecHd = 0 6) :nHeightCell = 29 7) GetHScrollBarHeight() = 17 8) :nRowCount() Кол-во строк = 7 [/pre2] Т.е. на форме всего 7 строк таблицы из заданных 8 !!! Почему ? Что не учитываю ? Почему меняется автоматом высота HeightSuper и HeightHead ? Исходник h_tbrowse.prg смотрел, нифига не понял, как они считаются. Как вручную можно рассчитать :nHeightSuper ? Если отключить метод убирания дырки внизу ТСБ [pre2] END TBROWSE // ON END {|ob| ob:SetNoHoles() }[/pre2] то тогда :nHeightHead получается правильно заданным, но суперхидер всё равно сам по себе считается. Ради интереса задал [pre2] :nHeightSuper := 0 :nHeightHead := 0 :nHeightFoot := 0 [/pre2] Шапки нет, а суперхидер всё равно показывается в ТСБ. Почему ?
Andrey: Пытаюсь сделать курсор с окантовкой черного цвета. Не получается... Как этот цвет задать ? [pre2] :nHRED := CLR_HRED :n_HRED := -CLR_HRED :n_HBLUE := -RGB(128,225,225) :nHBLUE := RGB(128,225,225) :nBLACK := CLR_BLACK :n_BLACK := -CLR_BLACK[/pre2] -0 же не бывает
Andrey: Блин, не сообразил сразу... Сделал вот так -RGB(1,1,1)
Andrey: А как править ключевое поле по индексу в ТСБ ? Сделал вот такой код: [pre2] nI := :nColumn( 'NN' ) :aColumns[nI]:lEdit := .T. :aColumns[nI]:nEditMove := 0 oCol := :GetColumn('NN') // обработка до ввода oCol:bPrevEdit := { |lR,ob| nRecno := (ob:cAlias)->( RecNo() ) ,; lR := (ob:cAlias)->( RLock() ) ,; iif( lR, nil , MsgInfo("Запись заблокирована!") ) ,; lR } // обработка после ввода oCol:bPostEdit := { |uv,ob| uv := (ob:cAlias)->( dbUnLock() ) ,; ob:Reset() , ob:Refresh(.T.) ,; ob:GoToRec( nRecno ), ob:Setfocus() }[/pre2] В таблице 24 записей, помещается 20. Беру 3-ю запись с NN=3 меняю на 15. В ТСБ остаётся только одна запись 15 - остальных нет ... Стрелкой вверх/вниз и другие записи появляются. Меняем NN=15 обратно на 3. В таблице опять только одна запись - 3. Как сделать правильно ?
Andrey: Заработало ! Вот так надо: [pre2] DEFINE TBROWSE oBrw ; .... LOADFIELDS LOCK // блокировка записей в автомате ..... oCol := :GetColumn('NN') // обработка до ввода oCol:bPrevEdit := { |lR,ob| lR := (ob:cAlias)->( RLock() ), ; nRecno := (ob:cAlias)->( RecNo() ) , lR } // обработка после ввода oCol:bPostEdit := { |xv,ob| xv := nil, ob:Refresh(.T.) , ob:GoToRec( nRecno ), ; ob:Upstable() , ob:Setfocus() }[/pre2]
SergKis: Andrey пишет Заработало ! Вот так надо: Взял пример Tsb_Basic\demo2.prg, поменял структуру dbf, сделал tag на поле F2 назвав NN[pre2] FUNCTION UseOpenBase() ... IF ( lDbfNo := ! File( cDbf+'.dbf' ) ) AAdd( aStr, { 'F1', 'D', 8, 0 } ) AAdd( aStr, { 'F2', 'C', 10, 0 } ) AAdd( aStr, { 'F3', 'N', 10, 2 } ) AAdd( aStr, { 'F4', 'L', 1, 0 } ) dbCreate( cDbf, aStr ) ENDIF IF lDbfNo .OR. !File( cIndx+'.cdx' ) USE ( cDbf ) ALIAS TEST EXCLUSIVE NEW WHILE TEST->( RecCount() ) < 30 TEST->( dbAppend() ) TEST->F1 := Date() + n++ TEST->F2 := StrZero( n, 2 ) TEST->F3 := n TEST->F4 := ( n % 2 ) == 0 END GO TOP INDEX ON F2 TAG NN FOR !Deleted() INDEX ON RECNO() TAG NN2 FOR !Deleted() INDEX ON RECNO() TAG DEL FOR Deleted() USE ENDIF ... [/pre2] Добавил LOCK в[pre2] DEFINE TBROWSE oBrw AT 5 + Form_0.Button_Ins.Height + 5, 5 ; ... GRID LOCK ; ... [/pre2] Режимы Insert и Edit работают и отображают тсб нормально без добавок, т.е. аналог твоего примера на изменение ключа работает.
SergKis: PS работает и без добавки LOCK и USE ( cDbf ) ALIAS TEST SHARED NEW
Andrey: SergKis пишет: Режимы Insert и Edit работают и отображают тсб нормально без добавок, т.е. аналог твоего примера на изменение ключа работает. У меня в задаче 2 индекса по базе: [pre2] cFldKey := "NN" cFilter1 := "PART==1 .AND. !Deleted()" cFilter2 := "PART==2 .AND. !Deleted()" INDEX ON &cFldKey TAG PART1 TO (cFileIndx) FOR &cFilter1 INDEX ON &cFldKey TAG PART2 TO (cFileIndx) FOR &cFilter2[/pre2] Может из-за этого ?
SergKis: Andrey пишет Может из-за этого ? Поправил, по мне, так правильнее работать, ставить SET SCOPE TO ... [pre2] IF ( lDbfNo := ! File( cDbf+'.dbf' ) ) AAdd( aStr, { 'F0', 'N', 1, 0 } ) AAdd( aStr, { 'F1', 'D', 8, 0 } ) AAdd( aStr, { 'F2', 'C', 10, 0 } ) AAdd( aStr, { 'F3', 'N', 10, 2 } ) AAdd( aStr, { 'F4', 'L', 1, 0 } ) dbCreate( cDbf, aStr ) ENDIF IF lDbfNo .OR. !File( cIndx+'.cdx' ) USE ( cDbf ) ALIAS TEST EXCLUSIVE NEW WHILE TEST->( RecCount() ) < 30 TEST->( dbAppend() ) TEST->F0 := (n % 2) + 1 TEST->F1 := Date() + n++ TEST->F2 := StrZero( n, 2 ) TEST->F3 := n TEST->F4 := ( n % 2 ) == 0 END GO TOP INDEX ON STR(F0)+F2 TAG NN FOR !Deleted() INDEX ON RECNO() TAG NN2 FOR !Deleted() INDEX ON RECNO() TAG DEL FOR Deleted() USE ENDIF SET AUTOPEN ON USE ( cDbf ) ALIAS TEST SHARED NEW OrdSetFocus('NN') SET SCOPE TO "1","1" GO TOP [/pre2] Работает
Andrey: Всем привет ! Можно ли при открытие базы в ТСБ (метод dbf) создать 6 своих виртуальных колонок перед колонками dbf ? Одну колонку можно же делать через COLNUMBER { 1, 50 } , а ещё 6 нужно. И как им присвоить имена и размеры ? a1ColTitle := {"(1)","(2)","(3)","(4)","(5)","(6)","#"} a1Name := {"CF1","CF2","CF3","CF4","CF5","CF6","ORDKEYNO"} a1Type := {"N","N","N","N","N","N","N"} a1Size := {50,50,50,50,50,50,50}
SergKis: Andrey пишет Можно ли при открытие базы в ТСБ (метод dbf) создать 6 своих виртуальных колонок перед колонками dbf ? Вариантов много. Вот один из них[pre2] BEGIN SEQUENCE WITH { |e|break(e) } DbUseArea( .F., cRdd, cFile, cAls, lShared, , cCdp ) lUse := ! NetErr() .and. Used() nMsg := 0 END SEQUENCE IF lUse k := 6 aField := Array(FCount()+k) aField[1] := FieldName(1) aField[2] := FieldName(1) aField[3] := FieldName(1) aField[4] := FieldName(1) aField[5] := FieldName(1) aField[6] := FieldName(1) FOR i := 1 TO FCount() ; aField[ k+i ] := FieldName(i) NEXT ENDIF ... DEFINE TBROWSE oBrw AT y,x WIDTH w HEIGHT h CELL ; ALIAS ALIAS() ; FONT (App.Object):Cargo:aFonts ; BRUSH { 255, 255, 230 } ; COLORS aClr ; ON GOTFOCUS oCar:FocusedControl := "oBrw" ; COLUMNS aField ; FOOTER .T. ; FIXED COLSEMPTY ; LOADFIELDS GOTFOCUSSELECT ; COLNUMBER { k+1, 60 } ; ENUMERATOR LOCK ... FOR i := 1 TO :aColumns o := :aColumns[ i [ IF o:cName == "ORDKEYNO" ; EXIT ENDIF o:cAlias := :cAlias o:bData := {|| Nil } o:bValue := {|u,obr,ncol,ocol| Local nrec := (obr)->( RecNo() ) u := ocol[ncol]:Cargo[nrec] // вирт. значение Return u } o:cField := "" switch i case 1 o:Cargo := aVirtual1 // массив виртуальных данных o:cName := VIRT1 o:cFieldTyp := "C" o:nFieldLen := 20 o:nFieldDec := 0 o:nWidth := o:ToWidth(o:nFieldLen, 0.8) exit case 2 o:Cargo := aVirtual2 // массив виртуальных данных o:cName := VIRT2 o:cFieldTyp := "N" o:nFieldLen := 7 o:nFieldDec := 0 o:nWidth := o:ToWidth(o:nFieldLen) exit case 3 ... exit case 4 ... exit case 5 ... exit case 6 ... exit end switch NEXT ... [/pre2]
SergKis: PS Еще сбросить или поставить Picture для колонки o:cPicture := Nil
SergKis: SergKis пишет Вот один из них Работающий вариант с 6-ю вирт. колонками [pre2] FUNCTION GetVirtAll() // создали массивы со значениями для вирт. колонок Local aDim1 := {}, aDim2 := {}, aDim3 := {}, aDim4 := {}, aDim5 := {}, aDim6 := {} Local nOld := RecNo(), cAls := ALIAS(), nRec GO TOP DO WHILE !EOF() nRec := RecNo() AAdd(aDim1, nRec + 10) AAdd(aDim2, nRec + 20) AAdd(aDim3, nRec + 30) AAdd(aDim4, nRec + 40) AAdd(aDim5, nRec + 50) AAdd(aDim6, nRec + 60) SKIP ENDDO GOTO nOld RETURN { aDim1, aDim2, aDim3, aDim4, aDim5, aDim6 } ... SELECT 0 cAls := "_A_"+hb_ntos(Select())+"_" BEGIN SEQUENCE WITH { |e|break(e) } DbUseArea( .F., cRdd, cFile, cAls, lShared, , cCdp ) lUse := ! NetErr() .and. Used() nMsg := 0 END SEQUENCE IF lUse aField := Array(FCount()+6) aField[1] := FieldName(1) aField[2] := FieldName(1) aField[3] := FieldName(1) aField[4] := FieldName(1) aField[5] := FieldName(1) aField[6] := FieldName(1) FOR i := 1 TO FCount() ; aField[ k+i ] := FieldName(i) NEXT ENDIF ... IF lUse This.Cargo:aVirtualAll := GetVirtAll() AAdd(aClr, { 6, {|c,n,b| c := n, iif( b:nCell == n, -CLR_BLUE, -RGB(128,225,225) ) } } ) AAdd(aClr, {12, {|c,n,b| c := n, iif( b:nCell == n, -CLR_BLUE, -RGB(128,225,225) ) } } ) x := 2 i := 1 y := GetWindowHeight(hSpl) + i h := This.ClientHeight - y - i * 2 - 1 w := This.ClientWidth - x * 2 This.Cargo:nSplitHeight := y DEFINE TBROWSE oBrw AT y,x WIDTH w HEIGHT h CELL ; ALIAS ALIAS() ; FONT (App.Object):Cargo:aFonts ; BRUSH { 255, 255, 230 } ; COLORS aClr ; ON GOTFOCUS oCar:FocusedControl := "oBrw" ; COLUMNS aField ; FOOTER .T. ; FIXED COLSEMPTY ; LOADFIELDS GOTFOCUSSELECT ; COLNUMBER { 6+1, 60 } ; ENUMERATOR LOCK :Cargo := oKeyData() :nColOrder := 0 :lNoChangeOrd := .T. :nWheelLines := 1 :lNoGrayBar := .F. :lNoLiteBar := .F. :lNoResetPos := .F. :lNoPopUp := .T. :lNoHScroll := .T. :nCellMarginLR := 1 :nStatusItem := 0 :lNoKeyChar := .T. // method :KeyChar disabled :lCheckBoxAllReturn := .T. // Enter modify value oCol:lCheckBox :lPickerMode := .F. // формат даты нормальный :nHeightCell := (App.Object):H1 + 3 :nHeightHead := :nHeightCell :nHeightFoot := :nHeightCell :SetDeleteMode( .T., .F., {|rec,obr| DelRecords(rec, obr) }, ; {|obr| obr:Cargo:nRecnoDraw := 0, obr:DrawSelect() } ) FOR i := 1 TO Len(:aColumns) o := :aColumns[ i ] IF o:cName == "ORDKEYNO"; EXIT ENDIF o:cAlias := :cAlias o:Cargo := This.Cargo:aVirtualAll[ i ] // массив виртуальных данных o:cName := 'VIRT'+hb_ntos(i) o:cHeading := "("+hb_ntos(i)+")" o:cFooting := "" o:cPicture := Nil o:bData := {|| Nil } o:bValue := {|u,obr,ncol,ocol| Local nrec := (obr:cAlias)->( RecNo() ) u := ocol:Cargo[nrec] // вирт. значение Return u } o:nAlign := DT_CENTER o:nFAlign := DT_CENTER o:cField := "" o:cFieldTyp := "N" o:nFieldLen := 5 o:nWidth := o:ToWidth(o:nFieldLen) NEXT ... [/pre2]
Avf: При вызове CONTEXT MENU для TsBrowse , CONTEXT MENU в другом окне не работает. Хотя для других контролов все нормально. Так в примере ниже: CONTEXT MENU OF Form2 появляется после ITEM "Item 1 from TBROWSE" ACTION Window2(), а после ITEM "Item 1 from BUTON" ACTION Window2() - нет. [pre2] #include "minigui.ch" #include "TSBrowse.ch" #translate dbcreate(<file>, <struct>) => hb_dbcreatetemp(<file>, <struct>) PROCEDURE main LOCAL i, br_zaw dbCreate( 'test', { { 'c1', 'C', 30, 0 }, ; { 'n1', 'N', 12, 2 } } ) IF SELECT( 'test' ) == 0 dbUseArea( .T.,, 'test' ) ENDIF FOR i := 1 TO 100 test->( dbAppend() ) test->c1 := Str( i ) test->n1 := test->( RecNo() ) NEXT test->( dbGoTop() ) DEFINE WINDOW Form1 ; AT 0,0 ; WIDTH 640 ; HEIGHT 480 ; TITLE "HMG Example of Context Menu" ; MAIN ; FONT 'Tahoma' SIZE 9 DEFINE TBROWSE oBrw AT 15, 10 OF Form1 ALIAS "test" WIDTH 450 HEIGHT 330 ADD COLUMN TO oBrw DATA {|| test->c1 } ALIGN DT_LEFT, DT_CENTER, DT_CENTER TITLE 'C!' SIZE 150 ADD COLUMN TO oBrw DATA {|| test->n1 } ALIGN DT_RIGHT, DT_CENTER, DT_CENTER TITLE 'N1' SIZE 100 END TBROWSE DEFINE BUTTON B ROW 350 COL 10 CAPTION 'Set BUTTON' ACTION ( MsgInfo("Button") ) END BUTTON DEFINE CONTEXT MENU CONTROL oBrw OF Form1 ITEM "Item 1 from TBROWSE" ACTION Window2() END MENU DEFINE CONTEXT MENU CONTROL B OF Form1 ITEM "Item 1 from BUTON" ACTION Window2() END MENU END WINDOW CENTER WINDOW Form1 ACTIVATE WINDOW Form1 Return Nil func Window2() DEFINE WINDOW Form2 ; AT 10,10 ; WIDTH 400 ; HEIGHT 400 ; TITLE "HMG Example of Context Menu in two windows" ; ICON "ACON_MAIN" ; MODAL ON KEY ESCAPE ACTION ThisWindow.Release DEFINE CONTEXT MENU OF Form2 ITEM "Item 2" ACTION MsgInfo("oK") END MENU END WINDOW CENTER WINDOW Form2 ACTIVATE WINDOW Form2 Return Nil [/pre2]
Andrey: Уважаемый Avf 1) Очень тяжело смотреть исходник без форматирования, я думаю что никто и не смотрел больше. 2) Пример собрался, а дальше что смотреть ? Мне не понятно. Может другие поняли.
Avf: Я очень извиняюсь, форматирование чего-то исчезло(был невнимателен) при копировании на форум. С контролов TsBrowse и Button вызывается контекстное меню. После выбора Item открывается новое окно. В новом окне тоже вызывается контекстное меню. В случае, если пришли через Button - все работает. Если через TsBrowse, меню не отображается. Еще раз, извиняюсь, у нас тут и так бошка на части разваливается(РБ).
Pasha: Движок форума съедает пробелы слева. Надо использовать стиль - моноширинный шрифт
Andrey: Мне сложно на это ответить. Я ещё не такой большой спец по МиниГуи.
Dima: Avf пишет: Я очень извиняюсь, форматирование чего-то исчезло(был невнимателен) при копировании на форум. я поправил , сейчас нормально
Avf: Спасибо, Дима.
SergKis: Avf Работает вариант [pre2] // Demo Context menu #include "minigui.ch" #include "TSBrowse.ch" #translate dbcreate(<file>, <struct>) => hb_dbcreatetemp(<file>, <struct>) PROCEDURE main LOCAL i, br_zaw SET OOP ON dbCreate( 'test', { { 'c1', 'C', 30, 0 }, ; { 'n1', 'N', 12, 2 } } ) IF SELECT( 'test' ) == 0 dbUseArea( .T.,, 'test' ) ENDIF FOR i := 1 TO 100 test->( dbAppend() ) test->c1 := Str( i ) test->n1 := test->( RecNo() ) NEXT test->( dbGoTop() ) DEFINE WINDOW Form1 ; AT 0,0 ; WIDTH 640 ; HEIGHT 480 ; TITLE "HMG Example of Context Menu" ; MAIN ; FONT 'Tahoma' SIZE 9 (This.Object):Event(1, {|| Window2() } ) DEFINE TBROWSE oBrw AT 15, 10 OF Form1 ALIAS "test" WIDTH 450 HEIGHT 330 ADD COLUMN TO oBrw DATA {|| test->c1 } ALIGN DT_LEFT, DT_CENTER, DT_CENTER TITLE 'C!' SIZE 150 ADD COLUMN TO oBrw DATA {|| test->n1 } ALIGN DT_RIGHT, DT_CENTER, DT_CENTER TITLE 'N1' SIZE 100 END TBROWSE DEFINE BUTTON B ROW 350 COL 10 CAPTION 'Set BUTTON' ACTION ( MsgInfo("Button") ) END BUTTON DEFINE CONTEXT MENU CONTROL oBrw OF Form1 ITEM "Item 1 from TBROWSE" ACTION _wPost(1) //Window2() END MENU DEFINE CONTEXT MENU CONTROL B OF Form1 ITEM "Item 1 from BUTON" ACTION _wPost(1) //Window2() END MENU END WINDOW CENTER WINDOW Form1 ACTIVATE WINDOW Form1 Return Nil func Window2() DEFINE WINDOW Form2 ; AT 10,10 ; WIDTH 400 ; HEIGHT 400 ; TITLE "HMG Example of Context Menu in two windows" ; ICON "ACON_MAIN" ; MODAL ON KEY ESCAPE ACTION ThisWindow.Release DEFINE CONTEXT MENU OF Form2 ITEM "Item 2" ACTION _wPost(1) //MsgInfo("oK") END MENU (This.Object):Event(1, {|| MsgInfo("OK!") } ) END WINDOW CENTER WINDOW Form2 ACTIVATE WINDOW Form2 Return Nil [/pre2]
Avf: Спасибо, Ceргей. Да, действительно, работая с eventами, можно обойти все недочеты в подобных ситуациях.
Andrey: SergKis пишет: Для Timestamp колонок это как в h_tbrowse.prg, можешь подобрать длину в символах не 20, а сколько надо у тебя Перенес эту тему сюда. Нужно наверное поставить там 24 знака для ВСЕХ, чтобы не съедались колонки ? А для этих колонок сделать вот так ! [pre2] ELSEIF cType $ "+^" // Type: [+] [^] // если в базе будет 1 000 000 записей, то нужно 7 знаков oCol:nWidth := GetTextWidth( Nil, REPL("9",7), hFont ) // 7 знака[/pre2] У меня разрешение экрана 1920х1080, может из-за этого съедаются колонки ? Сделал отдельный пример, первую таблицу по умолчанию, во вторую таблицу добавил свою функцию myPartWidthTsb( oBrw ) // поправить ширину колонок Тогда колонки 24,26,27,28 показываются полностью. Вот проект - https://cloud.mail.ru/public/2h5G/5HCw2TY2G Народ, посмотрите на своих мониторах, будут у вас съедаться колонки 24,26,27,28 в первой таблице ?
SergKis: Andrey [pre2] DEFINE TBROWSE oBrw1 ; AT nY, nX ALIAS aArray WIDTH nW HEIGHT nH CELL ; FONT aFont ; BRUSH YELLOW ; HEADERS aHead ; COLSIZES aSize ; PICTURE aPict ; JUSTIFY aAlign ; COLUMNS aField ; COLNAMES aName ; FOOTERS aFoot ; FIXED COLSEMPTY ; LOADFIELDS ; /*COLNUMBER { 1, 40 } */ ; ENUMERATOR LOCK EDIT ? procname(), "FontWidth =", GetTextWidth( 0, Replicate( "9", 24 ), GetFontHandle(aFont[ 1 ]) ), GetFontWidth(aFont[ 1 ], 20), GetTextWidth( 0, Replicate( "B", 20 ), GetFontHandle(aFont[ 1 ]) ) дает у меня MYBRW1 FontWidth = 216 220 220 216 - это что предлагаешь ты 220 - это то что стоит в :LoadFields(), получено 2-мя способами т.е. вариант в тсб на 4 pixel > твоего варианта [/pre2] Что дает у тебя ? Andrey пишет если в базе будет 1 000 000 записей, то нужно 7 знаков Тогда увеличишь, когда надо будет, я же показывал, к примеру :GetColumn("ID"):nWidth := (App.Object):W1 :GetColumn("VM"):nWidth := (App.Object):W1 или др. способом :GetColumn("ID"):nWidth := GetFontWidth(aFont[ 1 ], 7) :GetColumn("VM"):nWidth := GetFontWidth(aFont[ 1 ], 12) к примеру, если поле "N" и короткое, и надо по нему подводить итог (сумму), то делаю так[pre2] ELSEIF o:cFieldTyp == "N" .and. o:nFieldLen < 10 o:nWidth += GetFontWidth("Normal", 3) [/pre2] т.е. все ситации не засунешь во внутрь h_tbrowse.prg, что то придется писать и для своих баз можешь учесть все, что надо
SergKis: Andrey пишет посмотрите на своих мониторах, будут у вас съедаться колонки 24,26,27,28 в первой таблице ? на 3х PC нормально показывает не съедает ничего (1. win 8.1 [15"], 2. win 10 [14"], 3. win 8.1 [11"] ), exe твоей сборки
Andrey: SergKis пишет: ? procname(), "FontWidth =", GetTextWidth( 0, Replicate( "9", 24 ), GetFontHandle(aFont[ 1 ]) ), GetFontWidth(aFont[ 1 ], 20), GetTextWidth( 0, Replicate( "B", 20 ), GetFontHandle(aFont[ 1 ]) ) дает у меня MYBRW1 FontWidth = 216 220 220 216 - это что предлагаешь ты 220 - это то что стоит в :LoadFields(), получено 2-мя способами т.е. вариант в тсб на 4 pixel > твоего варианта Что дает у тебя ? MYBRW1 FontWidth = 240 200 200 У меня разрешение 1920х1080, win 8.1 [24"] Вот наверное из-за этого и съедаются колонки. Т.е. на всех мониторах красивого оформления НЕ ПОЛУЧИТСЯ без доп.функций, например как я написал myPartWidthTsb( oBrw ) // поправить ширину колонок SergKis пишет: т.е. все ситации не засунешь во внутрь h_tbrowse.prg, что то придется писать и для своих баз можешь учесть все, что надо Хорошо, понял. Буду делать свою добавку к ТСБ.
SergKis: Andrey Попробуй добавку ? procname(), "FontWidth =", GetTextWidth( 0, Replicate( "9", 24 ), GetFontHandle(aFont[ 1 ]) ), GetFontWidth(aFont[ 1 ], 20), ; GetTextWidth( 0, Replicate( "B", 20 ), GetFontHandle(aFont[ 1 ]) ) ?? (App.Object):W(2.3) она у меня 218 что у тебя ?
Andrey: SergKis пишет: что у тебя ? (App.Object):W(2.3)= 218
SergKis: Andrey Попробуй присвоить :nWidth := (App.Object):W(2.4) или (App.Object):W(2.5) для колонок "T" как будет выглядеть tsb
Andrey: SergKis пишет: Попробуй присвоить :nWidth := (App.Object):W(2.4) или (App.Object):W(2.5) для колонок "T" как будет выглядеть tsb Отлично выглядит на (App.Object):W(2.5) ! Попробовал фонт "Arial" вместо "DejaVu Sans Mono" для TsbNorm - стало лучше. Фонт "DejaVu Sans Mono" моноширинный, а Arial обычный Вот и компенсируются размеры ячеек.
Andrey: Строю ТСБ, удаляю(скрываю) колонки, делаю заморозку столбцов: [pre2] :nFreeze := :nColumn("TEVENT") // заморозить таблицу до этого столбца :lLockFreeze := .T. // избегать прорисовки курсора на замороженных столбцах [/pre2] Курсор на таблице, но нет активного ввода, нужно стрелкой вправо или Enter нажать, тогда появляется активный ввод. И ещё при движении налево, т.е. где замороженные столбцы - курсор уходит на эти столбцы, т.е. пропадает. Почему, установил же :lLockFreeze := .T. ?
Haz: Andrey пишет: И ещё при движении налево, т.е. где замороженные столбцы - курсор уходит на эти столбцы, т.е. пропадает. Почему, установил же :lLockFreeze := .T. ? проверил на последней сборке все работает , ищи у себя ошибку Andrey пишет: Курсор на таблице, но нет активного ввода, ху из активный ввод ?
Andrey: Haz пишет: ху из активный ввод ? Вот это, активный курсор для ввода: При построении ТСБ надо ENTER нажать, только тогда появляется активный ввод.
SergKis: Andrey Что бы не было разных непоняток, можно делать так (на базе примера Tsb_MoreFields\demo.prg)[pre2] #include "hmg.ch" #include "TSBrowse.ch" REQUEST DBFCDX function Main() field FIRST,LAST,STREET,CITY,STATE,ZIP,HIREDATE,MARRIED,AGE,SALARY field FIRST2,LAST2,STREET2,CITY2,STATE2,ZIP2,HIREDATE2,MARRIED2,AGE2,SALARY2 field FIRST3,LAST3,STREET3,CITY3,STATE3,ZIP3,HIREDATE3,MARRIED3,AGE3,SALARY3 field FIRST4,LAST4,STREET4,CITY4,STATE4,ZIP4,HIREDATE4,MARRIED4,AGE4,SALARY4 field FIRST5,LAST5,STREET5,CITY5,STATE5,ZIP5,HIREDATE5,MARRIED5,AGE5,SALARY5 field FIRST6,LAST6,STREET6,CITY6,STATE6,ZIP6,HIREDATE6,MARRIED6,AGE6,SALARY6 field FIRST7,LAST7,STREET7,CITY7,STATE7,ZIP7,HIREDATE7,MARRIED7,AGE7,SALARY7 field FIRST8,LAST8,STREET8,CITY8,STATE8,ZIP8,HIREDATE8,MARRIED8,AGE8,SALARY8 local obrw, aStruct, cCust, cmiln, n, nLen, a, i, c cCust := "customer.dbf" cmiln := "custmiln.dbf" SET OOP ON if File( cmiln ) USE ( cmiln ) NEW ALIAS "CUST" VIA "DBFCDX" else aStruct := hmg_DBfSTRUCT( cCust ) ASize( aStruct, Len( aStruct ) - 1 ) nLen := Len( aStruct ) for i := 2 to 8 c := Str( i, 1, 0 ) for n := 2 to nLen a := AClone( aStruct[ n ] ) a[ 1 ] += c AAdd( aStruct, a ) next next DBCREATE( cmiln, aStruct, "DBFCDX", .t., "CUST" ) for n := 1 to 20 //2000 APPEND FROM customer.dbf ; FIELDS FIRST,LAST,STREET,CITY,STATE,ZIP,HIREDATE,MARRIED,AGE,SALARY next GO TOP REPLACE ALL FIRST2 WITH FIRST, LAST2 WITH LAST, CITY2 WITH CITY, STATE2 WITH STATE, ; ZIP2 WITH ZIP, HIREDATE2 WITH HIREDATE, MARRIED2 WITH MARRIED, ; AGE2 WITH AGE, SALARY2 WITH SALARY REPLACE ALL FIRST3 WITH FIRST, LAST3 WITH LAST, CITY3 WITH CITY, STATE3 WITH STATE, ; ZIP3 WITH ZIP, HIREDATE3 WITH HIREDATE, MARRIED3 WITH MARRIED, ; AGE3 WITH AGE, SALARY3 WITH SALARY REPLACE ALL FIRST4 WITH FIRST, LAST4 WITH LAST, CITY4 WITH CITY, STATE4 WITH STATE, ; ZIP4 WITH ZIP, HIREDATE4 WITH HIREDATE, MARRIED4 WITH MARRIED, ; AGE4 WITH AGE, SALARY4 WITH SALARY REPLACE ALL FIRST5 WITH FIRST, LAST5 WITH LAST, CITY5 WITH CITY, STATE5 WITH STATE, ; ZIP5 WITH ZIP, HIREDATE5 WITH HIREDATE, MARRIED5 WITH MARRIED, ; AGE5 WITH AGE, SALARY5 WITH SALARY REPLACE ALL FIRST6 WITH FIRST, LAST6 WITH LAST, CITY6 WITH CITY, STATE6 WITH STATE, ; ZIP6 WITH ZIP, HIREDATE6 WITH HIREDATE, MARRIED6 WITH MARRIED, ; AGE6 WITH AGE, SALARY6 WITH SALARY REPLACE ALL FIRST7 WITH FIRST, LAST7 WITH LAST, CITY7 WITH CITY, STATE7 WITH STATE, ; ZIP7 WITH ZIP, HIREDATE7 WITH HIREDATE, MARRIED7 WITH MARRIED, ; AGE7 WITH AGE, SALARY7 WITH SALARY REPLACE ALL FIRST8 WITH FIRST, LAST8 WITH LAST, CITY8 WITH CITY, STATE8 WITH STATE, ; ZIP8 WITH ZIP, HIREDATE8 WITH HIREDATE, MARRIED8 WITH MARRIED, ; AGE8 WITH AGE, SALARY8 WITH SALARY GO TOP endif SET DELETE ON DEFINE WINDOW win_1 AT 0, 0 WIDTH 1004 HEIGHT 541 ; MAIN TITLE hb_ntos( LastRec() ) + " Records: 81 Fields: Record Lenght: 1061" NOMAXIMIZE NOSIZE DEFINE TOOLBAR ToolBar_1 BUTTONSIZE 8,36 IMAGESIZE 24,24 FLAT BORDER BUTTON TOP_1 ; PICTURE "res\go_first.bmp" ; TOOLTIP "Top" ; ACTION ( oBrw:GoTop(), oBrw:SetFocus() ) BUTTON PREV_1 ; PICTURE "res\go_prev.bmp" ; TOOLTIP "Up" ; ACTION ( oBrw:GoUp(), oBrw:SetFocus() ) BUTTON DOWN_1 ; PICTURE "res\go_next.bmp" ; TOOLTIP "Down" ; ACTION ( oBrw:GoDown(), oBrw:SetFocus() ) BUTTON BOTTOM_1 ; PICTURE "res\go_last.bmp" ; TOOLTIP "Bottom" ; ACTION ( oBrw:GoBottom(), oBrw:SetFocus() ) SEPARATOR BUTTON NEW_1 ; PICTURE "res\frm_new.bmp" ; TOOLTIP "Add" ; ACTION ( ( oBrw:cAlias )->( dbAppend() ), oBrw:GoToRec( ( oBrw:cAlias )->( RecNo() ), .T. ), oBrw:SetFocus() ) BUTTON EDIT_1 ; PICTURE "res\frm_edit.bmp" ; TOOLTIP "Edit" ; ACTION ( oBrw:PostMsg( WM_KEYDOWN, VK_F10, 0 ), oBrw:SetFocus() ) BUTTON DELETE_1 ; PICTURE "res\frm_delete.bmp" ; TOOLTIP "Delete" ; ACTION ( iif( MsgYesNo( "Delete Record ?", , .T. ), oBrw:DeleteRow(), NIL ), oBrw:SetFocus() ) SEPARATOR BUTTON PRINT_1 ; PICTURE "res\frm_print.bmp" ; TOOLTIP "Report" ; ACTION PrintData( oBrw ) SEPARATOR BUTTON EXIT_1 ; PICTURE "res\frm_exit.bmp" ; TOOLTIP "Exit" ; ACTION Win_1.Release END TOOLBAR DEFINE TBROWSE obrw AT 56, 20 ; CELLED SELECTOR "res\pointer.bmp" ; COLORS CLR_BLACK, CLR_WHITE, CLR_BLACK, { RGB( 231, 242, 255 ), GetSysColor( COLOR_GRADIENTINACTIVECAPTION ) } ; ALIAS "CUST" ; WIDTH win_1.Width - 40 - GetBorderWidth() / 2 HEIGHT 420 ; FONT "Arial" ; SIZE 9 ; ON INIT {|ob| TsbCreate( ob, .T. ) } :Cargo := oKeyData() END TBROWSE ON END {|ob| TsbCreate( ob, .F. ) } obrw:Cargo:aColumns := AClone( obrw:aColumns ) ON KEY CONTROL+1 ACTION _wPost(1, , "1") ON KEY CONTROL+2 ACTION _wPost(1, , "2") ON KEY CONTROL+3 ACTION _wPost(1, , "3") ON KEY CONTROL+4 ACTION _wPost(1, , "4") ON KEY CONTROL+5 ACTION _wPost(1, , "5") ON KEY CONTROL+6 ACTION _wPost(1, , "6") ON KEY CONTROL+7 ACTION _wPost(1, , "7") ON KEY CONTROL+8 ACTION _wPost(1, , "8") ON KEY CONTROL+0 ACTION _wPost(1, , "0") (This.Object):Event( 1, {|ow,ky,cn| Local ob := This.obrw.Object Local ac := ob:Cargo:aColumns, ni, oc Local aCols := {} ky := val(cn) FOR ni := 1 TO Len(ac) oc := ac[ ni ] If ni == 1 AAdd(aCols, ac[ ni ]) ElseIf ky == 0 AAdd(aCols, ac[ ni ]) ElseIf ky == 1 If val( right(oc:cName, 1) ) == 0 AAdd(aCols, ac[ ni ]) EndIf ElseIf right(oc:cName, 1) == cn AAdd(aCols, ac[ ni ]) EndIf NEXT ob:aColumns := aCols ob:nRowPos := 1 ob:nCell := 2 ob:Reset() Return Nil } ) END WINDOW CENTER WINDOW win_1 ACTIVATE WINDOW win_1 return nil *---------------------------------------- STATIC PROCEDURE TsbCreate( obrw, lInit ) *---------------------------------------- local aStruct, cCust, n, nLen, a, i, c local aFields IF lInit cCust := "customer" aStruct := hmg_DBfSTRUCT( cCust ) ASize( aStruct, Len( aStruct ) - 1 ) nLen := Len( aStruct ) for i := 2 to 8 c := Str( i, 1, 0 ) for n := 2 to nLen a := AClone( aStruct[ n ] ) a[ 1 ] += c AAdd( aStruct, a ) next next // initial columns aFields := {} for n := 1 to Len( aStruct ) a := aStruct[ n ][ 1 ] AAdd( aFields, a ) next LoadFields( "oBrw", "win_1", .T., aFields ) with object oBrw :nHeightCell += 5 :nHeightHead := oBrw:nHeightCell :SetColor( { 5 }, { CLR_WHITE } ) :SetColor( { 6 }, { RGB( 0, 0, 128 ) } ) :aColumns[ 1 ]:cPicture := "99,999,999" :aColumns[ 1 ]:lEdit := .F. :SetAppendMode( .F. ) :SetDeleteMode( .T., .F. ) :lNoResetPos := .T. :lNoMoveCols := .T. :lNoKeyChar := .T. :lNoChangeOrd := .T. :nFireKey := VK_F10 // default Edit key end object ELSE obrw:SetNoHoles() obrw:SetFocus() ENDIF RETURN *--------------------------------- STATIC PROCEDURE PrintData( oBrw ) *--------------------------------- LOCAL aStruct, cCust, n, nLen, a LOCAL PrevRec LOCAL aHdr := {} LOCAL aLen := {} LOCAL aHdr1 LOCAL aTot LOCAL aFmt cCust := "customer" aStruct := hmg_DBfSTRUCT( cCust ) ASize( aStruct, Len( aStruct ) - 1 ) nLen := Len( aStruct ) for n := 2 to nLen a := AClone( aStruct[ n ] ) AAdd( aHdr, a[1] ) AAdd( aLen, a[3] ) next aHdr1 := Array( Len( aHdr ) ) aTot := Array( Len( aHdr ) ) aFmt := Array( Len( aHdr ) ) AFill( aHdr1, '' ) AFill( aTot, .F. ) AFill( aFmt, '' ) PrevRec := ( oBrw:cAlias )->( RecNo() ) ( oBrw:cAlias )->( dbGoTop() ) DO REPORT ; TITLE Upper( cCust ) + ' Database List' ; HEADERS aHdr1, aHdr ; FIELDS aHdr ; WIDTHS aLen ; TOTALS aTot ; NFORMATS aFmt ; WORKAREA &( oBrw:cAlias ) ; LMARGIN 3 ; TMARGIN 3 ; PAPERSIZE DMPAPER_A4 ; PREVIEW ( oBrw:cAlias )->( dbGoto( PrevRec ) ) RETURN [/pre2] Всегда будут только нужные столбцы в колонках тсб. Клавиши Ctrl+1,...,Ctrl+8,Ctrl+0 меняют список колонок в просмотре от имени колонки oCol:cName
SergKis: Andrey пишет При построении ТСБ надо ENTER нажать, только тогда появляется активный ввод. А добавить oBrw:SetFocus() // можно добавить oBrw:GoPos(1, oBrw:nFreeze+1) oBrw:DrawSelect()
Andrey: SergKis пишет: А добавить oBrw:SetFocus() // можно добавить oBrw:GoPos(1, oBrw:nFreeze+1) oBrw:DrawSelect() Это не спасает, попробовал. Попробовал убрать скрытие столбцов в таблице, активный курсор появляется и передвижение на замороженные столбцы прекращается. Что-то с удалением/скрытием столбцов - ломается алгоритм движения курсора... Я с этим уже раз 5 сталкиваюсь, думал что-то я сам нахимичил, а это не я... Удаляю столбцы вот так: [pre2] oBrw:HideColumns( {1,2,3,4,5,12,18..} ,.t.) // скрыть колонки[/pre2]
SergKis: Andrey пишет Я с этим уже раз 5 сталкиваюсь, думал что-то я сам нахимичил, а это не я... Удаляю столбцы вот так: oBrw:HideColumns( (1,2,3,4,5,12,18..) ,.t.) // скрыть колонки Думаю, что это ТВОЯ химия, т.к. колонок :lVisible := .F. не должно быть до :nFreeze, т.е. скрываемые колонки должны находится ПОСЛЕ :nFreeze, т.к. до :nFreeze методы :nAtCol() и :nAtActual считают все колонки безусловно видимыми
Andrey: SergKis пишет: Думаю, что это ТВОЯ химия, т.к. колонок :lVisible := .F. не должно быть до :nFreeze Есть метод скрытия колонок, я скрыл колонки которые мне нужны. Показываю ТСБ, без заморозки колонок - нет активного курсора. [pre2] ............. myDelColumnTsb( oBrw, aTsbColumn ) // убрать колонки из таблицы //:nFreeze := :nColumn("TEVENT") // заморозить таблицу до этого столбца //:lLockFreeze := .T. // избегать прорисовки курсора на замороженных столбцах :GoPos(1, :nColumn("TEVENT") ) - без этого не пашет //:DrawSelect() ............ END TBROWSE ON END {|ob| ob:SetNoHoles(), ob:oPhant:nClrHeadBack := ob:Cargo:nClr4, ; ob:oPhant:nClrFootBack := ob:Cargo:nClr10,; ob:Refresh() }[/pre2] Т.е. убрал колонки - нужно позаботиться самому, чтобы показать активный курсор ... Блин, а я считал что ТСБ сам поставит на первую видимую колонку. Получается нет проверки, когда двигаем курсор - колонка заморожена или нет. Можно это как то проверить, чтобы курсор не улетал. Не особо это и критично, но так чтобы знать как это можно делать.
Andrey: Всем привет ! Есть построенный ТСБ, в нём суперхидер из одной колонки. Как узнать - сколько букв поместится в суперхидере ? Размеры получил, а кол-во букв не могу высчитать. [pre2] nWTsb := oBrw:GetAllColsWidth() // ширина всех колонок видимых hFont := oBrw:aSuperHead[ 1, 7 ] // 4-special header font If hFont != Nil aFont := GetFontParam(hFont) cFontName := aFont[1] nFontSize := aFont[2] lFontBold := aFont[3] ENDIF[/pre2] ? "hFont=", hFont, HB_ValToExp(aFont)
SergKis: Andrey Смотри свой же пример ButtonEx_DynamicMenu
Andrey: SergKis пишет: Смотри свой же пример ButtonEx_DynamicMenu Там другое. Возвращает максимальный размер фонта от кол-ва символов в строке. Мне нужно наоборот, от ширины шрифта и WIDTH объекта - получить максимальное кол-во символов которые влезут в WIDTH объекта.
SergKis: Andrey пишет Там другое. Возвращает максимальный размер фонта от кол-ва символов в строке. Мне нужно наоборот, от ширины шрифта и WIDTH объекта - получить максимальное кол-во символов которые влезут в WIDTH объекта. И что там другого ? Перебираются размеры фонта для строки, а наоборот (перебрать буквы для одного фонта) ты принять не можешь, религия не позволяет или арифметика другая
Andrey: SergKis пишет: религия не позволяет или арифметика другая Да вчера делал, не получилось. Сегодня по другому сделал, вроде работает... Вот так сделал - // Функция вернет максимальное количество букв "Н" или другое // для заданной строки: ширина-объекта и ширина-фонта FUNCTION GetMaxChar4FontWidth( cText, nWidth, cFontName, nFontSize, lBold ) LOCAL hFont, nWText, nMaxChar DEFAULT cText := "H", lBold := .F. lBold := !Empty(lBold) hFont := InitFont( cFontName, nFontSize, lBold ) nWText := GetTextWidth ( 0, cText, hFont ) DeleteObject( hFont ) nMaxChar := INT(nWidth/nWText) RETURN nMaxChar
SergKis: Andrey пишет // Функция вернет максимальное количество букв "Н" Почему именно "H". Используют в практике 3-и буквы, если от букв прыгать, а не от конкретного текста. "A" - min длина "B" - средняя длина "W" - max длина Если у тебя регистрирован фонт SET FONT Normal ..., то ты можешь получать длину от буквы "B" автоматом nWidth := GetFontWidth("Normal", 50 /* длина в символах */) Такой алгоритм применен в Tsb_DemoMdi примере для "M" полей и длинных "C" полей. Колонка шириной oCol:ToWidth(50 /*символов*/) и EditBox встраивает текст с переносами в эти 50 символов. Если в выводе преобладают маленькие буквы, то можно еще уменьшить nWidth *= 0.8 (или даже 0.7) или увеличить вывод кол-ва символов в полученный nWidth ~ 15-20%? т.е. 50+10(15) символов.
Andrey: SergKis пишет: Почему именно "H" Да не подумал сразу. Текст состоит у меня сейчас как правило только из нескольких заглавных букв. Поставил "х" и сразу стал текст в размер суперхидера попадать. Фонты уже зарегистрированны, спасибо за подсказку.
Dr. Oldwarez: Здравствуйте! Давно вам не писал - тут у меня личные проблемы были. И теперь вот вопрос: как открыть CSV-файл с заголовками в TsBrowse. Заголовки полей CSV можно брать в качестве заголовков TsBrowse. Есть поля текстовые, дата, время и одно длинное MEMO. Это экспортный файл из Google Calendar. Заранее благодарен
SergKis: Dr. Oldwarez пишет Есть поля текстовые, дата, время и одно длинное MEMO Пару записей показать бы. Можно dbf создавать а append from ... DELIMITED ..., но предложу через массив[pre2] aBuf := hb_ATokens( hb_memoread(cFie), CRLF) aDim := {} aHdr := {} FOR nI := 1 TO Len(aBuf) IF nI == 1 // header // как заданы заголовки в "..." или без них ? FOR EACH t IN hb_AToekns(aBuf[ nI ]) ; AAdd(aHdr, t) // без NEXT ELSE AAdd(aDim, &( "{"+aBuf[ nI ]+"}" )) ENDIF NEXT Далее подать aHdr и aDim в tsb, как в примерах Tsb_array_2, например [/pre2]
Dr. Oldwarez: SergKis пишет: Пару записей показать бы. Пожалуйста! [pre]Subject,Start Date,Start Time,End Date,End Time,Location,Description OLDWAREZ :Покупка компьютера,04/01/2021,10:00 AM,02/01/2021,12:30 PM,Вещевой рынок,Всего за 1500 руб. [/pre] Это стандартный экспорт календаря Гугл. Subject Start Date Start Time End Date End Time Location Description Это заголовки
SergKis: Dr. Oldwarez Не совсем стандартный csv по мне, но 1.принимаем в массив строковый все 2. опр. типы колонок 3. переводим данные строковые колонок по типам или показываем в тсб строковый вариант [pre2] aBuf := hb_ATokens( hb_memoread(cFie), CRLF) aDim := {} aTyp := {} aLen := {} aHdr := {} FOR nI := 1 TO Len(aBuf) IF nI == 1 // header FOR EACH t IN hb_AToekns(aBuf[ nI ], ",") ; AAdd(aHdr, t) NEXT ELSE aTmp := {} FOR EACH t IN hb_AToekns(aBuf[ nI ], ",") cTyp := "C" nLen := 0 IF "/" $ t cTyp := "D" t := CtoD(t) nLen := 8 ELSEIF ":" $ t .and. " AM" $ t cMilTime := ft_Civ2Mil( t ) // " 5:40 am" 0540 t := left(cMilTime, 2)+":"+right(cMilTime, 2)+":00" nLen := len(t) ELSEIF ":" $ t .and. " PM" $ t cMilTime := ft_Civ2Mil( t ) // " 5:40 pm" 1740 t := left(cMilTime, 2)+":"+right(cMilTime, 2)+":00" nLen := len(t) ELSE nLen := len(t) ENDIF AAdd(aTmp, t) AAdd(aTyp, cTip) AAdd(aLen, nLen) NEXT ENDIF NEXT [/pre2] можно подавать в тсб массивы или создавть dbf и в тсб (подключать hbnf.lib ) на выбор
SergKis: PS пропустил[pre2] AAdd(aLen, nLen) NEXT AAdd(aDim, aTmp) ENDIF [/pre2] и везде hb_ATokens(...) конечно
Dr. Oldwarez: SergKis пишет: опр. типы колонок Типы колонок заранее известны, но порядок может быть разным и могут быть неиспользуемые колонки. Используемые Subject - текстовый Start Date, End Date - дата (амер.). Start Time, End Time - текстовый AMPM Location - текстовый Description - MEMO
SergKis: Dr. Oldwarez пишет Типы колонок заранее известны, но порядок может быть разным и могут быть неиспользуемые колонки Определите структуру для dbf заранее, если все известно, в коде выше уберите aLen, aTyp aHdr - даст заголовки-поля по колонкам aDim - даст данные по записям и колонкам подайте их в тсб или обработайте и запишите в dbf
SergKis: PS вместо t := CtoD(t) использовать можно t := hb_CtoD(t, "mm/dd/yyyy")
Dr. Oldwarez: SergKis пишет: Определите структуру для dbf заранее, если все известно, в коде выше уберите aLen, aTyp aHdr - даст заголовки-поля по колонкам aDim - даст данные по записям и колонкам подайте их в тсб или обработайте и запишите в dbf Вот так? [pre2]SET DATE AMERICAN aBuf := hb_ATokens( hb_memoread(GetFile({{'CSV-Datei','*.csv'}},'Wählen Sie eine CSV Import-Datei aus',; cDatenLW,.F.,.T.)), CRLF) aDim := {} aTyp := {"C","D","C","C","C","M"} aLen := {10,10,5,5,25,150} aHdr := {} FOR nI := 1 TO Len(aBuf) IF nI == 1 // header FOR EACH t IN hb_ATokens(aBuf[ nI ], ",") ; AAdd(aHdr, t) nSubject:=ASCAN(aHdr,'Subject') nStartDate:=ASCAN(aHdr,'Start Date') nStartTime:=ASCAN(aHdr,'Start Time') nEndTime:=ASCAN(aHdr,'End Time') nLocation:=ASCAN(aHdr,'Location') nDescription:=ASCAN(aHdr,'Description') NEXT ELSE aTmp := hb_ATokens(aBuf[ nI ], ",") NEXT AAdd(aDim, {aTmp[nSubject],CTOD(aTmp[nStartDate]),ft_Civ2Mil(aTmp[nStartTime]),ft_Civ2Mil(aTmp[nEndTime]),; aTmp[nLocation],aTmp[nDescription]}) ENDIF NEXT SET DATE GERMAN[/pre2]
SergKis: Dr. Oldwarez пишет Вот так? Нет. Разрушили соответствие колонок aHdr и aDim в aHdr t, т.е. все колонки с пустыми, а в aDim только нужные по мне проще сделать массивы в полном соответствии как в файле, потом выбрать нужные по структуре или aHdr привести через aTmp в соответствие с aDim, как на ELSE
Dr. Oldwarez: SergKis пишет: Нет. Разрушили соответствие колонок aHdr и aDim Спасибо за напоминание! Тогда будет массив aHdr - для считывания ВСЕХ полей и aHeaders - то, что идёт в заголовки TBrowse Спасибо за помощь. Извините, тут одна линейка памяти сдохла, осталось совсем мало. Завтра куплю новую и продолжу.
SergKis: Dr. Oldwarez пишет Тогда будет массив aHdr - для считывания ВСЕХ полей и aHeaders - то, что идёт в заголовки TBrowse Определение заголовка лучше вынести за цикл[pre2] aBuf := hb_ATokens( hb_memoread(GetFile({{'CSV-Datei','*.csv'}},'Wählen Sie eine CSV Import-Datei aus',; cDatenLW,.F.,.T.)), CRLF) aFld := {"Subject", "StartDate", "StartTime", "EndTime", "Location", "Descript"} aTyp := {"C","D","C","C","C","M"} aLen := {10, 10, 5, 5, 25, 10} aDec := {0, 0, 0, 0, 0, 0} aDim := {} ; aHdr := {} FOR EACH t IN hb_ATokens(aBuf[ 1 ], ",") ; AAdd(aHdr, t) NEXT nSubject:=ASCAN(aHdr,'Subject') nStartDate:=ASCAN(aHdr,'Start Date') nStartTime:=ASCAN(aHdr,'Start Time') nEndTime:=ASCAN(aHdr,'End Time') nLocation:=ASCAN(aHdr,'Location') nDescription:=ASCAN(aHdr,'Description') aHead := {aHdr[nSubject],CTOD(aHdr[nStartDate]),ft_Civ2Mil(aHdr[nStartTime]),ft_Civ2Mil(aHdr[nEndTime]),; aHdr[nLocation],aHdr[nDescription]} FOR nI := 2 TO Len(aBuf) aTmp := hb_ATokens(aBuf[ nI ], ",") AAdd(aDim, {aTmp[nSubject],CTOD(aTmp[nStartDate]),ft_Civ2Mil(aTmp[nStartTime]),ft_Civ2Mil(aTmp[nEndTime]),; aTmp[nLocation],aTmp[nDescription]}) NEXT [/pre2]
Dr. Oldwarez: SergKis пишет: Нет. Разрушили соответствие колонок aHdr и aDim в aHdr t, т.е. все колонки с пустыми, а в aDim только нужные по мне проще сделать массивы в полном соответствии как в файле, потом выбрать нужные по структуре или aHdr привести через aTmp в соответствие с aDim, как на ELSE И вот, СРАБОТАЛО!!! [pre2]aBuf := hb_ATokens( hb_memoread(GetFile({{'CSV-Datei','*.csv'}},'Выберите файл CSV для импорта',; cDataDir,.F.,.T.)), CRLF) aDim := {} aTyp := {"C","D","C","C","C","M"} aLen := {80,80,40,40,200,400} aHdr := {} aHeaders:={"Subject","Start Date", "Start Time","End Time","Location","Description"} FOR nI := 1 TO Len(aBuf) IF nI == 1 // header FOR EACH t IN hb_ATokens(aBuf[ nI ], ",") ; AAdd(aHdr, t) nSubject:=ASCAN(aHdr,'Subject') nStartDate:=ASCAN(aHdr,'Start Date') nStartTime:=ASCAN(aHdr,'Start Time') nEndTime:=ASCAN(aHdr,'End Time') nLocation:=ASCAN(aHdr,'Location') nDescription:=ASCAN(aHdr,'Description') NEXT ELSE aTmp := hb_ATokens(aBuf[ nI ], ",") IF LEN(aTmp)>3 AADD(aDim,{; aTmp[nSubject],; hb_CTOD(aTmp[nStartDate],'MM/DD/YYYY'),; LEFT(FT_CIV2MIL(aTmp[nStartTime]),2)+":"+RIGHT(FT_CIV2MIL(aTmp[nStartTime]),2),; LEFT(FT_CIV2MIL(aTmp[nEndTime]),2)+":"+RIGHT(FT_CIV2MIL(aTmp[nEndTime]),2),; IIF(nLocation<=LEN(aTmp),aTmp[nLocation],""),; IIF(nDescription<=LEN(aTmp),aTmp[nDescription],"")}) ENDIF ENDIF NEXT [/pre2] Дальше там ещё должны быть преобразования с первым полем, раскалывающие его на два поля и контроль дубликатов по полям StartDate и StartTime. Для всего этого хорошо бы конвертацию во временную таблицу - мне с таблицами веселее, чем с массивами. Перед каждым открытием эта таблица должна, естественно, очищаться ZAP.
SergKis: Dr. Oldwarez пишет Для всего этого хорошо бы конвертацию во временную таблицу Делайте в таблицу (из моего примера)[pre2] REQUEST HB_MEMIO aStru := {} FOR EACH cFld, cTyp, nLen, nDec IN aFld, aTyp, aLen, aDec ; AAdd(aStru, {cFld, cTyp, nLen, nDec}) NEXT cDbf := "mem:Test" // или ".\Test" dbDrop(cDbf, cDbf, "DBFCDX") dbCreate( cDbf, aStru, , .T., "TMP", , "RU1251" ) FOR EACH aTmp IN aDim APPEND BLANK FOR nI := 1 TO FCount() FieldPut(nI, aTmp[ nI ] ) // aFld := {"Subject", "StartDate", "StartTime", "EndTime", "Location", "Descript"} NEXT NEXT USE [/pre2]
SergKis: PS добавить NEXT Browse() USE dbDrop(cDbf, cDbf, "DBFCDX") // для mem:
Andrey: У юзера падает программа на ТСБ. Видно мышкой так давит, что успевает несколько кликов сделать. У меня так не получается. Вот такая примерно ошибка: [pre2] Called from (b)CREATEBROWSETABLE(807) in module: Source\Tbrw_table.prg Called from TSBROWSE:LDBLCLICK(9200) in module: h_tbrowse.prg Called from TSBROWSE:HANDLEEVENT(9588) in module: h_tbrowse.prg Called from EVENTS(96) in module: h_events.prg Called from DOEVENTS(0) [/pre2] Можно как то блокировать запись, чтобы повторно не срабатывала мышка ? На ВСЕХ кнопках сделал блокировку, у юзера перестало падать по кнопкам. Это наверное из той же серии, комп медленный, а юзер мышку давит до последнего !
Петр: Andrey пишет: Это наверное из той же серии Серия называется "Извините, а вы точно ..."
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 'Вид' SIZE w_vid ; // 3 DATA ComboWBlock(Br_sch,'kod_vid',3,{aItem,aData}) ; ALIGN DT_CENTER, DT_CENTER ; EDITABLE ... Получаю: данные в колонке не отображаются и при попытке редактирования возникает ошибка: Error MGERROR/0 GETBOX: Initial Value or Field must be specified. Program terminated. Called from MSGMINIGUIERROR(100) in module: h_error.prg Called from _DEFINEGETBOX(95) in module: h_getbox.prg Called from TGETBOX:NEW(109) in module: TGetBox.prg Called from TSBROWSE:EDIT(5637) in module: h_tbrowse.prg Called from TSBROWSE:KEYDOWN(8661) in module: h_tbrowse.prg Called from TSBROWSE:HANDLEEVENT(9555) in module: h_tbrowse.prg Called from EVENTS(96) in module: h_events.prg Called from DOMESSAGELOOP(0) Called from _ACTIVATEWINDOW(1516) in module: h_windows.prg Called from DATA_SCH(225) in module: Source\data_sch.prg ... Однако если написать: DEFINE TBROWSE Br_sch AT h_tlbar,0 ALIAS 'sch' WIDTH w_br HEIGHT h_br BOLD CELLED ... ADD COLUMN TO Br_sch HEADER 'Вид' SIZE w_vid ; // 3 DATA nil ; ALIGN DT_CENTER, DT_CENTER ; EDITABLE ... Br_sch:SetData(3,ComboWBlock(Br_sch,'kod_vid',3,{aItem,aData})) ... Все прекрасно работает.
SergKis: alex_II пишет Получаю: данные в колонке не отображаются и при попытке редактирования возникает ошибка: Вам надо добавить уточнение для колонки COMBO или COMBOBOX (попадаете на GETBOX) ADD COLUMN TO Br_sch HEADER 'Вид' SIZE w_vid ; // 3 DATA ComboWBlock(Br_sch,'kod_vid',3,{aItem,aData}) ; COMBOBOX ; ALIGN DT_CENTER, DT_CENTER ; EDITABLE
alex_II: Спасибо за помощь
alex_II: Есть ли возможность изменить состояние чекбокса в TBROWSE клавишей Enter? Пользователям удобнее работать на клавиатуре. Может кто уже решил эту проблему.
SergKis: Есть ли возможность изменить состояние чекбокса в TBROWSE клавишей Enter? oBrw:lCheckBoxAllReturn := .T.
alex_II: Спасибо
alex_II: Неудобно редактировать COMBOBOX. Тут ситуация обратная CHECKBOX'у При работе с COMBOBOX мышью для, подтверждения выбора необходимо нажать Enter. Нельзя ли для этого использовать двойное нажатие ЛКМ. Редактирование через клавиатуру устраивает.
SergKis: alex_II пишет Неудобно редактировать COMBOBOX. Не только это, но стрелки вверх\вниз сменят позицию значения (SET NAVIGATION EXTENDED как правило стоит) и пользователь по привычке сделает и не заметит, а значение сменит, что было не видел ... Использую только на формах не на тсб, откл. TABSTOP, только мышкой можно менять. На тсб исп. вариант такого же тсб, см. пример Tsb_ListBox (много данных) или динамическое ContextMenu используйте. Примеры есть на эту тему или Андрея спросите их у него много
Haz: Не пойму как spinner в tsBrowse работает. при достижении нуля скачет на другую строку , как исправить никто не знает ? Берем базовый пример TsBtest в строке 522 пишем [pre2]Brw_6:SetSpinner( 10, .t., 1,1, {|| 0 }, {|| 100 } ) [/pre2] в любой строке ( в первой нагляднее ) в 10 колонке вбиваем ручками значение 2 и затем мышью или кнопками пытаемся установить 0. При переходе с 1 на 0 курсор улетает. Есть мысли где копать ? хоть какой модуль дурит ? исходники по слову spinner просмотрел - не нашел где подкрутить.
Dima: Haz пишет: Берем базовый пример TsBtest Не нашел такой
SergKis: Dima пишет Не нашел такой это Advanced\TsBrowse\TsBtest.prg Haz пишет Brw_6:SetSpinner( 10, .t., 1,1, {|| 0 }, {|| 100 } ) У меня работает, доходит до 0 и курсор не теряется, а нажав Esc, курсор уходит с тсб, надо кликать по тсб поищи Far-ом в source\TsBrowse Alt+F7 "spinn" выдаст все, там надо смотреть
Haz: Специально записал видео скомпилировал пример с нуля для надежности Сергей, обрати внимание на то что в первой колонки строки и позицию вертикального скроллера до перехода в ноль и после вот ссылка на видео https://drive.google.com/file/d/1BgXBWAyya-wn3P0DO34pM_2sXznafw7o/view?usp=sharing ЗЫ по слову спин обыскался в исходниках. Не пойму как решить проблему. Ладно бы у себя в проекте накосячил, так это стандартный пример с чистой версии минигуи
SergKis: Haz пишет Специально записал видео Ты про верт. скролл бар ? Почему он перемешается, не знаю ? Он не должен иметь к spinner отношения. Spinner это увеличение\уменьшение числового значения в GetBox, по мне. по слову спин обыскался в исходниках (см. выше) Far, Alt+F7 файлы *.prg,*,c,.ch ищем "spinn" => c_TBrowse.c h_tbrowse.prg TBtnBox.prg TGetBox.prg TSCOLUMN.PRG возможно h_events.prg, но надо смотреть блоки кода установленные в колонках и создаваемые в TBtnBox и TGetBox когда они срабатывают и почему и где воздействуют на VScrollBar объект. Сам не использую spinner, как то более наглядно через кнопочки +,-
Haz: SergKis пишет: Ты про верт. скролл бар ? Почему он перемешается, не знаю ? Он не должен иметь к spinner отношения. Spinner это увеличение\уменьшение числового значения в GetBox, по мне. Да вертикальный скролл уезжает, а вмести с ним и весь бровс Спиннер реализован на на BtnGet, никакого отношения в бровсу не должен иметь, просто рисуется в окне ячейки и имеет свой hWnd. НО ... шлет сообщения бровсу , если большое число спиннить непрерывно видна перерисовка бровса. Пытался делать тассировку сообщений через HandleEvent и при работе спиннера сообшения долетают до class Tcontrol. На этом я потерялся Идея с двумя кнопками интересна, покажи скрин реализации
SergKis: Haz пишет Идея с двумя кнопками интересна, покажи скрин реализации Скрин не покажу (там сервер нужен и ...), проще в пример перенести, модифицированный GetBox_3 тут https://TransFiles.ru/qo4ol
Haz: SergKis пишет: проще в пример перенести, модифицированный GetBox_3 Идея понятна, нужно посмотреть как она впишется в BtnGet TsBrows . Спасибо за нее.
Haz: Haz пишет: нужно посмотреть как она впишется в BtnGet TsBrows к сожалению не вписывается , в btnGet одна кнопка.. печаль.
SergKis: Haz пишет к сожалению не вписывается , в btnGet одна кнопка.. печаль. На модальном окне без заголовка (в размер ячейки) вписывается нормально или вариант, как в Excel строка с GetBox отдельно от тсб и по смене строк, меняешь их содержимое (расположение строки может быть горизонтальным, вертикальным) , можно кнопки сделать с +,- в toolbar или над колонкой. Можно сделать доп. колонки с +,- рядом с нужной и по edit вносишь константу, двойными кликами по ячейкам с +,- делаешь +1,-1
Haz: SergKis пишет: Можно сделать доп. колонки с +,- рядом с нужной и по edit вносишь константу, двойными кликами по ячейкам с +,- делаешь +1,-1 это уже тестирую , как вариант
SergKis: Haz пишет это уже тестирую SergKis пишет На модальном окне без заголовка (в размер ячейки) вписывается нормально В этом варианте полный аналог из примера на GetBox, на :bPrevEdit подключаешь и если в модал окне Esc - не пишешь результат в ячейку.
Haz: SergKis пишет: В этом варианте полный аналог из примера на GetBox, на :bPrevEdit подключаешь и если в модал окне Esc - не пишешь результат в ячейку. Ну так то и обычный спиннер вписать можно в модальное. Жаль что в TS этот элемент криво работает
Haz: SergKis пишет: На модальном окне без заголовка (в размер ячейки) Спасибо , создал модальное , изменил стиль окна и вписал туда обычный спиннер. Все работает
Haz: Попутно добавил у себя в h_tbrowse.prg [pre2] в описании данных DATA lShowNone AS LOGICAL INIT .T. // enable/disable DatePicker ShowNone in inplace Editing в методе Edit local lShowNone ... lShowNone := ::lShowNone ( после lPicker := ::lPickerMode // MWS Sep 20/07 ) и далее oCol:oEdit := TDatePicker():New( nRow, nCol, bSETGET( uValue ), Self, nWidth, nHeight, ; cPicture,, nClrFore, nClrBack, hFont, ::cChildControl,, cWnd, ; cMsg,,,,, bChange,,, lShowNone, ::lUpDown ) [/pre2] теперь достаточно указать oBrw:lShowNone := FALSE ,а то пользователи ( некоторые ) с этим квадратом справиться не могут
SergKis: Haz пишет Попутно добавил у себя в h_tbrowse.prg Оч. хорошая добавка создал модальное , изменил стиль окна и вписал туда обычный спиннер. Все работает Спиннер, конечно, хорошо, но у него очень малая область для кликов мышкой, особенно при работе с тачпад Что добавил в стиль модального окна ?
gfilatov2002: SergKis пишет: хорошая добавка Добавил эту переменную в новую сборку также Благодарю за помощь
Haz: SergKis пишет: Что добавил в стиль модального окна ? так, больше для красоты SetWindowLong(hWnd, GWL_STYLE, WS_BORDER)
SergKis: Haz пишет для красоты Спасибо. Можно еще такой вариант делать[pre2] DEFINE WINDOW &(oCol:cName) AT nY,nX WIDTH nW HEIGHT nH MODAL NOSIZE NOSYSMENU NOCAPTION BACKCOLOR BLUE @ 2,2 GETBOX _Get_ HEIGHT nH-4 WIDTH This.ClientWidth-4 VALUE oBrw:GetValue(oCol) ON KEY RETURN ACTION ( cRet := This._Get_.Value, ThisWindow.Release ) ON KEY ESCAPE ACTION ThisWindow.Release END WINDOW ACTIVATE WINDOW &(oCol:cName) [/pre2]
Haz: SergKis пишет: Можно еще такой вариант делать Примерно так и сделал. Заказчик захотел спиннер, на нем висит блок кода визуально отражающий итоговый денежный поток при сдвигах платежей во времени. Спасибо Григорий подкинул хелп по расчёту рмчёрту , иначе не разобрался бы
krutoff: Понадобилось в TBrowse открыть в символьном поле ComboBox и наткнулся на ограничение по длине бокса. Для сивольного поля открывается бокс только по длине поля, а для цифрового поля - подсчитывает длину мах строки: строка 5522 h_tbrowse.prg: IF ValType( ::bDataEval( oCol ) ) == "N" nWidth := 0 AEval( aGet, {| x | nWidth := Max( Len( x ), nWidth ) } ) nWidth := Max( GetTextWidth( 0, Replicate( 'B', nWidth ), hFont ), oCol:nWidth ) ENDIF ВОПРОС: Можно ли снять это ограничение (IF) ? (Тип поля менять не могу - такая постановка).
SergKis: krutoff пишет Можно ли снять это ограничение (IF) ? Чуть выше aGet := oCol:aItems т.е. форматируйте одну строку в массиве нужной длинны и все или чуть ниже[pre2] IF oCol:nEditWidth > 0 nWidth := oCol:nEditWidth ENDIF[/pre2] т.е. задайте нужное значение для колонки oCol:nEditWidth := ...
krutoff: SergKis Спасибо! Подошел только вариант 2: nWidth := oCol:nEditWidth
Haz: Может пригодиться кому ))) Уже давно этот метод появился благодаря Сергею как лекарство от залипшей нижней строки в бровсе. Ситуацию метод исправляет через выравнивание высот заголовков и подвалов и я его использовал во всех проектах. Но вот в последнем нужен строгий интерфейс и разные высоты заголовков и подвалов на одном экране при задании изначально одинаковых параметров начали раздражать. Еще раз пересмотрел примеры и исходники и выяснилось следующее: 1 Если объект создается через obrw := CreateBrowse() , а потом описание всех установок. То будет залипание нижней строки при определенном соотношении высот строк и высоты бровса 2 Если все установки делать внутри конструкции DEFINE TSBROWSE .... END TSBROWSE, то этой залипухи нет Переделал проект 1 Убрал все :SetNoHoles() 2 всех описаний свойств объекта вместо :SetNoHoles() поставил oBrw:lRePaint := .T.; oBrw:Display(); oBrw:ResetVScroll() и все стало нормально oBrw := CreateBrowse() ... // тут определения установок бровса и колонок oBrw:lRePaint := .T.; oBrw:Display(); oBrw:ResetVScroll() // и в самом конце это
SergKis: Haz пишет 2 Если все установки делать внутри конструкции DEFINE TSBROWSE .... END TSBROWSE, то этой залипухи нет На мой взгляд, это правильное использование формирование тсб, т.к. по END TSBROWSE происходят все расчеты размеров и прорисовки по ним всех строк и линий, если настройки делать после END ... то без принудительных установок и :Display() трудно заставить тсб отрисовывать все правильно, возможны при этом и "залипания". Во всех своих примерах, использовал методику формирования тсб ТОЛЬКО между DEFINE TBROWSE и END TBROWSE Убрал все :SetNoHoles() Как формируешь одинаковые высоты строки и всех типов заголовков ? От высоты клиентской области тсб ? Или берешь фикс. высоту клиентской области окна и от нее строишь, берешь высоту строки тсб и как то встраиваешь (округленно) размер тсб в окно ? Или жестко строишь окно (клиентскую область) от конкретных, определенных заранее высот всех строк, заголовков и высот доп. контролов окна ? Что делаешь в случае изменения окна по высоте с контролами и тсб, имею ввиду высоту строк ? Метод :SetNoHoles() позволяет сгладить эти вопросы, раскидав "лишние" пикселы между заголовками (SuperHeader, Header, Footer). Методика "oBrw:lRePaint := .T.; oBrw:Display(); oBrw:ResetVScroll()" требует очень жесткого подхода к расчетам всех контролов окна по высоте и учета изменения фонта и разрешения монитора и высот строк тсб, что бы окно смотрелось (по дизайну и пропорциям) более или менее прилично. По мне, это довольно трудоемко, т.е. вопрос куда деть "лишние" пикселы, между тсб и клиентской высотой окна при исп. разных фонтов остается и алгоритм их использования должен быть. Я, к примеру, использовал промежутки GapsHeight между контролами, увеличивая или уменьшая это значение, т.е. вычислял разницу высот всех контролов и клиентской высотой окна и из нее получал GapsHaight, не меняя высот контролов, но возможны и др. варианты
Haz: SergKis пишет: Как формируешь одинаковые высоты строки и всех типов заголовков ? Сергей, очень плотный интерфейс. На экране 6 TSB один напротив другого ( раздели экран на пополам по вертикали и на 3 части по горизонтали и представь что везде высота заголовка разная🧐), выверял высоты по пиксельно. В этом конкретном случае разница в заголовках и подвалах по всем TSB даёт эффект очень неаккуратной прорисовки и выглядит ... не профессионально. Согласен мириться с дырой под бровсом ( но в рамках окна бровса), но зато пиксель напротив пикселя и залипшей строки нет. Суть поста была в этом
SergKis: Haz пишет Согласен мириться с дырой под бровсом, но зато пиксель напротив пикселя и залипшей строки нет. Суть поста была в этом Я не придираюсь к методике, я уточняю, что другая требует более тщательного расчета и куда деть "лишние" пикселы. В твоем случае, я бы применил nHole := :SetNoHoles( nDelta, .F. ), т.е. получить "дырку" в пикселах и самому разделить ее между Header, Footer и др. заголовками в каких пропорциях так, что бы на всех тсб заголовки и подвалы были одинаковыми. END TBROWSE уже содержит :Display(), т.е. если до нее определиться со скролами, то как правило, прорисовка идет как надо, но на некоторых PC требуется дополнительный :Display(). Это выяснил Андрей, исп. Tsb_DemoMdi, как аналог dbEdit, на машинах клиента. В примере, можно глянуть, стоит в блоке кода на END TBROWSE доп. :Display()
Haz: SergKis пишет: т.е. получить "дырку" в пикселах и самому разделить ее между Header, Footer и др. заголовками в каких пропорциях так, что бы на всех тсб заголовки и подвалы были одинаковыми. пробовал, строгость общей картинки хромает. Не так важна дыра, как строгое соответствие между бровсами по высотам. Тут целью было избавиться от залипания последней строки. SetNoHoles() шикарно работает на окне с одним бровсом. Но если их много, то возникают вопросы. И все они в том, что : ВСЕ ВЫСОТЫ БРОВСОВ В ОКНЕ ДОЛЖНЫ БЫТЬ ОДИНАКОВЫ. А SetNoHoles() это метод конкретного бровса , а не группы бровсов. Отсюда возникает вопрос, нужны ли признаки группы ? То есть группируем бровсы в одну группу и у всех одни интерфейсные характеристики. Этого сейчас нет, и необходимость под вопросом.
SergKis: Haz пишет То есть группируем бровсы в одну группу и у всех одни интерфейсные характеристики. Этого сейчас нет, и необходимость под вопросом. Игорь, думаю, все несколько проще, у тсб одинаковая высота и высота строки, у 1-го тсб получаешь, например, :nHeightCell := 28 :nHeightHead := 32 :nHeightFooter := 32 nHoles := :SetNoHoles(2, .F.) // в низу планируем дырку в 2-а пиксела между строками и Footer (это сглаживание на разных мониторах), помогает избежать "залипания" nH1 := int(nHoles)/2) ; nH2 := nHoles - nH1 nHeaderAll := :nHeightHead+nH1 nFooterAll := :nHeightFoot+nH2 и эти данные исп. для всех тсб, без применения :SetNoHoles(...), т.е. :nHeightHead := nHeaderAll :nHeightFoot := nFooterAll Можно сразу в др. тсб брать данные с первого в группе, т.е. :nHeightCell := oBrw1:nHeightCell :nHeightHead := oBrw1:nHeightHead :nHeightFoot := oBrw1:nHeightFoot ... и т.д. Если есть SuperHeader и SpecHeader, то вкл. и их в расчет, если надо (они тоже должны иметь одинаковую высоту на всех тсб) Делаем все это перед END TBROWSE
Haz: SergKis пишет: Делаем все это перед END TBROWSE Так и делаю. Только приходится все же с фиксированной высотой . как уже говорил бровсов много на экране. И все должны быть одинаковы. В каждом есть хидер и суперхидер, все по 22 пикселя. Строки тоже 22. Есть в самом низу бровс на оду строку. Если автоматом выравнивать высоты хидеров и футеров , то невозможно соблюсти строгую эдентичность всего. Чтобы на разных разрешениях был почти одинаковый вид, играю высотой верхних (самых толстых) бровсов. Суперхидер нужен как визуальное разделение таблиц, это как титлебар у окна. В общем как не пробовал setnoholes тут только мешает, т.к. если идти от нижнего однострочного то там все предельно просто. Высота 66 ( 22 супер + 22 хидер + 22 строка ) . Значит и у остальных все по 22 и подбирать высоту нечем. Единственное что напрягало так это залипание на определенных совпадениях размеров и разрешения. Пока не решил вопрос с помощью display().
SergKis: Haz пишет Единственное что напрягало так это залипание на определенных совпадениях размеров и разрешения. Пока не решил вопрос с помощью display() :Display() сбросил и пересчитал все размеры прорисовки сначала. "Залипание" может остаться и где то проявиться, обратил внимание, что при повторных прорисовках, координаты могут "поплыть" на 1 пиксел (возможно это в моей версии тсб, которая 7.0-9.0). Для всех тсб оставляю в низу по 2 пиксела. Вариант расчета нескольких тсб[pre2] DEFINE FONT "FontNorm" ... DEFINE FONT "FontBold" ... nLineCell := 1 nLineHead := 2 nLineFoot := 1 nHeightCell := GetFontHeight("FontNorm")*nLineCell+4 nHeightHead := GetFontHeight("FontBold")*nLineHead+4 nHeightFoot := GetFontHeight("FontBold")*nLineFoot+4 ... DEFINE TBROWSE oBrw1 AT y,x WIDTH w HEIGHT h CELL ; ... :nHeightCell := nHeightCell :nHeightHead := nHeightHead :nHeightFoot := nHeightFoot nHole := :SetNoHoles(0, .F.) IF nHole <= 2 // плановая "дырка" :nHeightHead -= 1 :nHeightFoot -= 1 ENDIF nHole := :SetNoHoles(2, .F.) nH2 := int(nHole/2) nH1 := nHole - nH2 :nHeightHead += nH1 :nHeightFoot += nH2 ... END TBROWSE ON END {|ob| ob:Refresh() } ... DEFINE TBROWSE oBrw2 AT y,x WIDTH w HEIGHT h CELL ; ... :nHeightCell := oBrw1:nHeightCell :nHeightHead := oBrw1:nHeightHead :nHeightFoot := oBrw1:nHeightFoot ... END TBROWSE ON END {|ob| ob:Refresh() } ... DEFINE TBROWSE oBrw3 AT y,x WIDTH w HEIGHT h CELL ; ... :nHeightCell := oBrw1:nHeightCell :nHeightHead := oBrw1:nHeightHead :nHeightFoot := oBrw1:nHeightFoot ... END TBROWSE ON END {|ob| ob:Refresh() } ... [/pre2] Если их у тебя 6, по 3 в ряд, то на 4-м тсб можно повторить расчет, как на тсб1 и уже след. тсб делать от него PS Помнится, на форуме, кто то говорил, что 2 пиксела дырки не исправило "залипание" и исп. 3 пиксела или 4. У меня хватает 2-х
Haz: SergKis пишет: "Залипание" может остаться и где то проявиться, обратил внимание, что при повторных прорисовках, координаты могут "поплыть" Твой алгоритм понятен, спасибо. Сегодня прогоню тест ( в цикле буду менять размер окна по высоте на котором все живет ) если словлю залипуху придётся колдовать с этой дырой.
SergKis: Haz пишет если словлю залипуху придётся колдовать с этой дырой. На твоем PC все может быть ok! У клиента может вылезти залипание, у него могут быть др. характеристики монитора
SergKis: Haz пишет Сегодня прогоню тест ( в цикле буду менять размер окна по высоте на котором все живет ) если словлю залипуху придётся колдовать с этой дырой. Игорь, чем закончилось тестирование ? С дырой или без ?
Haz: SergKis пишет: чем закончилось тестирование ? С дырой или без ? Сергей привет, при прогоне теста, что с дырой, что без залипух не выявил. В цикле менял размеры окна по 3 пикселя в плюс и в минус. После чего рисовал бровс, так же менял по 1 пикселю высоту строки бровса в обе стороны. И с дырой и без залипух не было. Погонял через RDP тоже оба работают. Два дня назад без дыры поставил пользователям один активный проект т (человек 50 там одновременно сидят ) пока все молчат. Короче наблюдаю. Мнение такое , на простых интерфейсах с дырой однозначно, на строгих, где на экране таблиц много то без дыры.
SergKis: Haz пишет И с дырой и без залипух не было. Если ты делал длинный скроллинг вверх, вниз при этом на разных тсб окна, то результат радует, версия 9.0 стабильно рисует
Haz: SergKis пишет: Если ты делал длинный скроллинг вверх, вниз при этом на разных тсб окна, то результат радует, версия 9.0 стабильно рисует сегодня еще раз погоняю и отпишусь
Haz: Haz пишет: сегодня еще раз погоняю и отпишусь Устал гонять , никак специально не удаётся выйти на залипуху, если только все поменять и refresh (f) сделать. Но так и понятно, что мусор остается . Могу сюда тестовый пример сбросить.
SergKis: Haz пишет: Устал гонять , никак специально не удаётся выйти на залипуху Так это хорошо, обычно залип проявлялся на скроллах при длительном удержании стрелки вверх или вниз, а так же Pgdn, Pgup, т.е. постоянная прорисовка области тсб. Могу сюда тестовый пример сбросить Брось, может у кого и вылезет чего.
Dima: SergKis пишет: Брось, может у кого и вылезет чего. +1 Тоже чекну когда время будет. Желательно +собранный EXE
Haz: SergKis пишет: Брось, может у кого и вылезет чего. чуть не забыл [pre2] #include "minigui.ch" #include "TSBrowse.ch" static oBrw static lGo := .f. static lUp := .t. PROCEDURE Main local oWnd, hWnd SET OOP ON DEFINE WINDOW Form_0 ; TITLE "TsBrowse hole test " ; MAIN ; NOMAXIMIZE NOSIZE DEFINE STATUSBAR STATUSITEM "Item 1" WIDTH 0 FONTCOLOR BLACK STATUSITEM "Item 2" WIDTH 230 FONTCOLOR BLACK DATE CLOCK KEYBOARD END STATUSBAR oWnd := ThisWindow.Object hWnd := oWnd:Handle() WITH OBJECT This.Object :Event( 1, {|w| NIL } ) :Event( 2, {|w| NIL } ) :Event( 4, {|w| nil } ) :Event( 5, {|w| nil } ) :Event( 6, {|w| nil } ) END WITH END WINDOW oBrw := CreateBrowse( oWnd ) // Специально за END BROWSE oBrw:nHeightCell := 22 oBrw:nHeightHead := 22 DEFINE LABEL Label_1 PARENT Form_0 ROW 5 COL 5 WIDTH 80 HEIGHT 16 FONTNAME 'Arial' FONTSIZE 9 FONTBOLD .F. VALUE "nHeightCell" END LABEL DEFINE SPINNER Spinner_1 PARENT Form_0 ROW 22 COL 2 WIDTH 80 HEIGHT 20 RANGEMIN 10 RANGEMAX 100 VALUE 22 FONTNAME 'Arial' FONTSIZE 9 TOOLTIP '' WRAP .T. ON CHANGE {|| oBrw:nHeightCell := this.value, SecondFunc(oBrw) } END SPINNER DEFINE LABEL Label_2 PARENT Form_0 ROW 5 COL 90 WIDTH 80 HEIGHT 16 FONTNAME 'Arial' FONTSIZE 9 FONTBOLD .F. VALUE "nHeightHead" END LABEL DEFINE SPINNER Spinner_2 PARENT Form_0 ROW 22 COL 90 WIDTH 80 HEIGHT 20 RANGEMIN 10 RANGEMAX 100 VALUE 22 FONTNAME 'Arial' FONTSIZE 9 TOOLTIP '' WRAP .T. ON CHANGE {|| oBrw:nHeightHead := this.value, SecondFunc(oBrw) } END SPINNER DEFINE BUTTONEX Button_Go PARENT Form_0 ROW 12 COL 180 WIDTH 100 HEIGHT 30 ACTION {|| Go() } CAPTION "Старт" PICTURE "" TABSTOP .F. TOOLTIP "" FONTNAME "Arial" FONTSIZE 8 VERTICAL FALSE FLAT TRUE END BUTTONEX DEFINE BUTTONEX Button_Stop PARENT Form_0 ROW 12 COL 290 WIDTH 100 HEIGHT 30 ACTION {|| lGo := .f. } CAPTION "Стоп" PICTURE "" TABSTOP .F. TOOLTIP "" FONTNAME "Arial" FONTSIZE 8 VERTICAL FALSE FLAT TRUE END BUTTONEX Form_0.Activate RETURN FUNCTION SecondFunc(oBrw) oBrw:Refresh(.t.) RETURN NIL FUNCTION Go() lGo := .t. While lGo iF lUp oBrw:GoDown() lUp := !obrw:lHitBottom else oBrw:GoUp() lUp := obrw:lHitTop end doEvents() end Return Nil FUNCTION CreateBrowse( oWnd ) LOCAL i LOCAL aDatos := {} FOR i := 1 TO 1000 AAdd( aDatos, { i, RandStr( 30 ), Date() - i, if( i % 2 == 0, TRUE, FALSE ) } ) NEXT if isControlDefined( "oBrw", "Form_0" ) doMethod( "Form_0" , "oBrw", "Release") end DEFINE TBROWSE oBrw AT 45, 2 ; OF Form_0 ; WIDTH oWnd:ClientWidth() - 4 ; HEIGHT oWnd:ClientHeight() - GetProperty( "Form_0", "StatusBar", "Height" ) - 47 ; GRID ; SELECTOR TRUE; FONT "Arial" SIZE 12 oBrw:SetArray( aDatos, .T. ) oBrw:nWheelLines := 1 oBrw:nClrLine := COLOR_GRID oBrw:lNoChangeOrd := TRUE oBrw:lCellBrw := TRUE oBrw:lNoVScroll := TRUE oBrw:hBrush := CreateSolidBrush( 242, 245, 204 ) // prepare for showing of Double cursor AEval( oBrw:aColumns, {| oCol| oCol:lFixLite := oCol:lEdit := TRUE } ) // assignment of column's names oBrw:aColumns[ 1 ]:cName := "NUMBER" oBrw:aColumns[ 2 ]:cName := "TEXT" oBrw:aColumns[ 3 ]:cName := "DATE" oBrw:aColumns[ 4 ]:cName := "LOGIC" // the reference to columns by names oBrw:SetColSize( "NUMBER", 100 ) oBrw:SetColSize( "TEXT", 500 ) oBrw:SetColSize( "DATE", 200 ) // Checking the method nColumn() oBrw:SetColSize( oBrw:nColumn( "LOGIC" ), 300 ) oBrw:GetColumn( 'NUMBER' ):nAlign := DT_CENTER oBrw:GetColumn( 'TEXT' ):nAlign := DT_LEFT oBrw:GetColumn( 'DATE' ):nAlign := DT_CENTER oBrw:GetColumn( 'LOGIC' ):nAlign := DT_CENTER oBrw:SetColor( { 1 }, { RGB( 0, 12, 120 ) } ) oBrw:SetColor( { 2 }, { RGB( 242, 245, 204 ) } ) oBrw:SetColor( { 5 }, { RGB( 0, 0, 0 ) } ) oBrw:SetColor( { 6 }, { {|a, b, c| IF( c:nCell == b, { RGB( 66, 255, 236 ), RGB( 111, 183, 155 ) }, ; { RGB( 255, 255, 255 ), RGB( 200, 200, 200 ) } ) } } ) // cursor backcolor END TBROWSE RETURN oBrw FUNCTION RandStr( nLen ) LOCAL cSet := "qwertyuiopasdfghjklzxcvbnmQWERTYUIOPASDFGHJKLZXCVBNM" LOCAL cPass := "" LOCAL i := 0 FOR i := 1 TO nLen cPass += SubStr( cSet, Random( 52 ), 1 ) NEXT RETURN cPass [/pre2]
Haz: Dima пишет: Тоже чекну когда время будет. Желательно +собранный EXE https://drive.google.com/file/d/11tJqfBppxkPjJwsKvVEcGige6PYExkxR/view?usp=sharing
Andrey: Haz пишет: чуть не забыл А внизу ТСБ при старте дырка должна быть или нет ? И вопрос ещё такой - можно ли в колонку последнюю "виртуальную" что то записать ?
Dima: Поймал вот :) Смотрим что имеем в нижней строке Колесиком мышки так получилось Andrey пишет: А внизу ТСБ при старте дырка должна быть или нет ? У мну есть
Haz: Andrey пишет: А внизу ТСБ при старте дырка должна быть или нет как повезет , никаких противодырочых мер в коде не прописано Можно использовать SetNoHoles для получения дыры, и изменять какую либо из высот. Но вопрос был не в дырке , а поймать залипшую строку. как не пытался , не смог. Дима везунчик )) Andrey пишет: И вопрос ещё такой - можно ли в колонку последнюю "виртуальную" что то записать ? нет, это не виртуальная колонка а продолжение фона бровса. Можно конечно подумать чтоб линии сетки там не рисовались
Haz: Dima пишет: Поймал вот :) а тут поймаешь ? https://drive.google.com/file/d/1n5wpp640ryVmHUc3JdQ30Eu1bnrf_keY/view?usp=sharing
Dima: Haz пишет: а тут поймаешь ? Да поймал ,на похожей ситуации
Dima: А еще вот так вот поймал
Haz: Dima пишет: А еще вот так вот поймал как ты то делаешь ?
SergKis: Dima пишет: Затем меняю высоту заголовка (произвольно) и тыкаю мышкой посередине бровса и начинаю скролить колесом мышки. Для тсб это заведомо аварийная ситуация. По мне, нельзя менять на лету высоты строк и заголовков, т.к. нарушается расчет всей сетки, что рано или поздно приведет к сбою. Высоты надо определять до END TBROWSE и во время работы не трогать, можно поправить за счет дырки, не вылезая за пределы размеров клиентской обл. тсб. В примере после смены высот, надо разрушать и создавать новый тсб. или на main задавать высоты, на след. окне строить тсб
Andrey: Haz пишет: как повезет , никаких противодырочых мер в коде не прописано Можно использовать SetNoHoles для получения дыры, и изменять какую либо из высот У меня при старте стразу дырка внизу.
SergKis: Andrey пишет У меня при старте стразу дырка внизу. Haz пишет: никаких противодырочых мер в коде не прописано сделай[pre2] oBrw := CreateBrowse( oWnd ) // Специально за END BROWSE // oBrw:nHeightCell := 22 // oBrw:nHeightHead := 22 ... oBrw:lNoVScroll := TRUE oBrw:hBrush := CreateSolidBrush( 242, 245, 204 ) oBrw:lNoHScroll := TRUE oBrw:nHeightCell := 22 oBrw:nHeightHead := 22 ... [/pre2] в тсб поставь в спинер высоту строки 20 и дырки, наверно, не будет (или подбери число). Но если будет сетка не в размер клиентской области, скорее всего, будет затык отображения
Haz: SergKis пишет: в тсб поставь в спинер высоту строки 20 и дырки, наверно, не будет (или подбери число). Но если будет сетка не в размер клиентской области, скорее всего, будет затык отображения Задолбался гонять , конечно при определенных значениях высот есть дырка , но мне она не важна. Меняя высоты эта дырка меняет размеры от 0 до nHeightCell , но все корректно отображается. Из того, что показал Дима ну никак не получить. Тестирую на свежей Win10 за 3 дня так и не поймал артефакты на экране. Затеял все это как раз с целью отказаться в одном из проектов от использования :SetNoHoles() по причине требования соблюдения строгости высот в нескольких таблицах на одном экране. Если , как ты предлагал, использовать SetNoHoles в первом бровсе, а в остальных брать рассчитанные параметры высот, то первый будет без дыры, остальные дырявые ( смысл использования теряется ). Если использовать во всех, то все таблицы будут с разными высотами. вот пример одного не очень нагруженного экрана https://i.postimg.cc/PxW7ZHm5/Image-1.png все суперхидеры должны быть одинаковой высоты, все строки, заголовки , подвалы тоже PS поймал )))) на ситуации когда nHole == nHeightCell -1 теперь есть где искать лекарство
Haz: Haz пишет: PS поймал )))) на ситуации когда nHole == nHeightCell -1 у меня это nHeightCell == 20 , nHeightHead == 13 => nHole = 19 и при вниз-вверх залипуха теперь есть где искать лекарство в общем все оказалось просто COUNTROWS() не учитывает что после прорисовки нижней строки нужно место для GridLine. простое добавление пикселя под эту линию проблему залипухи решило. [pre2] HB_FUNC( COUNTROWS ) // ( hWnd, nHeightCell, nHeightHead, nHeightFoot, nHeightSuper, nHeightSpec ) -> nRows { HWND hWnd = ( HWND ) HB_PARNL( 1 ); int iCell = hb_parni( 2 ); int iHead = hb_parni( 3 ); int iFoot = hb_parni( 4 ); int iSupH = hb_parni( 5 ); int iSpcH = hb_parni( 6 ); RECT rct; int iRows, iFree; GetClientRect( hWnd, &rct ); iFree = rct.bottom - rct.top + 1 - iSupH - iHead - iFoot - iSpcH - 1; iRows = iFree / iCell; hb_retni( iRows ); } [/pre2] Дима , поймаешь ?? https://drive.google.com/file/d/11tJqfBppxkPjJwsKvVEcGige6PYExkxR/view?usp=sharing PS проверил. -1 работает правильно при любых заченияз oBrw:nLineStyle
Haz: SergKis пишет: Для тсб это заведомо аварийная ситуация. По мне, нельзя менять на лету высоты строк и заголовков, т.к. нарушается расчет всей сетки, что рано или поздно приведет к сбою. Высоты надо определять до END Сергей, все корректно меняется на лету, даже во время включённого автотеста. в примере поставил [pre2] FUNCTION SecondFunc(oBrw) oBrw:lRePaint := .T.; oBrw:Display(); oBrw:ResetVScroll() oBrw:Refresh(.t.) RETURN NIL [/pre2]
SergKis: Haz пишет в примере поставил FUNCTION SecondFunc(oBrw) oBrw:lRePaint := .T.; oBrw:Display(); oBrw:ResetVScroll() oBrw:Refresh(.t.) RETURN NIL Про эти команды я уже говорил, ты сбросил расчет прорисовки и сделал новый, повторил по сути команду END TBROWSE. т.е. делать[pre2] oBrw := CreateBrowse( oWnd ) // Специально за END BROWSE oBrw:nHeightCell := 22 oBrw:nHeightHead := 22 ... oBrw:lRePaint := .T.; oBrw:Display(); oBrw:ResetVScroll(); oBrw:Refresh(.t.) [/pre2] несколько бессмысленно, т.к. повторили END TBROWSE, почему не сделать это до нее. В этом примере да, а в реальных тсб такой необходимости не испытывал, хватало размеры ставить до END Если , как ты предлагал, использовать SetNoHoles в первом бровсе, а в остальных брать рассчитанные параметры высот, то первый будет без дыры, остальные дырявые ( смысл использования теряется ). Ты не понял. :SetNoHoles(, .F.) ничего не меняет, дырку не убирает, а возвращает значение этой дырки и ты сам, если надо, раскидываешь ее по заголовкам, получая конкретные значения высот (с дыркой или нет без разницы). Потом, задавая данные высот в др. тсб (одинаковых по высоте) с первого тсб, ты получишь на тсб, например, расположенных вряд горизонтально ровные границы заголовков и строк. Даже если в первом тсб сделать :SetNoHoles(, .T.), убрать дырку и разнести данные высот в др. тсб без выполнения :SetNoHoles() в них, будет тот же результат - высоты заголовков и строк будут одинаковы, т.е. как ты и хотел изначально. в общем все оказалось просто COUNTROWS() не учитывает что после прорисовки нижней строки нужно место для GridLine. простое добавление пикселя под эту линию проблему залипухи решило. Это хорошая новость, буду смотреть в своей 7.0 версии. Знаю только, что у меня 1-го пикселя не хватало, т.е. дырка-резерв в 1 пиксел не спасала от залипух, а два пикселя помогли от них избавиться
SergKis: Haz пишет лучше так проверь Игорь, спасибо, но как говорит один герой, "Торопиться не будем" Надо подумать, как все организовать, что бы не сломать что есть. У меня практически все тсб с Footer и колонкой # и наличие 2 пиксела дырки, визуально дает неплохой вид границы между строками и подвалом, есть смысл подумать, а надо ли Это скорее в тсб 9.0 надо довести до ума, что бы было
SergKis: Haz пишет по моему она лишняя при вычислении области скрола Не могу сказать, что это строка лишняя, она - это наша дырка, я так понимаю, т.к. скролл делается по строкам, без учета дырки. Т.е. если nHeightCell := 20, то имеем значение от 0-19, которые не участвуют в скролле УПС, куда пост делсяааааааа
Haz: Вобщем разобрался, число строк считается некорректно смотрим исходник CountRows() [pre2] HB_FUNC( COUNTROWS ) // ( hWnd, nHeightCell, nHeightHead, nHeightFoot, nHeightSuper, nHeightSpec ) -> nRows { HWND hWnd = ( HWND ) HB_PARNL( 1 ); int iCell = hb_parni( 2 ); int iHead = hb_parni( 3 ); int iFoot = hb_parni( 4 ); int iSupH = hb_parni( 5 ); int iSpcH = hb_parni( 6 ); RECT rct; int iRows, iFree; GetClientRect( hWnd, &rct ); iFree = rct.bottom - rct.top + 1 - iSupH - iHead - iFoot - iSpcH ; iRows = iFree / iCell; hb_retni( iRows ); } [/pre2] Начнем с того что GetClientRect( hWnd, &rct ) возвращает структуру где nTop и nLeft равны нулю и соонветственно nRight и nBottom содержат ШИРИНУ и ВЫСОТУ ( а не координаты Right и Bottom ) ВОТ ТУТ И ЕСТЬ ОШИБКА теперь пройдемся по алгоритму с исходными данными oBrw:nHeightCell == 1 oBrw:nHeightHead == 1 oBrw:nHeightFoot == 1 oBrw:nHeightSuper == 1 oBrw:nHeightSpec == 1 oBrw:nTop == 1 oBrw:nBottom == 6 то есть бровс занимает на экране строки с 1 по 6 ( всего 6 ) и из них 1) заголовки == 3 2) подвал == 1 3) данные == 2 идем по алгоритму GetClientRect( hWnd, &rct ) заполнит структуру значениями rct.top == 0 rct.left == 0 rct.right == ширина бровсв ( тут ширина бровса а не координата oBrw:nRight не интересна здесь ) !!!!!! rct.bottom == 6 ( тут высота бровса , а не координата oBrw:nBottom ) !!!!!!! далее iFree = rct.bottom - rct.top + 1 - iSupH - iHead - iFoot - iSpcH iFree = 6 - 0 +1 - 1 -1 -1 -1 iFree = 3 ЭТО НЕПРАВИЛЬНО должно быть 2 Автор забыл, что GetClientRect() возвращает размеры а не координаты и начал эти размеры высчитывать думая что в структуре rct вернулись координаты правильно будет так iFree = rct.bottom - iSupH - iHead - iFoot - iSpcH ( без + 1 и rct.top ) а мы тут всей толпой дырки ищем
Haz: SergKis пишет: УПС, куда пост делсяааааааа Серега, прости. Просто начал разбираться и эти посты стали лишними здесь
SergKis: Haz пишет правильно будет так iFree = rct.bottom - iSupH - iHead - iFoot - iSpcH ( без + 1 и rct.top ) В записи исходной iFree = rct.bottom - rct.top + 1 - iSupH - iHead - iFoot - iSpcH у меня вопросов не особо возникает, т.к. rct.top всегда 0, rct.bottom - высота в пикселях кл. части рабочей - iSupH - iHead - iFoot - iSpcH тоже понятно, вычли все высоты заголовков и в iFree получили остаток на все строки, т.е iRows = iFree / iCell дает кол-во строк. Что такое +1 пиксел, может подразумевалось место под нижнюю линию, но тогда скорее надо было отнять 1 пиксел. Может +1 это учет того, что высоты строк не с 0, а с 1 начинаются ? Не знаю что сказать ?!
Haz: SergKis пишет: Что такое +1 пиксел, может подразумевалось место под нижнюю линию, но тогда скорее надо было отнять 1 пиксел. Может +1 это учет того, что высоты строк не с 0, а с 1 начинаются ? Не знаю что сказать ?! +1 нужно если использовать GetWindowRect() - тогда вернуться координаты 1 nTop и 6 nBottom тогда всего строк считается nBotton - nTop + 1 или 6 - 1 + 1 = 6 там тупо пиксели окна высчитываются и имеет место быть опечатка или ошибка, автор спутал Client/Window Rect попутно проверил на дыре, на базе CountRows() написал HoleSize() [pre2] HB_FUNC( HOLESIZE ) // ( hWnd, nHeightCell, nHeightHead, nHeightFoot, nHeightSuper, nHeightSpec ) -> nRows { HWND hWnd = ( HWND ) HB_PARNL( 1 ); int iCell = hb_parni( 2 ); int iHead = hb_parni( 3 ); int iFoot = hb_parni( 4 ); int iSupH = hb_parni( 5 ); int iSpcH = hb_parni( 6 ); RECT rct; int iRows, iFree; GetClientRect( hWnd, &rct ); iFree = rct.bottom - iSupH - iHead - iFoot - iSpcH ; iRows = iFree / iCell; iRows = iFree - iRows * iCell; hb_retni( iRows ); } [/pre2] сравни с тем что я написал выше : правильно будет так iFree = rct.bottom - iSupH - iHead - iFoot - iSpcH ( без + 1 и rct.top ) в таком варианте HoleSize() возвращает тоже самое что и :SetNoholes(,.F.) а если в HoleSize() поставить как в исходной Countrows() iFree = rct.bottom - rct.top + 1 - iSupH - iHead - iFoot - iSpcH то вернет на 1 меньше ( это тот пиксель который ты искал )
SergKis: Haz пишет имеет место быть опечатка или ошибка Как идет вывод строки и линий в TSDrawCell ? Линия прорисовывается с одной стороны строки или с обоих (по горизонтали) или работает обводка ячейки ? Ты уже вник в тему, а я подзабыл уже.
Haz: SergKis пишет: Как идет вывод строки и линий в TSDrawCell ? внутрь ячейки то есть высота nHeightCell уже с линиями
SergKis: Haz пишет внутрь ячейки то есть высота nHeightCell уже с линиями Тогда твоя трактовка и правка кода правильная Но она может привести к искажениям, в текущих, набранных тсб. Т.к. появится лишний пиксел. Не врубаюсь хорошо это или не очень
Haz: SergKis пишет: Но она может привести к искажениям, в текущих, набранных тсб. не приведёт если есть setnoholes() тк он правильно считает
Haz: Haz пишет: Но она может привести к искажениям, в текущих, набранных тсб. Т.к. появится лишний пиксел. Не врубаюсь хорошо это или не очень Тут разница в том что в текущем алгоритме при определенном размере дыры добавлялась лишняя строка при nHole = nHeightCell -1 отсюда и залипон , тк при скроллировании окна про эту строку не знали
SergKis: Haz пишет Тут разница в том что в текущем алгоритме при определенном размере дыры добавлялась лишняя строка при nHole = nHeightCell -1 отсюда и залипон , тк при скроллировании окна про эту строку не знали Игорь, все очень похоже на правду и нашелся прыгающий пиксель, приводящий к лишней скрытой строке и залипону в конечном результате, но у меня на сегодня отрубилась башка, я как тот Колобок из мультика "Ничего не понимаю" Завтра и в понедельник надо закрыть тему, только потом могу вернуться к тек. версии hmg. В своей, наверно, C код трогать не буду. Потом в тек. внесу твои правки и погоняю примеры и варианты, что есть.
SergKis: SergKis пишет В записи исходной iFree = rct.bottom - rct.top + 1 - iSupH - iHead - iFoot - iSpcH у меня вопросов не особо возникает, ... Возник вопрос с утра пораньше, где тут учитывается наличие или отсутствие HScroll ?
Haz: SergKis пишет: Возник вопрос с утра пораньше, где тут учитывается наличие или отсутствие HScroll ? скрол это дочернее окно в oBrw:hWnd ( свойство oBrw:hWnd ) и следовательно GetClientRect() его учитывает автоматически.
Haz: Haz пишет: отсюда и залипон , тк при скроллировании окна про эту строку не знали Это следствие разных алгоритмов расчёта одного и того же. Обе функции Countrows() и TSBScroll() считают размеры, но по разному. В идеале их подружить нужно TSBScroll() должна зависеть от Countrows() Или делать отдельную функцию, которая вернет структуру с размерами - количество строк, размер дыры.
SergKis: Haz пишет Или делать отдельную функцию, которая вернет структуру с размерами - количество строк, размер дыры Или оставить все как есть, т.к. "знаем где собака порылась" и как выправлять
Dima: Haz пишет: цитата: как ты то делаешь ? Примерно так. Ставим курсор на самую последнюю видимую строку. У меня при старте помещается 33 , вот на нее и ставил. Затем меняю высоту заголовка (произвольно) и тыкаю мышкой посередине бровса и начинаю скролить колесом мышки. Иногда высоту достаточно менять до тех пор , пока бах и не пропал неактивный курсор бровса. Тогда снова тыкаем в середину бровса и скролим колесом ЗЫ Попробуй отключить горизонтальный скрол ЗЫ2 Я срочно уезжал под Киев клиника Lisod , но вернулись обратно так как там цирк и клоуны , поэтому раньше не ответил
Haz: Dima пишет: Примерно так. Ставим курсор на самую последнюю видимую строку. Дим , спасибо за подсказку. Проблема найдена, расчёт количества строк в текущей редакции tsb некорректен. если есть желание, могу ехе скинуть. https://drive.google.com/file/d/1iaeKkHhhUiwnADoHQvbRJldnQQMeyNQd/view?usp=sharing
Dima: Haz пишет: Проблема найдена Счас заценю
Dima: Тестить долго не пришлось , обкатал по той же схеме. Все равно есть какой то косяк
Haz: Dima пишет: Тестить долго не пришлось , обкатал по той же схеме. Все равно есть какой то косяк Уточню схему , нужно подобрать nHole == 0 и выделив последнюю строку изменить размер заголовка на +1 Это несколько другой глюк, хотя визуально такой же. RowCount считает 32 правильно, а залипла 33 . То что пропадал неактивный курсор говорит о том , что он вне зоны видимости бровса Возникает ситуация когда nRowPos > nRowCount() то есть при изменении высоты заголовка, меняется nRowCount() и текущая строка оказывается за зоной видимости. Потом Refresh ее прорисовывает в старом значении nRowPos. Это как раз та ситуация о которой писал Сергей ( губительна для бровса ), это следствие не полной проработки смены высот в SecundFunc() этого примера [pre2] FUNCTION SecondFunc(oBrw) oBrw:lRePaint := .T.; oBrw:Display(); oBrw:ResetVScroll() oBrw:Refresh(.t.) if lReady SetProperty("Form_0", "Label_3", "Value", "nHole = " + hb_ntoc( GetHole(oBrw:hWnd, oBrw:nHeightCell, oBrw:nHeightHead, oBrw:nHeightFoot, oBrw:nHeightSuper, 0)) + " RowCount = " + hb_ntoc(oBrw:nRowCount()) ) end RETURN NIL [/pre2] Видно что такие установки как :nAt , :nRowPos не меняются. Можно по простому в SecondFunc() делать сброс позиции или при придумать визуально красивый вариант сегодня сделаю вот на всякий последние исходники теста [pre2] #include "minigui.ch" #include "TSBrowse.ch" static oBrw static lGo := .f. static lUp := .t. static lReady := .F. PROCEDURE Main local oWnd, hWnd SET OOP ON DEFINE WINDOW Form_0 ; TITLE "TsBrowse hole test " ; MAIN ; NOMAXIMIZE NOSIZE DEFINE STATUSBAR STATUSITEM "Item 1" WIDTH 0 FONTCOLOR BLACK STATUSITEM "Item 2" WIDTH 230 FONTCOLOR BLACK DATE CLOCK KEYBOARD END STATUSBAR oWnd := ThisWindow.Object hWnd := oWnd:Handle() WITH OBJECT This.Object :Event( 1, {|w| NIL } ) :Event( 2, {|w| NIL } ) :Event( 4, {|w| nil } ) :Event( 5, {|w| nil } ) :Event( 6, {|w| nil } ) END WITH END WINDOW oBrw := CreateBrowse( oWnd ) // Специально за END BROWSE DEFINE LABEL Label_1 PARENT Form_0 ROW 5 COL 5 WIDTH 80 HEIGHT 16 FONTNAME 'Arial' FONTSIZE 9 FONTBOLD .F. VALUE "nHeightCell" END LABEL DEFINE SPINNER Spinner_1 PARENT Form_0 ROW 22 COL 2 WIDTH 80 HEIGHT 20 RANGEMIN 10 RANGEMAX 100 VALUE 22 FONTNAME 'Arial' FONTSIZE 9 TOOLTIP '' WRAP .T. ON CHANGE {|| oBrw:nHeightCell := this.value, SecondFunc(oBrw) } END SPINNER DEFINE LABEL Label_2 PARENT Form_0 ROW 5 COL 90 WIDTH 80 HEIGHT 16 FONTNAME 'Arial' FONTSIZE 9 FONTBOLD .F. VALUE "nHeightHead" END LABEL DEFINE SPINNER Spinner_2 PARENT Form_0 ROW 22 COL 90 WIDTH 80 HEIGHT 20 RANGEMIN 10 RANGEMAX 100 VALUE 22 FONTNAME 'Arial' FONTSIZE 9 TOOLTIP '' WRAP .T. ON CHANGE {|| oBrw:nHeightHead := this.value, SecondFunc(oBrw) } END SPINNER DEFINE BUTTONEX Button_Go PARENT Form_0 ROW 12 COL 180 WIDTH 100 HEIGHT 30 ACTION {|| Go() } CAPTION "Старт" PICTURE "" TABSTOP .F. TOOLTIP "" FONTNAME "Arial" FONTSIZE 8 VERTICAL FALSE FLAT TRUE END BUTTONEX DEFINE BUTTONEX Button_Stop PARENT Form_0 ROW 12 COL 290 WIDTH 100 HEIGHT 30 ACTION {|| lGo := .f. } CAPTION "Стоп" PICTURE "" TABSTOP .F. TOOLTIP "" FONTNAME "Arial" FONTSIZE 8 VERTICAL FALSE FLAT TRUE END BUTTONEX DEFINE LABEL Label_3 PARENT Form_0 ROW 25 COL 400 WIDTH 300 HEIGHT 16 FONTNAME 'Arial' FONTSIZE 9 FONTBOLD .F. VALUE "" END LABEL lReady := .T. Form_0.Activate RETURN FUNCTION SecondFunc(oBrw) oBrw:lRePaint := .T.; oBrw:Display(); oBrw:ResetVScroll() oBrw:Refresh(.t.) if lReady SetProperty("Form_0", "Label_3", "Value", "nHole = " + hb_ntoc( GetHole(oBrw:hWnd, oBrw:nHeightCell, oBrw:nHeightHead, oBrw:nHeightFoot, oBrw:nHeightSuper, 0)) + " RowCount = " + hb_ntoc(oBrw:nRowCount()) ) end RETURN NIL FUNCTION Go() lGo := .t. While lGo iF lUp oBrw:GoDown() lUp := !obrw:lHitBottom else oBrw:GoUp() lUp := obrw:lHitTop end doEvents() end Return Nil FUNCTION CreateBrowse( oWnd ) LOCAL i LOCAL aDatos := {} FOR i := 1 TO 1000 AAdd( aDatos, { i, RandStr( 30 ), Date() - i, if( i % 2 == 0, TRUE, FALSE ) } ) NEXT if isControlDefined( "oBrw", "Form_0" ) doMethod( "Form_0" , "oBrw", "Release") end DEFINE TBROWSE oBrw AT 45, 2 ; OF Form_0 ; WIDTH oWnd:ClientWidth() - 4 ; HEIGHT oWnd:ClientHeight() - GetProperty( "Form_0", "StatusBar", "Height" ) - 47 ; GRID ; SELECTOR TRUE; FONT "Arial" SIZE 12 oBrw:SetArray( aDatos, .T. ) oBrw:nWheelLines := 1 oBrw:nClrLine := COLOR_GRID oBrw:lNoChangeOrd := TRUE oBrw:lCellBrw := TRUE oBrw:hBrush := CreateSolidBrush( 242, 245, 204 ) oBrw:lNoVScroll := TRUE oBrw:nHeightCell := 20 oBrw:nHeightHead := 13 oBrw:nLineStyle := 6 // prepare for showing of Double cursor AEval( oBrw:aColumns, {| oCol| oCol:lFixLite := oCol:lEdit := TRUE } ) // assignment of column's names oBrw:aColumns[ 1 ]:cName := "NUMBER" oBrw:aColumns[ 2 ]:cName := "TEXT" oBrw:aColumns[ 3 ]:cName := "DATE" oBrw:aColumns[ 4 ]:cName := "LOGIC" // the reference to columns by names oBrw:SetColSize( "NUMBER", 100 ) oBrw:SetColSize( "TEXT", 500 ) oBrw:SetColSize( "DATE", 200 ) // Checking the method nColumn() oBrw:SetColSize( oBrw:nColumn( "LOGIC" ), 300 ) oBrw:GetColumn( 'NUMBER' ):nAlign := DT_CENTER oBrw:GetColumn( 'TEXT' ):nAlign := DT_LEFT oBrw:GetColumn( 'DATE' ):nAlign := DT_CENTER oBrw:GetColumn( 'LOGIC' ):nAlign := DT_CENTER oBrw:SetColor( { 1 }, { RGB( 0, 12, 120 ) } ) oBrw:SetColor( { 2 }, { RGB( 242, 245, 204 ) } ) oBrw:SetColor( { 5 }, { RGB( 0, 0, 0 ) } ) oBrw:SetColor( { 6 }, { {|a, b, c| IF( c:nCell == b, { RGB( 66, 255, 236 ), RGB( 111, 183, 155 ) }, ; { RGB( 255, 255, 255 ), RGB( 200, 200, 200 ) } ) } } ) // cursor backcolor END TBROWSE RETURN oBrw FUNCTION RandStr( nLen ) LOCAL cSet := "qwertyuiopasdfghjklzxcvbnmQWERTYUIOPASDFGHJKLZXCVBNM" LOCAL cPass := "" LOCAL i := 0 FOR i := 1 TO nLen cPass += SubStr( cSet, Random( 52 ), 1 ) NEXT RETURN cPass [/pre2]
Haz: переписал SecondFunc() и проблема ушла [pre2] FUNCTION SecondFunc(oBrw) static nRowCount := 0 if oBrw:nRowCount() < nRowCount oBrw:GoUp() oBrw:GoDown() end nRowCount := oBrw:nRowCount() oBrw:lRePaint := .T.; oBrw:Display(); oBrw:ResetVScroll() oBrw:Refresh(.t.) if lReady SetProperty("Form_0", "Label_3", "Value", "nHole = " + hb_ntoc( GetHole(oBrw:hWnd, oBrw:nHeightCell, oBrw:nHeightHead, oBrw:nHeightFoot, oBrw:nHeightSuper, 0)) + " RowCount = " + hb_ntoc(oBrw:nRowCount()) ) end RETURN NIL [/pre2] ЗЫ переписал по быстрому , возможно не учел чего то, но это показывает что эта проблема в алгоритме кодера ( моем), а не внутри бровса https://drive.google.com/file/d/1c2iG97MQooyICzXe8BZfERzhzCfLNn6G/view?usp=sharing
Dima: Haz пишет: переписал SecondFunc() и проблема ушла Да теперь все хорошо
Haz: Dima пишет: Да теперь все хорошо Спасибо за помощь
SergKis: Haz пишет вот на всякий последние исходники теста Игорь, можешь забросить на ftp, что менял в TsBrowse и окончательный пример ? Похоже завтра (может и дальше) еще на опытной экспл. сдаваемого проекта, а выглядывать и выкусывать изменения с темы не хочется, скорее вытащу что то не так. Спасибо.
Haz: SergKis пишет: Игорь, можешь забросить на ftp, что менял в TsBrowse и окончательный пример ? у меня сейчас другой комп , учетка ftp затерялась Выложу сюда ссылку на архив со всеми изменениями и описанием
Haz: Haz пишет: Выложу сюда ссылку на архив со всеми изменениями и описанием Сергей все тут, в комплекте Readme.txt https://drive.google.com/file/d/1iniM62TywOa8JagiIquyt9OqmfUsCIMj/view?usp=sharing
SergKis: Haz Спасибо
SergKis: Haz пишет Сергей все тут, в комплекте Readme.txt Сделал правку, убрал только +1 iFree = rct.bottom - rct.top - iSupH - iHead - iFoot - iSpcH; Примеры работают нормально, затыков не выявил, но в них нет динамических изменений высот, у меня их нигде нет. Проверил, сделав правку, версию unicode то же. Пример "TsBrowse hole test " погонял, но не азартно, т.к. считаю этот режим экстремальным использованием тсб и клиенту не предложу, без особой надобности, скорее крайний случай. А с примером тоже все ok! В свою версию тсб 7.0, изменения вносить не буду, т.к. там добавлены свои сопли по борьбе с затыком отображения
gfilatov2002: SergKis пишет: Примеры работают нормально, затыков не выявил, но в них нет динамических изменений высот, у меня их нигде нет. Проверил, сделав правку, версию unicode то же. Благодарю за помощь У меня получились такие же результаты... Эта правка будет включена в 3-й апдейт сборки 21.07, которая выйдет завтра.
Haz: SergKis пишет: Сделал правку, убрал только +1 iFree = rct.bottom - rct.top - iSupH - iHead - iFoot - iSpcH; не принципиально, тк rct.top всегда == 0 Но если кто- то потом полезет в исходник , то в голове будет каша ( не ясно зачем минусуем ) У себя проекты все пересобрал с iFree = rct.bottom - iSupH - iHead - iFoot - iSpcH; полет нормальный
SergKis: Haz пишет Но если кто- то потом полезет в исходник , то в голове будет каша ( не ясно зачем минусуем ) Оставил rct.top т.к. без нее, когда смотрю, кажется чего то не хватает. Выше GetClientRect и понятно становится. Смотрел др. места с GetClientRect, в целом не складывается впечатление, что человек перепутал применение ф-ии, скорее ошибся с +1, т.к. есть места где играется +-1 в высотах, в тех же scroll. Без +1 точнее расчет в этом месте
Haz: SergKis пишет: что человек перепутал применение ф-ии, скорее ошибся с +1, Ну мы можем только гадать выискивая тут умысел этой +1 Возможно сначала было GetWindowRect() и тогда +1 оправдана, в бровсе 5 строк , начинается с 10 строки экрана и заканчивается на 14 ( 1=10, 2=11, 3=12,4=13, 5=14 ) , как узнать высоту всего бровса ? правильно, nBottom - nTop + 1 или 14 - 10 + 1 = 5 потом автор наткнулся на Hscroll и изменил на GetClientRect(). Я бы тоже не обратил внимание в таком случае на +1 , тк возвращаемая структура путает названиями nTop и nBottom, хотя в них уже совсем другие сущности. при GetClientRect() высоту считать не надо, она уже есть в nBottom, поэтому nBottom - nTop + 1 нужно заменить на nBottom есть места где играется +-1 в высотах но это не то место. Как посчитать сколько строк поместиться в окно бровса целиком ? Надо взять общую высоту и отнять все высоты занятые НЕ строками , результат поделить на высоту строки и выделить целое. все значения достоверно известны, играть тут нечем отдельно про Scroll. В окне бровса он реализуется вызовом ScrollWindowEx() , который меняет стиль окна и создает скролл в клиентской области ( уменьшая ее ) https://docs.microsoft.com/en-us/windows/win32/api/winuser/nf-winuser-scrollwindowex [pre2]HB_FUNC( TSBRWSCROLL ) { HWND hWnd = ( HWND ) HB_PARNL( 1 ); int iRows = hb_parni( 2 ); HFONT hFont = ( HFONT ) HB_PARNL( 3 ); int nHeightCell = hb_parni( 4 ); int nHeightHead = hb_parni( 5 ); int nHeightFoot = hb_parni( 6 ); int nHeightSuper = hb_parni( 7 ); int nHeightSpecHd = hb_parni( 8 ); HFONT hOldFont = NULL; HDC hDC = GetDC( hWnd ); RECT rct; if( hFont ) hOldFont = ( HFONT ) SelectObject( hDC, hFont ); GetClientRect( hWnd, &rct ); rct.top += ( nHeightHead + nHeightSuper - ( nHeightSuper ? 1 : 0 ) + nHeightSpecHd - ( nHeightSpecHd ? 1 : 0 ) ); // exclude heading from scrolling rct.bottom -= nHeightFoot; // exclude footing from scrolling rct.bottom -= ( ( rct.bottom - rct.top ) % nHeightCell ); // exclude unused portion at bottom if( iRows > 0 ) rct.bottom -= nHeightCell; else rct.top += nHeightCell; ScrollWindowEx( hWnd, 0, ( int ) -( nHeightCell * iRows ), 0, &rct, 0, 0, 0 ); if( hFont ) SelectObject( hDC, hOldFont ); ReleaseDC( hWnd, hDC ); } [/pre2] и кстати автор тут +1 не использует хотя видно что тексты копипастились скорее всего именно миграция c GetWindowRect() на GetClientRect() и была т.к. rct.top остался рудиментом
SergKis: Haz пишет Ну мы можем только гадать выискивая тут умысел этой +1 Согласен. кстати автор тут +1 не использует хотя видно что тексты копипастились но правка на -1 есть, хотя линии прорисовываются внутри, как выясняли rct.top += ( nHeightHead + nHeightSuper - ( nHeightSuper ? 1 : 0 ) + nHeightSpecHd - ( nHeightSpecHd ? 1 : 0 ) ); // exclude heading from scrolling для вычисления rct.bottom -= ( ( rct.bottom - rct.top ) % nHeightCell ); // exclude unused portion at bottom В COUNTROWS сейчас все по делу PS. Использовать в расчете rct.top скорее привычка, т.е. y := 0 ; h := This.ClientHeight - y * 2 // т.е. y := This.ClientRow ; x := This.ClientCol h -= GetWindowHeight(hSplit) ...
Andrey: Haz пишет: отдельно про Scroll. В окне бровса он реализуется вызовом ScrollWindowEx() А можно как то цвет этого поменять на свой ? А то серый не очень красиво смотрится....
Haz: Andrey пишет: А можно как то цвет этого поменять на свой ? Скорее всего можно [pre2] CLASS TSBScrlBar FROM TControl DATA lVertical, lReDraw, lIsChild, nMin, nMax, nPgStep DATA bGoUp, bGoDown, bGoTop, bGoBottom, bPageUp, bPageDown, bPos DATA bTrack DATA l32Bit DATA lShowDisabled, hWnd, oWnd DATA lUpdate AS LOGICAL // TControl DATA bWhen // TWindow DATA bValid // TWindow CLASSDATA aProperties INIT { "cVarName", "nMin", "nMax",; "nPgStep", "nTop", "nLeft", "Cargo" } METHOD New( nRow, nCol, nMin, nMax, nPgStep, lVertical, oWnd, nWidth, nHeight,; bUpAct, bDownAct, bPgUp, bPgDown, bPos, lPixel, nClrText,; nClrBack, cMsg, lUpdate, bWhen, bValid, lDesign ) CONSTRUCTOR METHOD WinNew( nMin, nMax, nPgStep, lVertical, oWnd, bUpAction,; bDownAction, bPgUp, bPgDown, bPos, nClrText, nClrBack,; lUpdate, bWhen, bValid ) CONSTRUCTOR [/pre2] и далее [pre2] nClrText := GetSysColor( COLOR_WINDOW ),; nClrBack := GetSysColor( COLOR_SCROLLBAR ),; [/pre2] но эти переменные нигде не используются ....
Haz: SergKis пишет: но правка на -1 есть Ты про это rct.top += ( nHeightHead + nHeightSuper - ( nHeightSuper ? 1 : 0 ) ... мож кто то объяснит тут синтаксис .... мне кажется это тоже самое hb_default(@nHeightSuper , 0) но будем считать разобрались, понаблюдаем за результатами, может кто сюда отпишет
SergKis: Haz пишет мож кто то объяснит тут синтаксис .... Это если есть nHeightSuper, т.е > 0, то будет -1, иначе 0, так же и с наличием SupHd, Для чего это, не понимаю. Т.к. Если для красоты (WScroll красиво вписывался в клиентскую область), то -1 сверху и с низу можно делать не зависимо от наличия SuperHd и SuperHeader, а та к как написано .. , я не понимаю почему
Haz: SergKis пишет: я не понимаю почему В такой постановке тоже не понимаю
Haz: Сергей Возник вопрос о координатe oCell:nRow из ::GetCellInfo() никак не пойму что не так в примере , почему не совпадает с ячейкой. Может не правильно метод использую ? Пример простой в бровсе по bPrevEdit стоит показ окна в координатах ячейки и потом отказ в редактировании. Окно открывается ниже чем нужно на величину ::nTop вот пример [pre2] #include "minigui.ch" #include "tsbrowse.ch" #include "common.ch" #include "hmg.ch" #include "i_winuser.ch" static oMain static hMain Func Main() SET OOP ON DEFINE WINDOW Form_0 ; AT 0,0 ; WIDTH GetDeskTopWidth() ; HEIGHT GetDesktopHeight() - GetTaskBarHeight() ; TITLE "Test ::CellInfo" ; MAIN ; ON INIT {|| nil } ; NOTIFYICON "CRANE" ; NOTIFYTOOLTIP "TestCell" ; oMain :=This.Object hMain := ThisWindow.Handle DEFINE STATUSBAR Font "ARIAL" SIZE 9 BOLD STATUSITEM '' WIDTH 100 ACTION Nil STATUSITEM '' WIDTH 150 ACTION Nil STATUSITEM '' ACTION Nil STATUSITEM '' WIDTH 80 ACTION Nil STATUSITEM '' WIDTH 400 ACTION Nil DATE CLOCK END STATUSBAR DEFINE SPLITBOX HANDLE hSpl DEFINE TOOLBAR ToolBar_1 CAPTION "" BUTTONSIZE 60,32 FLAT BUTTON 01 ; CAPTION 'Справочники' ; PICTURE 'NEWSUPLOAD16' ; BUTTON 02 ; CAPTION 'Портфель' ; PICTURE 'n2' ; WHOLEDROPDOWN SEPARATOR DEFINE DROPDOWN MENU BUTTON 02 ITEM "Моделирование" IMAGE 'factory16' ACTION _wPost(11) NAME 100 END MENU END TOOLBAR DEFINE TOOLBAR ToolBar_2 CAPTION "" BUTTONSIZE 42,32 FLAT BUTTON 99 CAPTION 'Выход' PICTURE 'exit' ACTION {|| oMain:Release()} END TOOLBAR END SPLITBOX This.Height := GetDeskTopHeight() - This.StatusBar.Height - GetBorderHeight() END WINDOW DoMethod("Form_0", "maximize") oBrw := CreateBrowse( oMain ) Form_0.Activate CUSTOMER->(dbClosearea()) Return nil FUNCTION CreateBrowse( oWnd ) LOCAL i LOCAL aDatos := {} FOR i := 1 TO 1000 AAdd( aDatos, { i, RandStr( 30 ), Date() - i, if( i % 2 == 0, TRUE, FALSE ) } ) NEXT if isControlDefined( "oBrw", "Form_0" ) doMethod( "Form_0" , "oBrw", "Release") end DEFINE TBROWSE oBrw AT 50, 2 ; OF Form_0 ; WIDTH oWnd:ClientWidth() - 4 ; HEIGHT oWnd:ClientHeight() - GetProperty( "Form_0", "StatusBar", "Height" ) - 52 ; GRID ; FONT "Arial" SIZE 12 oBrw:SetArray( aDatos, .T. ) oBrw:nWheelLines := 1 oBrw:nClrLine := COLOR_GRID oBrw:lNoChangeOrd := TRUE oBrw:lCellBrw := TRUE oBrw:hBrush := CreateSolidBrush( 242, 245, 204 ) oBrw:lNoVScroll := TRUE oBrw:nHeightCell := 22 oBrw:nHeightHead := 22 oBrw:nLineStyle := 6 // prepare for showing of Double cursor AEval( oBrw:aColumns, {| oCol| oCol:lFixLite := oCol:lEdit := TRUE , oCol:bPrevEdit := {|xVal, oBrw| PrevEdit(xVal, oBrw) }} ) // assignment of column's names oBrw:aColumns[ 1 ]:cName := "NUMBER" oBrw:aColumns[ 2 ]:cName := "TEXT" oBrw:aColumns[ 3 ]:cName := "DATE" oBrw:aColumns[ 4 ]:cName := "LOGIC" // the reference to columns by names oBrw:SetColSize( "NUMBER", 100 ) oBrw:SetColSize( "TEXT", 500 ) oBrw:SetColSize( "DATE", 200 ) // Checking the method nColumn() oBrw:SetColSize( oBrw:nColumn( "LOGIC" ), 300 ) oBrw:GetColumn( 'NUMBER' ):nAlign := DT_CENTER oBrw:GetColumn( 'TEXT' ):nAlign := DT_LEFT oBrw:GetColumn( 'DATE' ):nAlign := DT_CENTER oBrw:GetColumn( 'LOGIC' ):nAlign := DT_CENTER oBrw:SetColor( { 1 }, { RGB( 0, 12, 120 ) } ) oBrw:SetColor( { 2 }, { RGB( 242, 245, 204 ) } ) oBrw:SetColor( { 5 }, { RGB( 0, 0, 0 ) } ) oBrw:SetColor( { 6 }, { {|a, b, c| IF( c:nCell == b, { RGB( 66, 255, 236 ), RGB( 111, 183, 155 ) }, ; { RGB( 255, 255, 255 ), RGB( 200, 200, 200 ) } ) } } ) // cursor backcolor END TBROWSE RETURN oBrw FUNCTION RandStr( nLen ) LOCAL cSet := "qwertyuiopasdfghjklzxcvbnmQWERTYUIOPASDFGHJKLZXCVBNM" LOCAL cPass := "" LOCAL i := 0 FOR i := 1 TO nLen cPass += SubStr( cSet, Random( 52 ), 1 ) NEXT RETURN cPass Func PrevEdit(xVal, oBrw) LOCAL oCell LOCAL oWnd, hWnd LOCAL aRect := {0,0,0,0} GetWindowRect( oBrw:hWnd, aRect ) SET OOP ON oCell := oBrw:GetCellInfo(oBrw:nRowPos) DEFINE WINDOW Cell ; AT oCell:nRow + aRect[2] + 1 , oCell:nCol + aRect[1] +1 ; // aRect добавлено чтоб перейти в физические координаты , иначе при перемещении окна координаты не меняются WIDTH oCell:nWidth - 2 ; HEIGHT oCell:nHeight -2 ; NOCAPTION ; MODAL ; oWnd := ThisWindow.Object hWnd := oWnd:Handle() END WINDOW SetWindowLong(hWnd, GWL_STYLE, WS_BORDER) _DefineHotKey ( "CELL" , 0 , VK_ESCAPE , {|| oWnd:Release() } ) _DefineHotKey ( "CELL" , 0 , VK_RETURN , {|| oWnd:Release() } ) Cell.Activate oBrw:DrawSeLect() return .F. [/pre2] это смещение получается из ::GetcellInfo() [pre2] ix := GetControlIndex( cBrw, cForm ) IF _HMG_aControlContainerRow[ ix ] == -1 nRow += ::nTop - 1 nCol += ::nLeft ELSE nRow += _HMG_aControlRow[ ix ] - 1 nCol += _HMG_aControlCol[ ix ] ENDIF [/pre2]
SergKis: Haz пишет Может не правильно метод использую ? Так и есть. Твой пример, немного поправил (как я делаю) [pre2] #include "minigui.ch" #include "tsbrowse.ch" #include "common.ch" #include "hmg.ch" #include "i_winuser.ch" static oMain static hMain FUNCTION Main() LOCAL nBtnW, nBtnH, nEndW, oBrw SET DATE GERMAN SET OOP ON SET FONT TO "Arial", 12 // кнопки toolbar от размера фонта nBtnW := App.Object:W(1.5) nBtnH := App.Object:H1 + 16 + 2 // 16 - это размер по высоте bmp nEndW := App.Object:W(0.7) DEFINE WINDOW Form_0 AT 0,0 WIDTH Sys.ClientWidth HEIGHT Sys.ClientHeight ; TITLE "Test ::CellInfo" ; MAIN ; ON INIT NIL ; ON RELEASE dbCloseAll() ; NOTIFYICON "CRANE" ; NOTIFYTOOLTIP "TestCell" ; oMain := This.Object hMain := ThisWindow.Handle //DEFINE STATUSBAR /*Font "ARIAL" SIZE 9*/ BOLD DEFINE STATUSBAR FONT App.FontName SIZE iif( App.FontSize > 11, 11, App.FontSize ) BOLD STATUSITEM '' WIDTH 100 ACTION Nil STATUSITEM '' WIDTH 150 ACTION Nil STATUSITEM '' ACTION Nil STATUSITEM '' WIDTH 80 ACTION Nil STATUSITEM '' WIDTH 400 ACTION Nil DATE CLOCK END STATUSBAR DEFINE SPLITBOX HANDLE hSpl DEFINE TOOLBAR ToolBar_1 CAPTION "" BUTTONSIZE nBtnW, nBtnH FLAT BUTTON 01 CAPTION 'Справочники' PICTURE 'NEWSUPLOAD16' SEPARATOR BUTTON 02 CAPTION 'Портфель' PICTURE 'n2' WHOLEDROPDOWN SEPARATOR DEFINE DROPDOWN MENU BUTTON 02 ITEM "Моделирование" IMAGE 'factory16' ACTION _wPost(11) NAME 100 END MENU END TOOLBAR DEFINE TOOLBAR ToolBar_2 CAPTION "" BUTTONSIZE nEndW, nBtnH FLAT BUTTON 99 CAPTION 'Выход' PICTURE 'exit' ACTION {|| oMain:Release()} END TOOLBAR END SPLITBOX END WINDOW DoMethod(oMain:Name, "maximize") oBrw := CreateBrowse( oMain, GetWindowHeight(hSpl) + 2, 2 ) ACTIVATE WINDOW &(oMain:Name) //Form_0.Activate Return nil FUNCTION CreateBrowse( oWnd, nY, nX ) LOCAL i, oBrw LOCAL aDatos := {} FOR i := 1 TO 1000 AAdd( aDatos, { i, RandStr( 30 ), Date() - i, if( i % 2 == 0, TRUE, FALSE ) } ) NEXT if isControlDefined( "oBrw", oWnd:Name ) doMethod( oWnd:Name , "oBrw", "Release") end DEFINE TBROWSE oBrw AT nY, nX OF &(oWnd:Name) ; WIDTH oWnd:ClientWidth() - nX * 2 ; HEIGHT oWnd:ClientHeight() - oWnd:StatusBar:Height - nY ; GRID //FONT "Arial" SIZE 12 :SetArray( aDatos, .T. ) :nWheelLines := 1 :nClrLine := COLOR_GRID :lNoChangeOrd := TRUE :lCellBrw := TRUE :hBrush := CreateSolidBrush( 242, 245, 204 ) :lNoVScroll := TRUE :nHeightCell := 22 :nHeightHead := 22 :nLineStyle := 6 // prepare for showing of Double cursor AEval( :aColumns, {| oCol| oCol:lFixLite := oCol:lEdit := TRUE , oCol:bPrevEdit := {|xVal, oBrw| PrevEdit(xVal, oBrw) }} ) // assignment of column's names :aColumns[ 1 ]:cName := "NUMBER" :aColumns[ 2 ]:cName := "TEXT" :aColumns[ 3 ]:cName := "DATE" :aColumns[ 4 ]:cName := "LOGIC" // the reference to columns by names :SetColSize( "NUMBER", 100 ) :SetColSize( "TEXT", 500 ) :SetColSize( "DATE", 200 ) // Checking the method nColumn() :SetColSize( oBrw:nColumn( "LOGIC" ), 300 ) :GetColumn( 'NUMBER' ):nAlign := DT_CENTER :GetColumn( 'TEXT' ):nAlign := DT_LEFT :GetColumn( 'DATE' ):nAlign := DT_CENTER :GetColumn( 'LOGIC' ):nAlign := DT_CENTER :SetColor( { 1 }, { RGB( 0, 12, 120 ) } ) :SetColor( { 2 }, { RGB( 242, 245, 204 ) } ) :SetColor( { 5 }, { RGB( 0, 0, 0 ) } ) :SetColor( { 6 }, { {|a, b, c| IF( c:nCell == b, { RGB( 66, 255, 236 ), RGB( 111, 183, 155 ) }, ; { RGB( 255, 255, 255 ), RGB( 200, 200, 200 ) } ) } } ) // cursor backcolor END TBROWSE RETURN oBrw FUNCTION RandStr( nLen ) LOCAL cSet := "qwertyuiopasdfghjklzxcvbnmQWERTYUIOPASDFGHJKLZXCVBNM" LOCAL cPass := "" LOCAL i := 0 FOR i := 1 TO nLen cPass += SubStr( cSet, Random( 52 ), 1 ) NEXT RETURN cPass FUNCTION PrevEdit(xVal, oBrw) LOCAL oCell := oBrw:GetCellInfo(oBrw:nRowPos) LOCAL nY := oCell:nRow + oBrw:nHeightHead + 4 LOCAL nX := oCell:nCol LOCAL nW := oCell:nWidth LOCAL nH := oCell:nHeight LOCAL oWnd, hWnd DEFINE WINDOW Cell AT nY,nX WIDTH nW - 2 HEIGHT nH - 2 MODAL NOCAPTION ; ON LOSTFOCUS oWnd:Release() oWnd := ThisWindow.Object hWnd := oWnd:Handle END WINDOW SetWindowLong(hWnd, GWL_STYLE, WS_BORDER) _DefineHotKey ( "CELL" , 0 , VK_ESCAPE , {|| oWnd:Release() } ) _DefineHotKey ( "CELL" , 0 , VK_RETURN , {|| oWnd:Release() } ) Cell.Activate oBrw:DrawSeLect() return .F. [/pre2] Поправки координаты nY тоже делаю
SergKis: PS Добавляю в modal окно Cell еще такое (выделил цветом) PS2 не забываем делать[pre2] FUNCTION PrevEdit(xVal, oBrw) ... LOCAL oWnd, hWnd LOCAL hOld := _HMG_InplaceParentHandle LOCAL oParent := _WindowObj(oBrw:cParentWnd) _HMG_InplaceParentHandle := oParent:Handle DEFINE WINDOW Cell AT nY,nX WIDTH nW - 2 HEIGHT nH - 2 MODAL NOCAPTION ; ... oBrw:DrawSeLect() ; DO EVENTS _HMG_InplaceParentHandle := hOld ... [/pre2] PS3 Создание контролов и тсб делаю до END WINDOW, т.е. [pre2] END SPLITBOX This.Maximize oBrw := CreateBrowse( This.Object, GetWindowHeight(hSpl) + 2, 2 ) END WINDOW //DoMethod(oMain:Name, "maximize") //oBrw := CreateBrowse( oMain, GetWindowHeight(hSpl) + 2, 2 ) ACTIVATE WINDOW &(oMain:Name) [/pre2] Тогда не надо писать для контролов окна OF &(oWnd:Name), т.е. имеем куски кода с привязкой к тек. окну. Их можно комбинировать на разных окнах PS4 Не стал править в исходнике, думаю и так знаешь. Просто вариант [pre2] DEFINE SPLITBOX HANDLE hSpl DEFINE TOOLBAR ToolBar_1 CAPTION "" BUTTONSIZE nBtnW, nBtnH FLAT BUTTON 01 CAPTION 'Справочники' PICTURE 'NEWSUPLOAD16' ACTION _wPost(01) SEPARATOR BUTTON 02 CAPTION 'Портфель' PICTURE 'n2' WHOLEDROPDOWN SEPARATOR DEFINE DROPDOWN MENU BUTTON 02 ITEM "Моделирование 1" IMAGE 'factory16' ACTION _wPost(02,, This.Name) NAME 201 ITEM "Моделирование 2" IMAGE 'factory16' ACTION _wPost(02,, This.Name) NAME 202 ITEM "Моделирование 3" IMAGE 'factory16' ACTION _wPost(02,, This.Name) NAME 203 END MENU END TOOLBAR DEFINE TOOLBAR ToolBar_2 CAPTION "" BUTTONSIZE nEndW, nBtnH FLAT BUTTON 99 CAPTION 'Выход' PICTURE 'exit' ACTION _wPost(99) END TOOLBAR END SPLITBOX This.Maximize oBrw := CreateBrowse( This.Object, GetWindowHeight(hSpl) + 2, 2 ) WITH OBJECT This.Object :Event(01, {| | Nil }) :Event(02, {|ow,ky,cItm| Local cBtn := StrZero(ky, 2), nItm, oBrw This.&(cBtn).Enabled := .F. oBrw := This.oBrw.Object nItm := Val(cItm) - ky * 100 IF nItm == 1 // ... ELSEIF nItm == 2 // ... ELSEIF nItm == 3 // ... ENDIF SetProperty(ow:Name, cBtn, "Enabled", .T.) Return Nil }) :Event(99, {|ow| ow:Release() }) END WITH END WINDOW [/pre2] PS5 убрал в CreateBrowse() лишнее oBrw между DEFINE TBROWSE и END TBROWSE, т.е.[pre2] oBrw:SetArray( aDatos, .T. ) oBrw:nWheelLines := 1 ... на :SetArray( aDatos, .T. ) :nWheelLines := 1 ... [/pre2]
Haz: SergKis пишет: Твой пример, немного поправи спасибо, посмотрю завтра. Сегодня целый день был посвящён совещаниям ни о чем. Только приехал, голова пустая совершенно
Andrey: Haz пишет: А можно как то цвет Scroll поменять на свой ? Скорее всего можно и далее nClrText := GetSysColor( COLOR_WINDOW ),; nClrBack := GetSysColor( COLOR_SCROLLBAR ),; но эти переменные нигде не используются .... А как его поменять можно ? Т.е. допустим в последнем примере который дал Сергей - Пост N: 3859 можешь показать ? А то я не знаю как это сделать, давно очень хотел поменять.
Haz: Andrey пишет: А как его поменять можно ? Андрей, переменные есть , но это пустышки. Они нигде не используются, видимо автор так и не дошёл до этого. Цвет скролбара определяется темой виндовс и легких путей его поменять нет (так же как и титл окна ). Можно нарисовать свой класс по скроллбару , где будет обрабатываться цвет и размер, но такой подход потребует пересчета клиентской области окна бровса и корректировки многих методов опирающихся на эти размеры.
Andrey: Понял, спасибо !
Haz: Andrey пишет: Понял, спасибо чуть дописал выше
Haz: Haz пишет: спасибо, посмотрю завтра Сергей посмотрел , попробуй в примере ( который ты правил ) перед тем как щелкнуть в ячейке, сдвинуть окно чуть в сторону . Во всех случаях GetCellInfo не попадет в координаты ( heading, cell, footing ) Нужна привязка к физическому положению парент окна сегодня изобрел это ( физические , а не относительные координаты ячейки на экране , вне зависимости куда двинули окно с бровсем) [pre2] FUNC GetCellRect( oBrw, nRowPos, nCell, lColSpecHd ) LOCAL nI, nStartX := 0, oCol, cBrw LOCAL nRow, nCol, nWidth, nHeight, nRight, nBottom LOCAL lHead := .F., lFoot := .F. LOCAL aRect := {0,0,0,0} LOCAL aRet := {} IF HB_ISLOGICAL( nRowPos ) IF nRowPos ; lHead := .T. ELSE ; lFoot := .T. ENDIF nRowPos := NIL lColSpecHd := .F. ENDIF DEFAULT nRowPos := oBrw:nRowPos, ; nCell := oBrw:nCell, ; lColSpecHd := .F. 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 nStartX-- 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, 0 ) 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, 1, 0 ) nCol := nStartX + iif( oCol:l3DLook, 2, 0 ) nWidth := oBrw:GetColSizes()[ nCell ] - iif( oCol:l3DLook, 3, 0 ) nHeight := oBrw:nHeightCell - iif( oCol:l3DLook, 3, 1 ) ENDIF GetWindowRect(oBrw:hWnd, aRect ) nRow := aRect[2] + 1 + oBrw:nHeightHead + oBrw:nHeightSuper + oBrw:nHeightSpecHd + iif( oCol:l3DLook, 2, 0 ) + (oBrw:nRowPos - 1 ) * oBrw:nHeightCell IF lHead nRow := aRect[2] + oBrw:nHeightSuper + iif( oCol:l3DLook, 2, 1 ) nCol := nStartX + iif( oCol:l3DLook, 2, 0 ) nHeight := oBrw:nHeightHead - iif( oCol:l3DLook, 3, 0 ) nWidth := oBrw:GetColSizes()[ nCell ] - iif( oCol:l3DLook, 3, 0 ) ELSEIF lFoot nRow := aRect[2] + _GetClientRect( oBrw:hWnd )[ 4 ] - oBrw:nHeightFoot + iif( oCol:l3DLook, 3, 1 ) nCol := nStartX + iif( oCol:l3DLook, 2, 0 ) nHeight := oBrw:nHeightFoot - iif( oCol:l3DLook, 3, 0 ) nWidth := oBrw:GetColSizes()[ nCell ] - iif( oCol:l3DLook, 3, 0 ) ENDIF nCol := nCol + oBrw:nLeft + aRect[1] -1 nRight := nCol + nWidth -1 nBottom := nRow + nHeight -1 aRet := {nCol, nRow, nRight, nBottom} RETURN aRet [/pre2] лень было для теста в класс заворачивать, а может и незачем. Плюс возвращаемое как по классике в массиве rect {nLeft, nTop, nRight, nBottom} Возвращает именно координаты ячейки ( без учета длинны поля редактирования т.к. это посчитал лишним ) параметры как у GetCellInfo() окно ячейки рисуется так ( плюс не стал пока заморачиваться с потерей фокуса ) [pre2] Func PrevEdit(xVal, oBrw) LOCAL oCell LOCAL oWnd, hWnd LOCAL aRect := {0,0,0,0} SET OOP ON aRect := GetCellRect(oBrw, oBrw:nRowPos) // // aRect := GetCellRect(oBrw, .t.) // // aRect := GetCellRect(oBrw, .F.) // DEFINE WINDOW Cell ; AT aRect[2] , aRect[1] ; WIDTH aRect[3] - aRect[1] + 1 ; HEIGHT aRect[4] - aRect[2] + 1 ; NOCAPTION ; MODAL ; oWnd := ThisWindow.Object hWnd := oWnd:Handle() END WINDOW SetWindowLong(hWnd, GWL_STYLE, WS_BORDER) _DefineHotKey ( "CELL" , 0 , VK_ESCAPE , {|| oWnd:Release() } ) _DefineHotKey ( "CELL" , 0 , VK_RETURN , {|| oWnd:Release() } ) Cell.Activate oBrw:DrawSeLect() return .F. [/pre2] гонял по всякому с 3DLook и без , в заголовках подвалах ячейках и пр . у меня все корректно рисует. Под 3DLook подбирал поправки попиксельно на большом экране
SergKis: Haz пишет:посмотрел , попробуй в примере ( который ты правил ) перед тем как щелкнуть в ячейке, сдвинуть окно чуть в сторону Улыбнуло Столько лет делал и не двигал никогда окно, клиенты похоже тоже. Поправил метод в тсб.[pre2] METHOD GetCellInfo( nRowPos, nCell, lColSpecHd ) CLASS TSBrowse LOCAL nI, nStartX := 0, oCol, cBrw, cForm //, ix LOCAL nRow, nCol, nWidth, nHeight LOCAL lHead := .F., lFoot := .F. LOCAL oCell := TSBcell():New() LOCAL aRect := {0,0,0,0}, y, x GetWindowRect(::hWnd, aRect ) y := aRect[2] + 1 x := aRect[1] + 1 IF HB_ISLOGICAL( nRowPos ) IF nRowPos ; lHead := .T. ELSE ; lFoot := .T. ENDIF nRowPos := NIL lColSpecHd := .F. ENDIF DEFAULT nRowPos := ::nRowPos, ; nCell := ::nCell, ; lColSpecHd := .F. cForm := ::cParentWnd cBrw := ::cControlName oCol := ::aColumns[ nCell ] IF ::nFreeze > 0 FOR nI := 1 TO Min( ::nFreeze, nCell - 1 ) nStartX += ::GetColSizes()[ nI ] NEXT ENDIF FOR nI := ::nColPos TO nCell - 1 nStartX += ::GetColSizes()[ nI ] NEXT IF lColSpecHd nRow := ::nHeightHead + ::nHeightSuper + iif( oCol:l3DLook, 2, 0 ) nCol := nStartX + iif( oCol:l3DLook, 2, 0 ) nWidth := ::GetColSizes()[ nCell ] - iif( oCol:l3DLook, 2, 1 ) nHeight := ::nHeightSpecHd - iif( oCol:l3DLook, 1, -1 ) ELSE nRow := nRowPos - 1 nRow := ( nRow * ::nHeightCell ) + ::nHeightHead + ; ::nHeightSuper + ::nHeightSpecHd + iif( oCol:l3DLook, 2, 0 ) nCol := nStartX + iif( oCol:l3DLook, 2, 0 ) nWidth := ::GetColSizes()[ nCell ] - iif( oCol:l3DLook, 2, 0 ) nHeight := ::nHeightCell - iif( oCol:l3DLook, 1, -1 ) ENDIF IF oCol:nEditWidthDraw > 0 nWidth := oCol:nEditWidthDraw If ! ::lNoVScroll nWidth -= GetVScrollBarWidth() ENDIF ENDIF IF lHead nRow := ::nHeightSuper + iif( oCol:l3DLook, 2, 0 ) + 1 nHeight := ::nHeightHead ELSEIF lFoot nRow := _GetClientRect( ::hWnd )[ 4 ] - ::nHeightFoot + 1 nHeight := ::nHeightFoot ENDIF //ix := GetControlIndex( cBrw, cForm ) //IF _HMG_aControlContainerRow[ ix ] == -1 //nRow += ::nTop - 1 //nCol += ::nLeft //ELSE //nRow += _HMG_aControlRow[ ix ] - 1 //nCol += _HMG_aControlCol[ ix ] //ENDIF nRow += ::aEditCellAdjust[ 1 ] nCol += ::aEditCellAdjust[ 2 ] nWidth += ::aEditCellAdjust[ 3 ] + 2 nHeight += ::aEditCellAdjust[ 4 ] oCell:nRow := nRow + y oCell:nCol := nCol + x oCell:nWidth := nWidth oCell:nHeight := nHeight RETURN oCell Тогда в примере делаем FUNCTION PrevEdit(xVal, oBrw) LOCAL oCell := oBrw:GetCellInfo(oBrw:nRowPos) LOCAL nY := oCell:nRow //+ oBrw:nHeightHead + 4 LOCAL nX := oCell:nCol LOCAL nW := oCell:nWidth LOCAL nH := oCell:nHeight LOCAL oWnd, hWnd LOCAL hOld := _HMG_InplaceParentHandle LOCAL oParent := _WindowObj(oBrw:cParentWnd) _HMG_InplaceParentHandle := oParent:Handle DEFINE WINDOW Cell AT nY,nX WIDTH nW - 2 HEIGHT nH - 2 MODAL NOCAPTION ; ON LOSTFOCUS oWnd:Release() oWnd := ThisWindow.Object hWnd := oWnd:Handle END WINDOW SetWindowLong(hWnd, GWL_STYLE, WS_BORDER) _DefineHotKey ( "CELL" , 0 , VK_ESCAPE , {|| oWnd:Release() } ) _DefineHotKey ( "CELL" , 0 , VK_RETURN , {|| oWnd:Release() } ) Cell.Activate oBrw:DrawSeLect() ; DO EVENTS _HMG_InplaceParentHandle := hOld RETURN .F. [/pre2] Вроде, работает у меня, Глянь тоже
Haz: SergKis пишет: Вроде, работает у меня, Глянь тоже да все работает.
Haz: SergKis пишет: Вроде, работает у меня, Глянь тоже у меня координаты ровнее в ячейку сравни , я подбирал значения специально .Но главное что привязка к положению окна заработала [pre2] #include "minigui.ch" #include "tsbrowse.ch" #include "common.ch" #include "hmg.ch" #include "i_winuser.ch" #include "hbclass.ch" static oMain static hMain FUNCTION Main() LOCAL nBtnW, nBtnH, nEndW, oBrw SET DATE GERMAN SET OOP ON SET FONT TO "Arial", 12 // кнопки toolbar от размера фонта nBtnW := App.Object:W(1.5) nBtnH := App.Object:H1 + 16 + 2 // 16 - это размер по высоте bmp nEndW := App.Object:W(0.7) // DEFINE WINDOW Form_0 AT 0,0 WIDTH Sys.ClientWidth HEIGHT Sys.ClientHeight ; DEFINE WINDOW Form_0 AT 0,0 WIDTH GetDesktopWidth() HEIGHT GetDesktopHeight() ; TITLE "Test ::CellInfo" ; MAIN ; ON INIT NIL ; NOTIFYICON "CRANE" ; NOTIFYTOOLTIP "TestCell" ; oMain := This.Object hMain := ThisWindow.Handle //DEFINE STATUSBAR /*Font "ARIAL" SIZE 9*/ BOLD DEFINE STATUSBAR FONT App.FontName SIZE iif( App.FontSize > 11, 11, App.FontSize ) BOLD STATUSITEM '' WIDTH 100 ACTION Nil STATUSITEM '' WIDTH 150 ACTION Nil STATUSITEM '' ACTION Nil STATUSITEM '' WIDTH 80 ACTION Nil STATUSITEM '' WIDTH 400 ACTION Nil DATE CLOCK END STATUSBAR DEFINE SPLITBOX HANDLE hSpl DEFINE TOOLBAR ToolBar_1 CAPTION "" BUTTONSIZE nBtnW, nBtnH FLAT BUTTON 01 CAPTION 'Справочники' PICTURE 'NEWSUPLOAD16' SEPARATOR BUTTON 02 CAPTION 'Портфель' PICTURE 'n2' WHOLEDROPDOWN SEPARATOR DEFINE DROPDOWN MENU BUTTON 02 ITEM "Моделирование" IMAGE 'factory16' ACTION _wPost(11) NAME 100 END MENU END TOOLBAR DEFINE TOOLBAR ToolBar_2 CAPTION "" BUTTONSIZE nEndW, nBtnH FLAT BUTTON 99 CAPTION 'Выход' PICTURE 'exit' ACTION {|| oMain:Release()} END TOOLBAR END SPLITBOX END WINDOW //DoMethod(oMain:Name, "maximize") oBrw := CreateBrowse( oMain, GetWindowHeight(hSpl) + 2, 2 ) ACTIVATE WINDOW &(oMain:Name) //Form_0.Activate Return nil FUNCTION CreateBrowse( oWnd, nY, nX ) LOCAL i, oBrw LOCAL aDatos := {} FOR i := 1 TO 1000 AAdd( aDatos, { i, RandStr( 30 ), Date() - i, if( i % 2 == 0, TRUE, FALSE ) } ) NEXT if isControlDefined( "oBrw", oWnd:Name ) doMethod( oWnd:Name , "oBrw", "Release") end DEFINE TBROWSE oBrw AT nY, nX OF &(oWnd:Name) ; WIDTH oWnd:ClientWidth() - nX * 2 ; HEIGHT oWnd:ClientHeight() - oWnd:StatusBar:Height - nY ; GRID //FONT "Arial" SIZE 12 oBrw:SetArray( aDatos, .T. ) oBrw:nWheelLines := 1 oBrw:nClrLine := COLOR_GRID oBrw:lNoChangeOrd := TRUE oBrw:lCellBrw := TRUE oBrw:hBrush := CreateSolidBrush( 242, 245, 204 ) oBrw:lNoVScroll := TRUE oBrw:nHeightCell := 22 oBrw:nHeightHead := 22 oBrw:lFooting := .T. oBrw:lDrawFooters := .T. oBrw:nHeightFoot := 20 oBrw:DrawFooters() // oBrw:nLineStyle := 6 // prepare for showing of Double cursor AEval( oBrw:aColumns, {| oCol| oCol:l3DLook := .F. , oCol:lFixLite := oCol:lEdit := TRUE , oCol:bPrevEdit := {|xVal, oBrw| PrevEdit(xVal, oBrw) }} ) // assignment of column's names oBrw:aColumns[ 1 ]:cName := "NUMBER" oBrw:aColumns[ 2 ]:cName := "TEXT" oBrw:aColumns[ 3 ]:cName := "DATE" oBrw:aColumns[ 4 ]:cName := "LOGIC" // the reference to columns by names oBrw:SetColSize( "NUMBER", 100 ) oBrw:SetColSize( "TEXT", 500 ) oBrw:SetColSize( "DATE", 200 ) // Checking the method nColumn() oBrw:SetColSize( oBrw:nColumn( "LOGIC" ), 300 ) oBrw:GetColumn( 'NUMBER' ):nAlign := DT_CENTER oBrw:GetColumn( 'TEXT' ):nAlign := DT_LEFT oBrw:GetColumn( 'DATE' ):nAlign := DT_CENTER oBrw:GetColumn( 'LOGIC' ):nAlign := DT_CENTER oBrw:SetColor( { 1 }, { RGB( 0, 12, 120 ) } ) oBrw:SetColor( { 2 }, { RGB( 242, 245, 204 ) } ) oBrw:SetColor( { 5 }, { RGB( 0, 0, 0 ) } ) oBrw:SetColor( { 6 }, { {|a, b, c| IF( c:nCell == b, { RGB( 66, 255, 236 ), RGB( 111, 183, 155 ) }, ; { RGB( 255, 255, 255 ), RGB( 200, 200, 200 ) } ) } } ) // cursor backcolor END TBROWSE RETURN oBrw FUNCTION RandStr( nLen ) LOCAL cSet := "qwertyuiopasdfghjklzxcvbnmQWERTYUIOPASDFGHJKLZXCVBNM" LOCAL cPass := "" LOCAL i := 0 FOR i := 1 TO nLen cPass += SubStr( cSet, Random( 52 ), 1 ) NEXT RETURN cPass Func PrevEdit(xVal, oBrw) LOCAL oCell LOCAL oWnd, hWnd LOCAL aRect := {0,0,0,0} SET OOP ON aRect := GetCellRect(oBrw, oBrw:nRowPos) // // aRect := GetCellRect(oBrw, .t.) // // aRect := GetCellRect(oBrw, .F.) // DEFINE WINDOW Cell ; AT aRect[2] , aRect[1] ; WIDTH aRect[3] - aRect[1] + 1 ; HEIGHT aRect[4] - aRect[2] + 1 ; NOCAPTION ; MODAL ; oWnd := ThisWindow.Object hWnd := oWnd:Handle() END WINDOW SetWindowLong(hWnd, GWL_STYLE, WS_BORDER) _DefineHotKey ( "CELL" , 0 , VK_ESCAPE , {|| oWnd:Release() } ) _DefineHotKey ( "CELL" , 0 , VK_RETURN , {|| oWnd:Release() } ) Cell.Activate oBrw:DrawSeLect() return .F. FUNC GetCellRect( oBrw, nRowPos, nCell, lColSpecHd ) LOCAL nI, nStartX := 0, oCol, cBrw LOCAL nRow, nCol, nWidth, nHeight, nRight, nBottom LOCAL lHead := .F., lFoot := .F. LOCAL aRect := {0,0,0,0} LOCAL aRet := {} IF HB_ISLOGICAL( nRowPos ) IF nRowPos ; lHead := .T. ELSE ; lFoot := .T. ENDIF nRowPos := NIL lColSpecHd := .F. ENDIF DEFAULT nRowPos := oBrw:nRowPos, ; nCell := oBrw:nCell, ; lColSpecHd := .F. 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 nStartX-- 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, 0 ) 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, 1, 0 ) nCol := nStartX + iif( oCol:l3DLook, 2, 0 ) nWidth := oBrw:GetColSizes()[ nCell ] - iif( oCol:l3DLook, 3, 0 ) nHeight := oBrw:nHeightCell - iif( oCol:l3DLook, 3, 1 ) ENDIF GetWindowRect(oBrw:hWnd, aRect ) nRow := aRect[2] + 1 + oBrw:nHeightHead + oBrw:nHeightSuper + oBrw:nHeightSpecHd + iif( oCol:l3DLook, 2, 0 ) + (oBrw:nRowPos - 1 ) * oBrw:nHeightCell IF lHead nRow := aRect[2] + oBrw:nHeightSuper + iif( oCol:l3DLook, 2, 1 ) nCol := nStartX + iif( oCol:l3DLook, 2, 0 ) nHeight := oBrw:nHeightHead - iif( oCol:l3DLook, 3, 0 ) nWidth := oBrw:GetColSizes()[ nCell ] - iif( oCol:l3DLook, 3, 0 ) ELSEIF lFoot nRow := aRect[2] + _GetClientRect( oBrw:hWnd )[ 4 ] - oBrw:nHeightFoot + iif( oCol:l3DLook, 3, 1 ) nCol := nStartX + iif( oCol:l3DLook, 2, 0 ) nHeight := oBrw:nHeightFoot - iif( oCol:l3DLook, 3, 0 ) nWidth := oBrw:GetColSizes()[ nCell ] - iif( oCol:l3DLook, 3, 0 ) ENDIF nCol := nCol + oBrw:nLeft + aRect[1] -1 nRight := nCol + nWidth -1 nBottom := nRow + nHeight -1 aRet := {nCol, nRow, nRight, nBottom} RETURN aRet [/pre2]
SergKis: Haz пишет у меня координаты ровнее в ячейку Возможно, это важно в каких то случаях. В сущест. методе есть поправки на Edit режим nRow += ::aEditCellAdjust[ 1 ] nCol += ::aEditCellAdjust[ 2 ] nWidth += ::aEditCellAdjust[ 3 ] + 2 nHeight += ::aEditCellAdjust[ 4 ] Мне ни разу не понадобились ровные координаты ячейки для встраивания окна, всегда примерно получается. Надо больше ячейки или если ячейка высокая (многострочная), то меньше (на половину или по App.Object:H1 для getbox, к примеру). Чаще надо сверху или снизу, справа или слева от ячейки давать окно для выбора из списка (что бы помещался список) Можно оформить твою ф-ю как метод, если надо сделаю
Haz: SergKis пишет: Можно оформить твою ф-ю как метод, если надо сделаю оформить в метод не сложно,да смысла нет. Просто пару раз наткнулся на выравнивание и везде подбором, вот и стало интересно можно ли автоматом в точку попасть
SergKis: Haz пишет стало интересно можно ли автоматом в точку попасть Можно в метод добавить параметр и правку такую [pre2] METHOD GetCellInfo( nRowPos, nCell, lColSpecHd, lEditMode ) ... y := aRect[2] //+ 1 x := aRect[1] //+ 1 ... DEFAULT nRowPos := ::nRowPos, ; nCell := ::nCell, ; lColSpecHd := .F., ; lEditMode := .T. ... IF lEditMode nRow += ::aEditCellAdjust[ 1 ] nCol += ::aEditCellAdjust[ 2 ] nWidth += ::aEditCellAdjust[ 3 ] + 2 nHeight += ::aEditCellAdjust[ 4 ] ENDIF ... [/pre2] В примере [pre2] FUNCTION PrevEdit(xVal, oBrw) LOCAL oCell := oBrw:GetCellInfo(oBrw:nRowPos, , , .F.) LOCAL nY := oCell:nRow //+ oBrw:nHeightHead + 4 LOCAL nX := oCell:nCol LOCAL nW := oCell:nWidth LOCAL nH := oCell:nHeight LOCAL oWnd, hWnd LOCAL hOld := _HMG_InplaceParentHandle LOCAL oParent := _WindowObj(oBrw:cParentWnd) _HMG_InplaceParentHandle := oParent:Handle DEFINE WINDOW Cell AT nY,nX WIDTH nW HEIGHT nH MODAL NOCAPTION ; ... [/pre2] Довольно точно дает ячейку, по мне
Haz: SergKis пишет: Можно в метод добавить параметр и правку такую да, это будет использоваться. SergKis пишет: Довольно точно дает ячейку, по мне в границы ячейки попиксельно попадает ? У меня при тесте было смещение снизу и вроде справа. 3dlook не проверял, в нем должно на пиксель внутрь со всех сторон уходить. Завтра посмотрю еще. В принципе думаю , что lEditmode практически всегда будет . f. т.к это окно пользователя и он сам определяет его размер под задачу.
SergKis: Haz пишет в границы ячейки попиксельно попадает ? Что принимать за границы ячейки ? Внешние или внутренние размеры ? В таком варианте окно встраивается по линиям ячейки, может width 1 пиксел справа не дотягивает (может, так мне кажется, глаз не алмаз у меня). В принципе думаю , что lEditmode практически всегда будет . f. т.к это окно пользователя и он сам определяет его размер под задачу. У меня, как раз, с окном такого плана lEditMode := .T., т.к. управляю установкой ::aEditCellAdjust, предварительно сохранив, что там есть и ставлю, что мне по ситуации надо с + или - значениями. Правда это в моей версии будет, тут можно ставить default lEditMode := .F., не принципиально. Если окно идет в высокую ячейку, высота ее больше высоты GetBox и он криво смотрится в таком виде (это имеет место, если клиент просит расстояние между текстами строк делать больше), то нужен lEditMode := .T. и установки в ::aEditCellAdjust для встраивания окна во внутрь ячейки (у себя делаю это автоматом сравнивая высоту ячейки и App.Object:H1 и заполняя ::aEditCellAdjust, если разница > 2 пикселей) или переносить алгоритм на окно. В др. случаях нужно примерная левая или правая координата ячейки, для размещения окна списка, работа не закрывая ячейку 3dlook не проверял, в нем должно на пиксель внутрь со всех сторон уходить. В методе есть учет и обработка 3Dlook, но не проверял и даже не смотрел с тех пор как набирал (копипастил из drawline, наверное)
SergKis: Игорь Вот что получилось, очень похожее по размерам ячеек, к реальной работе тсб у клиента. Фонт может быть nSize := 11, пропорции похожие. Это с последними изм. MiniGui.lib Пример тут https://TransFiles.ru/zyaq4 Это вариант oCell := oBrw:GetCellInfo(oBrw:nRowPos, , , .T.) он полностью закрывает ячейку (width += 2 есть) при oCell := oBrw:GetCellInfo(oBrw:nRowPos, , , .F.) справа видна линия, не хватает width
Haz: SergKis пишет: Вот что получилось, очень похожее по размерам ячеек, к реальной работе тсб у клиента. ты маньяк, 2 часа ночи 😱. От Андрея дурных привычек нахватался ? Сегодня посмотрю ближе к обеду наверное. В целом если с этим параметрам получаются родные координаты ячейки, то у пользователя даже сомнений не будет на счет единства интерфейса при редактировании.
Haz: Haz пишет: Вот что получилось, очень похожее по размерам ячеек, к реальной работе тсб у клиента. Сергей, вот тут поправь пожалста. В целом все ок [pre2] method GetCellInfo IF lColSpecHd ... ELSE nRow := nRowPos - 1 nRow := ( nRow * ::nHeightCell ) + ::nHeightHead + ; ::nHeightSuper + ::nHeightSpecHd + iif( oCol:l3DLook, 1, 0 ) nCol := nStartX + iif( oCol:l3DLook, 2, -1 ) nWidth := ::GetColSizes()[ nCell ] - iif( oCol:l3DLook, 4, 1 ) nHeight := ::nHeightCell - iif( oCol:l3DLook, 3, 1 ) ENDIF [/pre2]
SergKis: Haz пишет:вот тут поправь Поправил + вынес +2 к width на постоянку и default lEditMode := .F. оба режима .T./.F. при не заданных ::aEditCellAdjust дают одинаковый результат [pre2] METHOD GetCellInfo( nRowPos, nCell, lColSpecHd, lEditMode ) CLASS TSBrowse LOCAL nI, nStartX := 0, oCol, cBrw, cForm //, ix LOCAL nRow, nCol, nWidth, nHeight LOCAL lHead := .F., lFoot := .F. LOCAL oCell := TSBcell():New() LOCAL aRect := {0,0,0,0}, y, x GetWindowRect(::hWnd, aRect ) y := aRect[2] //+ 1 x := aRect[1] //+ 1 IF HB_ISLOGICAL( nRowPos ) IF nRowPos ; lHead := .T. ELSE ; lFoot := .T. ENDIF nRowPos := NIL lColSpecHd := .F. ENDIF DEFAULT nRowPos := ::nRowPos, ; nCell := ::nCell, ; lColSpecHd := .F., ; lEditMode := .F. cForm := ::cParentWnd cBrw := ::cControlName oCol := ::aColumns[ nCell ] IF ::nFreeze > 0 FOR nI := 1 TO Min( ::nFreeze, nCell - 1 ) nStartX += ::GetColSizes()[ nI ] NEXT ENDIF FOR nI := ::nColPos TO nCell - 1 nStartX += ::GetColSizes()[ nI ] NEXT IF lColSpecHd nRow := ::nHeightHead + ::nHeightSuper + iif( oCol:l3DLook, 2, 0 ) nCol := nStartX + iif( oCol:l3DLook, 2, 0 ) nWidth := ::GetColSizes()[ nCell ] - iif( oCol:l3DLook, 2, 1 ) nHeight := ::nHeightSpecHd - iif( oCol:l3DLook, 1, -1 ) ELSE nRow := nRowPos - 1 nRow := ( nRow * ::nHeightCell ) + ::nHeightHead + ; ::nHeightSuper + ::nHeightSpecHd + iif( oCol:l3DLook, 1, 0 ) nCol := nStartX + iif( oCol:l3DLook, 2, -1 ) nWidth := ::GetColSizes()[ nCell ] - iif( oCol:l3DLook, 4, 1 ) nHeight := ::nHeightCell - iif( oCol:l3DLook, 3, -1 ) ENDIF IF oCol:nEditWidthDraw > 0 nWidth := oCol:nEditWidthDraw If ! ::lNoVScroll nWidth -= GetVScrollBarWidth() ENDIF ENDIF IF lHead nRow := ::nHeightSuper + iif( oCol:l3DLook, 2, 0 ) + 1 nHeight := ::nHeightHead ELSEIF lFoot nRow := _GetClientRect( ::hWnd )[ 4 ] - ::nHeightFoot + 1 nHeight := ::nHeightFoot ENDIF //ix := GetControlIndex( cBrw, cForm ) //IF _HMG_aControlContainerRow[ ix ] == -1 //nRow += ::nTop - 1 //nCol += ::nLeft //ELSE //nRow += _HMG_aControlRow[ ix ] - 1 //nCol += _HMG_aControlCol[ ix ] //ENDIF IF lEditMode nRow += ::aEditCellAdjust[ 1 ] nCol += ::aEditCellAdjust[ 2 ] nWidth += ::aEditCellAdjust[ 3 ] //+ 2 nHeight += ::aEditCellAdjust[ 4 ] ENDIF oCell:nRow := nRow + y oCell:nCol := nCol + x oCell:nWidth := nWidth + 2 oCell:nHeight := nHeight RETURN oCell [/pre2] Пример тут https://TransFiles.ru/tqkss
Haz: SergKis пишет: Поправил + вынес +2 к width на постоянку и default lEditMode := .F. оба режима .T./.F. при не заданных ::aEditCellAdjust дают одинаковый результат у меня чего то не поменялось ничего по сравнению с предыдущим примером
Haz: Поправил + вынес +2 к width Все , нормально. Можно закончить на этом
gfilatov2002: Haz пишет: Можно закончить на этом Благодарю за исправление Добавил такое описание в текущий файл changelog: * Updated: Adaptation FiveWin Class TSBrowse 9.0 in HMG: - correction and added 4th parameter lEditMode in the method GetCellInfo(). Suggested and contributed by Sergej Kiselev and Igor Nazarov.
SergKis: Haz пишет Все , нормально. Можно закончить на этом Согласен. Пример без 3Dlook тут https://TransFiles.ru/nwmrr Смущает только default lEditMode := .F., если кто уже что то делал с исп. ::aEditCellAdjus, то будет слом
Haz: SergKis пишет: Смущает только default lEditMode := .F. можно оставить по дефолту .T. пример отлично работает
SergKis: Haz пишет можно оставить по дефолту .T. Так и сделал. Для примера ничего не изменилось в работе, но править в старом коде придется по любому [pre2] FUNCTION PrevEdit(xVal, oBrw) LOCAL oCell := oBrw:GetCellInfo(oBrw:nRowPos) LOCAL nY := oCell:nRow //+ oBrw:nHeightHead + 4 [/pre2]
gfilatov2002: SergKis пишет: править в старом коде придется по любому Да. Например, сломался режим добавления по клавише F2 в примере из папки \SAMPLES\Advanced\Tsb_addrecord_3
SergKis: gfilatov2002 пишет сломался режим добавления по клавише F2 в примере из папки Правится легко, но геморой остается в др. текстах [pre2] STATIC FUNCTION Add_Rec( oBrw ) ... nRow := 0 //:nTop + GetWindowRow( hWnd ) - GetBorderHeight() nCol := 0 //:nLeft + GetWindowCol( hWnd ) - GetBorderWidth () + 1 [/pre2] Может метод другой сделать GetCellRect, как Игорь ф-ю называл или GetCellSize
Haz: SergKis пишет: но править в старом коде придется по любому может еще один параметр ввести в GetCellInfo(....lParentPos ) hb_default( @lParentPos, .f.) определяет учитывать ли координаты парент окна
Haz: SergKis пишет: Может метод другой сделать GetCellRect, как Игорь ф-ю называл или GetCellSize возможно это выход
gfilatov2002: SergKis пишет: метод другой сделать GetCellSize Пошел по этому пути. Теперь пример работает нормально
SergKis: gfilatov2002 пишет Пошел по этому пути. Тогда есть смысл убрать lEditMode и строки с использованием ::aEditCellAdjust из метода Добавил метод GetCellSize, убрал lEditMode и строки с использованием ::aEditCellAdjust из него Пример Tsb_addrecord_3 нормально В своем примере (выше) использовал новый метод, вместо GetCellInfo, все работает OK!
gfilatov2002: SergKis пишет: убрать lEditMode и строки с использованием ::aEditCellAdjust из метода Ok. Также изменил описание: * Updated: Adaptation FiveWin Class TSBrowse 9.0 in HMG: - added the new useful method GetCellSize(). Suggested and contributed by Sergej Kiselev and Igor Nazarov (see demo in folder \samples\Advanced\Tsb_addrecord_3)
Andrey: Всем привет ! А можно в ENUMERATOR (это где номера колонок стоят) поставить иконку/картинку слева ? И возможно ли отслеживать нажатие мышкой на нём ? Хотелось бы сделать фильтрацию как в Экселе, там есть красивое решение.
SergKis: Andrey TSCOLUMN.PRG[pre2] // Click Event DATA bFLClicked // Block to be evaluated on footer left clicked DATA bFRClicked // Block to be evaluated on footer right clicked DATA bHLClicked // Block to be evaluated on header left clicked DATA bHRClicked // Block to be evaluated on header right clicked DATA bSLClicked // Block to be evaluated on Special header left clicked DATA bSRClicked // Block to be evaluated on Special header right clicked DATA bLClicked // Block to be evaluated on cell left clicked ... DATA uBmpCell // bitmap in cell (oBmp, hBmp or bBlock) DATA uBmpFoot // bitmap in footer (oBmp, hBmp or bBlock) DATA uBmpHead // bitmap in header (oBmp, hBmp or bBlock) DATA uBmpSpcHd // bitmap in special header (oBmp, hBmp or bBlock) ... H_TSBROWSE.PRG METHOD LButtonDown( nRowPix, nColPix, nKeyFlags ) CLASS TSBrowse ... uPar1 := nRowPix, ; uPar2 := nColPix, ; ... nClickRow := ::GetTxtRow( nRowPix ) nAtCol := Max( ::nAtColActual( nColPix ), 1 ) // JP 1.31 lHeader := nClickRow == 0 .AND. ::lDrawHeaders lFooter := nClickRow == -1 .AND. iif( ::lDrawFooters != NIL, ::lDrawFooters, .F. ) lSpecHd := nClickRow == -2 .AND. iif( ::lDrawSpecHd != NIL, ::lDrawSpecHd, .F. ) ... ELSEIF lSpecHd .AND. ::lEditableHd lMChange := ::lMChange ::lMChange := .F. IF ::aColumns[ nAtCol ]:bSLClicked != NIL Eval( ::aColumns[ nAtCol ]:bSLClicked, uPar1, uPar2, ::nAt, Self ) ... [/pre2] PS Возможно, надо сделать правку[pre2] METHOD LDblClick( nRowPix, nColPix, nKeyFlags ) CLASS TSBrowse LOCAL nClickRow := ::GetTxtRow( nRowPix ), ; nCol := ::nAtColActual( nColPix ), ; uPar1 := nRowPix, ; uPar2 := nColPix ... ELSEIF nClickRow == -2 .AND. ::lDrawSpecHd // .AND. ::aColumns[ nCol ]:lEditSpec IF ::aColumns[ nCol ]:lEditSpec IF ::lAutoSearch .OR. ::lAutoFilter ::nColSpecHd := Min( iif( nCol <= ::nFreeze, ::nFreeze + 1, ::nAtCol( nColPix ) ), Len( ::aColumns ) ) ::PostMsg( WM_KEYDOWN, VK_RETURN, 0 ) RETURN 0 ENDIF ELSEIF ::bLDblClick != NIL Eval( ::bLDblClick, uPar1, uPar2, nKeyFlags, Self ) ENDIF ... [/pre2] НО это проверять надо, сделай у себя для пробы
Andrey: Спасибо ! Попробую ! Как бороться с утечкой памяти при использовании картинок ? Если я сделаю так: [pre2] oBrw:Cargo := oHmgData() oBrw:Cargo:hArrDown := LoadImage("Arrow_down") oBrw:Cargo:hArrUp := LoadImage("Arrow_up") [/pre2] Нужно ли потом удалять эти объекты ? Или при закрытии окна все картинки с объекта oBrw - "убьются" сами ?
SergKis: Andrey пишет Нужно ли потом удалять эти объекты ? Обязательно надо удалять из своих хранилищ Для тсб переменных хранения handle картинок удаление автоматом при разрушении объекта, см. метод METHOD Destroy() CLASS TSBrowse oBrw:Cargo := oHmgData() oBrw:Cargo:hArrDown := LoadImage("Arrow_down") oBrw:Cargo:hArrUp := LoadImage("Arrow_up") В тсб есть свое хранилище (само освобождается) oBrw:aBitMaps и в колонке тоже (см. пример Tsb_BitMaps)[pre2] oBrw:GetColumn( "FLD6" ):lBitMap := .T. oBrw:GetColumn( "FLD6" ):aBitMaps := { LoadImage( ".\RES\edit_delete.bmp" ), ; LoadImage( ".\RES\edit_cancel.bmp" ) } oBrw:GetColumn( "FLD7" ):lBitMap := .T. oBrw:aBitMaps := { LoadImage( ".\RES\flag_bel.bmp" ), ; LoadImage( ".\RES\flag_en.bmp" ), ; LoadImage( ".\RES\flag_kaz.bmp" ), ; LoadImage( ".\RES\flag_ru.bmp" ), ; LoadImage( ".\RES\flag_ua.bmp" ), ; StockBmp( 7 ), ; StockBmp( 6 ) ; } [/pre2]
Andrey: SergKis пишет: oBrw:aBitMaps := { LoadImage( ".\RES\flag_bel.bmp" ), ; LoadImage( ".\RES\flag_en.bmp" ), ; LoadImage( ".\RES\flag_kaz.bmp" ), ; LoadImage( ".\RES\flag_ru.bmp" ), ; LoadImage( ".\RES\flag_ua.bmp" ), ; StockBmp( 7 ), ; StockBmp( 6 ) ; } Не совсем удобно помнить картинки по номерам. Так можно делать ? [pre2] oBrw:Cargo:hFlagEn := oBrw:aBitMaps[2] oBrw:Cargo:hFlagKa := oBrw:aBitMaps[3] oBrw:Cargo:hFlagRu := oBrw:aBitMaps[4][/pre2]
SergKis: Andrey пишет Не совсем удобно помнить картинки по номерам. Так можно делать ? Конечно можно, с мнемоникой удобнее и безопаснее работать, чем с номером элемента.
Haz: Andrey пишет: Как бороться с утечкой памяти Стандартно , когда hBitmap уже не нужен делаем DeleteObiect hBitmap ). В большинстве случаев при закрытии бровса объекты удаляются автоматически, гораздо хуже ситуация когда hBitmap это результат выполнения блока hBitmap := { || LoadImage( ) } и грузит картинку с диска. Столкнулся с этой ситуацией сделав браузер предпросмотра картинок на основе tsb по массиву. При долгом скроле и больших размерах превью в ячейке бровса память просто горит. Приходится отслеживать видимый диапазон бровса и убивать все hBitmap вне этого диапазона. Сам tsb это не умеет. :uBmpCell := {|| ... LoadImage() ...} это пожалуй самый проблемный способ с точки зрения жора памяти. Тк при прорисовке ячейки всегда создается новый объект , не освобождая предыдущий созданный. И этот объект живет во время жизни бровса. Пролистал 10 000 строк и получил в памяти 10 000 хендлов, пролистал обратно и их уже 20 000. Все решается просто, но нужно не забывать об этом.
Dima: Haz пишет: :uBmpCell := {|| ... LoadImage() ...} это пожалуй самый проблемный способ с точки зрения жора памяти Игорь так мы это уже проходили несколько лет назад , когда в моей проге были вот такие же утечки памяти. Поэтому в этом массивчике я храню хендлы а не LoadImage()
Andrey: Картинка в ENUMERATOR поставилась. Клик мышки правый/левый в ENUMERATOR отрабатывается. Спасибо БОЛЬШОЕ Сергей ! Надо бы Григорию код добавить в h_tbrowse.prg [pre2]METHOD LButtonDown( nRowPix, nColPix, nKeyFlags ) CLASS TSBrowse ... ELSEIF lSpecHd .AND. ::lEditableHd ... ::lMChange := lMChange ::DrawHeaders() ELSEIF lSpecHd .AND. ::aColumns[ nAtCol ]:bSLClicked != NIL //!!! Eval( ::aColumns[ nAtCol ]:bSLClicked, uPar1, uPar2, ::nAt, Self ) ENDIF METHOD LDblClick( nRowPix, nColPix, nKeyFlags ) CLASS TSBrowse .... #endif ELSEIF nClickRow == -2 .AND. ::lDrawSpecHd //!!! .AND. ::aColumns[ nCol ]:lEditSpec IF ::aColumns[ nCol ]:lEditSpec .and. ( ::lAutoSearch .OR. ::lAutoFilter ) ::nColSpecHd := Min( iif( nCol <= ::nFreeze, ::nFreeze + 1, ::nAtCol( nColPix ) ), Len( ::aColumns ) ) ::PostMsg( WM_KEYDOWN, VK_RETURN, 0 ) RETURN 0 ENDIF IF ::bLDblClick != NIL Eval( ::bLDblClick, uPar1, uPar2, nKeyFlags, Self ) ENDIF ENDIF[/pre2]
Haz: Dima пишет: Игорь так мы это уже проходили несколько лет назад , когда в моей проге были вот такие же утечки Дим, помню. Я про случай когда хендлов очень много , а за хендлами реальный объем сжираемой памяти . Один из последних тестировал 10 000 хендлов и 1 гиг в памяти.
Andrey: В ТСБ есть методы: [pre2] METHOD DrawFooters() METHOD DrawSuper() METHOD DrawHeaders()[/pre2] А как перерисовать новую картинку для ENUMERATOR ? Есть такой метод ?
полная версия страницы