Новая версия Расширенного релиза библиотеки MiniGUI (часть VI ) (продолжение)

Форум » GUI » Новая версия Расширенного релиза библиотеки MiniGUI (часть VI ) (продолжение) » Ответить

Новая версия Расширенного релиза библиотеки MiniGUI (часть VI ) (продолжение)

gfilatov: Начало темы находится здесь, а теперь АНОНС * АНОНС * АНОНС * АНОНС * АНОНС Готовится к опубликованию новая сборка №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: Haz пишет У меня все нормально У меня аналогично. Возможно имеется ввиду при Up на последней строке и последнем :nRowPos, строка swap сделала, но осталась последней, а др. ушла за экран, так именно это я имел ввиду под шероховатостью. Надо усиливать алгоритм, если надо, конечно. Оставляю это на тех, кому надо.

TimTim: Я пересобирал прогу. Может в этом дело?

Haz: TimTim пишет: Я пересобирал прогу. Может в этом дело? Может и в этом т.к. метод GoToRec() не обновлен в tsBrowse.lib При желании пересобрать обновить метод можно самостоятельно и пересобрать библиотеку

SergKis: gfilatov2002 пишет * Updated: Adaptation FiveWin Class TSBrowse 9.0 in HMG: - added the new method FilterData( cFilter, lFocus ) in the TSBrowse немного надо изменить[pre2] METHOD FilterRow( cFilter, lBottom, lFocus ) CLASS TSBrowse ... ::Reset(lBottom) ... или METHOD FilterRow( cFilter, lFocus, lBottom ) CLASS TSBrowse ... ::Reset(lBottom) ... [/pre2] второй вариант по частоте исп. lBottom (default .F.) первый по логике что лучше ? не знаю.

gfilatov2002: SergKis пишет: METHOD FilterRow( cFilter, lBottom, lFocus ) Принят первый вариант

SergKis: gfilatov2002 Похожая правка[pre2] METHOD FilterFTS( cFind, lUpper, lBottom, lFocus ) CLASS TSBrowse ... ::Reset(lBottom) ... [/pre2]

gfilatov2002: SergKis пишет: Похожая правка OK

Haz: gfilatov2002 Григорий в ::GotoRec() можно это добавить [pre2] If ::lIsDbf if hb_isBlock( nRec ) nRec := eval( nRec ) end if hb_isBlock( nRowPos ) nRowPos := eval( nRowPos ) end [/pre2] это позволит реализовать вычисляемые от условий координаты ( к примеру на последней странице nRowPos ровнять на nRowCount(), или nRec вычислять в dbLocate() )

SergKis: Haz пишет в ::GotoRec() можно это добавить только Eval с параметром nRec := eval( nRec, Self ) nRowPos := eval( nRowPos, Self )

gfilatov2002: Haz пишет: в ::GotoRec() можно это добавить OK SergKis пишет: только Eval с параметром OK

SergKis: gfilatov2002 У нас с Игорем еще предложение по методам [pre2] 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 [/pre2] Проверочный пример https://my-files.ru/hb9tz8

Andrey: SergKis пишет: Проверочный пример [pre2] DEFINE STATUSBAR STATUSITEM "" //STATUSITEM "Network opening of the database!" WIDTH 290 FONTCOLOR BLUE STATUSITEM "Methods: Seek, Find, Scope !" WIDTH 290 FONTCOLOR BLUE[/pre2] Вот так наверное нужно !

SergKis: Andrey пишет Вот так наверное нужно ! Скорее тут менять (а там все равно shared открытие) [pre2]FUNCTION UseOpenBase() LOCAL aStr := {} LOCAL cDbf := GetStartUpFolder() + "\TEST5" [/pre2]

gfilatov2002: SergKis пишет: еще предложение по методам Принято с благодарностью

Andrey: SergKis пишет: У нас с Игорем еще предложение по методам Ещё бы один метод нужен. Типа ColumnRec(nColumn) - показ нужной колонки в бровсе, для большого количества колонок в таблице. А то юзеру нужную ему колонку невозможно показать сразу, после разных манипуляций. Или он уже есть и я пропустил такой метод ?

Haz: Andrey пишет: я пропустил такой метод ::GoPos()

Andrey: Haz пишет: ::GoPos() Что-то это не работает... Я раньше у себя это пробовал: [pre2] oBrw1:nCell := 6 + nStaticNumField // передвинуть МАРКЕР на колонку выбранного фильтра или oBrw1:GoPos( 1,6 + nStaticNumField ) // передвинуть МАРКЕР на XX строку и XX колонку [/pre2] Всё равно таблица остаётся на первых видимых колонках. А те колонки, что за экраном, не показывает !

Haz: Andrey пишет: Что-то это не работает... Я раньше у себя это пробовал: oBrw1:nCell := 6 + nStaticNumField // передвинуть МАРКЕР на колонку выбранного фильтра или oBrw1:GoPos( 1,6 + nStaticNumField ) // передвинуть МАРКЕР на XX строку и XX колонку Всё равно таблица остаётся на первых видимых колонках. А те колонки, что за экраном, не показывает ! Работает ! GoPos() уходит на нужную колонку, хоть за экраном, хоть перед ним. Только что специально проверял

Andrey: Haz пишет: GoPos() уходит на нужную колонку, хоть за экраном, хоть перед ним. Только что специально проверял Блин, а у меня нет... Что нужно вызывать после этого метода ? Делаю так: [pre2] IF nStaticNumField <= 0 oBrw1:GoPos( 1,7 ) // передвинуть МАРКЕР на XX строку и XX колонку ELSE oBrw1:GoPos( 1,6 + nStaticNumField ) // передвинуть МАРКЕР на XX строку и XX колонку ENDIF[/pre2] Первое условие работает - oBrw1:GoPos( 1,7 ), другое нет. Т.е. если курсор на первой части таблицы, то отображается. Если уходит за видимую ПЕРВУЮ часть, то курсора не видно и таблица со столбцами не перемещается.

Dima: Andrey Пробни так Obrw:Refresh(.F.) // или Display Затем Gopos

SergKis: Andrey пишет Что нужно вызывать после этого метода ? Ничего не нужно. Надо найти у себя переустановку этого дела или ячейки :nCell

Andrey: SergKis пишет: Надо найти у себя переустановку этого дела или ячейки :nCell Уже неделю с этим бьюсь периодически....

Dima: Andrey пишет: Уже неделю с этим бьюсь периодически... Сделай простой пример: бровс и кнопка , при нажатии которой вводится место "прыга" и почекай как пашет Gopos

SergKis: Andrey Tsb_array_2\demo.prg [pre2] 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 ... [/pre2] работают строки

Andrey: SergKis пишет: работают строки Да, это работают. Видно у меня что-то не того.... Сделал как Дима посоветовал: [pre2] IF nStaticNumField <= 0 oBrw1:GoPos( 1,7 ) // передвинуть МАРКЕР на XX строку и XX колонку ELSE oBrw1:GoPos( 1,6 + nStaticNumField ) // передвинуть МАРКЕР на XX строку и XX колонку oBrw1:Refresh(.T.) ENDIF[/pre2] Первый показ срабатывает, другие разы нет !

Haz: Andrey пишет: oBrw1:GoPos( 1,6 + nStaticNumField ) // передвинуть МАРКЕР на XX строку и XX колонку oBrw1:Refresh(.T.) Дима немножко не так советовал, хотя это тоже не помогло бы . А так GoPos() в конце кода и так вызывает Refresh() В итоге ::ColumnRec( nColumn ) не нужен ,это тоже что и ::GoPos( ::nRowPos, nColumn ) и метод ::GoPos() рабочий

gfilatov2002: Выпущена новая сборка 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: gfilatov2002 В методе неточность[pre2] 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 ... [/pre2] Использовать :GotoRec(nRec, .T.) или как обычно

