Форум » 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 пишет метод работает. Я о том что просто не пользуюсь им. Я тоже не пользуюсь, но с тем что работает, не соглашусь. Если фонты по блоку кода - валится, нет footer вывода ... т.е. для того чтобы заработал, надо делать спец. отображение тсб. с изменениями, простенький вывод есть без адо, длл и др. спец.оборудования.
Vlad04: Tsb_seek ИЗ примеров c:\MiniGUI\SAMPLES\Advanced\Tsb_seek\ Сегодня обратил на такую странность в отображении. Если стрелкой прокручивать бровс вниз, то экран заполняется одинаковыми данными, не обновляется.
Andrey: Vlad04 пишет: то экран заполняется одинаковыми данными Наверное залипла последняя запись в таблице. Такое бывает часто. Нужно добавить разрыв в конец таблицы. Был бы подвал в конце таблицы, можно было бы воспользоваться функцией [pre2]oBrw:SetNoHoles() // убрать дырку внизу таблицы[/pre2]
Vlad04: Помогло , без подвала
Vlad04: Но не во всех случаях. Помогло добавить DEFINE TBROWSE Br_zaw AT 10, 1 OF o_test ALIAS "test" WIDTH (zox/2)-10 HEIGHT (zoy-150) ON CHANGE {||inkey(0.03),CorrectionFirstLast( Br_zaw )} CorrectionFirstLast - где то здесь описывается
Andrey: Vlad04 пишет: CorrectionFirstLast Выкинь эту функцию и забудь про неё ! Её дорабатывать нужно, я тоже её использовал, в каких то случаях помогает, в других вообще мешает. Наz советовал её не пользоваться. Делай высоту таблицы на 1-2 пикселя больше чем высота всех отображаемых ячеек. Это SergKis так рекомендует. У меня залипание пропало в таких случаях.
SergKis: Vlad04 пишет Но не во всех случаях если так[pre2] END WINDOW br_f:SetNoHoles(3) br_zaw:SetNoHoles(3) br_f:enabled(.f.) [/pre2]
Vlad04: SergKis br_zaw:SetNoHoles(3) Очень хорошо ! А (3) , что означает ? И вообще, что этот метод делает ?
SergKis: Vlad04 пишет что этот метод делает ? Метод убирает дырку в низу таблицы, распределяя разницу между присутствующими заголовками\подвалами, если их нет, есть только строки, то подправит размер тсб по высоте [pre2] METHOD SetNoHoles( nDelta, lSet ) CLASS TSBrowse LOCAL nH, nK, nHeight, nHole DEFAULT nDelta := 2, lSet := .T. ... [/pre2] nDelta := 2 - поправка для расчетов разницы lSet := .F. - рассчитает величину дырки, вернет из метода не меняя размер
Andrey: Делаю таблицу выбора по базе. Создаю колонки: [pre2] // создать 1-ю колонку ADD COLUMN TO oBrw2 HEADER "Номер"+CRLF+"графы" ; DATA FieldWBlock( "ID", Select() ) ; SIZE nWidth1 PICTURE "@Z 999" ; ALIGN DT_CENTER,DT_CENTER,DT_CENTER // создать 2-ю колонку ADD COLUMN TO oBrw2 HEADER "Наименование"+CRLF+"графы в карточке" ; DATA FieldWBlock( "FHEADER", Select() ) ; SIZE nWidth2 ; ALIGN DT_LEFT,DT_CENTER,DT_LEFT // создать 3-ю колонку ADD COLUMN TO oBrw2 HEADER "Печать"+CRLF+"в таблице" ; DATA FieldWBlock( "VIEW", Select() ) ; SIZE nWidth3 ; CHECKBOX ; // Editing with Check Box ALIGN DT_CENTER, DT_CENTER ; EDITABLE MOVE DT_MOVE_DOWN oBrw2:aColumns[3]:bPrevEdit := {|| CheckField(), TRUE } // проверка до ввода .... // --------- заменяем колонку CHECKBOX на свои картинки --------- oBrw2:aCheck := { LoadImage("CheckT28"), LoadImage("CheckF28") } ....[/pre2] Таблица не простая, для ID=0 делаются заголовки в таблице цветом и запрет на редактирование. Нужно убрать в таблице показ чекбокса по условию ID=0. Как это сделать ? Вот картинка:
Vlad04: if i =3 ADD COLUMN TO Brw_1 DATA {|| iif(Dogovor->Vid > 0,aVidD[Dogovor->Vid],' Нет ' )} .... ... А попробуй при формировании колонки установить условия показа чекбокса от значения ID. Т.е. вместо показа чекбокса можешь вывести пустое место.
Andrey: Vlad04 пишет: А попробуй при формировании колонки установить условия показа чекбокса от значения ID. Т.е. вместо показа чекбокса можешь вывести пустое место. Покажи как: [pre2] ADD COLUMN TO oBrw2 HEADER "Печать"+CRLF+"в таблице" ; DATA FieldWBlock( "VIEW", Select() ) ; [/pre2]
Haz: Andrey пишет: Таблица не простая, для ID=0 делаются заголовки в таблице цветом и запрет на редактирование. Нужно убрать в таблице показ чекбокса по условию ID=0. Как это сделать ? Не меняя класса TBROWSE можно только пытаться по условию ID=0 подменить ::aCheck в блоках ::bOnDrawLine и ::bOnDraw соответственно , а по условию ID <> 0 восстанавливать. Но думаю грязновато работать будет. В смысле работать будет , но с глючком. Оптимально - в классе дописать возможность ::aCheck назначать блок кода и добавить проверки на hb_isBlock( ::aCheck ). тогда картинки чекбокса можно будет менять на лету , в том числе и задавать NIL
Andrey: Haz пишет: Не меняя класса TBROWSE можно только пытаться по условию ID=0 подменить ::aCheck в блоках ::bOnDrawLine и ::bOnDraw соответственно , а по условию ID <> 0 восстанавливать. Но думаю грязновато работать будет. В смысле работать будет , но с глючком. Вот я с этим и бился... Решил сделать по другому:[pre2] LOCAL hImgTrue := LoadImage("CheckT28"), hImgFalse := LoadImage("CheckF28") ..... // создать 3-ю колонку ADD COLUMN TO oBrw2 HEADER "Печать"+CRLF+"в таблице" ; DATA FieldWBlock( "VIEW", Select() ) ; // эту строку наверное можно выкинуть ? SIZE nWidth3 ; NAME VIEW BITMAP ; ALIGN DT_CENTER, DT_CENTER ; EDITABLE MOVE DT_MOVE_DOWN oBrw2:aColumns[3]:bPrevEdit:= {|| CheckField(), FALSE } // проверка до ввода oBrw2:aColumns[3]:uBmpCell := {|| IF( (oBrw2:cAlias)->ID == 0, '' , IF( (oBrw2:cAlias)->VIEW , hImgTrue, hImgFalse ) ) } oBrw2:aColumns[3]:bData := {||Nil} oBrw2:aColumns[3]:cData := '{||Nil}' oBrw2:aColumns[3]:nAlign := nMakeLong( DT_CENTER, DT_CENTER )[/pre2]
Haz: Andrey пишет: Решил сделать по другому: вполне нормальное решение отказаться от чекбокса и использовать подмену ::bData и ::uBmpCell и главное оно универсально
Vlad04: Andrey Покажи как: ADD COLUMN TO Brw_1 DATA {|| iif(Dogovor->Vid <> 0,aVidD[Dogovor->Vid],' Нет ' )} ... Вариант не для ПРЯМОГО РЕДАКТИРОВАНИЯ.
Haz: Vlad04 пишет: Вариант не для ПРЯМОГО РЕДАКТИРОВАНИЯ. Это скорее вариант не прямой выборки. Для редактирования ему как до луны. Но это ни в коем случае не упрёк. Как работает блок выборки_записи, все знают со времен клиппера, и допилить - не вопрос. PS. сам часто использую этот прием, ступор иногда возникает при инкрементальном поиске по таким колонкам
Dima: Haz пишет: Для редактирования ему как до луны Да уж
Andrey: Andrey пишет: oBrw2:aColumns[3]:bPrevEdit:= {|| CheckField(), FALSE } // проверка до ввода Редактировать нужно ТОЛЬКО ТРЕТИЙ столбец. Мышка и Enter в CheckField() прекрасно с этим справляются. Там ещё параллельно в другую базу пишется... [pre2]//////////////////////////////////////////////////////////// STATIC FUNCTION CheckField() LOCAL cAlias := oBrw2:cAlias // "XLS_HEADER" LOCAL nID := M->oBrw2:nAt // номер строки и номер для поиска LOCAL aMenuHead := aStatMenuPrn[nID] // строка массива меню LOCAL lVal, cNameField := "VIEW" IF (cAlias)->ID == 0 // выбор здесь не предусмотрен RETURN .F. ENDIF lVal := (cAlias)->( FIELDGET( FIELDNUM(cNameField) ) ) (cAlias)->( FIELDPUT(FIELDNUM(cNameField), !lVal ) ) DO EVENTS IF (cAlias)->VIEW == .T. // значит нужно добавить запись в БД:XLS_GALKI SELECT("XLS_GALKI") APPEND BLANK XLS_GALKI->FNN := RECNO() XLS_GALKI->FNAME := (cAlias)->FHEADER XLS_GALKI->FALIAS := aMenuHead[2] XLS_GALKI->FPOLE := aMenuHead[3] XLS_GALKI->FPICT := aMenuHead[4] XLS_GALKI->FTYPE := aMenuHead[5] XLS_GALKI->FKOD := aMenuHead[6] XLS_GALKI->FRECNO := nID // номер записи из XLS_HEADER->ID XLS_GALKI->FLETTER := CHR(64 + XLS_GALKI->FNN ) ELSE // значит нужно удалить запись в БД:XLS_GALKI SELECT("XLS_GALKI") LOCATE FOR XLS_GALKI->FRECNO == nID IF FOUND() DELETE PACK ENDIF DO WHILE !EOF() XLS_GALKI->FNN := RECNO() XLS_GALKI->FLETTER := CHR(64 + XLS_GALKI->FNN ) SKIP ENDDO ENDIF oBrw1:Reset() oBrw1:Refresh(.T.) oBrw2:DrawSelect() SELECT(cAlias) RETURN .T.[/pre2]
Vlad04: Haz Такую конструкцию использую только для информационных столбцов, прямое редактирование использую для простых таблиц, типа справочник (1-2 колонки), что сложней - в отдельной форме.
Vlad04: А есть примеры многострочных бровсов ? Вариантов может быть несколько: в одной строке - Поле 1 - Поле 2 или - Часть1(Поле 1) - Часть2(Поле 1)
SergKis: Vlad04 пишет А есть примеры многострочных бровсов ? сделать пример не сложно Tsb_array_2 demo.prg[pre2] STATIC FUNCTION CreateDatos() ... FOR i := 1 TO k aDatos[ i ] := { " ", ; // 1 i, ; // 2 ntoc( i ) + CRLF + "_123", ; // 3 Date() + i, ; // 4 ... [/pre2]
Haz: SergKis пишет: А есть примеры многострочных бровсов ? В примерах есть только вариант с широкими строками , где в ячейке может быть многострочный текст. Такой вариант удобно использовать в виде календарика с событиями , привычно смотрится и можно каждую ячейку развернуть в окно с подробным описанием. Все остальные случаи многострочного бровса можно поделить условно на 2 вида : 1) когда заранее готовятся многострочные данные для скармливания бровсу , это может быть подготовка массива, временной базы или результат SQL запроса к таблице. Получаем многострочность в однострочном бровсе. 2) когда под задачу пишется свой Skipper() и FieldWblock(). Этот путь не простой , но проходимый. Я использую вариант 1 , нет желания и времени возиться с 2 PS дополню вариант 1 предпочтителен еще и тем что позволяет фильтровать ( срывать подразделы )
Vlad04: Haz В примерах есть только вариант с широкими строками , где в ячейке может быть многострочный текст. Такой вариант удобно использовать в виде календарика с событиями , привычно смотрится и можно каждую ячейку развернуть в окно с подробным описанием. О каких примерах конкретно идёт речь ?
Haz: Vlad04 пишет: О каких примерах конкретно идёт речь ? О базовом примере MiniGUI\SAMPLES\Advanced\TsBrowse\demo.exe Menu -> Samples on Windows -> Sample 4 -> колонка Address
Andrey: Всем привет. Использую многострочный Tsbrowse (из 2х строк). Всё работает отлично. При экспорте в Эксель высота строк ставиться почему то как одна строка. И приходиться твблицу в Экселе вручную высоту править... Убийственная работа. Нельзя там в исходниках исправить высоту ячеек, сделать её зависимой от высоты таблицы ячеек ?
Vlad04: в Эксель высота строк ставиться почему то как одна строка. А у Эксель для данного столбца нельзя ли установить свойство - ПЕРЕНОСИТЬ ПО СЛОВАМ. Тогда Эксель будет сам высоту строк править
Andrey: Vlad04 пишет: А у Эксель для данного столбца нельзя ли установить свойство Я там исходник глянул .... и ничего не понял...
Haz: Andrey пишет: Я там исходник глянул .... и ничего не понял... Надо внимательнее глядеть . Вся запись в методе ::Excel2() идет в так называемом двоичном формате BIFF. Этот формат был основным форматом Excel до 2007 года. Дальше используется Open XML , а BIFF поддерживается только с целью совместимости. Именно с форматом BIFF связаны все ограничения Excel до 2007 года ( одно из них это 65535 строк , но есть много других) Так вот про внимательность, Excel в методе заполняется в цикле через вызов BiffRec( opCode , ... ), где этот самый opCode - константа Excel по кодам операций ( в инете ссылок полно ). В самой функции BiffRec() отсутствует обработка кода 8 ( код операции ROWHEIGHT ) и 37 ( код операции DEF_ROWHEIGHT). Видимо автору метода она была не нужна. Но это не мешает ее туда добавить самостоятельно. Функция живет в TSColumn.prg и ее содержимое понятно без каких либо тайных знаний. PS Подарок тем , кому лень искать константы: http://www.purebasic.fr/english/viewtopic.php?p=267584 PPS Добавлю свое мнение, которое может не совпадать со мнгоми форумчанами. Формат BIFF считаю устаревшим, и не уверен что его следует развивать библиотеке. В 2007 микрософт формально его похоронил перейдя на xml. В исходнках harbour есть что то типа xlsxml. Пишу с мобильного и точно не помню. Уверен xml более перспективен как экспорт данных, т. к. микрософт теперь его использует в основе движка. И вот в xml готов поучаствовать. Тестовые примеры выгрузки в Excel из harbour у меня идут отлично и по скорости и по оформлению. Прикрутить класс к Tsbrowse, например как :Excel3() считаю вопросом времени (свободного времени)
Haz: И в новое сообщение тоже PPS Добавлю свое мнение, которое может не совпадать со мнгоми форумчанами. Формат BIFF считаю устаревшим, и не уверен что его следует развивать библиотеке. В 2007 микрософт формально его похоронил перейдя на xml. В исходнках harbour есть что то типа xlsxml. Пишу с мобильного и точно не помню. Уверен xml более перспективен как экспорт данных, т. к. микрософт теперь его использует в основе движка. И вот в xml готов поучаствовать. Тестовые примеры выгрузки в Excel из harbour у меня идут отлично и по скорости и по оформлению. Прикрутить класс к Tsbrowse, например как :Excel3() считаю вопросом времени (свободного времени)
Andrey: Haz пишет: Но это не мешает ее туда добавить самостоятельно. [pre2]* ============================================================================ * FUNCTION BiffRec() Version 9.0 Nov/01/2009 * Excel BIFF record wrappers (Biff2) * ============================================================================ Function BiffRec( nOpCode, uData, nRow, nCol, lBorder, nAlign, nPic, nFont ) ....[/pre2] Блин, да это только для шаманов ....
Haz: Andrey пишет: Блин, да это только для шаманов Шаманом себя не считаю, но проблем не вижу. В понед гляну с компа. И прочитай мое последнее сообщение по поводу BIFF
Andrey: Haz пишет: И вот в xml готов поучаствовать. Тестовые примеры выгрузки в Excel из harbour у меня идут отлично и по скорости и по оформлению. Прикрутить класс к Tsbrowse, например как :Excel3() считаю вопросом времени (свободного времени) Очень хочется иметь этот новый класс в исходниках. Я так же готов поучаствовать в тестировании и настройке этого класса, по мере своей квалификации.
Vlad04: Haz Тестовые примеры выгрузки в Excel из harbour у меня идут отлично Это не OLE и Excel 2007 и выше? Тогда может в начале с примерами ознакомить ? Выгрузка в Tsbrows частный случай.
Vlad04: из Tsbrows
Haz: Vlad04 пишет: Это не OLE и Excel 2007 и выше? Тогда может в начале с примерами ознакомить ? Выгрузка в Tsbrows частный случай. Это не OLE, до 2007 микрософт отстегивал стороннему разработчику за использование xml позже написал свою компоненту. Поддержка xml была и до 2007. Примеры все в исходниках харбура. Знакомся на здоровье, все в свободном доступе. Ссылки на исходники есть в разделе Harbour на этом форуме
Dima: Andrey пишет: Я так же готов поучаствовать в тестировании и настройке этого класса, по мере своей квалификации. +1 Потестю на древнем Excel 2003
Haz: Dima пишет: Потестю на древнем Excel 2003 Так ты уже потестил)
Dima: Haz пишет: Так ты уже потестил) Это было не с Минигуи
Haz: Andrey пишет: Блин, да это только для шаманов .... Глянул с компа. Какие шаманы ??? примитив в 4 строки кода Чтоб ::Excel2 был зависим от высоты строк бровса нужно всего - то 1) перейти по ссылке которую я давал и найти там установку высоты строки по умолчанию увидеть там код команды, ее длину и прочитать про размерность единицы высоты [pre2] DEFHEIGHT.DEF_ROWHEIGHT_RECORD DEFHEIGHT\opcode = 37 DEFHEIGHT\length = 2 [/pre2] 2) Открыть исходник BiffRec() и после команды 36 ( ну чтоб попорядку ) вставить нашу 37 [pre2] Case nOpCode == 37 // DEF_ROWHEIGHT_RECORD record Default nCol := nRow cHead := I2Bin( 37 ) + ; // opCode I2Bin( 2 ) // body length cBody := I2BIN( uData ) [/pre2] 3) Открыть исходник Excel2() и задать высоту строк по умолчанию по высоте строки бровса ( про размерность по ссылке конечно прочитали - поэтому *20, но мне точнее показалось на 15 ) [pre2] FWrite( nHandle, BiffRec( 66, GetACP() ) ) FWrite( nHandle, BiffRec( 12 ) ) FWrite( nHandle, BiffRec( 13 ) ) FWrite( nHandle, BiffRec( 37 , ::nHeightCell * 20) ) [/pre2] PS Кто тут увидел шаманов
Andrey: Haz пишет: PS Кто тут увидел шаманов Да ты шаман ! Можешь у других спросить... Больше тебя и никто и не написал как делать ! Заодно и подскажи как для шапки таблицы такое же сделать ? А то тоже получается всегда в одну строчку !
Haz: Пересобрал библиотеку hbxlsxml.lib под BCC ( в родной с русским есть глюк) и дополнил свой пример Tsb_cursor выгрузкой в Excel по правой кнопке мышь. Это просто пример, как альтернатива BIFF или OLE Цветная раскраска и формулы поддерживается от автора библиотеки. по ссылке готовый пример, исходник примера и библиотека. исходники самой библы в искать харбуре click here
Haz: Andrey пишет: Заодно и подскажи как для шапки таблицы такое же сделать ? А то тоже получается всегда в одну строчку ! можно перед записью строки заголовков задать высоту по заголовку, а потом перед записью данных задать высоту данных
Andrey: Haz пишет: по ссылке готовый пример, исходник примера и библиотека. исходники самой библы в искать харбуре Пример понятен. Наверное всё таки тестовый пример нужно отдельно для этого делать, с разными типами полей. Или прикрутить этот новый экспорт в пример MiniGUI\SAMPLES\Advanced\Tsb_array_3 Желательно ещё бы сразу в примере задать многострочный Tsbrowse для экспорта. Суперхидер и подвал так же необходим в экспорте. А цвета наверное нужно как то задавать отдельным параметром в ЭКСПОРТ, тира 0-черно/белый, 1-цвет передать с Tsbrowse, 2-задать свои отдельные цвета. Это как предложение по цвету.
Haz: Andrey пишет: прикрутить этот новый экспорт в пример MiniGUI\SAMPLES\Advanced\Tsb_array_3 Я продемонстрировал сам механизм использования xmlxls. По которому можно примерно оценить скорость выгрузки 1000 строк и простейшее оформление. Конечно в этом механизме есть и форматы ячеек и формулы и использование цвета, объединения, задавать шрифты и пр. Конечно не все, но многое в нем есть. Сам по себе экспорт бровса в оригинальном виде в Excel, это как полуфабрикат. Выгрузка документа должна быть законченной, включая оформление. Под офомлением я понимаю вид документа, а не слответствие листа в Excel внешнему виду бровса. Оформление должно включать все реквизиты документа, а не только табличку. Сейчас лучшее оформление можно получить через OLE, но скорость оставляет желать лучшего. Понятно что можно выкинуть в олю массив, а потом наряжать лист, так и это не быстро. Наводить красоту можно и через тот же BIFF, но нет библиотеки, а в кодах по спецификации BIFF можно потеряться. В этом плане xmlxls это компромис с хорошей скоростью и возможностью рисовать почти как хочешь. Я на нем сделал несколько отчётов и могу сказать, что это именно альтернатива OLE для рисования на листе Excel. Теперь что касается выгрузки именно бровса в Excel. Встраивать сам класс в исходники TSBROWS скорее всго не рационально т. к. бровс потребует библиотеку xmlxls для сборки. А вот отдельный пример экспорта бровса сделать конечно можно. Подвалы, суперхидеры, шрифты и цвета, это все решаемо. Но делать из какого либо примера винегрет, тоже не вариант. Так что только отдельный и небольшой, чтоб было понятно что где.
Dima: Haz пишет: Встраивать сам класс в исходники TSBROWS скорее всго не рационально т. к. бровс потребует библиотеку xmlxls для сборки. +1
Andrey: Haz пишет: Но делать из какого либо примера винегрет, тоже не вариант. Так что только отдельный и небольшой, чтоб было понятно что где. Хорошо, я тогда сделаю пример таблицы для этого. А там далее уже поможешь... Возвращаюсь к вопросу: Haz пишет: можно перед записью строки заголовков задать высоту по заголовку, а потом перед записью данных задать высоту данных Можно для Григория (чтобы он добавил в библиотеку) дать код для этого ?
Haz: Andrey пишет: Хорошо, я тогда сделаю пример таблицы для этого. А там далее уже поможешь... договорились
Haz: Haz пишет: Можно для Григория (чтобы он добавил в библиотеку) дать код для этого ? Да можно конечно. Тем более, что это и так понятно по коду Excel2 куда что вставлять. Вопрос, а надо ли из простого экспорта, городить копию бровса?
Andrey: Haz пишет: Вопрос, а надо ли из простого экспорта, городить копию бровса? Нет не надо, надо только 2 позиции: 1) Просто если шапка таблицы (а это часто бывает) состоит из нескольких строк, то при экспорте надо учитывать высоту шапки. 2) Если данные таблицы 2-3 строки, то при экспорте тоже учитываем высоту данных таблицы. У меня несколько таблиц есть с такими параметрами, да я думаю и другие порадуются более корректному экспорту.
Haz: Andrey пишет: Нет не надо, надо только 2 позиции: [pre2] В :Excel2() после этого FWrite( nHandle, BiffRec( 66, GetACP() ) ) FWrite( nHandle, BiffRec( 12 ) ) FWrite( nHandle, BiffRec( 13 ) ) Следующую строку убираем ( если кто то ужк успел ее суда добавить ) // FWrite( nHandle, BiffRec( 37 , ::nHeightCell * 15) ) После этого ... If ! Empty( cTitle ) cTitle := StrTran( cTitle, CRLF, Chr( 10 ) ) nAlign := If( Chr( 10 ) $ cTitle, 5, 1 ) FWrite( nHandle, BiffRec( 4, cTitle, 0, 0,, nAlign ) ) nLine := 3 EndIf Добавляем это FWrite( nHandle, BiffRec( 37 , ::nHeightHead * 15) ) А После этого ... If bPrintRow != Nil .and. ! Eval( bPrintRow, nRow ) ::Skip( 1 ) Loop EndIf Добавляем это If nRow == 2 FWrite( nHandle, BiffRec( 37 , ::nHeightCell * 15) ) END [/pre2] Andrey пишет: У меня несколько таблиц есть с такими параметрами, да я думаю и другие порадуются более корректному экспорту. может кто и порадуется , а по мне это просто способ схалявить на выгрузке таблицы. НУ чтоб юзер отстал , или для себя бумажку распечатать надо. такую выгрузку до ума еще доводить и доводить ( к примеру форматы ячеек ставить "процентный" или "финансовый" или как принято в фин отчетности - все отрицательные числа в скобках ) Проще уж сразу выгружать нормально
Haz: для справки; Обнаружил неприятную особенность :aCheck , при задании в качестве картинки хендла картинки из внешней переменной ( в моём случаи PUBLIC ) , повторный вызов TS картинку уже не показывал . Беглый просмотр кода исходников показал что при дестрое TS , так же дестроятся и эти хендлы. Т.е. закрытие бровса убивало PUBLIC переменные с хендлами картинок. Из ситуации вышел без изменения исходников , храня хендлы в самом бровсе через [pre2] __objAddData (oBrw, 'hPic1' ) oBrw:hPic1:= LoadImage("PICTURE1") и oBrw:GetColumn( 'COL1'):aCheck := {oBrw:hPic1, nil } [/pre2]
SergKis: Haz пишет oBrw:GetColumn( 'COL1'):aCheck := {oBrw:hPic1, nil } Почему сразу не делать oBrw:GetColumn( 'COL1'):aCheck := {LoadImage('PICTURE1'), nil } ?
Haz: SergKis пишет: Почему сразу не делать Логично, но не рискнул. При uBmpCell при этом идёт утечка памяти. В aCheck возможно утечка не проявится... тестировать не стал Хотя uBmpCell я вызвал в блоке...
SergKis: Haz пишет При uBmpCell при этом идёт утечка памяти. Как я понимаю, uBmpCell это полностью собственное управление, сам поставил, сам снял\освободил. Остальные свойства доводились "до кондиции"[pre2] If ::aSortBmp != Nil DeleteObject ( ::aSortBmp[ 1 ] ) DeleteObject ( ::aSortBmp[ 2 ] ) EndIf If ::aCheck != Nil DeleteObject ( ::aCheck[ 1 ] ) DeleteObject ( ::aCheck[ 2 ] ) EndIf If Len( ::aColumns ) > 0 For i := 1 To Len( ::aColumns ) If Valtype( ::aColumns[ i ]:aCheck ) == "A" AEval( ::aColumns[ i ]:aCheck, {|hBmp| If( Empty( hBmp ), , DeleteObject( hBmp ) ) } ) EndIf If Valtype( ::aColumns[ i ]:aBitMaps ) == "A" AEval( ::aColumns[ i ]:aBitMaps, {|hBmp| If( Empty( hBmp ), , DeleteObject( hBmp ) ) } ) EndIf Next EndIf [/pre2] Рекомендовал бы, вместо uBmpCell, использовать :aBitMaps с цифровым значением (Tsb_aBitMaps)[pre2] oBrw:GetColumn("FLD1"):aCheck := { LoadImage(".\RES\Print32.png"), NIL } oBrw:GetColumn("FLD2"):aCheck := { LoadImage(".\RES\Save32.png" ), NIL } oBrw:GetColumn("FLD3"):aCheck := { LoadImage(".\RES\Mail32.png" ), NIL } oBrw:GetColumn("FLD4"):aCheck := { LoadImage(".\RES\check1.bmp" ), ; LoadImage(".\RES\check0.bmp") } 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" ) } [/pre2]
Haz: SergKis пишет: Рекомендовал бы, вместо uBmpCell, использовать :aBitMaps Да, согласен спасибо за подсказку. В uBmpCell утечка была именно из-за блока. При каждом DrawLine() инмциализировался новый хендл.
SergKis: SergKis пишет Остальные свойства доводились "до кондиции" Упс. Потерялось однако. В моей версии еще такие строки есть в методе Destroy():[pre2] ... If Len( ::aColumns ) > 0 For i := 1 To Len( ::aColumns ) If Valtype( ::aColumns[ i ]:aCheck ) == "A" AEval( ::aColumns[ i ]:aCheck, {|hBmp| If( Empty( hBmp ), , DeleteObject( hBmp ) ) } ) EndIf If Valtype( ::aColumns[ i ]:aBitMaps ) == "A" AEval( ::aColumns[ i ]:aBitMaps, {|hBmp| If( Empty( hBmp ), , DeleteObject( hBmp ) ) } ) EndIf Next EndIf If Valtype(::aBitMaps) == "A" AEval(::aBitMaps, {|hBmp| If( empty(hBmp), , DeleteObject(hBmp) ) }) EndIf ... [/pre2] т.е. в тек. версии утечка есть при oBrw:aBitMaps := {LoadImage(...), ...} на колонках утечки нет.
Haz: SergKis пишет: т.е. в тек. версии утечка есть при oBrw:aBitMaps := {LoadImage(...), ...} на колонках утечки нет Возможно и а текущей не будет утечки если aBitMaps задавать массивом. Внутренние переменные бровса убьются сборщиком мусора после дестроя самого бровса. А во время работы бровса новые объекты не создаются. В моем же случае было uBmpCell := {¦¦ if( lFllag, Loadimage(), nil)} тоесть при навигации бровса постоянно создаётся новый хендл картинки, не уничтожая старый. GdiPlus при навигации показал утечки. Обнаружил проблему Дима, у него пользователь от скуки гонял курсор вверх вниз и брос падал. С дестроем в твой версии все понятно. Непривычно само поведение - кормишь бровсу переменную, а он ее убивает. Этот момент нужно учитывать. У меня маленькая статусная картинка используется в нескольких модулях и в каждом бровсе, я ее определил в паблик переменной при старте программы сслаюсь на нее везде. т. е. LoadImage() делал один раз. Поскольку aCheck практически не использовал то проблем не видел. Будем считать это особеннстью бровса.
SergKis: Haz пишет В моем же случае было uBmpCell := {¦¦ if( lFllag, Loadimage(), nil)} Это скорее недосмотр кода, т.к. именно для oCol:uBmpCell можно использовать PUBLIC\PRIVATE переменные, т.е. oCol:uBmpCell := {¦¦ if( lFllag, m->hPicture1, nil)} или из массива брать handle image Будем считать это особеннстью бровса Пара LoadImage() -> DeleteObject() для aChecк, aMitMaps как особенность тсб, просто надо учитывать, а усилить поведение, при необходимости, всегда можно, к примеру :aCheck := { 'PICTURE1', Nil } - будет внутри делать LoadImage('PICTURE1') и DeleteObject() при Dectroy() :aCheck := { hPicture1, Nil } - не будет делать ни LoadImage() ни DeleteObject() при Dectroy() для :aBitMaps аналогично. Надо ли ?
Haz: SergKis пишет: aChecк, aMitMaps как особенность тсб, просто надо учитывать я про это же . Пока сам не наткнешься- не поймешь )
gfilatov2002: SergKis пишет: В моей версии еще такие строки в методе Destroy(): Благодарю за исправление Добавил его в текущий код. Кстати, уже готов RC 3 для новой сборки. Кратко, что нового см. ниже [pre2]- The RadioGroup control supports an optional AUTOSIZE clause. - The Report Generator by Roberto Lopez was moved to MiniGUI core. - Added the command CHECK TYPE [ SOFT ] <var1> AS <type1> [ , <var2> AS <type2> [ , <varN> AS <typeN> ] ] (synchronized with Official HMG). - The function HttpConnect was modified to use TUrl and TIpClientHttp classes. - Updated and improved the following libraries: TSBrowse, HbNetIO, SddODBC. - Updated Harbour Compiler 3.2.0dev to a latest Git-version. - Added the new interesting samples and updated some Advanced samples. [/pre2]
Andrey: Haz пишет: А вот отдельный пример экспорта бровса сделать конечно можно. Подвалы, суперхидеры, шрифты и цвета, это все решаемо. Но делать из какого либо примера винегрет, тоже не вариант. Так что только отдельный и небольшой, чтоб было понятно что где. Сделал отдельный пример. Отправил на почту. Ждем что выйдет из под руки мастера !
Haz: Andrey пишет: Ждем что выйдет За пару дней, что нибудь да выйдет.
gfilatov2002: Andrey пишет: Отправил на почту На какую Ничего не пришло...
Haz: gfilatov2002 пишет: На какую Ничего не пришло... Григорий, мне пришло Андрей хочет выгрузку в Excel из бровса в формате XML увидеть. Я так вывожу отчёты из программ. Качество оформления как OLE, скорость выгрузки как BIFF
gfilatov2002: Haz пишет: мне пришло Понял, буду ждать от Вас выгрузку в Excel из бровса в формате XML
Haz: Andrey пишет: Сделал отдельный пример. Отправил на почту. Ждем что выйде Андрей, скинул на почту. Для справки : Под выгрузку немного допиливал библиотеку hbxlsxml, в оригинальной косяки с русским языком и многострочными ячейками в Excel. Библиотека не секрет , могу выложить все исходники. Теперь немного про особенности XML выгрузки . Для выгрузки необходимо сначала определить все возможные форматы ячеек , которые будут на листе экселя. И в момент экспорта ссылаться на них, в примере это видно. Сама выгрузка должна идти заполнением листа сверху - вниз и слева - направо т.е сначала первая строка , потом вторая и так далее , вернуться на первую уже нельзя ( тоже и по колонкам ) И наконец выгрузка бровса - частный случай. Я рисую морду отчету и гружу из DBF ЗЫ В примере не стал трогать Excel3() , которую подправил Сергей, а написал Brw2Xml и вставил ее вызов.
Andrey: Haz пишет: Андрей, скинул на почту. 1) Заголовок таблицы - косяк: размер фонта не тот.[pre2] FUNC Brw2xml( oBrw, cFile, lActivate, hProgress, cTitle ) нужно как сейчас в библиотеке: Excel2( cFile, lActivate, hProgress, aTitle, lSave, bPrintRow ), где aTitle := { cTitle, hFont } // титул со своим фонтом из-за этого я и сделал похожую функцию: Excel3Xml( oBrw, cFile, lActivate, aTitle, lSave ), где aTitle := { cTitle, hFont } // титул со своим фонтом[/pre2] 2) Суперхидера в экспорте НЕТ ! 3) Формат вывода 6-ой колонки не соответствует Tsbrowse 4) Далее нет цветового оформления. Т.е. нужно бы сделать цвета таблицы полностью как в Tsbrowse. Возможно ли такое сделать ? А так - классно получилось ! Haz пишет: Библиотека не секрет , могу выложить все исходники. Это наверное тоже нужно добавить в проект. Пускай Григорий папку отдельно сделает, чтобы были исходники, откуда плясать можно всем. P.S. Судя по правкам в исходнике, у тебя ещё старая версия МиниГуи !
Haz: Andrey пишет: Заголовок таблицы - косяк: размер фонта не тот. Я его и не делал, все для этого есть. Как задать шрифт видно из примера по хидеру и футеру. Опрелить стиль для заголовка дело 3 минут. То же и суперхидер, сделать можно, но зачем? Задачу воспроизводства бровса в Excel один в один, решить то можно, только кому она нужна? Более востребованы быстрые выгрузки в Excel, тем более оформленные как отчёты. Andrey пишет: Формат вывода 6-ой колонки не соответствует Tsbrowse Форматы все задаются в функции XMLSetDefault(), специально задал только 2. Не хочу писать транслятор с форматов PICTURE в форматы Excel. Это отдельное и бесполезное развлечение. Andrey пишет: Далее нет цветового оформления. Т.е. нужно бы сделать цвета таблицы полностью как в Tsbrowse. Возможно ли такое сделать ? Возможно, при условии что цвет задан явно, а не блоком кода. В примере это показано по хидеру и футеру. Кстати твоя выгрузка через Excel2() вообще ничем в этом раскладе, ни шрифтов ни цвета. PS Andrey пишет: Судя по правкам в исходнике, у тебя ещё старая версия МиниГуи ! Там правка только карго касается, не гонюсь сразу обновряться, т. к. некоторые библиотеки харбура приходится обновлять (в поставке они старые) Да и сюрпризы в отлаженном коде после обновлений иногда бывают. Обновляюсь когда есть время на ловлю блох в своих проектах после обновлений. Ну и главное, мы тут переписываемся, а народ не знает о чем. Кто выложит пример? PS сегодня, внесу мелкие правки
Andrey: Haz пишет: Ну и главное, мы тут переписываемся, а народ не знает о чем. Кто выложит пример? Григорию отправлю пример, как сделаем. Haz пишет: Возможно, при условии что цвет задан явно, а не блоком кода. В примере это показано по хидеру и футеру. Кстати твоя выгрузка через Excel2() вообще ничем в этом раскладе, ни шрифтов ни цвета. Тогда, если можно дай пример закраски шапки таблицы (любым цветом) и отрицательных чисел. Чтобы потом можно было делать на базе этого свою раскраску отчёта. А выгрузка через Excel2() ограничена, из-за чего я и ухватился за твой пример. Haz пишет: Форматы все задаются в функции XMLSetDefault(), специально задал только 2. Не хочу писать транслятор с форматов PICTURE в форматы Excel. Это отдельное и бесполезное развлечение. Согласен с этим, но в качестве примера как сделать ТОЛЬКО для одного формата я и ввел в пример такое поле. Чтобы потом, каждый кто будет использовать это, смог сделать свою обработку.
Haz: Andrey пишет: Согласен с этим, но в качестве примера как сделать ТОЛЬКО для одного формата я и ввел в пример такое поле. Чтобы потом, каждый кто будет использовать это, смог сделать свою обработку. Лови https://drive.google.com/open?id=1J_3jTxCSvdPg_xzhhLgSqi7yro6l_NyL
Haz: Andrey пишет: Тогда, если можно дай пример закраски шапки таблицы (любым цветом) и отрицательных чисел. Чтобы потом можно было делать на базе этого свою раскраску отчёта. в примере шапка и так красится, что касается отрицательных чисел , то это задается теми же форматами Excel к примеру так "# ##0,00_ ;[Красный]-# ##0,00\ " на числовой колонке PS Проверил. Точнее так [pre2] XmlSetDefault( oBrw ) // Можно значения по умолчанию переопределять oBrw:aColumns[6]:XML_Format := "00\:00\:00" oBrw:aColumns[9]:XML_Format := "0.00_ ;[Red]\-0.00\ " Brw2Xml(oBrw, "TEST.XML", .T.,, aTitle) XmlReSetDefault( oBrw ) [/pre2]
Haz: Haz пишет: А выгрузка через Excel2() ограничена На самом деле если бы была нормальная спецификация пл BIFF2(4) , то выгрузка Excel2() довольно легко дополняется. Видел только англоязычную где то, да и с примерами по BIFF очень скудно.
Andrey: Haz пишет: в примере шапка и так красится, У меня нет. Excel 2003
Dima: Andrey пишет: Excel 2003 Я думал один такой на форуме
Haz: Andrey пишет: У меня нет. Excel 2003 Да , у 2003 ограничения по палитре. Попробуй в коде подставить [pre2] вместо этого oStyle:bgColor( '#' + NToC(oBrw:nClrSpcHdBack, 16) ) вот это oStyle:bgColor( '#' + NToC(CLR_GREEN, 16) ) [/pre2]
Haz: Dima пишет: Я думал один такой на форуме Надо же чтоб кто то на старье потестил )))
Dima: Haz пишет: На самом деле если бы была нормальная спецификация пл BIFF2(4) Не она ? https://www.openoffice.org/sc/excelfileformat.pdf
Haz: Dima пишет: Не она ? Это видел, кто возьмется перевести на "великий и могучий" ?
Andrey: Я поставил для суперхидера, шапки и подвала: oStyle:bgColor( '#' + NToC(CLR_HGRAY, 16) ) // only Excel 2003 Пример получился классным. При смене таблицы на одну строку: #define MULTILINE_TSB .F. , то же экспортирует классно. Остался ОДНА проблема касающаяся METHOD Excel2(). При использовании колонки в Tsbrowse числового формата "@R 99:99:99", то при экспорте всегда лезет такая ошибка: И колонка остаётся без формата. Я сделал 6-ю колонку специально для тестирования. Можно как нибудь убрать/починить этот формат для METHOD Excel2() ?
Haz: Andrey пишет: Можно как нибудь убрать/починить этот формат для METHOD Excel2() ? или полностью переделывать , то есть все предустановки выносить из Excel2() и назначать до экспорта ( у меня для этого служит XMLSetDefault() и переопределения перед экспортом) или навсегда вшивать этот ( никому не нужный формат ) в исходник Excel2(). Сам формат можно подсмотреть у меня в выгрузке.
Andrey: Haz пишет: или навсегда вшивать этот ( никому не нужный формат ) в исходник Excel2(). Хотя бы так или сделать определение этого формата до вызова Excel2(), как ты сделал у себя: [pre2] XmlSetDefault( oBrw ) // Можно значения по умолчанию переопределять oBrw:aColumns[6]:XML_Format := "00\:00\:00" oBrw:aColumns[9]:XML_Format := "0.00_ ;[Red]\-0.00\ " Brw2Xml(oBrw, "TEST.XML", .T.,, aTitle) // экспорт в Excel XmlReSetDefault( oBrw )[/pre2] А лучше наверное в исходнике дать этот формат и небольшое описание, типа для назначения своих форматов. Можно название твоей функции поменять на Excel3Xml() ? И ещё вопрос: [pre2] For nCol := 1 To Len( oBrw:aColumns ) uData := Eval( oBrw:aColumns[ nCol ]:bData ) cType := ValType( uData )[/pre2] можно добавить сюда сразу:[pre2] nBackColor := oBrw:aColumns[ nCol ]:nClrBack oStyle:bgColor( '#' + NToC(nBackColor, 16) ) // Excel > 2003 [/pre2] Или так не пойдёт, потому что цвета Tsbrowsa состоят из блок-кода ?
Haz: Andrey пишет: сделать определение этого формата до вызова Excel2(), как ты сделал у себя: Это потребует переделки метода, лучше выносить наружу, т.к форматов в Excel гораздо больше чем в харбур и могут они быть любые Andrey пишет: Можно название твоей функции поменять на Excel3Xml() Называй как хочешь )
SergKis: Andrey пишет Или так не пойдёт, потому что цвета Tsbrowsa состоят из блок-кода ? Сделай обработку блока кода[pre2] nBackColor := oBrw:aColumns[ nCol ]:nClrBack If Valtype( nBackColor ) == "B" Eval( nBackColor, oBrw:nAt, nCol, oBrw ) EndIf oStyle:bgColor( '#' + NToC(nBackColor, 16) ) // Excel > 2003 [/pre2]
SergKis: PS сори, пропустил пока набирал (маленький экран) nBackColor := Eval( nBackColor, oBrw:nAt, nCol, oBrw )
Andrey: SergKis пишет: Сделай обработку блока кода Сделал. Цвета не появляются ! Хотя коды цвета правильные, совпадают с CLR_HGRAY Вот код:[pre2] For nCol := 1 To Len( oBrw:aColumns ) uData := Eval( oBrw:aColumns[ nCol ]:bData ) cType := ValType( uData ) nBackColor := oBrw:aColumns[ nCol ]:nClrBack If Valtype( nBackColor ) == "B" nBackColor := Eval( nBackColor, oBrw:nAt, nCol, oBrw ) EndIf //? nLine, nCol, nBackColor, "== 12632256", CLR_HGRAY oStyle:bgColor( '#' + NToC(nBackColor, 16) ) switch cType[/pre2] Наверное ещё что-то нужно сделать, чтобы применить цвет к этой ячейке ?
Haz: Andrey пишет: Наверное ещё что-то нужно сделать, чтобы применить цвет к этой ячейке ? Стиль нужно определить заранее. С блоками скорее в два прохода придётся. Сначала анализируем весь бровс на возможные форматы по цвету, шрифту и пр. На основе анализа формируем все эти форматы, а потом, при выводе бровса в зависимости от результата блока выбираем нужный формат. Excel читает XML построчно. К момену вывода ячейки формат должен быть определен Из примера куска кода не ясно где он расположен в тексте Ps почитал выше, тут не сработает. Тут идёт вывод и форматы уже определены ранее. Андрей, ты зациклен на воспроизводстве внешнего вида бровса. Либо заранее опрелить цвет которам ты будешь рисовать. Либо взять цвет из каждой ячейки при первомпроходе, сформитовать форматы запомнив координаты. А при выводе брать по координатам. Я же сторонник того, что копия бровса в Excel никому не нужна. Достаточно вывести данные в читаемом и оформленном виде, для маньков путь анализа бровса. Другим способом можно назвать условное ворматирование Excel, но там тоже все не само появится, и нужно как минимум знать как написать условный формат.
Andrey: Haz пишет: Из примера куска кода не ясно где он расположен в тексте Вот код: [pre2] While nLine <= nLen oSheet:cellHeight( nRow, 1, oBrw:nHeightCell / 1.3 ) For nCol := 1 To Len( oBrw:aColumns ) uData := Eval( oBrw:aColumns[ nCol ]:bData ) cType := ValType( uData ) nBackColor := oBrw:aColumns[ nCol ]:nClrBack If Valtype( nBackColor ) == "B" nBackColor := Eval( nBackColor, oBrw:nAt, nCol, oBrw ) EndIf //? nLine, nCol, nBackColor, "== 12632256" oStyle:bgColor( '#' + NToC(nBackColor, 16) ) switch cType[/pre2] Haz пишет: Я же сторонник того, что копия бровса в Excel никому не нужна. Достаточно вывести данные в читаемом и оформленном виде, для маньков путь анализа бровса. Согласен, просто хотелось бы иметь просто пример как это делается (оформление цветами). В качестве примера и сделал меню для повтора цветов:[pre2] MENUITEM 'color table white ' ACTION nTsbColor := 1 FONT Font1 MENUITEM 'color table gray ' ACTION nTsbColor := 2 FONT Font1 MENUITEM 'color of the table "ruler"' ACTION nTsbColor := 3 FONT Font1 MENUITEM 'color of the table "columns"' ACTION nTsbColor := 4 FONT Font1 MENUITEM 'color of the table "chess"' ACTION nTsbColor := 5 FONT Font1[/pre2] Вот я решил сделать цвета в xml и не могу с ходу. Для этого нужно разбираться. А что за пример в котором не показано как можно сделать ! И не маньяк я, а хочу иметь в качестве примера - как нужно правильно делать, а не методом тыка работает/не работает. Т.е. отдельно написать: // секция для цветового оформления таблицы. Шапку, суперхидер и подвал как заполнять цветом уже понятно, осталось только саму таблицу покрасить.
Haz: Andrey пишет: Вот я решил сделать цвета в xml и не могу с ходу. Для этого нужно разбираться. Определить стиль перед выводом заранее. При выводе указать каким стилем. Ты же пытаешься во время вывода ячеек бровса сунуть цвет непонятно какому стилю. Это как раскраски, хочу фигурку закрасить желтым, беру жёлтый фломастер каторый уже заранее преготовлен. Я же не просто так говорил про варианты : 1 выбирать заранее определенные стили - условные цвета вывода 2 попытаться при прогоне по бровсу сформировать все комбинации цвет, шрифт, рамка, выравнивание. Опрелить их как стили с привязкой к координатам ячейки и при выводе бровса брать эти стили 3 тоже что и 2 но использовать условное форматирование. Мне не сложно еще раз повторить, что Excel читает XML сверху вниз и слева направо. То есть сначала раскладываем фломастеры и их уже не меняем. Потом рисуем тем что разложили. Реализация динамической раскраски начинается с вопроса, а какие фломастеры потребуются. Ну уж если совсем по простому То обрати внимание что цвет шапки и подвала задаётся в соответствуюших местах кода под коментарием ОПРЕДЕЛЯЕМ СТИЛИ ШАПКИ и ОПРЕДЕЛЯЕМ СТИЛИ ПОДВАЛА. Там же есть и комментарий ОПРЕДЕЛЯЕМ СТИЛИ КОЛОНОК, вот туда свой цвет и пихай. И учти каждый стиль одного цвета, нужен другой цвет - определяй новый стиль.
Andrey: Haz пишет: На самом деле если бы была нормальная спецификация пл BIFF2(4) , то выгрузка Excel2() довольно легко дополняется. Видел только англоязычную где то, да и с примерами по BIFF очень скудно. Пример MiniGUI\SAMPLES\Advanced\Tsb_Brw2xml из последней версии МиниГуии - классный получился ! Спасибо Haz ! Экспорт для Excel2() для нескольких строк - то что нужно ! Даже наверное шрифты можно не уменьшать. Но да ладно, пускай остаются в качестве примера, как можно делать. Единственно что не хватает в экспорте для Excel2() рамок в ячейках таблицы. В шапке и подвале таблицы рамки есть, а на ячейках нет ! Можно это как то подправить ?
Haz: Andrey пишет: Единственно что не хватает в экспорте для Excel2() рамок в ячейках таблицы. В шапке и подвале таблицы рамки есть, а на ячейках нет ! Можно это как то подправить ? А самому хотя бы посмотреть что мешает ? [pre2]Function BiffRec( nOpCode, uData, nRow, nCol, lBorder, nAlign, nPic, nFont )[/pre2]
Andrey: Прикрутил к этому же проекту ещё один экспорт, через ОЛЮ ! 1) Для одной строки всё прекрасно работает, для многострочных строк нет ! 2) Как задать титул перед шапкой определённым фонтом (также, как для нового oBrw:Excel2() ) ? Как бы исправить исходники ? Проект вот тут - https://cloud.mail.ru/public/JNeH/xGmMBvmVD Почему не работает в методе oBrw:ExcelOle( cXlsFile, ....) следующее назначение ? [pre2] lSave := .T. cPath := GetStartUpFolder() + "\" // путь записи файла cMaska := "A14_ДолгСальдо" // шаблон файла cXlsFile := cPath + cMaska + "_" + DTOC( DATE() ) + "_" cXlsFile += SUBSTR( CharRepl( ":", TIME(), "-" ), 1, 5 ) + ".xls"[/pre2] Обрезает до A14_ДОЛГСАЛЬДО_12.03.2018_23-18
Andrey: Andrey пишет: Почему не работает в методе oBrw:ExcelOle( cXlsFile, ....) следующее назначение ? lSave := .T. cPath := GetStartUpFolder() + "\" // путь записи файла cMaska := "A14_ДолгСальдо" // шаблон файла cXlsFile := cPath + cMaska + "_" + DTOC( DATE() ) + "_" cXlsFile += SUBSTR( CharRepl( ":", TIME(), "-" ), 1, 5 ) + ".xls" Обрезает до A14_ДОЛГСАЛЬДО_12.03.2018_23-18 Убрал в модуле h_tbrowse.prg строку 4809: [pre2] If ! Empty( cXlsFile ) //cXlsFile := AllTrim( StrTran( Upper( cXlsFile ), ".XLS" ) ) поставил // EndIf[/pre2] Перестало обрезать ! И убрался только верхний регистр ! То что нужно ! Григорий, убери пожалуйста в исходниках эту строку. Или замени её как нужно, для следующих версий МиниГуи ! Заранее спасибо !
Andrey: [pre2] oBrw:ExcelOle( cXlsFile, lActivate, hProgress, cTitle, hFont, lSave, bExtern, aColSel, bPrintRow ) cXlsFile // имя файла lActivate := .T. // открыть Excel hProgress := nil // хенд для ProgressBar lSave := .T. // сохранить файл bExtern := nil // ? aColSel := nil // ? bPrintRow := nil // ?[/pre2] Подскажите пожалуйста, что за параметры (за что отвечают) ?
Andrey: SergKis пишет: Предлагаю новый метод для tsb, для растяжки нескольких колонок до размера тсб по ширине. ..... Использование при ширине tsb > ширины колонок :AdjColumns() - все колонки :AdjColumns({"NAME", "SUMMA"}) - указанные колонки по cName :AdjColumns({3, 4, 5}) - указанные колонки по номеру А нормально будет работать ? Я при включении предыдущего метода на примере Tsb_Config.prg [pre2] oBrw:nAdjColumn := 2 // stretch column 2 to fill the voids in the right Tbrowse[/pre2] имел хороший баг при изменении ширины окна ! Григорий помог его решить через: [pre2] // repartition column 2 (1 + 1 -SELECTOR) - otherwise buggy oBrw:bInit := {|| oBrw:SetColSize( 2, nWidthFirstColumn )} .... ////////////////////////////////////////////////////////////////// FUNCTION ResizeBrowse() .... Eval(oBrw:bInit) // read the second column of the table ... [/pre2]
SergKis: Andrey пишет А нормально будет работать ? Я при включении предыдущего метода на примере Tsb_Config.prg oBrw:nAdjColumn := 2 SergKis пишет Использование при ширине tsb > ширины колонок т.е. ты вызываешь метод так (др. вариантов не предполагал пока)[pre2] :AdjColumns({3, 4, 5}) // или :AdjColumns() END TBROWSE oRpt:SetNoHoles()[/pre2] возможно при увеличении окна и размера тсб, тоже сработает, если вызвать. Можешь пробовать libу кинул
Andrey: SergKis пишет: Можешь пробовать libу кинул Классно ! Работает ! Но, если использовать [pre2] oBrw:HideColumns( {10} ,.t.) // скрыть колонки [/pre2] То последняя колонка становится слишком широкой ! Т.е. наверное не учитываются скрытые колонки ? А так очень понравился этот метод !
SergKis: Andrey пишет То последняя колонка становится слишком широкой ! Есть такая бяка. Надо правки делать[pre2] METHOD AdjColumns( aColumns, nDelta ) CLASS TSBrowse ... LOCAL nVisible := 0, aVisible := {} ... AEval( ::aColumns, {|oc| nVisible += iif( oc:lVisible, oc:nWidth, 0 ) }) AEval( aCol , {|nc| iif( obr:aColumns[ nc ]:lVisible, AAdd(aVisible, nc), Nil ) }) k := Len(aVisible) ... For i := 1 To k c := aVisible[ i ] ... [/pre2] вроде работает, погоняй еще, либу кинул
Andrey: SergKis пишет: вроде работает, погоняй еще, либу кинул Погонял... Не работает... Свой пример кинул.
SergKis: Andrey пишет Погонял... Не работает... SergKis пишет :AdjColumns({3, 4, 5}) // или :AdjColumns() END TBROWSE а у тебя[pre2] :lLockFreeze := .T. // избегать прорисовки курсора на замороженных столбцах :AdjColumns() // растяжка колонок до размера тсб по ширине ... :GetColumn("Name_8"):lEdit := .T. :HideColumns( {10} ,.t.) // скрыть колонки TsbColor( oBrw ) // задание цветов таблицы ... т.е. сначала разместили по ширине колонки, потом скрыли. ЗАМЕЧАТЕЛЬНО Убрал в самый низ ... :AdjColumns() // растяжка колонок до размера тсб по ширине END WITH // oBrw объект снят сработало как надо. [/pre2]
Andrey: SergKis пишет: Убрал в самый низ Поторопился я ... Как всегда.
Andrey: Сделал пример ! Tsb кладу на уже готовую форму в другом модуле. Всё показывает нормально, кроме вертикального скролинга. Должен быть, а не показывает при старте. Если стрелками(мышкой) подёргать, то линия скролинга появляется... обгрызанная, без стрелки вверху и внизу. Можно ли как то перерисовать весь вертикальный скролинг ?
Andrey: Новая версия МиниГуи - 18.04 Метод oBrw:ExcelOle(). При экспорте в таблице столбец с номерами домов (примерно такой порядок: 1, 2, 5, 9/2 и т.д.) неправильно экспортирует. Превращает этот столбец в 1,2,5, 09 февраля. Григорий, я сделаю тестовый пример с этим и вышлю на почту.
Andrey: Как указать правильно формат показа в Tsbrowse для текстового поля (значения "123300") по шаблону "@R 99:99:99" ? Для числового поля показ идёт правильный, а как задать такой же шаблон для текстового поля ? Если создаём aPict := { nil, nil, nil, nil, nil, "@R 99:99:99", nil } и передаём в [pre2]oBrw:SetArrayTo(aArray, aFontHF, aHead, aSize, aFoot, aPict, aAlign, aName)[/pre2] То показ 6 колонки будет так - "123300" Если сделать [pre2] oBrw:SetArrayTo(aArray, aFontHF, aHead, aSize, aFoot, aPict, aAlign, aName) oBrw:aColumns[6]:cPicture := '@R 99:99:99' [/pre2] То показ в 6 колонке будет уже "12:33:00" Опять глюк нашёл в Tsb ?
SergKis: Andrey пишет Опять глюк нашёл в Tsb ? Это от того, что игнорируешь исходники. :SetArrayTo не обрабатывает сложные Picture, а делает расчет ширины колонок для размещения правильно данных header, строк, footer (что бы помещалось все в колонке при просмотре), превращая Picture в простой вид для строки к примеру cPict := Replicate( "X", Len( ::aDefValue[ nI ] ) ). Все что не устраивает, в полученном варианте, правишь сам после создания тсб. К примеру, в массиве в колонке мах длина всех элементов 20 символов, но в процессе работы может быть 30 длина, тогда можешь регулировать колонкой задав ширину в пикселях или задав aPict[6] := repl('X', 30), ::aDefValue[ 6 ], будет от заданного aPict[6].
Andrey: Предложение по METHOD Excel2() - сделать как у METHOD ExcelOle() в самом конце метода: [pre2] If lActivate ShellExecute( 0, "Open", If( lSave, cFile, cWork ),,, 3 ) EndIf ::Display() If hProgress != Nil SendMessage( hProgress, PBM_SETPOS, 0, 0 ) EndIf Return Nil [/pre2] В METHOD ExcelOle() предлагаю сделать в самом начале: [pre2] Default lSave := ! lActivate .and. ! Empty( cXlsFile ), ; cXlsFile := "", ; hFntTitle := hFont CursorWait() // Check the file name for the number of points If AtNum( ".", HB_FNameName( cFile ) ) > 0 cMsg := 'Calling from: ' + ProcName(0) + '(' + hb_ntos( ProcLine(0) ) cMsg += ') --> ' + ProcFile(0) + ';;' cMsg += 'Output File Name - "' + HB_FNameName( cFile ) + '";' cMsg += 'contains several signs dot !;' cMsg += 'Excel can "truncate" the file name !;;' cMsg := AtRepl( ";", cMsg, CRLF ) MsgStop( cMsg , "Error" ) Endif If ::lSelector[/pre2] Только это обязательно нужно сделать, я ОЧЕНЬ ДОЛГО не мог понять почему у меня режет имя файла, а на некоторых компах нет ! Чтобы потом другим было легче это понять !!! Если в имени файла использовать несколько точек, то САМ EXCEL "режет" имя файла. Можно конечно сделать немного по другому: переименовать входящее имя файла, но тогда нужно будет потом закрывать Ole-Эксель, и открывать его заново с переименованным файлом. Не очень красивое решение здесь для Экселя. Этот вариант сделал для Экспорта Dbf-файла.
Haz: Andrey пишет: предлагаю сделать Поддержу Андрея. По первому предложению лишним не будет. В принципе хорошийстиль за собой все проводить в исходное состояние. По второму думаю все сложнее, проблема может быть не только в количестве точек. Как вариант - может сообщать о недопустимости такого имени файла, а со временем критерии могут быть расширены.
SergKis: Andrey пишет If AtNum( ".", HB_FNameName( cFile ) ) > 0 ... Не уверен, скорее уверен, что этого в ExelOle делать не надо. Как пишет Игорь варианты возможны разные, все не засунешь, да и процедура ExelOle вызывается где то, вот там как надо и лепим имя файла, если очень надо, то и excel можно запустить отдельно не в ExcelOle. Второе предложение это перегруз
Andrey: SergKis пишет: процедура ExelOle вызывается где то, вот там как надо и лепим имя файла, если очень надо, то и excel можно запустить отдельно не в ExcelOle. Второе предложение это перегруз Я проверял поведение Excel. Имя файла с несколькими точками - режется ТОЛЬКО при вызове через OLE ! Если делать вызов Excel по другому, то всё нормально. Меню экспорта 1 и 3 в программе работает нормально. В конце метода ExcelOle() вызов экселя запускается НЕ ОТДЕЛЬНО !!! [pre2] If ! Empty( cXlsFile ) .and. lSave oBook:SaveAs( cXlsFile, xlWorkbookNormal ) // вот здесь и режется... If ! lActivate CursorArrow() oExcel:Quit() ::Reset() Return Nil EndIf EndIf CursorArrow() If lActivate oSheet:Range( "A1" ):Select() oExcel:Visible := .T. // показ Экселя EndIf[/pre2] Из-за этого я и предлагаю для ЭТОГО варианта разместить предупреждения, чтобы потом кто-то не налетел на ! Я Григория замучил - что режется имя файла, месяца 2 не мог понять почему. А решение оказывается совсем ПРОСТОЕ !
PSP: Андрей, нужно абстрагироваться от конкретного случая. Все обработки вариантов нужно делать "до того, как". Методу нужно предоставить данные в том виде, в котором они будут на 100% обработаны предсказуемым образом без всяких MsgStop(...)
Dima: PSP +1
Haz: PSP пишет: Все обработки вариантов нужно делать "до того, как" +500 Под конкретный случай, нужно конкретно и решать
Andrey: Понял ваше мнение ! Andrey пишет: Новая версия МиниГуи - 18.04 Метод oBrw:ExcelOle(). При экспорте в таблице столбец с номерами домов (примерно такой порядок: 1, 2, 5, 9/2 и т.д.) неправильно экспортирует. Превращает этот столбец в 1,2,5, 09 февраля. А как это исправить ? В методе :Excel2(...) выгрузка идёт правильно.
Andrey: Пробовал задавать явно формат столбца, всё равно не помогает.[pre2] // только для 6 и 10 колонки oBrw:aColumns[6]:cPicture := '@R 99:99:99' // без этого нет показа в колонке ":" oBrw:aColumns[10]:cPicture := 'xxxxxxxxx' [/pre2]
Dima: Andrey глянь
Andrey: Спасибо Дима ! Не получается... добавить перед числом апостроф (‘). Например: ’11-53 или ‘1/47. Апостроф не отображается после нажатия клавиши ВВОД; Поставил в колонке 10 апостроф (‘) - выгружате через Оле-Эксель так же ‘3/2 или ‘9/3 Конечно как самый примитив пойдёт, только юзера будут очень недовольны таким номером дома... Можно сделать первым символом знак "_" или "~" ставить. Но потом бы из документа этот знак желательно убрать... Тогда нужно ставить обработку удаления, после вставки из буфера... А лучше надо бы в конвертацию формата для текстового поля явно в исходниках указать, типа: [pre2]oSheet:Cells( nLine, nI ):SET( "NumberFormat", '@' ) // текстовая ячейка[/pre2] Пытался разобраться сaм, ничего не понял... Там идёт накопление в буфер, а потом идёт вставка из буфера. Как до этого указать формат столбца не знаю.
Andrey: Ура ! Получилось... Нужна правка в исходнике h_tbrowse.prg: [pre2] For nCol := 1 To Len( ::aColumns ) If aColSel != Nil .and. AScan( aColSel, nCol ) == 0 Loop EndIf uData := Eval( ::aColumns[ nCol ]:bData ) If ValType( uData ) == "C" oSheet:Cells( nLine, nCol ):SET( "NumberFormat", '@' ) // text cell EndIf If ValType( uData ) == "C" .and. At( CRLF, uData ) > 0 uData := StrTran( uData, CRLF, "&&" ) If AScan( aRepl, nCol ) == 0 AAdd( aRepl, nCol ) EndIf EndIf[/pre2] В METHOD ExcelOle() предлагаю сделать эту правку ! Pasha пишет: Как вариант: перед заполнением таблицы по строкам можно установить NumberFormat для тех столбцов, для которых это надо, т.е:
Dima: Andrey пишет: SET( "NumberFormat", '@' ) Может не сработать в ряде случаев когда много цифр в ячейке и Excel по своему покажет
Andrey: Dima пишет: Может не сработать в ряде случаев когда много цифр в ячейке и Excel по своему покажет В каких случаях ? Я тестировал столбец из номеров домов - вида: 1,2,3/2, 4, 5/3, 6А, 112Б, 94 стр.3 и т.д. ТОЛЬКО для текстового столбца делаю формат :SET( "NumberFormat", '@' ) // text cell Остальные столбцы НЕ ТРОГАЮ.
Dima: Andrey пишет: В каких случаях ? Да был случай лет 5 назад , вываливал в Excel коды морозильных камер (штук 500 примерно) В этих кодах были цифры , пробелы , точки и тире. Все коды разные. Из 500 штук , штуки 3 всегда показывало криво , и шаблон подобрать не удалось (руками тоже пробовали) . PS Это был файл формата CSV
Andrey: Возвращаюсь опять к методу ExcelOle(). При вызов экселя, он запускается, а потом уходит на второй план, т.е. под задачу. У всех так происходит ? Или это только у меня так, из-за Far. Если у всех, то надо бы Эксель на передний план ВСЕГДА переключать. Или ключ ввести для перевода. У кого какие будут соображения ?
Andrey: Предложение по METHOD Excel2() - сделать задержку, чтобы бегунок показывался на экране нормально, это в конце метода: [pre2] If ! Empty( aRepl ) For nCol := 1 To Len( aRepl ) oSheet:Columns( Chr( 64 + aRepl[ nCol ] ) ):WrapText := .T. Next EndIf If hProgress != Nil SendMessage( hProgress, PBM_SETPOS, nCount, 0 ) EndIf INKEYGUI(100) If ::lSelector ::InsColumn( ::aClipBoard[ 2 ], ::aClipBoard[ 1 ] ) ::lNoPaint := .F. EndIf If ! Empty( cXlsFile ) .and. lSave .....[/pre2] И ещё предложение: [pre2] EndIf //If ! Empty( ::aSuperHead ) // заменить как ниже If (::lDrawSuperHd) For nCol := 1 To Len( ::aSuperHead ) nVar := If( ::lSelector, 1, 0 ) uData := If( ValType( ::aSuperhead[ nCol, 3 ] ) == "B", Eval( ::aSuperhead[ nCol, 3 ] ), ;[/pre2] Поясню почему. Если в примере нужно убрать показ суперхидера, то можно назначит ему высоту 1 пиксел. И исходники пересматривать не придётся. Но если у нас суперхидер есть в 1 пиксел, то ! Empty( ::aSuperHead ) выдаст что суперхидер есть и сделает экспорт его на лист Экселя. А If (::lDrawSuperHd) позволит этого избежать.
Haz: Andrey пишет: сделать задержку, чтобы бегунок показывался на экране нормально Тормозить программу специально? Ради красоты бегунка Правильнее нормально задавать параметры отображения. К примеру если рисуем процентовку, которая, напоминаю равна 100 То незачем прорисовывать каждую запись из 1000. Дастаточно каждую десятую.
Andrey: Haz пишет: Правильнее нормально задавать параметры отображения. К примеру если рисуем процентовку, которая, напоминаю равна 100 То незачем прорисовывать каждую запись из 1000. Дастаточно каждую десятую. А как надо правильно ? Подправь пожалуйста исходник, а то в методе :Excel2() нормально рисуется бегунок, а в методе :ExcelOle() - огрызок какой-то.
Andrey: И ещё одна странность в методе :ExcelOle() - не рисуется подвал таблицы ! Там же есть вроде в тексте: [pre2] If AScan( ::aColumns, { |o| o:cFooting != Nil } ) > 0 For nCol := 1 To Len( ::aColumns ) If ( aColSel != Nil .and. AScan( aColSel, nCol ) == 0 ) .or. ::aColumns[ nCol ]:cFooting == Nil Loop EndIf uData := If( ValType( ::aColumns[ nCol ]:cFooting ) == "B", Eval( ::aColumns[ nCol ]:cFooting ), ; ::aColumns[ nCol ]:cFooting ) uData := cValTochar( uData ) uData := StrTran( uData, CRLF, Chr( 10 ) ) oSheet:Cells( nLine, nCol ):Value := uData Next EndIf [/pre2] Как исправить, чтобы заработало ?
Haz: Andrey пишет: Предложение по METHOD Excel2() - сделать задержку, Ты уж определись про какой метод ты пишешь ? А то говоришь про Excel2() а код кидаешь из ExcelOle() Вместо INKEYGUI() скорее подойдет Sysrefresh() или DoEvents() В конце метода nCount == nTotal ?? при выводе этого [pre2] ::ExcelOle() If hProgress != Nil SendMessage( hProgress, PBM_SETPOS, nCount, 0 ) EndIf [/pre2] если посмотреть в Excel2() то в конце там не nCount . Может тут проблема ? [pre2] ::Excel2() If hProgress != Nil SendMessage( hProgress, PBM_SETPOS, nTotal, 0 ) EndIf [/pre2] Следующий фокус я не понял [pre2] If hProgress != Nil nTotal := ( ::nLen + 1 ) * Len( ::aColumns ) + 30 SetProgressBarRange ( hProgress , 1 , nTotal ) SendMessage( hProgress, PBM_SETPOS, 0, 0 ) nEvery := Max( 1, Int( nTotal * .02 ) ) // refresh hProgress every 2 % EndIf [/pre2] и затем два раза [pre2] If hProgress != Nil nCount -= 15 SendMessage( hProgress, PBM_SETPOS, nCount, 0 ) EndIf [/pre2]
Andrey: Haz пишет: Ты уж определись про какой метод ты пишешь ? А то говоришь про Excel2() а код кидаешь из ExcelOle() Вместо INKEYGUI() скорее подойдет Sysrefresh() или DoEvents() Да точно, перепутал я. Понял насчёт Sysrefresh() или DoEvents(). Но остальной код я тоже не понимаю, зачем так сделано: nCount -= 15 и т.д. - для меня загадка... Напиши пожалуйста как правильно сделать, а Григорий уже исправит исходники ! И как насчёт подвала таблицы, почему нет в экселе её ?
Haz: Andrey пишет: И ещё одна странность в методе :ExcelOle() - не рисуется подвал таблицы ! В версии 2018/03/28: HMG Extended Edition version 18.03. все рисуется из твоего же примера Tsb_Brw2xml Ищи где намудрил с исходниками
Andrey: Haz пишет: В версии 2018/03/28: HMG Extended Edition version 18.03. все рисуется из твоего же примера Tsb_Brw2xml Я понял в чём дело. Если увеличить таблицу то 1000 элементов, то подвал в таблице пропадает ! Я пробовал на версии 18.03 - тоже нет подвала. Сделал в версии 18.04 кол-во строк 240, подвал есть. На 250 строках подвала уже нет и вот такая таблица получается: Что-то ерундит алгоритм выгрузки в эксель. Как и где подправить ? Смотреть последний проект - Tsb_Export8d.7z
Haz: Andrey пишет: Что-то ерундит алгоритм выгрузки в эксель. Как и где подправить ? А ерундит счетчик строк в алгоритме, на твоей картинке ясно виден разрыв ( пустая строка ) и после нее еще 5 строк. Если в примере общее число строк уменьшить на 5 , то разрыв исчезнет и подвал появится. Скорее всего из-за разрыва подвал затирается. Так что ищи причину разрыва, подвал - это следствие
Haz: Добавлю чуть. В текущей реализации ::ExcelOle() морально устарел , а убивец текущей реализации метода - Паша После появления поддержки вариантного массива этот ::ExcelOle() стал рудиментом, т.к. с __oleVariantNew() работать приятнее и понятнее , чем клеить ячейки в строку с ограничением в 20к
Andrey: Haz пишет: В текущей реализации ::ExcelOle() морально устарел , а убивец текущей реализации метода - Паша После появления поддержки вариантного массива этот ::ExcelOle() стал рудиментом, т.к. с __oleVariantNew() работать приятнее и понятнее , чем клеить ячейки в строку с ограничением в 20к А можно сделать замену этой текущей реализации для всех ? Я этого сам не осилю.
Haz: Andrey пишет: Я этого сам не осилю. Ну надо же когда то начинать
Haz: Никак не могу понять почему зависает следующий код Есть колонка NAME с текстовым полем , хочу и редактировать его и выбирать из справочника . Идеально подходит ::SetBtnGet Следующий код при выборе кнопки записывает слово "Test" в поле, но только в первый раз, во второй раз бровс зависает [pre2]oBrw:SetBtnGet( "NAME", "", { | oEdit, xVar | xVar := "Test",; oEdit:VarPut( xVar ), oEdit:Refresh() }, 16 )[/pre2] Мож есть у кого мысли куда копать ? PS Даже с таким кодом на второй раз завис [pre2]oBrw:SetBtnGet( "NAME", "", { | | NIL } , 16 )[/pre2] и еще интереснее , если в первый раз ввести значение ручками , а во второй вызвать кнопку - тоже завис.
Pasha: Haz пишет: В текущей реализации ::ExcelOle() морально устарел для начала можно убрать некоторые рудименты: строки oBook := oExcel:Get( "ActiveWorkBook") oSheet := oExcel:Get( "ActiveSheet" ) заменить на oBook := oExcel:ActiveWorkBook oSheet := oExcel:ActiveSheet аналогично вызов (в 2-х местах) oSheet:Range( cRange ):Set( "HorizontalAlignment", xlHAlignCenterAcrossSelection ) заменить на oSheet:Range( cRange ):HorizontalAlignment := xlHAlignCenterAcrossSelection после этого можно перейти на использование класса win_oleAuto из библиотеки hbwin, заменив строку oExcel := CreateObject( "Excel.Application" ) на win_oleCreateObject( "Excel.Application" ) Используя класс win_oleAuto, можно вместо передачи через буфер обмена передавать в Excel всю таблице одним вызовом __oleVariantNew() В принципе передача через буфер обмена фрагментами по 20к тоже работает быстро, но можно и делать это прямой записью.
SergKis: Haz пишет Следующий код при выборе кнопки записывает слово "Test" в поле, но только в первый раз, во второй раз бровс зависает Добавил в пример Tsb_addrecord_2 [pre2] ADD COLUMN TO oBrw DATA FieldWBlock( "ITG", Select( "base" ) ) ; HEADER "Total" FOOTER hb_ntos(nItg) ; ALIGN DT_RIGHT, DT_CENTER, DT_RIGHT ; SIZE 90 oBrw:SetBtnGet( 3, "", { |oe,cv| cv := "Test",; oe:VarPut(cv), oe:Refresh() }, 16 ) [/pre2] работает не виснет. Игорь, наверно, примерчик нужен
Haz: SergKis пишет: работает не виснет. Игорь, наверно, примерчик нужен Сергей, спасибо. Пока обошелся решив по другому. Сейчас не до примерчиков, позже сделаю обязательно ( может дома подготовлю и то не уверен ) ! Тащу два объемных проекта, даже тараканов в них давить некогда. Нужно сдать ! После сдачи видимо будет период оптимизации кода и украшательства. Вот там примерчики начнутся.
Haz: Сергей работает не виснет. Вобщем это я тупанул. Работает конечно при чистом запуске. Я пользуюсь для сборки проектов фришным редактором от Xailer ( xEdit ) Этот редактор , при запуске проекта на исполнение , пытается управлять приложением ( пытается использовать отладку, показать значения переменных, ресурсов и пр.) Возможно и можно его прикрутить как отладчик, но я не пользуюсь. Так вот, при запуске из под редактора , кнопка эта вешает задачу, при запуске нормальном - все ок. Знал же, раньше натыкался и все выяснил. Но время прошло и за неиспользованием этого функционала все забыл ((. Пол дня потратил на старые грабли
gfilatov2002: Pasha пишет: для начала можно убрать некоторые рудименты Благодарю за помощь! Выполнил предложенные правки Используя класс win_oleAuto для следующей сборки
SergKis: Haz пишет Есть колонка NAME с текстовым полем , хочу и редактировать его и выбирать из справочника . Идеально подходит ::SetBtnGet У себя исп. вариант без кнопки, но с назначением клавиш, может будет интересно. Изменения: [pre2] CLASS TSColumn ... DATA aKeyEvent INIT {} DATA bKeyEvent ... METHOD SetKeyEvent( nKey, bKey, lCtrl, lShift, lAlt ) ... ENDCLASS ... METHOD SetKeyEvent( nKey, bKey, lCtrl, lShift, lAlt ) CLASS TSColumn AAdd( ::aKeyEvent, { nKey, bKey, lCtrl, lShift, lAlt } ) RETURN Self ... CLASS TGetBox FROM TControl ... METHOD New( nRow, nCol, bSetGet, oWnd, nWidth, nHeight, cPict, bValid,; ... ::oGet := _DefineGetBox ( cControl, ParentFormName, nCol, nRow, nWidth, nHeight, uValue, ; // BK ... METHOD Edit( uVar, nCell, nKey, nKeyFlags, cPicture, bValid, nClrFore, ; ... Local nK, aKey, oGet ... oCol:oEdit := TGetBox():New( nRow+::aEditCellAdjust[1], nCol+::aEditCellAdjust[2], ; bSETGET( uValue ), Self, nWidth+2+::aEditCellAdjust[3], nHeight+2+::aEditCellAdjust[4], ; cPicture,, nClrFore, nClrBack, hFont, ::cChildControl, cWnd, ; cMsg,,,,, bChange, .T.,, lSpinner .and. cType $ "ND", bUp, bDown, ; bMin, bMax, oCol:lNoMinus ) IF ! empty(oCol:aKeyEvent) oGet := oCol:oEdit:oGet For nK := 1 TO Len(oCol:aKeyEvent) aKey := oCol:aKeyEvent[ nK ] If HB_ISNUMERIC( aKey[1] ) oGet:SetKeyEvent( aKey[1], aKey[2], aKey[3], aKey[4], aKey[5] ) EndIf Next ENDIF EndIf ... Пример Tsb_addrecord_2\demo.prg ... ADD COLUMN TO oBrw DATA FieldWBlock( "ITG", Select( "base" ) ) ; HEADER "Total" FOOTER hb_ntos(nItg) ; ALIGN DT_RIGHT, DT_CENTER, DT_RIGHT ; SIZE 90 // oBrw:SetBtnGet( 3, "", { |oe,cv| cv := "Test",; // oe:VarPut(cv), oe:Refresh() }, 16 ) oBrw:aColumns[3]:SetKeyEvent(VK_F5, {|og,ky| MyKeyEvent(og, ky) }) oBrw:aColumns[3]:SetKeyEvent(VK_F6, {|og,ky| MyKeyEvent(og, ky) }) oBrw:aColumns[3]:SetKeyEvent(VK_F7, {|og,ky| MyKeyEvent(og, ky) }) AEval( oBrw:aColumns, {|oCol,nCol| oCol:lFixLite := .T., ; ... *---------------------------------------------- STATIC FUNCTION MyKeyEvent( oGet, nKey ) *---------------------------------------------- LOCAL cVK := '', cTx := 'Test ' If nKey == VK_F5 cVK := 'VK_F5' ElseIf nKey == VK_F6 cVK := 'VK_F6' ElseIf nKey == VK_F7 cVK := 'VK_F7' EndIf oGet:VarPut(cTx+cVK) oGet:Refresh() // MsgBox( cVK + ' : ' + cValToChar( oGet:VarGet() ), 'Info' ) RETURN NIL [/pre2]
SergKis: PS DATA bKeyEvent надо убрать, остался от опытов
Haz: SergKis пишет: У себя исп. вариант без кнопки Сергей. Спасибо. В понедельник поткстирую
Haz: Сергей : может будет интересно. У меня есть очень draft, ну совсем бета альтернативного комбо в ячейке. Руки не доходят довести до ума, но испьзую так как есть. В понедельник скину в форум пример. Глянешь, интересны идеи. Суть в том, что вместо комбика попытался использовать бровс по базе. В последних проектах использую успешно, хоть и бета. А вот времени на осмысление нет. И чтоб совсем точки над ё, я не прошу сделать за меня. Я предлагаю идею и готов выслушать мнение.
SergKis: Haz пишет Суть в том, что вместо комбика попытался использовать бровс по базе. С этого начинал, с combo (и с поиском по букве). В итоге отказался, со временем маленький список -> в большой, + колонки ... Практически везде перехожу на тсб (с hb 2.0 browse, на 3.2 переделываю на тсб) А вот времени на осмысление нет. Со временем туго, согласен, справочники делаю по такой схеме (с поправками на задачу конечно), как идея (код из задачи, как есть) [pre2] // SPR modal window #include "minigui.ch" #include "tsbrowse.ch" MEMVAR oApp, oMain, oTbr, aReturn FUNC SprAGENT() LOCAL cBrw := 'AGENT' LOCAL cDbf := cBrw LOCAL cCapt := gTxt(Agenti) LOCAL nOrder := 1 LOCAL aColumn := { 'TNOM' , 'FIO' , 'FIO3' } LOCAL aName := { 'KOD' , 'NAM' , 'NOTE' } LOCAL aHeader := { gTxt(Kod) , gTxt(Nam), gTxt(Note) } LOCAL aWidth := { gW(1) , gW(2) , gW(2) } LOCAL aOrder := { 'KOD' , 'NAM' , } LOCAL aEdit := { .F. , .F. , .F. } LOCAL aAlign := { 1 , 0 , 0 } LOCAL aFAlign := { 1 , 0 , 0 } LOCAL aPicture := { , , } LOCAL aFixLite := { .T. , .T. , .T. } LOCAL aNoDescend := { .T. , .T. , .T. } LOCAL aOnGotFocusSelect := { .T. , .T. , .T. } LOCAL aEmptyValToChar := { .T. , .T. , .T. } LOCAL aEditMove := { 0 , 0 , 0 } LOCAL aBlockData := { , , } LOCAL aFields := { , , } LOCAL aData := { aColumn , ; // 1 aName , ; // 2 aHeader , ; // 3 aWidth , ; // 4 aOrder , ; // 5 aEdit , ; // 6 aAlign , ; // 7 aFAlign , ; // 8 aPicture , ; // 9 aFixLite , ; // 10 aNoDescend , ; // 11 aOnGotFocusSelect , ; // 12 aEmptyValToChar , ; // 13 aEditMove , ; // 14 aBlockData , ; // 15 aFields ; // 16 } RETURN SprGet( cBrw, cCapt, aData, nOrder ) FUNC SprU04() LOCAL cBrw := 'U04' LOCAL cDbf := cBrw LOCAL cCapt := gTxt(Klienti) LOCAL nOrder := 2 LOCAL aColumn := { 'R_1' , 'R_2' , 'R_4' , 'R_5' , 'R_13' , 'R_34' } LOCAL aName := { 'KOD' , 'NAM' , 'RNR' , 'PNR' , 'GRU' , 'ADR' } LOCAL aHeader := { gTxt(Kod) , gTxt(Nam), gTxt(Kli_R_4), gTxt(Kli_R_5), gTxt(Kli_R_13), gTxt(Kli_R_34) } LOCAL aWidth := { gW(1) , gW(3.5) , gW(1.5) , gW(1.5) , gW(1) , gW(4)+gW(0.5) } LOCAL aOrder := { 'KOD' , 'NAM' , , , , } LOCAL aEdit := { .F. , .F. , .F. , .F. , .F. , .F. } LOCAL aAlign := { 1 , 0 , 0 , 0 , 0 , 0 } LOCAL aFAlign := { 1 , 0 , 0 , 0 , 0 , 0 } LOCAL aPicture := { , , , , , } LOCAL aFixLite := { .T. , .T. , .T. , .T. , .T. , .T. } LOCAL aNoDescend := { .T. , .T. , .T. , .T. , .T. , .T. } LOCAL aOnGotFocusSelect := { .T. , .T. , .T. , .T. , .T. , .T. } LOCAL aEmptyValToChar := { .T. , .T. , .T. , .T. , .T. , .T. } LOCAL aEditMove := { 0 , 0 , 0 , 0 , 0 , 0 } LOCAL aBlockData := { , , , , , {|| KliAdr() } } LOCAL aFields := { , , , , , } LOCAL aData := { aColumn , ; // 1 aName , ; // 2 aHeader , ; // 3 aWidth , ; // 4 aOrder , ; // 5 aEdit , ; // 6 aAlign , ; // 7 aFAlign , ; // 8 aPicture , ; // 9 aFixLite , ; // 10 aNoDescend , ; // 11 aOnGotFocusSelect , ; // 12 aEmptyValToChar , ; // 13 aEditMove , ; // 14 aBlockData , ; // 15 aFields ; // 16 } RETURN SprGet( cBrw, cCapt, aData, nOrder ) * ----------------------------------------------------------------------------------- * FUNC SprGet( cID, cTitle, aData, nOrder, cBrwName ) * ----------------------------------------------------------------------------------- * LOCAL nY, nX, nH, nW, nT LOCAL cBrw := iif( empty(cBrwName), 'oSprav', cBrwName ) LOCAL cDbf := cID LOCAL cAls := cID LOCAL cWnd := 'w'+cBrw LOCAL aColumn := aData[ 1 ] // 1 LOCAL aName := aData[ 2 ] // 2 LOCAL aHeader := aData[ 3 ] // 3 LOCAL aWidth := aData[ 4 ] // 4 LOCAL aOrder := aData[ 5 ] // 5 LOCAL aEdit := aData[ 6 ] // 6 LOCAL aAlign := aData[ 7 ] // 7 LOCAL aFAlign := aData[ 8 ] // 8 LOCAL aPicture := aData[ 9 ] // 9 LOCAL aFixLite := aData[ 10 ] // 10 LOCAL aNoDescend := aData[ 11 ] // 11 LOCAL aOnGotFocusSelect := aData[ 12 ] // 12 LOCAL aEmptyValToChar := aData[ 13 ] // 13 LOCAL aEditMove := aData[ 14 ] // 14 LOCAL aBlockData := aData[ 15 ] // 15 LOCAL aFields := aData[ 16 ] // 16 LOCAL nDcell := 5 LOCAL nI, nK := len(aColumn) LOCAL hWnd := iif( _HMG_BeginWindowMDIActive, GetActiveMdiHandle(), GetActiveWindow() ) LOCAL nWndY := GetWindowRow (hWnd) LOCAL nWndX := GetWindowCol (hWnd) LOCAL nWndH := GetWindowHeight(hWnd) LOCAL nWndW := GetWindowWidth (hWnd) LOCAL nModH := GetClientHeight(hWnd) LOCAL nModW := GetVScrollBarWidth() + 2 + nK LOCAL nAls := Select() LOCAL hSpl, cNam, aHmg, oGet, cPic, oCel DEFAULT nOrder := 2 PRIVATE oTbr, aReturn := {} If ! Spr_Use( cDbf, cAls, .T. ) MsgStop( gTxt(NotUsed) + CRLF + cDbf + '.DBF', gTxt(Info) ) RETURN aReturn EndIf SET ORDER TO nOrder cAls := Alias() aHmg := Save_Rest_HMG(hWnd) AEval(aWidth, {|nw| nModW += nw }) nY := int( (nWndH - nModH) / 2 ) + nWndY nX := int( (nWndW - nModW) / 2 ) + nWndX DEFINE WINDOW &cWnd ; AT nY, nX ; WIDTH nModW ; HEIGHT nModH ; TITLE cTitle ; ICON oApp:Icon ; MODAL NOSIZE ; ON RELEASE ( iif( Select(cAls) > 0, (cAls)->( dbCloseArea() ), ), dbSelectArea(nAls) ) DEFINE SPLITBOX HANDLE hSpl DEFINE TOOLBAR ToolBar_1 BUTTONSIZE 68,32 FLAT BUTTON 06 CAPTION gTxt(Sort) PICTURE 'page_123' ACTION oTbr:PostMsg( WM_KEYDOWN, VK_F6, 0 ) ; TOOLTIP 'F6' SEPARATOR BUTTON 07 CAPTION gTxt(Find) PICTURE 'page_fltr' ACTION Press_Key(oTbr) ; TOOLTIP 'F7' SEPARATOR BUTTON E1 CAPTION ' ' PICTURE 'br_empty' ACTION NIL ; SEPARATOR BUTTON 13 CAPTION gTxt(Vibor) PICTURE 'page_enter' ACTION oTbr:PostMsg( WM_KEYDOWN, VK_RETURN, 0 ) ; TOOLTIP 'Enter' SEPARATOR END TOOLBAR DEFINE TOOLBAR ToolBar_2 BUTTONSIZE 48,32 FLAT BUTTON 10 CAPTION gTxt(Exit) PICTURE 'exit' ACTION ThisWindow.Release ; TOOLTIP 'Esc' END TOOLBAR END SPLITBOX nW := ThisWindow.ClientWidth nY := GetWindowHeight(hSpl) nX := 0 nH := ThisWindow.ClientHeight - nY nT := nY DEFINE TBRW &cBrw TO oTbr AT nY,nX WIDTH nW HEIGHT nH ALIAS cAls CELL oTbr:Cargo := cID :aColSel := aColumn :hFontHead := gProp(TsbHeader) :hFontFoot := gProp(TsbFooter) :LoadFields(.T.) :nWheelLines := 1 :nClrLine := COLOR_GRID :nHeightCell += nDcell :nHeightHead += nDcell :nHeightFoot := :nHeightCell :lNoGrayBar := .F. :lDrawFooters := .T. :lFooting := .T. :lNoVScroll := .F. :lNoHScroll := .T. :nFreeze := 1 :lLockFreeze := .F. :nFireKey := VK_F4 // default Edit :nLineStyle := LINES_ALL // LINES_NONE LINES_ALL LINES_VERT LINES_HORZ LINES_3D LINES_DOTTED :SetColor( { CLR_FOCUSB }, { { |a,b,c| If( c:nCell == b, {Rgb( 66, 255, 236), Rgb(209, 227, 248)}, ; {Rgb(220, 220, 220), Rgb(220, 220, 220)} ) } } ) For nI := 1 To nK oCol := :aColumns [ nI ] oCol:cName := aName [ nI ] oCol:cField := aColumn [ nI ] oCol:cHeading := aHeader [ nI ] oCol:nWidth := aWidth [ nI ] oCol:lEdit := aEdit [ nI ] oCol:nAlign := aAlign [ nI ] oCol:nFAlign := aFAlign [ nI ] oCol:lFixLite := aFixLite [ nI ] oCol:lOnGotFocusSelect := aOnGotFocusSelect[ nI ] oCol:lEmptyValToChar := aEmptyValToChar [ nI ] oCol:nEditMove := aEditMove [ nI ] If ! empty(aPicture [ nI ]) oCol:cPicture := aPicture [ nI ] EndIf If ! empty(aOrder[ nI ]) oCol:cOrder := aOrder [ nI ] // отключаем подсветку в Footer // If oCol:cName == "KOD" // oCol:cFooting := { |nc,obr| nc := (obr:cAlias)->( OrdKeyNo() ), ; // iif( empty(nc), '', hb_ntos(nc) ) } // ElseIf oCol:cName == "NAM" // oCol:cFooting := { |nc,obr| nc := (obr:cAlias)->( OrdKeyCount() ), ; // ' '+iif( empty(nc), '', hb_ntos(nc) ) } // EndIf EndIf If ! empty(aBlockData[ nI ]) If HB_ISCHAR(aBlockData[ nI ]) oCol:bData := AliasBlock(aBlockData[ nI ], cAls, .T.) Else oCol:bData := aBlockData[ nI ] EndIf EndIf If ! empty(aFields [ nI ]) oCol:cField := aFields [ nI ] EndIf Next :nCell := :nColumn('NAM') :aSortBmp := { LoadImage("br_up"), LoadImage("br_dn") } // отключаем подсветку в Footer // :bChange := {|obr| obr:DrawFooters() } :bLDblClick := {|p1,p2,p3,obr| p1:=p2:=p3:=Nil, obr:PostMsg( WM_KEYDOWN, VK_RETURN, 0 ) } :SetIndexCols( :nColumn('KOD'), :nColumn('NAM') ) :SetOrder(:nColumn(iif( nOrder == 1, 'KOD', 'NAM') )) if :nLen > :nRowCount() :ResetVScroll( .T. ) :oHScroll:SetRange(0,0) EndIf :UserKeys(VK_F6 , {|obr,nky,cky| Order_Set(obr,nky,cky)}) :UserKeys(VK_F7 , {|obr | Press_Key(obr )}) :UserKeys(VK_RETURN, {|obr | Recno_Get(obr )}) :UserKeys( , {|obr,nky,cky| Press_Key(obr,nky,cky)}) END TBRW oTbr:SetNoHoles() oTbr:SetFocus() cPic := StrTran( oTbr:GetColumn('KOD'):cPicture, '@K ', '' ) oCel := oTbr:GetCellInfo( 1, oTbr:nColumn('KOD') ) nX := 2 nW := oCel:nWidth - 5 nH := oTbr:nHeightCell nY := nT + GetWindowHeight(oTbr:hWnd) - oTbr:nHeightFoot // 550 @ nY, nX GETBOX KOD OBJ oGet HEIGHT nH WIDTH nW VALUE space(len(cPic)) ; BACKCOLOR oApp:BColorGet PICTURE cPic ; ON CHANGE Seek__Set(oTbr) ; INVISIBLE NOTABSTOP oGet:lOnGotFocusSelect := .F. oGet:OnEscape := {|og| og:GetObj():Hide(), oTbr:SetFocus(), .T. } oGet:OnEnter := {|og| og:GetObj():Hide(), oTbr:SetFocus() } oGet:OnDown := {|og| og:GetObj():Hide(), oTbr:SetFocus() } oGet:OnUp := {|og| og:GetObj():Hide(), oTbr:SetFocus() } cPic := StrTran( oTbr:GetColumn('NAM'):cPicture, '@K ', '' ) oCel := oTbr:GetCellInfo( 1, oTbr:nColumn('NAM') ) nX := oCel:nCol + 2 nW := oCel:nWidth - 10 @ nY, nX GETBOX NAM OBJ oGet HEIGHT nH WIDTH nW VALUE space(len(cPic)) ; BACKCOLOR oApp:BColorGet PICTURE cPic ; ON CHANGE Seek__Set(oTbr) ; INVISIBLE NOTABSTOP oGet:lOnGotFocusSelect := .F. oGet:OnEscape := {|og| og:GetObj():Hide(), oTbr:SetFocus(), .T. } oGet:OnEnter := {|og| og:GetObj():Hide(), oTbr:SetFocus() } oGet:OnDown := {|og| og:GetObj():Hide(), oTbr:SetFocus() } oGet:OnUp := {|og| og:GetObj():Hide(), oTbr:SetFocus() } END WINDOW ACTIVATE WINDOW &cWnd Save_Rest_HMG(aHmg) dbSelectArea(nAls) RETURN aReturn * ----------------------------------------------------------------------------------- * STATIC FUNC KliAdr() * ----------------------------------------------------------------------------------- * LOCAL cAdr, cAls := oTbr:cAlias If empty((cAls)->R_34) cAdr := Alltrim((cAls)->R_3 ) + ' ' + AllTrim((cAls)->R_3A) Else cAdr := Alltrim((cAls)->R_34) + ' ' + AllTrim((cAls)->R_35) EndIf RETURN cAdr * ----------------------------------------------------------------------------------- * STATIC FUNC Order_Set( oBrw, nKey, cKey ) * ----------------------------------------------------------------------------------- * LOCAL cOrd := (oBrw:cAlias)->( OrdSetFocus() ) If cOrd == "KOD" oBrw:nCell := oBrw:nColumn('NAM') oBrw:SetOrder( oBrw:nCell ) Else oBrw:nCell := oBrw:nColumn('KOD') oBrw:SetOrder( oBrw:nCell ) EndIf oBrw:SetFocus() RETURN Nil * ----------------------------------------------------------------------------------- * STATIC FUNC Seek__Set( oBr ) * ----------------------------------------------------------------------------------- * LOCAL oBrw := iif( empty(oBr), oTsb, oBr ) LOCAL cBrw := oBrw:Cargo LOCAL cAls := oBrw:cAlias LOCAL cNam := (cAls)->( OrdName() ) LOCAL cVal := _GetValue(cNam, oBrw:cParentWnd) If ! empty(cVal) If cNam == 'KOD' If 'U02' != cBrw cVal := TR0(cVal) EndIf Else cVal := ELRU(Trim(upper(cVal))) EndIf (cAls)->( dbSeek(cVal) ) oBrw:GotoRec( (cAls)->( RecNo()) ) DoEvents() EndIf RETURN Nil * ----------------------------------------------------------------------------------- * STATIC FUNC Press_Key( oBrw, nKey, cKey ) * ----------------------------------------------------------------------------------- * LOCAL cNam := (oBrw:cAlias)->( OrdName() ) LOCAL oSpr := _WindowObj(oBrw:cParentWnd) LOCAL oGet := oSpr:GetObj(cNam) If empty(nKey) oGet:Show() oGet:SetFocus() DoEvents() Else cKey := VK2Char(nKey) If len(cKey) > 0 oGet:Show() oGet:SetFocus() DoEvents() oGet:Get:VarPut(space(len(oGet:Get:Picture))) _PushKey(nKey) EndIf EndIf RETURN Nil * ----------------------------------------------------------------------------------- * STATIC FUNC Recno_Get( oBrw, nKey, cKey ) * ----------------------------------------------------------------------------------- * LOCAL cID := oBrw:Cargo LOCAL cAls := oBrw:cAlias LOCAL oWnd := _WindowObj(oBrw:cParentWnd) If cID $ 'U03,U04' AAdd(aReturn, (cAls)->R_1) AAdd(aReturn, (cAls)->R_2) ElseIf cID $ 'AGENT,KART' AAdd(aReturn, (cAls)->TNOM) AAdd(aReturn, (cAls)->FIO ) EndIf oWnd:Release() RETURN Nil ЗЫ oGet:OnEscape := {|og| og:GetObj():Hide(), oTbr:SetFocus(), .T. } oGet:OnEnter := {|og| og:GetObj():Hide(), oTbr:SetFocus() } oGet:OnDown := {|og| og:GetObj():Hide(), oTbr:SetFocus() } oGet:OnUp := {|og| og:GetObj():Hide(), oTbr:SetFocus() } это аналоги oGet:SetKeyEvent В задаче применяю (окно с тсб и рядом типа карточки) y := nRow x := nCol n := 'KliKod' // код клиента (справочник) @ y, x GETBOX &n OBJ o WIDTH oSt:W(10) HEIGHT oSt:H('G') VALUE space(4) ACTION wPost(91) IMAGE 'view' ; VALID SayGet_Value(.T., .T.) BACKCOLOR BG FONTCOLOR FC o:lOnGotFocusSelect := .T. o:OnEscape := {|og| oView:SetFocus(), .T. } o:OnF5 := {| | wPost(91) } y += This.&(n).Height + b n := 'KliNam' @ y, x GETBOX &n OBJ o WIDTH oSt:W(35) HEIGHT oSt:H('G') VALUE space(10) ; READONLY BACKCOLOR BG FONTCOLOR FC NOTABSTOP ... y += This.&(n).Height + b n := 'KliAgent' // код агента, для клиента (справочник) @ y, x GETBOX &n OBJ o WIDTH oSt:W(10) HEIGHT oSt:H('G') VALUE space(5) ACTION wPost(92) IMAGE 'view' ; VALID SayAgent_Value(.T., .T.) PICTURE '99999' BACKCOLOR BG FONTCOLOR FC o:lOnGotFocusSelect := .T. o:OnF5 := {| | wPost(92) } o:OnEscape := {|og| oView:SetFocus(), .T. } This.&(n).Value := TR0( Alltrim(gProp(Agent)), Len( This.&(n).Value ) ) x += This.&(n).Width n := 'NamAgent' @ y, x GETBOX &n OBJ o WIDTH oSt:W(25) HEIGHT oSt:H('G') VALUE space(30) ; READONLY BACKCOLOR BG FONTCOLOR FC NOTABSTOP ... и события (как я без них) For i := 1 To nCnt :Event( i, {|ow,ky| PressTBar(ow, ky), TsbCreate(ow, ky) } ) Next :Event( 91, {|ow | KliU04(ow) } ) :Event( 92, {|ow | KliAgent(ow) } ) :Event( 98, {|ow | OrdSave(ow) } ) :Event( 99, {|ow | oWnd:Action := .T., ow:Release() } ) END WITH // ---- Window events ... [/pre2]
Haz: Сергей Haz пишет: У меня есть очень draft, ну совсем бета альтернативного комбо в ячейке. Выдернул из проекта , переписал под CDX вроде работает . Логика похожа на твой пример - те же массивы заголовков, полей и пр. Подчеркиваю это совсем бета , по мере допиливаю понемногу. Но что это понятно из примера [pre2] #include "minigui.ch" #include "tsbrowse.ch" #include "hmg.ch" #include "common.ch" Static oMain Procedure Main() local i := 0 local cCol := "" PUBLIC aFont := {} SET OOP ON REQUEST DBFCDX SET CENTURY ON SET DELETED ON RDDSETDEFAULT('DBFCDX') DEFINE FONT Font_1 FONTNAME "Arial" SIZE 8 DEFINE FONT Font_2 FONTNAME "Arial" SIZE 8 ITALIC AAdd( aFont, GetFontHandle( "Font_1" ) ) AAdd( aFont, GetFontHandle( "Font_2" ) ) if ! File('base1.dbf') DBCreate( "BASE1.DBF" , {{"REC", "N", 4, 0},{"ID", "N", 4, 0} } ) end if ! File('base2.dbf') DBCreate( "BASE2.DBF" , {{"ID", "N", 4, 0}, {"NAME", "C", 20, 0} } ) end USE "BASE1.DBF" EXCL NEW ALIAS "BASE1" USE "BASE2.DBF" EXCL NEW ALIAS "BASE2" IF BASE2->(Eof()) FOR i := 1 TO 100 BASE2->(dbAppend()) BASE2->ID := i BASE2->NAME := RandStr( 20 ) END INDEX ON ID TAG "ID" TO "BASE2" END IF BASE1->(Eof()) FOR i := 1 TO 10 BASE1->(dbAppend()) BASE1->ID := i END END BASE2->(OrdSetFocus("ID")) DEFINE WINDOW Form1 ; AT 0,0 ; WIDTH 355 ; HEIGHT 600 ; TITLE "MAIN" ; MAIN ; FONT 'Tahoma' SIZE 10 oMain :=This.Object END WINDOW DEFINE TBROWSE oBrw At 25, 5 ALIAS "BASE1" ; OF Form1 ; WIDTH oMain:ClientWidth - 10 ; HEIGHT oMain:ClientHeight - 10 :LoadFields( TRUE ) :lCellBrw := TRUE :nHeightCell := 22 :nHeightHead := 22 END TBROWSE AEval(oBrw:aColumns(), {|oCol| oCol:bPrevEdit := {|xVal, oBrw| TEST_PrevEdit( xVal, oBrw ) } }) cCol := "REC" oBrw:SetColSize( cCol , 50) with object oBrw:GetColumn( cCol ) :cHeading := "RecNo #" :cPicture := Replicate("9", 4) :lEdit := FALSE :nAlign := DT_RIGHT :bData := { || BASE1->(RECNO()) } end cCol := "ID" oBrw:SetColSize( cCol , 250) with object oBrw:GetColumn( cCol ) :cHeading := "String" :cPicture := Replicate("X", 20) :lEdit := TRUE :nAlign := DT_LEFT :bData := { || SeekID( BASE1->ID ) } end Form1.CENTER ACTIVATE WINDOW Form1 Return FUNCTION RandStr( nLen ) LOCAL cSet := "qwertyuiopasdfghjklzxcvbnmQWERTYUIOPASDFGHJKLZXCVBNM" LOCAL cStr := "" LOCAL i := 0 FOR i := 1 TO nLen cStr += SubStr( cSet, Random( 52 ), 1 ) NEXT RETURN cStr FUNC SeekID(nId) LOCAL xRet := NIL IF BASE2->(dbSeek( nId, FALSE )) xRet := BASE2->NAME END RETURN xRet FUNC TEST_PrevEdit( xVal, oBrw ) LOCAL cCol := Upper(oBrw:aColumns[oBrw:nCell]:cName ) LOCAL cAlias := oBrw:cAlias LOCAL cSql := "" LOCAL nPos := 0 LOCAL nRecSave := 0 LOCAL nOrdSave := 0 LOCAL lRet := TRUE DO CASE CASE cCol == "ID" xLbx := LBX():New() xLbx:cAlias := "BASE2" xLbx:cRetField := "ID" xLbx:aHeaders := {'Тип'} xLbx:aWidth := {250} xLbx:aField := {'NAME'} xLbx:nHeightCell := 20 xLbx:nHeightHead := 0 xLbx:nHeightFoot := 0 xLbx:bPostBlock := {|| NIL } xLbx:ListBox( oBrw, xVal ) lRet := FALSE END RETURN lRet FUNC ToRGB(nColor) LOCAL nR := 0 LOCAL nG := 0 LOCAL nB := 0 LOCAL cColor := NTOC(nColor, 16) /* BBGGRR, где XX - число от 00 до FF. */ nR := CTON(SUBSTR( cColor, 5, 2 ), 16) nG := CTON(SUBSTR( cColor, 3, 2 ), 16) nB := CTON(SUBSTR( cColor, 1, 2 ), 16) RETURN {nR, nG, nB } //////////////////////////////// #include "minigui.ch" #include "tsbrowse.ch" #include "common.ch" #include "hmg.ch" #define GWL_STYLE (-16) #define GWL_EXSTYLE (-20) #define WS_BORDER 0x00800000 #define WS_EX_CLIENTEDGE 0x00000200 #define WS_EX_DLGMODALFRAME 0x00000001 #define WS_EX_LEFTSCROLLBAR 0x00004000 #define WS_EX_TOOLWINDOW 0x00000080 #define WS_DLGFRAME 0x00400000 #include "hbclass.ch" CREATE CLASS Lbx VAR oBrw VAR oBrwParent VAR oWLbx VAR oLbx VAR aHeaders INIT {} VAR aFooters INIT {} VAR aData INIT {} VAR aAlign INIT {} VAR aFAlign INIT {} VAR aHAlign INIT {} VAR aWidth INIT {} VAR aField INIT {} VAR aFont INIT {} VAR cAlias INIT "LBX" VAR cRetField INIT "NAME" VAR bPostBlock INIT nil VAR bSearch INIT nil VAR nHeightCell INIT 20 VAR nHeightHead INIT 20 VAR nHeightFoot INIT 20 METHOD New() METHOD ListBox(oBrw, xVal) METHOD Release(oBrw) METHOD UserKeys( nKey, nFlg, oBrw, oBrwParent, cRetField ) ENDCLASS METHOD Lbx:new() RETURN SELF METHOD Lbx:ListBox(oBrw, xVal) LOCAL nRecCount := 0 LOCAL nCol := 0 LOCAL nWidth := 0 LOCAL nHeight := 0 LOCAL nRow := 0 LOCAl oCell LOCAL aWRect := {0,0,0,0} LOCAL aCRect := {0,0,0,0} LOCAL lFlip := FALSE LOCAL i := 0 LOCAL nWh := 0 if !Empty( ::aWidth ) AEval(::aWidth, {|e| nWh += e + 1 }) end SET OOP ON GetWindowRect(oBrw:hWnd, aWRect ) oCell := oBrw:GetCellinfo(oBrw:nRowPos, oBrw:nCell, FALSE) nCol := oCell:nCol + aWRect[1] - Getproperty(oBrw:cParentWnd, oBrw:cControlName, "Col") nRow := oCell:nRow + aWRect[2] - Getproperty(oBrw:cParentWnd, oBrw:cControlName, "Row") nWidth := oCell:nWidth nHeight := oCell:nHeight // Поправка на координаты прииспользовании TAB IF __objHasData(oBrw, 'nColShift') IF oBrw:nColShift <> NIL nCol := nCol - oBrw:nColShift END END IF __objHasData(oBrw, 'nRowShift') IF oBrw:nRowShift <> NIL nRow := nRow - oBrw:nRowShift END END // // Если правый край выезжает за экрам IF nWh > nWidth IF nCol < aWRect[1] nCol := oCell:nCol + aWRect[1] - Getproperty(oBrw:cParentWnd, oBrw:cControlName, "Col") END IF nWh + nCol > Getproperty(oBrw:cParentWnd, "Width") nCol := Getproperty(oBrw:cParentWnd, "Width") - nWh - 35 END nWidth := nWh END // Если выезжает за низ окна IF oMain:ClientHeight - nRow - 130 < Min( ((::cAlias)->(RecCount()) + 2) * ::nHeightCell ,300 ) // Нужно показывать вверх lFlip := TRUE END DEFINE WINDOW LBEX ; AT nRow + IF( lFlip, -Min( ( (::cAlias)->(RecCount()) + 2) * ::nHeightCell ,300 ), nHeight ), nCol ; WIDTH nWidth ; HEIGHT Min( (::cAlias)->(RecCount() + 2) * (::nHeightCell) + (::nHeightCell) ,300 ) ; NOCAPTION ; CHILD ; ON LOSTFOCUS {|| oWLbx:Release()} ; ON RELEASE {|| ::Release( oBrw ) } oWLbx :=This.Object END WINDOW hWnd := GetFormHandle("LBEX") SetWindowLong(hWnd, GWL_EXSTYLE, WS_EX_TOOLWINDOW ) SetWindowLong(hWnd, GWL_STYLE, WS_DLGFRAME) (::cAlias)->(dbGoTop()) DEFINE TBROWSE oLbx At 25, 0 ALIAS ::cAlias ; OF LBEX ; WIDTH oWLbx:Width-3 ; HEIGHT oWLbx:Height - 30 ; END TBROWSE ::oBrw := oLbx ::oBrwParent := oBrw SetWindowLong (::oBrw:hWnd, GWL_EXSTYLE, WS_EX_STATICEDGE) if hb_isArray(::aField) .AND. Len( ::aField) > 0 ::oBrw:aColSel := ::aField endif ::oBrw:LoadFields( TRUE ) ::oBrw:lCellBrw := TRUE ::oBrw:nHeightCell := ::nHeightCell ::oBrw:nHeightHead := ::nHeightHead ::oBrw:nHeightFoot := ::nHeightFoot ::oBrw:lNoChangeOrd := TRUE ::oBrw:lNoHScroll := TRUE ::oBrw:ChangeFont( M->aFont[ 1 ], , 3 ) // nLevel 1 = Cells 2= Headers 3 = Footers ::oBrw:ChangeFont( M->aFont[ 1 ], , 2 ) // nLevel 1 = Cells 2= Headers 3 = Footers ::oBrw:ChangeFont( M->aFont[ 2 ], , 1 ) // nLevel 1 = Cells 2= Headers 3 = Footers ::oBrw:bLDblClick := {|| ; (::oBrwParent:cAlias)->&(::oBrwParent:GetColumn(::oBrwParent:nCell):cName ) := (::oBrw:cAlias)->&(::cRetField),; oWLbx:Release(); } ::oBrw:bUserKeys := {|nKy,nFl,oBr| ::UserKeys(nKy, nFl, oBr ) } ::oBrw:SetColor( { 6 }, { { |a,b,c| IF( c:nCell == b, -CLR_HRED , -RGB(128,225,225) ) } } ) // фон курсора ::oBrw:SetColor( { 2 }, { { || GetSysColor( COLOR_BTNFACE ) } }, ) // фон ::oBrw:hBrush := CreateSolidBrush( ToRGB(GetSysColor( COLOR_BTNFACE ))[1],; ToRGB(GetSysColor( COLOR_BTNFACE ))[2],; ToRGB(GetSysColor( COLOR_BTNFACE ))[3] ) IF hb_isArray( ::aWidth ) .AND. Len( ::aWidth ) > 0 FOR i := 1 TO Len(::aWidth) ::oBrw:SetColSize(i, ::aWidth[ i ] ) END ELSE ::oBrw:SetColSize(1, nWidth ) END IF hb_IsArray( ::aHeaders ) .AND. Len( ::aHeaders ) > 0 FOR i := 1 TO Len(::aHeaders) ::oBrw:aColumns[ i ]:cHeading := ::aHeaders[ i ] END END AEval(::oBrw:aColumns(), {|oCol| oCol:nClrSeleBack := oCol:nClrFocuBack, oCol:nClrSeleFore := oCol:nClrFocuFore, oCol:lEdit := FALSE }) DEFINE IMAGE Image_1 PARENT LBEX ROW 3 COL 0 WIDTH 15 HEIGHT 15 PICTURE 'FIND' STRETCH .F. END IMAGE DEFINE GETBOX Text_FTS PARENT LBEX ROW 0 COL 16 WIDTH oWLbx:Width - 42 HEIGHT ::nHeightCell VALUE Space(100) FONTNAME 'Arial' FONTSIZE 9 FONTBOLD FALSE TOOLTIP '' READONLY FALSE MAXLENGTH 100 BACKCOLOR {255,255,255} ON CHANGE IF( HB_IsBlock(::bSearch), Eval( ::bSearch, ::Self , This.Value ), nil ) END GETBOX DEFINE BUTTONEX Button_Del PARENT LBEX ROW 3 COL oWLbx:Width - 22 WIDTH 15 HEIGHT 15 ACTION {|| (::oBrwParent:cAlias)->&( ::oBrwParent:GetColumn(oBrw:nCell):cName ) := 0, oWLbx:Release() } CAPTION "" PICTURE "DB_CANCEL" TABSTOP .F. TOOLTIP "ВНИМАНИЕ Нажимая здесь Вы очистите значение в ячейке таблицы !" FONTNAME "Arial" FONTSIZE 9 END BUTTONEX ON KEY ESCAPE OF LBEX ACTION LBEX.Release Domethod( "LBEX", "Text_FTS", "SetFocus") ::oBrw:SetNoHoles() ::oBrw:SetFocus() ::oBrw:Reset() ACTIVATE WINDOW LBEX RETURN NIL METHOD Release( oBrw ) oBrw:SetFocus() oBrw:DrawSelect() IF(HB_IsBlock( ::bPostBlock), Eval(::bPostBlock, oBrw, oLbx ), NIL) RETURN NIL METHOD UserKeys( nKey, nFlg, oBrw ) Local uRet, cOrd, oCell, nRow, nPos nFlg := Nil do case case nKey == VK_RETURN .OR. nKey == VK_SPACE uRet := .F. (::oBrwParent:cAlias )->&( ::oBrwParent:GetColumn(::oBrwParent:nCell):cName ) := (::oBrw:cAlias)->&(::cRetField) oWLbx:Release() Case nKey < 48 oBrw:SetFocus() otherwise uRet := .F. oBrw:SetFocus() End RETURN uRet [/pre2]
SergKis: Игорь Поправь [ i ], начиная с этого текста и т.д. [pre2] IF hb_isArray( ::aWidth ) .AND. Len( ::aWidth ) > 0 FOR i := 1 TO Len(::aWidth) ::oBrw:SetColSize(i, ::aWidth[ i ] ) END ELSE ::oBrw:SetColSize(1, nWidth ) END [/pre2]
Dima: SergKis пишет: Игорь Поправь [ i ], начиная с этого текста и т.д. Поправил
Haz: Dima пишет: Поправил и я
SergKis: Haz пишет Глянешь, интересны идеи. Суть в том, что вместо комбика попытался использовать бровс по базе 1.Таких вариантов поля (Id -> наименование) замена, практически нет в работе, все как то сложнее. 2.Кроме id записи, есть клиентский код, который пользователи любят и вводят его (многие наизусть), а не через наименование. К примеру: - ФИО однозначно не определяет запись, надо ТАБ.НОМЕР и\или персональный код - наименование магазина, так же однозначно на дает запись, надо страну\город\адрес\регистр.номер(ИНН) или клиентский код - группы материалов\товаров могут иметь одинаковые наименования, но разные клиентские коды и др. показатели. ... 3.От ведения на тсб практически отказался, осталось только на совсем простеньких справочниках. Ввод, корректировку делаю на окне типа InputWindow(...) из hmg. Там validы, заполнение доп. полей и т.д. 4. Замену ComboBox-у делаю на GetBox-ах, как показал в примере выше. Если исп. в тсб на колонке вызов справочника, то исп. установку клавиши F5 на колонку (изменеия в MiniGui.lib перед примером выше) и VALID колонки, если значение задают не через вызов справочника, а кодом руками. Есть такое использование (в тсб) на окнах запросов для получения отчетов. 5.Мысли по твоему варианту: - возможность указывать, кол-во строк в тсб, если меньше, то окно меньше - располагать окно с тсб не только сверху\снизу, но и слева\справа, указывая L[eft],R[ight],T[op],B[ottom] - если использовать механизм назначенной клавиши для вызова списка, ввод в само поле можно исп. для поиска в списке или в footer, как у меня в примере
SergKis: Haz, Dima Как то правка не прошла [pre2] ::oBrw:aColumns[ i ]:cHeading := ::aHeaders[ i ] // тут надо, может и ниже тоже END END [/pre2]
Haz: SergKis пишет: Мысли по твоему варианту Про назначение клавиш - спасибо. Прикину как прикрутить. В остальном пример сильно кастрирван. Там есть список полей, которые нужно показать в бровсе и поле которое нужно вернуть из справочника. ID и NAME это частный случай. Поиск по справочнику делаю по содержимому getbox через вызов bSearch. В примере не смог его показать т. к. это FTS поиск от ADS, то есть по вхождению в любых полях. Как в CDX сделать не знаю. У меня для поиска клиента, к примеру, можно в Getbox ввести ИНН или КПП или форму собственноси или почтрвый индекс или чего ещё. или через пробел все это сразу сразу. В FTS задается что искать, любое или все. И бровс фильтрует записи по условию поиска. Все уже привыкли не думая набирать или часть наименования или адреса или телефона. А вот до назначения клавиш я не допер. Повешу на них доп инструмент. У меня главный косяк в том что на модальной форме этот бровс ругается что из модала можно только модал. А если бровс сам сделать модальным, то на нем не отыграть потерю фокуса так как модал не его потерять). Твой пример посмотрел, все понятно. Спасибо буду использовать
SergKis: Haz пишет У меня главный косяк в том что на модальной форме этот бровс ругается что из модала можно только модал. А если бровс сам сделать модальным, то на нем не отыграть потерю фокуса так как модал не его потерять). 1 Можно делать два типа окна для child и modal имея признак в объекте. - modal делать похожим на справочник и иметь кнопку выхода+Esc - child как сейчас, но можно и одинаково оформлять вызывать с модального окна модальный режим, с др. child 2 GetBox_FTS можно делать с двумя\одной родными кнопками с image для поиска\очистки или еще что то. 3 Исп. не bPrevEdit, а Valid и назн. клавишу для вызова списка, тогда в поле TGETBOX можно не вызывая списка вводить, если был On Change (меняем значение в поле тсб - поиск) по клавише или в valid по Enter вызываем объект списка, переносим значение из TGETBOX в GetBox_FTS с отработкой оного. 4 Иметь метод в объекте установки Row, Col отображения списка относительно родителя и задания кол-ва строк в списке
Haz: SergKis пишет: Можно делать два типа окна для child и modal 1 Буду тип задавать по типу родителя. Так решается проблема что из чего вызывать. Вот как быть с потерей фокуса у модала ?? не дает он его терять, а у меня на это событие справочник закрывается с отказом от выбора. 2 - 4 Согласен . это уже детали реализации.
SergKis: Haz пишет Вот как быть с потерей фокуса у модала ?? не дает он его терять, а у меня на это событие справочник закрывается с отказом от выбора. По мне, выбор по Enter, DblClick, Button Ok (выбор сделан, список убираем), а все остальное отказ. Выход базовый по кнопке крестику (своя, работа с NOCAPTION .T.) или Esc (отказ, список убираем). Потеря фокуса - для child режима - частный случай отказа
SergKis: PS Игорь, вспомнилось, ты вроде занимался морганием модальных окон при потере фокуса, можно туда приблуду вставить типа, по handle окна получить объект (если есть) и получить свойство bBlock := oW:GetProp('LostFocus') и если блок задан, выполнить Do_WindowEventProcedure ( bBlock, oW:Index, oW ) В объект окна списка ставить блок (ThisWindow.Object):SetProp('LostFocus', {|ow| ow:Release() }
Haz: SergKis пишет: Игорь, вспомнилось, ты вроде занимался морганием модальных окон при потере фокуса, можно туда приблуду вставить Примерно так и думаю. Пока ещё не смотрел. Хочу сделать не трогая исходников. Не получится., придется править.
SergKis: Haz пишет Не получится., придется править. Тогда в TWndData можно добавить DATA bLostFocusModal и устанавливать и работать с ним
Andrey: Andrey пишет: Сделал в версии 18.04 кол-во строк 240, подвал есть. На 250 строках подвала уже нет и вот такая таблица получается: ..... Что-то ерундит алгоритм выгрузки в эксель. Как и где подправить ? Предложение по правке этой ошибки (h_tbrowse.prg): [pre2] nColHead := 0 For nCol := 1 To Len( ::aColumns ) If aColSel != Nil .and. AScan( aColSel, nCol ) == 0 Loop EndIf uData := If( ValType( ::aColumns[ nCol ]:cHeading ) == "B", Eval( ::aColumns[ nCol ]:cHeading ), ; ::aColumns[ nCol ]:cHeading ) If ValType( uData ) != "C" Loop EndIf uData := StrTran( uData, CRLF, Chr( 10 ) ) nColHead ++ oSheet:Cells( nLine, nColHead ):Value := uData If hProgress != Nil If nCount % nEvery == 0 SendMessage( hProgress, PBM_SETPOS, nCount, 0 ) EndIf nCount ++ EndIf Next nStart := ++ nLine // поставить вместо этого nStart := nLine + 1 EndIf[/pre2] И ещё при печати подвала: [pre2] If AScan( ::aColumns, { |o| o:cFooting != Nil } ) > 0 For nCol := 1 To Len( ::aColumns ) If ( aColSel != Nil .and. AScan( aColSel, nCol ) == 0 ) .or. ::aColumns[ nCol ]:cFooting == Nil Loop EndIf uData := If( ValType( ::aColumns[ nCol ]:cFooting ) == "B", Eval( ::aColumns[ nCol ]:cFooting ), ; ::aColumns[ nCol ]:cFooting ) uData := cValTochar( uData ) uData := StrTran( uData, CRLF, Chr( 10 ) ) oSheet:Cells( nLine + 1, nCol ):Value := uData // вот так сделать Next EndIf[/pre2] Григорий, файл h_tbrowse.prg который присылал мне, я исправил и выслал на почту.
gfilatov2002: Andrey пишет: Предложение по правке этой ошибки Благодарю за это исправление Проблема с выводом подвала решена
Andrey: gfilatov2002 пишет: Проблема с выводом подвала решена ДА ! И проблема показа текстовых столбцов вида 3/2, 1/5 и т.д. ТОЖЕ решена в отправленном модуле !
Andrey: Вспомнил про ещё один баг в METHOD ExcelOle() ! После создания xls файла, сам Эксель уходин на второй план, т.е. под окно этого экспорта. Юзера ЗЛЯТСЯ ОЧЕНЬ на это !!! Для исправления этого нужно сделать так: [pre2] CursorArrow() ::Reset() If hProgress != Nil SendMessage( hProgress, PBM_SETPOS, 0, 0 ) EndIf If lActivate oExcel:Visible := .T. hWnd := oExcel:hWnd ShowWindow( hWnd, 6 ) // MINIMIZE windows INKEYGUI(100) ShowWindow( hWnd, 3 ) // MAXIMIZE windows BringWindowToTop( hWnd ) Else oExcel:Application:Quit() EndIf //::Reset() //If hProgress != Nil // SendMessage( hProgress, PBM_SETPOS, 0, 0 ) //EndIf Return Nil [/pre2] Такой код оставляет ЭКСЕЛЬ на переднем плане.
Alex_Cher: Andrey пишет: Вспомнил про ещё один баг в METHOD ExcelOle() А в oExcel := TOleAuto():New( "Excel.Application" ) можно получить такой же же эффект, что бы при создание Excel вылетал на передний план ?
Andrey: Alex_Cher пишет: можно получить такой же же эффект, что бы при создание Excel вылетал на передний план ? Да. Делай последние строчки так же как METHOD ExcelOle() и получишь такой же результат.
Andrey: Может такой код нужно ставить, чтобы Эксель оставался на экране: [pre2] If lActivate oExcel:Visible := .T. If VAL( oExcel:Version ) <= 13 // Excel 2003 ShowWindow( oExcel:hWnd, 6 ) // MINIMIZE windows ShowWindow( oExcel:hWnd, 3 ) // MAXIMIZE windows Endif Try BringWindowToTop( oExcel:hWnd ) // a window on the foreground End Try Else oExcel:Application:Quit() EndIf[/pre2]
Alex_Cher: Andrey пишет: Делай последние строчки так же как METHOD ExcelOle() Андрей, неверное я что-то не догоняю, с сырцах не нашел метод TOleAuto(): и куда добавлять ...?
Andrey: Alex_Cher пишет: неверное я что-то не догоняю, с сырцах не нашел метод TOleAuto(): и куда добавлять ...? Этот код добавляй в свою программу. Я писал про METHOD ExcelOle() который находиться MiniGUI\SOURCE\TsBrowse\h_tbrowse.prg Но этот метод Григорий исправит и будет достен в следующей версии.
Andrey: Нашёл ещё один баг в METHOD ExcelOle(): При многострочном построении Tsbrowsa при экспорте - получается так: Хотя таблица выглядеть должна примерно так: Как и где исправить код для этого метода ?
Alex_Cher: Andrey пишет: Этот код добавляй в свою программу. Андрей с Excel все получилось ... , почему с Word не получается - oWord:Visible := .T. hWnd := oWord:hWnd ShowWindow( hWnd, 6 ) // MINIMIZE windows INKEYGUI(100) ShowWindow( hWnd, 3 ) // MAXIMIZE windows BringWindowToTop( hWnd )
Andrey: Alex_Cher пишет: почему с Word не получается - Там фигня с Вордом. Я делаю так: [pre2] If lActivate oText:HomeKey(wdStory) // в начало текста oWord:Visible := .T. SetWordWindowToForeground(oWord) // окно Word на передний план EndIf RETURN NIL ////////////////////////////////////////////////////////////////////// // окно Word на передний план FUNCTION SetWordWindowToForeground(oWord) LOCAL hWnd, nVer, cCaption, cTitle // ------------------- поиск ХЕНДЛА открытого окна документа -------------- hWnd := 0 nVer := VAL( oWord:Version ) // Версия Word IF nVer > 14 // Word 2010 hWnd := oWord:ActiveDocument:ActiveWindow:Hwnd ELSE //hWnd:=oWord:hwnd - так делать нельзя ! cCaption := oWord:Windows[1]:Caption cTitle := cCaption + " - MICROSOFT WORD" hWnd := FindWindowEx(,,, cTitle ) IF hWnd == 0 cTitle := cCaption + " [Режим ограниченной функциональности] - MICROSOFT WORD" hWnd := FindWindowEx(,,, cTitle ) ENDIF ENDIF IF hWnd > 0 ShowWindow( hWnd, 6 ) // MINIMIZE windows ShowWindow( hWnd, 3 ) // MAXIMIZE windows BringWindowToTop( hWnd ) // A window on the foreground ENDIF RETURN NIL[/pre2] Смотри пример DBF_to_DOC_03.7z на https://abonent4.ru/minigui/
Alex_Cher: Andrey пишет: Там фигня с Вордом. Я делаю так: Все получилось, Андрей, большое тебе спасибо ....!
Andrey: Модуль h_tbrowse.prg, METHOD ExcelOle(...) Нафига там где то посередке стоит: [pre2] If ::lIsDbf ( ::cAlias )->( DbGoTo( nRecNo ) ) ::GoPos( nOldRow, nOldCol ) EndIf ::nAt := nAt[/pre2] Всё равно при выходе стоит - ::Reset()
Andrey: Если в методе ExcelOle(...) стоит функция доп.обработки [pre2] If bExtern != Nil Eval( bExtern, oSheet, Self ) EndIf[/pre2] В ней также можно перемещаться по tsbrowse, то наверное вот этот кусок: [pre2] If ::lIsDbf ( ::cAlias )->( DbGoTo( nRecNo ) ) ::GoPos( nOldRow, nOldCol ) EndIf ::nAt := nAt[/pre2] - нужно ставить уже после этой If bExtern != Nil ? Или я не прав ?
SergKis: Andrey пишет нужно ставить уже после этой If bExtern != Nil ? Я бы сказал "нужно ставить уже и после этой If bExtern != Nil ? "
Andrey: Понял ! Спасибо ! Буду у себя так делать. Осталось Григорию у себя в библиотеке поменять...
Andrey: Всем привет ! Можно ли как то на лету изменить таблицу с параметром SELECT .T. или вообще без него ? Т.е. строиться таблица с SELECT .T., а потом его нужно удалить/восстановить.
Andrey: Понял, что нельзя. Ещё вопрос про селектор. Нашёл баг по редко встречающему условию. METHOD ExcelOle() используем таблицу с селектором. При экспорте делаем так: [pre2] CursorWait() If ::lSelector ::aClipBoard := { ColClone( ::aColumns[ 1 ], Self ), 1, "" } ::DelColumn( 1 ) ::lSelector :=.F. // нужно сделать !!! EndIf[/pre2] Нужно тогда ::lSelector делать .F. - иначе при вызове доп.функции: [pre2] If bExtern != Nil Eval( bExtern, oSheet, Self ) EndIf[/pre2] При проверке ::lSelector будет возвращать всегда .T. - что неправильно !!! И разместить как я предлагал доп.функцию уже в самом конце: [pre2] oSheet:Range( "A1" ):Select() If hProgress != Nil SendMessage( hProgress, PBM_SETPOS, nTotal, 0 ) EndIf If bExtern != Nil Eval( bExtern, oSheet, Self ) EndIf If ::lIsDbf ( ::cAlias )->( DbGoTo( nRecNo ) ) ::GoPos( nOldRow, nOldCol ) EndIf ::nAt := nAt If ! Empty( cXlsFile ) .and. lSave[/pre2]
Andrey: Всем привет ! Вот кусок кода для Tsbrowse: [pre2] LOCAL nRecNo := ( oBrw:cAlias )->( RecNo() ), nAt := oBrw:nAt LOCAL nOldRow := oBrw:nLogicPos(), nOldCol := oBrw:nCell ........ For nRow := 1 TO oBrw:nLen ..... oBrw:Skip(1) Next ..... oBrw:Reset() // вариант 1 If oBrw:lIsDbf ( oBrw:cAlias )->( DbGoTo( nRecNo ) ) oBrw:GoPos(nOldRow, nOldCol) EndIf oBrw:nAt := nAt oBrw:Reset() // вариант 2 ....[/pre2] Куда ставить oBrw:Reset() ? По варианту 1 или по варианту 2 ?
Haz: Andrey пишет: Куда ставить oBrw:Reset() Посмотреть что делает ::Reset() потом на свой кусок кода и понимание придет само [pre2] METHOD Reset(lBottom) ... If lBottom ::GoBottom() ElseIf ::lInitGoTop ::GoTop() EndIf ::Refresh( .T., .T. ) If ::bChange != Nil Eval( ::bChange, Self, 0 ) EndIf Return Self [/pre2]
Andrey: А зачем тогда нужно делать: [pre2]LOCAL nAt := oBrw:nAt ... oBrw:nAt := nAt [/pre2]
Haz: Andrey пишет: зачем тогда нужно делать: LOCAL nAt := oBrw:nAt При бровсе по массиву gopos не выполнится, а перед этим был skip()
Andrey: Всем привет ! Обнаружил в методе ExcelOle() баг. Удаляет часть данных из Второй колонке в конце таблицы. Версия МиниГуи последняя. Пробовал в нескольких задачах. Вот так это выглядит, 0-к съедает в последней ячейке 2-ой колонки: Если стоит 001, то удаляет два нолика. Как бы исправить это ? В Tsb4xlsOle.prg экспорт отрабатывает на отлично.
Andrey: Ещё обнаружил в методе ExcelOle() баг. Если буквы при экспорте в эксель больше Z, т.е. колонок больше 26 - то ломается экспорт. Попробую сделать свою функцию для названия колонок и заменить везде CHR(64 +....
SergKis: Andrey пишет Попробую сделать свою функцию для названия колонок и заменить везде CHR(64 +.... Паша тебе дал хорошие функции, зачем велосипед гонять[pre2] Function ExcelAdr(nRow, nCol) Return if(nCol>26,Chr(Int((nCol-1)/26)+64),'')+Chr((nCol-1)%26+65) + LTrim(Str(Int(nRow))) и до кучи еще одну функцию (для адреса диапазона ячеек): Function ExcelAdr2(nRow1, nCol1, nRow2, nCol2) Return ExcelAdr(nRow1, nCol1) + ':' + ExcelAdr(nRow2, nCol2)[/pre2] Под них скорее надо method ExcelOle заточить, вместо[pre2] aCol := { 26, 52, 78, 104, 130, 156 }, ; aLet := { "", "A", "B", "C", "D", "E" }, ; ... cLet := aLet[ AScan( aCol, {|e| Len( If( aColSel != Nil, aColSel, ::aColumns ) ) <= e } ) ] If ! Empty( cLet ) nCol := AScan( aLet, cLet ) - 1 cLet += Chr( 64 + Len( If( aColSel != Nil, aColSel, ::aColumns ) ) - aCol[ Max( 1, nCol ) ] ) Else cLet := Chr( 64 + Len( If( aColSel != Nil, aColSel, ::aColumns ) ) ) EndIf ... [/pre2]
Andrey: SergKis пишет: Паша тебе дал хорошие функции, зачем велосипед гонять Да забыл про них. А где давал уже и не помню !
Dima: Andrey пишет: А где давал уже и не помню тут )) http://clipper.borda.ru/?1-1-0-00000531-000-0-0-1531592334
Andrey: Григорий, я исправил h_tbrowse.prg У меня заработал экспорт с большим количеством колонок. Исправленный h_tbrowse.prg - оправил к тебе на почту.
gfilatov2002: Andrey пишет: заработал экспорт с большим количеством колонок Проверил на базе с 28 полями - экспорт работает нормально. Благодарю за помощь Andrey пишет: Исправленный h_tbrowse.prg Обрати внимание, что у тебя старая версия этого файла
Andrey: gfilatov2002 пишет: Обрати внимание, что у тебя старая версия этого файла Да, я брал из предыдущей версии. Буду ждать новую версию МиниГуи.
Andrey: SergKis пишет: И еще, если добавить в TsColumn DATA bDecode // Charset decode or other DATA bEncode // Charset encode or other Не совсем понятно зачем это нужно. Можно пояснить ?
SergKis: Andrey пишет Можно пояснить ? см. http://clipper.borda.ru/?1-1-0-00000532-000-80-0-1535705309 пост 1960 и далее Можно применить для др. действий, к примеру своя шифровка\расшифровка символьных полей
SergKis: PS Обрати внимание на пример поста 1962
SergKis: PS Описание примера - пост 1940, тема та же
Andrey: SergKis пишет: Можно применить для др. действий, к примеру своя шифровка\расшифровка символьных полей Давно об этом мечтал. Пример будет на эту тему ?
SergKis: Andrey пишет Пример будет на эту тему ? [pre2] 1. :lEdit := .T. :bData := FieldWBlock('NAME', select(cAlias)) :bDecode := {|cv| sx_Decrypt(cv, 'MyPassword') } :bEncode := {|cv| sx_Encrypt(cv, 'MyPassword') } 2. oKey := oKeyData() oKey:Set(1, 'Name 1') oKey:Set(2, 'Name 2') oKey:Set(3, 'Name 3') ... oKey:Set(9, 'Name 9') :lEdit := .F. :bData := FieldWBlock('NUMKEY', select(cAlias)) :bDecode := {|nk| oKey:Get(nk, '????????') } [/pre2]
Andrey: Всем привет ! Пытаюсь понять метод oBrw:DeleteRow() для DBF. Что-то не работает... Модифицировал пример Tsb_linedrag для вставки/удаления записей. Вставка работает, удаление нет. Что не так делаю ? Проект вот - https://cloud.mail.ru/public/4kmS/Ad1Xf9Sy2 И ещё пара вопросов: 1) Не отрабатывает вставка вертикального скролинга - oBrw:ResetVScroll(). Почему ? 2) Как сделать заново полное считывание базы для этой программы ? можно обойтись без удаления объекта, а просто заново считать базу в готовый объект ?
SergKis: Andrey пишет Пытаюсь понять метод oBrw:DeleteRow() для DBF Для этого определись с режимом работы SET DELETED ON\OFF Если OFF, то записи удаленные так же на экране, только помечаются deleted, :DeleteRow() тогда делает recall для удаленной, для разделения при показе вкл. цвета для удаленных. Если ON и без индекса, то сам управляй переменной :nLen, т.е. уст. блок :bLogicLen для "правильного" счета записей в просмотре. Если с индексом, то делай его FOR ! deleted() - тогда тсб кое что сделает сама, это кое что иногда нужно менять. В этом примере для исчезновения строк при удалении сделать[pre2] GO TOP INDEX ON RecNo() TAG ID FOR ! Deleted() GO TOP DEFINE WINDOW Form_0 ; ... STATIC FUNCTION RecnoInsert(oBrw) ... // IF INDEXORD() == 0 oBrw:GoToRec( nRecno ) // ENDIF // oBrw:Refresh( .T. ) // перечитать записи таблицы ? "Insert=", nRecno ENDIF oBrw:SetFocus() ... STATIC FUNCTION RecnoDelete(oBrw) LOCAL nRow := oBrw:nRowPos ... lDelete := oBrw:DeleteRow() ? "Delete=",nRecno, lDelete If nRow == oBrw:nRowCount() oBrw:PostMsg( WM_KEYDOWN, VK_END, 0 ) EndIf oBrw:SetFocus() ... [/pre2]
SergKis: PS и SET DELETED ON поставить конечно
SergKis: PPS оговорюсь сразу, что[pre2] If nRow == oBrw:nRowCount() oBrw:PostMsg( WM_KEYDOWN, VK_END, 0 ) EndIf [/pre2] не решает всех проблем, это только пример варианта, т.к. есть еще значение :nLen его тоже учитывать надо.
Andrey: SergKis пишет: Для этого определись с режимом работы SET DELETED ON\OFF Спасибо большое за разъяснения ! А как быть с : 2) Как сделать заново полное считывание базы для этой программы ? можно обойтись без удаления объекта, а просто заново считать базу в готовый объект ?
SergKis: Andrey пишет Не отрабатывает вставка вертикального скролинга - oBrw:ResetVScroll() [pre2] FUNCTION CreateBrowse() ... // oBrw:ResetVScroll() // показ вертикального скролинга можно не ставить если ставить, то лучше парой строк // oBrw:ResetVScroll() // показ вертикального скролинга // oBrw:oHScroll:SetRange( 0, 0 ) VScroll появляется при :nLen > :nRowCount() и потом остается. При задании ширины тсб это надо учитывать. Если VScroll не нужен в твоем примере, то делаем oBrw:lNoVScroll := .T. // у тебя он уже так стоит и STATIC FUNCTION RecnoInsert(oBrw) ... If oBrw:lNoVScroll oBrw:oVScroll := Nil EndIf oBrw:GoToRec( nRecno ) ... STATIC FUNCTION RecnoDelete(oBrw) ... lDelete := oBrw:DeleteRow() ? "Delete=",nRecno, lDelete If oBrw:lNoVScroll oBrw:oVScroll := Nil EndIf If nRow == oBrw:nRowCount() ... [/pre2]
SergKis: Andrey пишет 2) Как сделать заново полное считывание базы для этой программы ? можно обойтись без удаления объекта, а просто заново считать базу в готовый объект ? Сие есть тайна для меня, т.к. не понимаю о чем речь. В тсб просмотре только 1 - :nRowCount() строк
Andrey: SergKis пишет: Сие есть тайна для меня, т.к. не понимаю о чем речь. Базу открывать по сети SHARED. Открываем БЕЗ индексов. Первый юзер открыл базу - допустим 10 записей в ней. Другой добавил ещё пару записей и что-то откорректировал. Вот по кнопке Refresh хочу перечитать заново базу и получить все записи для 1-го юзера. У себя в задаче у меня есть такая кнопка, но там у меня условный индекс, рисуется всё автоматом.
SergKis: Andrey :DrawLine(...), :DrawSelect(...) рисуют строку из буфера записи, так что, если 2-ая прога делает commit, то твоя при перемещении по базе должна показать изменения или по кнопке :Refresh(.T.)\Display(). Пробуй
Andrey: SergKis пишет: или по кнопке :Refresh(.T.)\Display(). Пробуй Блин, так просто... Не догадался сразу. Заработало !
Andrey: Базу открывать по сети SHARED. Открываем БЕЗ индексов. А как сделать пересчёт в 1-ом столбце, который я создаю сам ?[pre2] ADD COLUMN TO TBROWSE oBrw DATA {|| 0 } ; //oBrw:nAt } ; HEADER CRLF + "NN" SIZE 40 ; COLORS {CLR_BLACK, WHITE} ALIGN DT_CENTER ; NAME NN [/pre2] Так как индексов нет, то перестройку нумерации нежно только при вставки/удалении записи. Добавил в эти функции - пересчёт ItogoNN( oBrw ) Вот сама функция: [pre2]FUNCTION ItogoNN( oBrw ) LOCAL nI, cAlias := oBrw:cAlias, nRec := ( cAlias )->( RecNo() ) Eval( oBrw:bGoTop ) // переход на начало таблицы FOR nI := 1 TO oBrw:nLen Eval( oBrw:GetColumn("NN"):bData, nI ) oBrw:Skip(1) NEXT ( cAlias )->( DbGoTo( nRec ) ) RETURN NIL[/pre2] Но нет вообще пересчёта. Почему ? Проект положил на fpt и - https://cloud.mail.ru/public/KRRJ/2WvDwnz2a
Haz: Andrey пишет: Но нет вообще пересчёта. Почему ? А чего ты ожидаешь от этого ? Andrey пишет: DATA {|| 0 } PS и не надо портить хороший пример
SergKis: Andrey А что ты считаешь таким "хитрым" способом ?
Andrey: SergKis пишет: А что ты считаешь таким "хитрым" способ Ставил [pre2]ADD COLUMN TO TBROWSE oBrw DATA {|| oBrw:nAt } ;[/pre2] Первый раз показывает правильно. После удаления/вставки или колёсиком покрутить нумерация слетает.... Может и неправильно так делать, тогда подскажите как ? База открывается без индексов ! Можно было бы через массив, там вроде проще, но нужна база. Haz пишет: PS и не надо портить хороший пример Я его до рабочей таблицы довожу. Как в жизни юзера требуют.
SergKis: Andrey Тебе что пишешь, что не пишешь - результат один .... Если ON и без индекса, то сам управляй переменной :nLen, т.е. уст. блок :bLogicLen для "правильного" счета записей в просмотре. плюс свой skipper нужен, может еще что понадобится. А для NN колонки пиши ADD COLUMN TO TBROWSE oBrw DATA {|| (oBrw:cAlias)->( OrdKeyNo() ) } ; но без индекса с SET DELETED ON хз что будет
SergKis: в работе тсб. не ту кнопку нажал, сори.
SergKis: Andrey пишет Я его до рабочей таблицы довожу. Как в жизни юзера требуют. Делай команду выборки в др. таблицу ( COPY TO ..., APPEND FROM ... FOR ! deleted ) Поля бери только ключ для связки или recno + поля по которым построить рабочие индексы для тек. просмотра, если надо. Таблица будет "узкая" и быстрая. Связываешь с основной базой и работаешь SET DELETED OFF, отображая удаленные цветом (вдруг передумают удалять). Все модификации переносишь на основную базу. По refresh можешь сделать ZAP и снова APPEND FROM ... или новый COPY TO ... с переоткрытием.
Andrey: SergKis пишет: ADD COLUMN TO TBROWSE oBrw DATA {|| (oBrw:cAlias)->( OrdKeyNo() ) } ; но без индекса с SET DELETED ON хз что будет Ставил и так, только индекса нет и высвечивается RECNO() Из-за этого и подумал, что можно первую колонку сделать "виртуальной" и нумерацию туда самому переписывать при вставке/добавлении записи. Удалённые записи не нужны, юзер просит только рабочие записи. SergKis пишет: По refresh можешь сделать ZAP и снова APPEND FROM ... или новый COPY TO ... с переоткрытием. Нужно тогда закрывать базу, открывать её монопольно и т.д. Более сложный вариант получается....
Haz: Andrey пишет: Может и неправильно так делать, тогда подскажите как Правильно по индексу. Для таблицы которая целиком на экране , сойдет и ADD COLUMN TO TBROWSE oBrw DATA {|| oBrw:nPaintRow }
Haz: в SHARED и по сети оптимально только индекс. Неоптимально - написать что то типа [pre2] ADD COLUMN TO TBROWSE oBrw DATA {|| GetNum( oBrw ) } [/pre2] где GetNum() [pre2] Func GetNum( oBrw ) local cAlias := oBrw:cAlias local nRec := (cAlias)->(RecNo()) LOcal n := 0 (cAlias)->(dbEval({|| ++n }, {|| !Deleted() .and. RecNo() <= nRec } )) (cAlias)->( dbGoTo(nRec)) Return n [/pre2] НО это костыль по сравнению с индексом
SergKis: Andrey пишет Нужно тогда закрывать базу, открывать её монопольно и т.д. Более сложный вариант получается.... Это таблица отобранная, может состоять из одного поля (ключ или RecNo для связи с базой), находится в mem:, открыта сразу монопольно - твой тсб единственный пользователь, многое упрощается. Это общий случай для всех отборов (типа команда select) ведения, отчетов, ....
SergKis: PS Можешь иметь на нее тэг с FOR ! deleted(), тогда удаленные будут исчезать при set deleted on, OrdKeyNo(), OrdKeyCount() будут ok
Haz: SergKis пишет: Делай команду выборки в др. таблицу ( COPY TO ..., APPEND FROM ... FOR ! deleted ) Сергей, привет! В сети будет сюрприз. Если коллега удалит или вставит запись , то RDD это отработает при скроле по таблице и запись либо появится, либо исчезнет, а вот нумерация слетит т.к. Refresh() не вызывался и временная таблица не пересчитана
SergKis: Игорь, привет ! Сюрприза не будет, т.к. работаем (тсб) совсем с др. таблицей с конкретным числом записей. Под командами copy to ..., append from ... понимаю условное обозначение выборки с уст. scope, filter (это скорее do while ...) На время работы их, если это под тсб, блокируем тсб :lEnable := .T., потом :Reset(), :Display() ... Таблица для тсб может иметь поля для индексов, тогда делаем сначала reindex. То что в базе запись удалена, а у нас нет - будет пустая запись на экране новой не будет совсем, но это временно до след. нажатия refresh, допустимое время появления данных на сервере оно субъективно, но существует
Haz: SergKis пишет: Сюрприза не будет проще индекс держать с !Deleterd() и дергать номер ключа. Но легкий путь , не наш метод
SergKis: PS Для тсб (человека) вполне может не важны те добавления\удаления в данный момент он свое крыжит для важных выборок делаем locktable на время выборки и "чудес" не будет
SergKis: Haz пишет проще индекс держать с !Deleterd() Кто бы спорил, но у Андрея одно рабочее место без индекса, другое с условным индексом ... Что бы не ломать ту ситуацию новую можно так решать безболезненно. Да сложности особой нет
SergKis: PS + такая техника спокойно перейдет в LetoDB
Andrey: SergKis пишет: Кто бы спорил, но у Андрея одно рабочее место без индекса, другое с условным индексом ... Что бы не ломать ту ситуацию новую можно так решать безболезненно. Да сложности особой нет Да я уже согласился. Понял, что огород городить не надо. Надо открывать базу в SHARED и делать индекс !Deleterd() Только вот забыл как делать файл с уникальным именем в папке.. Сейчас сделаю свой вариант и покажу Tsbrowse.
SergKis: Andrey пишет Только вот забыл как делать файл с уникальным именем в папке.. А с именем самого dbf не пойдет. Его должны открывать ВСЕ приложения с модификацией (как SET AUTOPEN ON) иначе "нам удачи не видать"
SergKis: PS Если планируешь повторно исп. удаленные записи, то нужен тэг FOR Deleted()
Andrey: SergKis пишет: А с именем самого dbf не пойдет. Его должны открывать ВСЕ приложения с модификацией (как SET AUTOPEN ON) иначе "нам удачи не видать" Зачем ? Каждый узер открывает базу и делает свой индекс с !Deleterd() Вешаем таймер и каждые полминуты делаем Refresh() базы. Чем не решение ? Избавимся от создания общего индекса. Но можно держать и общий индекс с !Deleterd(). Это уже без разницы.
SergKis: Andrey пишет Вешаем таймер и каждые полминуты делаем Refresh() базы Знаем проходили, Чел пялится в свою запись на экране, вдруг раз она убежала то ли вверх то ли вниз - вставились\удалились записи рядом, попытка удержать курсор на ней может не получиться, пока он таращил глаза, наконец нашел, начал любоваться а она опять куда то улетела, причина см. выше и т.д. Избавимся от создания общего индекса По мне это минус. Если базы копеечные, то да так можно делать, но вопрос нужно ли ?
Andrey: SergKis пишет: Знаем проходили, Чел пялится в свою запись на экране, вдруг раз она убежала то ли вверх то ли вниз - вставились\удалились записи рядом, попытка удержать курсор на ней может не получиться, пока он таращил глаза, наконец нашел, начал любоваться а она опять куда то улетела, причина см. выше и т.д. Понял, так делать тогда не будем. Только для теста.... SergKis пишет: По мне это минус. Если базы копеечные, то да так можно делать, но вопрос нужно ли ? У меня такой механизм (условная индексация) работает уже лет 15. Условная индексация каждого юзера для всех его нужных полей базы, что хочет то и выбирает и ко мне не пристаёт.
Andrey: Что-то фигня получается с разными индексами... С одним общим лучше ! Вот так выглядит теперь: [img]https://i.imgur.com/gievW7U.png?3[/img] Вот проект и исходники (fpt) - https://cloud.mail.ru/public/GMwS/mbgXwsCEs Запустить две программы и можно тестировать. Посмотрите пожалуйста исходники, может что-то и упустил.
SergKis: Andrey Так поправь[pre2] FUNCTION UseOpenBase() LOCAL aStr := {} LOCAL cDbf := GetStartUpFolder() + "\TEST" LOCAL cIndx := cDbf LOCAL lDbfNo LOCAL aAlias := {} LOCAL n := 0 IF ( lDbfNo := ! File( cDbf+'.dbf' ) ) AAdd( aStr, { 'F1', 'D', 8, 0 } ) AAdd( aStr, { 'F2', 'C', 60, 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() ) < 10 TEST->( dbAppend() ) TEST->F1 := Date() + n++ TEST->F2 := Str( n ) TEST->F3 := n TEST->F4 := ( n % 2 ) == 0 END GO TOP INDEX ON RECNO() TAG NN FOR !Deleted() INDEX ON RECNO() TAG NO FOR Deleted() USE ENDIF SET AUTOPEN ON USE ( cDbf ) ALIAS "TEST" SHARED NEW OrdSetFocus('NN') GO TOP // ORDLISTADD( cIndx ) AADD( aAlias, ALIAS() ) // запомнить базу для закрытия RETURN aAlias [/pre2]
Andrey: Всё таки есть небольшие сбои в Tsbrowse или в примерах Tsb_Shared нужно что-то добавлять. Непонятки возникли: 1) если удалить 2-3 записи в таблице, то нарушается показ в вертикальном скролинге. 2) demo.exe - если таблица без вертикального скролинга, то при добавлении записей вертик.скролинг не появляется (иногда появляется) 3) demo2.exe - если таблица без вертикального скролинга, то при добавлении записей вертик.скролинг появляется но без нижней стрелки, огрызок какой то... Последний проект Tsb_Basic(1.8).7z здесь - https://cloud.mail.ru/public/8WrP/cpCzTtqKp
SergKis: Andrey Просто добавь воды строки[pre2] STATIC FUNCTION RecnoInsert(oBrw) ... oBrw:ResetVScroll( .T. ) oBrw:oHScroll:SetRange( 0, 0 ) ENDIF RETURN Nil ... STATIC FUNCTION RecnoDelete(oBrw) ... with object oBrw If :nLen > :nRowCount() .and. :nRowPos < :nRowCount() (:cAlias)->( dbSkip(-:nRowCount()) ) :nRowPos := :nRowCount() :Refresh(.T.) EndIf end with oBrw:ResetVScroll( .T. ) oBrw:oHScroll:SetRange( 0, 0 ) RETURN Nil ... [/pre2] выделенное синим, можешь не ставить.
Andrey: SergKis пишет: Просто добавь воды строки Спасибо ! Помогло !
Andrey: Всем доброй ночи ! Вот столкнулся с такой проблемой, не знаю как сделать перемещение записи в таблице вверх или вниз. Какой нужно сделать алгоритм показа ? Ввести новое поле в базу или по другому ? Я делал ранее алгоритм пересчёта поля на лету, но там база была очень маленькой. А для больших баз как это реализовать ? Вот заготовку примера сделал - https://cloud.mail.ru/public/FDWs/KgajUDnAw И ещё одна важная особенность ! Юзер хочет добавить запись под/перед курсором/маркером бровса, а не в конец базы.
Haz: Andrey пишет: Юзер хочет добавить запись под/перед курсором/маркером бровса, а не в конец базы. В чем проблема? Держи активный индекс по которому сортируются записи. Хоть вычисляемый, хоть по значению в поле. При добавлении позаботься о том чтобы у новой записи индекс получил нужное значение. Варианты реализации - все что угодно на твой вкус, главное результат. Вопрос вообще ни каким боком к Tsbrowse не относится. Если тупо оценить его то это, "как логически поместить запись в нужную позицию" Это же и к предыстории к вопроса относится. Как решишь, далее нужно всего лишь применить новую редакцию ::gotorec() с указанием нужной строки
SergKis: Andrey Использую без индексов C функции (вроде от Pasha они), пробни, может подойдет [pre2] #define HB_OS_WIN_USED #include "hbapi.h" #include "hbapiitm.h" #include "hbapirdd.h" #include "hbrdddbf.h" #include "hbapicdp.h" //#include "hbdate.h" #ifdef __XHARBOUR__ #define HB_SUCCESS SUCCESS #endif /* HB_FUNC( MILLIS ) { hb_retnl( hb_dateMilliSeconds() ); } */ /* HB_FUNC( DBSETCDP ) { AREAP pArea = hb_rddGetCurrentWorkAreaPointer(); if( pArea && ISCHAR(1) ) { char * pCdp = hb_parc(1); if( pCdp ) pArea->cdPage = hb_cdpFind( (char *) pCdp ); } } */ // ------------------------------- // Static func bMemoGetBlock(nPos) // Return {|| dbGetMemoBlock(nPos)} // ------------------------------- HB_FUNC( DBGETMEMOBLOCK ) { DBFAREAP pArea = ( DBFAREAP ) hb_rddGetCurrentWorkAreaPointer(); USHORT uiField = hb_parni( 1 ) - 1; #ifdef __XHARBOUR__ LPFIELD pField = pArea->lpFields + uiField; #else LPFIELD pField = pArea->area.lpFields + uiField; #endif char * ptr = ( char * ) pArea->pRecord + pArea->pFieldOffset[uiField]; ULONG ulBlock = 0; if( pField->uiLen == 4 ) ulBlock = HB_GET_LE_UINT32( ptr ); else { BYTE bByte; USHORT uiCount; for( uiCount = 0; uiCount < 10; uiCount++ ) { bByte = ptr[ uiCount ]; if( bByte >= '0' && bByte <= '9' ) ulBlock = ulBlock * 10 + ( bByte - '0' ); } } hb_retnl( ulBlock ); } // --------------------------- // Получить значение поля как строка // if FieldType(nPos) == "C"; xVal := FieldGet(nPos) // else ; xVal := dbGetValue(nPos) // endif // --------------------------- HB_FUNC( DBGETVALUE ) { DBFAREAP pArea = ( DBFAREAP ) hb_rddGetCurrentWorkAreaPointer(); USHORT uiField = hb_parni( 1 ) - 1; #ifdef __XHARBOUR__ LPFIELD pField = pArea->lpFields + uiField; #else LPFIELD pField = pArea->area.lpFields + uiField; #endif hb_retclen( ( char * ) pArea->pRecord + pArea->pFieldOffset[uiField], pField->uiLen ); } // ----------------------------- // if FieldType(nPos) == "C"; FieldPut(nPos, xVal) // else ; dbPutValue(nPos, xVal) // endif // ----------------------------- HB_FUNC( DBPUTVALUE ) { DBFAREAP pArea = ( DBFAREAP ) hb_rddGetCurrentWorkAreaPointer(); USHORT uiField = hb_parni( 1 ) - 1; #ifdef __XHARBOUR__ LPFIELD pField = pArea->lpFields + uiField; #else LPFIELD pField = pArea->area.lpFields + uiField; #endif if( ISCHAR(2) && ( hb_parclen(2) <= pField->uiLen ) ) { memcpy( ( char * ) pArea->pRecord + pArea->pFieldOffset[uiField], hb_parc(2), hb_parclen(2) ); pArea->fRecordChanged = TRUE; pArea->fDataFlush = TRUE; } hb_ret(); } // ------------------------ // Вставить запись // nKol := 1; nRec := RecNo() // dbGoto(nRec); dbInsert(nRec, nKol) // ------------------------ HB_FUNC( DBINSERT ) { DBFAREAP pArea = ( DBFAREAP ) hb_rddGetCurrentWorkAreaPointer(); BOOL bOk = TRUE; if( pArea && ! pArea->fReadonly && ! pArea->fShared ) { ULONG ulRec, ulCount = ISNUM(2) ? hb_parnl(2) : 1; #ifdef __XHARBOUR__ ULONG hFile = pArea->hDataFile; #else HB_FHANDLE hFile = hb_fileHandle( pArea->pDataFile ); #endif if( ISNUM(1) ) ulRec = hb_parnl(1); else SELF_RECNO( ( AREAP ) pArea, &ulRec ); if( ulRec == 0 || ulRec > pArea->ulRecCount ) bOk = FALSE; if( bOk && SELF_GOCOLD( ( AREAP ) pArea ) != HB_SUCCESS ) bOk = FALSE; else { ULONG ulIndex; for( ulIndex = 0; ulIndex < ulCount; ulIndex ++) SELF_APPEND( ( AREAP ) pArea, TRUE ); SELF_FLUSH( ( AREAP ) pArea ); /* pArea->fUpdateHeader = TRUE; pArea->ulRecCount += ulCount; if( SELF_WRITEDBHEADER( ( AREAP ) pArea ) != HB_SUCCESS ) bOk = FALSE; */ if( bOk ) { ULONG ulLen = (pArea->ulRecCount - ulRec) * pArea->uiRecordLen; ULONG ulLen1 = ulCount*pArea->uiRecordLen; // ULONG ulRecNo; char * pData = hb_xgrab( ulLen + 1 ); char * pZero = hb_xgrab( ulLen1 + 1 ); hb_fsSeekLarge( hFile, ( HB_FOFFSET ) pArea->uiHeaderLen + ( HB_FOFFSET ) pArea->uiRecordLen * ( HB_FOFFSET ) (ulRec - 1), FS_SET ); hb_fsReadLarge( hFile, pData, ulLen ); hb_fsSeekLarge( hFile, ( HB_FOFFSET ) pArea->uiHeaderLen + ( HB_FOFFSET ) pArea->uiRecordLen * ( HB_FOFFSET ) (pArea->ulRecCount - ulCount), FS_SET ); hb_fsReadLarge( hFile, pZero, ulLen1 ); hb_fsSeekLarge( hFile, ( HB_FOFFSET ) pArea->uiHeaderLen + ( HB_FOFFSET ) pArea->uiRecordLen * ( HB_FOFFSET ) (ulRec - 1), FS_SET ); hb_fsWriteLarge( hFile, pZero, ulLen1 ); hb_fsSeekLarge( hFile, ( HB_FOFFSET ) pArea->uiHeaderLen + ( HB_FOFFSET ) pArea->uiRecordLen * ( HB_FOFFSET ) (ulRec + ulCount - 1), FS_SET ); hb_fsWriteLarge( hFile, pData, ulLen ); hb_xfree( pData ); hb_xfree( pZero ); /* for( ulRecNo = ulRec + ulCount - 1; ulRecNo >= ulRec; ulRecNo --) { SELF_GOTO( ( AREAP ) pArea, ulRecNo ); SELF_SETBLANKRECORD( ( AREAP ) pArea, 2 ); // HB_BLANK_EOF } */ } } if( bOk && SELF_GOTO( ( AREAP ) pArea, ulRec ) != HB_SUCCESS ) bOk = FALSE; } hb_retl( bOk ); } // ---------------------------- // Физическое удаление записей // nKol := 1; nRec := RecNo() // dbGoto(nRec); dbDelRecord(nRec, nKol) // ---------------------------- HB_FUNC( DBDELRECORD ) { DBFAREAP pArea = ( DBFAREAP ) hb_rddGetCurrentWorkAreaPointer(); BOOL bOk = TRUE; if( pArea && ! pArea->fReadonly && ! pArea->fShared ) { ULONG ulRec, ulCount = ISNUM(2) ? hb_parnl(2) : 1; #ifdef __XHARBOUR__ ULONG hFile = pArea->hDataFile; #else HB_FHANDLE hFile = hb_fileHandle( pArea->pDataFile ); #endif if( ISNUM(1) ) ulRec = hb_parnl(1); else SELF_RECNO( ( AREAP ) pArea, &ulRec ); if( ulRec == 0 || (ulRec + ulCount - 1) > pArea->ulRecCount ) bOk = FALSE; if( bOk && SELF_GOCOLD( ( AREAP ) pArea ) != HB_SUCCESS ) bOk = FALSE; else { char pData; if( (ulRec + ulCount - 1) < pArea->ulRecCount ) { ULONG ulLen = (pArea->ulRecCount - (ulRec + ulCount - 1)) * pArea->uiRecordLen; char * pData = hb_xgrab( ulLen + 1 ); hb_fsSeekLarge( hFile, ( HB_FOFFSET ) pArea->uiHeaderLen + ( HB_FOFFSET ) pArea->uiRecordLen * ( HB_FOFFSET ) (ulRec + ulCount - 1), FS_SET ); hb_fsReadLarge( hFile, pData, ulLen ); hb_fsSeekLarge( hFile, ( HB_FOFFSET ) pArea->uiHeaderLen + ( HB_FOFFSET ) pArea->uiRecordLen * ( HB_FOFFSET ) (ulRec - 1), FS_SET ); hb_fsWriteLarge( hFile, pData, ulLen ); hb_xfree( pData ); } pArea->fUpdateHeader = TRUE; pArea->ulRecCount -= ulCount; } if( bOk && SELF_WRITEDBHEADER( ( AREAP ) pArea ) != HB_SUCCESS ) bOk = FALSE; if( bOk && SELF_GOTO( ( AREAP ) pArea, ulRec ) != HB_SUCCESS ) bOk = FALSE; } hb_retl( bOk ); } // -------------------------- // Обрезать файл после записи ... // nRec := RecNo(); dbGoto(nRec) // dbTruncate(nRec) // -------------------------- HB_FUNC( DBTRUNCATE ) { DBFAREAP pArea = ( DBFAREAP ) hb_rddGetCurrentWorkAreaPointer(); BOOL bOk = TRUE; if( pArea && ! pArea->fReadonly && ! pArea->fShared ) { ULONG ulRec; if( ISNUM(1) ) ulRec = hb_parnl(1); else SELF_RECNO( ( AREAP ) pArea, &ulRec ); if( ulRec == 0 || ulRec > pArea->ulRecCount ) bOk = FALSE; if( bOk && SELF_GOCOLD( ( AREAP ) pArea ) != HB_SUCCESS ) bOk = FALSE; else { pArea->fUpdateHeader = TRUE; pArea->ulRecCount = ulRec; } if( bOk && SELF_WRITEDBHEADER( ( AREAP ) pArea ) != HB_SUCCESS ) bOk = FALSE; if( bOk && SELF_GOTO( ( AREAP ) pArea, ulRec ) != HB_SUCCESS ) bOk = FALSE; } hb_retl( bOk ); } HB_FUNC( DBRECORDGET ) { AREAP pArea = ( AREAP ) hb_rddGetCurrentWorkAreaPointer(); PHB_ITEM pItem = hb_itemPutNI( NULL, 0 ); BYTE *pRec; if( pArea && (SELF_INFO( (AREAP) pArea, DBI_GETRECSIZE, pItem ) == HB_SUCCESS) && ( SELF_GETREC( (AREAP) pArea, &pRec ) == HB_SUCCESS ) ) { hb_retclen( pRec, hb_itemGetNI(pItem) ); } hb_itemRelease( pItem ); } HB_FUNC( DBRECORDPUT ) { AREAP pArea = ( AREAP ) hb_rddGetCurrentWorkAreaPointer(); PHB_ITEM pItem = hb_itemPutNI( NULL, 0 ); if( pArea && ISCHAR(1) && (SELF_INFO( (AREAP) pArea, DBI_GETRECSIZE, pItem ) == HB_SUCCESS) && hb_parclen(1) >= (ULONG) hb_itemGetNI(pItem) ) { SELF_PUTREC( pArea, hb_parc(1) ); } hb_itemRelease( pItem ); } static void SetFieldType( LPFIELD pField, char bType ) { switch( bType ) { case 'C': pField->uiType = HB_FT_STRING; break; case 'L': pField->uiType = HB_FT_LOGICAL; break; case 'D': pField->uiType = HB_FT_DATE; break; case 'I': case '2': case '4': pField->uiType = HB_FT_INTEGER; break; case 'Y': pField->uiType = HB_FT_CURRENCY; break; case 'N': pField->uiType = HB_FT_LONG; break; case 'F': pField->uiType = HB_FT_FLOAT; break; case '8': case 'B': pField->uiType = HB_FT_DOUBLE; } } // ------------------------ // Переименовать поле, поменять его тип и дробную часть // в пределах длины поля, заданную при создании dbf // FieldRename( nPos, FieldNameNew[, FieldTypeNew[, FieldDecNew]] ) // ------------------------ HB_FUNC( FIELDRENAME ) { DBFAREAP pArea = ( DBFAREAP ) hb_rddGetCurrentWorkAreaPointer(); USHORT uiField = hb_parni( 1 ); char szFieldName[12]; #ifdef __XHARBOUR__ if( uiField && uiField <= pArea->uiFieldCount && ISCHAR(2) && hb_parclen(2) <= 11 ) #else if( uiField && uiField <= pArea->area.uiFieldCount && ISCHAR(2) && hb_parclen(2) <= 11 ) #endif { char * szType = hb_parc( 3 ); #ifdef __XHARBOUR__ ULONG hFile = pArea->hDataFile; LPFIELD pField = pArea->lpFields + uiField - 1; #else HB_FHANDLE hFile = hb_fileHandle( pArea->pDataFile ); LPFIELD pField = pArea->area.lpFields + uiField - 1; #endif ULONG ulOffset = sizeof( DBFHEADER ) + (uiField-1)*sizeof( DBFFIELD ); memset(szFieldName, 0, 12); memcpy(szFieldName, hb_parc(2), hb_parclen(2) ); hb_fsSeekLarge( hFile, ( HB_FOFFSET ) ulOffset, FS_SET ); hb_fsWriteLarge( hFile, szFieldName, 11 ); pField->sym = ( void * ) hb_dynsymGetCase( szFieldName ); if( szType ) { hb_fsSeekLarge( hFile, ( HB_FOFFSET ) ( ulOffset + 11 ), FS_SET ); hb_fsWriteLarge( hFile, szType, 1 ); SetFieldType( pField, szType[0] ); } if( ISNUM( 4 ) ) { USHORT uiDec = hb_parni( 4 ); hb_fsSeekLarge( hFile, ( HB_FOFFSET ) ( ulOffset + 17 ), FS_SET ); hb_fsWriteLarge( hFile, (char *) &uiDec, 1 ); pField->uiDec = uiDec; } } } HB_FUNC( DBFRECCOUNT ) { DBFAREAP pArea = ( DBFAREAP ) hb_rddGetCurrentWorkAreaPointer(); if( pArea ) { if( ISNUM( 1 ) ) { HB_PUT_LE_UINT32( pArea->dbfHeader.ulRecCount, hb_parnl( 1 ) ); pArea->fUpdateHeader = TRUE; } hb_retnl( HB_GET_LE_UINT32( pArea->dbfHeader.ulRecCount ) ); } else hb_retnl( 0 ); } #include <windows.h> HB_FUNC( GETSYSTEMDEFAULTLANGID ) { hb_retnl( GetSystemDefaultLangID() ); } [/pre2]
Haz: SergKis пишет: Использую без индексов Сергей привет. Навеяно исходниками. Году в 90 занимался вставкой записей используя функции семейства fread, fwrite итд. Зная структуру dbf эта задача прммитивная, но тогда.... и базы были короче и валялись они локально. А может и оптимизма в голове было побольше. Сейчас я только пожелаю флаг в руки и вперёд в атаку. А я тут подожду.
SergKis: Haz пишет А я тут подожду. Как говорится "Хозяин-барин", но dbInsert очень хорошо легла на: 1. Разбиение отчета печати по листам, когда нельзя разрывать лист на строках заголовков, итогов и т.д., т.е. разрывать лист можно только на детальной строке а далее как душа ляжет ... Вставляю строку типа chr(12) 2. Выполнен отбор типа select * ...., далее по уточнению различные группирования, заголовки\подзаголовки\итоги\под итоги и т.д. с выходом на печать и п.1 3. Ввод в какой то документ, где пользователь сам определяет перед\после какой строкой[и] делаем запись new 4. Export или подсовывание запроса с базы где нет полей с определенными названиями в какой то уже работающий отчет. Делаем запрос и потом меняем названия полей на нужные или на раб. месте за дробью надо не 7 знаков, а по установке, округляем и меняем в структуре через FieldRename(...) Это основное, что использую.
Haz: SergKis пишет: Как говорится "Хозяин-барин", но Плавали, знаем все тоже делаю в sql запросах Select top 50 * Select next Select summa as [ выручка с НДС ] Группировки так вообще для этого скуль и придумали а вставку в определённую логическую позицию по спец полю определяющему сортировку и вложенность структуры. Но тут кто как привык. Все подходы правильные когда работают
SergKis: Haz пишет все тоже делаю в sql запросах На ADS у нас только немцы приходили в начале 2000-х, но их выжили скандинавы. Из за его стоимости никто из клиентов не хочет(ел) приобретать лицензию, даже богатый Латв.энерго. От исп. mysqll и firebird мы отказались сами из за администр. затрат эксплуатации на чужих администраторах\рс. Но тут кто как привык Схему select * или select (...) as (...) ... поддерживаю на DBFCDX(letodb), распределяя "основной" запрос на сервер, с доработкой "до кондиции" на клиенте.
Andrey: Вот ещё одна непонятка для меня. Беру пример \SAMPLES\Advanced\Tsb_array_2\demo.prg Меняю: [pre2] LOCAL cFontName := "Comic Sans MS" LOCAL nFontSize := 16 DEFINE TBROWSE oBrw ; .... FONT cFontName SIZE nFontSize ; GRID [/pre2] Фонт меняется в таблице, визуально видно. Запрашиваю размер фонта так:[pre2] hFont := oBrw:hFont // считать хендл фонта ячеек таблицы //hFont := oBrw:aColumns[2]:hFont // 1-cells font If hFont != Nil aFontGet := GetFontParam(hFont) nFSize2 := aFontGet[2] // узнать истинный размер фонта в ячейке ENDIF ? "nFontSize=", nFontSize, "|nFSize2=", nFSize2, hb_ValToExp(aFontGet) Получаю: [pre2] nFontSize=16 |nFSize2=9 {"Segoe UI", 9, .F., .F., .F., .F., 0}[/pre2] Почему так получается ? Или я неправильно делаю ? Тогда подскажите пожалуйста как нужно определить размер фонта в ячейках.
SergKis: Andrey пишет Почему так получается ? Или я неправильно делаю ? Может игнорируешь исходники, для понимания ситуации ?
TimTim: Andrey пишет: Юзер хочет добавить запись под/перед курсором/маркером бровса, а не в конец базы. Haz пишет: Держи активный индекс по которому сортируются записи. Хоть вычисляемый, хоть по значению в поле. При добавлении позаботься о том чтобы у новой записи индекс получил нужное значение. Привожу пример грубой реализации - https://cloud.mail.ru/public/2CQk/xrGVyF58D В примере также реализовал "движение" записи вверх-вниз. Действительно совет Haz: далее нужно всего лишь применить новую редакцию ::gotorec() с указанием нужной строки очень помог. Я еще мало что могу в использовании MiniGui и TsBrowse в частности. А есть задача, в которой желательно реализовать следующее. Во-первых, реализовать отметку нескольких записей по SHIFT/CTRL + клик мышью (как в проводнике, например) и затем перемещение / копирование этих записей после указанной курсором записи, т.е. "привычный" copy/past. Во-вторых, хотелось бы, чтобы перемещенная запись меняла цвет шрифта или фона, например, как в Total Commander. Это только на момент работы с БД. После выхода из TsBrowse сохранять цвет измененных записей не надо.
Haz: TimTim пишет: Во-первых, реализовать отметку нескольких записей по SHIFT/CTRL + клик мышью (как в проводнике, например) Реализовать отметку можно добавив в бровс объект массив с номерами отмеченных записей. Сделать это можно так [pre2] __objAddData( oBrw, 'aRecordds' ) oBrw:aRecords := {} [/pre2] Далее по bLClick добавлять в этот массив номера записей, проверяя предварительно нажата ли CTRL или SHIFT. С SHIFT придется повозится на предмет получения не одного а списка номеров записей TimTim пишет: затем перемещение / копирование этих записей после указанной курсором записи, т.е. "привычный" copy/past. можно через контекстное меню с пересчетом ключа индекса для копируемых (перемещаемых) записей TimTim пишет: хотелось бы, чтобы перемещенная запись меняла цвет шрифта или фона, в условии oBrw:SetColor() проверять есть ли запись в массиве помеченных. См. пример TSB_CALENDAR как там сделана отметка и покраска . Правда там отметка относится к ячейке, но логика одинакова
TimTim: Спасибо за ответ. Пример с календарем посмотрю. А чем и как ловить нажатие клавиш CTRL и / или SHIFT?
Haz: TimTim пишет: А чем и как ловить нажатие клавиш CTRL и / или SHIFT? KBDSTAT() Bit Key ------------------------------------------------------------------------ 1 Right shift currently pressed 2 Left shift currently pressed 3 Ctrl currently pressed (left or right) 4 Alt currently pressed (Alt or Shift-Alt) 5 Scroll-Lock ON/OFF 6 Num-Lock ON/OFF 7 Caps-Lock ON/OFF 8 Insert ON/OFF IF ISBIT(KBDSTAT(), 3) MsgDebug("CTRL pressed") END
SergKis: Haz Что то new :GotoRec(...) как то не так срабатывает. Пример https://my-files.ru/4e57lz Работа кнопок Up, Down и перепоказ после них 1. New вариант :GotoRec положил в функцию myGotoRec 2. Old вариант oBrw:GotoRec(...) 3. галочки переключают на функцию и доп параметр nRowPos На родном (old) варианте отрабатывает ок, по показ с 1-ой строки На new варианте ломается показ, нажмем Home показ восстановится Или я что то потерял ?
SergKis: PS чуть перепутал, но это не влияет на результат[pre2] If lPos MyGotoRec(oBrw, nRec, nRow) Else MyGotoRec(oBrw, nRec) EndIf [/pre2]
Haz: SergKis пишет: new варианте ломается показ, Завтра посмотрю
Haz: SergKis пишет: Что то new :GotoRec(...) как то не так срабатывает. Сергей, вроде со скипами там косяк был [pre2] FUNC myGotoRec( oBrw, nRec, nRowPos ) LOCAL cAlias LOCAL nSkip := 0 LOCAL lMore := .T. LOCAL lSkip := .F. LOCAL lRet := .F. LOCAL lReCount := .F. with object oBrw If :lIsDbf lRet := .T. cAlias := :cAlias :nLastPos := (cAlias)->( RecNo() ) hb_default( @nRowPos, :nRowPos ) (cAlias)->( dbGoto(nRec) ) DO WHILE (cAlias)->( !EOF() ) .and. nSkip < ( :nRowCount() - nRowPos ) (cAlias)->( dbSkip(1) ) nSkip ++ ENDDO If (cAlias)->( EOF() ) lReCount := .T. nRowPos := :nRowCount() - nSkip + 1 EndIf (cAlias)->( dbGoto(nRec) ) nSkip := 0 :nRowPos := 1 DO WHILE lMore (cAlias)->( dbSkip(-1) ) nSkip ++ lMore := !(cAlias)->(BOF()) .and. nSkip < (nRowPos) // lSkip := !(cAlias)->(BOF()) ENDDO // :Refresh(lReCount, lReCount) //If lSkip :Skip( nSkip -1 ) //EndIf :Refresh(lReCount, lReCount) :nRowPos := nSkip :nAt := :nLogicPos() :Refresh(lReCount, lReCount) :ResetVscroll() If :bChange != Nil Eval( :bChange, Self, 0 ) EndIf :lHitTop := :lHitBottom := .F. DO EVENTS EndIf end with RETURN lRet [/pre2] твой пример погонял - все норм
SergKis: Haz пишет твой пример погонял - все норм Игорь добавь до 21 строки в таблице (в районе 7 к примеру) и жмем End С записью Line 15 проделываем Up, Down во всех режимах С new вариантом перескок отображения на Line 13, что не совсем правильно
Haz: SergKis пишет: добавь до 21 строки в таблице (в районе 7 к примеру) и жмем End Да, все увидел. Пару дней возьму на правку и тестирование.
Andrey: Всем привет. Сделал у себя выгрузку базы через SetArrayTo() и обломался. Оказывается таблица больше 41 колонок НЕ ДЕЛАЕТСЯ. А у меня в базе 120 колонок, есть и ещё чуть больше. Этот параметр наверное как то задан по умолчанию ? Увеличить можно сейчас ? Раньше компы были слабее, а сейчас на порядок быстрее.
SergKis: Andrey пишет Оказывается таблица больше 41 колонок НЕ ДЕЛАЕТСЯ. Странное утверждение. Tsb_array_2\demo.prg меняем слегка[pre2] STATIC FUNCTION CreateDatos() LOCAL a, i, k := 1000, aDatos, aHead, aSize, aFoot, aPict, aAlign, aName aDatos := Array( k ) FOR i := 1 TO k aDatos[ i ] := { " ", ; // 1 i, ; // 2 ntoc( i ) + "_123", ; // 3 Date() + i, ; // 4 PadR( "Test line - " + ntoc( i ), 20 ), ; // 5 Round( ( 10000 -i ) * i / 3, 2 ), ; // 6 100.00 * i, ; // 7 0.12, ; // 8 Round( 100.00 * i * 0.12, 2 ), ; // 9 Round( 1234567.00 / i, 3 ), ; // 10 PadR( "Line " + StrZero( i, 5 ), 20 ), ; // 11 Date(), ; // 12 Time(), ; // 13 i % 2 == 0 } // 14 a := AClone(aDatos[ i ]) AEval(a, {|xv| AAdd(aDatos[ i ], xv) }) AEval(a, {|xv| AAdd(aDatos[ i ], xv) }) AEval(a, {|xv| AAdd(aDatos[ i ], xv) }) AEval(a, {|xv| AAdd(aDatos[ i ], xv) }) AEval(a, {|xv| AAdd(aDatos[ i ], xv) }) AEval(a, {|xv| AAdd(aDatos[ i ], xv) }) AEval(a, {|xv| AAdd(aDatos[ i ], xv) }) AEval(a, {|xv| AAdd(aDatos[ i ], xv) }) NEXT ... [/pre2] 126 колонок есть
Haz: SergKis пишет: Странное утверждение Да, тоже не понял как клеятся слова выгрузка и setarrayto. Куда выгрузка, где эти колонки? У меня Tsbrowse был с 1000 колонок
Andrey: Haz пишет: У меня Tsbrowse был с 1000 колонок У меня почему то 41 колонка и всё, больше не идёт. SergKis пишет: 126 колонок есть У меня почему то режет в 3-х местах только на 41 колонку. Буду смотреть у себя, раз нет ограничений.
Andrey: Понял почему это происходит. Так как у меня выгружается иногда и по 40-50 тыс.записей, я сделал для того чтобы юзер не смотрел и не видел пустой экран, создание формы и показ таблицы из одной записи на 41 колонку. Потом я в ON INIT передаю новый массив. А далее делаю: [pre2] oBrw8:DeleteRow( .T. ) // Delete All oBrw8:aArray:={} // очистить массив aArray := aDim // переопределяем на новый входящий массив For nI := 1 TO Len(aArray) if ! empty(aArray[ nI ]) ADD ITEM aArray[ nI ] TO &cBrw OF &cForm EndIf Next[/pre2] Из-за этого у меня и режется до 41 колонки.
Andrey: Непонятка возникает при обновлении массива. Показываю прелодер, а он при создании таблицы не показывает лепестки - белый экран и всё. Делаю так: [pre2] // создаём окно ожидания с потоком WaitThreadCreate( 'Расчёт по отчёту ...' ) // как в SAMPLES\BASIC\WAIT_WINDOW_2\demo2.prg SetProperty(oBrw8:cParentWnd, oBrw8:cControlName, "Enabled", .F.) oBrw8:DeleteRow( .T. ) // Delete All oBrw8:aArray:={} // очистить массив aArray := aDim // переопределяем на новый входящий массив For nI := 1 TO Len(aArray) if ! empty(aArray[ nI ]) ADD ITEM aArray[ nI ] TO &cBrw OF &cForm // вариант 1 EndIf IF nI % 500 DO EVENTS // чтобы показывать прелодер из WaitThreadCreate() ENDIF Next[/pre2] Если поместить DO EVENTS то таблица на экране вся показывается и мелькает, потом подвисает ещё иногда. Если убрать DO EVENTS то таблицы на экране нет (что хорошо), но прелодер не работает, белый экран на нём, без лепестков и время сбоку в секундах стоит, отображает 00:00:00. Как можно заставить прелодер отображаться ?
Haz: Andrey пишет: таблица на экране вся показывается и мелькает, Зачем? Зачем в ts добавлять по одному элементу? Формируй массив данных любуюсь на свой прелодер. А потом добавляй целиком. Хоть через SetArray(To) или прямым присвоением в oBrw:aArray с последующей синхронизации бровса ( тоже все уже разжевано на форуме) . Даже был пример как не массив а dbf подменить на лету.
Andrey: Haz пишет: А потом добавляй целиком. Переделал это добавление. Действительно быстрее намного получилось. Только прелодер все равно белый, без лепестков. На 1-2 секунды появляется всего, потом уже Tsbrowse показывается.
Haz: Andrey пишет: Только прелодер все равно белый, без лепестков Ты же сам в прошлом посте писал как это лечится
Dima: Haz пишет: Ты же сам в прошлом посте писал как это лечится Он забыл типа
Andrey: Всем привет ! Вопрос не могу решить, помогите пожалуйста. Таблица небольшая, на экран помещается, даже остаётся много пустого места. Добавляю туда ещё запись и не могу - показать на экране всю таблицу целикоми чтобы маркер был на добавленной записи. Причём есть индекс по полю, из-за него последняя запись в таблице не становиться последней, а чуток ранее. Делаю так:[pre2] oBrw:Reset() oBrw:Refresh(.T.) ItogoNN(oBrw) oBrw:SetOrder(2, , .F. ) // сортировка по столбцу 2 .... // мои вычисления позиции nRow в таблице oBrw:GoPos(nRow,5) // уст. МАРКЕР на ХХ строку и ХХ колонку oBrw:GotoRec( nRow, nRow-1 ) // ??? уст. МАРКЕР на ХХ строку и показать таблицу с 1-ой позиции строк oBrw:SetFocus() DO EVENTS[/pre2]
Haz: Andrey пишет: oBrw:GotoRec( nRow, nRow-1 ) GotoRec первым параметром принимает номер записи а не номер строки
Andrey: Haz пишет: GotoRec первым параметром принимает номер записи а не номер строки В данном случае у меня в таблице номер записи равен номеру строки, т.е. у меня таблица через SetArrayTo()
SergKis: Andrey пишет В данном случае у меня в таблице номер записи равен номеру строки, т.е. у меня таблица через SetArrayTo() [pre2]METHOD GotoRec( nRec, nRowPos ) CLASS TSBrowse LOCAL cAlias LOCAL nSkip LOCAL n LOCAL nRecSave LOCAL lRet := .F. LOCAL lReCount := .F. IF ::lIsDbf ... [/pre2]
Haz: Andrey пишет: последняя запись в таблице не становиться последней, а чуток ранее. Andrey пишет: oBrw:GotoRec( nRow, nRow-1 ) Не вдаваясь что такое setarrayto Если номер записи равен номеру строки и надо попасть на последнюю Объяснни. что значит nRow - 1
Dima: Haz пишет: Объяснни. что значит nRow - 1 Да он не помнит уже...склероз ))
Andrey: Haz пишет: Объяснни. что значит nRow - 1 Пробовал по разному, сначала было oBrw:GotoRec( nRow, nRow ), всё равно таблица 1 позицию выдает с 9 строки таблицы. Потом сделал так oBrw:GotoRec( nRow, nRow -1 ) - без разницы. Методом научного тыка сегодня сделал. Нужно так оказывается: [pre2] oBrw:Reset() oBrw:Refresh(.T.) ItogoNN(oBrw) oBrw:SetOrder(2, , .F. ) // сортировка по столбцу 2 .... // мои вычисления позиции nRow в таблице Eval( oBrw:bGoTop ) // переход на начало таблицы oBrw:GoPos(nRow,5) // уст. МАРКЕР на ХХ строку и ХХ колонку oBrw:GotoRec( nRow, nRow-1 ) // ??? уст. МАРКЕР на ХХ строку и показать таблицу с 1-ой позиции строк oBrw:SetFocus() DO EVENTS[/pre2] Спасибо вам за этот отличный метод !!!
SergKis: Andrey пишет у меня таблица через SetArrayTo() Это означает таблица в массиве тсб, в таком случае :GotoRec(...) полностью игнорирует свои внутренности, т.е. НЕ РАБОТАЕТ, т.к. значение :lIsDbf = .F.
Haz: SergKis пишет: т.е. НЕ РАБОТАЕТ, т.к. значение :lIsDbf = .F. Пришёл Сергей и сдал военную тайну от том что goto на recno это только для dbf Надо было терпеть до последнего
Andrey: Haz пишет: Пришёл Сергей и сдал военную тайну от том что goto на recno это только для dbf Ну хоть что то стало понятней !
SergKis: Haz пишет Надо было терпеть до последнего Игорь, тянуть нельзя было, Андрей до сих пор верит в Деда Мороза, что загружает SetArrayTo(), а не TsBrowse. Что дальше было бы ? Теперь можно быть спокойным, Андрей пишет Ну хоть что то стало понятней !
Andrey: Всем привет ! Заметил такую странность у себя в проектах использующие Tsbrowse/ Для Суперхидера цвет текста не работает ! Вот хотя бы для примера Tsb_Export, там цвет указан желтый, а всегда показывает черный. [pre2] :SetColor( {17}, { { || CLR_YELLOW } } ) // 17, текста спецхидер[/pre2] Пробовал и так, как и для шапки и подвала таблицы: [pre2] :SetColor( {17}, { CLR_YELLOW } ) // 17, текста спецхидер[/pre2] Почему ? Какой правильный синтаксис ?
gfilatov2002: Andrey пишет: Для Суперхидера цвет текста не работает Эта ошибка будет исправлена в следующей сборке
krutoff: Может не в той теме пишу, но продублирую. Попробовал XLSXML - отлично! Но заказчик захотел поле Number 16 знаков для номера банк.карты и вывод успешно загнулся. Я доковырял до модуля xlsxml_s.prg строка 123: ::writeData( "Number", row, column, AllTrim( Str( xData, 18, 6 ) ), style ) Получается, если разрядность больше - идут звезды при выводе. Не знаю, кто поддерживает этот модуль, - поправьте, плз. Андрей - Tsb_Export - отличный пример! В Tsb2xml.prg -> FUNCTION XmlSetDefault: вместо oCol:XML_FootFont идет 2 раза присваивание oCol:XML_HdrFont -поправьте, плз.
Haz: krutoff пишет: о заказчик захотел поле Number 16 знаков для номера банк.карты и вывод успешно загнулся. выводи как строку например вместо этого oObj:writeNumber( nRow, 13, 1234567890123456789, "numberRight" ) выводи так oObj:writeString( nRow, 13, ntoc(1234567890123456789), "numberRight" )
Andrey: Всем привет ! Как боротся с отгрызанными стрелками ? Если делаю oBrw:Hide() или просто сохраняю/перечитываю цвета у бровса, то выходит так: Только после того как мышкой встаю на линию скролинга, то тогда появляются стрелки. Юзер будет просто в шоке.... Как с этим бороться ?
SergKis: Andrey пишет Как с этим бороться ? Попробуй добавить последними командами [pre2] obrw:ResetVScroll( .T. ) obrw:oVScroll:SetRange( 0, 0 ) obrw:oHScroll:SetRange( 0, 0 ) obrw:Refresh() If ! obrw:lNoHScroll .and. obrw:oHScroll != Nil obrw:oHScroll:SetPos( obrw:nCell ) EndIf obrw:ResetVScroll( .T. ) obrw:oHScroll:SetRange( 0, 0 ) [/pre2]
Andrey: Всем привет ! Вот нашёл небольшой глюк:
Andrey: SergKis пишет: oBrw:Enabled( lEnable ) - с закраской тсб А как свою закраску установить ? Хочется черный фон и серые буквы. Можно сделать как то так - oBrw:Enabled( .F. , {BLACK,SILVER} ) ?
SergKis: Andrey Посмотри исходник :Enabled(), думаю, увидишь Можешь найти тему "Новая версия ...", посвященную :Enabled()
Andrey: Хотелось бы простого написания, как то так - oBrw:Enabled( .F. , {BLACK,SILVER} ) А так придётся писать отдельную внешнюю функцию. Не совсем удобно... И в METHOD Enabled() нет сохранения [pre2]oBrw:nClrLine := ??? // цвет линий между ячейками таблицы[/pre2]
SergKis: Andrey Ты, точно, посмотрел исходник и пост в теме ? Григорий делал переменные объекта, для уст. цветов закраски.
Andrey: SergKis пишет: Ты, точно, посмотрел исходник и пост в теме ? Да вроде да ! По теме нашёл gfilatov2002 пишет: Для этого я добавил в класс DATA nClr_Gray AS NUMERIC INIT CLR_GRAY DATA nClr_HGray AS NUMERIC INIT CLR_HGRAY А как это использовать - не понимаю. У себя сделал тест: [pre2] oBrw:Enabled( .F. ) // блокировка таблицы с закраской nClrLine := TsbColorRepl(oBrw, BLACK, SILVER) MsgDebug(...) oBrw:nClrLine := nClrLine // восстановить цвет линий между ячейками таблицы oBrw:Enabled( .T. ) // разблокировка таблицы с закраской .... /////////////////////////////////////////////////////////////////// // заменить текущий цвет TBROWSE FUNCTION TsbColorRepl(oBrw, aBackColor, aFontColor) LOCAL nJ, nBackColor, nFontColor, nSaveColor nFontColor := ToRGB( aFontColor ) nBackColor := ToRGB( aBackColor ) // ------ изменить цвета Tsbrowse ------------ FOR nJ := 1 to LEN(oBrw:aColumns) // меняем цвет по всем колонкам oBrw:SetColor( { 1}, { { || nFontColor } } ) // 1 , текста в ячейках таблицы oBrw:SetColor( { 2}, { { || nBackColor } } ) // 2 , фона в ячейках таблицы oBrw:Setcolor( { 3}, { nFontColor } ) // 3 , текста шапки таблицы oBrw:SetColor( { 4}, { { || nBackColor } } ) // 4 , фона шапка таблицы oBrw:SetColor( { 9}, { nFontColor } ) // 9 , текста подвала таблицы oBrw:SetColor( {10}, { { || nBackColor } } ) // 10, фона подвала таблицы //oBrw:SetColor( {15}, { { || CLR_WHITE } } ) // 15, линий между ячейками таблицы NEXT nSaveColor := oBrw:nClrLine // сохранить цвет линий между ячейками таблицы oBrw:nClrLine := nFontColor // новый цвет линий между ячейками таблицы // цвет фона под таблицей oBrw:hBrush := CreateSolidBrush( aBackColor[1], aBackColor[2], aBackColor[3] ) RETURN nSaveColor[/pre2] Так заработала, только вверху шапки и внизу подвала за границей таблицы НЕ КРАСЯТСЯ ячейки.
SergKis: Andrey пишет А как это использовать - не понимаю. Внимательно, медленно просмотри метод :Enabled() Найди переменные, сравни со своим текстом ...
Andrey: Всем привет ! Всех поздравляю с праздниками ! Вопрос возник. Делаю у себя в проге на главной таблице: [pre2] oBrw:Enabled( .F. ) // блокировка таблицы с закраской[/pre2] Таблица становиться серой и на первом же поле вывода прога сваливается: Error BASE/1003 Переменная не существует: MARK // это первое поле в таблице Called from (b)LISTFIELDTABLE(847) in module: Tbrw_table.prg Called from TSBROWSE:BDATAEVAL(1584) in module: h_tbrowse.prg Called from TSBROWSE:DRAWSELECT(3797) in module: h_tbrowse.prg Called from TSBROWSE:PAINT(9779) in module: h_tbrowse.prg Called from TCONTROL:HANDLEEVENT(878) in module: TControl.prg Called from TSBROWSE:HANDLEEVENT(8328) in module: h_tbrowse.prg Called from EVENTS(95) in module: h_events.prg Called from DOEVENTS(0) Called from CREATEBROWSEPRINTF5(441) in module: form_f5print.prg Called from FORM_F5PRINT(221) in module: form_f5print.prg Called from FORMPRINTF5(105) in module: form_f5print.prg Called from (b)BUTTON_UPMENUTABLE(2152) in module: Tbrw_table.prg Вот код:[pre2] Дата_2 = '{|| (Alias())->MARK }' // это текстовый ини-файл For nI := 1 To Len(aTable) cHeadName := aTable[nI,1 ] // 1 Шапка_ cDateBlock := aTable[nI,2 ] // 2 Дата_ ...... // ------ преобразовать на знаки ------ cHeadName := STRTRAN(cHeadName,";", CRLF ) cDateBlock := STRTRAN(cDateBlock,'CRLF', '"' + CRLF + '"' ) xVal := Eval( &( cDateBlock ) ) aAligh := &(cAlighColum) // выравнивание: cells, header, footer ADD COLUMN TO TBROWSE oBrw // добавить новую колонку в TBROWSE oBrw:aColumns[nI]:cHeading := cHeadName // заголовок колонки oBrw:aColumns[nI]:bData := &( cDateBlock ) // поля в колонке 847 строка oBrw:aColumns[nI]:nAlign := aAligh[1] // выравнивание: cells[/pre2] Что я не так делаю ?
SergKis: Andrey пишет Что я не так делаю ? Для таких действий в объект колонки внесена переменная\свойство cAlias, т.е. oCol:bData := MacroBlock('MARK') oCol:cAlias := 'MY1' если алиас совпадает с алиасом тсб, то oCol:cAlias := oBrw:cAlias или обычный вариант oCol:bData := FieldWBlock('MARK', Select(Alias()))
SergKis: PS Расшифровка cDataBlock := '{|| MARK }' bVal := &( cDataBlock ) xVal := Eval( bVal ) ? cDataBlock, xVal, bVal oCol:bData := bVal If ! '->' $ cDataBlock oCol:cAlias := oBrw:cAlias EndIf
Andrey: SergKis - СПАСИБО !
Haz: Вопрос поднял Сергей, я немного перефразирую и спрошу тут С какой целью в METHOD TSBrowse:Edit() в CheckBox игнорируется VK_RETURN ? Кроме как защита от дурака , когда пользователь тыкает бездумно по кнопкам и не смотрит что происходит у меня другого объяснения нет. Ведь до кнопки VK_SPACE нужно типа "осмысленно" дотянуться. Только мне кажется что если бездумно , то все равно куда тянуться, до 1, 0, Y, N, S, ENTER, SPACE но только ENTER в этом случае игнорируется. В итоге пользователь до изнеможения долбит ENTER , забывая про SPACE и устав кликает мышью. Может восстановим VK_RETURN в правах ? для совместимости можно с флагом типа ::lCheckBoxIgnoreReturn по умолчанию TRUE , а можно и без тогда [pre2] If nKey != VK_RETURN .OR. # ::lCheckBoxIgnoreReturn If Upper( Chr( nKey ) ) $ "YCST1" ::lChanged := uVar == .F. uVar := .T. ElseIf Upper( Chr( nKey ) ) $ "FN0" ::lChanged := uVar == .T. uVar := .F. ElseIf nKey == VK_SPACE uVar := ! uValue ::lChanged := .T. Else Return 0 EndIf ::lHasChanged := If( ::lChanged, .T., ::lHasChanged ) ::oWnd:nLastKey := VK_RETURN ::PostEdit( uVar, nCell ) ::lPostEdit := .F. Return 0 Else ::lPostEdit := .T. ::lChanged := .F. ::oWnd:nLastKey := nKey ::PostEdit( uValue, nCell ) ::lPostEdit := .F. Return 0 EndIf [/pre2]
Andrey: Haz пишет: тогда в своей программе при определении бровса достаточно указать oBrw:bEditLog := { |a,b,c| WriteEditLog( a, b, c:cAlias ) } Поставил у себя такую замечательную эту штуку в тестовый пример ! Отличное решение, юзера будут просто в восторге. Я ещё сделал поиск по номеру записи - вообще все претензии что программа сама удалила и исправила - пропадут ! Правда не по всем полям происходит запись. Нужно разбираться. Спасибо БОЛЬШОЕ Haz !
Haz: Andrey пишет: Правда не по всем полям происходит запись. Нужно разбираться. Рад что пригодилось. Запись не идет по тем полям где используется bPrevEdit с последующим отказом от редвктирования., но с изменением значения. Тут нужно самому позаботиться, т. к. метод Edit не вызывается. В целом использую подобный функционал несколько лет. Мотивирует пользователя лучше чем пинок, особенно когда все видят героя.
Haz: Haz пишет: В целом использую подобный функционал несколько лет. Добавлю, что из объекта tsBrosе который передается блоку третьим параметром, легко достать номер колонки и соответственно имя Поля, которое изменили. Никак не доходят руки до контрольного примера запятая будет посвободнее обязательно что-нибудь простое напишу
Andrey: Да мне Сергей посоветовал так сделать: [pre2] // запись в лог-файл всех изменений полей БД oBrw1:bEditLog := { |xo,xn,ob| WriteEditLog( xo, xn, ob ) } [/pre2] Вот мой код записи [pre2] ///////////////////////////////////////////////////////////////////// // запись в лог-файл всех изменений полей БД FUNCTION WriteEditLog( xOld, xNew, oBrw ) LOCAL cFileLog := ChangeFileExt( Application.ExeName, ".log" ) LOCAL nCol, cHead, cStr, CRZ := "; " nCol := oBrw:nCell - 1 // номер колонки в таблице cHead := oBrw:aColumns[ nCol ]:cHeading // имя шапки колонки IF LEN(ALLTRIM(cHead)) == 0 cHead := HB_NtoS(nCol) ENDIF cStr := DToC( Date() ) + CRZ + Time() + CRZ cStr += NetName()+"/"+hb_UserName()+"/User-"+HB_NtoS(M->nPubUser) + CRZ // Кто изменил данные cStr += oBrw:cAlias + CRZ + "ID=" + HB_NtoS( (oBrw:cAlias)->ID ) + CRZ cStr += "Запись: " + HB_NtoS( (oBrw:cAlias)->(RecNo()) ) + CRZ cStr += "Колонка: " + cHead + CRZ IF VALTYPE(xOld) == "C" cStr += "замена: [" + ALLTRIM(xOld) + "] на: [" + ALLTRIM(xNew) + "]" + CRZ ELSE cStr += "замена: [" + cValToChar(xOld) + "] на: [" + cValToChar(xNew) + "]" + CRZ ENDIF cStr += CRLF STRFILE(cStr, cFileLog, .T.) RETURN NIL[/pre2] Только мне пришлось делать nCol := oBrw:nCell - 1
Haz: Andrey пишет: Только мне пришлось делать nCol := oBrw:nCell - 1 Возможно используешь :Selector по этому нумерация едет. Попробуй выдернуть имя поля через oCol:cName Продолжу тут. Я лог веду в dbf, с указанием имени поля и тайм штампа времени изменения. Это позволяет вне завистмости в каком бровсе поменяли значение, всегда правильно показывать хронологию. Показ реализован прямо в бровсе по правой кнопке. Имя колонки в логе меня не особо интересует, т. к. показываю лог именно в ней.
SergKis: Haz пишет Имя колонки в логе меня не особо интересует, т. к. показываю лог именно в ней Посмотрел на примере, oBrw:nCell и nCol в METHOD PostEdit, разные. Добавил в вызов nCol [pre2] METHOD PostEdit( uTemp, nCol, bValid ) CLASS TSBrowse ... xNewEditValue := ::bDataEval( ::aColumns[ nCol ], , nCol ) //Igor Nazarov If hb_isBlock( ::bEditLog ) .and. ::aColumns[ nCol ]:xOldEditValue != xNewEditValue Eval( ::bEditLog, ::aColumns[ nCol ]:xOldEditValue, xNewEditValue, Self, nCol ) EndIf Return Nil В задаче oBrw1:bEditLog := { |xo,xn,ob,nc| WriteEditLog( xo, xn, ob, nc ) } ... FUNCTION WriteEditLog( xOld, xNew, oBrw, nCell ) LOCAL cFileLog := ChangeFileExt( Application.ExeName, ".log" ) LOCAL nCol, cHead, cStr, CRZ := "; ", oCol, cAls, cName, oC WITH OBJECT oBrw DEFAULT nCell := :nCell oC := :aColumns [ nCell ] oCol := :GetColumn( nCell ) // - iif( :lSelector, 1, 0 ) ) cName := oCol:cName nCol := :nColumn( cName ) cAls := iif( Empty(oCol:cAlias), :cAlias, oCol:cAlias ) cHead := oCol:cHeading END WITH ? cAls , oBrw:lSelector, oBrw:nCell ? nCell, oC:cName, oC:cHeading ? nCol , cName , cHead ... получил в _MsgLog.txt MAIN .F. 8 7 FTEXT Text 7 FTEXT Text правилась колонка 7 FTEXT [/pre2] Думаю надо добавить в вызов номер колонки редактирования в вызов :bEditLog для начала
SergKis: Причина другого значения :nCell понятна, уже выполнены команды [pre2] If nLastKey == VK_UP .and. ::lPostEditGo ::GoUp() ElseIf nLastkey == VK_RIGHT .and. ::lPostEditGo ::GoRight() ElseIf nLastkey == VK_LEFT .and. ::lPostEditGo ::GoLeft() ElseIf nLastkey == VK_DOWN .and. ::lPostEditGo ::GoDown() ::Refresh( .F. ) ElseIf ::aColumns[ nCol ]:nEditMove >= 1 .and. ::aColumns[ nCol ]:nEditMove <= 5 // excel-like behaviour post-edit movement Eval( aMoveCell[ ::aColumns[ nCol ]:nEditMove ] ) ElseIf ::aColumns[ nCol ]:nEditMove == 0 ::DrawSelect() EndIf [/pre2] т.е. подготовлена работа со след. колонкой
SergKis: Можно сделать так [pre2] If hb_isBlock( ::bEditLog ) .and. ::aColumns[ nCol ]:xOldEditValue != xNewEditValue uTemp := ::nCell ::nCell := nCol Eval( ::bEditLog, ::aColumns[ nCol ]:xOldEditValue, xNewEditValue, Self ) ::nCell := uTemp EndIf [/pre2]
Haz: SergKis пишет: т.е. подготовлена работа со след. колонкой Может обработку bEditLog поднять перед этой подготовкой? Посмотрю с работы, с телефона не реально.
полная версия страницы