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

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

gfilatov: Начало темы находится здесь, а теперь АНОНС * АНОНС * АНОНС * АНОНС * АНОНС Готовится к опубликованию новая сборка №48, которая выйдет в конце недели. Если у Вас есть интересные наработки для включения в новый релиз, то сейчас самое удобное время для их отправки мне Кратко, что нового: - исправление обнаруженных ошибок и неточностей кода; - новый класс HEADERIMAGE для Grid и Browse; - свойство Address в Hyperlink может теперь открывать папку или файл на диске; - добавлен NOTABSTOP класс для Browse; - поддержка пользовательских компонентов (заимствована из оффициального релиза); - расширения и исправления в библиотеках TsBrowse и PropGrid; - обновлены сборки Харбор и HMGS-IDE; - новые и обновленные старые примеры (как обычно ).

Ответов - 90, стр: 1 2 3 4 5 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]



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