Haz: SergKis пишет: Использовать :GotoRec(nRec, .T.) или как обычно то есть nRowPos или число или признак проверки на последний экран ? может тогда третьим параметром ? SergKis пишет: подключать блок не удалось Не подобрать условие ?

SergKis: Haz пишет то есть nRowPos или число или признак проверки на последний экран ? Да. У себя поставил DEFAULT nRowPos := .T. на входе - основной режим т.е. всегда заполнять последний экран, если надо оставить пустоту внизу экрана, то :GotoRec(nRec, :nRowPos\или число) но такое реже надо Не подобрать условие ? была ошибка в коде[pre2] If HB_ISBLOCK( nRec надо nRowPos ) nRowPos := Eval( nRowPos, Self ) EndIf [/pre2] исправлять ее для блока или заменить вызов самим кодом, я сделал второе

Haz: SergKis пишет: была ошибка в коде Да при вставке в исходник скорее всего техническая опечатка у Григория проскочила. Не удивительно мы столько раз просили его то то поменять то это

gfilatov2002: SergKis пишет: Использовать :GotoRec(nRec, .T.) или как обычно Благодарю за исправление моей опечатки Да, без дополнительных кодовых блоков эта функция теперь работает отлично

SergKis: gfilatov2002 Чуть добавить надо (пропущена ситуация)[pre2] 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 ) ) ... [/pre2]

gfilatov2002: SergKis пишет: If HB_ISLOGICAL(nRowPos) nRowPos := Nil EndIf Такой добавочный код излишен, поскольку функция hb_default() поправит этот случай hb_default( @nRowPos, ::nRowPos ) Проверил корректность работы функции на примере из папки samples\Advanced\Tsb_addrecord Функция сработала без проблем

SergKis: gfilatov2002 пишет поскольку функция hb_default() поправит этот случай [pre2] If HB_ISLOGICAL(nRowPos) .and. nRowPos .and. ::nLen > ::nRowCount() Если ::nLen <= ::nRowCount(), то nRowPos пойдет дальше логический и имеем далее DO WHILE !( cAlias )->( BoF() ) .AND. n < nRowPos - 1 [/pre2]

Andrey: gfilatov2002 пишет: - MS VisualC 2017 32-bit для Harbour 3.2.0dev; (есть в наличии) - MS VisualC 2017 64-bit для Harbour 3.2.0dev; (есть в наличии) Хотелось бы попробовать перейти на этот компилятор. Как получить эти сборки ?

gfilatov2002: Andrey пишет: Как получить эти сборки ? Отправил ссылки на архивы этих сборок по почте

Andrey: gfilatov2002 пишет: Отправил ссылки на архивы этих сборок по почте Спасибо ! Получил. Теперь вопрос другой - как распаковать эти архивы, чтобы можно было собирать свой проект под разными компиляторами ? Хотелось бы иметь возможность через *.hbp собирать проект для 3-х компиляторов: BCC, VC, VC64. Желательно бы иметь такую структуру каталогов: C:\MiniGUI\BCC C:\MiniGUI\VC17 C:\MiniGUI\VC1764 Или по другому, как лучше будет и универсальней.

SergKis: Григорий, можно Андрей кинет мне (он знает куда) ссылки или архивы сборок VC-ных, полюбопытсвовать.

gfilatov2002: 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: gfilatov2002 пишет Без проблем Спасибо.

SergKis: gfilatov2002 Предложение:[pre2] 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) ... [/pre2] 2. предлагаю _LogFile(...) поправить, что бы команда ? не давала на вывод NIL [pre2] *-----------------------------------------------------------------------------* #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. [/pre2]

gfilatov2002: SergKis пишет: Предложение: 1-й пункт принят без вопросов, а со вторым - неясно, чем не угодил тип NIL

SergKis: gfilatov2002 пишет неясно, чем не угодил тип NIL "Старые" тексты с set alternate ... и исп. команд ? ... - все ок, но команды ? "портят" протокол\отчет. Только это

gfilatov2002: SergKis пишет: команды ? "портят" протокол\отчет Тогда надо заменить ? на ? "" например, с помощью препроцессора P.S. Нет, препроцессор в этом случае не поможет Поэтому 2-й пункт принят также. Благодарю за помощь

gfilatov2002: Завершена подготовка новой сборки 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: gfilatov2002 пишет: * The optimized ON SIZE event's behavior with using of the auxiliary WinAPI events WM_ENTERSIZEMOVE and WM_EXITSIZEMOVE. А новые свойства окна будут ? [pre2] DEFINE WINDOW test ; ...... MAIN TOPMOST ; ON MAXIMIZE ( zzzz() ) ; ON SIZE ( zzzz() ) ; ON SIZE_BEGIN ( хххх() ) ; ON SIZE_END ( хххх() ) ;[/pre2] Можно оставить по старому и новому варианту, программист сам будет решать, что использовать.

gfilatov2002: Выпущена новая сборка 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: gfilatov2002 Можно собрать вариант сборки, как раньше, на 7z

gfilatov2002: SergKis пишет: вариант сборки, как раньше, на 7z Да, конечно. Кинул прямую ссылку в Л.С.

SergKis: gfilatov2002 Спасибо.

SergKis: gfilatov2002 Предлагаю на on size сделать 2-а вызова процедуры, а не один, как сейчас. Большой разницы нет, но немного удобней расчеты производить: 1-ый раз запоминаем старые значения (коэффициенты) 2-ой считаем новые Изменения:[pre2] //********************************************************************** 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 ... [/pre2]

gfilatov2002: SergKis пишет: Предлагаю на on size сделать 2-а вызова процедуры Принято с благодарностью Два прохода для этого события решают также проблему перерисовки контролов, которая иногда возникает при быстром изменении размеров формы

Andrey: Поставил новую версию 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 прописал так [pre2]# включить путь к своим *.ch и *.fmg -incpath=Include -incpath=Source [/pre2]Но первым берется всё равно MiniGui\Harbour\include\RDDLETO.CH Можно конечно поступить проще, тупо удалить файлы из поставки минигуи RDDLETO.CH и RDDLETO.LIB, но хочется разобраться как делать правильно.

