Автор | Сообщение |
gfilatov
|
| модератор
|
Пост N: 699
Зарегистрирован: 25.05.05
|
|
Отправлено: 29.01.08 13:59. Заголовок: Новая версия Расширенного релиза библиотеки MiniGUI (часть VI ) (продолжение)
Начало темы находится здесь, а теперь АНОНС * АНОНС * АНОНС * АНОНС * АНОНС Готовится к опубликованию новая сборка №48, которая выйдет в конце недели. Если у Вас есть интересные наработки для включения в новый релиз, то сейчас самое удобное время для их отправки мне Кратко, что нового: - исправление обнаруженных ошибок и неточностей кода; - новый класс HEADERIMAGE для Grid и Browse; - свойство Address в Hyperlink может теперь открывать папку или файл на диске; - добавлен NOTABSTOP класс для Browse; - поддержка пользовательских компонентов (заимствована из оффициального релиза); - расширения и исправления в библиотеках TsBrowse и PropGrid; - обновлены сборки Харбор и HMGS-IDE; - новые и обновленные старые примеры (как обычно ).
| |
|
Ответов - 300
, стр:
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
All
[только новые]
|
|
SergKis
|
| постоянный участник
|
Пост N: 2110
Зарегистрирован: 17.02.12
|
|
Отправлено: 26.10.18 12:00. Заголовок: Haz пишет У меня все..
Haz пишет У меня аналогично. Возможно имеется ввиду при Up на последней строке и последнем :nRowPos, строка swap сделала, но осталась последней, а др. ушла за экран, так именно это я имел ввиду под шероховатостью. Надо усиливать алгоритм, если надо, конечно. Оставляю это на тех, кому надо.
| |
|
TimTim
|
| |
Пост N: 155
Зарегистрирован: 10.07.07
|
|
Отправлено: 26.10.18 12:03. Заголовок: Я пересобирал прогу...
Я пересобирал прогу. Может в этом дело?
| |
|
Haz
|
| |
Пост N: 1377
Зарегистрирован: 20.02.11
|
|
Отправлено: 26.10.18 12:17. Заголовок: TimTim пишет: Я пер..
TimTim пишет: цитата: | Я пересобирал прогу. Может в этом дело? |
| Может и в этом т.к. метод GoToRec() не обновлен в tsBrowse.lib При желании пересобрать обновить метод можно самостоятельно и пересобрать библиотеку
| |
|
SergKis
|
| постоянный участник
|
Пост N: 2114
Зарегистрирован: 17.02.12
|
|
Отправлено: 28.10.18 22:02. Заголовок: gfilatov2002 пишет ..
gfilatov2002 пишет цитата: | * Updated: Adaptation FiveWin Class TSBrowse 9.0 in HMG: - added the new method FilterData( cFilter, lFocus ) in the TSBrowse |
| немного надо изменить METHOD FilterRow( cFilter, lBottom, lFocus ) CLASS TSBrowse ... ::Reset(lBottom) ... или METHOD FilterRow( cFilter, lFocus, lBottom ) CLASS TSBrowse ... ::Reset(lBottom) ... второй вариант по частоте исп. lBottom (default .F.) первый по логике что лучше ? не знаю.
| |
|
gfilatov2002
|
| moderator
|
Пост N: 1385
Зарегистрирован: 11.02.10
|
|
Отправлено: 28.10.18 22:17. Заголовок: SergKis пишет: METH..
SergKis пишет: цитата: | METHOD FilterRow( cFilter, lBottom, lFocus ) |
| Принят первый вариант
| |
|
SergKis
|
| постоянный участник
|
Пост N: 2115
Зарегистрирован: 17.02.12
|
|
Отправлено: 29.10.18 08:31. Заголовок: gfilatov2002 Похожа..
gfilatov2002 Похожая правка METHOD FilterFTS( cFind, lUpper, lBottom, lFocus ) CLASS TSBrowse ... ::Reset(lBottom) ...
| |
|
gfilatov2002
|
| moderator
|
Пост N: 1386
Зарегистрирован: 11.02.10
|
|
Отправлено: 29.10.18 10:06. Заголовок: SergKis пишет: Похо..
SergKis пишет: OK
| |
|
Haz
|
| |
Пост N: 1383
Зарегистрирован: 20.02.11
|
|
Отправлено: 29.10.18 11:31. Заголовок: gfilatov2002 Григо..
gfilatov2002 Григорий в ::GotoRec() можно это добавить If ::lIsDbf if hb_isBlock( nRec ) nRec := eval( nRec ) end if hb_isBlock( nRowPos ) nRowPos := eval( nRowPos ) end это позволит реализовать вычисляемые от условий координаты ( к примеру на последней странице nRowPos ровнять на nRowCount(), или nRec вычислять в dbLocate() )
| |
|
SergKis
|
| постоянный участник
|
Пост N: 2116
Зарегистрирован: 17.02.12
|
|
Отправлено: 29.10.18 11:54. Заголовок: Haz пишет в ::GotoRe..
Haz пишет цитата: | в ::GotoRec() можно это добавить |
| только Eval с параметром nRec := eval( nRec , Self ) nRowPos := eval( nRowPos , Self )
| |
|
gfilatov2002
|
| moderator
|
Пост N: 1387
Зарегистрирован: 11.02.10
|
|
Отправлено: 29.10.18 12:08. Заголовок: Haz пишет: в ::Goto..
Haz пишет: цитата: | в ::GotoRec() можно это добавить |
| OK SergKis пишет: OK
| |
|
SergKis
|
| постоянный участник
|
Пост N: 2117
Зарегистрирован: 17.02.12
|
|
Отправлено: 29.10.18 12:27. Заголовок: gfilatov2002 У нас ..
gfilatov2002 У нас с Игорем еще предложение по методам Скрытый текст
METHOD SeekRec( xVal, lSoftSeek , lFindLast, nRowPos ) CLASS TSBrowse LOCAL cAlias, nRecOld, lRet := .F. DEFAULT lSoftSeek := .T., lFindLast := .T., nRowPos := ::nRowPos cAlias := ::cAlias nRecOld := (cAlias)->( Recno() ) IF (cAlias)->( dbSeek( xVal, lSoftSeek, lFindLast ) ) ::GoToRec((cAlias)->( RecNo() ), nRowPos ) lRet := .T. ELSE (cAlias)->( dbGoto(nRecOld) ) ENDIF RETURN lRet METHOD FindRec( Block, lNext, nRowPos ) CLASS TSBrowse LOCAL i, n := 0 LOCAL cAlias, nRecOld LOCAL lArr := HB_ISARRAY(Block) LOCAL lRet := .F. DEFAULT lNext := .F., nRowPos := ::nRowPos cAlias := ::cAlias nRecOld := (cAlias)->( Recno() ) IF lNext (cAlias)->( dbSkip(1) ) ELSE (cAlias)->( dbGotop() ) ENDIF DO WHILE (cAlias)->( !EOF() ) n ++ IF lArr FOR i := 1 TO Len(Block) lRet := !Empty(EVal( Block[ i ], Self, i )) IF lRet EXIT ENDIF NEXT ELSE lRet := !Empty(EVal( Block, Self, 0 )) ENDIF IF lRet EXIT ENDIF DO EVENTS (cAlias)->( dbSkip(1) ) ENDDO IF lRet ::GoToRec(( cAlias)->( RecNo() ), nRowPos ) ELSE (cAlias)->( dbGoto(nRecOld) ) ENDIF RETURN lRet METHOD ScopeRec( xScopeTop, xScopeBottom, lBottom ) CLASS TSBrowse LOCAL cAlias := ::cAlias (cAlias)->( ORDSCOPE(0, xScopeTop ) ) (cAlias)->( ORDSCOPE(1, xScopeBottom) ) ::Reset(lBottom) RETURN Nil
| Проверочный пример https://my-files.ru/hb9tz8
| |
|
|
Andrey
|
| постоянный участник
|
Пост N: 6095
Зарегистрирован: 12.09.06
|
|
Отправлено: 29.10.18 13:08. Заголовок: SergKis пишет: Пров..
SergKis пишет: DEFINE STATUSBAR STATUSITEM "" //STATUSITEM "Network opening of the database!" WIDTH 290 FONTCOLOR BLUE STATUSITEM "Methods: Seek, Find, Scope !" WIDTH 290 FONTCOLOR BLUE Вот так наверное нужно !
| |
|
SergKis
|
| постоянный участник
|
Пост N: 2118
Зарегистрирован: 17.02.12
|
|
Отправлено: 29.10.18 13:15. Заголовок: Andrey пишет Вот так..
Andrey пишет Скорее тут менять (а там все равно shared открытие) FUNCTION UseOpenBase() LOCAL aStr := {} LOCAL cDbf := GetStartUpFolder() + "\TEST5"
| |
|
gfilatov2002
|
| moderator
|
Пост N: 1388
Зарегистрирован: 11.02.10
|
|
Отправлено: 29.10.18 13:44. Заголовок: SergKis пишет: еще ..
SergKis пишет: цитата: | еще предложение по методам |
| Принято с благодарностью
| |
|
Andrey
|
| постоянный участник
|
Пост N: 6096
Зарегистрирован: 12.09.06
|
|
Отправлено: 30.10.18 09:06. Заголовок: SergKis пишет: У на..
SergKis пишет: цитата: | У нас с Игорем еще предложение по методам |
| Ещё бы один метод нужен. Типа ColumnRec(nColumn) - показ нужной колонки в бровсе, для большого количества колонок в таблице. А то юзеру нужную ему колонку невозможно показать сразу, после разных манипуляций. Или он уже есть и я пропустил такой метод ?
| |
|
Haz
|
| |
Пост N: 1384
Зарегистрирован: 20.02.11
|
|
Отправлено: 30.10.18 11:00. Заголовок: Andrey пишет: я про..
| |
|
Andrey
|
| постоянный участник
|
Пост N: 6097
Зарегистрирован: 12.09.06
|
|
Отправлено: 30.10.18 12:10. Заголовок: Haz пишет: ::GoPos(..
Haz пишет: Что-то это не работает... Я раньше у себя это пробовал: oBrw1:nCell := 6 + nStaticNumField // передвинуть МАРКЕР на колонку выбранного фильтра или oBrw1:GoPos( 1,6 + nStaticNumField ) // передвинуть МАРКЕР на XX строку и XX колонку Всё равно таблица остаётся на первых видимых колонках. А те колонки, что за экраном, не показывает !
| |
|
Haz
|
| |
Пост N: 1385
Зарегистрирован: 20.02.11
|
|
Отправлено: 30.10.18 12:29. Заголовок: Andrey пишет: Что-т..
Andrey пишет: цитата: | Что-то это не работает... Я раньше у себя это пробовал: oBrw1:nCell := 6 + nStaticNumField // передвинуть МАРКЕР на колонку выбранного фильтра или oBrw1:GoPos( 1,6 + nStaticNumField ) // передвинуть МАРКЕР на XX строку и XX колонку Всё равно таблица остаётся на первых видимых колонках. А те колонки, что за экраном, не показывает ! |
| Работает ! GoPos() уходит на нужную колонку, хоть за экраном, хоть перед ним. Только что специально проверял
| |
|
Andrey
|
| постоянный участник
|
Пост N: 6098
Зарегистрирован: 12.09.06
|
|
Отправлено: 30.10.18 12:31. Заголовок: Haz пишет: GoPos() ..
Haz пишет: цитата: | GoPos() уходит на нужную колонку, хоть за экраном, хоть перед ним. Только что специально проверял |
| Блин, а у меня нет... Что нужно вызывать после этого метода ? Делаю так: IF nStaticNumField <= 0 oBrw1:GoPos( 1,7 ) // передвинуть МАРКЕР на XX строку и XX колонку ELSE oBrw1:GoPos( 1,6 + nStaticNumField ) // передвинуть МАРКЕР на XX строку и XX колонку ENDIF Первое условие работает - oBrw1:GoPos( 1,7 ), другое нет. Т.е. если курсор на первой части таблицы, то отображается. Если уходит за видимую ПЕРВУЮ часть, то курсора не видно и таблица со столбцами не перемещается.
| |
|
Dima
|
| |
Пост N: 6962
Зарегистрирован: 17.05.05
|
|
Отправлено: 30.10.18 12:43. Заголовок: Andrey Пробни так O..
Andrey Пробни так Obrw:Refresh(.F.) // или Display Затем Gopos
| |
|
SergKis
|
| постоянный участник
|
Пост N: 2119
Зарегистрирован: 17.02.12
|
|
Отправлено: 30.10.18 12:44. Заголовок: Andrey пишет Что нуж..
Andrey пишет цитата: | Что нужно вызывать после этого метода ? |
| Ничего не нужно. Надо найти у себя переустановку этого дела или ячейки :nCell
| |
|
|
Andrey
|
| постоянный участник
|
Пост N: 6100
Зарегистрирован: 12.09.06
|
|
Отправлено: 30.10.18 12:53. Заголовок: SergKis пишет: Надо..
SergKis пишет: цитата: | Надо найти у себя переустановку этого дела или ячейки :nCell |
| Уже неделю с этим бьюсь периодически....
| |
|
Dima
|
| |
Пост N: 6963
Зарегистрирован: 17.05.05
|
|
Отправлено: 30.10.18 13:05. Заголовок: Andrey пишет: Уже н..
Andrey пишет: цитата: | Уже неделю с этим бьюсь периодически... |
| Сделай простой пример: бровс и кнопка , при нажатии которой вводится место "прыга" и почекай как пашет Gopos
| |
|
SergKis
|
| постоянный участник
|
Пост N: 2120
Зарегистрирован: 17.02.12
|
|
Отправлено: 30.10.18 13:05. Заголовок: Andrey Tsb_array_2&..
Andrey Tsb_array_2\demo.prg STATIC FUNCTION CreateDatos() LOCAL a, i, k := 1000, aDatos, aHead, aSize, aFoot, aPict, aAlign, aName ... i % 2 == 0 } // 14 a := AClone(aDatos[ i ]) AEval(a, {|xv| AAdd(aDatos[ i ], xv) }) AEval(a, {|xv| AAdd(aDatos[ i ], xv) }) ... PROCEDURE MAIN ... END TBROWSE oBrw:GoPos(1, 21) // oBrw:GoPos(7, 31) END WINDOW ... работают строки
| |
|
Andrey
|
| постоянный участник
|
Пост N: 6101
Зарегистрирован: 12.09.06
|
|
Отправлено: 30.10.18 13:09. Заголовок: SergKis пишет: рабо..
SergKis пишет: Да, это работают. Видно у меня что-то не того.... Сделал как Дима посоветовал: IF nStaticNumField <= 0 oBrw1:GoPos( 1,7 ) // передвинуть МАРКЕР на XX строку и XX колонку ELSE oBrw1:GoPos( 1,6 + nStaticNumField ) // передвинуть МАРКЕР на XX строку и XX колонку oBrw1:Refresh(.T.) ENDIF Первый показ срабатывает, другие разы нет !
| |
|
Haz
|
| |
Пост N: 1388
Зарегистрирован: 20.02.11
|
|
Отправлено: 30.10.18 13:27. Заголовок: Andrey пишет: oBrw1..
Andrey пишет: цитата: | oBrw1:GoPos( 1,6 + nStaticNumField ) // передвинуть МАРКЕР на XX строку и XX колонку oBrw1:Refresh(.T.) |
| Дима немножко не так советовал, хотя это тоже не помогло бы . А так GoPos() в конце кода и так вызывает Refresh() В итоге ::ColumnRec( nColumn ) не нужен ,это тоже что и ::GoPos( ::nRowPos, nColumn ) и метод ::GoPos() рабочий
| |
|
gfilatov2002
|
| moderator
|
Пост N: 1389
Зарегистрирован: 11.02.10
|
|
Отправлено: 31.10.18 10:46. Заголовок: Выпущена новая сборк..
Выпущена новая сборка 18.10 для BCC 5.51 и компиляторов Harbour и xHarbour Базовый дистрибутив-инсталлятор находится по адресу http://hmgextended.com/files/CONTRIB/hmg-18.10-setup.exe Рекомендуется к использованию Также имеются следующие сборки для Си-компиляторов: - MinGW 8.1.0 32-bit для Harbour 3.2.0dev; (есть в наличии) - MinGW 8.1.0 64-bit для Harbour 3.4.0dev; (есть в наличии) - MS VisualC 2017 32-bit для Harbour 3.2.0dev; (есть в наличии) - MS VisualC 2017 64-bit для Harbour 3.2.0dev; (есть в наличии) - Borland/Embarcadero C++ 7.3 (32-bit) для Harbour 3.4.0dev. (под заказ) Особая благодарность SergKis и Haz за их постоянную помощь в совершенствовании TsBrowse Выпуск последующих сборок отложен на неопределенное время...
| |
|
SergKis
|
| постоянный участник
|
Пост N: 2121
Зарегистрирован: 17.02.12
|
|
Отправлено: 02.11.18 11:25. Заголовок: gfilatov2002 В мето..
gfilatov2002 В методе неточность METHOD GotoRec( nRec, nRowPos ) CLASS TSBrowse ... If HB_ISBLOCK( nRecnRowPos ) nRowPos := Eval( nRowPos, Self ) EndIf подключать блок не удалось, сделал правку для варианта с полным заполнением посл. экрана, тогда и блоки не нужны METHOD GotoRec( nRec, nRowPos ) CLASS TSBrowse LOCAL cAlias LOCAL nSkip LOCAL n LOCAL nRecSave LOCAL lRet := .F. LOCAL lReCount := .F. IF ::lIsDbf /* If HB_ISBLOCK( nRec ) nRec := Eval( nRec, Self ) EndIf If HB_ISBLOCK( nRec ) nRowPos := Eval( nRowPos, Self ) EndIf */ lRet := .T. cAlias := ::cAlias ::nLastPos := ( cAlias )->( RecNo() ) nRec := Min( ( cAlias )->( LastRec() ), nRec ) If HB_ISLOGICAL(nRowPos) .and. nRowPos .and. ::nLen > ::nRowCount() nRowPos := Nil nRecSave := ::nLastPos (cAlias)->( dbGoto(nRec) ) (cAlias)->( dbSkip( ::nRowCount() - ::nRowPos ) ) If (cAlias)->( EOF() ) Eval( ::bGoBottom ) ::nRowPos := ::nRowCount() DO WHILE ::nRowPos > 1 .and. (cAlias)->( RecNo() ) != nRec (cAlias)->( dbSkip( -1 ) ) ::nRowPos -- ENDDO Else (cAlias)->( dbGoto(nRecSave) ) EndIf EndIf hb_default( @nRowPos, ::nRowPos ) ( cAlias )->( dbGoto( nRec ) ) n := 0 ... Использовать :GotoRec(nRec, .T.) или как обычно
| |
|
Haz
|
| |
Пост N: 1393
Зарегистрирован: 20.02.11
|
|
Отправлено: 02.11.18 12:03. Заголовок: SergKis пишет: Испо..
SergKis пишет: цитата: | Использовать :GotoRec(nRec, .T.) или как обычно |
| то есть nRowPos или число или признак проверки на последний экран ? может тогда третьим параметром ? SergKis пишет: цитата: | подключать блок не удалось |
| Не подобрать условие ?
| |
|
SergKis
|
| постоянный участник
|
Пост N: 2122
Зарегистрирован: 17.02.12
|
|
Отправлено: 02.11.18 15:15. Заголовок: Haz пишет то есть nR..
Haz пишет цитата: | то есть nRowPos или число или признак проверки на последний экран ? |
| Да. У себя поставил DEFAULT nRowPos := .T. на входе - основной режим т.е. всегда заполнять последний экран, если надо оставить пустоту внизу экрана, то :GotoRec(nRec, :nRowPos\или число) но такое реже надо была ошибка в коде If HB_ISBLOCK( nRec надо nRowPos ) nRowPos := Eval( nRowPos, Self ) EndIf исправлять ее для блока или заменить вызов самим кодом, я сделал второе
| |
|
Haz
|
| |
Пост N: 1394
Зарегистрирован: 20.02.11
|
|
Отправлено: 02.11.18 15:35. Заголовок: SergKis пишет: была..
SergKis пишет: Да при вставке в исходник скорее всего техническая опечатка у Григория проскочила. Не удивительно мы столько раз просили его то то поменять то это
| |
|
|
gfilatov2002
|
| moderator
|
Пост N: 1390
Зарегистрирован: 11.02.10
|
|
Отправлено: 02.11.18 17:04. Заголовок: SergKis пишет: Испо..
SergKis пишет: цитата: | Использовать :GotoRec(nRec, .T.) или как обычно |
| Благодарю за исправление моей опечатки Да, без дополнительных кодовых блоков эта функция теперь работает отлично
| |
|
SergKis
|
| постоянный участник
|
Пост N: 2123
Зарегистрирован: 17.02.12
|
|
Отправлено: 02.11.18 18:28. Заголовок: gfilatov2002 Чуть д..
gfilatov2002 Чуть добавить надо (пропущена ситуация) METHOD GotoRec( nRec, nRowPos ) CLASS TSBrowse ... (cAlias)->( dbGoto(nRecSave) ) EndIf EndIf If HB_ISLOGICAL(nRowPos) nRowPos := Nil EndIf hb_default( @nRowPos, ::nRowPos ) ( cAlias )->( dbGoto( nRec ) ) ...
| |
|
gfilatov2002
|
| moderator
|
Пост N: 1391
Зарегистрирован: 11.02.10
|
|
Отправлено: 02.11.18 18:40. Заголовок: SergKis пишет: ..
SergKis пишет: цитата: | If HB_ISLOGICAL(nRowPos) nRowPos := Nil EndIf |
| Такой добавочный код излишен, поскольку функция hb_default() поправит этот случай цитата: | hb_default( @nRowPos, ::nRowPos ) |
| Проверил корректность работы функции на примере из папки samples\Advanced\Tsb_addrecord Функция сработала без проблем
| |
|
SergKis
|
| постоянный участник
|
Пост N: 2124
Зарегистрирован: 17.02.12
|
|
Отправлено: 02.11.18 18:52. Заголовок: gfilatov2002 пишет ..
gfilatov2002 пишет цитата: | поскольку функция hb_default() поправит этот случай |
| If HB_ISLOGICAL(nRowPos) .and. nRowPos .and. ::nLen > ::nRowCount() Если ::nLen <= ::nRowCount(), то nRowPos пойдет дальше логический и имеем далее DO WHILE !( cAlias )->( BoF() ) .AND. n < nRowPos - 1
| |
|
Andrey
|
| постоянный участник
|
Пост N: 6106
Зарегистрирован: 12.09.06
|
|
Отправлено: 02.11.18 19:03. Заголовок: gfilatov2002 пишет: ..
gfilatov2002 пишет: цитата: | - MS VisualC 2017 32-bit для Harbour 3.2.0dev; (есть в наличии) - MS VisualC 2017 64-bit для Harbour 3.2.0dev; (есть в наличии) |
| Хотелось бы попробовать перейти на этот компилятор. Как получить эти сборки ?
| |
|
gfilatov2002
|
| moderator
|
Пост N: 1392
Зарегистрирован: 11.02.10
|
|
Отправлено: 02.11.18 20:39. Заголовок: Andrey пишет: Как п..
Andrey пишет: цитата: | Как получить эти сборки ? |
| Отправил ссылки на архивы этих сборок по почте
| |
|
Andrey
|
| постоянный участник
|
Пост N: 6108
Зарегистрирован: 12.09.06
|
|
Отправлено: 05.11.18 05:00. Заголовок: gfilatov2002 пишет: ..
gfilatov2002 пишет: цитата: | Отправил ссылки на архивы этих сборок по почте |
| Спасибо ! Получил. Теперь вопрос другой - как распаковать эти архивы, чтобы можно было собирать свой проект под разными компиляторами ? Хотелось бы иметь возможность через *.hbp собирать проект для 3-х компиляторов: BCC, VC, VC64. Желательно бы иметь такую структуру каталогов: C:\MiniGUI\BCC C:\MiniGUI\VC17 C:\MiniGUI\VC1764 Или по другому, как лучше будет и универсальней.
| |
|
SergKis
|
| постоянный участник
|
Пост N: 2125
Зарегистрирован: 17.02.12
|
|
Отправлено: 05.11.18 13:13. Заголовок: Григорий, можно Андр..
Григорий, можно Андрей кинет мне (он знает куда) ссылки или архивы сборок VC-ных, полюбопытсвовать.
| |
|
gfilatov2002
|
| moderator
|
Пост N: 1393
Зарегистрирован: 11.02.10
|
|
Отправлено: 05.11.18 15:38. Заголовок: SergKis пишет: можн..
SergKis пишет: цитата: | можно Андрей кинет мне (он знает куда) ссылки |
| Без проблем - это ведь тестовые сборки для любопытных Кстати, обновил сегодня сборку 18.10 ( Update 1) с учетом Ваших исправлений в TsBrowse Что нового: цитата: | * Fixed: Program crash at releasing of a Tab control with imbedded Slider (introduced in the build 18.10). Bug was reported by Richard Rylko. Contributed by Grigory Filatov <gfilatov@inbox.ru> * Modified: The function HMG_Alert() respects now the Minigui command SET CENTERWINDOW RELATIVE PARENT. Contributed by Grigory Filatov <gfilatov@inbox.ru> * Updated: Adaptation FiveWin Class TSBrowse 9.0 in HMG: - improved the method GotoRec( nRec [, lLastPos | nRowPos ] ) in the TSBrowse class. Contributed by Sergej Kiselev (see demo in folder \samples\Advanced\Tsb_addrecord) |
|
| |
|
SergKis
|
| постоянный участник
|
Пост N: 2126
Зарегистрирован: 17.02.12
|
|
Отправлено: 05.11.18 15:41. Заголовок: gfilatov2002 пишет Б..
gfilatov2002 пишет Спасибо.
| |
|
|
SergKis
|
| постоянный участник
|
Пост N: 2137
Зарегистрирован: 17.02.12
|
|
Отправлено: 21.11.18 12:48. Заголовок: gfilatov2002 Предло..
gfilatov2002 Предложение: 1. CLASS TKeyData ... _METHOD Destroy() ERROR HANDLER ControlAssign ENDCLASS /////////////////////////////////////////////////////////////////////////////// METHOD ControlAssign( xValue ) CLASS TKeyData LOCAL cMessage, uRet, lError cMessage := __GetMessage() lError := .T. If PCOUNT() == 0 uRet := ::Get( cMessage ) lError := .F. ElseIf PCOUNT() == 1 ::Set( SubStr( cMessage, 2 ), xValue ) uRet := ::Get( cMessage ) lError := .F. EndIf If lError uRet := Nil ::MsgNotFound( cMessage ) EndIf RETURN uRet тогда можно так (пример Advanced\Tsb_Basic\demo4.prg line 416) oRec2 := (cAls)->( RecGet() ) nKey2 := oRec2:F0 oRec2:F0 := nKey1 oRec1:F0 := nKey2 ... вместо oRec2 := (cAls)->( RecGet() ) nKey2 := oRec2:Get('F0') oRec2:Set('F0', nKey1) oRec1:Set('F0', nKey2) ... 2. предлагаю _LogFile(...) поправить, что бы команда ? не давала на вывод NIL Скрытый текст
*-----------------------------------------------------------------------------* #ifndef __XHARBOUR__ FUNCTION _LogFile( lCrLf, ... ) #else FUNCTION _LogFile( ... ) #endif *-----------------------------------------------------------------------------* LOCAL hFile, i, xVal, cTp LOCAL aParams := hb_AParams() LOCAL nParams := Len( aParams ) LOCAL cFile := hb_defaultValue( _SetGetLogFile(), GetStartUpFolder() + "\_MsgLog.txt" ) #ifdef __XHARBOUR__ LOCAL lCrLf #endif IF !Empty( cFile ) hFile := iif( File( cFile ), FOpen( cFile, FO_READWRITE ), FCreate( cFile, FC_NORMAL ) ) IF hFile == F_ERROR RETURN .F. ENDIF FSeek( hFile, 0, FS_END ) #ifdef __XHARBOUR__ IF nParams > 0 lCrLf := aParams[ 1 ] ENDIF #endif IF ( lCrLf := hb_defaultValue( lCrLf, .T. ) ) FWrite( hFile, CRLF, 2 ) ENDIF IF nParams == 2 .and. HB_ISNIL(aParams[ 2 ]) .and. lCrLf ELSEIF nParams > 1 // IF lCrlf // FWrite( hFile, CRLF, 2 ) // ENDIF FOR i := 2 TO nParams xVal := aParams[ i ] cTp := ValType( xVal ) IF cTp == 'C' ; xVal := iif( Empty( xVal ), "'" + "'", Trim( xVal ) ) ELSEIF cTp == 'N' ; xVal := hb_ntos( xVal ) ELSEIF cTp == 'L' ; xVal := iif( xVal, ".T.", ".F." ) #ifdef __XHARBOUR__ ELSEIF cTp == 'D' ; xVal := DToC( xVal ) #else ELSEIF cTp == 'D' ; xVal := hb_DToC( xVal, 'DD.MM.YYYY' ) #endif ELSEIF cTp == 'A' ; xVal := "ARRAY[" + hb_ntos( Len( xVal ) ) + "]" ELSEIF cTp == 'H' ; xVal := "HASH[" + hb_ntos( Len( xVal ) ) + "]" ELSEIF cTp == 'B' ; xVal := "'" + "B" + "'" ELSEIF cTp == 'T' ; xVal := hb_TSToStr( xVal, .T. ) ELSEIF cTp == 'U' ; xVal := 'NIL' ELSE ; xVal := "'" + cTp + "'" ENDIF FWrite( hFile, xVal + Chr( 9 ) ) NEXT // ELSE // FWrite( hFile, CRLF, 2 ) ENDIF FClose( hFile ) ENDIF RETURN .T.
|
| |
|
gfilatov2002
|
| moderator
|
Пост N: 1397
Зарегистрирован: 11.02.10
|
|
Отправлено: 21.11.18 13:50. Заголовок: SergKis пишет: Пред..
SergKis пишет: 1-й пункт принят без вопросов, а со вторым - неясно, чем не угодил тип NIL
| |
|
SergKis
|
| постоянный участник
|
Пост N: 2138
Зарегистрирован: 17.02.12
|
|
Отправлено: 21.11.18 13:59. Заголовок: gfilatov2002 пишет н..
gfilatov2002 пишет цитата: | неясно, чем не угодил тип NIL |
| "Старые" тексты с set alternate ... и исп. команд ? ... - все ок, но команды ? "портят" протокол\отчет. Только это
| |
|
gfilatov2002
|
| moderator
|
Пост N: 1398
Зарегистрирован: 11.02.10
|
|
Отправлено: 21.11.18 14:06. Заголовок: SergKis пишет: кома..
SergKis пишет: цитата: | команды ? "портят" протокол\отчет |
| Тогда надо заменить ? на ? "" например, с помощью препроцессора P.S. Нет, препроцессор в этом случае не поможет Поэтому 2-й пункт принят также. Благодарю за помощь
| |
|
gfilatov2002
|
| moderator
|
Пост N: 1400
Зарегистрирован: 11.02.10
|
|
Отправлено: 03.12.18 12:05. Заголовок: Завершена подготовка..
Завершена подготовка новой сборки 18.11, последней в этом году Кратко, что нового: цитата: | * Fixed a problem with button's focus at a window activation when this button was defined with the DEFAULT clause. * A first TEXTBOX have got a control's content selection by default when a focus is received at a window activation. It is not required a calling of Setfocus method at form's 'On Init' event anymore (look at the InputBox() and InputWindow() functions). * Added an additional checking before a calling of the C-function _SetFont() due to a program crash in some situations (introduced in the build 16.12). * The optimized ON SIZE event's behavior with using of the auxiliary WinAPI events WM_ENTERSIZEMOVE and WM_EXITSIZEMOVE. * A Label control supports a codeblock type for assigning to 'Value' property, e.g. @ ... LABEL ... VALUE { || ... } Form.Label.Value := { || ... } * Modified handling of the WM_NEXTDLGCTL message according to WinAPI specification (synchronized with Official HMG). * Added the Harbour client library for access to LetoDBf server RDDLeto with the corresponding header files. * Updated and improved the TSBrowse, HbXML and HMG_HPDF libraries. * Updated Harbour Compiler 3.2.0dev to a recent Git-version. (ChangeLog Last Entry: 2018-11-16 16:33) * Added the new interesting samples: - Calendar; - Mandelbrot Fractal; - My Player sample is based upon the VLC ActiveX Control; - MiniGUI DataBase Utility (Inspired by EMAG Software DBU at https://www.emagsoftware.it) and updated some Advanced samples. |
| Особая благодарность SergKis и Haz за их постоянную помощь в совершенствовании TsBrowse Выпуск последующих сборок отложен на неопределенное время...
| |
|
Andrey
|
| постоянный участник
|
Пост N: 6138
Зарегистрирован: 12.09.06
|
|
Отправлено: 03.12.18 15:17. Заголовок: gfilatov2002 пишет: ..
gfilatov2002 пишет: цитата: | * The optimized ON SIZE event's behavior with using of the auxiliary WinAPI events WM_ENTERSIZEMOVE and WM_EXITSIZEMOVE. |
| А новые свойства окна будут ? DEFINE WINDOW test ; ...... MAIN TOPMOST ; ON MAXIMIZE ( zzzz() ) ; ON SIZE ( zzzz() ) ; ON SIZE_BEGIN ( хххх() ) ; ON SIZE_END ( хххх() ) ; Можно оставить по старому и новому варианту, программист сам будет решать, что использовать.
| |
|
gfilatov2002
|
| moderator
|
Пост N: 1401
Зарегистрирован: 11.02.10
|
|
Отправлено: 05.12.18 11:42. Заголовок: Выпущена новая сборк..
Выпущена новая сборка 18.11 для BCC 5.5.1 и компиляторов Harbour и xHarbour. Установщик дистрибутива находится по адресу http://hmgextended.com/files/CONTRIB/hmg-18.11-setup.exe Также имеются следующие сборки для Си-компиляторов: - MinGW 8.1.0 32-bit для Harbour 3.2.0dev; (есть в наличии) - MinGW 8.1.0 64-bit для Harbour 3.4.0dev; (есть в наличии) - MS VisualC 2017 32-bit для Harbour 3.2.0dev; (путь и имя архива не изменял) - MS VisualC 2017 64-bit для Harbour 3.2.0dev; (путь и имя архива не изменял) - Borland/Embarcadero C++ 7.3 (32-bit) для Harbour 3.4.0dev. (под заказ). Благодарю за Ваше внимание
| |
|
SergKis
|
| постоянный участник
|
Пост N: 2147
Зарегистрирован: 17.02.12
|
|
Отправлено: 05.12.18 13:09. Заголовок: gfilatov2002 Можно ..
gfilatov2002 Можно собрать вариант сборки, как раньше, на 7z
| |
|
gfilatov2002
|
| moderator
|
Пост N: 1402
Зарегистрирован: 11.02.10
|
|
Отправлено: 05.12.18 14:12. Заголовок: SergKis пишет: вари..
SergKis пишет: цитата: | вариант сборки, как раньше, на 7z |
|
Да, конечно. Кинул прямую ссылку в Л.С.
| |
|
SergKis
|
| постоянный участник
|
Пост N: 2148
Зарегистрирован: 17.02.12
|
|
Отправлено: 05.12.18 15:11. Заголовок: gfilatov2002 Спасиб..
gfilatov2002 Спасибо.
| |
|
SergKis
|
| постоянный участник
|
Пост N: 2149
Зарегистрирован: 17.02.12
|
|
Отправлено: 06.12.18 10:35. Заголовок: gfilatov2002 Предла..
gfilatov2002 Предлагаю на on size сделать 2-а вызова процедуры, а не один, как сейчас. Большой разницы нет, но немного удобней расчеты производить: 1-ый раз запоминаем старые значения (коэффициенты) 2-ой считаем новые Изменения: //********************************************************************** CASE WM_ENTERSIZEMOVE //********************************************************************** IF ! _HMG_AutoAdjust lEnterSizeMove := Nil // .T. _HMG_MouseState := 1 ENDIF // EXIT //********************************************************************** CASE WM_SIZE //********************************************************************** IF ( ISNIL(lEnterSizeMove) .OR. ! lEnterSizeMove ) .OR. ! iswinnt() // IF ! lEnterSizeMove .OR. ! iswinnt() IF ISNIL(lEnterSizeMove) lEnterSizeMove := .T. ENDIF ControlCount := Len ( _HMG_aControlHandles ) ... //********************************************************************** CASE WM_EXITSIZEMOVE //********************************************************************** lEnterSizeMove := .F. IF ! _HMG_AutoAdjust _HMG_MouseState := 0 SendMessage ( hWnd , WM_SIZE , 0 , 0 ) ENDIF EXIT ... тогда результат процедуры в on size выглядит Start - Tsb_export987bcc.exe Number of records in the table: 1005 Windows 8.1 6.3 Harbour MiniGUI Extended Edition 18.11 (32-bit) . RESIZETABLE VK_LBUTTON -127 _HMG_MouseState 1 // первый раз RESIZETABLE VK_LBUTTON 1 _HMG_MouseState 0 // второй раз RESIZETABLE VK_LBUTTON -128 _HMG_MouseState 1 // первый раз RESIZETABLE VK_LBUTTON 0 _HMG_MouseState 0 // второй раз ... Пример процедуры on resize STATIC FUNCTION ResizeTable(oBrw) ? procname(), 'VK_LBUTTON', WAPI_GETKEYSTATE(VK_LBUTTON), '_HMG_MouseState', _HMG_MouseState IF _HMG_MouseState > 0 // первый раз ELSE // второй раз ENDIF ...
| |
|
gfilatov2002
|
| moderator
|
Пост N: 1403
Зарегистрирован: 11.02.10
|
|
Отправлено: 06.12.18 13:11. Заголовок: SergKis пишет: Пред..
SergKis пишет: цитата: | Предлагаю на on size сделать 2-а вызова процедуры |
| Принято с благодарностью Два прохода для этого события решают также проблему перерисовки контролов, которая иногда возникает при быстром изменении размеров формы
| |
|
Andrey
|
| постоянный участник
|
Пост N: 6142
Зарегистрирован: 12.09.06
|
|
Отправлено: 07.12.18 11:53. Заголовок: Поставил новую верси..
Поставил новую версию 18.11 Мой большой проект перестал собираться. Выдаёт ошибку: OBJ\use_LetoDb.c: Turbo Incremental Link 5.66 Copyright (c) 1997-2002 Borland Error: Unresolved external '_HB_FUN_LETO_SET' referenced from W:\HB_PROJECT\...\OBJ\USE_LETODB.OBJ Откатил назад на версию 18.10 - проект собирается !!! Использую Leto DB Server v.2.15b3 с 2015 года. Отлично работает, переходить на новую версию нет надобности. Я так понимаю функция LETO_SET берется из MiniGui\Harbour\include\RDDLETO.CH Т.е. появилась поддержка LetoDb. Можно ли починить МиниГуи версию 18.11 для правильной сборки ? Т.е. как задать правило в MyPrj.hbp для подключения сначала моих ch - W:\HB_Project\MyPrj\Include\rddleto.ch и моей библиотеки W:\HB_Project\MyPrj\rddleto.lib Хотя я в MyPrj.hbp прописал так # включить путь к своим *.ch и *.fmg -incpath=Include -incpath=Source Но первым берется всё равно MiniGui\Harbour\include\RDDLETO.CH Можно конечно поступить проще, тупо удалить файлы из поставки минигуи RDDLETO.CH и RDDLETO.LIB, но хочется разобраться как делать правильно.
| |
|
SergKis
|
| постоянный участник
|
Пост N: 2150
Зарегистрирован: 17.02.12
|
|
Отправлено: 07.12.18 13:41. Заголовок: Andrey пишет Можно л..
Andrey пишет цитата: | Можно ли починить МиниГуи версию 18.11 для правильной сборки ? |
| 1 попробуй у себя ставить #define CaseSensitive // отключить #define set(...) LETO_SET(...) возможно пройдет проект на новой версии RddLeto 3.0 2. замени в MiniGui\Harbour\Lib\RDDLETO.LIB из версии Leto 2.0 3. замени в MiniGui\Harbour\Include\RDDLETO.CH из версии Leto 2.0
| |
|
SergKis
|
| постоянный участник
|
Пост N: 2151
Зарегистрирован: 17.02.12
|
|
Отправлено: 07.12.18 13:45. Заголовок: PS по первому пункту..
PS по первому пункту, можно закрыть строки в RDDLETO.CH v.m.3.0 ... /* redirect for 4 options handled in LETO_SET(), others forward to SET() */ #ifdef CASESENSITIVE // #define set( _HB_SETTING, XSET ) LETO_SET( _HB_SETTING, XSET ) // #define Set( _HB_SETTING, XSET ) LETO_SET( _HB_SETTING, XSET ) #endif //#define SET( _HB_SETTING, XSET ) LETO_SET( _HB_SETTING, XSET )
| |
|
Andrey
|
| постоянный участник
|
Пост N: 6143
Зарегистрирован: 12.09.06
|
|
Отправлено: 07.12.18 16:02. Заголовок: SergKis пишет: по п..
SergKis пишет: цитата: | по первому пункту, можно закрыть строки в RDDLETO.CH v.m.3.0 |
| А как сделать, чтобы в prg брался ВСЕГДА мой ch - W:\HB_Project\MyPrj\Include\rddleto.ch ?
| |
|
SergKis
|
| постоянный участник
|
Пост N: 2152
Зарегистрирован: 17.02.12
|
|
Отправлено: 07.12.18 16:05. Заголовок: Andrey Посмотри и в..
Andrey Посмотри и выполни пункты 2 и 3 Будет все твое
| |
|
PSP
|
| постоянный участник
|
Пост N: 1488
Зарегистрирован: 27.01.07
|
|
Отправлено: 07.12.18 16:07. Заголовок: Andrey пишет: А как..
Andrey пишет: цитата: | А как сделать, чтобы в prg брался ВСЕГДА мой ch - W:\HB_Project\MyPrj\Include\rddleto.ch ? |
| #include "W:\HB_Project\MyPrj\Include\rddleto.ch"
| |
|
SergKis
|
| постоянный участник
|
Пост N: 2153
Зарегистрирован: 17.02.12
|
|
Отправлено: 07.12.18 16:09. Заголовок: PS Если хочешь разде..
PS Если хочешь разделить версии leto, переименуй свои rddleto.ch -> rddleto2.ch rddleto.lib -> rddleto2.lib и подключай их
| |
|
SergKis
|
| постоянный участник
|
Пост N: 2154
Зарегистрирован: 17.02.12
|
|
Отправлено: 07.12.18 16:16. Заголовок: gfilatov2002 Поправ..
gfilatov2002 Поправил у себя в TsBrowse METHOD SetNoHoles( nDelta, lSet ) CLASS TSBrowse LOCAL nH, nK, nHeight, nHole DEFAULT nDelta := 0, lSet := .T. // nHole := ::nHeight - ::nHeightHead - ::nHeightSuper - ; nHole := _GetClientRect( ::hWnd )[4] - ::nHeightHead - ::nHeightSuper - ; ::nHeightFoot - ::nHeightSpecHd - ; If( ::lNoHScroll, 0, GetHScrollBarHeight() ) ... А то METHOD nHeight() INLINE GetWindowHeight( ::hWnd ) дает не то
| |
|
gfilatov2002
|
| moderator
|
Пост N: 1404
Зарегистрирован: 11.02.10
|
|
Отправлено: 07.12.18 20:59. Заголовок: SergKis пишет: Попр..
SergKis пишет: цитата: | Поправил у себя в TsBrowse METHOD SetNoHoles |
| Благодарю за исправление! Так, конечно, лучше...
| |
|
SergKis
|
| постоянный участник
|
Пост N: 2155
Зарегистрирован: 17.02.12
|
|
Отправлено: 07.12.18 21:02. Заголовок: PS Может зря "за..
PS Может зря "завелся" с :nHeight, но не глянулось изменение дырки в тсб после on resize (с изменениями). До on resize была ~2-3 pixel, после убралась из за разницы алгоритмов высоты. Процедура на on resize Скрытый текст
DEFINE WINDOW test ; AT 0,0 WIDTH nWwnd HEIGHT 720 ; MINWIDTH 600 MINHEIGHT 620 ; TITLE "(" + MsgAboutDim(5) + ") " + SHOW_TITLE ; ICON "1MAIN_ICO" ; MAIN TOPMOST ; ON MAXIMIZE ( ResizeForm(oBrw, .T.) ) ; ON SIZE ( ResizeForm(oBrw, .F.) ) ; BACKCOLOR { 93,114,148 } ; ON INIT ( OnInitTest(oBrw,cParam), This.Topmost := .F., oBrw:SetFocus() ) ... * ================================================================================ STATIC FUNCTION ResizeForm( oBrw, lMaximize ) Local nW // ? procname(), lMaximize, '_HMG_MouseState', _HMG_MouseState ResizeTsb( oBrw, lMaximize ) IF _HMG_MouseState == 0 // установим новую ширину PROGRESSBAR nW := This.Button_Exit.Col + This.Button_Exit.Width + 20 This.PBar_1.Width := This.ClientWidth - nW - 20 This.PBar_1.SetFocus oBrw:SetFocus() ENDIF RETURN NIL * ================================================================================ STATIC FUNCTION ResizeTsb( oBrw, lMaximize ) Local nK, nN, nS, nW, nH, nCol, oCol, cBrw STATIC oCargo DEFAULT lMaximize := .F. //? procname(), lMaximize, '_HMG_MouseState', _HMG_MouseState If ISNIL(oCargo) oCargo := oKeyData() oCargo:nHeightSuper := oBrw:nHeightSuper oCargo:nHeightHead := oBrw:nHeightHead oCargo:nHeightSpecHd := oBrw:nHeightSpecHd oCargo:nHeightCell := oBrw:nHeightCell oCargo:nHeightFoot := oBrw:nHeightFoot oCargo:aKfc := array(Len( oBrw:aColumns )) AFill( oCargo:aKfc, 0 ) EndIf IF _HMG_MouseState > 0 .or. lMaximize WITH OBJECT oBrw nW := _GetClientRect( :hWnd )[3] nN := nK := 0 For nCol := 1 To Len( :aColumns ) oCol := :aColumns[ nCol ] oCargo:aKfc[ nCol ] := 0 If nCol == 1 .and. :lSelector; LOOP ElseIf ! oCol:lVisible ; LOOP ElseIf oCol:lBitMap ; LOOP EndIf oCargo:aKfc[ nCol ] := oCol:nWidth / nW If oCargo:aKfc[ nCol ] > nK nN := nCol nK := oCargo:aKfc[ nCol ] Endif Next oCargo:nColMaxKfc := nN END WITH ENDIF IF _HMG_MouseState == 0 //? //? procname(), oCargo:nColMaxKfc, oCargo:aKfc, oBrw:lPainted //AEval(oCargo:aKfc, {|k,i| _LogFile(.T., i, k) }) //? WITH OBJECT oBrw // new size TsBrowse cBrw := :cControlName :lEnabled := .F. This.&(cBrw).Enabled := .F. :Move( :nLeft, :nTop, This.ClientWidth, This.ClientHeight - :nTop, .T. ) // new width columns nW := _GetClientRect( :hWnd )[3] nN := oCargo:nColMaxKfc nS := 0 For nCol := 1 To Len(:aColumns) oCol := :aColumns[ nCol ] If Empty( oCargo:aKfc[ nCol ] ); LOOP EndIf oCol:nWidth := int( oCargo:aKfc[ nCol ] * nW ) nS += oCol:nWidth Next :aColumns[ nN ]:nWidth += ( nW - nS ) // new rows table :nHeightSuper := oCargo:nHeightSuper :nHeightHead := oCargo:nHeightHead :nHeightSpecHd := oCargo:nHeightSpecHd :nHeightCell := oCargo:nHeightCell :nHeightFoot := oCargo:nHeightFoot nH := _GetClientRect( :hWnd )[4] nS := nH - :nHeightHead - :nHeightSuper - ; :nHeightFoot - :nHeightSpecHd - ; iif( :lNoHScroll, 0, GetHScrollBarHeight() ) nS -= ( Int( nS / :nHeightCell ) * :nHeightCell ) nN := If( :nHeightSuper > 0, 1, 0 ) + ; If( :nHeightHead > 0, 1, 0 ) + ; If( :nHeightSpecHd > 0, 1, 0 ) + ; If( :nHeightFoot > 0, 1, 0 ) If nN > 0 nK := int( nS / nN ) If :nHeightFoot > 0 :nHeightFoot += nK nS -= nK EndIf If :nHeightSuper > 0 :nHeightSuper += nK nS -= nK EndIf If :nHeightSpecHd > 0 :nHeightSpecHd += nK nS -= nK EndIf If :nHeightHead > 0 :nHeightHead += nS EndIf EndIf :lEnabled := .T. This.&(cBrw).Enabled := .T. :Paint() // :Refresh(.T.) END WITH ENDIF RETURN NIL ...
|
| |
|
Andrey
|
| постоянный участник
|
Пост N: 6144
Зарегистрирован: 12.09.06
|
|
Отправлено: 08.12.18 15:09. Заголовок: SergKis пишет: Если..
SergKis пишет: цитата: | Если хочешь разделить версии leto, переименуй свои rddleto.ch -> rddleto2.ch rddleto.lib -> rddleto2.lib и подключай их |
| То что надо ! Спасибо ! Сделал rddleto_my.ch
| |
|
Andrey
|
| постоянный участник
|
Пост N: 6145
Зарегистрирован: 12.09.06
|
|
Отправлено: 08.12.18 15:11. Заголовок: gfilatov2002 пишет: ..
gfilatov2002 пишет: цитата: | Два прохода для этого события решают также проблему перерисовки контролов, которая иногда возникает при быстром изменении размеров формы |
| Григорий, а тихое обновление версии 18.11 с учётом последних изменений можно сделать ?
| |
|
gfilatov2002
|
| moderator
|
Пост N: 1405
Зарегистрирован: 11.02.10
|
|
Отправлено: 08.12.18 18:49. Заголовок: Andrey пишет: тихое..
Andrey пишет: цитата: | тихое обновление версии 18.11 с учётом последних изменений можно сделать ? |
| Да, сейчас готовлю update 1 для версии 18.11, который запланирован к выходу на следующей неделе...
| |
|
SergKis
|
| постоянный участник
|
Пост N: 2156
Зарегистрирован: 17.02.12
|
|
Отправлено: 09.12.18 16:50. Заголовок: gfilatov2002 Измени..
gfilatov2002 Изменил в TsBrowse :SetNoHoles(...) с учетом исп. в ON SIZE Скрытый текст
CLASS TSBrowse FROM TControl ... DATA aOldParams ... METHOD SetNoHoles( nDelta, lSet ) CLASS TSBrowse LOCAL nH, nK, nHeight, nHole, nCol, oCol, aRect DEFAULT nDelta := 0, lSet := .T. If ISARRAY( ::aOldParams ) .and. Len( ::aOldParams ) > 4 ::nHeightSuper := ::aOldParams[1] ::nHeightHead := ::aOldParams[2] ::nHeightSpecHd := ::aOldParams[3] ::nHeightCell := ::aOldParams[4] ::nHeightFoot := ::aOldParams[5] EndIf nHole := _GetClientRect( ::hWnd )[4] - ; ::nHeightHead - ::nHeightSuper - ; ::nHeightFoot - ::nHeightSpecHd - ; If( ::lNoHScroll, 0, GetHScrollBarHeight() ) nHole -= ( Int( nHole / ::nHeightCell ) * ::nHeightCell ) nHole -= nDelta nHeight := nHole If lSet nH := If( ::nHeightSuper > 0, 1, 0 ) + ; If( ::nHeightHead > 0, 1, 0 ) + ; If( ::nHeightSpecHd > 0, 1, 0 ) + ; If( ::nHeightFoot > 0, 1, 0 ) If nH > 0 nK := int( nHole / nH ) If ::nHeightFoot > 0 ::nHeightFoot += nK nHole -= nK EndIf If ::nHeightSuper > 0 ::nHeightSuper += nK nHole -= nK EndIf If ::nHeightSpecHd > 0 ::nHeightSpecHd += nK nHole -= nK EndIf If ::nHeightHead > 0 ::nHeightHead += nHole EndIf Else SetProperty( ::cParentWnd, ::cControlName, "Height", ; GetProperty( ::cParentWnd, ::cControlName, "Height" ) - nHole ) EndIf If Empty( ::aOldParams ) ::Display() aRect := _GetClientRect( ::hWnd ) ::aOldParams := array(7) ::aOldParams[1] := ::nHeightSuper ::aOldParams[2] := ::nHeightHead ::aOldParams[3] := ::nHeightSpecHd ::aOldParams[4] := ::nHeightCell ::aOldParams[5] := ::nHeightFoot ::aOldParams[6] := { aRect[3], aRect[4] } // client { width, height } ::aOldParams[7] := array(Len( ::aColumns )) For nCol := 1 To Len( ::aColumns ) ::aOldParams[7][ nCol ] := 0 oCol := ::aColumns[ nCol ] If nCol == 1 .and. ::lSelector; LOOP ElseIf oCol:lBitMap ; LOOP EndIf If ! Empty(::aOldParams[6][1]) ::aOldParams[7][ nCol ] := oCol:nWidth / ::aOldParams[6][1] EndIf Next Else If ::lEnabled ::lEnabled := .F. EndIf ::Paint() ::lEnabled := .T. ::Refresh(.F.) EndIf EndIf RETURN nHeight
| Добавил метод OnResize(...), сейчас он работает "правильно" для тсб со всеми колонками помещающиеся на экран, но предлагаю включить (потом может модифицируем) Скрытый текст
METHOD OnReSize( nWidth, nHeight, lTop ) CLASS TSBrowse LOCAL nCnt, aCol, nCol, oCol, nKfc, lRet := .F. LOCAL nColMaxKfc := 0, nW, nS, nN LOCAL nTop := iif( empty( lTop ), ::nTop, 0 ) IF _HMG_MouseState == 0 .and. ISARRAY( ::aOldParams[7] ) aCol := ::aOldParams[7] nCnt := Min( Len(aCol), Len( ::aColumns ) ) nKfc := 0 lRet := .T. For nCol := 1 To nCnt oCol := ::aColumns[ nCol ] If nCol == 1 .and. ::lSelector; LOOP ElseIf ! oCol:lVisible ; LOOP ElseIf oCol:lBitMap ; LOOP EndIf If aCol[ nCol ] > nKfc nColMaxKfc := nCol nKfc := aCol[ nCol ] Endif Next ::lEnabled := .F. ::Move( ::nLeft, ::nTop, nWidth, nHeight - nTop, .T. ) nW := _GetClientRect( ::hWnd )[3] nN := nS := 0 For nCol := 1 To nCnt oCol := ::aColumns[ nCol ] If nCol == 1 .and. ::lSelector; LOOP ElseIf ! oCol:lVisible ; LOOP ElseIf oCol:lBitMap ; LOOP EndIf nKfc := aCol[ nCol ] oCol:nWidth := int( nKfc * nW ) nS += oCol:nWidth nN := nCol Next nN := iif( nColMaxKfc > 0, nColMaxKfc, nN ) ::aColumns[ nN ]:nWidth += ( nW - nS ) ::lEnabled := .T. ::SetNoHoles() ENDIF Return lRet Применение ... DEFINE WINDOW test ; ... ON MAXIMIZE ResizeForm(oBrw) ; ON SIZE ResizeForm(oBrw) ; ... DEFINE TBROWSE oBrw AT 46+10, 0 ; ... END TBROWSE oBrw:SetNoHoles() // убрать дырку внизу таблицы ... END WINDOW ... STATIC FUNCTION ResizeForm( oBrw ) Local nW oBrw:OnResize( This.ClientWidth, This.ClientHeight ) // сработает 1 раз при _HMG_MouseState == 0 (внутри анализ) IF _HMG_MouseState == 0 // установим новую ширину PROGRESSBAR nW := This.Button_Exit.Col + This.Button_Exit.Width + 20 This.PBar_1.Width := This.ClientWidth - nW - 20 This.PBar_1.SetFocus oBrw:SetFocus() ENDIF RETURN NIL
|
| |
|
SergKis
|
| постоянный участник
|
Пост N: 2157
Зарегистрирован: 17.02.12
|
|
Отправлено: 09.12.18 19:08. Заголовок: PS Погонял OnResize ..
PS Погонял OnResize метод на _HMG_MouseState == 1 и изменение ширины колонки мышой, получилась добавка METHOD OnReSize( nWidth, nHeight, lTop ) CLASS TSBrowse LOCAL nCnt, aCol, nCol, oCol, nKfc, lRet := .F. LOCAL nColMaxKfc := 0, nW, nS, nN LOCAL nTop := iif( empty( lTop ), ::nTop, 0 ) IF _HMG_MouseState == 1 aCol := array(Len( ::aColumns )) nW := _GetClientRect( ::hWnd )[3] For nCol := 1 To Len( ::aColumns ) oCol := ::aColumns[ nCol ] aCol[ nCol ] := 0 If nCol == 1 .and. ::lSelector; LOOP ElseIf oCol:lBitMap ; LOOP EndIf aCol[ nCol ] := oCol:nWidth / nW Next ::aOldParams[7] := AClone( aCol ) ELSEIF _HMG_MouseState == 0 .and. ISARRAY( ::aOldParams[7] ) aCol := ::aOldParams[7] ...
| |
|
SergKis
|
| постоянный участник
|
Пост N: 2158
Зарегистрирован: 17.02.12
|
|
Отправлено: 09.12.18 19:34. Заголовок: PPS можно добавить в..
PPS можно добавить в класс DATA bOnResizeEnter DATA bOnResizeExit и сделать вызовы в OnResize(...) ... ::aOldParams[7] := AClone( aCol ) IF ISBLOCK( ::bOnResizeEnter ) EVal( ::bOnResizeEnter, Self ) ENDIF ELSEIF _HMG_MouseState == 0 .and. ISARRAY( ::aOldParams[7] ) aCol := ::aOldParams[7] ... ::lEnabled := .T. IF ISBLOCK( ::bOnResizeExit ) EVal( ::bOnResizeExit, Self ) ENDIF ::SetNoHoles() ENDIF Return lRet возможно закроются хотелки
| |
|
gfilatov2002
|
| moderator
|
Пост N: 1407
Зарегистрирован: 11.02.10
|
|
Отправлено: 09.12.18 22:43. Заголовок: SergKis пишет: возм..
SergKis пишет: цитата: | возможно закроются хотелки |
| Принято с благодарностью за Вашу помощь
| |
|
SergKis
|
| постоянный участник
|
Пост N: 2160
Зарегистрирован: 17.02.12
|
|
Отправлено: 10.12.18 15:26. Заголовок: gfilatov2002 Может ..
gfilatov2002 Может поведение процедуры _HMG_aFormMaximizeProcedure [ i ] сделать одинаковым с процедурой на ON SIZE ? //********************************************************************** CASE WM_SIZE //********************************************************************** ... IF _HMG_MainActive == .T. IF wParam == SIZE_MAXIMIZED // _DoWindowEventProcedure ( _HMG_aFormMaximizeProcedure [ i ], i ) If ! Empty( _HMG_aFormMaximizeProcedure [ i ] ) If _HMG_AutoAdjust _DoWindowEventProcedure ( _HMG_aFormMaximizeProcedure [ i ], i ) Else _HMG_MouseState := 1 _DoWindowEventProcedure ( _HMG_aFormMaximizeProcedure [ i ], i ) _HMG_MouseState := 0 _DoWindowEventProcedure ( _HMG_aFormMaximizeProcedure [ i ], i ) EndIf EndIf IF _HMG_AutoAdjust .AND. _HMG_MainClientMDIHandle == 0 _Autoadjust( hWnd ) ENDIF ...
| |
|
gfilatov2002
|
| moderator
|
Пост N: 1408
Зарегистрирован: 11.02.10
|
|
Отправлено: 10.12.18 15:51. Заголовок: SergKis пишет: Може..
SergKis пишет: цитата: | Может поведение процедуры _HMG_aFormMaximizeProcedure [ i ] сделать одинаковым с процедурой на ON SIZE ? |
| Нет, на мой взгляд, этого не требуется, только усложняется логика обработки
| |
|
SergKis
|
| постоянный участник
|
Пост N: 2161
Зарегистрирован: 17.02.12
|
|
Отправлено: 10.12.18 16:45. Заголовок: gfilatov2002 OK! не..
gfilatov2002 OK! небольшая правка METHOD OnReSize( nWidth, nHeight, lTop ) CLASS TSBrowse LOCAL nCnt, aCol, nCol, oCol, nKfc, lRet := .F. LOCAL nColMaxKfc := 0, nW, nS, nN LOCAL nTop := iif( empty( lTop ), ::nTop, 0 ) IF Empty( nWidth ) nWidth := GetWindowWidth( ::hWnd ) ENDIF IF Empty( nHeight ) nHeight := GetWindowHeight( ::hWnd ) lTop := .T. nTop := 0 ENDIF IF _HMG_MouseState == 1 aCol := array(Len( ::aColumns )) nW := _GetClientRect( ::hWnd )[3] If ! ::lNoVScroll .and. ::nLen > ::nRowCount() nW -= GetVScrollBarWidth() EndIf For nCol := 1 To Len( ::aColumns ) ... ELSEIF _HMG_MouseState == 0 .and. ISARRAY( ::aOldParams[7] ) ... nW := _GetClientRect( ::hWnd )[3] nN := nS := 0 If ! ::lNoVScroll .and. ::nLen > ::nRowCount() nW -= GetVScrollBarWidth() EndIf For nCol := 1 To nCnt ...
| |
|
gfilatov2002
|
| moderator
|
Пост N: 1409
Зарегистрирован: 11.02.10
|
|
Отправлено: 10.12.18 16:54. Заголовок: SergKis пишет: небо..
SergKis пишет: Благодарю за помощь
| |
|
SergKis
|
| постоянный участник
|
Пост N: 2162
Зарегистрирован: 17.02.12
|
|
Отправлено: 10.12.18 16:57. Заголовок: PS Проверяю на Tsb_B..
PS Проверяю на Tsb_Basic\demo4.prg Изменения Скрытый текст
... DEFINE WINDOW Form_0 ; WIDTH 700 ; HEIGHT 600 ; TITLE "(4) TsBrowse DBASE SHARED Demo" ; MAIN ; // NOMAXIMIZE NOSIZE ; ON INIT oBr:SetFocus() ; ON RELEASE dbCloseArea( aAlias[1] ) ; ON MAXIMIZE ResizeForm( oBr ) ; ON SIZE ResizeForm( oBr ) ... Form_0.Activate RETURN FUNC ResizeForm( oBrw ) LOCAL nW := This.ClientWidth LOCAL nH := This.ClientHeight - This.StatusBar.Height oBrw:OnResize( nW - 10, nH - 5 ) RETURN Nil ... FUNCTION CreateBrowse() ... oBrw:nWheelLines := 1 oBrw:nClrLine := COLOR_GRID // цвет линий между ячейками таблицы oBrw:lNoChangeOrd := TRUE // убрать сортировку по полю oBrw:nColOrder := 0 // убрать значок сортировки по полю oBrw:lCellBrw := TRUE // oBrw:lNoVScroll := TRUE // отключить показ горизонтального скролинга oBrw:lNoHScroll := TRUE // отключить показ горизонтального скролинга oBrw:hBrush := CreateSolidBrush( 242, 245, 204 ) // цвет фона под таблицей ... STATIC FUNCTION RecInsert(oBrw) ... oBrw:GotoRec(nRecno, nRow + nPos) If ! oBrw:lNoVScroll .and. oBrw:nLen > oBrw:nRowCount() oBrw:ResetVScroll( .T. ) oBrw:oHScroll:SetRange( 0, 0 ) EndIf oBrw:nCell := 2 // передвинуть МАРКЕР на 2 колонку ...
| вроде, полет нормальный
| |
|
SergKis
|
| постоянный участник
|
Пост N: 2163
Зарегистрирован: 17.02.12
|
|
Отправлено: 10.12.18 17:10. Заголовок: gfilatov2002 Это из..
gfilatov2002 Это изменение, не давал, пропустил METHOD SetNoHoles( nDelta, lSet ) CLASS TSBrowse ... If Empty( ::aOldParams ) ::Display() aRect := _GetClientRect( ::hWnd ) If ! ::lNoVScroll .and. ::nLen > ::nRowCount() aRect[3] -= GetVScrollBarWidth() EndIf ::aOldParams := array(7) ... Else If ::lEnabled ::lEnabled := .F. EndIf ::Paint() ::lEnabled := .T. ::Refresh(.F.) If ! ::lNoVScroll .and. ::nLen > ::nRowCount() ::ResetVScroll( .T. ) ::oHScroll:SetRange( 0, 0 ) EndIf EndIf ...
| |
|
gfilatov2002
|
| moderator
|
Пост N: 1410
Зарегистрирован: 11.02.10
|
|
Отправлено: 10.12.18 18:27. Заголовок: SergKis пишет: Это ..
SergKis пишет: Спасибо
| |
|
gfilatov2002
|
| moderator
|
Пост N: 1411
Зарегистрирован: 11.02.10
|
|
Отправлено: 12.12.18 10:24. Заголовок: Обновил сборку 18.11..
Обновил сборку 18.11 ( Update 1) с учетом последних исправлений в TsBrowse Что нового: цитата: | * Enhanced: The optimized ON SIZE event detects now the mouse state. You can use the variable _HMG_MouseState for accepting of a left mouse button down (=1) or up (=0) state. Suggested and contributed by Sergej Kiselev. Revised by Grigory Filatov <gfilatov@inbox.ru> (see demo in folder \Utils\mgDBU) * New: Added the Harbour HbCurl contrib library compiled with the latest Curl and libcurl 32-bit package version 7.62.0 (30 Oct 2018). Contributed by Grigory Filatov <gfilatov@inbox.ru> (look at ReadMe.txt in folder \harbour) * Updated: Adaptation FiveWin Class TSBrowse 9.0 in HMG: - added the new method OnReSize( nWidth, nHeight, lTop ); - the improved method SetNoHoles(). Contributed by SergKis (see demo in folder \samples\Advanced\Tsb_Export) * Updated: MySql library source code (see in folder \Source\HbMySql): - added the new method affected_rows() in the class TMySQLQuery. Contributed by Attila Szabo. * Updated: 'Print Pie Graph' sample: the updated data for November 2018. Contributed by Grigory Filatov <gfilatov@inbox.ru> (see demo.prg in folder \samples\Basic\GraphPrint) * Updated: 'Internet Explorer ActiveX' sample: - updated the events processing routine for proper 64-bit handling. Contributed by Grigory Filatov <gfilatov@inbox.ru> (see in folder \samples\Advanced\ActiveX) * Updated: 'HMG_HPDF library usage' sample. Based upon a contribution of HMG user Edward. Revised by Grigory Filatov <gfilatov@inbox.ru> (see demo3.prg in folder \samples\Advanced\PDF_PRINT_3) |
|
| |
|
gfilatov2002
|
| moderator
|
Пост N: 1413
Зарегистрирован: 11.02.10
|
|
Отправлено: 20.12.18 13:34. Заголовок: Выпустил 2-е обновле..
Выпустил 2-е обновление для сборки 18.11 Что нового: цитата: | * Enhanced: Added the events support for ActiveX control. Syntax: @ <nRow>,<nCol> ACTIVEX <ControlName> ; [ OF | PARENT <ParentWindowName> ] ; WIDTH <nWidth> ; HEIGHT <nWidth> ; PROGID <cProgId> ; [ EVENTMAP <aEvents> ] ; [ CLIENTEDGE ] Or DEFINE ACTIVEX <ControlName> <...> EVENTMAP { { nEvent, [bAction | cFuncName] }, { ... } } CLIENTEDGE .T. END ACTIVEX Requested by Carlos Vargas <cvargaz[at]donboscocorp.com>. Based on a contribution of Oscar Lira <oscarlira78@hotmail.com>. Revised by Grigory Filatov <gfilatov@inbox.ru> (see demo in folder \samples\Advanced\VLC) * Modified: A StatusBar with KEYBOARD clause look was improved with using of an ownerdraw color for the status items. Contributed by Grigory Filatov <gfilatov@inbox.ru> (see demo in folder \Utils\mgDBU) * Updated: Minor correction of StatusItem refresh at modifying of FontColor, BackColor and Align properties at runtime. Contributed by Grigory Filatov <gfilatov@inbox.ru> (see demo4.prg in folder \samples\Basic\Status) * Updated: 'Internet Explorer ActiveX' sample. Contributed by Grigory Filatov <gfilatov@inbox.ru> (see in folder \samples\Advanced\ActiveX) * Updated: 'My Player' sample is based upon the VLC ActiveX Control at http://www.videolan.org/. Contributed by Grigory Filatov <gfilatov@inbox.ru> (see in folder \samples\Advanced\VLC) * Updated: 'MiniGUI DataBase Utility' sample. Contributed by Grigory Filatov <gfilatov@inbox.ru> (see in folder \Utils\mgDBU) |
|
| |
|
alex_II
|
| |
Пост N: 143
Зарегистрирован: 12.07.06
|
|
Отправлено: 25.12.18 09:50. Заголовок: на версии 18.11 программа вылетает
Перешел с версии 18.08 сразу на 18.11, программа перестала работать. Кусок исходника: hSplBox := _DefineSplitBox('Form_main') DEFINE TOOLBAR ToolBar_main BUTTONSIZE 24,24 FLAT BUTTON But_LkObo PICTURE 'obo24' ACTION lookObo(sity->ls) DROPDOWN ... END TOOLBAR _EndSplitBox() DEFINE DROPDOWN MENU BUTTON But_LkObo ITEM 'Количество месяцев просмотра' ACTION numMes() IMAGE NIL END MENU Ошибка стала возникать при вызове DROPDOWN меню Дело оказалось в строках, которые обрамляют TOOLBAR: hSplBox := _DefineSplitBox('Form_main') ... _EndSplitBox() Если эти строки закоментировать, программа работает
| |
|
gfilatov2002
|
| moderator
|
Пост N: 1414
Зарегистрирован: 11.02.10
|
|
Отправлено: 25.12.18 11:27. Заголовок: alex_II пишет: Ошиб..
alex_II пишет: цитата: | Ошибка стала возникать при вызове DROPDOWN меню |
| Если возможно, подготовьте простой пример, демонстрирующий эту ошибку. Мой контрольный пример работает нормально (см. ниже) Скрытый текст
#include "minigui.ch" Function Main DEFINE WINDOW Form_1 ; AT 0,0 ; WIDTH 640 HEIGHT 480 ; TITLE 'MiniGUI ToolBar Demo' ; ICON 'DEMO.ICO' ; MAIN ; FONT 'Arial' SIZE 10 DEFINE STATUSBAR STATUSITEM 'HMG Power Ready!' END STATUSBAR DEFINE MAIN MENU POPUP '&File' ITEM 'Get ToolBar_C Button_1' ACTION MsgInfo ( if ( Form_1.ToolBar_c.Button_1c.Value , '.T.' , '.F.' ) , 'Button_1c' ) ITEM 'Get ToolBar_C Button_2' ACTION MsgInfo ( if ( Form_1.ToolBar_c.Button_2c.Value , '.T.' , '.F.' ) , 'Button_2c' ) ITEM 'Get ToolBar_C Button_3' ACTION MsgInfo ( if ( Form_1.ToolBar_c.Button_3c.Value , '.T.' , '.F.' ) , 'Button_3c' ) SEPARATOR ITEM 'Set ToolBar_C Button_1' ACTION Form_1.ToolBar_c.Button_1c.Value := .T. ITEM 'Set ToolBar_C Button_2' ACTION Form_1.ToolBar_c.Button_2c.Value := .T. ITEM 'Set ToolBar_C Button_3' ACTION Form_1.ToolBar_c.Button_3c.Value := .T. SEPARATOR ITEM '&Exit' ACTION Form_1.Release END POPUP POPUP '&Help' ITEM '&About' ACTION MsgInfo ("MiniGUI ToolBar demo") END POPUP END MENU DEFINE SPLITBOX DEFINE TOOLBAR ToolBar_a BUTTONSIZE 45,40 FONT 'Arial' SIZE 8 FLAT BUTTON Button_1a ; CAPTION '&Undo' ; PICTURE 'button4.bmp' ; ACTION MsgInfo('Click! 1') BUTTON Button_2a ; CAPTION '&Save' ; PICTURE 'button5.bmp' ; WHOLEDROPDOWN DEFINE DROPDOWN MENU BUTTON Button_2a ITEM 'Exit' ACTION Form_1.Release ITEM 'About' ACTION MsgInfo ("MiniGUI ToolBar Demo") END MENU BUTTON Button_3a ; CAPTION '&Close' ; PICTURE 'button6.bmp' ; ACTION MsgInfo('Click! 3') ; DROPDOWN DEFINE DROPDOWN MENU BUTTON Button_3a ITEM 'Disable ToolBar 1 Button 1' ACTION Form_1.Button_1a.Enabled := .F. ITEM 'Enable ToolBar 1 Button 1' ACTION Form_1.Button_1a.Enabled := .T. END MENU END TOOLBAR /* DEFINE TOOLBAR ToolBar_b BUTTONSIZE 45,40 FONT 'ARIAL' SIZE 8 FLAT BUTTON Button_1b ; CAPTION 'More ToolBars...' ; PICTURE 'button7.bmp' ; ACTION MsgInfo('Click! 1'); BUTTON Button_2b ; CAPTION 'Button 2' ; PICTURE 'button8.bmp' ; ACTION MsgInfo('Click! 2'); SEPARATOR BUTTON Button_3b ; CAPTION 'Button 3' ; PICTURE 'button7.bmp' ; ACTION MsgInfo('Click! 3') END TOOLBAR DEFINE TOOLBAR ToolBar_c BUTTONSIZE 45,40 FONT 'Arial' SIZE 8 CAPTION 'ToolBar 3' FLAT BUTTON Button_1c ; CAPTION 'Check 1' ; PICTURE 'button4.bmp' ; ACTION MsgInfo('Hey!'); CHECK GROUP BUTTON Button_2c ; CAPTION 'Check 2' ; PICTURE 'button5.bmp' ; ACTION MsgInfo('Hey!') ; CHECK GROUP BUTTON Button_3c ; CAPTION 'Check 3' ; PICTURE 'button6.bmp' ; ACTION MsgInfo('Hey!') ; SEPARATOR; CHECK GROUP BUTTON Button_4c ; CAPTION 'Help Check' ; PICTURE 'button9.bmp' ; ACTION MsgInfo('Hey!') ; CHECK END TOOLBAR */ END SPLITBOX END WINDOW CENTER WINDOW Form_1 ACTIVATE WINDOW Form_1 Return Nil
|
| |
|
SergKis
|
| постоянный участник
|
Пост N: 2168
Зарегистрирован: 17.02.12
|
|
Отправлено: 25.12.18 11:32. Заголовок: alex_II Замените вы..
alex_II Замените вызовы функций hSplBox := _DefineSplitbox('Form_main') ... _EndSplitBox() командами DEFINE SPLITBOX HANDLE hSpl ... END SPLITBOX Запустил несколько примеров из samples со splitbox и dropdown - работают
| |
|
SergKis
|
| постоянный участник
|
Пост N: 2169
Зарегистрирован: 17.02.12
|
|
Отправлено: 25.12.18 11:36. Заголовок: gfilatov2002 Если з..
gfilatov2002 Если записать как у alex_II, то валится, запись командой работает
| |
|
alex_II
|
| |
Пост N: 144
Зарегистрирован: 12.07.06
|
|
Отправлено: 25.12.18 12:32. Заголовок: Все работает
SergKis пишет: цитата: | Замените вызовы функций hSplBox := _DefineSplitbox('Form_main') ... _EndSplitBox() командами DEFINE SPLITBOX HANDLE hSpl ... END SPLITBOX |
| Благодарю, Ваша рекомендация помогла
| |
|
gfilatov2002
|
| moderator
|
Пост N: 1415
Зарегистрирован: 11.02.10
|
|
Отправлено: 04.01.19 16:00. Заголовок: Подготовил перед Рож..
Подготовил перед Рождеством уже 5-ю бету для новой сборки библиотеки Список изменений у этой сборки следующий Скрытый текст
* Fixed: Problem with AUTOSIZE property handling in the CHECKLABEL control. Contributed by Grigory Filatov <gfilatov@inbox.ru> (see demo in folder \samples\Basic\CheckLabel_3) * Enhanced: Added 'VCENTERALIGN' clause (optional) for vertical aligning of a text in CHECKLABEL control. Contributed by Grigory Filatov <gfilatov@inbox.ru> (see demo in folder \samples\Basic\CheckLabel_2) * Modified: A Switcher control was used for managing of the logical variables in the function InputWindow(). Note: an obsolete behaviour may be restored via adding the definition of the constant HMG_LEGACY_ON to the header file minigui.ch. Contributed by Grigory Filatov <gfilatov@inbox.ru> (see demo at folder \samples\Basic\MAINDEMO_(SYNTAX_I)) * Enhanced: Added an auxiliary conversion function HMG_ClrToHTML( nClr ) --> cHtmlClr ( format "#rrggbb" ) Example: ? HMG_ClrToHTML( CLR_BLUE ) --> #000080 Contributed by Grigory Filatov <gfilatov@inbox.ru> (see Tsb2xml.prg in folder \samples\Advanced\Tsb_Brw2xml) * Updated: Adaptation FiveWin Class TSBrowse 9.0 in HMG: - fixed the processing of the variable :lNoMoveCols in the method RButtonDown(). The bug was reported by Sylvain Larche. Contributed by Grigory Filatov <gfilatov@inbox.ru> * Updated: HbSQLite3 library: - update for using SQLITE3 version 3.27.0dev (from 3.26.0). Contributed by Grigory Filatov <gfilatov@inbox.ru> * Updated: Harbour Compiler 3.2.0dev (SVN 2018-12-31 15:32): * Updated: OpenSSL wrapper for using of the version 1.0.2q. Contributed by Grigory Filatov <gfilatov@inbox.ru> (look at ReadMe.txt in folder \harbour) * Updated: HMGS-IDE v.1.4.3.5 Project Manager and Two-Way Visual Form Designer. Contributed by Grigory Filatov <gfilatov@inbox.ru> (look for what's new at changelog.txt in folder \Ide) * New: 'Switcher control for logical variables' sample. Syntax: @ <row>,<col> SWITCHER <name> [ OF <parent> ] ; HEIGHT 46 ; IMAGE { 'MINIGUI_SWITCH_ON', 'MINIGUI_SWITCH_OFF' } ; [ VALUE <cValue> ] ; [ FONT <fontname> SIZE <fontsize> ] ; [ LEFTCHECK ] [ CHECKED ] ; [ ON MOUSEHOVER <bMouseHover> ] ; [ ON MOUSELEAVE <bMouseLeave> ] ; [ ON CLICK <bMouseClick> ] Contributed by Grigory Filatov <gfilatov@inbox.ru> (see in folder \samples\Basic\CheckLabel_3) * New: 'Media Player Test' sample. Contributed by Grigory Filatov <gfilatov@inbox.ru> (see demo2.prg in folder \samples\Basic\PLAYER_1) * Updated: 'Print Pie Graph' sample: the updated data for December 2018. Windows 10 is the leader for the first time since July 2015. Contributed by Grigory Filatov <gfilatov@inbox.ru> (see demo.prg in folder \samples\Basic\GraphPrint) * Updated: 'RichEdit Extended' samples: - a correction in the function _SetFontSizeRTF(). Contributed by Pierpaolo Martinello <pier.martinello[at]alice.it> (see in folders \samples\Advanced\RicheditEx and \samples\Advanced\RicheditEx_2) * Updated: 'MiniGUI DataBase Utility' sample: - fixed a command line processing. Contributed by Grigory Filatov <gfilatov@inbox.ru> (see in folder \Utils\mgDBU) * Updated: MPM utility: - added permit of execution of a batch file with an admin privilege request. Based upon a contribution of Pierpaolo Martinello (see in folder \Utils\MPM)
|
Благодарю за Ваше внимание
| |
|
SergKis
|
| постоянный участник
|
Пост N: 2171
Зарегистрирован: 17.02.12
|
|
Отправлено: 04.01.19 21:17. Заголовок: gfilatov2002 У себя..
gfilatov2002 У себя сделал небольшую правку (расчет высоты для колонки с несколькими CRLF Static Function SetHeights( oBrw ) ... // Now for cells nHHeight := oBrw:nHeightCell For nEle := 1 TO Len( oBrw:aColumns ) ... // Default oBrw:nMemoHV := 2 If Empty(oBrw:nMemoHV) .and. Chr(13) $ cHeading oBrw:nMemoHV := Len( hb_ATokens(cHeading, Chr(13)) ) EndIf nHeight := SBGetHeight( oBrw:hWnd, hFont, 0 ) ... )
| |
|
gfilatov2002
|
| moderator
|
Пост N: 1416
Зарегистрирован: 11.02.10
|
|
Отправлено: 04.01.19 22:18. Заголовок: SergKis пишет: расч..
SergKis пишет: цитата: | расчет высоты для колонки с несколькими CRLF |
| Принято с небольшими изменениями Благодарю за Вашу помощь и внимание
| |
|
SergKis
|
| постоянный участник
|
Пост N: 2172
Зарегистрирован: 17.02.12
|
|
Отправлено: 05.01.19 00:45. Заголовок: SergKis пишет If Emp..
SergKis пишет цитата: | If Empty(oBrw:nMemoHV) .and. Chr(13) $ cHeading |
| Использую так в колонке (при работе с базой колонок, созданной заранее) :cHeading, "Адрес юридический" + CRLF + "Адрес фактический" + CRLF + "Контакты" :bData := {|| Alltrim(K_8) + chr(13) + chr(10) + ; // Adr. jur. Alltrim(K_A) + chr(13) + chr(10) + ; // Adr. fakt. Alltrim(K_C) } ) // telefon, ... ... при oBrw:nMemoHV := 1 // будет одна строка в просмотре тсб oBrw:nMemoHV := 2 // будет две строки ... oBrw:nMemoHV := 0 // будет три строки ...
| |
|
Andrey
|
| постоянный участник
|
Пост N: 6154
Зарегистрирован: 12.09.06
|
|
Отправлено: 06.01.19 20:21. Заголовок: SergKis пишет: Испо..
SergKis пишет: цитата: | Использую так в колонке (при работе с базой колонок, созданной заранее) |
| Примерчик бы маленький сделать в папку Tsb_Basic - demo5.prg ! Да и в demo3.prg правку небольшую внести: DEFINE WINDOW Form_0 ; .... TITLE "(3) TsBrowse DBASE SHARED Demo" ; .... STATUSITEM "(3) TsBrowse - network opening of the database!" WIDTH 290 FONTCOLOR BLUE
| |
|
SergKis
|
| постоянный участник
|
Пост N: 2173
Зарегистрирован: 17.02.12
|
|
Отправлено: 06.01.19 23:14. Заголовок: Andrey пишет Примерч..
Andrey пишет цитата: | Примерчик бы маленький сделать |
| Примерчик по колонкам с базой колонок был, пробуй. Вырезка из проги Скрытый текст
* ----------------------------------------------------------------------------------- * STATIC FUNC InitCols() // Создание колонок tsb * ----------------------------------------------------------------------------------- * LOCAL cR08 := 'R08' LOCAL cR09 := 'R09' LOCAL cPicKol := '99999999' LOCAL cPicCen := '9999999.99' LOCAL cPicSum := '9999999.99' Stru2Cols(R08_Stru(), cR08) // sCols( R08.B_2 , cHeading, 'Sheet' ) sCols( R08.B_2 , bDecode , {|cv| alltrim(cv) } ) sCols( R08.D_E , cHeading, 'Excel' + CRLF + 'line' ) // для документа sCols( R08.D_E , nAlign , DT_CENTER ) sCols( R08.D_E , nWidth , TxtWidth(5) ) sCols( R08.D_E , bDecode , {|nv| hb_ntos(nv) } ) sCols( R08.D_2 , cHeading, gTxt(Pavadz) + CRLF + 'Sheet' + CRLF + 'File name' ) sCols( R08.D_2 , nAlign , DT_CENTER ) sCols( R08.D_2 , nWidth , TxtWidth(25) ) sCols( R08.D_2 , bData , {|| alltrim(D_2) + chr(13) + chr(10) + ; alltrim(B_2) + chr(13) + chr(10) + ; alltrim(B_0) } ) sCols( R08.K_E1, cHeading, 'Excel' + CRLF + 'line' ) // для клиента sCols( R08.K_E1, nAlign , DT_CENTER ) sCols( R08.K_E1, nWidth , TxtWidth(5) ) sCols( R08.K_E1, bData , {|| hb_ntos(K_E1) + chr(13) + chr(10) + ; // наименование hb_ntos(K_E2) + chr(13) + chr(10) + ; // рег. nr hb_ntos(K_E3) } ) // pvn. nr sCols( R08.K_2 , cHeading, gTxt(Nosut) + CRLF + gTxt(RegNr) + CRLF + gTxt(PvnNr) ) sCols( R08.K_2 , nWidth , TxtWidth(30) ) sCols( R08.K_2 , bData , {|| Alltrim(K_2) + chr(13) + chr(10) + ; // наименование Alltrim(K_4) + chr(13) + chr(10) + ; // рег. nr Alltrim(K_6) } ) // pvn. nr sCols( R08.K_E4, cHeading, 'Excel' + CRLF + 'line' ) // для клиента адресов sCols( R08.K_E4, nAlign , DT_CENTER ) sCols( R08.K_E4, nWidth , TxtWidth(5) ) sCols( R08.K_E4, bData , {|| hb_ntos(K_E4) + chr(13) + chr(10) + ; // Adr. jur. hb_ntos(K_E5) + chr(13) + chr(10) + ; // Adr. fiz. hb_ntos(K_E6) } ) // telefon sCols( R08.K_8 , cHeading, gTxt(AdrJur) + CRLF + gTxt(AdrFiz) + CRLF + gTxt(Telef) ) sCols( R08.K_8 , nWidth , TxtWidth(30) ) sCols( R08.K_8 , bData , {|| Alltrim(K_8) + chr(13) + chr(10) + ; // Adr. jur. Alltrim(K_A) + chr(13) + chr(10) + ; // Adr. fiz. Alltrim(K_C) } ) // telefon sCols( R08.K_E4, cHeading, 'Excel' + CRLF + 'line' ) // для клиента данных банка sCols( R08.K_E4, nAlign , DT_CENTER ) sCols( R08.K_E4, nWidth , TxtWidth(5) ) sCols( R08.K_E4, bData , {|| hb_ntos(K_E1) + chr(13) + chr(10) + ; // Banka hb_ntos(K_E4) + chr(13) + chr(10) + ; // Kods hb_ntos(K_E6) } ) // Konts sCols( R08.K_E , cHeading, gTxt(Banka) + CRLF + gTxt(BankKod) + CRLF + gTxt(BankScet) ) sCols( R08.K_E , nWidth , TxtWidth(30) ) sCols( R08.K_E , bData , {|| Alltrim(K_E) + chr(13) + chr(10) + ; // Banka Alltrim(K_G) + chr(13) + chr(10) + ; // Kods Alltrim(K_I) } ) // Konts Stru2Cols(R09_Stru(), cR09) ... FUNC Child_R08( oWnd ) .. dbSelectArea(cR08) AAdd(aCols, gCols( R08.D_2 )) AAdd(aCols, gCols( R08.K_2 )) AAdd(aCols, gCols( R08.K_8 )) AAdd(aCols, gCols( R08.K_E )) DEFINE WINDOW &cWnd ; ... DEFINE TBROWSE &cBrw OBJ oBrw AT y, x ALIAS ALIAS() WIDTH w HEIGHT h CELL :hFontHead := GetFontHandle( "TsbHeader" ) :hFontFoot := GetFontHandle( "TsbFooter" ) :nWheelLines := 1 :lNoHScroll := .T. :lFooting := .T. :lDrawFooters := .T. :lNoGrayBar := .T. :lNoLiteBar := .F. :lNoResetPos := .F. :lPickerMode := .F. :nLineStyle := LINES_ALL :nClrLine := COLOR_GRID :lNoChangeOrd := .T. :nColOrder := 0 AEval( aCols, {| oc| :AddColumn( oc ) } ) :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)} ) } } ) :nMemoHV := 1 // список документов по уникальному тэгу клиента однострочный // :nMemoHV := 0 // список документов в три строки :nHeightCell -= 1 :ResetVScroll( .T. ) :oHScroll:SetRange( 0, 0 ) :AdjColumns() END TBROWSE oBrw:SetNoHoles() oBrw:SetFocus() ... Достичь того же можно и такими действиями и возможно это лучше в каких то случаях AAdd(aCols, gCols( R08.D_2 )) aCols[1]:cHeading := gTxt(Pavadz) aCols[1]:bData := {|| alltrim(D_2) } AAdd(aCols, gCols( R08.K_2 )) aCols[2]:cHeading := gTxt(Nosut) aCols[2]:bData := {|| Alltrim(K_2) } AAdd(aCols, gCols( R08.K_8 )) aCols[3]:cHeading := gTxt(AdrJur) aCols[3]:bData := {|| Alltrim(K_8) } AAdd(aCols, gCols( R08.K_E )) aCols[4]:cHeading := gTxt(Bank) aCols[4]:bData := {|| Alltrim(K_E) } ...
|
| |
|
gfilatov2002
|
| moderator
|
Пост N: 1417
Зарегистрирован: 11.02.10
|
|
Отправлено: 21.01.19 13:29. Заголовок: Выпущена новая сборк..
Выпущена новая сборка 19.01 для BCC 5.5.1 и компиляторов Harbour и xHarbour. Установщик базового дистрибутива находится по адресу http://hmgextended.com/files/CONTRIB/hmg-19.01-setup.exe Также имеются дополнительные сборки для следующих Си-компиляторов: - MinGW 8.1.0 32-bit для Harbour 3.2.0dev; (есть в наличии) - MinGW 8.2.0 64-bit для Harbour 3.4.0dev; (есть в наличии) - MS VisualC 2017 32-bit для Harbour 3.2.0dev; (путь и имя архива не изменял) - MS VisualC 2017 64-bit для Harbour 3.2.0dev; (путь и имя архива не изменял) - Borland/Embarcadero C++ 7.3 (32-bit) для Harbour 3.2.0dev. (есть в наличии). Благодарю за Ваше внимание
| |
|
SergKis
|
| постоянный участник
|
Пост N: 2176
Зарегистрирован: 17.02.12
|
|
Отправлено: 22.01.19 11:36. Заголовок: gfilatov2002 пишет ..
gfilatov2002 пишет цитата: | * Enhanced: Added an auxiliary conversion function HMG_ClrToHTML( nClr ) --> cHtmlClr ( format "#rrggbb" ) ... |
| Модификация \samples\Advanced\Tsb_Brw2xml\Tsb4xml.prg Скрытый текст
CLASS ColorN2H ... VAR nDef INIT CLR_SILVER VAR cDef INIT HMG_ClrToHTML( CLR_SILVER ) // HEX_SILVER ... METHOD Def( nDef, cDef ) CLASS ColorN2H LOCAL aClr If nDef != Nil .and. HB_ISNUMERIC(nDef) ::nDef := nDef EndIf If cDef != Nil .and. HB_ISCHAR(cDef) ::cDef := cDef EndIf aClr := { ; CLR_BLACK , ; CLR_MAROON , ; CLR_DARKRED , ; CLR_RED , ; CLR_ORANGERED , ; CLR_DARKGREEN , ; CLR_GREEN , ; CLR_OLIVE , ; CLR_DARKORANGE , ; CLR_ORANGE , ; CLR_GOLD , ; CLR_LAWNGREEN , ; CLR_LIME , ; CLR_CHARTREUSE , ; CLR_DARKGOLDENROD , ; CLR_SADDLEBROWN , ; CLR_CHOCOLATE , ; CLR_GOLDENROD , ; CLR_FIREBRICK , ; CLR_FORESTGREEN , ; CLR_OLIVEDRAB , ; CLR_BROWN , ; CLR_SIENNA , ; CLR_DARKOLIVEGREEN , ; CLR_GREENYELLOW , ; CLR_LIMEGREEN , ; CLR_YELLOWGREEN , ; CLR_CRIMSON , ; CLR_PERU , ; CLR_TOMATO , ; CLR_DARKSLATEGRAY , ; CLR_CORAL , ; CLR_SEAGREEN , ; CLR_YELLOW , ; CLR_SANDYBROWN , ; CLR_DIMGRAY , ; CLR_DARKKHAKI , ; CLR_MIDNIGHTBLUE , ; CLR_MEDIUMSEAGREEN , ; CLR_SALMON , ; CLR_DARKSALMON , ; CLR_LIGHTSALMON , ; CLR_SPRINGGREEN , ; CLR_NAVY , ; CLR_PURPLE , ; CLR_TEAL , ; CLR_GRAY , ; CLR_LIGHTCORAL , ; CLR_INDIGO , ; CLR_MEDIUMVIOLETRED , ; CLR_BURLYWOOD , ; CLR_DARKBLUE , ; CLR_DARKMAGENTA , ; CLR_DARKSLATEBLUE , ; CLR_DARKCYAN , ; CLR_TAN , ; CLR_KHAKI , ; CLR_ROSYBROWN , ; CLR_DARKSEAGREEN , ; CLR_SLATEGRAY , ; CLR_LIGHTGREEN , ; CLR_DEEPPINK , ; CLR_PALEVIOLETRED , ; CLR_PALEGREEN , ; CLR_LIGHTSLATEGRAY , ; CLR_MEDIUMSPRINGGREEN , ; CLR_CADETBLUE , ; CLR_DARKGRAY , ; CLR_LIGHTSEAGREEN , ; CLR_MEDIUMAQUAMARINE , ; CLR_PALEGOLDENROD , ; CLR_NAVAJOWHITE , ; CLR_WHEAT , ; CLR_HOTPINK , ; CLR_STEELBLUE , ; CLR_MOCCASIN , ; CLR_PEACHPUFF , ; CLR_SILVER , ; CLR_LIGHTPINK , ; CLR_BISQUE , ; CLR_PINK , ; CLR_DARKORCHID , ; CLR_MEDIUMTURQUOISE , ; CLR_MEDIUMBLUE , ; CLR_SLATEBLUE , ; CLR_BLANCHEDALMOND , ; CLR_LEMONCHIFFON , ; CLR_TURQUOISE , ; CLR_DARKTURQUOISE , ; CLR_LIGHTGOLDENRODYELLOW , ; CLR_DARKVIOLET , ; CLR_MEDIUMORCHID , ; CLR_LIGHTGRAY , ; CLR_AQUAMARINE , ; CLR_PAPAYAWHIP , ; CLR_ORCHID , ; CLR_ANTIQUEWHITE , ; CLR_THISTLE , ; CLR_MEDIUMPURPLE , ; CLR_GAINSBORO , ; CLR_BEIGE , ; CLR_CORNSILK , ; CLR_PLUM , ; CLR_LIGHTSTEELBLUE , ; CLR_LIGHTYELLOW , ; CLR_ROYALBLUE , ; CLR_MISTYROSE , ; CLR_BLUEVIOLET , ; CLR_LIGHTBLUE , ; CLR_POWDERBLUE , ; CLR_LINEN , ; CLR_OLDLACE , ; CLR_SKYBLUE , ; CLR_CORNFLOWERBLUE , ; CLR_MEDIUMSLATEBLUE , ; CLR_VIOLET , ; CLR_PALETURQUOISE , ; CLR_SEASHELL , ; CLR_FLORALWHITE , ; CLR_HONEYDEW , ; CLR_IVORY , ; CLR_LAVENDERBLUSH , ; CLR_WHITESMOKE , ; CLR_LIGHTSKYBLUE , ; CLR_LAVENDER , ; CLR_SNOW , ; CLR_MINTCREAM , ; CLR_BLUE , ; CLR_FUCHSIA , ; CLR_DODGERBLUE , ; CLR_DEEPSKYBLUE , ; CLR_ALICEBLUE , ; CLR_GHOSTWHITE , ; CLR_CYAN , ; CLR_LIGHTCYAN , ; CLR_AZURE , ; CLR_WHITE ; } AEval(aClr, {|nclr| ::oNH:Set( nclr, HMG_ClrToHTML( nclr ) ) }) ::nLenN := Len( hb_ntos(::oNH:Len) ) RETURN Self ...
| Полет HMG_ClrToHTML( nClr ) нормальный
| |
|
gfilatov2002
|
| moderator
|
Пост N: 1418
Зарегистрирован: 11.02.10
|
|
Отправлено: 22.01.19 12:11. Заголовок: SergKis пишет: Моди..
SergKis пишет: цитата: | Модификация \samples\Advanced\Tsb_Brw2xml\Tsb4xml.prg |
| Благодарю за помощь
| |
|
LYSK
|
| |
Пост N: 76
Зарегистрирован: 17.10.05
|
|
Отправлено: 24.01.19 03:14. Заголовок: Григорий, а то, что ..
Григорий, а то, что исчезли примеры ADSRDD - это так и должно быть?
| |
|
gfilatov2002
|
| moderator
|
Пост N: 1419
Зарегистрирован: 11.02.10
|
|
Отправлено: 24.01.19 11:14. Заголовок: LYSK пишет: исчезли..
LYSK пишет: В каких папках были эти примеры Насколько я помню, такие примеры всегда были дополнительные из-за необходимости включать в поставку необходимые для работы dll-ки. По ходу, обновил сборку 19.01 с учетом последних изменений (путь и имя установщика не изменились)
| |
|
LYSK
|
| |
Пост N: 77
Зарегистрирован: 17.10.05
|
|
Отправлено: 24.01.19 11:36. Заголовок: так то и была папка ..
так то и была папка ADS_RDD. "Живому тормоз-мертвечина!" как сказал классик. Появилась необходимость вжиться в программу, где индексы IDX, которых оказывается не не умеет HARBOUR ;-). И фиг было бы с ними, но какое то время старое и новое должны жить одновременно.. Вот и посмотреось в сторону локального ADS.
| |
|
Haz
|
| |
Пост N: 1435
Зарегистрирован: 20.02.11
|
|
Отправлено: 24.01.19 12:02. Заголовок: LYSK пишет: Вот и ..
LYSK пишет: цитата: | Вот и посмотреось в сторону локального ADS |
| так проблема то в чем ? в поставке rddads скорее не самый новый , но рабочий. Не обращал внимания , но неужель DBFCDX не умеет работать с IDX ??
| |
|
LYSK
|
| |
Пост N: 78
Зарегистрирован: 17.10.05
|
|
Отправлено: 24.01.19 12:44. Заголовок: Pasha вот тут https:..
| |
|
Dima
|
| |
Пост N: 7000
Зарегистрирован: 17.05.05
|
|
Отправлено: 24.01.19 13:49. Заголовок: LYSK пишет: Появила..
LYSK пишет: цитата: | Появилась необходимость вжиться в программу, где индексы IDX, которых оказывается не не умеет HARBOUR ;-). |
| Так собери ADSRDD и юзай CDX и IDX , хоть вместе , хоть отдельно....работает !
| |
|
Haz
|
| |
Пост N: 1436
Зарегистрирован: 20.02.11
|
|
Отправлено: 24.01.19 13:50. Заголовок: Dima пишет: Так соб..
Dima пишет: именно так , скачай последние сырцы и собери с ними под нужного клиента
| |
|
LYSK
|
| |
Пост N: 79
Зарегистрирован: 17.10.05
|
|
Отправлено: 24.01.19 13:55. Заголовок: Дима, там еще нужен ..
Дима, там еще нужен ADS'ный фарш, и пока что у меня не нашлось совместимого с ADSRDD. Вот в 2010 году был!
| |
|
Dima
|
| |
Пост N: 7001
Зарегистрирован: 17.05.05
|
|
Отправлено: 24.01.19 14:00. Заголовок: LYSK Всё тут (верси..
| |
|
Haz
|
| |
Пост N: 1437
Зарегистрирован: 20.02.11
|
|
Отправлено: 24.01.19 14:02. Заголовок: LYSK пишет: нужен A..
LYSK пишет: http://github.com/harbour/core/archive/master.zip в папке \core-master\contrib\rddads сырцы aceapi в поставке ads сборка примерно так set PATH=C:\borland\bcc55\bin set HB_INSTALL_PREFIX=C:\MiniGui\Harbour set HB_DIR_ADS=C:\acesdk set HB_WITH_ADS=C:\acesdk C:\MiniGui\Harbour\bin\hbmk2 rddads.hbp
| |
|
Haz
|
| |
Пост N: 1438
Зарегистрирован: 20.02.11
|
|
Отправлено: 24.01.19 14:03. Заголовок: Dima пишет: Всё тут..
Dima пишет: Мы тут наперегонки помогаем
| |
|
LYSK
|
| |
Пост N: 80
Зарегистрирован: 17.10.05
|
|
Отправлено: 24.01.19 14:05. Заголовок: За что и уважаю Клип..
За что и уважаю Клипперистов!
| |
|
SergKis
|
| постоянный участник
|
Пост N: 2179
Зарегистрирован: 17.02.12
|
|
Отправлено: 25.01.19 15:50. Заголовок: gfilatov2002 Неболь..
gfilatov2002 Небольшая добавка CLASS TWndData ... ACCESS Row INLINE GetWindowRow ( ::nHandle ) ASSIGN Row ( nVal ) INLINE _SetWindowSizePos( ::cName, nVal, , , ) ACCESS Col INLINE GetWindowCol ( ::nHandle ) ASSIGN Col ( nVal ) INLINE _SetWindowSizePos( ::cName, , nVal, , ) ACCESS Width INLINE GetWindowWidth ( ::nHandle ) ASSIGN Width ( nVal ) INLINE _SetWindowSizePos( ::cName, , , nVal, ) ACCESS Height INLINE GetWindowHeight( ::nHandle ) ASSIGN Height( nVal ) INLINE _SetWindowSizePos( ::cName, , , , nVal) ACCESS ClientWidth INLINE _GetClientRect ( ::nHandle )[ 3 ] ... CLASS TCnlData INHERIT TWndData ... ASSIGN Cargo ( xVal ) INLINE _ControlCargo( Self, , xVal ) ACCESS Row INLINE _GetControlRow ( ::cName, ::oWin:Name ) ASSIGN Row ( nVal ) INLINE _SetControlRow ( ::cName, ::oWin:Name, nVal ) ACCESS Col INLINE _GetControlCol ( ::cName, ::oWin:Name ) ASSIGN Col ( nVal ) INLINE _SetControlCol ( ::cName, ::oWin:Name, nVal ) ACCESS Width INLINE _GetControlWidth ( ::cName, ::oWin:Name ) ASSIGN Width ( nVal ) INLINE _SetControlWidth ( ::cName, ::oWin:Name, nVal ) ACCESS Height INLINE _GetControlHeight( ::cName, ::oWin:Name ) ASSIGN Height( nVal ) INLINE _SetControlHeight( ::cName, ::oWin:Name, nVal ) ...
| |
|
SergKis
|
| постоянный участник
|
Пост N: 2180
Зарегистрирован: 17.02.12
|
|
Отправлено: 27.01.19 18:23. Заголовок: gfilatov2002 Возмож..
gfilatov2002 Возможно будет интересно : C Скрытый текст
HB_FUNC( UNITSTOPIXELSX ){ int UnitsX = hb_parnl(1); DWORD dwDLU = GetDialogBaseUnits(); int cx = MulDiv( UnitsX, LOWORD( dwDLU ), 4); hb_retnl( cx ); } HB_FUNC( UNITSTOPIXELSY ){ int UnitsY = hb_parnl(1); DWORD dwDLU = GetDialogBaseUnits(); int cy = MulDiv( UnitsY, HIWORD( dwDLU ), 8); hb_retnl( cy ); }
| Class Скрытый текст
#include "minigui.ch" #include "hbclass.ch" STATIC o_Dlu2Pix * ----------------------------------------------------------------------------------- * FUNCTION oDlu2Pix( nPrcW, nPrcH ) * ----------------------------------------------------------------------------------- * If o_Dlu2Pix == NIL nPrcW := hb_defaultValue(nPrcW, 100) nPrcH := hb_defaultValue(nPrcH, 100) o_Dlu2Pix := TDlu2Pix():New( nPrcW, nPrcH ) Else If pCount() > 0 nPrcW := hb_defaultValue(nPrcW, o_Dlu2Pix:nScaleWidth ) nPrcH := hb_defaultValue(nPrcH, o_Dlu2Pix:nScaleHeight) o_Dlu2Pix:UnitsToPixels( nPrcW, nPrcH ) Endif EndIf RETURN o_Dlu2Pix #define _METHOD METHOD /////////////////////////////////////////////////////////////////////////////// CLASS TDlu2Pix //--------------------------------------------------- /////////////////////////////////////////////////////////////////////////////// VAR nUnitWidth INIT 50 VAR nUnitHeight INIT 14 // height controls GetBox, Button, ... VAR nUnitHeight2 INIT 24 // 2 height controls GetBox, Button, ... VAR nUnitGapsWidth INIT 4 // width space between controls VAR nUnitGapsHeight INIT 4 // height space between controls VAR nUnitMargWidth INIT 7 // Left, Right margin VAR nUnitMargHeight INIT 7 // Top, Bottom margin VAR nUnitWidthDT INIT 50 // for data VAR nUnitWidthDT1 INIT 60 // for data 50 * 1.2 VAR nUnitWidthDT2 INIT 75 // for data 50 * 1.3 VAR nScaleWidth INIT 100 // % width VAR nScaleHeight INIT 100 // % height VAR nPixWidth INIT 0 VAR nPixHeight INIT 0 VAR nPixHeight2 INIT 0 VAR nPixWidthDT INIT 0 VAR nPixWidthDT1 INIT 0 VAR nPixWidthDT2 INIT 0 VAR nGapsWidth INIT 0 VAR nGapsHeight INIT 0 VAR nMargWidth INIT 0 VAR nMargHeight INIT 0 METHOD New( nPrcW, nPrcH ) INLINE ( ::nScaleWidth := hb_defaultValue(nPrcW, 100), ; ::nScaleHeight := hb_defaultValue(nPrcH, 100), ; ::UnitsToPixels(), ; Self ) CONSTRUCTOR _METHOD UnitsToPixels( nPrcW, nPrcH ) METHOD DLU2PixH( nHeight, nPrc ) INLINE Round((UnitsToPixelsY(nHeight) * 13 * nPrc)/1500, 0) METHOD DLU2PixW( nWidth , nPrc ) INLINE Round((UnitsToPixelsX(nWidth ) * 13 * nPrc)/1500, 0) _METHOD Kfc( nKfcW, nKfcH ) _METHOD W ( nKfc ) _METHOD H ( nKfc ) _METHOD H2( nKfc ) _METHOD D ( nKfc ) _METHOD G ( nKfc, lW ) INLINE iif( empty( lW ), ::GW( nKfc ), ::GH( nKfc ) ) _METHOD GW( nKfc ) _METHOD GH( nKfc ) _METHOD M ( nKfc, lW ) INLINE iif( empty( lW ), ::MW( nKfc ), ::MH( nKfc ) ) _METHOD MW( nKfc ) _METHOD MH( nKfc ) ENDCLASS METHOD UnitsToPixels( nPrcW, nPrcH ) CLASS TDlu2Pix DEFAULT nPrcW := hb_defaultValue(nPrcW, ::nScaleWidth ), ; nPrcH := hb_defaultValue(nPrcH, ::nScaleHeight) ::nPixWidth := ::DLU2PixW( ::nUnitWidth , nPrcW ) ::nPixHeight := ::DLU2PixH( ::nUnitHeight , nPrcH ) ::nPixHeight2 := ::DLU2PixH( ::nUnitHeight2, nPrcH ) ::nGapsWidth := ::DLU2PixW( ::nUnitGapsWidth , nPrcW ) ::nGapsHeight := ::DLU2PixH( ::nUnitGapsHeight, nPrcH ) ::nMargWidth := ::DLU2PixW( ::nUnitMargWidth , nPrcW ) ::nMargHeight := ::DLU2PixH( ::nUnitMargHeight, nPrcH ) ::nPixWidthDT := ::DLU2PixW( ::nUnitWidthDT , nPrcW ) ::nPixWidthDT1 := ::DLU2PixH( ::nUnitWidthDT1, nPrcH ) ::nPixWidthDT2 := ::DLU2PixH( ::nUnitWidthDT2, nPrcH ) RETURN Nil METHOD Kfc( nKfcW, nKfcH ) CLASS TDlu2Pix If ! empty(nKfcW) ::nPixWidth += int( ::nPixWidth * nKfcW ) ::nPixWidthDT += int( ::nPixWidthDT * nKfcW ) ::nPixWidthDT1 += int( ::nPixWidthDT1 * nKfcW ) ::nPixWidthDT2 += int( ::nPixWidthDT2 * nKfcW ) EndIf If ! empty(nKfcH) ::nPixHeight += int( ::nPixHeight * nKfcH ) ::nPixHeight2 += int( ::nPixHeight2 * nKfcH ) EndIf RETURN Nil METHOD D( nKfc ) CLASS TDlu2Pix LOCAL nVal := ::nPixWidthDT If HB_ISNUMERIC( nKfc ) .and. nKfc > 0 If nKfc == 1; nVal := ::nPixWidthDT ElseIf nKfc == 2; nVal := ::nPixWidthDT2 ElseIf nKfc == 3; nVal := ::nPixWidthDT3 Else ; nVal := int( nKfc * nVal ) EndIf EndIf RETURN nVal METHOD W( nKfc ) CLASS TDlu2Pix LOCAL nVal := ::nPixWidth If HB_ISNUMERIC( nKfc ) .and. nKfc > 0 nVal := int( nKfc * nVal ) EndIf RETURN nVal METHOD H( nKfc ) CLASS TDlu2Pix LOCAL nVal := ::nPixHeight If HB_ISNUMERIC( nKfc ) .and. nKfc > 0 nVal := int( nKfc * nVal ) EndIf RETURN nVal METHOD H2( nKfc ) CLASS TDlu2Pix LOCAL nVal := ::nPixHeight2 If HB_ISNUMERIC( nKfc ) .and. nKfc > 0 nVal := int( nKfc * nVal ) EndIf RETURN nVal METHOD GW( nKfc ) CLASS TDlu2Pix LOCAL nVal := ::nGapsWidth If HB_ISNUMERIC( nKfc ) .and. nKfc > 0 nVal := int( nKfc * nVal ) EndIf RETURN nVal METHOD GH( nKfc ) CLASS TDlu2Pix LOCAL nVal := ::nGapsHeight If HB_ISNUMERIC( nKfc ) .and. nKfc > 0 nVal := int( nKfc * nVal ) EndIf RETURN nVal METHOD MW( nKfc ) CLASS TDlu2Pix LOCAL nVal := ::nMargWidth If HB_ISNUMERIC( nKfc ) .and. nKfc > 0 nVal := int( nKfc * nVal ) EndIf RETURN nVal METHOD MH( nKfc ) CLASS TDlu2Pix LOCAL nVal := ::nMargHeight If HB_ISNUMERIC( nKfc ) .and. nKfc > 0 nVal := int( nKfc * nVal ) EndIf RETURN nVal
| Samples\Basic\GetBox Скрытый текст
/* * MINIGUI - Harbour Win32 GUI library Demo * * Copyright 2002 Roberto Lopez <harbourminigui@gmail.com> * * HMG GETBOX demo * (C) 2006 Jacek Kubica <kubica@wssk.wroc.pl> */ #include "minigui.ch" *----------------------------- Function MAIN() *----------------------------- LOCAL oGet, oPix SET CENTURY ON SET DATE ANSI SET ShowDetailError ON SET DELETED ON SET BROWSESYNC ON oPix := oDlu2Pix() OPEN_TABLE() DEFINE FONT font_0 FONTNAME 'MS Sans Serif' SIZE 10 /*9*/ DEFAULT SET GETBOX FOCUS BACKCOLOR TO {200,255,255} SET GETBOX FOCUS FONTCOLOR TO BLUE DEFINE WINDOW Form_1 ; AT 0,0 ; WIDTH 480 HEIGHT 410 ; TITLE 'HMG GetBox Demo by Jacek Kubica <kubica@wssk.wroc.pl>' ; MAIN DEFINE GETBOX Text_1 // Alternate Syntax ROW 10 COL 10 WIDTH oPix:W(1.5) HEIGHT oPix:H() // 20 VALUE DATE() PICTURE '@K' TOOLTIP "Date Value: Must be greater or equal to "+DTOC(DATE()) VALID {|| Compare(this.value)} VALIDMESSAGE "Must be greater or equal to "+DTOC(DATE()) MESSAGE "Date Value" BACKCOLOR {{255,255,255},{255,255,200},{200,255,255}} FONTCOLOR {{0,0,0},{255,255,200},{0,0,255}} END GETBOX OBJECT oGet oGet:SetKeyEvent( VK_F5, {|o| MsgBox( 'VK_F5 : ' + cValToChar( o:VarGet() ), This.Name ) } ) oGet:SetKeyEvent( , {|o| MsgBox( 'LDblClick : ' + cValToChar( o:VarGet() ), This.Name ) } ) @ 40,10 GETBOX Text_2 OBJ oGet ; WIDTH oPix:W(1.5) ; HEIGHT oPix:H() ; // 20; VALUE 57639 ; ACTION MsgInfo( "Button Action"); TOOLTIP {"Numeric input. RANGE -100,200000 PICTURE @Z 99,999.99","Button ToolTip"}; PICTURE '@Z 99,999.99'; RANGE -100,200000; BOLD; MESSAGE "Numeric input"; VALIDMESSAGE "Value between -100 and 200000 " ; BACKCOLOR {{255,255,255},{255,255,200},{200,255,255}} ; FONTCOLOR {{0,0,0},{255,255,200},{0,0,255}} oGet:SetKeyEvent( VK_F5, {|o| MsgBox( 'VK_F5 : ' + cValToChar( o:VarGet() ), This.Name ) } ) oGet:SetKeyEvent( , {|o| MsgBox( 'LDblClick : ' + cValToChar( o:VarGet() ), This.Name ) } ) @ 78,10 GETBOX Text_3 ; VALUE "Jacek"; ACTION MsgInfo( "Button Action"); ACTION2 MsgInfo( "Button2 Action"); IMAGE {"folder.bmp","info.bmp"}; BUTTONWIDTH 24; PICTURE "@K !xxxxxxxxxxx"; TOOLTIP {"Character Input. VALID {|| ( len(alltrim(This.Value)) >= 2)} PICTURE @K !xxxxxxxxxxx ","Button ToolTip","Button 2 ToolTip"}; VALID {|| ( len(alltrim(This.Value)) >= 2)}; VALIDMESSAGE "Minimum 2 characters" ; MESSAGE "Character Input"; BACKCOLOR {{255,255,255},{255,255,200},{200,255,255}} ; FONTCOLOR {{0,0,0},{255,255,200},{0,0,255}} @ 120,10 GETBOX Text_4 WIDTH oPix:W(.2) /*30*/ HEIGHT oPix:H() ; // 20; VALUE .t.; TOOLTIP "Logical Input VALID {|| (This.Value == .t.)}"; PICTURE "Y"; VALID {|| (This.Value == .t.)}; VALIDMESSAGE "Only True is allowed here !!!"; MESSAGE "Logical Input"; BACKCOLOR {{255,255,255},{255,255,200},{200,255,255}} ; FONTCOLOR {{0,0,0},{255,255,200},{0,0,255}} @ 160,10 GETBOX Text_2a WIDTH oPix:W(1.5) HEIGHT oPix:H() ; // 20; VALUE 234123.10 ; TOOLTIP "Numeric input PICTURE @ECX) $**,***.**" ; PICTURE '@ECX) $**,***.**' ; BACKCOLOR {{255,255,255},{255,255,200},{200,255,255}} ; FONTCOLOR {{0,0,0},{255,255,200},{0,0,255}} @ 200,10 GETBOX Text_2b WIDTH oPix:W(1.5) HEIGHT oPix:H() ; // 20; VALUE "Kowalski"; PICTURE "@K !!!!!!!!!!"; ON CHANGE {|| TONE(300)}; BACKCOLOR {{255,255,255},{255,255,200},{200,255,255}} ; FONTCOLOR {{0,0,0},{255,255,200},{0,0,255}} DEFINE GETBOX Text_2c // Alternate Syntax ROW 240 COL 10 WIDTH oPix:W(1.5) HEIGHT oPix:H() // 20 VALUE "MyPass" PICTURE "@K !!!!!!!!!" BACKCOLOR {{255,255,255},{255,255,200},{200,255,255}} FONTCOLOR {{0,0,0},{255,255,200},{0,0,255}} VALID {|| ( len(alltrim(This.Value)) >= 4)} TOOLTIP "Character input PASSWORD clause is set" VALIDMESSAGE "Password must contains minimum 4 characters" MESSAGE "Enter password (min 4 char.) " PASSWORD .T. END GETBOX @ 0 ,157 FRAME Frame_1 Caption "" WIDTH 308 HEIGHT 335 @ 10,160 BROWSE Browse_1 WIDTH 300 HEIGHT 180 ; WORKAREA TEST ; BACKCOLOR {255,255,200} ; HEADERS {"Date","Numeric","Character","Logical"}; WIDTHS {70,60,99,50}; FIELDS { 'Test->Datev' , 'Test->Numeric' , 'Test->Character' , 'Test->Logical'} ; JUSTIFY {BROWSE_JTFY_LEFT,BROWSE_JTFY_RIGHT, BROWSE_JTFY_LEFT,BROWSE_JTFY_CENTER} ; FONT "MS Sans serif" SIZE 09 ; Value 1; LOCK; TOOLTIP "Double Click to edit"; ON DBLCLICK { || UnlockData( ) } ; ON CHANGE {|| ( SetProperty( "Form_1", "StatusBar", "Item", 2, alltrim(str(recno() ))),Form_1.Text_5.Refresh , Form_1.Text_6.Refresh , Form_1.Text_7.Refresh ,Form_1.Text_8.Refresh)}// @ 213,165 LABEL Label_1a VALUE "Date" BOLD AUTOSIZE @ 210,210 GETBOX Text_5 ; WIDTH oPix:D() /*75*/ HEIGHT oPix:H() ; // 20; TOOLTIP "Text_5" ; BACKCOLOR {{255,255,255},{255,255,200},{200,255,255}} ; PICTURE '@D'; FIELD test->Datev ; READONLY @ 243,165 LABEL Label_1b VALUE "Num." BOLD AUTOSIZE DEFINE GETBOX Text_6 // Alternate Syntax ROW 240 COL 210 WIDTH oPix:W() // 60 HEIGHT oPix:H() // 20 FIELD test->Numeric BACKCOLOR {{255,255,255},{255,255,200},{200,255,255}} VALID {|| (!EMPTY(This.Value).AND.This.Value<=99999)} WHEN {|| This.Value > 99} TOOLTIP "Numeric field. VALID {|| (!EMPTY(This.Value).AND.This.Value<=99999)} . WHEN {|| This.Value > 99}" READONLY .T. PICTURE "@KB 999999" END GETBOX @ 273,165 LABEL Label_1c VALUE "Char." BOLD AUTOSIZE @ 270,210 GETBOX Text_7 ; WIDTH oPix:W(1.5) /*130*/ HEIGHT oPix:H() ; // 20; BACKCOLOR {{255,255,255},{255,255,200},{200,255,255}} ; TOOLTIP "Characters field. " ; VALIDMESSAGE "Can not be empty!. VALID {|| (!EMPTY(This.Value))} . PICTURE @K !XXXXXXXXXXXXXXXX "; VALID {|| (!EMPTY(This.Value))} ; FIELD test->Character ; PICTURE "@K !XXXXXXXXXXXXXXXX"; READONLY @ 303,165 LABEL Label_1d VALUE "Logic." BOLD AUTOSIZE @ 300,210 GETBOX Text_8 ; WIDTH oPix:W(.2) /*30*/ HEIGHT oPix:H() ; // 20; BACKCOLOR {{255,255,255},{255,255,200},{200,255,255}} ; FONTCOLOR RED ; BOLD; TOOLTIP "Logical field" ; FIELD test->Logical; READONLY @ 210,360 BUTTONEX Button_1 WIDTH oPix:W() /*60*/ HEIGHT oPix:H() /*25*/ CAPTION "Save" FONTCOLOR {200,0,0} BOLD ACTION saveDateNow() @ 240,360 BUTTONEX Button_2 WIDTH oPix:W() /*60*/ HEIGHT oPix:H() /*25*/ CAPTION "Edit" FONTCOLOR {200,0,0} BOLD ACTION UnlockData() @ 270,360 BUTTONEX Button_3 WIDTH oPix:W() /*60*/ HEIGHT oPix:H() /*25*/ CAPTION "Cancel" FONTCOLOR {200,0,0} BOLD ACTION CancelData() DEFINE MAIN MENU POPUP '&Get Value' ITEM "Get Text_1 Value" ACTION MsgBox("Value: "+chr(9)+_Trans(Form_1.Text_1.Value)+CRLF+"Valtype: "+chr(9)+VALTYPE(Form_1.Text_1.Value)) MESSAGE "Vale and ValueType" ITEM "Get Text_2 Value" ACTION MsgBox("Value: "+chr(9)+_Trans(Form_1.Text_2.Value)+CRLF+"Valtype: "+chr(9)+VALTYPE(Form_1.Text_2.Value)) ITEM "Get Text_3 Value" ACTION MsgBox("Value: "+chr(9)+_Trans(Form_1.Text_3.Value)+CRLF+"Valtype: "+chr(9)+VALTYPE(Form_1.Text_3.Value)) ITEM "Get Text_4 Value" ACTION MsgBox("Value: "+chr(9)+_Trans(Form_1.Text_4.Value)+CRLF+"Valtype: "+chr(9)+VALTYPE(Form_1.Text_4.Value)) ITEM "Get Text_2a Value" ACTION MsgBox("Value: "+chr(9)+_Trans(Form_1.Text_2a.Value)+CRLF+"Valtype: "+chr(9)+VALTYPE(Form_1.Text_2a.Value)) ITEM "Get Text_2b Value" ACTION MsgBox("Value: "+chr(9)+_Trans(Form_1.Text_2b.Value)+CRLF+"Valtype: "+chr(9)+VALTYPE(Form_1.Text_2b.Value)) ITEM "Get Text_2c Value" ACTION MsgBox("Value: "+chr(9)+_Trans(Form_1.Text_2c.Value)+CRLF+"Valtype: "+chr(9)+VALTYPE(Form_1.Text_2c.Value)) END POPUP POPUP 'Get &DisplayValue' ITEM "Get Text_1 DisplayValue" ACTION MsgBox(Form_1.Text_1.DisplayValue) ITEM "Get Text_2 DisplayValue" ACTION MsgBox(Form_1.Text_2.DisplayValue) ITEM "Get Text_3 DisplayValue" ACTION MsgBox(Form_1.Text_3.DisplayValue) ITEM "Get Text_4 DisplayValue" ACTION MsgBox(Form_1.Text_4.DisplayValue) ITEM "Get Text_2a DisplayValue" ACTION MsgBox(Form_1.Text_2a.DisplayValue) ITEM "Get Text_2b DisplayValue" ACTION MsgBox(Form_1.Text_2b.DisplayValue) ITEM "Get Text_2c DisplayValue" ACTION MsgBox(Form_1.Text_2c.DisplayValue) END POPUP POPUP '&Set Value' ITEM "Set Text_1 Value" ACTION Form_1.Text_1.Value := STOD('19620210') ITEM "Set Text_2 Value" ACTION Form_1.Text_2.Value := 99999 ITEM "Set Text_3 Value" ACTION Form_1.Text_3.Value := 'janusz' ITEM "Set Text_4 Value" ACTION Form_1.Text_4.Value := .f. ITEM "Set Text_2a Value to 200.123" ACTION Form_1.Text_2a.Value := 200.123 ITEM "Set Text_2b Value to malinowski" ACTION Form_1.Text_2b.Value := 'malinowski' ITEM "Set Text_2c Value to new_pass" ACTION Form_1.Text_2c.Value := 'new_pass' END POPUP POPUP 'Set &Picture' ITEM "Set Text_1 Picture to '@D'" ACTION Form_1.Text_1.Picture:='@D' ITEM "Set Text_2 Picture to '@Z 999,999.99'" ACTION Form_1.Text_2.Picture:='@Z 999,999.99' ITEM "Set Text_3 Picture to '@K!'" ACTION Form_1.Text_3.Picture:='@K!' ITEM "Set Text_4 Picture to '@L'" ACTION Form_1.Text_4.Picture:='@L' SEPARATOR ITEM "Set Text_1 Picture to '@K'" ACTION Form_1.Text_1.Picture:='@K' ITEM "Set Text_2 Picture to '@Z 99,999.99'" ACTION Form_1.Text_2.Picture:='@Z 99,999.99' ITEM "Set Text_3 Picture to '@K !xxxxxxxxxxxxxx'" ACTION Form_1.Text_3.Picture:='@K !xxxxxxxxxxxxxx' ITEM "Set Text_4 Picture to '@Y'" ACTION Form_1.Text_4.Picture:='@Y' END POPUP POPUP 'Disable/Enable' ITEM "Enable Text_1" ACTION Form_1.Text_1.Enabled:=.t. ITEM "Enable Text_2" ACTION Form_1.Text_2.Enabled:=.t. ITEM "Enable Text_3" ACTION Form_1.Text_3.Enabled:=.t. ITEM "Enable Text_4" ACTION Form_1.Text_4.Enabled:=.t. ITEM "Enable Text_2a" ACTION Form_1.Text_2a.Enabled:=.t. ITEM "Enable Text_2b" ACTION Form_1.Text_2b.Enabled:=.t. ITEM "Enable Text_2c" ACTION Form_1.Text_2c.Enabled:=.t. SEPARATOR ITEM "Disable Text_1" ACTION Form_1.Text_1.Enabled:=.f. ITEM "Disable Text_2" ACTION Form_1.Text_2.Enabled:=.f. ITEM "Disable Text_3" ACTION Form_1.Text_3.Enabled:=.f. ITEM "Disable Text_4" ACTION Form_1.Text_4.Enabled:=.f. ITEM "Disable Text_2a" ACTION Form_1.Text_2a.Enabled:=.f. ITEM "Disable Text_2b" ACTION Form_1.Text_2b.Enabled:=.f. ITEM "Disable Text_2c" ACTION Form_1.Text_2c.Enabled:=.f. END POPUP END MENU DEFINE STATUSBAR STATUSITEM "Standard message" WIDTH 160 STATUSITEM "1" WIDTH 40 KEYBOARD END STATUSBAR END WINDOW Form_1.Button_1.Enabled:=.f. Form_1.Button_3.Enabled:=.f. Form_1.Center Form_1.Activate Return NIL *----------------------------- Function OPEN_TABLE() *----------------------------- Local i If !FILE("test.dbf") DBTESTCREATE("test") USE TEST NEW EXCLUSIVE FOR i=1 to 10 APPEND BLANK test->Datev := date()+i test->Numeric := i*10 test->Character := "Character "+ltrim(str(i)) test->Logical := ( int(i/2) == i/2 ) next i USE ENDIF USE TEST NEW SHARED Return NIL *----------------------------- Procedure UnlockData() *----------------------------- IF !RLOCK() MsgStop("Record occupied by another user") return endif Form_1.Text_5.Refresh Form_1.Text_6.Refresh Form_1.Text_7.Refresh Form_1.Text_8.Refresh Form_1.Text_5.Readonly:=.f. Form_1.Text_6.Readonly:=.f. Form_1.Text_7.Readonly:=.f. Form_1.Text_8.Readonly:=.f. Form_1.Button_1.Enabled:=.t. Form_1.Button_2.Enabled:=.f. Form_1.Button_3.Enabled:=.t. // Form_1.Browse_1.Enabled:=.f. Form_1.Text_5.SetFocus Return *----------------------------- Procedure saveDateNow() *----------------------------- IF RLOCK() Form_1.Text_5.Save Form_1.Text_6.Save Form_1.Text_7.Save Form_1.Text_8.Save UNLOCK else RETURN endif Form_1.Text_5.Readonly:=.t. Form_1.Text_6.Readonly:=.t. Form_1.Text_7.Readonly:=.t. Form_1.Text_8.Readonly:=.t. Form_1.Browse_1.Refresh Form_1.Text_5.Refresh Form_1.Text_6.Refresh Form_1.Text_7.Refresh Form_1.Text_8.Refresh Form_1.Button_1.Enabled:=.f. Form_1.Button_2.Enabled:=.t. Form_1.Button_3.Enabled:=.f. Form_1.Browse_1.Enabled:=.t. Form_1.Browse_1.SetFocus return *----------------------------- Function CancelData() *----------------------------- Form_1.Text_5.Readonly:=.t. Form_1.Text_6.Readonly:=.t. Form_1.Text_7.Readonly:=.t. Form_1.Text_8.Readonly:=.t. Form_1.Text_5.Refresh Form_1.Text_6.Refresh Form_1.Text_7.Refresh Form_1.Text_8.Refresh Form_1.Button_1.Enabled:=.f. Form_1.Button_2.Enabled:=.t. Form_1.Browse_1.Enabled:=.t. Form_1.Button_3.Enabled:=.f. Form_1.Browse_1.SetFocus UNLOCK return NIL *----------------------------- Function DBTESTCREATE(ufile) *----------------------------- Local aDbf := {} AADD (aDbf,{"Datev" , "D", 8,0}) AADD (aDbf,{"Numeric" , "N", 5,0}) AADD (aDbf,{"Character" , "C", 20,0}) AADD (aDbf,{"Logical" , "L", 1,0}) dbcreate( ufile, aDbf, 'DBFNTX' ) aDbf := {} Return NIL *----------------------------- Function Compare(dDate) *----------------------------- if empty(dDate) .or. dDate < date() return .f. endif return .t. *----------------------------- Function _Trans(xval) *----------------------------- Local RetVal:="" if VALTYPE(xVAL)=="C" RetVal := xval elseif valtype(xVal)=="D" RetVal := DTOC(xVal) elseif valtype(xVal)=="N" RetVal := alltrim(str(xVal)) elseif valtype(xVal)=="L" RetVal := if(xVal,"True","False") else RetVal := "Unknown" endif return RetVal
|
| |
|
Andrey
|
| постоянный участник
|
Пост N: 6167
Зарегистрирован: 12.09.06
|
|
Отправлено: 28.01.19 14:14. Заголовок: gfilatov2002 пишет: ..
gfilatov2002 пишет: цитата: | Выпущена новая сборка 19.01 для BCC 5.5.1 и компиляторов Harbour и xHarbour. |
| Пере собрал несколько программ. Полёт нормальный !
| |
|
gfilatov2002
|
| moderator
|
Пост N: 1420
Зарегистрирован: 11.02.10
|
|
Отправлено: 30.01.19 20:12. Заголовок: SergKis пишет: Небо..
SergKis пишет: Принято. Благодарю за помощь SergKis пишет: Да, это интересно
| |
|
SergKis
|
| постоянный участник
|
Пост N: 2181
Зарегистрирован: 17.02.12
|
|
Отправлено: 31.01.19 11:07. Заголовок: gfilatov2002 пишет Д..
gfilatov2002 пишет Тогда полный вариант примера Basic\GetBox https://my-files.ru/u0c7yv В архиве и полный вариант h_objects.prg Пример можно пробовать на разных мониторах и разрешениях. Параметры есть FontSize, ScaleWidth, ScaleHeight можно поиграть, к примеру demo.exe 14 125 110
| |
|
gfilatov2002
|
| moderator
|
Пост N: 1421
Зарегистрирован: 11.02.10
|
|
Отправлено: 31.01.19 11:52. Заголовок: SergKis пишет: полн..
SergKis пишет: цитата: | полный вариант h_objects.prg |
| Спасибо Буду разбираться...
| |
|
SergKis
|
| постоянный участник
|
Пост N: 2182
Зарегистрирован: 17.02.12
|
|
Отправлено: 31.01.19 19:38. Заголовок: gfilatov2002 Нашел,..
gfilatov2002 Нашел, что не перенес из своей раб. версии в h_objects.prg METHOD DoEvent ( Key, nHandle ) CLASS TWndData LOCAL o := Self LOCAL i := o:Index LOCAL w := o:IsWindow LOCAL p := o:oParam:Get(Key) ... IF w RETURN Do_WindowEventProcedure ( ::oEvent:Get( Key ), i, o, Key, p ) ENDIF RETURN Do_ControlEventProcedure( ::oEvent:Get( Key ), i, o, Key, p ) ...
| |
|
SergKis
|
| постоянный участник
|
Пост N: 2183
Зарегистрирован: 17.02.12
|
|
Отправлено: 31.01.19 19:43. Заголовок: PS и METHOD DoEvent..
PS и METHOD DoEvent ( Key, nHandle ) CLASS TCnlData LOCAL o := iif( hmg_IsWindowObject( nHandle ), hmg_GetWindowObject( nHandle ), Self ) RETURN Do_ControlEventProcedure( ::oEvent:Get( Key ), o:Index, o, Key, ::oParam:Get( Key ) )
| |
|
SergKis
|
| постоянный участник
|
Пост N: 2184
Зарегистрирован: 17.02.12
|
|
Отправлено: 31.01.19 19:57. Заголовок: PPS и CLASS TCnlDat..
PPS и CLASS TCnlData INHERIT TWndData ... METHOD PostMsg( nKey, xPar ) INLINE iif( ::oWin:Action, ( ::oParam:Set( nKey, xPar ), ; PostMessage( ::oWin:nHandle, ::WM_nMsgC, nKey, ::nHandle ) ), Nil ) METHOD Post ( nKey, xPar ) INLINE ::PostMsg( nKey, xPar ) METHOD SendMsg( nKey, xPar ) INLINE iif( ::oWin:Action, ( ::oParam:Set( nKey, xPar ), ; SendMessage( ::oWin:nHandle, ::WM_nMsgC, nKey, ::nHandle ) ), Nil ) METHOD Send ( nKey, xPar ) INLINE ::SendMsg( nKey, xPar ) ...
| |
|
SergKis
|
| постоянный участник
|
Пост N: 2185
Зарегистрирован: 17.02.12
|
|
Отправлено: 01.02.19 13:19. Заголовок: gfilatov2002 Если в..
gfilatov2002 Если в пример добавить ... END WITH This.Button_1.Enabled:=.f. This.Button_3.Enabled:=.f. This.Browse_1.ColumnsAutoFitH END WINDOW Form_1.Center Form_1.Activate ... то поведение browse будет нормальным, при смене параметров
| |
|
gfilatov2002
|
| moderator
|
Пост N: 1422
Зарегистрирован: 11.02.10
|
|
Отправлено: 01.02.19 13:28. Заголовок: SergKis пишет: в пр..
SergKis пишет: Принято с благодарностью Контрольный пример работает нормально
| |
|
SergKis
|
| постоянный участник
|
Пост N: 2186
Зарегистрирован: 17.02.12
|
|
Отправлено: 02.02.19 00:02. Заголовок: gfilatov2002 Слегка..
gfilatov2002 Слегка почистил пример https://my-files.ru/sz6n72 добавил управление и DublClick по getboxам записи из browse для включения edit.
| |
|
gfilatov2002
|
| moderator
|
Пост N: 1423
Зарегистрирован: 11.02.10
|
|
Отправлено: 02.02.19 12:23. Заголовок: SergKis пишет: почи..
SergKis пишет: Благодарю за помощь
| |
|
SergKis
|
| постоянный участник
|
Пост N: 2187
Зарегистрирован: 17.02.12
|
|
Отправлено: 02.02.19 23:24. Заголовок: gfilatov2002 Перебр..
gfilatov2002 Перебрал пример https://my-files.ru/6muluk 1. перевел на события, включая меню и browse 2. в DEF GET ввел ON DBLCLICK ... и ON KEY ... вместо KEYEVENT ... (см. Text_1, Text_2) 3. ввел параметр фонта, т.е. можно пробовать запуски с разными фонтами: demo.exe 16 140 120 demo.exe 14 125 110 demo.exe 16 135 120 Arial demo.exe 14 120 110 Arial ...
| |
|
SergKis
|
| постоянный участник
|
Пост N: 2188
Зарегистрирован: 17.02.12
|
|
Отправлено: 03.02.19 07:51. Заголовок: PS пропустил несколь..
PS пропустил несколько событий (исп. параметра) ... DEF GET Text_2b GAPS {0, 2.0, , 2.0} ROWS ; VALUE "Kowalski"; PICTURE "@K !!!!!!!!!!"; ON CHANGE (ThisWindow.Object):Post(13, , 300) ; // TONE(300) BACKCOLOR :O:BColorGet ; FONTCOLOR :O:FColorGet ... DEF BTNEX OButton_4 GAPS {0, , , 2.0} ROWS HEIGHT :H1 * 2 ; ... BACKCOLOR WHITE ; ACTION (ThisWindow.Object):Post(13, , 800) ; // TONE(800) TOOLTIP "horizontal Bitmap BUTTONEX 4" ... :Y := This.Text_2b.Row + :GapsHeight DEF SAY Label_1a COLS WIDTH :O:nBrwSayLen VALUE "Date" BOLD DEF GET Text_5 ROWS WIDTH :D ; FIELD test->Datev ; ON LOSTFOCUS LostFocus2Get() ; ON DBLCLICK (ThisWindow.Object):Post(12, This.Text_5.Index) ; //DublClick2Get() ; TOOLTIP "Text_5. DublClick --> Edit" ; BACKCOLOR :O:BColorGet ; PICTURE '@D'; GOTFOCUSSELECT ; READONLY :X := :O:nLeft2 DEF SAY Label_1b COLS WIDTH :O:nBrwSayLen VALUE "Num." BOLD DEF GET Text_6 ROWS WIDTH 1 ; FIELD test->Numeric ; ON LOSTFOCUS LostFocus2Get() ; ON DBLCLICK (ThisWindow.Object):Post(12, This.Text_6.Index) ; // DublClick2Get() ; TOOLTIP "Numeric field. VALID {|| (!EMPTY(This.Value).AND.This.Value<=99999)} . WHEN {|| This.Value > 99}" ; BACKCOLOR :O:BColorGet ; PICTURE "@KB 999999"; VALID {|| (!EMPTY(This.Value).AND.This.Value<=99999)} ; WHEN {|| This.Value > 99} ; GOTFOCUSSELECT ; READONLY :X := :O:nLeft2 DEF SAY Label_1c COLS WIDTH :O:nBrwSayLen VALUE "Char." BOLD DEF GET Text_7 ROWS COLS ; FIELD test->Character ; ON LOSTFOCUS LostFocus2Get() ; ON DBLCLICK (ThisWindow.Object):Post(12, This.Text_7.Index) ; // DublClick2Get() ; TOOLTIP "Characters field. DublClick --> Edit" ; VALIDMESSAGE "Can not be empty!. VALID {|| (!EMPTY(This.Value))} . PICTURE @K !XXXXXXXXXXXXXXXX "; VALID {|| (!EMPTY(This.Value))} ; PICTURE "@K !XXXXXXXXXXXXXXXX"; BACKCOLOR :O:BColorGet ; GOTFOCUSSELECT ; READONLY :O:nLeft3 := :X + :GapsWidth :X := :O:nLeft2 DEF SAY Label_1d COLS WIDTH :O:nBrwSayLen VALUE "Logic." BOLD DEF GET Text_8 ROWS WIDTH :O:nBoolLen ; FIELD test->Logical; ON LOSTFOCUS LostFocus2Get() ; ON DBLCLICK (ThisWindow.Object):Post(12, This.Text_8.Index) ; //DublClick2Get() ; BACKCOLOR :O:BColorGet ; FONTCOLOR :O:FColor2 ; BOLD; TOOLTIP "Logical field. DublClick --> Edit" ; CENTERALIGN ; READONLY ... :Event(10, {| | This.Enabled := .F., This.Browse_1.SetFocus } ) // :Event(11, {| | This.Enabled := .T., This.Browse_1.SetFocus } ) :Event(11, {| | This.Enabled := .T., This.SetFocus } ) // так интереснее :Event(12, {| | DublClick2Get() } ) :Event(13, {|ow,ky,np| TONE( np ) } ) END WITH ...
| |
|
SergKis
|
| постоянный участник
|
Пост N: 2189
Зарегистрирован: 17.02.12
|
|
Отправлено: 03.02.19 08:12. Заголовок: PPS ON DBLCLICK (Thi..
PPS ON DBLCLICK (ThisWindow.Object):Post(12, This.Text_8.Index) ; //DublClick2Get() ; Такая форма записи, а не This.Index, исп. по причине отсутствия инф. о контроле, т.к. блок кода выполняется в TGET. Переданный индекс контрола, в событии создает среду This для указанного контрола. Если не передавать индекс, то среда This будет только для окна
| |
|
SergKis
|
| постоянный участник
|
Пост N: 2190
Зарегистрирован: 17.02.12
|
|
Отправлено: 03.02.19 15:35. Заголовок: gfilatov2002 можно ..
gfilatov2002 можно зарезервировать для исп. в событиях о Петра MESSAGEONLY _App_Wnd_App_ EVENTS _App_Wnd_Events_ TO h и METHOD PostMsg( nKey, nPar ) INLINE PostMessage( ::hWnd, WM_APP_LAUNCH, nKey, hb_defaultValue( nPar, 0 ) ) METHOD SendMsg( nKey, nPar ) INLINE SendMessage( ::hWnd, WM_APP_LAUNCH, nKey, hb_defaultValue( nPar, 0 ) ) #define WM_WND_LAUNCH (WM_USER+1044) #define WM_CTL_LAUNCH (WM_USER+1045) #define WM_APP_LAUNCH (WM_USER+1046)
| |
|
SergKis
|
| постоянный участник
|
Пост N: 2191
Зарегистрирован: 17.02.12
|
|
Отправлено: 03.02.19 17:43. Заголовок: gfilatov2002 Исправл..
gfilatov2002 Исправление, что бы в приоритете был индекс контрола, потом handle (было наоборот) METHOD DoEvent ( Key, nHandle ) CLASS TWndData LOCAL o := Self LOCAL i := o:Index LOCAL w := o:IsWindow LOCAL p := o:oParam:Get(Key) IF ! Empty( nHandle ) IF nHandle > 0 .and. nHandle <= Len( _HMG_aControlHandles ) // control index IF hmg_IsWindowObject( _HMG_aControlHandles[ nHandle ] ) o := hmg_GetWindowObject( _HMG_aControlHandles[ nHandle ] ) i := o:Index w := o:IsWindow ELSE i := nHandle w := .F. ENDIF ELSEIF hmg_IsWindowObject( nHandle ) // control handle o := hmg_GetWindowObject( nHandle ) i := o:Index w := o:IsWindow ENDIF ENDIF IF w RETURN Do_WindowEventProcedure ( ::oEvent:Get( Key ), i, o, Key, p ) ENDIF RETURN Do_ControlEventProcedure( ::oEvent:Get( Key ), i, o, Key, p )
| |
|
SergKis
|
| постоянный участник
|
Пост N: 2192
Зарегистрирован: 17.02.12
|
|
Отправлено: 03.02.19 20:02. Заголовок: gfilatov2002 Еще, из..
gfilatov2002 Еще, измените код, а то мелькает в левом верхнем углу FUNCTION HMG_Alert( cMsg, aOptions, cTitle, nType, cIcoFile, nIcoSize ) ... DEFINE WINDOW oDlg WIDTH 0 HEIGHT 0 ; TITLE cTitle ; MODAL NOSIZE // ON INIT FillDlg( cMsg, aOptions, nLineas, cIcoFile, nIcoSize ) END WINDOW FillDlg( cMsg, aOptions, nLineas, cIcoFile, nIcoSize ) ACTIVATE WINDOW oDlg ...
| |
|
gfilatov2002
|
| moderator
|
Пост N: 1424
Зарегистрирован: 11.02.10
|
|
Отправлено: 03.02.19 20:39. Заголовок: SergKis пишет: можн..
SergKis пишет: Cделал SergKis пишет: цитата: | что бы в приоритете был индекс контрола |
| Принято SergKis пишет: цитата: | мелькает в левом верхнем углу |
| Благодарю за помощь!
| |
|
SergKis
|
| постоянный участник
|
Пост N: 2193
Зарегистрирован: 17.02.12
|
|
Отправлено: 03.02.19 22:23. Заголовок: gfilatov2002 пишет С..
| |
|
SergKis
|
| постоянный участник
|
Пост N: 2194
Зарегистрирован: 17.02.12
|
|
Отправлено: 04.02.19 09:59. Заголовок: gfilatov2002 Предло..
gfilatov2002 Предложение. Вынести за скобки #ifdef _OBJECT_ процедуры 1. FUNCTION Do_WindowEventProcedure( bBlock, i, p1, p2, p3, p4 ) FUNCTION Do_ControlEventProcedure( bBlock, i, p1, p2, p3, p4 ) 2. #command ACTIVATE WINDOW <name, ...> [ <nowait: NOWAIT> ] ; [ INIT <bInit> ] ; => ; _ActivateWindow ( \{<(name)>\}, <.nowait.>, , <{bInit}> ) #command ACTIVATE WINDOW ALL [ INIT <bInit> ] ; => ; _ActivateAllWindows ( <{bInit}> ) 3. *-----------------------------------------------------------------------------* FUNCTION _ActivateWindow ( aForm, lNoWait, lDebugger, bInit ) *-----------------------------------------------------------------------------* ... * Look For Main Window FOR EACH FormName IN aForm i := GetFormIndex ( FormName ) IF HB_ISBLOCK( bInit ) Do_WindowEventProcedure( bInit, i, 'WINDOW_ACTIVATE' ) ENDIF IF _HMG_aFormType [ i ] == 'A' MainFound := .T. EXIT ENDIF NEXT ... *-----------------------------------------------------------------------------* FUNCTION _ActivateAllWindows ( bInit ) *-----------------------------------------------------------------------------* ... AAdd ( aForm, MainName ) _ActivateWindow ( aForm, , , bInit ) RETURN NIL ... Использовать после END WINDOW среду This. Form_1.Center // Form_1.Activate ACTIVATE WINDOW Form_1 INIT _logfile(.T., This.Name, _HMG_Value()) ...
| |
|
SergKis
|
| постоянный участник
|
Пост N: 2195
Зарегистрирован: 17.02.12
|
|
Отправлено: 04.02.19 11:05. Заголовок: gfilatov2002 Правка..
gfilatov2002 Правка. CLASS TDlu2Pix ... ASSIGN Handle( hWnd ) INLINE ( ::hWnd := hWnd, ::lError := Empty( hWnd ), ; iif( ::lError, MsgMiniGuiError("Application events are not created !"), ) ) ACCESS IsError INLINE ::lError ACCESS Wm_nApp INLINE WM_APP_LAUNCH ACCESS IsMsg INLINE ( ::lAction .and. ! ::lError ) ... METHOD Post ( nKey, nPar, xPar ) INLINE ::PostMsg( nKey, nPar, xPar ) METHOD PostMsg( nKey, nPar, xPar ) INLINE ( nPar := hb_defaultValue(nPar, 0), ; iif( ::IsMsg, ( ::oParam:Set( nKey, xPar ), ; PostMessage( ::hWnd, ::Wm_nApp, nKey, nPar ) ), Nil ) ) METHOD Send ( nKey, nPar, xPar ) INLINE ::SendMsg( nKey, nPar, xPar ) METHOD SendMsg( nKey, nPar, xPar ) INLINE ( nPar := hb_defaultValue(nPar, 0), ; iif( ::IsMsg, ( ::oParam:Set( nKey, xPar ), ; SendMessage( ::hWnd, ::Wm_nApp, nKey, nPar ) ), Nil ) ) ...
| |
|
gfilatov2002
|
| moderator
|
Пост N: 1425
Зарегистрирован: 11.02.10
|
|
Отправлено: 04.02.19 11:27. Заголовок: SergKis пишет: Пред..
SergKis пишет: Сделал, конечно. Только изменил кодовое слово INIT на ON INIT SergKis пишет: Благодарю за помощь
| |
|
SergKis
|
| постоянный участник
|
Пост N: 2196
Зарегистрирован: 17.02.12
|
|
Отправлено: 04.02.19 11:33. Заголовок: gfilatov2002 Еще, е..
gfilatov2002 Еще, если добавить CLASS TWndData ... ACCESS App INLINE ::oApp ACCESS AO INLINE ::oApp:oCargo ACCESS AP INLINE ::oApp:oProp ... можно писать короче WITH OBJECT This.Object :O:BColorGet := :AO:BColorGet // (App.Object):O:BColorGet :O:FColorGet := :AO:FColorGet // (App.Object):O:FColorGet :O:FColor1 := :AO:FColor1 // (App.Object):O:FColor1 :O:FColor2 := :AO:FColor2 // (App.Object):O:FColor2
| |
|
gfilatov2002
|
| moderator
|
Пост N: 1426
Зарегистрирован: 11.02.10
|
|
Отправлено: 04.02.19 11:39. Заголовок: SergKis пишет: ..
SergKis пишет: цитата: | ACCESS AO INLINE ::oApp:oCargo ACCESS AP INLINE ::oApp:oProp |
| OK
| |
|
SergKis
|
| постоянный участник
|
Пост N: 2197
Зарегистрирован: 17.02.12
|
|
Отправлено: 04.02.19 11:39. Заголовок: gfilatov2002 Пропус..
gfilatov2002 Пропустил строки CLASS TDlu2Pix ... ACCESS IsMsg INLINE ( ::lAction .and. ! ::lError ) ACCESS Action INLINE ::lAction ASSIGN Action( lAction ) INLINE ::lAction := !( Empty( lAction ) ) ...
| |
|
gfilatov2002
|
| moderator
|
Пост N: 1427
Зарегистрирован: 11.02.10
|
|
Отправлено: 04.02.19 11:42. Заголовок: SergKis пишет: ..
SergKis пишет: цитата: | ACCESS Action INLINE ::lAction ASSIGN Action( lAction ) INLINE ::lAction := !( Empty( lAction ) ) |
| OK
| |
|
SergKis
|
| постоянный участник
|
Пост N: 2198
Зарегистрирован: 17.02.12
|
|
Отправлено: 05.02.19 08:25. Заголовок: gfilatov2002 Неболь..
gfilatov2002 Небольшая правка CLASS TDlu2Pix ... METHOD Event( Key, Block, p2, p3 ) INLINE iif( HB_ISBLOCK( Block ), ; ::oEvent:Set( Key, Block ), ; ( Block := hb_defaultValue(Block, ::oParam:Get( Key)), ; ::oEvent:Do ( Key, Block, p2, p3 ) ) ) ... и пример https://my-files.ru/em7ci6
| |
|
gfilatov2002
|
| moderator
|
Пост N: 1428
Зарегистрирован: 11.02.10
|
|
Отправлено: 05.02.19 11:38. Заголовок: SergKis пишет: Небо..
SergKis пишет: Добавил Но модуль h_objects.prg в Вашем примере - без последних изменений
| |
|
SergKis
|
| постоянный участник
|
Пост N: 2199
Зарегистрирован: 17.02.12
|
|
Отправлено: 05.02.19 11:52. Заголовок: gfilatov2002 Сори, ..
| |
|
SergKis
|
| постоянный участник
|
Пост N: 2204
Зарегистрирован: 17.02.12
|
|
Отправлено: 08.02.19 10:21. Заголовок: gfilatov2002 Можно ..
gfilatov2002 Можно добавить Скрытый текст
CLASS TDlu2Pix ... VAR nL INIT 0 VAR nT INIT 0 VAR nR INIT 0 VAR nB INIT 0 ... _METHOD GetGaps( aGaps, oWnd ) _METHOD D ( nKfc ) ... ACCESS Bottom INLINE ::MH() ACCESS LTRB INLINE { ::nL, ::nT, ::nR, ::nB } ... METHOD GetGaps( aGaps, oWnd ) CLASS TDlu2Pix LOCAL oApp, nGapW, nGapH, n If HB_ISCHAR(oWnd); oWnd := _WindowObj(oWnd) EndIf oApp := iif( Empty(oWnd), Self , oWnd:App ) nGapW := iif( Empty(oWnd), oApp:GapsWidth , oWnd:GapsWidth ) nGapH := iif( Empty(oWnd), oApp:GapsHeight, oWnd:GapsHeight ) If HB_ISNUMERIC(aGaps) n := aGaps aGaps := array(4) AFill(aGaps, n) EndIf DEFAULT aGaps := { 0, 0, nGapW, nGapH } ::nL := 0 ::nT := 0 ::nR := 0 ::nB := 0 If Len(aGaps) == 2 If ! HB_ISNUMERIC(aGaps[1]); aGaps[1] := nGapW EndIf If ! HB_ISNUMERIC(aGaps[2]); aGaps[2] := nGapH EndIf ::nL := aGaps[1] ::nR := aGaps[1] ::nT := aGaps[2] ::nB := aGaps[2] Else If Len(aGaps) != 4; ASize(aGaps, 4) EndIf If ! HB_ISNUMERIC(aGaps[1]); aGaps[1] := nGapW EndIf If ! HB_ISNUMERIC(aGaps[2]); aGaps[2] := nGapH EndIf If ! HB_ISNUMERIC(aGaps[3]); aGaps[3] := nGapW EndIf If ! HB_ISNUMERIC(aGaps[4]); aGaps[4] := nGapH EndIf ::nL := aGaps[1] ::nT := aGaps[2] ::nR := aGaps[3] ::nB := aGaps[4] EndIf If '.' $ hb_ntos(::nL); ::nL := oApp:GW( ::nL ) EndIf If '.' $ hb_ntos(::nT); ::nT := oApp:GH( ::nT ) EndIf If '.' $ hb_ntos(::nR); ::nR := oApp:GW( ::nR ) EndIf If '.' $ hb_ntos(::nB); ::nB := oApp:GH( ::nB ) EndIf aGaps[1] := ::nL aGaps[2] := ::nT aGaps[3] := ::nR aGaps[4] := ::nB RETURN aGaps ... Тогда в примере demo_misc.prg #include "demo.ch" *-----------------------------------------------------------------------------* FUNCTION _SetGaps( aGaps, oWnd ) *-----------------------------------------------------------------------------* RETURN (App.Object):GetGaps( aGaps, oWnd ) ...
| Пример https://my-files.ru/nljgq8
| |
|
gfilatov2002
|
| moderator
|
Пост N: 1429
Зарегистрирован: 11.02.10
|
|
Отправлено: 08.02.19 11:06. Заголовок: SergKis пишет: Можн..
SergKis пишет: OK
| |
|
SergKis
|
| постоянный участник
|
Пост N: 2205
Зарегистрирован: 17.02.12
|
|
Отправлено: 08.02.19 22:14. Заголовок: gfilatov2002 Мысли ..
gfilatov2002 Мысли вслух. Если вынести oDlu2Pixel(...) и класс TDlu2Pix за скобки #ifdef _OBJECT_, то можно Скрытый текст
i_altsyntax.ch #xcommand END BUTTON [ ON INIT <bInit> ] ; ... _HMG_ActiveControlId, ; <bInit> ) ) ... #xcommand END BUTTONEX [ ON INIT <bInit> ] ; ... _HMG_ActiveControlHorizontal,; <bInit> ) ... #xcommand END GETBOX [<o: OBJ,OBJECT> <var>] [ ON INIT <binit> ] ; ... .NOT. _HMG_ActiveControlBorder,; <binit> ) ... #xcommand END LABEL [ ON INIT <bInit> ] ; ... _HMG_ActiveControlId,; <bInit> ) ... i_button.ch ... #xcommand @ <row>,<col> BUTTONEX <name> ; ... [ <default: DEFAULT> ] ; [ ON INIT <bInit> ] ; ... <imageheight>, <aGradInfo>, <.horizontal.>, <bInit> ) ... i_getbox.ch ... #command @ <row>, <col> GETBOX <name> ; ... [ HELPID <helpid> ] ; [ ON INIT <bInit> ] ; ... <{action2}>, <abitmap>, <btnwidth>, <.nominus.>, <.noborder.>, <bInit> ) ... i_label.ch ... #command @ <row>,<col> LABEL <name> ; ... [ <noprefix: NOPREFIX> ] ; [ ON INIT <bInit> ] ; ... <nId>, ; <bInit> ) ... h_button.prg ... FUNCTION _DefineOwnerButton ( ControlName, ParentForm, x, y, Caption, ; ... ladjust, handcursor, imagewidth, imageheight, aGradInfo, lhorizontal, bInit ) ... LOCAL k LOCAL oc, ow ... IF _HMG_lOOPEnabled Eval ( _HMG_bOnControlInit, k, mVar ) ow := _WindowObj ( ParentForm ) oc := _ControlObj( ControlHandle ) ENDIF Do_ControlEventProcedure ( bInit, k, oc, ow ) RETURN Nil ... h_getbox.prg ... FUNCTION _DefineGetBox ( ControlName, ParentFormName, x, y, w, h, Value, ; ... when, ProcedureName, ProcedureName2, abitmap, BtnWidth, lNoMinus, noborder, ; bInit ) ... LOCAL k, Style, aPicData, oGet LOCAL oc, ow ... IF _HMG_lOOPEnabled Eval ( _HMG_bOnControlInit, k, mVar ) ow := _WindowObj ( ParentFormHandle ) oc := _ControlObj( ControlHandle ) ENDIF Do_ControlEventProcedure ( bInit, k, oGet, oc, ow ) RETURN oGet ... h_label.prg ... FUNCTION _DefineLabel ( ControlName, ParentFormName, x, y, Caption, w, h, ; ... LOCAL lDialogInMemory LOCAL oc, ow ... IF autosize == .T. .AND. .NOT. lDialogInMemory _SetControlWidth ( ControlName , ParentFormName , GetTextWidth( NIL, Caption, FontHandle ) + ; iif( bold == .T. .OR. italic == .T., GetTextWidth( NIL, " ", FontHandle ), 0 ) ) _SetControlHeight ( ControlName , ParentFormName , FontSize + iif( FontSize < 14, 12, 16 ) ) ENDIF IF _HMG_lOOPEnabled Eval ( _HMG_bOnControlInit, k, mVar ) ow := _WindowObj ( ParentFormHandle ) oc := _ControlObj( ControlHandle ) ENDIF Do_ControlEventProcedure ( bInit, k, oc, ow ) RETURN Nil ... и т.д. Тогда в примере так пишем demo.prg ... // :Y += :GapsHeight :X := :Left DEFINE GETBOX Text_2c // Alternate Syntax ROW :Y += :GapsHeight COL :X WIDTH :W() HEIGHT :H() VALUE "MyPass" PICTURE "@K !!!!!!!!!" BACKCOLOR :O:BColorGet FONTCOLOR :O:FColorGet VALID {|| ( len(alltrim(This.Value)) >= 4)} TOOLTIP "Character input PASSWORD clause is set" VALIDMESSAGE "Password must contains minimum 4 characters" MESSAGE "Enter password (min 4 char.) " PASSWORD .T. END GETBOX ON INIT {|og,oc,ow| ow:Y += This.Height + ow:GapsHeight } // :Y += This.Text_2c.Height + :GapsHeight :O:aFrm[4] := :Y - :O:aFrm[1] ... По др. контролам аналогично. Используется среда контрола в ON INIT.
|
| |
|
SergKis
|
| постоянный участник
|
Пост N: 2206
Зарегистрирован: 17.02.12
|
|
Отправлено: 08.02.19 22:23. Заголовок: PS Оборвалась переда..
| |
|
SergKis
|
| постоянный участник
|
Пост N: 2207
Зарегистрирован: 17.02.12
|
|
Отправлено: 08.02.19 22:26. Заголовок: PPS опять 504 Gatewa..
PPS опять 504 Gateway Time-out, но передача прошла.
| |
|
SergKis
|
| постоянный участник
|
Пост N: 2208
Зарегистрирован: 17.02.12
|
|
Отправлено: 09.02.19 06:26. Заголовок: gfilatov2002 Привел..
| |
|
krutoff
|
| |
Пост N: 193
Зарегистрирован: 17.10.05
|
|
Отправлено: 09.02.19 13:03. Заголовок: GetBox WindowType Panel
Давно борюсь с ситуацией, когда у GetBox не работает вызов VALID в окне PANEL. Вышел на h_getbox.prg строка 528: IF _IsChildOfActiveWindow( hWnd ) .AND. !readonly .AND. lAllowEdit Если я закоментирую вызов функции _IsChildOfActiveWindow -> то VALID отрабатывает! IF /*_IsChildOfActiveWindow( hWnd ) .AND.*/ !readonly .AND. lAllowEdit Я не совсем понимаю, что эта функция делает, но функция присутствует в h_window.prg и вызывается только один раз и только для GetBox. Для показа этой ситуации можно в примере MiniGUI\SAMPLES\BASIC\CONTAINERS\Panel\demo1.prg в строке 50 вместо TEXTBOX изменить DEFINE TEXTBOX TEXT_1 на: 120,10 GETBOX GET_1 VALUE 'GetBox' VALID {|| MsgYesNo('GetValid: '+Win_2.Get_1.Value)}
| |
|
SergKis
|
| постоянный участник
|
Пост N: 2210
Зарегистрирован: 17.02.12
|
|
Отправлено: 09.02.19 17:27. Заголовок: krutoff пишет Если я..
krutoff пишет цитата: | Если я закоментирую вызов функции _IsChildOfActiveWindow |
| Есть такая блокировка работы GetBox, возможно оправданная. К примеру имеем не менее 3-х окон MdiChild и ввод в GetBox на одном из окон, после Enter focus улетает на др. окна. Используйте TEXTBOX с такой конструкцией DEFINE TEXTBOX TEXT_1 ROW 120 COL 10 VALUE 'Test' ON CHANGE {|| This.Cargo := .T. } ON LOSTFOCUS {|| Valid1() } ON ENTER {|| _PushKey(VK_TAB) } END TEXTBOX This.TEXT_1.Cargo := .F. // no change ... STAT FUNC Valid1() If This.Cargo // change textbox If 'get' $ This.Value MsgBox('Error value '+ This.Value, 'ERROR') This.SetFocus Else This.Cargo := .F. EndIf EndIf RETURN Nil
| |
|
SergKis
|
| постоянный участник
|
Пост N: 2212
Зарегистрирован: 17.02.12
|
|
Отправлено: 09.02.19 17:58. Заголовок: PS c GetBox-сами про..
PS c GetBox-сами проверку valid надо проделывать на кнопке OK, пробежав по всем и переключая фокус на Getbox с ошибкой
| |
|
gfilatov2002
|
| moderator
|
Пост N: 1430
Зарегистрирован: 11.02.10
|
|
Отправлено: 09.02.19 20:20. Заголовок: SergKis пишет: В пр..
SergKis пишет: цитата: | В примере поправил StatusBar |
| При попытке скачать этот пример получаю Можно повторно выложить этот архив
| |
|
SergKis
|
| постоянный участник
|
Пост N: 2213
Зарегистрирован: 17.02.12
|
|
Отправлено: 09.02.19 20:40. Заголовок: gfilatov2002 Тут ht..
| |
|
gfilatov2002
|
| moderator
|
Пост N: 1431
Зарегистрирован: 11.02.10
|
|
Отправлено: 09.02.19 21:12. Заголовок: SergKis пишет: Тут ..
SergKis пишет: Спасибо! С этими изменениями пример у меня отработал нормально, надписи в статусбаре не искажаются
| |
|
gfilatov2002
|
| moderator
|
Пост N: 1432
Зарегистрирован: 11.02.10
|
|
Отправлено: 09.02.19 21:17. Заголовок: SergKis пишет: Мысл..
SergKis пишет: цитата: | Мысли вслух. Если вынести oDlu2Pixel(...) и класс TDlu2Pix за скобки |
| SergKis пишет: цитата: | Используется среда контрола в ON INIT |
| Не уверен, что требуются такие изменения во всех контролах
| |
|
SergKis
|
| постоянный участник
|
Пост N: 2214
Зарегистрирован: 17.02.12
|
|
Отправлено: 09.02.19 21:19. Заголовок: gfilatov2002 Обрати..
gfilatov2002 Обратите внимание на DEFINE GETBOX Text_2c // Alternate Syntax ... END GETBOX ON INIT {|| :Y += This.Height + :GapsHeight } // ON INIT {|og,ow,oc| ow:Y += oc:Height + ow:GapsHeight } // :Y += This.Text_2c.Height + :GapsHeight // !!! это использовать, убрав выше ... Пробовал "Мысли в слух". Для сборки надо убрать ON INIT, открыв строку приращения координаты
| |
|
gfilatov2002
|
| moderator
|
Пост N: 1433
Зарегистрирован: 11.02.10
|
|
Отправлено: 09.02.19 21:29. Заголовок: SergKis пишет: Для ..
SergKis пишет: цитата: | Для сборки надо убрать ON INIT |
| Благодарю за напоминание Да, конечно, я это сделал - иначе бы пример не запустился
| |
|
SergKis
|
| постоянный участник
|
Пост N: 2215
Зарегистрирован: 17.02.12
|
|
Отправлено: 09.02.19 22:01. Заголовок: gfilatov2002 пишет Н..
gfilatov2002 пишет цитата: | Не уверен, что требуются такие изменения во всех контролах |
| В своей версии 2.07 сделал контролы, перечисленные выше + в TsBrowse сделал #xcommand DEFINE TBROWSE <name> OBJ <obrw> ; ... [ ON INIT> <bInit> ] ; ... [ <.lAutoCol.> ], [ \{<aColSel>\} ], ; <{bInit}> );; with object <obrw> ... #command END TBRW [ ON INIT> <bInit> ] ; =>; _EndTBrowse( <{bInit}> );; end with ... Поменял объявление и вызов Local oc, ow := oDlu2Pixel() ... Do_ControlEventProcedure ( bInit, k, ow, oc ) ... Для GetBox добавил [ <GotFocusSelect: GOTFOCUSSELECT> ] ; ... ..., <.GotFocusSelect.>, <{bInit}> ) ... FUNCTION _DefineGetBox ( ControlName, ParentFormName, x, y, w, h, Value, ; ... If HB_ISCHAR( cPicture ) .and. ! Empty(cPicture) .and. '@K ' $ cPicture GotFocusSelect := .T. EndIf If ! Empty( GotFocusSelect ) .and. Empty( uGotFocus ) If ValType( Value ) == "C" _HMG_aControlGotFocusProcedure[k] := {|| SendMessage( _HMG_aControlHandles[k], EM_SETSEL, 0, If( Empty(Value), -1, Len(Trim(Value))) ) } ElseIf ValType( Value ) $ "ND" _HMG_aControlGotFocusProcedure[k] := {|| SendMessage( _HMG_aControlHandles[k], EM_SETSEL, 0, -1 ) } EndIf EndIf IF _HMG_lOOPEnabled Eval ( _HMG_bOnControlInit, k, mVar ) ow := _WindowObj ( ParentFormHandle ) oc := _ControlObj( ControlHandle ) ENDIF Do_ControlEventProcedure ( bInit, k, oGet, ow, oc ) RETURN oGet Получилось 1. без SET OOP ON делаем (можем) WITH OBJECT App.Object с SET OOP ON делаем WITH OBJECT ThisWindow.Object работаем в одинаковых переменных 2. С использованием ON INIT практически все команды между _Define...(...) уходят в них и работа с This... обезличенно. Возможна упрощенная автоматизация, убрав лишнее в блоки кода (не надо делать как в demo.ch из примера) При работе с сообщениями удобнее устанавливать eventы на контролы. 3. Старый стиль написания остается Попробовал пока немного на GetBox
| |
|
SergKis
|
| постоянный участник
|
Пост N: 2216
Зарегистрирован: 17.02.12
|
|
Отправлено: 09.02.19 22:06. Заголовок: PS *----------------..
PS *-----------------------------------------------------------------------------* FUNCTION _EndTBrowse( bInit ) *-----------------------------------------------------------------------------* LOCAL i, oBrw LOCAL oc, ow := oDlu2Pixel() IF _HMG_BeginTBrowseActive i := AScan ( _HMG_aControlHandles, _HMG_ActiveTBrowseHandle ) IF i > 0 oBrw := _HMG_aControlIds[ i ] IF _HMG_lOOPEnabled ow := _WindowObj ( _HMG_aControlParenthandles[ i ] ) oc := _ControlObj( _HMG_aControlHandles [ i ] ) ENDIF Do_ControlEventProcedure ( bInit, i, oBrw, ow, oc ) oBrw:lRePaint := .T. oBrw:Display() _HMG_ActiveTBrowseName := "" _HMG_ActiveTBrowseHandle := 0 _HMG_BeginTBrowseActive := .F. ENDIF ENDIF RETURN NIL
| |
|
SergKis
|
| постоянный участник
|
Пост N: 2217
Зарегистрирован: 17.02.12
|
|
Отправлено: 09.02.19 22:34. Заголовок: В продолжении пример..
В продолжении примера, промежутков между контролами (GapsWidth, GapsHeight), оказалось удобным при Resize окон. В задаче окно разделено на 2-е части: - контролы Label, Getbox слева вертикально в плотном заполнении, 2 pixel в Normalize + кнопка Save - справа Tbrowse 60% окна. При Resize с ним ясно все. По контролам - персчитываю новое значение по вертикали GapsHeight, GapsWidth не меняю, т.е. левый X tsb тот же - меняю Y у контролов Текст из задачи как есть (кому интересно) Скрытый текст
* ----------------------------------------------------------------------------------- * STATIC FUNCTION DokRetResize( oBrw ) * ----------------------------------------------------------------------------------- * LOCAL nW := This.ClientWidth - oBrw:nLeft LOCAL nH := This.ClientHeight, y, x, w, h, g LOCAL oWnd, aPar, nAlC, hSpl, nAlH, nGaH, nSpH oBrw:OnResize( nW, nH ) IF _HMG_MouseState == 0 oWnd := This.Object aPar := oWnd:GetProp(0) nAlC := aPar[4] hSpl := aPar[5] nAlH := aPar[6] nGaH := aPar[7] nSpH := GetWindowHeight(hSpl) h := nH - nSpH - nAlH // остаток высоты без контролов g := int( h / nAlC ) // GapsHeight new y := nSpH + g // Y start AEval( oWnd:GetObj4Type('LABEL,GETBOX,OBUTTON'), {|oc| oc:Hide() } ) This.K_1.Row := y; y += This.K_1.Height + g This.K_2.Row := y; y += This.K_2.Height + g This.K_3.Row := y This.K_4.Row := y; y += This.K_4.Height + g This.K_5.Row := y This.K_6.Row := y; y += This.K_6.Height + g This.K_7.Row := y; y += This.K_7.Height + g This.K_8.Row := y; y += This.K_8.Height + g This.K_9.Row := y; y += This.K_9.Height + g This.K_A.Row := y; y += This.K_A.Height + g This.K_B.Row := y This.K_C.Row := y; y += This.K_C.Height + g This.K_D.Row := y This.K_E.Row := y; y += This.K_E.Height + g This.K_F.Row := y This.K_G.Row := y; y += This.K_G.Height + g This.K_H.Row := y This.K_I.Row := y; y += This.K_I.Height + g This.O_1.Row := y; y += This.O_1.Height + g This.O_2.Row := y; y += This.O_2.Height + g This.O_3.Row := y This.O_4.Row := y; y += This.O_4.Height + g This.O_5.Row := y This.O_6.Row := y; y += This.O_6.Height + g This.O_7.Row := y This.O_8.Row := y; y += This.O_8.Height + g This.O_D.Row := y This.O_E.Row := y; y += This.O_E.Height + g This.O_F.Row := y This.O_G.Row := y; y += This.O_G.Height + g This.O_H.Row := y This.O_I.Row := y; y += This.O_I.Height + g This.Save.Row := y AEval( oWnd:GetObj4Type('LABEL,GETBOX,OBUTTON'), {|oc| oc:Show() } ) oBrw:AdjColumns() oBrw:SetFocus() ENDIF RETURN NIL
|
| |
|
SergKis
|
| постоянный участник
|
Пост N: 2218
Зарегистрирован: 17.02.12
|
|
Отправлено: 10.02.19 11:26. Заголовок: gfilatov2002 Попроб..
gfilatov2002 Попробовал Tsb с on init ( пример Tsb_addRecord ) Скрытый текст
/* * MINIGUI - Harbour Win32 GUI library Demo * */ #include "minigui.ch" #include "tsbrowse.ch" FIELD id, info *----------------------------------- PROCEDURE Main *----------------------------------- LOCAL i, obrw IF !hb_FileExists( "datab.dbf" ) dbCreate( "datab", { { "ID", "N", 5, 0 }, { "INFO", "C", 15, 0 } } ) ENDIF USE datab ALIAS base NEW INDEX ON id TO datab temporary IF LastRec() == 0 FOR i := 1 TO 100 APPEND BLANK REPLACE id WITH RecNo(), info WITH "record " + hb_ntos( RecNo(), 4 ) NEXT ENDIF DEFINE WINDOW win_1 AT 0, 0 WIDTH 400 HEIGHT 500 ; MAIN TITLE "TSBrowse Add Record Demo" NOMAXIMIZE NOSIZE @06, 10 BUTTON BRUN CAPTION "Add Record" ACTION AddRecord( obrw ) // DEFAULT DEFINE TBROWSE obrw AT 40, 10 GRID ALIAS "base" WIDTH 370 HEIGHT 418 ; ON INIT {|ob| InitTsb( .F., ob ) } END TBROWSE ON INIT {|ob| InitTsb( .T., ob ) } END WINDOW CENTER WINDOW win_1 ACTIVATE WINDOW win_1 RETURN *----------------------------------- STAT FUNC InitTsb( lEnd, obrw ) *----------------------------------- If ! lEnd ADD COLUMN TO obrw HEADER "ID" SIZE 100 DATA FieldWBlock( "id" , Select( "base" ) ) ADD COLUMN TO obrw HEADER "INFO" SIZE 150 DATA FieldWBlock( "info", Select( "base" ) ) obrw:lNoHScroll := .T. obrw:SetColor( { 2 }, { {|| iif( base->( ordKeyNo() ) % 2 == 0, RGB( 255, 255, 255 ), RGB( 230, 230, 230 ) ) } } ) Else obrw:SetNoHoles() obrw:SetFocus() EndIf RETURN NIL *----------------------------------- PROCEDURE AddRecord( obrw ) *----------------------------------- APPEND BLANK REPLACE id WITH RecNo(), info WITH "record " + hb_ntos( RecNo(), 4 ) obrw:GoToRec( base->( RecNo() ), .T. ) obrw:SetFocus() RETURN
| Был не прав с EndTbrowse сделал так Скрытый текст
*-----------------------------------------------------------------------------* FUNCTION _EndTBrowse( bInit ) *-----------------------------------------------------------------------------* LOCAL i, oBrw LOCAL oc, ow := oDlu2Pixel() IF _HMG_BeginTBrowseActive i := AScan ( _HMG_aControlHandles, _HMG_ActiveTBrowseHandle ) IF i > 0 oBrw := _HMG_aControlIds[ i ] oBrw:lRePaint := .T. oBrw:Display() _HMG_ActiveTBrowseName := "" _HMG_ActiveTBrowseHandle := 0 _HMG_BeginTBrowseActive := .F. IF _HMG_lOOPEnabled ow := _WindowObj ( _HMG_aControlParenthandles[ i ] ) oc := _ControlObj( _HMG_aControlHandles [ i ] ) ENDIF Do_ControlEventProcedure ( bInit, i, oBrw, ow, oc ) ENDIF ENDIF RETURN NIL
|
| |
|
gfilatov2002
|
| moderator
|
Пост N: 1434
Зарегистрирован: 11.02.10
|
|
Отправлено: 10.02.19 20:55. Заголовок: SergKis пишет: Полу..
SergKis пишет: цитата: | Получилось 1. без SET OOP ON делаем (можем) WITH OBJECT App.Object с SET OOP ON делаем WITH OBJECT ThisWindow.Object работаем в одинаковых переменных |
| Это очень интересно. Можно получить пример 1 для GetBox App_OopGetBox без установки SET OOP ON и для сравнения пример 3 App_OopGetBox3 с SET OOP ON SergKis пишет: цитата: | 2. С использованием ON INIT практически все команды между _Define...(...) уходят в них и работа с This... обезличенно. Возможна упрощенная автоматизация, убрав лишнее в блоки кода (не надо делать как в demo.ch из примера) |
| Очень хорошо SergKis пишет: цитата: | 3. Старый стиль написания остается |
| Отлично SergKis пишет: Спасибо! У меня такой пример тоже сработал (см. ниже) Скрытый текст
цитата: | /* * MINIGUI - Harbour Win32 GUI library Demo * */ #include "minigui.ch" #include "tsbrowse.ch" FIELD id, info *---------------------------------------- PROCEDURE Main *---------------------------------------- LOCAL i, obrw IF !hb_FileExists( "datab.dbf" ) dbCreate( "datab", { { "ID", "N", 5, 0 }, { "INFO", "C", 15, 0 } } ) ENDIF USE datab ALIAS base NEW INDEX ON id TO datab temporary IF LastRec() == 0 FOR i := 1 TO 100 APPEND BLANK REPLACE id WITH RecNo(), info WITH "record " + hb_ntos( RecNo(), 4 ) NEXT ENDIF DEFINE WINDOW win_1 AT 0, 0 WIDTH 400 HEIGHT 500 ; MAIN TITLE "TSBrowse Add Record Demo" NOMAXIMIZE NOSIZE @06, 10 BUTTON brun CAPTION "Add Record" ACTION AddRecord( obrw ) DEFINE TBROWSE obrw AT 40, 10 GRID ALIAS "base" ; WIDTH 370 HEIGHT 418 ; ON INIT {|ob| TsbCreate( ob, .T. ) } END TBROWSE ON END {|ob| TsbCreate( ob, .F. ) } END WINDOW CENTER WINDOW win_1 ACTIVATE WINDOW win_1 RETURN *---------------------------------------- STATIC PROCEDURE TsbCreate( obrw, lInit ) *---------------------------------------- IF lInit ADD COLUMN TO obrw HEADER "ID" ; SIZE 100 ; DATA FieldWBlock( "id", Select( "base" ) ) ADD COLUMN TO obrw HEADER "INFO" ; SIZE 150 ; DATA FieldWBlock( "info", Select( "base" ) ) obrw:lNoHScroll := .T. obrw:SetColor( { 2 }, { {|| iif( base->( ordKeyNo() ) % 2 == 0, RGB( 255, 255, 255 ), RGB( 230, 230, 230 ) ) } } ) ELSE obrw:SetNoHoles() obrw:SetFocus() ENDIF RETURN *---------------------------------------- PROCEDURE AddRecord( obrw ) *---------------------------------------- APPEND BLANK REPLACE id WITH RecNo(), info WITH "record " + hb_ntos( RecNo(), 4 ) obrw:GoToRec( base->( RecNo() ), .T. ) obrw:SetFocus() RETURN |
|
|
| |
|
SergKis
|
| постоянный участник
|
Пост N: 2221
Зарегистрирован: 17.02.12
|
|
Отправлено: 11.02.19 05:06. Заголовок: gfilatov2002 Пример..
gfilatov2002 Пример для SET OOP ON\OFF https://TransFiles.ru/wyxjd Если SET OOP ON -> убираем коменты у строк WITH OBJECT App.Object //------------------------------------------ for SET OOP ON // WITH OBJECT This.Object // :O:BColorGet := :AO:BColorGet // (App.Object):O:BColorGet // :O:FColorGet := :AO:FColorGet // (App.Object):O:FColorGet // :O:FColor1 := :AO:FColor1 // (App.Object):O:FColor1 // :O:FColor2 := :AO:FColor2 // (App.Object):O:FColor2 //------------------------------------------ ставим коментарий у WITH OBJECT App.Object собран пример в режиме SET OOP OFF Небольшая правка CLASS TDlu2Pix ... заменить METHOD Event( Key, p1, p2, p3 ) INLINE iif( HB_ISBLOCK( p1 ), ; ::oEvent:Set( Key, p1 ), ; ( p2 := hb_defaultValue(p2, ::oParam:Get( Key)), ; ::oEvent:Do ( Key, p1, p2, p3 ) ) ) ... CLASS TWndData ... METHOD GetGaps( aGaps, oWnd ) INLINE ::oApp:GetGaps( aGaps, oWnd ) METHOD W ( nKfc ) INLINE ::oApp:W ( nKfc ) ...
| |
|
SergKis
|
| постоянный участник
|
Пост N: 2223
Зарегистрирован: 17.02.12
|
|
Отправлено: 11.02.19 05:54. Заголовок: gfilatov2002 В App_..
gfilatov2002 В App_OopGetbox2 правка :Event( 1, {|| HMG_Alert("MessageBox Info", , "Information", ICON_INFORMATION) } ) :Event( 2, {|oa,ky,np,cp| ShellExecute( , 'open', App.ExeName, cp, , np ), ; ReleaseAllWindows() } ) :Event( 3, {|oa,ky,np,xp| _LogFile(.T., oa, ky, np, xp, oa:ClassName) } )
| |
|
gfilatov2002
|
| moderator
|
Пост N: 1435
Зарегистрирован: 11.02.10
|
|
Отправлено: 11.02.19 10:35. Заголовок: SergKis пишет: собр..
SergKis пишет: цитата: | собран пример в режиме SET OOP OFF |
| Благодарю за скорую помощь
| |
|
SergKis
|
| постоянный участник
|
Пост N: 2224
Зарегистрирован: 17.02.12
|
|
Отправлено: 11.02.19 11:31. Заголовок: gfilatov2002 В прим..
gfilatov2002 В пример 3 правка @ :Y, :X GETBOX Text_2b WIDTH :O:nDefLen HEIGHT :H1 ; ... ON CHANGE (App.Object):Send(This.Cargo, 300) ; //{|| TONE(300)}; ... @ :Y, :X BUTTONEX OButton_4 WIDTH :O:nDefLen HEIGHT :H1 * 2 ; ... ACTION ( (App.Object):Send(This.Cargo[1], 800), ; // TONE(800) (App.Object):Post(This.Cargo[2]) ) ;
| |
|
gfilatov2002
|
| moderator
|
Пост N: 1436
Зарегистрирован: 11.02.10
|
|
Отправлено: 11.02.19 11:41. Заголовок: SergKis пишет: В пр..
SergKis пишет: OK
| |
|
SergKis
|
| постоянный участник
|
Пост N: 2225
Зарегистрирован: 17.02.12
|
|
Отправлено: 11.02.19 14:28. Заголовок: gfilatov2002 Пропус..
gfilatov2002 Пропустил я в примере 3 DEFINE GETBOX Text_6 // Alternate Syntax ... BACKCOLOR :O:BColorGet ... и TOOLTIPы поправить, может быть @ :Y, :X GETBOX Text_5 WIDTH :D1 HEIGHT :H1 ; TOOLTIP "Text_5. DublClick => Edit" ; ... @ :Y, :X GETBOX Text_7 WIDTH :O:nDefLen HEIGHT :H1 ; BACKCOLOR :O:BColorGet ; TOOLTIP "Characters field. DublClick => Edit " ; ... @ :Y, :X GETBOX Text_8 WIDTH :O:nBoolLen HEIGHT :H1 ; ... TOOLTIP "Logical field. DublClick => Edit" ;
| |
|
gfilatov2002
|
| moderator
|
Пост N: 1437
Зарегистрирован: 11.02.10
|
|
Отправлено: 11.02.19 15:04. Заголовок: SergKis пишет: в пр..
SergKis пишет: цитата: | в примере 3 DEFINE GETBOX Text_6 // Alternate Syntax ... BACKCOLOR :O:BColorGet ... и TOOLTIPы поправить |
| Благодарю за помощь
| |
|
SergKis
|
| постоянный участник
|
Пост N: 2226
Зарегистрирован: 17.02.12
|
|
Отправлено: 11.02.19 15:30. Заголовок: gfilatov2002 пишет У..
gfilatov2002 пишет цитата: | У меня такой пример тоже сработал (о tsb) |
| Мне понравилось использовать on init. В своей версии 2.07 прошел по всем контролам и добавил bInit. Даже в timer Local ow := oDlu2Pixel() ... IF _HMG_lOOPEnabled Eval ( _HMG_bOnControlInit, k, mVar ) ow := _WindowObj( ParentFormHandle ) ENDIF Do_WindowEventProcedure( bInit, k, ow, ControlName, k ) Return Nil Если в IDE добавить on init {|| NIL }, то в ней можно переустанавливать координаты (к примеру): ON INIT {|| This.Row := :Y, This.Col := :X, This.Width := :W1, This.Height := :H1, :Y += This.Height + :GapsHeight, ... }
| |
|
gfilatov2002
|
| moderator
|
Пост N: 1438
Зарегистрирован: 11.02.10
|
|
Отправлено: 12.02.19 12:40. Заголовок: SergKis пишет: про..
SergKis пишет: цитата: | прошел по всем контролам и добавил bInit |
| Добавил обработку bInit в 20 базовых элементов управления (плюс TBrowse, конечно). Поправил выделение при получении фокуса по событию ON GOTFOCUS в GetBox с символьными данными: IF ValType( Value ) == "C" _HMG_aControlGotFocusProcedure [k] := {|| SendMessage( _HMG_aControlHandles [k], EM_SETSEL, 0, iif( Empty( Value ), -1, Len( Trim( ( _HMG_aControlHeadClick [k] ):Cargo ) ) ) ) } Неточность выделения видна при редактировании поля Text_7 на десятой записи из базы. Также в альтернативном синтаксисе использовал новую команду ON INIT <b> вместо увеличения длины команды END <control> [ON INIT]. Теперь бы не мешало проверить эти изменения на реальном примере...
| |
|
SergKis
|
| постоянный участник
|
Пост N: 2227
Зарегистрирован: 17.02.12
|
|
Отправлено: 12.02.19 12:56. Заголовок: gfilatov2002 Дайте ..
gfilatov2002 Дайте ссылку в личку или так Покручу. В тек. версии только несколько элементов от on init-ил
| |
|
gfilatov2002
|
| moderator
|
Пост N: 1439
Зарегистрирован: 11.02.10
|
|
Отправлено: 12.02.19 13:02. Заголовок: SergKis пишет: Дайт..
SergKis пишет: Отправил ссылку
| |
|
SergKis
|
| постоянный участник
|
Пост N: 2228
Зарегистрирован: 17.02.12
|
|
Отправлено: 12.02.19 13:45. Заголовок: gfilatov2002 пишет О..
gfilatov2002 пишет Забрал
| |
|
gfilatov2002
|
| moderator
|
Пост N: 1440
Зарегистрирован: 11.02.10
|
|
Отправлено: 12.02.19 13:53. Заголовок: SergKis пишет: Забр..
SergKis пишет: Если описание использования dlu в файле doc\Changelog.txt содержит неточности (или ошибки), то прошу их исправить без стеснения
| |
|
SergKis
|
| постоянный участник
|
Пост N: 2229
Зарегистрирован: 17.02.12
|
|
Отправлено: 12.02.19 17:50. Заголовок: gfilatov2002 Родной..
gfilatov2002 Родной "оригинальный" BASIC\GetBox из 19.01 переделал на проверку ON INIT. Только прорисовка убрана в ON INIT, остальное не трогал Тут https://TransFiles.ru/36pe9
| |
|
gfilatov2002
|
| moderator
|
Пост N: 1441
Зарегистрирован: 11.02.10
|
|
Отправлено: 12.02.19 17:58. Заголовок: SergKis пишет: BASI..
SergKis пишет: цитата: | BASIC\GetBox из 19.01 переделал на проверку ON INIT |
| Супер! Большое спасибо за помощь
| |
|
SergKis
|
| постоянный участник
|
Пост N: 2230
Зарегистрирован: 17.02.12
|
|
Отправлено: 15.02.19 10:13. Заголовок: gfilatov2002 Малень..
gfilatov2002 Маленькая правка METHOD GetObj4Name( cName ) CLASS TWndData ... ::oName:Eval( {| oc | iif( cName $ Upper(oc:cName), AAdd( aObj, oc ), Nil ) } ) ...
| |
|
gfilatov2002
|
| moderator
|
Пост N: 1442
Зарегистрирован: 11.02.10
|
|
Отправлено: 15.02.19 10:27. Заголовок: SergKis пишет: Мале..
SergKis пишет: Ok
| |
|
SergKis
|
| постоянный участник
|
Пост N: 2231
Зарегистрирован: 17.02.12
|
|
Отправлено: 16.02.19 10:57. Заголовок: gfilatov2002 Предло..
gfilatov2002 Предложение по TREE добавить в Node и Item Cargo, использовав _HMG_aControlHeadClick[ k ] #xcommand NODE <text> [ IMAGES <aImage> ] [ ID <id> ] [ CARGO <Cargo> ]; =>; _DefineTreeNode (<text>, <aImage> , <id>, <Cargo> ) #xcommand DEFINE NODE <text> [ IMAGES <aImage> ] [ ID <id> ] [ CARGO <Cargo> ] ; =>; _DefineTreeNode (<text>, <aImage> , <id>, <Cargo> ) #xcommand END NODE ; =>; _EndTreeNode() #xcommand TREEITEM <text> [ IMAGES <aImage> ] [ ID <id> ] [ CARGO <Cargo> ] ; => ; _DefineTreeItem (<text>, <aImage> , <id>, <Cargo> ) h_tree.prg #include "minigui.ch" #include "i_winuser.ch" STATIC lDialogInMemory := .F. STATIC a_Node_Item_Cargo := {} *-----------------------------------------------------------------------------* FUNCTION _DefineTree ( ControlName, ParentFormName, row, col, width, height, ; ... __defaultNIL( @dblclick, "" ) a_Node_Item_Cargo := {} mVar := '_' + ParentFormName + '_' + ControlName ... *-----------------------------------------------------------------------------* FUNCTION InitDialogTree( ParentName, ControlHandle, k ) *-----------------------------------------------------------------------------* ... FOR n := 1 TO Len( _HMG_aDialogTreeItem ) aImage := _HMG_aDialogTreeItem[ n, 2 ] text := _HMG_aDialogTreeItem[ n, 1 ] id := _HMG_aDialogTreeItem[ n, 3 ] NodeIndex := _HMG_aDialogTreeItem[ n, 4 ] Cargo := _HMG_aDialogTreeItem[ n, 6 ] ... ImgDef := iif( ValType( aImage ) == "A", Len( aImage ), 0 ) // Tree+ NodeHandle := _HMG_NodeHandle[ NodeIndex ] AAdd( a_Node_Item_Cargo, Cargo ) IF ImgDef == 0 ... _HMG_aControlPageMap [ _HMG_ActiveTreeIndex ] := _HMG_aTreeMap _HMG_aControlPicture [ _HMG_ActiveTreeIndex ] := _HMG_aTreeIdMap _HMG_aControlHeadClick[ _HMG_ActiveTreeIndex ] := AClone ( a_Node_Item_Cargo ) ... *-----------------------------------------------------------------------------* FUNCTION _DefineTreeNode ( text, aImage, Id, Cargo ) *-----------------------------------------------------------------------------* ... IF lDialogInMemory _HMG_NodeIndex++ AAdd ( _HMG_aDialogTreeItem, { text, aImage, Id, _HMG_NodeIndex, 'NODE', Cargo } ) ELSE ... AAdd ( _HMG_aTreeMap, _HMG_NodeHandle[ _HMG_NodeIndex ] ) AAdd ( _HMG_aTreeIdMap, Id ) AAdd ( a_Node_Item_Cargo, Cargo ) ENDIF ... *-----------------------------------------------------------------------------* FUNCTION _DefineTreeItem ( text, aImage, Id, Cargo ) *-----------------------------------------------------------------------------* ... IF lDialogInMemory AAdd ( _HMG_aDialogTreeItem, { text, aImage, Id, _HMG_NodeIndex, 'ITEM', Cargo } ) ELSE ... AAdd ( _HMG_aTreeMap, Handle ) AAdd ( _HMG_aTreeIdMap, Id ) AAdd ( a_Node_Item_Cargo, Cargo ) ENDIF ... *-----------------------------------------------------------------------------* FUNCTION _EndTree() *-----------------------------------------------------------------------------* IF .NOT. lDialogInMemory _HMG_aControlPageMap [ _HMG_ActiveTreeIndex ] := _HMG_aTreeMap _HMG_aControlPicture [ _HMG_ActiveTreeIndex ] := _HMG_aTreeIdMap _HMG_aControlHeadClick[ _HMG_ActiveTreeIndex ] := AClone( a_Node_Item_Cargo ) IF _HMG_ActiveTreeValue > 0 ... ENDIF a_Node_Item_Cargo := {} RETURN NIL ... *-----------------------------------------------------------------------------* FUNCTION TreeNodeItemCargo( ControlName, ParentForm, Item, Value ) *-----------------------------------------------------------------------------* LOCAL i, xVal IF ( i := GetControlIndex( ControlName, ParentForm ) ) > 0 IF Item > 0 .and. Item <= Len ( _HMG_aControlHeadClick[ i ] ) xVal := _HMG_aControlHeadClick[ i ][ Item ] IF pCount() > 3 _HMG_aControlHeadClick[ i ][ Item ] := Value ENDIF ENDIF ENDIF RETURN xVal h_controlmisc.prg FUNCTION _DeleteAllItems ( ControlName , ParentForm ) ... CASE t == "TREE" TreeView_DeleteAllItems ( c , _HMG_aControlPageMap [ i ] ) // Tree+ ASize ( _HMG_aControlPageMap [ i ] , 0 ) ASize ( _HMG_aControlPicture [ i ] , 0 ) ASize ( _HMG_aControlHeadClick[ i ] , 0 ) ... FUNCTION _DeleteItem ( ControlName , ParentForm , Value ) ... CASE T == "TREE" ... ASize ( _HMG_aControlPageMap [ix] , AfterCount ) ASize ( _HMG_aControlPicture [ix] , AfterCount ) HB_ADEL( _HMG_aControlHeadClick[ix] , Value, .T. ) ...
| |
|
SergKis
|
| постоянный участник
|
Пост N: 2232
Зарегистрирован: 17.02.12
|
|
Отправлено: 16.02.19 11:00. Заголовок: PS Пример BASIC\..
| |
|
SergKis
|
| постоянный участник
|
Пост N: 2233
Зарегистрирован: 17.02.12
|
|
Отправлено: 16.02.19 11:04. Заголовок: PPS При TreeItemSort..
PPS При TreeItemSort(...) и AddItem, думаю NODE\ITEM Cargo не стоит исползовать
| |
|
SergKis
|
| постоянный участник
|
Пост N: 2234
Зарегистрирован: 17.02.12
|
|
Отправлено: 16.02.19 18:32. Заголовок: gfilatov2002 Замени..
gfilatov2002 Замените, пожалуйста, методы, добавлена обработка удаленных контролов METHOD GetObj4Type( cType, lEque ) CLASS TWndData LOCAL aObj := {}, aO := {}, o IF ! Empty( cType ) lEque := hb_defaultValue( lEque, .T. ) IF ::cChr $ cType ; lEque := .F. ENDIF FOR EACH cType IN hb_ATokens( Upper( cType ), ::cChr ) ::oName:Eval( {| oc | iif( lEque, iif( cType == oc:cType, AAdd( aObj, oc ), ), ; iif( cType $ oc:cType, AAdd( aObj, oc ), ) ) } ) NEXT FOR EACH o IN aObj If _IsControlDefined(o:Name, o:Window:Name) aAdd(aO, o) EndIf NEXT ENDIF RETURN aO METHOD GetObj4Name( cName ) CLASS TWndData LOCAL aObj := {} IF ! Empty( cName ) FOR EACH cName IN hb_ATokens( Upper( cName ), ::cChr ) ::oName:Eval( {| oc | iif( _IsControlDefined(oc:Name, oc:Window:Name), ; iif( cName $ Upper(oc:cName), AAdd( aObj, oc ), Nil ), Nil ) } ) NEXT ENDIF RETURN aObj
| |
|
gfilatov2002
|
| moderator
|
Пост N: 1443
Зарегистрирован: 11.02.10
|
|
Отправлено: 16.02.19 19:34. Заголовок: SergKis пишет: Заме..
SergKis пишет: цитата: | Замените, пожалуйста, методы, добавлена обработка удаленных контролов |
| Принято. Благодарю за помощь
| |
|
Vlad04
|
| постоянный участник
|
Пост N: 807
Зарегистрирован: 13.10.05
|
|
Отправлено: 17.02.19 09:54. Заголовок: Ещё бы хороший приме..
Ещё бы хороший пример (на основе DBF) построения ДЕРЕВА и работы с ним
| |
|
SergKis
|
| постоянный участник
|
Пост N: 2235
Зарегистрирован: 17.02.12
|
|
Отправлено: 17.02.19 10:19. Заголовок: Vlad04 пишет Ещё бы ..
Vlad04 пишет цитата: | Ещё бы хороший пример (на основе DBF) построения ДЕРЕВА и работы с ним |
| Какие трудности с dbf. К примеру имеем - группы - подгруппы - товар while ! eof() // группы group := ... NODE group sele podgroup set scope group to group go top while ! eof() podgoup := ... NODE podgroup sele tovar set scope podgroup to podgroup go top while ! eof() ITEM tovar skip enddo END NODE sele podgroup skip enddo END NODE sele group skip enddo Если это в одном файле, открываем его три раза group, podgroup, tovar и делаем то же самое group, podgroup тэги UNIQUE
| |
|
Vlad04
|
| постоянный участник
|
Пост N: 808
Зарегистрирован: 13.10.05
|
|
Отправлено: 17.02.19 13:37. Заголовок: Не понял ? Какая вло..
Не понял ? Какая вложенность здесь ? Группа и подгруппа ? Классический Трей- файлы директории.
| |
|
SergKis
|
| постоянный участник
|
Пост N: 2236
Зарегистрирован: 17.02.12
|
|
Отправлено: 17.02.19 14:10. Заголовок: Vlad04 пишет Не поня..
Vlad04 пишет цитата: | Не понял ? Какая вложенность здесь ? Группа и подгруппа ? |
| Вложенность обыкновенная, показана последняя часть 2-а node и item: Краски - группа Акриловые - подгруппа Водоэмульсионные - ... Масляные - ... ... Краска белая марка ... - товар\материал Краска синяя марка ... - ... ... Над группой может быть Краски для внутренних работ Краски для наружных работ ... Еще выше может быть Материалы для внутренних работ Материалы для наружных работ ... Классическое дерево, не хуже директорий
| |
|
SergKis
|
| постоянный участник
|
Пост N: 2237
Зарегистрирован: 17.02.12
|
|
Отправлено: 18.02.19 11:29. Заголовок: gfilatov2002 Поправ..
gfilatov2002 Поправил Method Enabled (сейчас он не работает совсем, с изменениями - частично) CLASS TSBrowse FROM TControl ... DATA aOldParams DATA aOldEnabled #ifdef __EXT_USERKEYS__ ... METHOD Enabled( lEnab, Clr1, Clr2 ) //JP 1.55 ... METHOD Enabled( lEnab, Clr1, Clr2 ) CLASS TSBrowse Local nI Default lEnab := .T., Clr1 := CLR_GRAY, Clr2 := CLR_HGRAY IF ValType( lEnab ) == "L" IF !lEnab IF ::lEnabled ::aOldEnabled := { ::hBrush, {} , ::nClrPane } For nI := 1 TO Len( ::aColumns ) AAdd( ::aOldEnabled[2], ::aColumns[ nI ]:Clone() ) ::aColumns[ nI ]:SaveColor() Next ENDIF ::lEnabled := .F. ::SetColor( { 2 }, { CLR2 } ) ::SetColor( { 3, 4 }, { CLR1, CLR2 } ) ::SetColor( { 9, 10 }, { CLR1, CLR2 } ) ::SetColor( { 16, 17 }, { CLR1, CLR2 } ) ::SetColor( { 18, 19 }, { CLR1, CLR2 } ) ::nClrPane := CLR2 ELSE IF ! ::lEnabled For nI := 1 TO Len( ::aColumns ) ::aColumns[ nI ]:RestColor() SetColor( , ::aColumns[ nI ]:aColors, nI ) Next If HB_ISARRAY( ::aOldEnabled ) .and. ! empty( ::aOldEnabled[1] ) AEval( ::aOldEnabled[2], {|oc,nc| ::aColumns[ nc ] := oc:Clone() } ) ::hBrush := ::aOldEnabled[1] ::nClrPane := ::aOldEnabled[3] EndIf ENDIF ::lEnabled := .T. ENDIF ::Refresh() /* этот кусок кода работает для варианта колонки помещаются на экране тсб и нет hscroll. для тсб со горизонтальным скролингом добавка ниже не помогает потому я оставил в коментариях, т.е. при исп. :Enabled(...) допиливать за вызовом самому (точно не понял, как быть) If ! ::lNoHScroll .and. ::oHScroll != Nil ::oHScroll:SetPos( ::nCell ) EndIf ::ResetVScroll( .T. ) ::oVScroll:SetRange( 0, 0 ) ::oHScroll:SetRange( 0, 0 ) ::Refresh() If ! ::lNoHScroll .and. ::oHScroll != Nil ::oHScroll:SetPos( ::nCell ) EndIf ::ResetVScroll( .T. ) ::oHScroll:SetRange( 0, 0 ) */ ENDIF RETURN 0 ... Проверка в примере Advanced\TsBrowse TsbTest.prg ... Case nSample = 1 DEFINE TBROWSE Brw_1 AT 0, 0 ALIAS "Employee" ; ... :UserKeys( VK_F5, {|obr| oBr:Enabled(.F.), ; MsgBox('Test oBrw:Enabled(.F.\.T.)', oBr:cControlName), ; oBr:Enabled(.T.), oBr:SetFocus() } ) END TBROWSE ... Надо отметить, что hscroll при нажатии F5 пропадает сразу и не восстанавливается, но и колонок за пределы тсб нет.
| |
|
SergKis
|
| постоянный участник
|
Пост N: 2238
Зарегистрирован: 17.02.12
|
|
Отправлено: 18.02.19 11:34. Заголовок: PS Есть faq с прорис..
PS Есть faq с прорисовкой Header, Footer фантомных колонок, но это др. история
| |
|
gfilatov2002
|
| moderator
|
Пост N: 1444
Зарегистрирован: 11.02.10
|
|
Отправлено: 18.02.19 11:53. Заголовок: SergKis пишет: Meth..
SergKis пишет: цитата: | Method Enabled (сейчас он не работает совсем |
| Посмотрел в примере Advanced\Tsb_seek рабочий вызов этого метода Что здесь не так
| |
|
SergKis
|
| постоянный участник
|
Пост N: 2239
Зарегистрирован: 17.02.12
|
|
Отправлено: 18.02.19 12:02. Заголовок: PPS Уточнение по TsB..
PPS Уточнение по TsBrowse. HScroll есть, что то я просмотрел его В примере Tsb_Basic\demo4.prg с добавкой DEFINE BUTTONEX Button_Go Row y + 2 Col x WIDTH 40 HEIGHT 24 CAPTION "Go" ACTION ( oBr:SetFocus(), oBr:GotoRec(This.Recno.Value, This.RowPos.Value ) ) FONTSIZE 9 FONTBOLD .F. END BUTTONEX x += This.RowPos.Width + 20 DEFINE BUTTONEX Button_Msg Row y + 2 Col x WIDTH 40 HEIGHT 24 CAPTION "Msg" ACTION ( oBr:Enabled(.F.), MsgBox('Test oBrw:Enabled(.F.\.T.)', This.name), ; oBr:Enabled(.T.), oBr:SetFocus() ) FONTSIZE 9 FONTBOLD .F. END BUTTONEX ... работает при строках меньше и больше :RowCount() нормально, но на примере Андрея, на котором тренировался, при VScroll наличии пропадают стабильно стрелки управления или сам VScroll полностью и спасает добавка STAT FUNC _myTsb( obrw, n ) If n == 1 obrw:Enabled(.F.) Else obrw:Enabled(.T.) obrw:ResetVScroll( .T. ) obrw:oVScroll:SetRange( 0, 0 ) obrw:oHScroll:SetRange( 0, 0 ) obrw:Refresh() obrw:ResetVScroll( .T. ) obrw:oHScroll:SetRange( 0, 0 ) obrw:SetFocus() EndIf RETURN Nil
| |
|
SergKis
|
| постоянный участник
|
Пост N: 2240
Зарегистрирован: 17.02.12
|
|
Отправлено: 18.02.19 12:41. Заголовок: gfilatov2002 пишет П..
gfilatov2002 пишет цитата: | Посмотрел в примере Advanced\Tsb_seek рабочий вызов этого метода |
| Пример с методом работает У меня все время глюки с методом (отказадся использовать, только переменную :lEnabled). Спасает сохранение\восстановление колонок, hBrush и борьба с VScroll. Ok, буду бороться вне метода
| |
|
gfilatov2002
|
| moderator
|
Пост N: 1445
Зарегистрирован: 11.02.10
|
|
Отправлено: 18.02.19 12:48. Заголовок: SergKis пишет: Спас..
SergKis пишет: цитата: | Спасает сохранение\восстановление колонок, hBrush |
| Переписал этот метод с учетом Вашего вклада следующим образом: METHOD Enabled( lEnab ) CLASS TSBrowse Local nI Default lEnab := .T. IF ValType( lEnab ) == "L" IF !lEnab IF ::lEnabled ::aOldEnabled := { ::hBrush, {}, ::nClrPane } For nI := 1 TO Len( ::aColumns ) AAdd( ::aOldEnabled[2], ::aColumns[ nI ]:Clone() ) ::aColumns[ nI ]:SaveColor() Next ENDIF ::lEnabled := .F. ::SetColor( { 2 }, { ::nCLR_HGRAY } ) ::SetColor( { 3, 4 }, { ::nCLR_GRAY, ::nCLR_HGRAY } ) ::SetColor( { 9, 10 }, { ::nCLR_GRAY, ::nCLR_HGRAY } ) ::SetColor( { 16, 17 }, { ::nCLR_GRAY, ::nCLR_HGRAY } ) ::SetColor( { 18, 19 }, { ::nCLR_GRAY, ::nCLR_HGRAY } ) ::nClrPane := ::nCLR_HGRAY ::hBrush := CreateSolidBrush( GetRed( ::nClrPane ), GetGreen( ::nClrPane ), GetBlue( ::nClrPane ) ) ELSE IF ! ::lEnabled For nI := 1 TO Len( ::aColumns ) ::aColumns[ nI ]:RestColor() SetColor( , ::aColumns[ nI ]:aColors, nI ) Next If HB_ISARRAY( ::aOldEnabled ) .and. ! Empty( ::aOldEnabled[1] ) AEval( ::aOldEnabled[2], {|oc, nc| ::aColumns[ nc ] := oc:Clone() } ) DeleteObject( ::hBrush ) ::hBrush := ::aOldEnabled[1] ::nClrPane := ::aOldEnabled[3] EndIf ENDIF ::lEnabled := .T. ENDIF ::Refresh() ENDIF RETURN 0 Хуже вроде не стало. Благодарю за помощь
| |
|
SergKis
|
| постоянный участник
|
Пост N: 2241
Зарегистрирован: 17.02.12
|
|
Отправлено: 18.02.19 13:42. Заголовок: gfilatov2002 :sm36..
gfilatov2002 Было бы хорошо добавить параметры Clr1, Clr2, для управления, если BackColor окна не CLR_GRAY\HGREY
| |
|
gfilatov2002
|
| moderator
|
Пост N: 1446
Зарегистрирован: 11.02.10
|
|
Отправлено: 18.02.19 13:49. Заголовок: SergKis пишет: для..
SergKis пишет: цитата: | для управления, если BackColor окна не CLR_GRAY\HGREY |
| Для этого я добавил в класс DATA nClr_Gray AS NUMERIC INIT CLR_GRAY DATA nClr_HGray AS NUMERIC INIT CLR_HGRAY
| |
|
SergKis
|
| постоянный участник
|
Пост N: 2242
Зарегистрирован: 17.02.12
|
|
Отправлено: 18.02.19 13:49. Заголовок: PS И добавить сохран..
PS И добавить сохранение\восстановление цветов SuperHeader
| |
|
SergKis
|
| постоянный участник
|
Пост N: 2243
Зарегистрирован: 17.02.12
|
|
Отправлено: 18.02.19 13:51. Заголовок: gfilatov2002 пишет Д..
gfilatov2002 пишет цитата: | Для этого я добавил в класс |
| Похоже глаз замылился, не увидел, сору.
| |
|
SergKis
|
| постоянный участник
|
Пост N: 2244
Зарегистрирован: 17.02.12
|
|
Отправлено: 18.02.19 14:37. Заголовок: gfilatov2002 Добави..
gfilatov2002 Добавил SuperHeader IF ::lEnabled ::aOldEnabled := { ::hBrush, {}, ::nClrPane, {} } For nI := 1 TO Len( ::aColumns ) AAdd( ::aOldEnabled[2], ::aColumns[ nI ]:Clone() ) ::aColumns[ nI ]:SaveColor() Next If ::lDrawSuperHd AEval( ::aSuperHead, {|as| AAdd( ::aOldEnabled[4], { as[4], as[5], as[11] } ) } ) EndIf ENDIF ... If HB_ISARRAY( ::aOldEnabled ) .and. ! Empty( ::aOldEnabled[1] ) AEval( ::aOldEnabled[2], {|oc, nc| ::aColumns[ nc ] := oc:Clone() } ) DeleteObject( ::hBrush ) ::hBrush := ::aOldEnabled[1] ::nClrPane := ::aOldEnabled[3] If ::lDrawSuperHd AEval( ::aOldEnabled[4], {|as,ns| ::aSuperHead[ns][ 4] := as[1], ; ::aSuperHead[ns][ 5] := as[2], ; ::aSuperHead[ns][11] := as[3] } ) EndIf EndIf ... Пример Tsb_seek добавил ... ADD COLUMN TO br_zaw DATA {|| test->street } ALIGN DT_LEFT, DT_CENTER, DT_CENTER TITLE 'Street' SIZE 300 br_zaw:hBrush := CreateSolidBrush( 242, 245, 204 ) ADD SUPER HEADER TO br_zaw FROM COLUMN 1 TO COLUMN br_zaw:nColCount() ; TITLE " SuperHeader" br_zaw:bUserKeys := {|nKey,nFlags| fszuk1(nkey,nflags) } ... Работает
| |
|
gfilatov2002
|
| moderator
|
Пост N: 1447
Зарегистрирован: 11.02.10
|
|
Отправлено: 18.02.19 15:24. Заголовок: SergKis пишет: Доба..
SergKis пишет: цитата: | Добавил SuperHeader ... Работает |
| Спасибо
| |
|
Andrey
|
| постоянный участник
|
Пост N: 6180
Зарегистрирован: 12.09.06
|
|
Отправлено: 18.02.19 15:35. Заголовок: Григорий, я пример в..
Григорий, я пример выслал на почту. Там наверное нужно переделать сохранение/восстановление цветов с учётом этих новых правок ?
| |
|
SergKis
|
| постоянный участник
|
Пост N: 2246
Зарегистрирован: 17.02.12
|
|
Отправлено: 19.02.19 12:57. Заголовок: gfilatov2002 По пов..
gfilatov2002 По поводу предложения в tree node\item cargo. То что я использовал _HMG_aControlHeadClick, наверно, не очень правильно. Лучше _HMG_aControlMiscData1[ k ] := { 0, aImgNode, aImgItem, {} }, плюс использовать NodeHandle := _HMG_NodeHandle[ NodeIndex ] и AAdd( a_Node_Item_Cargo, { NodeHandle, Cargo } ) тогда вся работа с node\item cargo - это поиск по NodeHandle для удаления, выбора и сортировка будет без разницы. При добавлении новых node\item вставлять их в самый конец массива. По мне так все ровненько выходит. Cargo на node\item это небходимость упрощения работы. Сейчас приходится добавлять в node\item ключи (счетчики пунктов), потом бегать по дереву составляя выбранный ключ и потом через табл. перекодировки добывать реальный ключ и через него др. данные, но и это не спасает для трех языков одновременно (unicode версия) и в дереве могут находится сразу 3-и термина языковых одновременно, т.е. с одинаковыми ключами и разными счетчиками пунктов. Мороки много, так, что исп. tree не хочется
| |
|
gfilatov2002
|
| moderator
|
Пост N: 1448
Зарегистрирован: 11.02.10
|
|
Отправлено: 19.02.19 22:16. Заголовок: SergKis пишет: То ч..
SergKis пишет: цитата: | То что я использовал _HMG_aControlHeadClick, наверно, не очень правильно. |
| Возможно. Но, как известно, лучшее - враг хорошего В тираж ушло Ваше первое решение, оно органично вписалось в текущую логику при построении дерева. Также добавил поддержку псевдо-объекта This для этого Cargo как показано ниже цитата: | *-----------------------------------------------------------------------------* FUNCTION OnReturnTree() *-----------------------------------------------------------------------------* LOCAL nItm := This.Value LOCAL cWnd := ThisWindow.Name LOCAL cCtl := This.Name LOCAL lIsN := TreeItemIsTrueNode ( cCtl, cWnd, nItm ) LOCAL cItm := This.&(cCtl).Item( nItm ) LOCAL cCrg := This.&(cCtl).Cargo( nItm ) MsgBox( "#" + hb_ntos (nItm) + " --> " + cItm + ' ' + ; iif( lIsN, 'TrueNode', 'Node' )+ CRLF + ; cValToChar(cCrg), ; cWnd + '.' + cCtl ) RETURN Nil *-----------------------------------------------------------------------------* Procedure AddItemTest() *-----------------------------------------------------------------------------* LOCAL i Form_1.Tree_1.DeleteAllItems Form_1.Tree_1.AddItem( 'New Root Item 1' , 0 ) Form_1.Tree_1.AddItem( 'New Item 1.1' , 1 ) Form_1.Tree_1.AddItem( 'New Item 1.2' , 1 ) Form_1.Tree_1.AddItem( 'New Item 1.3' , 1 ) Form_1.Tree_1.AddItem( 'New Root Item 2' , 0 ) Form_1.Tree_1.AddItem( 'New Item 2.1' , 5 ) Form_1.Tree_1.AddItem( 'New Item 2.2' , 5 ) Form_1.Tree_1.AddItem( 'New Item 2.3' , 5 ) Form_1.Tree_1.AddItem( 'New Item 1.4' , 1 ) Form_1.Tree_1.AddItem( 'New Item 1.4.1' , 5 ) For i := 1 To Form_1.Tree_1.ItemCount Form_1.Tree_1.Cargo( i ) := Form_1.Tree_1.Item( i ) Next Return |
|
| |
|
gfilatov2002
|
| moderator
|
Пост N: 1449
Зарегистрирован: 11.02.10
|
|
Отправлено: 20.02.19 11:57. Заголовок: Всем, кому это интересно
Подготовил третий релиз-кандидат для новой сборки 19.02 Кратко, что нового (см.ниже) Скрытый текст
* Fixed a program crash happens occasionally in Windows 10 only and only for non-admin users. * Added the new class TDlu2Pix for managing of the UI controls sizing. * Added the new ON INIT <bBlock> clause for the basic (non all) controls. Example: DEFINE LABEL Label_1 ON INIT {|| This.Row := :Y, This.Col := :X, This.Width := :W1,; This.Height := :H1, :Y += This.Height + :GapsHeight } END LABEL * ACTIVATE WINDOW command supports an optional ON INIT clause. * TREE control supports an optional CARGO clause for the nodes and items at theirs definition, i.e. NODE <text> [ IMAGES <aImage> ] [ ID <id> ] [ CARGO <Cargo> ] TREEITEM <text> [ IMAGES <aImage> ] [ ID <id> ] [ CARGO <Cargo> ] * The Getbox control's value with "@K" PICTURE property will be selected at ON GOTFOCUS event. * 'Application' object supports the read/write property 'Object'. Syntax: Application.Object [ := <arg> ] * Updated the TSBrowse, RDDLeto and Sqlite3 libraries. * Updated HMGS-IDE to version 1.4.3.6. * Updated Harbour Compiler 3.2.0dev to a recent Git-version. (ChangeLog Last Entry: 2019-02-11 13:51) * Added the new interesting samples and updated some Advanced samples.
| Благодарю Сергея Киселева за неоценимую помощь в подготовке этой сборки Возможно, Вы хотите присоединиться к команде разработчиков Минигуи
| |
|
SergKis
|
| постоянный участник
|
Пост N: 2247
Зарегистрирован: 17.02.12
|
|
Отправлено: 20.02.19 14:01. Заголовок: gfilatov2002 пишет В..
gfilatov2002 пишет цитата: | Возможно, Вы хотите присоединиться к команде разработчиков Минигуи |
| Думаю, что нет, т.к. практически все разночтения между версиями hmg текущей и нашей (в базе 2.07) сняты. Товарищ, по работе, переводит на VC2017 hb в unucod с LV866 по правилам hb и тек. нашу версию hmg + C либы. Я максимально сближаю нашу версию hmg с текущей. В планах, последним шагом, тек. версию hmg сделать unicode, т.е. переползти на родную hmg
| |
|
SergKis
|
| постоянный участник
|
Пост N: 2248
Зарегистрирован: 17.02.12
|
|
Отправлено: 21.02.19 16:27. Заголовок: gfilatov2002 Неболь..
| |
|
gfilatov2002
|
| moderator
|
Пост N: 1450
Зарегистрирован: 11.02.10
|
|
Отправлено: 21.02.19 17:06. Заголовок: SergKis пишет: прим..
SergKis пишет: цитата: | пример Tree по каталогам hmg |
| Супер Большое спасибо за пример
| |
|
SergKis
|
| постоянный участник
|
Пост N: 2249
Зарегистрирован: 17.02.12
|
|
Отправлено: 21.02.19 21:04. Заголовок: gfilatov2002 Добавь..
gfilatov2002 Добавьте, пожалуйста, в CLASS TKeyData ... ACCESS IsEvent INLINE ::lKey ASSIGN KeyUpper( lUpper ) INLINE hb_HCaseMatch( ::aKey, ! Empty( lUpper ) ) METHOD ISBLOCK( Key ) INLINE HB_ISBLOCK( ::Get( Key ) ) ...
| |
|
gfilatov2002
|
| moderator
|
Пост N: 1451
Зарегистрирован: 11.02.10
|
|
Отправлено: 21.02.19 21:14. Заголовок: SergKis пишет: Доба..
SergKis пишет: цитата: | Добавьте, пожалуйста, в CLASS TKeyData |
| OK
| |
|
SergKis
|
| постоянный участник
|
Пост N: 2252
Зарегистрирован: 17.02.12
|
|
Отправлено: 23.02.19 20:04. Заголовок: gfilatov2002 Неболь..
gfilatov2002 Небольшая оболочка для hmg https://TransFiles.ru/dujpq Хотел сделать без сообщений, но DublClick на Tree в Item оставляет фокус на Item, а не на TsBrowse. Сделал работу по сообщениям. На вопросы отвечу
| |
|
gfilatov2002
|
| moderator
|
Пост N: 1452
Зарегистрирован: 11.02.10
|
|
Отправлено: 23.02.19 23:09. Заголовок: SergKis пишет: Небо..
SergKis пишет: цитата: | Небольшая оболочка для hmg |
| Большое спасибо! Очень хорошо SergKis пишет: цитата: | Хотел сделать без сообщений |
| Было бы тоже интересно... SergKis пишет: Наверное, небольшое описание как использовать не помешает
| |
|
SergKis
|
| постоянный участник
|
Пост N: 2254
Зарегистрирован: 17.02.12
|
|
Отправлено: 24.02.19 00:05. Заголовок: gfilatov2002 пишет Н..
gfilatov2002 пишет цитата: | Наверное, небольшое описание как использовать не помешает |
| 1. Располагаю на уровне каталогов Advanced Application Basic TEST в нем подкаталог HmgPrj -> разорачиваем архив. Запускаемся. 2. Пример взаимодействия tree + tsbrowse 3. Изучаем содержимое текстов hmg (source, примеры, утилиты, doc) - в tree выбираем item с файлом - для txt, ch запустится редактор сразу - для prg, c в tsb создается список Entity, по ключевым словам, номер строки в тексте и содержимое строки. Работают сортировки в колонках Line, Entity type, Entity name (двойной клик). Выбрав строку нужную Enter, DblClick попадем на указанную строку в редакторе 4. Пример использования App.Cargo, App.Object, ThisWindow.Object Можно, конечно, добавить сборку minigui lib-ов, но не ставил такую цель
| |
|
SergKis
|
| постоянный участник
|
Пост N: 2255
Зарегистрирован: 17.02.12
|
|
Отправлено: 24.02.19 00:15. Заголовок: PS Ключевые слова дл..
PS Ключевые слова для C, PRG + FColor задаются в массивах (можно сделать из вне) см. AppInitEnv() Запуск редактора в App.Object строка (см. STAT FUNC PrjStart( cPath, cDir )) :O:Ed := cDir + 'ED' + cSep + 'Notepad3.exe' из :O:ChLog := cPath + 'DOC' + cSep + 'ChangeLog.txt' берется root текст для Tree
| |
|
SergKis
|
| постоянный участник
|
Пост N: 2256
Зарегистрирован: 17.02.12
|
|
Отправлено: 24.02.19 00:32. Заголовок: PPS Запуск редактора..
PPS Запуск редактора (два варианта) в строках :Event( 2, {|ow,ky,par| _Execute ( , , ow:AO:Ed, par, , 5 ) } ) // без номера строки :Event( 3, {|ow,ky,par| _Execute ( , , ow:AO:Ed, '/g '+par[1]+' '+par[2], , 5 ) } ) // с установкой на номер строки Notepad3.exe использован по причине наличия подсветки Harbour синтаксиса. Можно исп. другой. Notepad2.exe как пример другого лежит рядом в ED каталоге
| |
|
SergKis
|
| постоянный участник
|
Пост N: 2257
Зарегистрирован: 17.02.12
|
|
Отправлено: 24.02.19 07:50. Заголовок: gfilatov2002 пишет Б..
gfilatov2002 пишет цитата: | Было бы тоже интересно... |
| Тут без евентов (строки помечены // !!!) https://TransFiles.ru/3i5po Разницы по тексту почти нет, но DblClick по дереву не переключает фокус на TsBrowse. Команда в STAT FUNC Read_Entity( cFile, cItem ) стоит oBrw:Cargo := cFile oBrw:aSuperHead[1, 3] := upper(cFile) oBrw:Reset() oBrw:SetFocus() DO EVENTS
| |
|
SergKis
|
| постоянный участник
|
Пост N: 2258
Зарегистрирован: 17.02.12
|
|
Отправлено: 24.02.19 08:28. Заголовок: PS добавление новых ..
PS добавление новых ключевых слов Скрытый текст
AppInitEnv() ... aEntityPrg := { "FUNC " , ; ... "PROCEDURE " , ; "CREATE CLASS " , ; "CLASS " , ; "END CLASS " , ; ... aEntityFClr := { { "STAT " , CLR_BLUE }, ; { "STATIC " , CLR_BLUE }, ; { "CREATE" , CLR_RED }, ; { "CLASS " , CLR_RED }, ; { "ENDCLASS ", CLR_RED }, ; { "END " , CLR_RED }, ; { "DEFINE " , CLR_RED }, ; ...
|
| |
|
SergKis
|
| постоянный участник
|
Пост N: 2259
Зарегистрирован: 17.02.12
|
|
Отправлено: 24.02.19 09:12. Заголовок: PPS Отсечь каталоги ..
PPS Отсечь каталоги из просмотра можно так Скрытый текст
*-----------------------------------------------------------------------------* STAT FUNC PrjSampl( nNr ) *-----------------------------------------------------------------------------* LOCAL aMask := {"*.prg", "*.cpp", "*.c", "*.ch"} LOCAL aNoDir := {"OBJ,ED,TMP,TEMP"} // было {"OBJ"} DEFAULT nNr := TREE_NODE_SAMLPES WITH OBJECT App.Object :O:aSampl := DirListHmg(:O:Sampl, aMask, .T., .F., aNoDir) END WITH RETURN Nil
|
| |
|
gfilatov2002
|
| moderator
|
Пост N: 1453
Зарегистрирован: 11.02.10
|
|
Отправлено: 24.02.19 18:50. Заголовок: SergKis пишет: DblC..
SergKis пишет: цитата: | DblClick по дереву не переключает фокус на TsBrowse |
| Решил эту проблему с помощью простого таймера: цитата: | oBrw:Reset() DEFINE TIMER t_1 OF &cWnd INTERVAL 50 ACTION ( oBrw:SetFocus(), DOMETHOD( cWnd, "t_1", "RELEASE" ) ) ONCE DO EVENTS |
| предварительно добавив 3-й параметр в функцию цитата: | STAT FUNC Read_Entity( cFile, cItem, cWnd ) |
| Теперь фокус переключается нормально
| |
|
gfilatov2002
|
| moderator
|
Пост N: 1454
Зарегистрирован: 11.02.10
|
|
Отправлено: 24.02.19 18:52. Заголовок: SergKis пишет: Тут ..
SergKis пишет: Большое спасибо
| |
|
SergKis
|
| постоянный участник
|
Пост N: 2260
Зарегистрирован: 17.02.12
|
|
Отправлено: 25.02.19 09:39. Заголовок: gfilatov2002 пишет Р..
gfilatov2002 пишет цитата: | Решил эту проблему с помощью простого таймера предварительно добавив 3-й параметр в функцию Теперь фокус переключается нормально |
| Это все хорошо Что бы этого не делать + убираются и др. бяки, предпочитаю работать с Event-ами. Тексты при этом не сильно отличаются (на примере видно). gfilatov2002 Можно добавить в h_objmisc.prg *-----------------------------------------------------------------------------* FUNCTION _wPost( nEvent, nIndex, xParam ) *-----------------------------------------------------------------------------* LOCAL oWnd If HB_ISOBJECT(nIndex) If nIndex:ClassName == 'TSBROWSE' oWnd := _WindowObj( nIndex:cParentWnd ) Else oWnd := nIndex EndIf nIndex := Nil Else oWnd := _WindowObj( _HMG_THISFORMNAME ) EndIf oWnd:PostMsg( nEvent, nIndex, xParam ) RETURN Nil *-----------------------------------------------------------------------------* FUNCTION _wSend( nEvent, nIndex, xParam ) *-----------------------------------------------------------------------------* LOCAL oWnd If HB_ISOBJECT(nIndex) If nIndex:ClassName == 'TSBROWSE' oWnd := _WindowObj( nIndex:cParentWnd ) Else oWnd := nIndex EndIf nIndex := Nil Else oWnd := _WindowObj( _HMG_THISFORMNAME ) EndIf oWnd:SendMsg( nEvent, nIndex, xParam ) RETURN Nil проще писать в текстах, например: ON DBLCLICK (ThisWindow.Object):Post(1, This.Index) ; --> _wPost(1, This.Index) :UserKeys(VK_ESCAPE, {|ob| _WindowObj(ob:cParentWnd):Send(4) } ) --> :UserKeys(VK_ESCAPE, {|ob| _wSend(4, ob) }) :UserKeys(VK_RETURN, {|ob,ow,cl| ow := _WindowObj(ob:cParentWnd), ; cl := hb_ntos((ob:cAlias)->R_2), ; ow:Send(3, , { cl, ob:Cargo }) } ) --> :UserKeys(VK_RETURN, {|ob| _wSend(3,ob, { hb_ntos((ob:cAlias)->R_2), ob:Cargo }) } )
| |
|
gfilatov2002
|
| moderator
|
Пост N: 1455
Зарегистрирован: 11.02.10
|
|
Отправлено: 25.02.19 10:42. Заголовок: SergKis пишет: доба..
SergKis пишет: OK, добавил P.S. Новая сборка выйдет завтра...
| |
|
gfilatov2002
|
| moderator
|
Пост N: 1456
Зарегистрирован: 11.02.10
|
|
Отправлено: 26.02.19 10:19. Заголовок: Выпущена новая сборк..
Выпущена новая сборка 19.02 для BCC 5.5.1 и компиляторов Harbour и xHarbour. Инсталлятор базового дистрибутива находится по адресу http://hmgextended.com/files/CONTRIB/hmg-19.02-setup.exe Также имеются дополнительные сборки для следующих Си-компиляторов: - MinGW 8.1.0 32-bit для Harbour 3.2.0dev; (есть в наличии) - MinGW 8.2.0 64-bit для Harbour 3.4.0dev; (есть в наличии) - MS VisualC 2017 32-bit для Harbour 3.2.0dev; (путь и имя архива не изменял) - MS VisualC 2017 64-bit для Harbour 3.2.0dev; (путь и имя архива не изменял) - Pelles C 8.0 32-bit для xHarbour b10244; (под заказ) - Pelles C 9.0 64-bit для xHarbour b10244; (под заказ) - Borland/Embarcadero C++ 7.3 (32-bit) для Harbour 3.2.0dev; (под заказ) - Open Watcom C/C++ 2.0 (32-bit) для Harbour 3.2.0dev. (под заказ) Благодарю за Ваше внимание
| |
|
SergKis
|
| постоянный участник
|
Пост N: 2261
Зарегистрирован: 17.02.12
|
|
Отправлено: 27.02.19 21:18. Заголовок: Возможно, будет поле..
Возможно, будет полезно (на базе пред. примера). Утилита hmg_project для просмотра исходников MiniGui https://TransFiles.ru/o9ytl Добавлен пункт All entity для списка всех entity объектов файлов C и PRG каталога SOURCE. На индексных колонках есть подвод по вводимому тексту (для колонки line это по name файла) Архив разворачивать в UTILS\hmg_project. Сборка только под посл. версией hmg. На вопросы отвечу.
| |
|
gfilatov2002
|
| moderator
|
Пост N: 1457
Зарегистрирован: 11.02.10
|
|
Отправлено: 27.02.19 23:33. Заголовок: SergKis пишет: Утил..
SergKis пишет: цитата: | Утилита hmg_project для просмотра исходников |
| Большое спасибо SergKis пишет: Да, очень наглядный пример системной утилиты
| |
|
Andrey
|
| постоянный участник
|
Пост N: 6182
Зарегистрирован: 12.09.06
|
|
Отправлено: 27.02.19 23:55. Заголовок: SergKis пишет: Утил..
SergKis пишет: цитата: | Утилита hmg_project для просмотра исходников MiniGui |
| Можно ли добавить в эту утилиту глобальный поиск по исходникам, но только не отдельных слов (это просто, можно Far использовать), а поиск по строкам 2х или 3х слов одновременно (Far такого не может) ?
| |
|
TimTim
|
| |
Пост N: 162
Зарегистрирован: 10.07.07
|
|
Отправлено: 28.02.19 08:31. Заголовок: А что мелочиться, ср..
А что мелочиться, сразу уж поиск по регулярному выражению.
| |
|
SergKis
|
| постоянный участник
|
Пост N: 2262
Зарегистрирован: 17.02.12
|
|
Отправлено: 28.02.19 08:52. Заголовок: Andrey пишет Можно л..
Andrey пишет цитата: | Можно ли добавить в эту утилиту глобальный поиск по исходникам, но только не отдельных слов |
| Не понятно, какие фразы надо искать в исходниках hmg ? В своих и во многих проектах, понятно, в данных mem полей или текстовых данных баз, тоже ясно. И TimTim прав, лучше с регулярным выражением. Но это др. утилита, по мне.
| |
|
Haz
|
| |
Пост N: 1440
Зарегистрирован: 20.02.11
|
|
Отправлено: 01.03.19 10:49. Заголовок: Andrey пишет: Можно..
Andrey пишет: цитата: | Можно ли добавить в эту утилиту глобальный поиск по исходникам, но только не отдельных слов (это просто, можно Far использовать), а поиск по строкам 2х или 3х слов одновременно (Far такого не может) ? |
| Far такое может , ставим плагин RESearch и ищем по регулярным выражениям насколько фантазии хватит в этих выражениях
| |
|
Andrey
|
| постоянный участник
|
Пост N: 6183
Зарегистрирован: 12.09.06
|
|
Отправлено: 01.03.19 14:57. Заголовок: Haz пишет: плагин R..
Haz пишет: цитата: | плагин RESearch и ищем по регулярным выражениям насколько фантазии хватит в этих выражениях |
| А я и не знал... Спасибо БОЛЬШОЕ !
| |
|
SergKis
|
| постоянный участник
|
Пост N: 2263
Зарегистрирован: 17.02.12
|
|
Отправлено: 02.03.19 13:38. Заголовок: gfilatov2002 Неболь..
gfilatov2002 Небольшая правка в hmg_project DEFINE TREE Tree_1 AT :Y, :X ; WIDTH :W4 ; HEIGHT This.ClientHeight - This.StatusBar.Height - :Y * 2 ; VALUE 1 ; FONT "font_1" ; ON CHANGE _wSend(11) ; ON DBLCLICK _wPost(1, This.Index) ; ... STAT FUNCTION OnReturnTree() ... If 'All.*' $ cCrg oBrw := (This.AllEntity.Object):Tsb nCnt := This.&(cCtl).ItemCount _wPost(7, , '... W A I T ...') // :StatusBar:Say('... W A I T ...') _wSend(8) :Action := .F. dbSelectArea( oBrw:cAlias ) ... oBrw:SetFocus() DO EVENTS :Action := .T. _wPost(7, , '') // :StatusBar:Say('') ... на время формирования списка тсб "All entity" блокируется X окна
| |
|
SergKis
|
| постоянный участник
|
Пост N: 2264
Зарегистрирован: 17.02.12
|
|
Отправлено: 02.03.19 13:56. Заголовок: PS и еще FUNCTION A..
PS и еще FUNCTION AppInitEnv() ... SET BROWSESYNC ON SET CENTERWINDOW RELATIVE PARENT _HMG_MESSAGE [1] := 'Are you sure ?' _HMG_MESSAGE [2] := 'Close Window' aEntityC := { "HB_FUNC(" , ; ...
| |
|
gfilatov2002
|
| moderator
|
Пост N: 1458
Зарегистрирован: 11.02.10
|
|
Отправлено: 02.03.19 19:13. Заголовок: SergKis пишет: Небо..
SergKis пишет: цитата: | Небольшая правка в hmg_project |
| Спасибо
| |
|
SergKis
|
| постоянный участник
|
Пост N: 2265
Зарегистрирован: 17.02.12
|
|
Отправлено: 10.03.19 21:50. Заголовок: gfilatov2002 Мелочь..
gfilatov2002 Мелочь, конечно, но так правильнее FUNCTION _wPost( nEvent, nIndex, xParam ) ... If HB_ISOBJECT( nIndex ) If nIndex:ClassName == 'TSBROWSE' oWnd := _WindowObj ( nIndex:cParentWnd ) nIndex := oWnd:GetObj( nIndex:cControlName ) Else oWnd := nIndex nIndex := Nil EndIf Else ... FUNCTION _wSend( nEvent, nIndex, xParam ) ... If HB_ISOBJECT( nIndex ) If nIndex:ClassName == 'TSBROWSE' oWnd := _WindowObj ( nIndex:cParentWnd ) nIndex := oWnd:GetObj( nIndex:cControlName ) Else oWnd := nIndex nIndex := Nil EndIf Else ... Тогда в блоке кода события, как в action кнопок и др. контролов, будет среда This для TsBrowse, т.е. сообщение _wPost(12, oBrw) oWnd:Event(12, {|obr,cbr,cwn| obr := (This.Object):Tsb, ; // объект oBrw cbr := This.Name, ; // имя TsBrowse cwn := ThisWindow.Name, ... }) // имя окна
| |
|
SergKis
|
| постоянный участник
|
Пост N: 2266
Зарегистрирован: 17.02.12
|
|
Отправлено: 10.03.19 21:54. Заголовок: gfilatov2002 Прошу ..
gfilatov2002 Прошу прощения не добрал команду nIndex := oWnd:GetObj( nIndex:cControlName ):Index
| |
|
gfilatov2002
|
| moderator
|
Пост N: 1459
Зарегистрирован: 11.02.10
|
|
Отправлено: 10.03.19 22:14. Заголовок: SergKis пишет: в бл..
SergKis пишет: цитата: | в блоке кода события, как в action кнопок и др. контролов, будет среда This для TsBrowse |
| OK
| |
|
gfilatov2002
|
| moderator
|
Пост N: 1460
Зарегистрирован: 11.02.10
|
|
Отправлено: 15.03.19 18:00. Заголовок: Подготовил первый ре..
Подготовил первый релиз-кандидат для новой сборки 19.03 Кратко, что нового: Скрытый текст
* Misc bugfixes for the memory leaks in the ToolBar[Ex] control. It was an ugly mistake with missed release of the bitmaps at a destroying of a Tool Button. * Added a ban on an editing in a Browse control for databases that were opened with the READONLY clause. Otherwise, an error "Write not allowed" will occur. * Added the following useful network functions: - NetRecLock( nSeconds ); - NetFileLock( nSeconds ); - NetAppend( nSeconds, lReleaseLocks ); - NetDelete(); - NetRecall(); - IsLocked( nRecId ); - NetError(). The above network functions were used in a BROWSE control. * Necessity of a lock's setting at the BROWSE editing will be defined automatically for a database that opened in a shared mode. * Added 'FIELD' clause (optional) to CHECKLABEL and SWITCHER controls. They supports the 'Refresh' and 'Save' methods now. * The unneeded clauses in the command GRAPH BITMAP may be omitted: - TITLECOLOR (default is BLACK); - SHOWGRID .T. supersede SHOWXGRID .T. and SHOWYGRID .T.; - SEPARATION is NIL by default; - NOBORDER is .F. by default. * Added the following PROGRESSBAR MARQUEE commands for compatibility with Official HMG: SET PROGRESSBAR <name> OF <parent> ENABLE MARQUEE ; [ UPDATED <milliseconds> ] SET PROGRESSBAR <name> OF <parent> DISABLE MARQUEE * Updated the RDDLeto and Sqlite3 libraries. * Added the new interesting samples and updated some Advanced samples.
| Рассматриваю эту сборку как финальную вследствие невозможности продолжения работы по финансовым причинам
| |
|
dimao
|
| |
Пост N: 93
Зарегистрирован: 14.01.09
|
|
Отправлено: 16.03.19 11:35. Заголовок: Ой! Вы опубликуйте Я..
Ой! Вы опубликуйте Яндекс кошелек. Может нам удастся как то компенсировать ваши старания!
| |
|
gfilatov2002
|
| moderator
|
Пост N: 1461
Зарегистрирован: 11.02.10
|
|
Отправлено: 18.03.19 10:13. Заголовок: dimao пишет: опубли..
dimao пишет: цитата: | опубликуйте Яндекс кошелек |
| Благодарю за отклик, но Яндекс кошельки заблокированы на Украине. Единственный реальный путь - оплата через PayPal (РЕКВИЗИТЫ ЕСТЬ НА САЙТЕ).
| |
|
Vlad04
|
| постоянный участник
|
Пост N: 814
Зарегистрирован: 13.10.05
|
|
Отправлено: 18.03.19 11:22. Заголовок: Не Единственный. Как..
Не Единственный. Как пишут цитата: | Самый простой и оптимальный вариант: перечисление через сайт paysend.com Системе не важно, где были эмитированы карты — главное, чтобы они были открыты в международных платежных системах (Mastercard, Maestro, Visa). Работа с системой «МИР» не поддерживается. Нужен только интернет и номер карточки адресата. Комиссия при этом фиксирована и составляет всего 49 рублей в независимости от суммы перевода. |
|
| |
|
PSP
|
| постоянный участник
|
Пост N: 1508
Зарегистрирован: 27.01.07
|
|
Отправлено: 18.03.19 11:53. Заголовок: Какой принцип оплаты..
Какой принцип оплаты (вознаграждения) приемлем? Единоразово (лицензия), периодически (покупка текущего релиза)? Какова сумма?
| |
|
gfilatov2002
|
| moderator
|
Пост N: 1462
Зарегистрирован: 11.02.10
|
|
Отправлено: 18.03.19 11:59. Заголовок: PSP пишет: Какой пр..
PSP пишет: цитата: | Какой принцип оплаты (вознаграждения) приемлем? |
| Любой PSP пишет: цитата: | Единоразово (лицензия), периодически (покупка текущего релиза)? |
| Желательно, периодически PSP пишет: На Ваше усмотрение, т,е, пожертвование
| |
|
PSP
|
| постоянный участник
|
Пост N: 1510
Зарегистрирован: 27.01.07
|
|
Отправлено: 18.03.19 12:07. Заголовок: Создал отдельную тем..
| |
|
Andrey
|
| постоянный участник
|
Пост N: 6185
Зарегистрирован: 12.09.06
|
|
Отправлено: 18.03.19 12:55. Заголовок: gfilatov2002 пишет: ..
gfilatov2002 пишет: цитата: | Подготовил первый релиз-кандидат для новой сборки 19.03 |
| Григорий, а туда войдёт пример FormDarken(0.7).7z ? А то Сергей классно там описал в функции SayValueObj() методы и как работать с объектами через oWnd := ThisWindow.Object
| |
|
gfilatov2002
|
| moderator
|
Пост N: 1463
Зарегистрирован: 11.02.10
|
|
Отправлено: 18.03.19 14:19. Заголовок: Andrey пишет: туда ..
| |
|
Andrey
|
| постоянный участник
|
Пост N: 6186
Зарегистрирован: 12.09.06
|
|
Отправлено: 18.03.19 14:44. Заголовок: gfilatov2002 пишет: ..
gfilatov2002 пишет: Тогда туда же и этот большой проект положите - Tsb_composite(2.18).7z
| |
|
gfilatov2002
|
| moderator
|
Пост N: 1464
Зарегистрирован: 11.02.10
|
|
Отправлено: 18.03.19 15:05. Заголовок: Andrey пишет: этот..
Andrey пишет: цитата: | этот большой проект положите - Tsb_composite |
| Добавил на эту страницу этот проект тоже
| |
|
Haz
|
| |
Пост N: 1444
Зарегистрирован: 20.02.11
|
|
Отправлено: 20.03.19 18:31. Заголовок: Косячек в ::GoToRec()
Григорий, уберите пожалуйста проверку на номер записи. С индексами и фильтром при наличии проверки не работает метод ( конкретно под ADS , остальное не проверял ) METHOD GotoRec( nRec, nRowPos ) CLASS TSBrowse LOCAL cAlias LOCAL nSkip LOCAL n LOCAL nRecSave LOCAL lRet := .F. LOCAL lReCount := .F. IF ::lIsDbf javascript:pst3('','','','[font%20color=blue]',''); lRet := .T. cAlias := ::cAlias ::nLastPos := ( cAlias )->( RecNo() ) вот эта строка портит позицию если удалить все нормально nRec := Min( ( cAlias )->( LastRec() ), nRec ) с этой проверкой пытается встать на запись которая не входит в фильтр
| |
|
gfilatov2002
|
| moderator
|
Пост N: 1472
Зарегистрирован: 11.02.10
|
|
Отправлено: 20.03.19 21:01. Заголовок: Haz пишет: с этой п..
Haz пишет: цитата: | с этой проверкой пытается встать на запись которая не входит в фильтр |
| Поправил. Благодарю за помощь
| |
|
gfilatov2002
|
| moderator
|
Пост N: 1476
Зарегистрирован: 11.02.10
|
|
Отправлено: 27.03.19 11:02. Заголовок: Выпустил новую сборк..
Выпустил новую сборку 19.03 для BCC 5.5.1 и компиляторов Harbour и xHarbour. Базовый дистрибутив находится по адресу http://hmgextended.com/files/CONTRIB/hmg-19.03-setup.exe Также имеются дополнительные сборки для следующих Си-компиляторов: - MinGW 8.3.1 32-bit для Harbour 3.2.0dev; (есть в наличии) - MinGW 8.2.0 64-bit для Harbour 3.4.0dev; (есть в наличии) - MS VisualC 2017 32-bit для Harbour 3.2.0dev; (путь и имя архива не изменял) - MS VisualC 2017 64-bit для Harbour 3.2.0dev; (путь и имя архива не изменял) - Pelles C 8.0 32-bit для xHarbour b10244; (под заказ) - Pelles C 9.0 64-bit для xHarbour b10244; (под заказ) - Borland/Embarcadero C++ 7.3 (32-bit) для Harbour 3.2.0dev; (под заказ) - Open Watcom C/C++ 2.0 (32-bit) для Harbour 3.2.0dev. (под заказ) Эти сборки доступны для всех, кто сделал пожертвование для поддержки развития библиотеки Благодарю за Ваше внимание
| |
|
Andrey
|
| постоянный участник
|
Пост N: 6216
Зарегистрирован: 12.09.06
|
|
Отправлено: 27.03.19 12:18. Заголовок: Григорий, а как полу..
Григорий, а как получить сборки для MS VisualC 2017 ?
| |
|
gfilatov2002
|
| moderator
|
Пост N: 1478
Зарегистрирован: 11.02.10
|
|
Отправлено: 27.03.19 12:58. Заголовок: Andrey пишет: как п..
Andrey пишет: цитата: | как получить сборки для MS VisualC 2017 ? |
| Архивы этих сборок лежат по старым адресам, имена архивов я не менял.
| |
|
Andrey
|
| постоянный участник
|
Пост N: 6217
Зарегистрирован: 12.09.06
|
|
Отправлено: 27.03.19 13:12. Заголовок: Спасибо ! :sm36: ..
Спасибо ! И что-то нет доки: * New: Documentation 'Harbour for beginners' in format CHM. It is an original work of Alexander Kresin <alex@kresin.ru> (see hrbfaq.chm in folder \harbour\doc)
| |
|
gfilatov2002
|
| moderator
|
Пост N: 1479
Зарегистрирован: 11.02.10
|
|
Отправлено: 27.03.19 13:24. Заголовок: Andrey пишет: нет д..
Andrey пишет: Документация находится в основном дисрибутиве (для BCC 5.5)
| |
|
Andrey
|
| постоянный участник
|
Пост N: 6218
Зарегистрирован: 12.09.06
|
|
Отправлено: 27.03.19 14:20. Заголовок: Блин... Опять проста..
Блин... Опять простая невнимательность .
| |
|
SergKis
|
| постоянный участник
|
Пост N: 2303
Зарегистрирован: 17.02.12
|
|
Отправлено: 29.03.19 11:46. Заголовок: gfilatov2002 В ново..
gfilatov2002 В новой версии примеры CheckLabel* валятся с похожей ошибкой Скрытый текст
Application: C:\MiniGui\SAMPLES\BASIC\CheckLabel_3\demo.exe Date: 03/29/19 Time: 10:45:15 Time from start: 0 days 0 hours 0 mins 5 secs Error MGERROR/0 Control: Label_2 Of Form_Main : Refresh method can be used only if FIELD clause is set. Program terminated. Called from MSGMINIGUIERROR(99) in module: h_error.prg Called from _REFRESH(5907) in module: h_controlmisc.prg Called from DOMETHOD(5223) in module: h_controlmisc.prg Called from (b)MAIN(57) in module: demo.prg Called from _DOCONTROLEVENTPROCEDURE(1865) in module: h_windows.prg Called from OLABELEVENTS(308) in module: h_label.prg Called from DOMESSAGELOOP(0) Called from _ACTIVATEWINDOW(1499) in module: h_windows.prg Called from MAIN(138) in module: demo.prg ----------------------------- System Information ------------------------------ ...
|
| |
|
gfilatov2002
|
| moderator
|
Пост N: 1481
Зарегистрирован: 11.02.10
|
|
Отправлено: 29.03.19 12:56. Заголовок: SergKis пишет: прим..
SergKis пишет: цитата: | примеры CheckLabel* валятся с похожей ошибкой |
| Да, я знаю Уже сделал "тихое" обновление этой сборки Прошу скачать заново и проверить эти исправления Андрей Кстати, обновил архив MSVC-сборки также с учетом последних изменений, рекомендую скачать...
| |
|
SergKis
|
| постоянный участник
|
Пост N: 2304
Зарегистрирован: 17.02.12
|
|
Отправлено: 29.03.19 13:58. Заголовок: gfilatov2002 пишет П..
gfilatov2002 пишет цитата: | Прошу скачать заново и проверить эти исправления |
| Работает
| |
|
Andrey
|
| постоянный участник
|
Пост N: 6224
Зарегистрирован: 12.09.06
|
|
Отправлено: 31.03.19 16:00. Заголовок: gfilatov2002 пишет: ..
gfilatov2002 пишет: цитата: | Кстати, обновил архив MSVC-сборки также с учетом последних изменений, рекомендую скачать... |
| Спасибо БОЛЬШОЕ ! Григорий, а можно эти функции добавить в базовые ? А то постоянно приходиться добавлять в проги, где есть работа с ини-файлами. Функции не мои, это твоя работа. *--------------------------------------------------------* STATIC Function GetIni( cSection, cEntry, cDefault, cFile ) RETURN GetPrivateProfileString(cSection, cEntry, cDefault, cFile ) *--------------------------------------------------------* STATIC Function WriteIni( cSection, cEntry, cValue, cFile ) RETURN( WritePrivateProfileString( cSection, cEntry, cValue, cFile ) ) *--------------------------------------------------------* STATIC Function IsINISection(cIniFile, cName) Return ( aScan( _GetSectionNames(cIniFile), {|x| UPPER(x) == UPPER(cName)} ) > 0 ) *--------------------------------------------------------* STATIC Function IsVarINISection(cIniFile, cSecName, cName) Return ( aScan( _GetSection(cSecName, cIniFile), {|x| UPPER(x[1]) == UPPER(cName)} ) > 0 )
| |
|
Andrey
|
| постоянный участник
|
Пост N: 6225
Зарегистрирован: 12.09.06
|
|
Отправлено: 31.03.19 20:20. Заголовок: Перешёл на новую вер..
Перешёл на новую версию МиниГуи. Теперь вылетает с ошибкой: Error MGERROR/0 Control: unrecognized property 'BACKGROUNDCOLOR'. Program terminated Called from MSGMINIGUIERROR(99) in module: h_error.prg Called from SETPROPERTY(4126) in module: h_controlmisc.prg Called from MYINITMENUBUTTON6RESAY(1037) in module: form_calc.prg Строка 1037: SetProperty( cForm, cObj, "BackgroundColor", aBackgroundColor ) В текстах программ часто использую. Пришлось откатиться на предыдущую версию.
| |
|
SergKis
|
| постоянный участник
|
Пост N: 2312
Зарегистрирован: 17.02.12
|
|
Отправлено: 31.03.19 20:57. Заголовок: Andrey SetProperty(..
Andrey SetProperty( cForm, cObj, "BackgroundColor", aBackgroundColor ) попробуй
| |
|
Andrey
|
| постоянный участник
|
Пост N: 6226
Зарегистрирован: 12.09.06
|
|
Отправлено: 31.03.19 21:20. Заголовок: SergKis пишет: попр..
SergKis пишет: Блин, это опять все исходники шерстить....
| |
|
SergKis
|
| постоянный участник
|
Пост N: 2313
Зарегистрирован: 17.02.12
|
|
Отправлено: 31.03.19 21:42. Заголовок: Andrey h_controlmis..
Andrey h_controlmisc.prg line 4025 CASE Arg3 == "BACKCOLOR" .OR. Arg3 == "GRADIENTOVER" .OR. Arg3 == "BACKGROUNDCOLOR" добавь и пересобери libу или пробни #translate BACKGROUNDCOLOR => BACKCOLOR
| |
|
Andrey
|
| постоянный участник
|
Пост N: 6227
Зарегистрирован: 12.09.06
|
|
Отправлено: 31.03.19 22:03. Заголовок: Пере собрал библиоте..
Пере собрал библиотеку. Теперь вылетает на: Error MGERROR/0 Control: unrecognized property 'CAPTURE'. Program terminated. Called from MSGMINIGUIERROR(99) in module: h_error.prg Called from SETPROPERTY(4126) in module: h_controlmisc.prg Called from MYINITMENUBUTTON8RESAY(1493) in module: form_calc.prg Строка 1493: SetProperty( cForm, cObj, "Capture", "" )
| |
|
SergKis
|
| постоянный участник
|
Пост N: 2314
Зарегистрирован: 17.02.12
|
|
Отправлено: 31.03.19 22:21. Заголовок: и какая версия у теб..
и какая версия у тебя см.уже 1810 не нахожу Captu ?
| |
|
Andrey
|
| постоянный участник
|
Пост N: 6228
Зарегистрирован: 12.09.06
|
|
Отправлено: 31.03.19 22:57. Заголовок: 19.03..
19.03 @ 190, 20 CHECKBOX &cObj CAPTION cCaption ; ..... В 19.02 работает однако.... Понял в чём дело. Ошибся в синтаксисе я, а раньше версии просто пропускали это. вместо SetProperty( cForm, cObj, "Capture", "" ) надо SetProperty( cForm, cObj, "CAPTION", "" ) Заработало !
| |
|
SergKis
|
| постоянный участник
|
Пост N: 2316
Зарегистрирован: 17.02.12
|
|
Отправлено: 03.04.19 11:48. Заголовок: gfilatov2002 Предла..
gfilatov2002 Предлагаю добавить в CLASS TControl ... DATA lMsg AS LOGICAL INIT .T. ... METHOD SetMsg( cText, lDefault ) CLASS TControl ... If ! ::lMsg .or. ::nStatusItem < 1 return Nil EndIf ... тогда можно отключать "порчу" 1го itemа StatusBar, проделываемого TsBrowse. К примеру DEFINE TBROWSE Entity OBJ oBrw AT :Y, :X ALIAS Alias() CELL ; WIDTH This.ClientWidth - :X - :R ; HEIGHT This.ClientHeight - :Y - :B - ; This.StatusBar.Height ; COLORS App.Cargo:BrwColors ; ON INIT {|ob| TsbCreate( ob ) } :lMsg := .F. END TBROWSE ON END {|ob| ob:SetNoHoles() } dbSelectArea( App.Cargo:AllEntAls ) DEFINE TBROWSE AllEntity OBJ oBrw AT This.Tree_1.Row, This.Tree_1.Col ; ALIAS Alias() CELL ; WIDTH This.ClientWidth - :L - :R ; HEIGHT This.Entity.Height ; COLORS App.Cargo:BrwColors ; ON CHANGE {|ob| ob:DrawFooters() } ; ON INIT {|ob| TsbCreate( ob ) } :lMsg := .F. END TBROWSE ON END {|ob| ob:SetNoHoles(), This.AllEntity.Hide } ...
| |
|
gfilatov2002
|
| moderator
|
Пост N: 1482
Зарегистрирован: 11.02.10
|
|
Отправлено: 03.04.19 12:03. Заголовок: SergKis пишет: Пред..
SergKis пишет: цитата: | Предлагаю добавить в CLASS TControl ... DATA lMsg AS LOGICAL INIT .T. ... METHOD SetMsg( cText, lDefault ) CLASS TControl ... If ! ::lMsg .or. ::nStatusItem < 1 return Nil EndIf ... тогда можно отключать "порчу" 1го itemа StatusBar, проделываемого TsBrowse |
| Благодарю за предложение Но что мешает уже сейчас присвоить с тем же результатом
| |
|
SergKis
|
| постоянный участник
|
Пост N: 2317
Зарегистрирован: 17.02.12
|
|
Отправлено: 03.04.19 12:40. Заголовок: gfilatov2002 пишет Н..
gfilatov2002 пишет цитата: | Но что мешает уже сейчас присвоить |
| Как говорится, УПС. Вполне можно. В своей версии увидел DATA lMsg INIT .F. (всегда отключено, не исп. внутренний механизм тсб), вот и дернулся.
| |
|
Haz
|
| |
Пост N: 1450
Зарегистрирован: 20.02.11
|
|
Отправлено: 05.04.19 14:56. Заголовок: Григорий , проверьт..
Григорий , проверьте точно ли исправления прошли в новой версии. После обновления опять словил глюк , глянул исходники - они не изменились Haz пишет:
цитата: | Григорий, уберите пожалуйста проверку на номер записи. С индексами и фильтром при наличии проверки не работает метод ( конкретно под ADS , остальное не проверял ) METHOD GotoRec( nRec, nRowPos ) CLASS TSBrowse LOCAL cAlias LOCAL nSkip LOCAL n LOCAL nRecSave LOCAL lRet := .F. LOCAL lReCount := .F. IF ::lIsDbf lRet := .T. cAlias := ::cAlias ::nLastPos := ( cAlias )->( RecNo() ) вот эта строка портит позицию если удалить все нормально nRec := Min( ( cAlias )->( LastRec() ), nRec ) |
| нужно удалить ( закоментить ) строки , у себя убрал. Глюк исчез If Empty( ( cAlias )->( dbFilter() ) ) nRec := Min( ( cAlias )->( LastRec() ), nRec ) EndIf
| |
|
gfilatov2002
|
| moderator
|
Пост N: 1484
Зарегистрирован: 11.02.10
|
|
Отправлено: 05.04.19 15:21. Заголовок: Haz пишет: удалить ..
Haz пишет: цитата: | удалить ( закоментить ) строки , у себя убрал. Глюк исчез If Empty( ( cAlias )->( dbFilter() ) ) nRec := Min( ( cAlias )->( LastRec() ), nRec ) EndIf |
| Убрал эти строки из метода GotoRec() Благодарю за проверку
| |
|
gfilatov2002
|
| moderator
|
Пост N: 1485
Зарегистрирован: 11.02.10
|
|
Отправлено: 05.04.19 15:34. Заголовок: Andrey пишет: можно..
Andrey пишет: цитата: | можно эти функции добавить в базовые ? |
| Нет, это локальные одно-строчные функции, которые можно легко заменить с помощью препроцессорных команд #xtranslate цитата: | #xtranslate GetIni( cSection, cEntry, cDefault, cFile ) =>; GetPrivateProfileString(cSection, cEntry, cDefault, cFile ) *--------------------------------------------------------* #xtranslate WriteIni( cSection, cEntry, cValue, cFile ) =>; WritePrivateProfileString( cSection, cEntry, cValue, cFile ) *--------------------------------------------------------* #xtranslate IsINISection(cIniFile, cName) =>; ( aScan( _GetSectionNames(cIniFile), {|x| UPPER(x) == UPPER(cName)} ) > 0 ) *--------------------------------------------------------* #xtranslate IsVarINISection(cIniFile, cSecName, cName) =>; ( aScan( _GetSection(cSecName, cIniFile), {|x| UPPER(x[1]) == UPPER(cName)} ) > 0 ) |
|
| |
|
Haz
|
| |
Пост N: 1460
Зарегистрирован: 20.02.11
|
|
Отправлено: 18.04.19 17:53. Заголовок: Предложение в TsBrowse
Часто требуется узнать какой хороший человек отредактировал данные в таблице. У себя задаче решил через ::bPrevEdit и ::bPostEdit в колонках Но поскольку бровсов уже более 50 и это не предел , поднадоело в каждом это прописывать. Предлагаю включить в библиотеку базовый механизм 1 в данных бровса определить DATA xOldEditValue DATA xNewEditValue DATA bEditLog 2 в METHOD Edit CLASS TSbrowse добавить Default nCell := ::nCell, ; ::lPostEdit := .F., ; ::lNoPaint := .F. ::xOldEditValue := ::xNewEditValue := Eval(::aColumns[ nCell ]:bData ) 3 в конце METHOD PostEdit CLASS TSbrowse добавить ::xNewEditValue := Eval(::aColumns[ ::nCell ]:bData) if hb_isBlock( ::bEditLog ) Eval( ::bEditLog, ::xOldEditValue, ::xNewEditValue, Self ) end Return Nil тогда в своей программе при определении бровса достаточно указать oBrw:bEditLog := { |a,b,c| WriteEditLog( a, b, c:cAlias ) } и прописать саму функцию в которой в базу или текстовик вести протокол кто когда что и тд Func WriteEditLog ( xOld, xNew, cAlias ) ... ... return nil Как идейка
| |
|
SergKis
|
| постоянный участник
|
Пост N: 2395
Зарегистрирован: 17.02.12
|
|
Отправлено: 18.04.19 18:22. Заголовок: Haz пишет Как идейка..
Haz пишет На первый взгляд, ОК! только ::xOldEditValue := ::xNewEditValue := ::bDataEval( ::aColumns[ nCell ], , nCell ) и ::xNewEditValue := ::bDataEval( ::aColumns[ nCell ], , nCell )
| |
|
SergKis
|
| постоянный участник
|
Пост N: 2396
Зарегистрирован: 17.02.12
|
|
Отправлено: 18.04.19 18:26. Заголовок: PS if hb_isBlock..
PS if hb_isBlock( ::bEditLog ) .and. ::xOldEditValue != ::xNewEditValue Eval( ::bEditLog, ::xOldEditValue, ::xNewEditValue, Self ) end
| |
|
SergKis
|
| постоянный участник
|
Пост N: 2397
Зарегистрирован: 17.02.12
|
|
Отправлено: 18.04.19 18:30. Заголовок: PPS Возможно, эти пе..
PPS Возможно, эти переменные надо не CLASS TsBrowse, а в CLASS TsColumn Тогда все колонки тек. линии будут иметь старые, новые значения
| |
|
Haz
|
| |
Пост N: 1461
Зарегистрирован: 20.02.11
|
|
Отправлено: 18.04.19 18:31. Заголовок: SergKis пишет: На п..
SergKis пишет: Спасибо за правки
| |
|
Haz
|
| |
Пост N: 1462
Зарегистрирован: 20.02.11
|
|
Отправлено: 18.04.19 18:34. Заголовок: SergKis пишет: PPS ..
SergKis пишет: цитата: | PPS Возможно, эти переменные надо не CLASS TsBrowse, а в CLASS TsColumn Тогда все колонки тек. линии будут иметь старые, новые значения |
| Нет смысла , редактируется всегда только одна из колонок в один момент времени
| |
|
Haz
|
| |
Пост N: 1463
Зарегистрирован: 20.02.11
|
|
Отправлено: 18.04.19 18:36. Заголовок: Haz пишет: Нет смыс..
Haz пишет: цитата: | Нет смысла , редактируется всегда только одна из колонок в один момент времени |
| хотя , если в TsColumn , то это позволит undo по строке сделать
| |
|
SergKis
|
| постоянный участник
|
Пост N: 2398
Зарегистрирован: 17.02.12
|
|
Отправлено: 18.04.19 18:41. Заголовок: И в TsColumn должно ..
И в TsColumn должно быть достаточным только старое значение, а новое в bPostEdit должно быть определено. Именно для Undo и есть смысл в колонке иметь старое значение
| |
|
Haz
|
| |
Пост N: 1466
Зарегистрирован: 20.02.11
|
|
Отправлено: 19.04.19 11:55. Заголовок: В общем пока получил..
В общем пока получилось так CLASS TSColumn ... DATA xOldEditValue CLASS TSBrowse ... DATA bEditLog METHOD Edit( uVar, nCell, nKey, nKeyFlags, cPicture, bValid, nClrFore, ; nClrBack ) CLASS TSBrowse Local nRow, nHeight, cType, uValue, nI, aGet, oCol, cMsg, aRct, bChange, lSpinner, bUp, bDown, ; bMin, bMax, nStartX, nWidth, lCombo, lMulti, nCol, lLogicDrop, lPicker, nTxtHeight, hFont, ix Local cWnd := ::cControlName Local nK, aKey, oGet Default nCell := ::nCell, ; ::lPostEdit := .F., ; ::lNoPaint := .F. ::aColumns[ nCell ]:xOldEditValue := ::bDataEval( ::aColumns[ nCell ], , nCell ) METHOD PostEdit( uTemp, nCol, bValid ) CLASS TSBrowse Local aMoveCell, bRecLock, bAddRec, cAlias, uRet, ; nLastKey := ::oWnd:nLastKey, ; lAppend := ::lAppendMode, xNewEditValue ... // в самом конце xNewEditValue := ::bDataEval( ::aColumns[ ::nCell ], , ::nCell ) if hb_isBlock( ::bEditLog ) .and. ::aColumns[ ::nCell ]:xOldEditValue != xNewEditValue Eval( ::bEditLog, ::aColumns[ ::nCell ]:xOldEditValue, xNewEditValue, Self ) end Return Nil После объявления в своей программе oBrw:bEditLog := { |a,b,c| WriteEditLog( a, b, c ) } все передается корректно
| |
|
SergKis
|
| постоянный участник
|
Пост N: 2441
Зарегистрирован: 17.02.12
|
|
Отправлено: 21.04.19 20:35. Заголовок: gfilatov2002 Управл..
gfilatov2002 Управление линиями в колонке METHOD DrawLine( xRow ) CLASS TSBrowse ... oColumn := If( nJ > Len( ::aColumns ), ::oPhant, ::aColumns[ nJ ] ) nLineStyle := ::nLineStyle If HB_ISNUMERIC(oColumn:nLineStyle) nLineStyle := oColumn:nLineStyle EndIf cPicture := ::cPictureGet( oColumn, nJ ) ... METHOD DrawSelect( xRow ) CLASS TSBrowse ... oColumn := If( nJ > Len( ::aColumns ), ::oPhant, ::aColumns[ nJ ] ) nLineStyle := ::nLineStyle If HB_ISNUMERIC(oColumn:nLineStyle) nLineStyle := oColumn:nLineStyle EndIf hFont := ::hFontGet( oColumn, nJ ) ... CLASS TSColumn ... DATA nLineStyle ... Пример // LINES_NONE LINES_ALL LINES_VERT LINES_HORZ LINES_3D LINES_DOTTED oCol:nLineStyle := LINES_HORZ или oCol:nLineStyle := LINES_NONE
| |
|
SergKis
|
| постоянный участник
|
Пост N: 2442
Зарегистрирован: 17.02.12
|
|
Отправлено: 21.04.19 21:09. Заголовок: gfilatov2002 Для He..
gfilatov2002 Для Header, Footer тоже самое можно сделать CLASS TSColumn ... DATA nLineStyle DATA nHLineStyle DATA nSLineStyle // SpecHd DATA nFLineStyle ... METHOD DrawHeaders( lFooters ) CLASS TSBrowse ... nClrLine := ::nClrLine Local nLineStyle := 1 Default lFooters := .F. ... Else l3DText := nClr3dL := nClr3dS := Nil EndIf nLineStyle := 1 If HB_ISNUMERIC(oColumn:nHLineStyle) nLineStyle := oColumn:nHLineStyle EndIf TSDrawCell( hWnd, ; // 1 hDC, ; // 2 0, ; // 3 nStartCol, ; // 4 aColSizes[ nJ ], ; // 5 cHeading, ; // 6 nAlign, ; // 7 nClrFore, ; // 8 nClrBack, ; // 9 hFont, ; // 10 hBitMap, ; // 11 nHeightHead, ; // 12 l3DLook, ; // 13 nLineStyle, ; // 14 nLineStyle nClrLine, ; // 15 1, ; // 16 1=Header 2=Footer 3=Super 4=Special ... IF ::lDrawSpecHd ... Else l3DText := nClr3dL := nClr3dS := Nil EndIf nLineStyle := 1 If HB_ISNUMERIC(oColumn:nSLineStyle) nLineStyle := oColumn:nSLineStyle EndIf TSDrawCell( hWnd, ; // 1 hDC, ; // 2 0, ; // 3 nStartCol, ; // 4 aColSizes[nJ], ; // 5 cHeading, ; // 6 nAlign, ; // 7 nClrFore, ; // 8 nClrBackS, ; // 9 hFont, ; // 10 hBitMap, ; // 11 0, ; // 12 nHeightFoot l3DLook, ; // 13 nLineStyle, ; // 14 nLineStyle nClrLine, ; // 15 4, ; // 16 1=Header 2=Footer 3=Super 4=Special ... If ::lFooting .and. ::lDrawFooters ... Else l3DText := nClr3dL := nClr3dS := Nil EndIf nLineStyle := 1 If HB_ISNUMERIC(oColumn:nFLineStyle) nLineStyle := oColumn:nFLineStyle EndIf TSDrawCell( hWnd, ; // 1 hDC, ; // 2 ::nRowCount(), ; // 3 nStartCol, ; // 4 aColSizes[nJ], ; // 5 cFooting, ; // 6 nAlign, ; // 7 nClrFore, ; // 8 nClrBack, ; // 9 hFont, ; // 10 hBitMap, ; // 11 nHeightFoot, ; // 12 l3DLook, ; // 13 nLineStyle, ; // 14 nLineStyle nClrLine, ; // 15 2, ; // 16 1=Header 2=Footer 3=Super ...
| |
|
SergKis
|
| постоянный участник
|
Пост N: 2443
Зарегистрирован: 17.02.12
|
|
Отправлено: 22.04.19 08:55. Заголовок: gfilatov2002 Предла..
gfilatov2002 Предлагаю добавить для блокировки перехода на др. строку вверх\вниз при :PostEdit (oCol:EditMove работает) CLASS TSBrowse FROM TControl ... DATA lPostEdit // to detect postediting DATA lPostEditGo AS LOGICAL INIT .T. // to detect postediting VK_UP,VK_RIGHT,VK_LEFT,VK_DOWN ... METHOD PostEdit( uTemp, nCol, bValid ) CLASS TSBrowse ... ( cAlias )->( DbSkip( 0 ) ) // refresh relations just in case that a relation field changes ::SetFocus() 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 behavior post-edit movement Eval( aMoveCell[ ::aColumns[ nCol ]:nEditMove ] ) ::DrawSelect() If ! ::lAppendMode ::Refresh( .F. ) EndIf ElseIf ::aColumns[ nCol ]:nEditMove == 0 .and. ! ::lAutoEdit ::DrawSelect() EndIf ::oWnd:nLastKey := Nil ... Else If lAppend .and. ::lIsArr ... ::SetFocus() 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 ::oWnd:nLastKey := Nil ...
| |
|
gfilatov2002
|
| moderator
|
Пост N: 1494
Зарегистрирован: 11.02.10
|
|
Отправлено: 22.04.19 10:43. Заголовок: SergKis Добавил эти..
SergKis Добавил эти изменения, хотя и считаю их необязательными Благодарю за помощь
| |
|
gfilatov2002
|
| moderator
|
Пост N: 1495
Зарегистрирован: 11.02.10
|
|
Отправлено: 22.04.19 11:03. Заголовок: Просто к сведению З..
Просто к сведению Завершена подготовка следующей сборки 19.04, которая выйдет на этой неделе Список изменений для новой сборки можно увидеть на сайте библиотеки (файл ChangelogHMG.docx).
| |
|
SergKis
|
| постоянный участник
|
Пост N: 2447
Зарегистрирован: 17.02.12
|
|
Отправлено: 22.04.19 11:41. Заголовок: gfilatov2002 пишет Д..
gfilatov2002 пишет цитата: | Добавил эти изменения, хотя и считаю их необязательными |
| Согласен, что это мелочь. Но линиями давно хотел заняться, т.к. надо часто показывать колонки, как одну графу, суперхидер над ней занят. Приходилось показывать через выражение, а модифицировать на окне как отдельные поля\getbox. Второе изменение, по мне, более четко отрабатывает установленный на колонки :nEditMove алгоритм, не перескакивая на др. запись, отличную от строки с :Edit
| |
|
gfilatov2002
|
| moderator
|
Пост N: 1496
Зарегистрирован: 11.02.10
|
|
Отправлено: 22.04.19 11:48. Заголовок: SergKis пишет: боле..
SergKis пишет: цитата: | более четко отрабатывает установленный на колонки :nEditMove алгоритм |
| Я полностью доверяю Вашему программисткому чутью, потому что Вы - практик Большое спасибо за Вашу помощь
| |
|
SergKis
|
| постоянный участник
|
Пост N: 2448
Зарегистрирован: 17.02.12
|
|
Отправлено: 22.04.19 11:52. Заголовок: PS Пример Tsb_addrec..
PS Пример Tsb_addrecord_3. Line 94 добавляем :lCellBrw := .T. :lPostEditGo := .F. и F4 прекрасно исполняет :nEditMove колонки Пример App_TsbBox demo_misc.prg добавляем sCols( Cust.COUNTRY, cHeading, 'Country' ) sCols( Cust.COUNTRY, nLineStyle , LINES_HORZ ) sCols( Cust.COUNTRY, nHLineStyle, LINES_HORZ ) sCols( Cust.COUNTRY, nFLineStyle, LINES_HORZ ) sCols( Cust.CITY, nLineStyle, LINES_HORZ ) sCols( Cust.CITY, cHeading, 'City' ) получили объединенную колонку
| |
|
gfilatov2002
|
| moderator
|
Пост N: 1497
Зарегистрирован: 11.02.10
|
|
Отправлено: 25.04.19 09:13. Заголовок: Выпустил новую сборк..
Выпустил новую сборку 19.04 для BCC 5.5.1 и компиляторов Harbour и xHarbour. Базовый дистрибутив находится по адресу http://hmgextended.com/files/CONTRIB/hmg-19.04-setup.exe Также имеются дополнительные сборки для следующих Си-компиляторов: - MinGW 8.3.1 32-bit для Harbour 3.2.0dev; (есть в наличии) - MinGW 8.2.0 64-bit для Harbour 3.4.0dev; (есть в наличии) - MS VisualC 2017 32-bit для Harbour 3.2.0dev; (путь и имя архива не изменял) - MS VisualC 2017 64-bit для Harbour 3.2.0dev; (путь и имя архива не изменял) - Pelles C 8.0 32-bit для xHarbour b10244; (под заказ) - Pelles C 9.0 64-bit для xHarbour b10244; (под заказ) - Borland/Embarcadero C++ 7.3 (32-bit) для Harbour 3.2.0dev; (под заказ) - Borland/Embarcadero C++ 7.4 (32-bit) для Harbour 3.2.0dev; (под заказ) NEW - Open Watcom C/C++ 2.0 (32-bit) для Harbour 3.2.0dev. (под заказ) Благодарю за Ваше внимание
| |
|
Andrey
|
| постоянный участник
|
Пост N: 6272
Зарегистрирован: 12.09.06
|
|
Отправлено: 25.04.19 19:07. Заголовок: Григорий, а можно сд..
Григорий, а можно сделать тихое обновление под новую сборку 19.04 с учётом предложения для ::nClrLine := ::nCLR_GRAY // изменить цвет линий между ячейками таблицы А то новой версии долго ждать придётся... Заранее БОЛЬШОЕ СПАСИБО !
| |
|
gfilatov2002
|
| moderator
|
Пост N: 1498
Зарегистрирован: 11.02.10
|
|
Отправлено: 25.04.19 20:05. Заголовок: Andrey пишет: можно..
Andrey пишет: цитата: | можно сделать тихое обновление |
| OK, завтра сделаю
| |
|
gfilatov2002
|
| moderator
|
Пост N: 1499
Зарегистрирован: 11.02.10
|
|
Отправлено: 26.04.19 09:26. Заголовок: Обновил установщик с..
Обновил установщик сборки 19.04 с учетом пожелания Andrey. Что нового: - добавил новую переменную :nCLR_Lines класса TSBrowse в метод Enabled() для установки цвета линий сетки при блокировке грида.
| |
|
SergKis
|
| постоянный участник
|
Пост N: 2467
Зарегистрирован: 17.02.12
|
|
Отправлено: 26.04.19 12:24. Заголовок: gfilatov2002 Возвра..
gfilatov2002 Возвращаясь к вопросу, озвученного Haz цитата: | С какой целью в METHOD TSBrowse:Edit() в CheckBox игнорируется VK_RETURN ? |
| в теме http://clipper.borda.ru/?1-1-0-00000526-000-280-0 В некоторых ситуациях, на ChecBox проще производить действия, чем используя :aBitMaps на цифрах и отсутствие VK_RETURN мешает. Давайте добавим, предложенное Игорем, с правкой DATA lCheckBoxNoReturn INIT .T. ... METHOD Edit( uVar, nCell, nKey, nKeyFlags, cPicture, bValid, nClrFore, ; ... If cType == "L" .and. oCol:lCheckBox If nKey != VK_RETURN .or. ! ::lCheckBoxNoReturn If Upper( Chr( nKey ) ) $ "YCST1" ::lChanged := uVar == .F. uVar := .T. ElseIf Upper( Chr( nKey ) ) $ "FN0" ::lChanged := uVar == .T. uVar := .F. ElseIf nKey == VK_SPACE .or. nKey == VK_RETURN uVar := ! uValue ::lChanged := .T. Else Return 0 EndIf ...
| |
|
gfilatov2002
|
| moderator
|
Пост N: 1500
Зарегистрирован: 11.02.10
|
|
Отправлено: 26.04.19 12:36. Заголовок: SergKis пишет: на C..
SergKis пишет: цитата: | на ChecBox проще производить действия |
| Теперь стало понятнее предложение Игоря SergKis пишет: цитата: | Давайте добавим, предложенное Игорем, с правкой |
| Добавлю, конечно... Благодарю за разъяснение P.S. Снова обновил установщик сборки 19.04 с учетом вышеуказанных изменений в TSBrowse
| |
|
SergKis
|
| постоянный участник
|
Пост N: 2468
Зарегистрирован: 17.02.12
|
|
Отправлено: 26.04.19 14:22. Заголовок: gfilatov2002 Меня д..
gfilatov2002 Меня дернули, стояли над душой, потому отослал с ошибкой, ИЗВИНИТЕ. Это должна быть не глобальная установка, а установка на колонку с CheckBox, т.е. CLASS TSColumn DATA lCheckBoxNoReturn INIT .T. и If nKey != VK_RETURN .or. ! oCol:lCheckBoxNoReturn
| |
|
SergKis
|
| постоянный участник
|
Пост N: 2469
Зарегистрирован: 17.02.12
|
|
Отправлено: 26.04.19 14:24. Заголовок: PS С глобальной то ж..
PS С глобальной то же можно, но трудности будут при наличии в строке нескольких ChecBox, а VK_RETURN нужен не всем
| |
|
gfilatov2002
|
| moderator
|
Пост N: 1501
Зарегистрирован: 11.02.10
|
|
Отправлено: 26.04.19 14:53. Заголовок: SergKis пишет: долж..
SergKis пишет: цитата: | должна быть не глобальная установка, а установка на колонку с CheckBox |
| Поправил и перезалил исправленный установщик Благодарю за помощь
| |
|
Haz
|
| |
Пост N: 1488
Зарегистрирован: 20.02.11
|
|
Отправлено: 26.04.19 20:01. Заголовок: gfilatov2002 пишет: ..
gfilatov2002 пишет: цитата: | Теперь стало понятнее предложение Игоря |
| Только мне расскажите зачем VK_RETURN в игноре. Не понимаю как это помогает работать с чекбоксом Я не придираюсь. Хочу понять логику автора
| |
|
SergKis
|
| постоянный участник
|
Пост N: 2470
Зарегистрирован: 17.02.12
|
|
Отправлено: 26.04.19 20:32. Заголовок: Haz пишет Не понимаю..
Haz пишет цитата: | Не понимаю как это помогает работать с чекбоксом |
| Вроде, если поставить oCol:nEditMove != 0, не помню на память, то по VK_RETURN должна исполнится команда перемещения на др. колонку или строку и колонку
| |
|
Haz
|
| |
Пост N: 1489
Зарегистрирован: 20.02.11
|
|
Отправлено: 26.04.19 20:38. Заголовок: SergKis пишет: Врод..
SergKis пишет: цитата: | Вроде, если поставить oCol:nEditMove |
| Так это по любой колонке ПОСЛЕ редактирования. А сейчас по ENTER не пускает в редакцию. И я не врубаюсь зачем это сделано
| |
|
SergKis
|
| постоянный участник
|
Пост N: 2471
Зарегистрирован: 17.02.12
|
|
Отправлено: 26.04.19 20:44. Заголовок: Haz В данном случае..
Haz В данном случае, если колонка lEdit == .T., то Enter просто переместится на след. колонку без исправления. В этом логика есть. К примеру всегда ставлю на combobox NOTABSTOP, т.к. стрелками легко сбить значение. Тут такой же случай, тыкаем enter на колонках, без реальной модификации и допрыгиваем до нужной колонки. Перепрыгивая и CheckBox без изменений.
| |
|
gfilatov2002
|
| moderator
|
Пост N: 1502
Зарегистрирован: 11.02.10
|
|
Отправлено: 26.04.19 20:45. Заголовок: Haz пишет: я не вру..
Haz пишет: цитата: | я не врубаюсь зачем это сделано |
| Возможно, автор библиотеки хотел имитировать поведение обычного CheckBox, который не изменяет свое значение при нажатии клавиши Enter, а реагирует на ПРОБЕЛ
| |
|
Haz
|
| |
Пост N: 1490
Зарегистрирован: 20.02.11
|
|
Отправлено: 26.04.19 20:52. Заголовок: SergKis пишет: Пере..
SergKis пишет: цитата: | Перепрыгивая и CheckBox без изменений. |
| Это аргумент, но все равно слабоват. т. е. защита о дурака. Тогда логичнее было бы делать запрет VK_RETURN только при nEditMove <> 0
| |
|
Haz
|
| |
Пост N: 1491
Зарегистрирован: 20.02.11
|
|
Отправлено: 26.04.19 20:59. Заголовок: gfilatov2002 пишет: ..
gfilatov2002 пишет: цитата: | Возможно, автор библиотеки хотел имитировать поведение обычного CheckBox, который не изменяет свое значение при нажатии клавиши Enter, а реагирует на ПРОБЕЛ |
| Да, Сергей примерно о том же говорит. Но у меня пользователи практически до оргазма доходят в попытках энтером переключить значение чекбокса. Думаю все же опциональность здесь точно необходима. Спасибо, мысль автора пррояснили.
| |
|
SergKis
|
| постоянный участник
|
Пост N: 2472
Зарегистрирован: 17.02.12
|
|
Отправлено: 26.04.19 22:38. Заголовок: Haz пишет Думаю все ..
Haz пишет цитата: | Думаю все же опциональность здесь точно необходима. |
| К примеру :nEditMove - перемещение на след. строку на CheckBox (ставим по опции, до этого прыгала по горизонтали) Тогда: Space - ставим\снимаем галочку и переходим на след. строку в той же колонке. Enter просто перемещает на след. строку в той же колонке. В целом удобно, без мыши проделать операции.
| |
|
SergKis
|
| постоянный участник
|
Пост N: 2473
Зарегистрирован: 17.02.12
|
|
Отправлено: 27.04.19 07:37. Заголовок: Haz пишет Думаю все ..
Haz пишет цитата: | Думаю все же опциональность здесь точно необходима. |
| Можно сделать, что бы не вводить, переменную tsbrowse METHOD LoadFields( lEditable, lChecBoxNoReturn ) CLASS TSBrowse ... If cType == "L" ATail( ::aColumns ):lCheckBox := .T. If HB_ISLOGICAL(lChecBoxNoReturn) ATail( ::aColumns ):lCheckBoxNoReturn := lChecBoxNoReturn EndIf EndIf ... или вводить переменную tsbrowse в Nil и в tscolumn для checkbox:lChecBoxNoReturn устанавливать от нее, если задана
| |
|
Ответов - 300
, стр:
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
All
[только новые]
|
|
|