SergKis: 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: PS по первому пункту, можно закрыть строки в RDDLETO.CH v.m.3.0[pre2] ... /* 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 ) [/pre2]

Andrey: SergKis пишет: по первому пункту, можно закрыть строки в RDDLETO.CH v.m.3.0 А как сделать, чтобы в prg брался ВСЕГДА мой ch - W:\HB_Project\MyPrj\Include\rddleto.ch ?

SergKis: Andrey Посмотри и выполни пункты 2 и 3 Будет все твое

PSP: Andrey пишет: А как сделать, чтобы в prg брался ВСЕГДА мой ch - W:\HB_Project\MyPrj\Include\rddleto.ch ? #include "W:\HB_Project\MyPrj\Include\rddleto.ch"

SergKis: PS Если хочешь разделить версии leto, переименуй свои rddleto.ch -> rddleto2.ch rddleto.lib -> rddleto2.lib и подключай их

SergKis: gfilatov2002 Поправил у себя в TsBrowse[pre2] 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() ) ... [/pre2] А то METHOD nHeight() INLINE GetWindowHeight( ::hWnd ) дает не то

gfilatov2002: SergKis пишет: Поправил у себя в TsBrowse METHOD SetNoHoles Благодарю за исправление! Так, конечно, лучше...

SergKis: PS Может зря "завелся" с :nHeight, но не глянулось изменение дырки в тсб после on resize (с изменениями). До on resize была ~2-3 pixel, после убралась из за разницы алгоритмов высоты. Процедура на on resize [pre2] 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 ... [/pre2]

Andrey: SergKis пишет: Если хочешь разделить версии leto, переименуй свои rddleto.ch -> rddleto2.ch rddleto.lib -> rddleto2.lib и подключай их То что надо ! Спасибо ! Сделал rddleto_my.ch

Andrey: gfilatov2002 пишет: Два прохода для этого события решают также проблему перерисовки контролов, которая иногда возникает при быстром изменении размеров формы Григорий, а тихое обновление версии 18.11 с учётом последних изменений можно сделать ?

gfilatov2002: Andrey пишет: тихое обновление версии 18.11 с учётом последних изменений можно сделать ? Да, сейчас готовлю update 1 для версии 18.11, который запланирован к выходу на следующей неделе...

SergKis: gfilatov2002 Изменил в TsBrowse :SetNoHoles(...) с учетом исп. в ON SIZE [pre2] 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 [/pre2] Добавил метод OnResize(...), сейчас он работает "правильно" для тсб со всеми колонками помещающиеся на экран, но предлагаю включить (потом может модифицируем) [pre2] 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 [/pre2]

SergKis: PS Погонял OnResize метод на _HMG_MouseState == 1 и изменение ширины колонки мышой, получилась добавка [pre2] 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] ... [/pre2]

SergKis: PPS можно добавить в класс DATA bOnResizeEnter DATA bOnResizeExit и сделать вызовы в OnResize(...) [pre2] ... ::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 [/pre2] возможно закроются хотелки

gfilatov2002: SergKis пишет: возможно закроются хотелки Принято с благодарностью за Вашу помощь

SergKis: gfilatov2002 Может поведение процедуры _HMG_aFormMaximizeProcedure [ i ] сделать одинаковым с процедурой на ON SIZE ?[pre2] //********************************************************************** 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 ... [/pre2]

gfilatov2002: SergKis пишет: Может поведение процедуры _HMG_aFormMaximizeProcedure [ i ] сделать одинаковым с процедурой на ON SIZE ? Нет, на мой взгляд, этого не требуется, только усложняется логика обработки

SergKis: gfilatov2002 OK! небольшая правка[pre2] 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 ... [/pre2]

gfilatov2002: SergKis пишет: небольшая правка Благодарю за помощь

SergKis: PS Проверяю на Tsb_Basic\demo4.prg Изменения [pre2] ... 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 колонку ... [/pre2] вроде, полет нормальный

SergKis: gfilatov2002 Это изменение, не давал, пропустил [pre2] 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 ... [/pre2]

gfilatov2002: SergKis пишет: Это изменение, не давал Спасибо

gfilatov2002: Обновил сборку 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: Выпустил 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: Перешел с версии 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: alex_II пишет: Ошибка стала возникать при вызове DROPDOWN меню Если возможно, подготовьте простой пример, демонстрирующий эту ошибку. Мой контрольный пример работает нормально (см. ниже) [pre2]#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 [/pre2]

SergKis: alex_II Замените вызовы функций hSplBox := _DefineSplitbox('Form_main') ... _EndSplitBox() командами DEFINE SPLITBOX HANDLE hSpl ... END SPLITBOX Запустил несколько примеров из samples со splitbox и dropdown - работают

SergKis: gfilatov2002 Если записать как у alex_II, то валится, запись командой работает

alex_II: SergKis пишет: Замените вызовы функций hSplBox := _DefineSplitbox('Form_main') ... _EndSplitBox() командами DEFINE SPLITBOX HANDLE hSpl ... END SPLITBOX Благодарю, Ваша рекомендация помогла

gfilatov2002: Подготовил перед Рождеством уже 5-ю бету для новой сборки библиотеки Список изменений у этой сборки следующий [pre2] * 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) [/pre2]Благодарю за Ваше внимание

SergKis: gfilatov2002 У себя сделал небольшую правку (расчет высоты для колонки с несколькими CRLF[pre2] 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 ) ... [/pre2])

gfilatov2002: SergKis пишет: расчет высоты для колонки с несколькими CRLF Принято с небольшими изменениями Благодарю за Вашу помощь и внимание

SergKis: SergKis пишет If Empty(oBrw:nMemoHV) .and. Chr(13) $ cHeading Использую так в колонке (при работе с базой колонок, созданной заранее) [pre2] :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 // будет три строки ... [/pre2]

Andrey: SergKis пишет: Использую так в колонке (при работе с базой колонок, созданной заранее) Примерчик бы маленький сделать в папку Tsb_Basic - demo5.prg ! Да и в demo3.prg правку небольшую внести:[pre2] DEFINE WINDOW Form_0 ; .... TITLE "(3) TsBrowse DBASE SHARED Demo" ; .... STATUSITEM "(3) TsBrowse - network opening of the database!" WIDTH 290 FONTCOLOR BLUE[/pre2]

SergKis: Andrey пишет Примерчик бы маленький сделать Примерчик по колонкам с базой колонок был, пробуй. Вырезка из проги [pre2] * ----------------------------------------------------------------------------------- * 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) } ... [/pre2]

gfilatov2002: Выпущена новая сборка 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: gfilatov2002 пишет * Enhanced: Added an auxiliary conversion function HMG_ClrToHTML( nClr ) --> cHtmlClr ( format "#rrggbb" ) ... Модификация \samples\Advanced\Tsb_Brw2xml\Tsb4xml.prg [pre2] 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 ... [/pre2] Полет HMG_ClrToHTML( nClr ) нормальный

gfilatov2002: SergKis пишет: Модификация \samples\Advanced\Tsb_Brw2xml\Tsb4xml.prg Благодарю за помощь

LYSK: Григорий, а то, что исчезли примеры ADSRDD - это так и должно быть?

gfilatov2002: LYSK пишет: исчезли примеры ADSRDD В каких папках были эти примеры Насколько я помню, такие примеры всегда были дополнительные из-за необходимости включать в поставку необходимые для работы dll-ки. По ходу, обновил сборку 19.01 с учетом последних изменений (путь и имя установщика не изменились)

LYSK: так то и была папка ADS_RDD. "Живому тормоз-мертвечина!" как сказал классик. Появилась необходимость вжиться в программу, где индексы IDX, которых оказывается не не умеет HARBOUR ;-). И фиг было бы с ними, но какое то время старое и новое должны жить одновременно.. Вот и посмотреось в сторону локального ADS.

Haz: LYSK пишет: Вот и посмотреось в сторону локального ADS так проблема то в чем ? в поставке rddads скорее не самый новый , но рабочий. Не обращал внимания , но неужель DBFCDX не умеет работать с IDX ??

LYSK: Pasha вот тут https://clipper.borda.ru/?1-4-0-00000805-000-0-0-1381588962 писал: Сейчас посмотрел сырцы харбора, и увидел, что индексы idx не поддерживаются. Проблема в том что пока не нашлось client ingene, совместимого с adordd из комплектной harbour/lib

Dima: LYSK пишет: Появилась необходимость вжиться в программу, где индексы IDX, которых оказывается не не умеет HARBOUR ;-). Так собери ADSRDD и юзай CDX и IDX , хоть вместе , хоть отдельно....работает !

Haz: Dima пишет: Так собери ADSRDD именно так , скачай последние сырцы и собери с ними под нужного клиента

LYSK: Дима, там еще нужен ADS'ный фарш, и пока что у меня не нашлось совместимого с ADSRDD. Вот в 2010 году был!

Dima: LYSK Всё тут (версия 11)

Haz: LYSK пишет: нужен ADS'ный фарш 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: Dima пишет: Всё тут (версия 11) Мы тут наперегонки помогаем

LYSK: За что и уважаю Клипперистов!

SergKis: gfilatov2002 Небольшая добавка [pre2] 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 ) ... [/pre2]

SergKis: gfilatov2002 Возможно будет интересно : C [pre2] 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 ); } [/pre2] Class [pre2] #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 [/pre2] Samples\Basic\GetBox [pre2] /* * 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 [/pre2]

Andrey: gfilatov2002 пишет: Выпущена новая сборка 19.01 для BCC 5.5.1 и компиляторов Harbour и xHarbour. Пере собрал несколько программ. Полёт нормальный !

gfilatov2002: SergKis пишет: Небольшая добавка Принято. Благодарю за помощь SergKis пишет: Возможно будет интересно Да, это интересно

SergKis: gfilatov2002 пишет Да, это интересно Тогда полный вариант примера Basic\GetBox https://my-files.ru/u0c7yv В архиве и полный вариант h_objects.prg Пример можно пробовать на разных мониторах и разрешениях. Параметры есть FontSize, ScaleWidth, ScaleHeight можно поиграть, к примеру demo.exe 14 125 110

gfilatov2002: SergKis пишет: полный вариант h_objects.prg Спасибо Буду разбираться...

SergKis: gfilatov2002 Нашел, что не перенес из своей раб. версии в h_objects.prg [pre2] 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 ) ... [/pre2]

SergKis: PS и [pre2] 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 ) ) [/pre2]

SergKis: PPS и [pre2] 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 ) ... [/pre2]

SergKis: gfilatov2002 Если в пример добавить [pre2] ... END WITH This.Button_1.Enabled:=.f. This.Button_3.Enabled:=.f. This.Browse_1.ColumnsAutoFitH END WINDOW Form_1.Center Form_1.Activate ... [/pre2] то поведение browse будет нормальным, при смене параметров

gfilatov2002: SergKis пишет: в пример добавить Принято с благодарностью Контрольный пример работает нормально

SergKis: gfilatov2002 Слегка почистил пример https://my-files.ru/sz6n72 добавил управление и DublClick по getboxам записи из browse для включения edit.

gfilatov2002: SergKis пишет: почистил пример Благодарю за помощь

SergKis: 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: PS пропустил несколько событий (исп. параметра) [pre2] ... 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 ... [/pre2]

SergKis: PPS ON DBLCLICK (ThisWindow.Object):Post(12, This.Text_8.Index) ; //DublClick2Get() ; Такая форма записи, а не This.Index, исп. по причине отсутствия инф. о контроле, т.к. блок кода выполняется в TGET. Переданный индекс контрола, в событии создает среду This для указанного контрола. Если не передавать индекс, то среда This будет только для окна

SergKis: gfilatov2002 [pre2] можно зарезервировать для исп. в событиях о Петра 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) [/pre2]

SergKis: gfilatov2002 Исправление, что бы в приоритете был индекс контрола, потом handle (было наоборот) [pre2] 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 ) [/pre2]

SergKis: gfilatov2002 Еще, измените код, а то мелькает в левом верхнем углу [pre2] 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 ... [/pre2]

gfilatov2002: SergKis пишет: можно зарезервировать Cделал SergKis пишет: что бы в приоритете был индекс контрола Принято SergKis пишет: мелькает в левом верхнем углу Благодарю за помощь!

SergKis: gfilatov2002 пишет Сделал Спасибо. Вот что получилось с примером (h_objects.prg свежий) https://my-files.ru/v1kc9m

SergKis: gfilatov2002 Предложение. Вынести за скобки #ifdef _OBJECT_ процедуры 1. FUNCTION Do_WindowEventProcedure( bBlock, i, p1, p2, p3, p4 ) FUNCTION Do_ControlEventProcedure( bBlock, i, p1, p2, p3, p4 ) [pre2] 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()) ... [/pre2]

SergKis: gfilatov2002 Правка. [pre2] 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 ) ) ... [/pre2]

gfilatov2002: SergKis пишет: Предложение. Сделал, конечно. Только изменил кодовое слово INIT на ON INIT SergKis пишет: Правка Благодарю за помощь

SergKis: gfilatov2002 Еще, если добавить [pre2] 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 [/pre2]

gfilatov2002: SergKis пишет: ACCESS AO INLINE ::oApp:oCargo ACCESS AP INLINE ::oApp:oProp OK

SergKis: gfilatov2002 Пропустил строки [pre2] CLASS TDlu2Pix ... ACCESS IsMsg INLINE ( ::lAction .and. ! ::lError ) ACCESS Action INLINE ::lAction ASSIGN Action( lAction ) INLINE ::lAction := !( Empty( lAction ) ) ... [/pre2]

gfilatov2002: SergKis пишет: ACCESS Action INLINE ::lAction ASSIGN Action( lAction ) INLINE ::lAction := !( Empty( lAction ) ) OK

SergKis: gfilatov2002 Небольшая правка [pre2] 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 ) ) ) ... [/pre2] и пример https://my-files.ru/em7ci6

gfilatov2002: SergKis пишет: Небольшая правка Добавил Но модуль h_objects.prg в Вашем примере - без последних изменений

SergKis: gfilatov2002 Сори, забыл заменить. Тут https://my-files.ru/42c6pn

SergKis: gfilatov2002 Можно добавить [pre2] 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 ) ... [/pre2] Пример https://my-files.ru/nljgq8

gfilatov2002: SergKis пишет: Можно добавить OK

SergKis: gfilatov2002 Мысли вслух. Если вынести oDlu2Pixel(...) и класс TDlu2Pix за скобки #ifdef _OBJECT_, то можно [pre2] 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. [/pre2]

SergKis: PS Оборвалась передача, пропала ссылка на пример с указанными изменениями Пример тут https://my-files.ru/2iogvt

SergKis: PPS опять 504 Gateway Time-out, но передача прошла.

SergKis: gfilatov2002 Привел в соответствие свойства классов. В примере поправил StatusBar https://my-files.ru/n8l6pu

krutoff: Давно борюсь с ситуацией, когда у 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: krutoff пишет Если я закоментирую вызов функции _IsChildOfActiveWindow Есть такая блокировка работы GetBox, возможно оправданная. К примеру имеем не менее 3-х окон MdiChild и ввод в GetBox на одном из окон, после Enter focus улетает на др. окна. Используйте TEXTBOX с такой конструкцией[pre2] 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 [/pre2]

SergKis: PS c GetBox-сами проверку valid надо проделывать на кнопке OK, пробежав по всем и переключая фокус на Getbox с ошибкой

gfilatov2002: SergKis пишет: В примере поправил StatusBar При попытке скачать этот пример получаю 502 Bad Gateway Можно повторно выложить этот архив

SergKis: gfilatov2002 Тут https://transfiles.ru/bf6j5

gfilatov2002: SergKis пишет: Тут Спасибо! С этими изменениями пример у меня отработал нормально, надписи в статусбаре не искажаются

gfilatov2002: SergKis пишет: Мысли вслух. Если вынести oDlu2Pixel(...) и класс TDlu2Pix за скобки SergKis пишет: Используется среда контрола в ON INIT Не уверен, что требуются такие изменения во всех контролах

SergKis: gfilatov2002 Обратите внимание на [pre2] 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 // !!! это использовать, убрав выше ... [/pre2] Пробовал "Мысли в слух". Для сборки надо убрать ON INIT, открыв строку приращения координаты

gfilatov2002: SergKis пишет: Для сборки надо убрать ON INIT Благодарю за напоминание Да, конечно, я это сделал - иначе бы пример не запустился

SergKis: gfilatov2002 пишет Не уверен, что требуются такие изменения во всех контролах В своей версии 2.07 сделал контролы, перечисленные выше + в TsBrowse сделал [pre2] #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 [/pre2] Получилось 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: PS[pre2] *-----------------------------------------------------------------------------* 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 [/pre2]

SergKis: В продолжении примера, промежутков между контролами (GapsWidth, GapsHeight), оказалось удобным при Resize окон. В задаче окно разделено на 2-е части: - контролы Label, Getbox слева вертикально в плотном заполнении, 2 pixel в Normalize + кнопка Save - справа Tbrowse 60% окна. При Resize с ним ясно все. По контролам - персчитываю новое значение по вертикали GapsHeight, GapsWidth не меняю, т.е. левый X tsb тот же - меняю Y у контролов Текст из задачи как есть (кому интересно) [pre2] * ----------------------------------------------------------------------------------- * 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 [/pre2]

SergKis: gfilatov2002 Попробовал Tsb с on init ( пример Tsb_addRecord ) [pre2] /* * 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 [/pre2] Был не прав с EndTbrowse сделал так [pre2] *-----------------------------------------------------------------------------* 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 [/pre2]

gfilatov2002: 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 пишет: Попробовал Tsb с on init Спасибо! У меня такой пример тоже сработал (см. ниже) /* * 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: gfilatov2002 Пример для SET OOP ON\OFF https://TransFiles.ru/wyxjd Если SET OOP ON -> убираем коменты у строк[pre2] 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 ) ... [/pre2]

SergKis: gfilatov2002 В App_OopGetbox2 правка[pre2] :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) } ) [/pre2]

gfilatov2002: SergKis пишет: собран пример в режиме SET OOP OFF Благодарю за скорую помощь

SergKis: gfilatov2002 В пример 3 правка [pre2] @ :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]) ) ; [/pre2]

gfilatov2002: SergKis пишет: В пример 3 правка OK

SergKis: gfilatov2002 Пропустил я в примере 3[pre2] 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" ; [/pre2]

gfilatov2002: SergKis пишет: в примере 3 DEFINE GETBOX Text_6 // Alternate Syntax ... BACKCOLOR :O:BColorGet ... и TOOLTIPы поправить Благодарю за помощь

SergKis: gfilatov2002 пишет У меня такой пример тоже сработал (о tsb) Мне понравилось использовать on init. В своей версии 2.07 прошел по всем контролам и добавил bInit. Даже в timer[pre2] Local ow := oDlu2Pixel() ... IF _HMG_lOOPEnabled Eval ( _HMG_bOnControlInit, k, mVar ) ow := _WindowObj( ParentFormHandle ) ENDIF Do_WindowEventProcedure( bInit, k, ow, ControlName, k ) Return Nil [/pre2] Если в IDE добавить on init {|| NIL }, то в ней можно переустанавливать координаты (к примеру): ON INIT {|| This.Row := :Y, This.Col := :X, This.Width := :W1, This.Height := :H1, :Y += This.Height + :GapsHeight, ... }

gfilatov2002: SergKis пишет: прошел по всем контролам и добавил bInit Добавил обработку bInit в 20 базовых элементов управления (плюс TBrowse, конечно). Поправил выделение при получении фокуса по событию ON GOTFOCUS в GetBox с символьными данными: [pre2] IF ValType( Value ) == "C" _HMG_aControlGotFocusProcedure [k] := {|| SendMessage( _HMG_aControlHandles [k], EM_SETSEL, 0, iif( Empty( Value ), -1, Len( Trim( ( _HMG_aControlHeadClick [k] ):Cargo ) ) ) ) } [/pre2] Неточность выделения видна при редактировании поля Text_7 на десятой записи из базы. Также в альтернативном синтаксисе использовал новую команду ON INIT <b> вместо увеличения длины команды END <control> [ON INIT]. Теперь бы не мешало проверить эти изменения на реальном примере...

SergKis: gfilatov2002 Дайте ссылку в личку или так Покручу. В тек. версии только несколько элементов от on init-ил

gfilatov2002: SergKis пишет: Дайте ссылку в личку Отправил ссылку

SergKis: gfilatov2002 пишет Отправил ссылку Забрал

gfilatov2002: SergKis пишет: Забрал Если описание использования dlu в файле doc\Changelog.txt содержит неточности (или ошибки), то прошу их исправить без стеснения

SergKis: gfilatov2002 Родной "оригинальный" BASIC\GetBox из 19.01 переделал на проверку ON INIT. Только прорисовка убрана в ON INIT, остальное не трогал Тут https://TransFiles.ru/36pe9

gfilatov2002: SergKis пишет: BASIC\GetBox из 19.01 переделал на проверку ON INIT Супер! Большое спасибо за помощь

SergKis: gfilatov2002 Маленькая правка[pre2] METHOD GetObj4Name( cName ) CLASS TWndData ... ::oName:Eval( {| oc | iif( cName $ Upper(oc:cName), AAdd( aObj, oc ), Nil ) } ) ... [/pre2]

gfilatov2002: SergKis пишет: Маленькая правка Ok

SergKis: gfilatov2002 Предложение по TREE добавить в Node и Item Cargo, использовав _HMG_aControlHeadClick[ k ] [pre2] #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. ) ... [/pre2]

SergKis: PS Пример BASIC\Tree https://TransFiles.ru/s4754

SergKis: PPS При TreeItemSort(...) и AddItem, думаю NODE\ITEM Cargo не стоит исползовать

SergKis: gfilatov2002 Замените, пожалуйста, методы, добавлена обработка удаленных контролов[pre2] 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 [/pre2]

gfilatov2002: SergKis пишет: Замените, пожалуйста, методы, добавлена обработка удаленных контролов Принято. Благодарю за помощь

Vlad04: Ещё бы хороший пример (на основе DBF) построения ДЕРЕВА и работы с ним

SergKis: Vlad04 пишет Ещё бы хороший пример (на основе DBF) построения ДЕРЕВА и работы с ним Какие трудности с dbf. К примеру имеем - группы - подгруппы - товар[pre2] 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 [/pre2] Если это в одном файле, открываем его три раза group, podgroup, tovar и делаем то же самое group, podgroup тэги UNIQUE

Vlad04: Не понял ? Какая вложенность здесь ? Группа и подгруппа ? Классический Трей- файлы директории.

SergKis: Vlad04 пишет Не понял ? Какая вложенность здесь ? Группа и подгруппа ? Вложенность обыкновенная, показана последняя часть 2-а node и item: Краски - группа Акриловые - подгруппа Водоэмульсионные - ... Масляные - ... ... Краска белая марка ... - товар\материал Краска синяя марка ... - ... ... Над группой может быть Краски для внутренних работ Краски для наружных работ ... Еще выше может быть Материалы для внутренних работ Материалы для наружных работ ... Классическое дерево, не хуже директорий

SergKis: gfilatov2002 Поправил Method Enabled (сейчас он не работает совсем, с изменениями - частично) [pre2] 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 пропадает сразу и не восстанавливается, но и колонок за пределы тсб нет. [/pre2]

SergKis: PS Есть faq с прорисовкой Header, Footer фантомных колонок, но это др. история

gfilatov2002: SergKis пишет: Method Enabled (сейчас он не работает совсем Посмотрел в примере Advanced\Tsb_seek рабочий вызов этого метода Что здесь не так

SergKis: PPS Уточнение по TsBrowse. HScroll есть, что то я просмотрел его В примере Tsb_Basic\demo4.prg с добавкой [pre2] 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 [/pre2]

SergKis: gfilatov2002 пишет Посмотрел в примере Advanced\Tsb_seek рабочий вызов этого метода Пример с методом работает У меня все время глюки с методом (отказадся использовать, только переменную :lEnabled). Спасает сохранение\восстановление колонок, hBrush и борьба с VScroll. Ok, буду бороться вне метода

gfilatov2002: SergKis пишет: Спасает сохранение\восстановление колонок, hBrush Переписал этот метод с учетом Вашего вклада следующим образом: [pre2]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 [/pre2] Хуже вроде не стало. Благодарю за помощь

SergKis: gfilatov2002 Было бы хорошо добавить параметры Clr1, Clr2, для управления, если BackColor окна не CLR_GRAY\HGREY

gfilatov2002: SergKis пишет: для управления, если BackColor окна не CLR_GRAY\HGREY Для этого я добавил в класс [pre2] DATA nClr_Gray AS NUMERIC INIT CLR_GRAY DATA nClr_HGray AS NUMERIC INIT CLR_HGRAY [/pre2]

SergKis: PS И добавить сохранение\восстановление цветов SuperHeader

SergKis: gfilatov2002 пишет Для этого я добавил в класс Похоже глаз замылился, не увидел, сору.

SergKis: gfilatov2002 Добавил SuperHeader [pre2] 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) } ... Работает [/pre2]

gfilatov2002: SergKis пишет: Добавил SuperHeader ... Работает Спасибо

Andrey: Григорий, я пример выслал на почту. Там наверное нужно переделать сохранение/восстановление цветов с учётом этих новых правок ?

SergKis: 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: 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: Подготовил третий релиз-кандидат для новой сборки 19.02 Кратко, что нового (см.ниже) [pre2]* 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. [/pre2] Благодарю Сергея Киселева за неоценимую помощь в подготовке этой сборки Возможно, Вы хотите присоединиться к команде разработчиков Минигуи

SergKis: gfilatov2002 пишет Возможно, Вы хотите присоединиться к команде разработчиков Минигуи Думаю, что нет, т.к. практически все разночтения между версиями hmg текущей и нашей (в базе 2.07) сняты. Товарищ, по работе, переводит на VC2017 hb в unucod с LV866 по правилам hb и тек. нашу версию hmg + C либы. Я максимально сближаю нашу версию hmg с текущей. В планах, последним шагом, тек. версию hmg сделать unicode, т.е. переползти на родную hmg

SergKis: gfilatov2002 Небольшой пример Tree по каталогам hmg + Cargo https://TransFiles.ru/wy6kc

gfilatov2002: SergKis пишет: пример Tree по каталогам hmg Супер Большое спасибо за пример

SergKis: gfilatov2002 Добавьте, пожалуйста, в CLASS TKeyData[pre2] ... ACCESS IsEvent INLINE ::lKey ASSIGN KeyUpper( lUpper ) INLINE hb_HCaseMatch( ::aKey, ! Empty( lUpper ) ) METHOD ISBLOCK( Key ) INLINE HB_ISBLOCK( ::Get( Key ) ) ... [/pre2]

gfilatov2002: SergKis пишет: Добавьте, пожалуйста, в CLASS TKeyData OK

SergKis: gfilatov2002 Небольшая оболочка для hmg https://TransFiles.ru/dujpq Хотел сделать без сообщений, но DublClick на Tree в Item оставляет фокус на Item, а не на TsBrowse. Сделал работу по сообщениям. На вопросы отвечу

gfilatov2002: SergKis пишет: Небольшая оболочка для hmg Большое спасибо! Очень хорошо SergKis пишет: Хотел сделать без сообщений Было бы тоже интересно... SergKis пишет: На вопросы отвечу Наверное, небольшое описание как использовать не помешает

SergKis: 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: 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: 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: 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: PS добавление новых ключевых слов [pre2] 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 }, ; ... [/pre2]

SergKis: PPS Отсечь каталоги из просмотра можно так [pre2] *-----------------------------------------------------------------------------* 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 [/pre2]

gfilatov2002: 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: SergKis пишет: Тут без евентов Большое спасибо

SergKis: gfilatov2002 пишет Решил эту проблему с помощью простого таймера предварительно добавив 3-й параметр в функцию Теперь фокус переключается нормально Это все хорошо Что бы этого не делать + убираются и др. бяки, предпочитаю работать с Event-ами. Тексты при этом не сильно отличаются (на примере видно). gfilatov2002 Можно добавить в h_objmisc.prg[pre2] *-----------------------------------------------------------------------------* 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 }) } ) [/pre2]

gfilatov2002: SergKis пишет: добавить в h_objmisc.prg OK, добавил P.S. Новая сборка выйдет завтра...

gfilatov2002: Выпущена новая сборка 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: Возможно, будет полезно (на базе пред. примера). Утилита hmg_project для просмотра исходников MiniGui https://TransFiles.ru/o9ytl Добавлен пункт All entity для списка всех entity объектов файлов C и PRG каталога SOURCE. На индексных колонках есть подвод по вводимому тексту (для колонки line это по name файла) Архив разворачивать в UTILS\hmg_project. Сборка только под посл. версией hmg. На вопросы отвечу.

gfilatov2002: SergKis пишет: Утилита hmg_project для просмотра исходников Большое спасибо SergKis пишет: будет полезно Да, очень наглядный пример системной утилиты

Andrey: SergKis пишет: Утилита hmg_project для просмотра исходников MiniGui Можно ли добавить в эту утилиту глобальный поиск по исходникам, но только не отдельных слов (это просто, можно Far использовать), а поиск по строкам 2х или 3х слов одновременно (Far такого не может) ?

TimTim: А что мелочиться, сразу уж поиск по регулярному выражению.

SergKis: Andrey пишет Можно ли добавить в эту утилиту глобальный поиск по исходникам, но только не отдельных слов Не понятно, какие фразы надо искать в исходниках hmg ? В своих и во многих проектах, понятно, в данных mem полей или текстовых данных баз, тоже ясно. И TimTim прав, лучше с регулярным выражением. Но это др. утилита, по мне.

Haz: Andrey пишет: Можно ли добавить в эту утилиту глобальный поиск по исходникам, но только не отдельных слов (это просто, можно Far использовать), а поиск по строкам 2х или 3х слов одновременно (Far такого не может) ? Far такое может , ставим плагин RESearch и ищем по регулярным выражениям насколько фантазии хватит в этих выражениях

Andrey: Haz пишет: плагин RESearch и ищем по регулярным выражениям насколько фантазии хватит в этих выражениях А я и не знал... Спасибо БОЛЬШОЕ !

SergKis: gfilatov2002 Небольшая правка в hmg_project [pre2] 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('') ... [/pre2] на время формирования списка тсб "All entity" блокируется X окна

SergKis: PS и еще [pre2] FUNCTION AppInitEnv() ... SET BROWSESYNC ON SET CENTERWINDOW RELATIVE PARENT _HMG_MESSAGE [1] := 'Are you sure ?' _HMG_MESSAGE [2] := 'Close Window' aEntityC := { "HB_FUNC(" , ; ... [/pre2]

gfilatov2002: SergKis пишет: Небольшая правка в hmg_project Спасибо

SergKis: gfilatov2002 Мелочь, конечно, но так правильнее [pre2] 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 ... [/pre2] Тогда в блоке кода события, как в 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: gfilatov2002 Прошу прощения не добрал команду nIndex := oWnd:GetObj( nIndex:cControlName ):Index

gfilatov2002: SergKis пишет: в блоке кода события, как в action кнопок и др. контролов, будет среда This для TsBrowse OK

gfilatov2002: Подготовил первый релиз-кандидат для новой сборки 19.03 Кратко, что нового: [pre2]* 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. [/pre2] Рассматриваю эту сборку как финальную вследствие невозможности продолжения работы по финансовым причинам

dimao: Ой! Вы опубликуйте Яндекс кошелек. Может нам удастся как то компенсировать ваши старания!

gfilatov2002: dimao пишет: опубликуйте Яндекс кошелек Благодарю за отклик, но Яндекс кошельки заблокированы на Украине. Единственный реальный путь - оплата через PayPal (РЕКВИЗИТЫ ЕСТЬ НА САЙТЕ).

Vlad04: Не Единственный. Как пишут Самый простой и оптимальный вариант: перечисление через сайт paysend.com Системе не важно, где были эмитированы карты — главное, чтобы они были открыты в международных платежных системах (Mastercard, Maestro, Visa). Работа с системой «МИР» не поддерживается. Нужен только интернет и номер карточки адресата. Комиссия при этом фиксирована и составляет всего 49 рублей в независимости от суммы перевода.

PSP: Какой принцип оплаты (вознаграждения) приемлем? Единоразово (лицензия), периодически (покупка текущего релиза)? Какова сумма?

gfilatov2002: PSP пишет: Какой принцип оплаты (вознаграждения) приемлем? Любой PSP пишет: Единоразово (лицензия), периодически (покупка текущего релиза)? Желательно, периодически PSP пишет: Какова сумма? На Ваше усмотрение, т,е, пожертвование

PSP: Создал отдельную тему: http://clipper.borda.ru/?1-1-0-00000547-000-0-0-1552900007

Andrey: gfilatov2002 пишет: Подготовил первый релиз-кандидат для новой сборки 19.03 Григорий, а туда войдёт пример FormDarken(0.7).7z ? А то Сергей классно там описал в функции SayValueObj() методы и как работать с объектами через oWnd := ThisWindow.Object

gfilatov2002: Andrey пишет: туда войдёт пример FormDarken(0.7).7z ? Нет. Но он доступен для скачивания на этой странице сайта http://hmgextended.com/applications.html

Andrey: gfilatov2002 пишет: Но он доступен для скачивания на этой странице сайта http://hmgextended.com/applications.html Тогда туда же и этот большой проект положите - Tsb_composite(2.18).7z

gfilatov2002: Andrey пишет: этот большой проект положите - Tsb_composite Добавил на эту страницу этот проект тоже

Haz: Григорий, уберите пожалуйста проверку на номер записи. С индексами и фильтром при наличии проверки не работает метод ( конкретно под ADS , остальное не проверял ) [pre2] 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 ) [/pre2] с этой проверкой пытается встать на запись которая не входит в фильтр

gfilatov2002: Haz пишет: с этой проверкой пытается встать на запись которая не входит в фильтр Поправил. Благодарю за помощь

gfilatov2002: Выпустил новую сборку 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: Григорий, а как получить сборки для MS VisualC 2017 ?

gfilatov2002: Andrey пишет: как получить сборки для MS VisualC 2017 ? Архивы этих сборок лежат по старым адресам, имена архивов я не менял.

Andrey: Спасибо ! И что-то нет доки: * 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: Andrey пишет: нет доки Документация находится в основном дисрибутиве (для BCC 5.5)

Andrey: Блин... Опять простая невнимательность .

SergKis: gfilatov2002 В новой версии примеры CheckLabel* валятся с похожей ошибкой [pre2] 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 ------------------------------ ... [/pre2]

gfilatov2002: SergKis пишет: примеры CheckLabel* валятся с похожей ошибкой Да, я знаю Уже сделал "тихое" обновление этой сборки Прошу скачать заново и проверить эти исправления Андрей Кстати, обновил архив MSVC-сборки также с учетом последних изменений, рекомендую скачать...

SergKis: gfilatov2002 пишет Прошу скачать заново и проверить эти исправления Работает

Andrey: gfilatov2002 пишет: Кстати, обновил архив MSVC-сборки также с учетом последних изменений, рекомендую скачать... Спасибо БОЛЬШОЕ ! Григорий, а можно эти функции добавить в базовые ? А то постоянно приходиться добавлять в проги, где есть работа с ини-файлами. Функции не мои, это твоя работа. [pre2]*--------------------------------------------------------* 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 ) [/pre2]

Andrey: Перешёл на новую версию МиниГуи. Теперь вылетает с ошибкой: 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: [pre2] SetProperty( cForm, cObj, "BackgroundColor", aBackgroundColor )[/pre2] В текстах программ часто использую. Пришлось откатиться на предыдущую версию.

SergKis: Andrey SetProperty( cForm, cObj, "BackgroundColor", aBackgroundColor ) попробуй

Andrey: SergKis пишет: попробуй Блин, это опять все исходники шерстить....

SergKis: Andrey h_controlmisc.prg line 4025 CASE Arg3 == "BACKCOLOR" .OR. Arg3 == "GRADIENTOVER" .OR. Arg3 == "BACKGROUNDCOLOR" добавь и пересобери libу или пробни #translate BACKGROUNDCOLOR => BACKCOLOR

Andrey: Пере собрал библиотеку. Теперь вылетает на: 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: [pre2] SetProperty( cForm, cObj, "Capture", "" )[/pre2]

SergKis: и какая версия у тебя см.уже 1810 не нахожу Captu ?

Andrey: 19.03 [pre2] @ 190, 20 CHECKBOX &cObj CAPTION cCaption ; .....[/pre2] В 19.02 работает однако.... Понял в чём дело. Ошибся в синтаксисе я, а раньше версии просто пропускали это. вместо SetProperty( cForm, cObj, "Capture", "" ) надо SetProperty( cForm, cObj, "CAPTION", "" ) Заработало !

SergKis: gfilatov2002 Предлагаю добавить в [pre2] 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 } ... [/pre2]

gfilatov2002: 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 Благодарю за предложение Но что мешает уже сейчас присвоить :nStatusItem := 0 с тем же результатом

SergKis: gfilatov2002 пишет Но что мешает уже сейчас присвоить Как говорится, УПС. Вполне можно. В своей версии увидел DATA lMsg INIT .F. (всегда отключено, не исп. внутренний механизм тсб), вот и дернулся.

Haz: Григорий , проверьте точно ли исправления прошли в новой версии. После обновления опять словил глюк , глянул исходники - они не изменились [pre2] 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 ) [/pre2] нужно удалить ( закоментить ) строки , у себя убрал. Глюк исчез [pre2] If Empty( ( cAlias )->( dbFilter() ) ) nRec := Min( ( cAlias )->( LastRec() ), nRec ) EndIf [/pre2]

gfilatov2002: Haz пишет: удалить ( закоментить ) строки , у себя убрал. Глюк исчез If Empty( ( cAlias )->( dbFilter() ) ) nRec := Min( ( cAlias )->( LastRec() ), nRec ) EndIf Убрал эти строки из метода GotoRec() Благодарю за проверку

gfilatov2002: 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: Часто требуется узнать какой хороший человек отредактировал данные в таблице. У себя задаче решил через ::bPrevEdit и ::bPostEdit в колонках Но поскольку бровсов уже более 50 и это не предел , поднадоело в каждом это прописывать. Предлагаю включить в библиотеку базовый механизм 1 в данных бровса определить [pre2] DATA xOldEditValue DATA xNewEditValue DATA bEditLog [/pre2] 2 в METHOD Edit CLASS TSbrowse добавить [pre2] Default nCell := ::nCell, ; ::lPostEdit := .F., ; ::lNoPaint := .F. ::xOldEditValue := ::xNewEditValue := Eval(::aColumns[ nCell ]:bData ) [/pre2] 3 в конце METHOD PostEdit CLASS TSbrowse добавить [pre2] ::xNewEditValue := Eval(::aColumns[ ::nCell ]:bData) if hb_isBlock( ::bEditLog ) Eval( ::bEditLog, ::xOldEditValue, ::xNewEditValue, Self ) end Return Nil [/pre2] тогда в своей программе при определении бровса достаточно указать [pre2] oBrw:bEditLog := { |a,b,c| WriteEditLog( a, b, c:cAlias ) } [/pre2] и прописать саму функцию в которой в базу или текстовик вести протокол кто когда что и тд Func WriteEditLog ( xOld, xNew, cAlias ) ... ... return nil Как идейка

SergKis: Haz пишет Как идейка На первый взгляд, ОК! только ::xOldEditValue := ::xNewEditValue := ::bDataEval( ::aColumns[ nCell ], , nCell ) и ::xNewEditValue := ::bDataEval( ::aColumns[ nCell ], , nCell )

SergKis: PS[pre2] if hb_isBlock( ::bEditLog ) .and. ::xOldEditValue != ::xNewEditValue Eval( ::bEditLog, ::xOldEditValue, ::xNewEditValue, Self ) end [/pre2]

SergKis: PPS Возможно, эти переменные надо не CLASS TsBrowse, а в CLASS TsColumn Тогда все колонки тек. линии будут иметь старые, новые значения

Haz: SergKis пишет: На первый взгляд, ОК! Спасибо за правки

Haz: SergKis пишет: PPS Возможно, эти переменные надо не CLASS TsBrowse, а в CLASS TsColumn Тогда все колонки тек. линии будут иметь старые, новые значения Нет смысла , редактируется всегда только одна из колонок в один момент времени

Haz: Haz пишет: Нет смысла , редактируется всегда только одна из колонок в один момент времени хотя , если в TsColumn , то это позволит undo по строке сделать

SergKis: И в TsColumn должно быть достаточным только старое значение, а новое в bPostEdit должно быть определено. Именно для Undo и есть смысл в колонке иметь старое значение

Haz: В общем пока получилось так [pre2] 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 [/pre2] После объявления в своей программе oBrw:bEditLog := { |a,b,c| WriteEditLog( a, b, c ) } все передается корректно

SergKis: gfilatov2002 Управление линиями в колонке[pre2] 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 [/pre2]

SergKis: gfilatov2002 Для Header, Footer тоже самое можно сделать[pre2] 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 ... [/pre2]

SergKis: gfilatov2002 Предлагаю добавить для блокировки перехода на др. строку вверх\вниз при :PostEdit (oCol:EditMove работает)[pre2] 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 ... [/pre2]

gfilatov2002: SergKis Добавил эти изменения, хотя и считаю их необязательными Благодарю за помощь

gfilatov2002: Просто к сведению Завершена подготовка следующей сборки 19.04, которая выйдет на этой неделе Список изменений для новой сборки можно увидеть на сайте библиотеки (файл ChangelogHMG.docx).

SergKis: gfilatov2002 пишет Добавил эти изменения, хотя и считаю их необязательными Согласен, что это мелочь. Но линиями давно хотел заняться, т.к. надо часто показывать колонки, как одну графу, суперхидер над ней занят. Приходилось показывать через выражение, а модифицировать на окне как отдельные поля\getbox. Второе изменение, по мне, более четко отрабатывает установленный на колонки :nEditMove алгоритм, не перескакивая на др. запись, отличную от строки с :Edit

gfilatov2002: SergKis пишет: более четко отрабатывает установленный на колонки :nEditMove алгоритм Я полностью доверяю Вашему программисткому чутью, потому что Вы - практик Большое спасибо за Вашу помощь

SergKis: PS Пример Tsb_addrecord_3. Line 94 добавляем[pre2] :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' ) получили объединенную колонку [/pre2]

gfilatov2002: Выпустил новую сборку 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: Григорий, а можно сделать тихое обновление под новую сборку 19.04 с учётом предложения для [pre2]::nClrLine := ::nCLR_GRAY // изменить цвет линий между ячейками таблицы [/pre2] А то новой версии долго ждать придётся... Заранее БОЛЬШОЕ СПАСИБО !

gfilatov2002: Andrey пишет: можно сделать тихое обновление OK, завтра сделаю

gfilatov2002: Обновил установщик сборки 19.04 с учетом пожелания Andrey. Что нового: - добавил новую переменную :nCLR_Lines класса TSBrowse в метод Enabled() для установки цвета линий сетки при блокировке грида.

SergKis: gfilatov2002 Возвращаясь к вопросу, озвученного Haz С какой целью в METHOD TSBrowse:Edit() в CheckBox игнорируется VK_RETURN ? в теме http://clipper.borda.ru/?1-1-0-00000526-000-280-0 В некоторых ситуациях, на ChecBox проще производить действия, чем используя :aBitMaps на цифрах и отсутствие VK_RETURN мешает. Давайте добавим, предложенное Игорем, с правкой[pre2] 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 ... [/pre2]

gfilatov2002: SergKis пишет: на ChecBox проще производить действия Теперь стало понятнее предложение Игоря SergKis пишет: Давайте добавим, предложенное Игорем, с правкой Добавлю, конечно... Благодарю за разъяснение P.S. Снова обновил установщик сборки 19.04 с учетом вышеуказанных изменений в TSBrowse

SergKis: gfilatov2002 Меня дернули, стояли над душой, потому отослал с ошибкой, ИЗВИНИТЕ. Это должна быть не глобальная установка, а установка на колонку с CheckBox, т.е.[pre2] CLASS TSColumn DATA lCheckBoxNoReturn INIT .T. и If nKey != VK_RETURN .or. ! oCol:lCheckBoxNoReturn [/pre2]

SergKis: PS С глобальной то же можно, но трудности будут при наличии в строке нескольких ChecBox, а VK_RETURN нужен не всем

gfilatov2002: SergKis пишет: должна быть не глобальная установка, а установка на колонку с CheckBox Поправил и перезалил исправленный установщик Благодарю за помощь

Haz: gfilatov2002 пишет: Теперь стало понятнее предложение Игоря Только мне расскажите зачем VK_RETURN в игноре. Не понимаю как это помогает работать с чекбоксом Я не придираюсь. Хочу понять логику автора

SergKis: Haz пишет Не понимаю как это помогает работать с чекбоксом Вроде, если поставить oCol:nEditMove != 0, не помню на память, то по VK_RETURN должна исполнится команда перемещения на др. колонку или строку и колонку

Haz: SergKis пишет: Вроде, если поставить oCol:nEditMove Так это по любой колонке ПОСЛЕ редактирования. А сейчас по ENTER не пускает в редакцию. И я не врубаюсь зачем это сделано

SergKis: Haz В данном случае, если колонка lEdit == .T., то Enter просто переместится на след. колонку без исправления. В этом логика есть. К примеру всегда ставлю на combobox NOTABSTOP, т.к. стрелками легко сбить значение. Тут такой же случай, тыкаем enter на колонках, без реальной модификации и допрыгиваем до нужной колонки. Перепрыгивая и CheckBox без изменений.

gfilatov2002: Haz пишет: я не врубаюсь зачем это сделано Возможно, автор библиотеки хотел имитировать поведение обычного CheckBox, который не изменяет свое значение при нажатии клавиши Enter, а реагирует на ПРОБЕЛ

Haz: SergKis пишет: Перепрыгивая и CheckBox без изменений. Это аргумент, но все равно слабоват. т. е. защита о дурака. Тогда логичнее было бы делать запрет VK_RETURN только при nEditMove <> 0

Haz: gfilatov2002 пишет: Возможно, автор библиотеки хотел имитировать поведение обычного CheckBox, который не изменяет свое значение при нажатии клавиши Enter, а реагирует на ПРОБЕЛ Да, Сергей примерно о том же говорит. Но у меня пользователи практически до оргазма доходят в попытках энтером переключить значение чекбокса. Думаю все же опциональность здесь точно необходима. Спасибо, мысль автора пррояснили.

SergKis: Haz пишет Думаю все же опциональность здесь точно необходима. К примеру :nEditMove - перемещение на след. строку на CheckBox (ставим по опции, до этого прыгала по горизонтали) Тогда: Space - ставим\снимаем галочку и переходим на след. строку в той же колонке. Enter просто перемещает на след. строку в той же колонке. В целом удобно, без мыши проделать операции.

SergKis: Haz пишет Думаю все же опциональность здесь точно необходима. Можно сделать, что бы не вводить, переменную tsbrowse[pre2] METHOD LoadFields( lEditable, lChecBoxNoReturn ) CLASS TSBrowse ... If cType == "L" ATail( ::aColumns ):lCheckBox := .T. If HB_ISLOGICAL(lChecBoxNoReturn) ATail( ::aColumns ):lCheckBoxNoReturn := lChecBoxNoReturn EndIf EndIf ... [/pre2] или вводить переменную tsbrowse в Nil и в tscolumn для checkbox:lChecBoxNoReturn устанавливать от нее, если задана

полная версия страницы