Форум » GUI » Новая версия Расширенного релиза библиотеки MiniGUI (часть VI ) (продолжение) » Ответить
Новая версия Расширенного релиза библиотеки MiniGUI (часть VI ) (продолжение)
gfilatov: Начало темы находится здесь, а теперь АНОНС * АНОНС * АНОНС * АНОНС * АНОНС Готовится к опубликованию новая сборка №48, которая выйдет в конце недели. Если у Вас есть интересные наработки для включения в новый релиз, то сейчас самое удобное время для их отправки мне Кратко, что нового: - исправление обнаруженных ошибок и неточностей кода; - новый класс HEADERIMAGE для Grid и Browse; - свойство Address в Hyperlink может теперь открывать папку или файл на диске; - добавлен NOTABSTOP класс для Browse; - поддержка пользовательских компонентов (заимствована из оффициального релиза); - расширения и исправления в библиотеках TsBrowse и PropGrid; - обновлены сборки Харбор и HMGS-IDE; - новые и обновленные старые примеры (как обычно ).
Haz: SergKis пишет: Enter просто перемещает на след. строку в той же колонке. В целом удобно, без мыши проделать операции. Никогда не пользовался в данном виде. Стрелками проще UP/DOWN. Раз будет переменная, будет и выбор на любой вкус.
SergKis: Haz пишет Никогда не пользовался в данном виде. Стрелками проще UP/DOWN. Такой режим существовал и не стоит его трогать. Для переменной, возможен вариант[pre2] METHOD Edit( uVar, nCell, nKey, nKeyFlags, cPicture, bValid, nClrFore, ; ... If nKey != VK_RETURN .or. ( ! oCol:lCheckBoxNoReturn .or. !Empty(::lCheckBoxAllReturn) ) ... CLASS TSBrowse DATA lCheckBoxAllReturn INIT .F. [/pre2] .T. - включит для всех, остальные значения - работа от значения :lCheckBoxNoReturn в колонке
Haz: SergKis пишет: Такой режим существовал и не стоит его трогать. Да пусть живет Главное всегда должен быть выбор. И про него сейчас разговор. Мне больше две переменные нравятся в твоем последнем предложении.
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: SetProperty( cForm, cObj, "BackgroundColor", aBackgroundColor ) Сделал как советовал Сергей: #translate BACKGROUNDCOLOR => BACKCOLOR Теперь перестало собираться вообще, ошибка при сборке: form_calc.prg(170) Error E0030 Syntax error "syntax error at '@'" form_calc.prg(183) Error E0030 Syntax error "syntax error at '@'" form_calc.prg(553) Error E0030 Syntax error "syntax error at '@'" form_calc.prg(687) Error E0030 Syntax error "syntax error at '@'" form_calc.prg(732) Error E0030 Syntax error "syntax error at '@'" form_calc.prg(882) Error E0030 Syntax error "syntax error at '@'" form_calc.prg(1116) Error E0030 Syntax error "syntax error at '@'" 7 errors Т.е. выдаёт ошибку на работающем коде[pre2] @ 230, 50 IMAGE Image_Warning PARENT Form_Calc ; PICTURE 'Warning128' WIDTH 128 HEIGHT 128 ; STRETCH TRANSPARENT BACKGROUNDCOLOR aBackColor INVISIBLE[/pre2] Григорий, верни назад как ранее была обработка, как советовал Сергей ! [pre2]h_controlmisc.prg line 4025 CASE Arg3 == "BACKCOLOR" .OR. Arg3 == "GRADIENTOVER" .OR. Arg3 == "BACKGROUNDCOLOR" добавь и пересобери libу [/pre2] Вот это помогло !
Andrey: В новой версии опять часто вылетает на такой ошибке: Error BASE/1132 Переполнение массива: Неверное количество аргументов Called from FILLDLG(341) in module: h_alert.prg Called from (b)HMG_ALERT(161) in module: h_alert.prg Called from DO_WINDOWEVENTPROCEDURE(82) in module: h_objmisc.prg Called from _ACTIVATEWINDOW(1314) in module: h_windows.prg Called from HMG_ALERT(161) in module: h_alert.prg Если задана случайно или осталось после предыдущего использования: _HMG_ModalDialogReturn := 2 и вызвать HMG_ALERT() только с одной кнопкой, то прога вылетает. Можно туда (до строки 341) вставить проверку, чтобы не вылетало ?
gfilatov2002: Andrey пишет: Можно туда (до строки 341) вставить проверку Поправил, конечно Благодарю за сообщение
gfilatov2002: Обновил сборку 19.04 (Update 1) с учетом последних исправлений (в TsBrowse и др,) Что нового: * Updated: Added the sounds to the new Alert* family functions to be similar to the system dialogs in Windows 7. Contributed by Grigory Filatov <gfilatov@inbox.ru> (see demo in folder \samples\Basic\MAINDEMO_(SYNTAX_I)) * Updated: Adaptation FiveWin Class TSBrowse 9.0 in HMG: - added processing of the new variable :lPostEditGo and correction for the codeblock :bEditLog in the method PostEdit(); - improved handling of <Enter> key in a celled Checkbox item. (see demo in folder \samples\Advanced\Tsb_BitMaps) Suggested and contributed by Sergej Kiselev. * Updated: RDDLeto client library by Rolf 'elch' Beckmann. Contributed by Grigory Filatov <gfilatov@inbox.ru> (see demo in folder \samples\Advanced\LetoDBf) * Updated: HbSQLite3 library: - update for using SQLITE3 version 3.29.0dev (from 3.28.0). Contributed by Grigory Filatov <gfilatov@inbox.ru> * New: 'Read color by coordinates' sample. Contributed by Verchenko Andrey <verchenkoag@gmail.com> (see in folder \samples\Basic\GetColorRowCol) * Updated: 'HMG Grid Demo' sample. Contributed by Grigory Filatov <gfilatov@inbox.ru> (see demo.prg in folder \samples\Basic\Grid_Test) * Updated: 'MiniGUI DataBase Utility' sample: - added the closing of opened table; - correction for modification of a structure of a table. Contributed by Pierpaolo Martinello <pier.martinello[at]alice.it> (see in folder \Utils\mgDBU)
Andrey: gfilatov2002 пишет: Обновил сборку 19.04 (Update 1) с учетом последних исправлений (в TsBrowse и др,) Григорий, про это не забудь пожалуйста:[pre2] h_controlmisc.prg line 4025 CASE Arg3 == "BACKCOLOR" .OR. Arg3 == "GRADIENTOVER" .OR. Arg3 == "BACKGROUNDCOLOR" [/pre2]
gfilatov2002: Andrey пишет: Arg3 == "BACKGROUNDCOLOR" Сделал Благодарю за напоминание
SergKis: gfilatov2002 Надо убрать в h_checklabel.prg, похоже пересеклись по адресам [pre2] /* IF _HMG_lOOPEnabled Eval ( _HMG_bOnControlInit, k, mVar ) #ifdef _OBJECT_ ow := _WindowObj ( ParentFormHandle ) oc := _ControlObj( ControlHandle ) #endif ENDIF */ Do_ControlEventProcedure ( bInit, k, ow, oc ) RETURN Nil [/pre2]
SergKis: PS это видно на примере CheckLabel_2 SET OOP ON пропадают картинки
gfilatov2002: SergKis пишет: Надо убрать в h_checklabel.prg Сделал ремарку, конечно Благодарю за помощь
SergKis: gfilatov2002 Давайте сделаем [pre2] METHOD Destroy() CLASS TSBrowse ... вместо If ::aSortBmp != Nil DeleteObject ( ::aSortBmp[ 1 ] ) DeleteObject ( ::aSortBmp[ 2 ] ) EndIf If ::aCheck != Nil DeleteObject ( ::aCheck[ 1 ] ) DeleteObject ( ::aCheck[ 2 ] ) EndIf так If Valtype( ::aSortBmp ) == "A" .and. ! Empty( ::aSortBmp ) AEval( ::aSortBmp, {|hBmp| If( Empty( hBmp ), , DeleteObject( hBmp ) ) } ) EndIf If Valtype( ::aCheck ) == "A" .and. ! Empty( ::aCheck ) AEval( ::aCheck, {|hBmp| If( Empty( hBmp ), , DeleteObject( hBmp ) ) } ) EndIf Картинок можно больше складывать и на ходу менять по ситуевинам разным [/pre2]
gfilatov2002: SergKis пишет: Давайте сделаем Сделал, конечно Благодарю за помощь
SergKis: gfilatov2002 Сейчас в тсб :Destroy() отрабатывают не на все переменные DeleteObject(), загруженных по LoadImage() и их надо отрабатывать собственными обработчиками или складывать картинки в public переменные Предлагаю добавить в тсб переменную и такой вид :Destroy()[pre2] DATA lDestroyAll AS LOGICAL INIT .F. // flag to destroy all bitmap created LoadImage(...) ... METHOD Destroy() CLASS TSBrowse Local oCol Default ::lDestroy := .F. If ::uBmpSel != Nil .and. ::lDestroy DeleteObject ( ::uBmpSel ) EndIf If ::hBrush != Nil // Alen Uzelac 13.09.2012 DeleteObject ( ::hBrush ) EndIf If ::oCursor != Nil // GF 29.02.2016 ::oCursor:End() EndIf If ::hBmpCursor != Nil DeleteObject ( ::hBmpCursor ) EndIf If Valtype( ::aSortBmp ) == "A" .and. ! Empty( ::aSortBmp ) AEval( ::aSortBmp, {|hBmp| If( Empty( hBmp ), , DeleteObject( hBmp ) ) } ) EndIf If Valtype( ::aCheck ) == "A" .and. ! Empty( ::aCheck ) AEval( ::aCheck, {|hBmp| If( Empty( hBmp ), , DeleteObject( hBmp ) ) } ) EndIf If Len( ::aColumns ) > 0 FOR EACH oCol IN ::aColumns If Valtype( oCol:aCheck ) == "A" AEval( oCol:aCheck, {|hBmp| If( Empty( hBmp ), , DeleteObject( hBmp ) ) } ) EndIf If Valtype( oCol:aBitMaps ) == "A" AEval( oCol:aBitMaps, {|hBmp| If( Empty( hBmp ), , DeleteObject( hBmp ) ) } ) EndIf If ! ::lDestroyAll LOOP EndIf If ! Empty( oCol:uBmpCell ) .and. ! HB_ISBLOCK( oCol:uBmpCell ) DeleteObject( oCol:uBmpCell ) EndIf If ! Empty( oCol:uBmpHead ) .and. ! HB_ISBLOCK( oCol:uBmpHead ) DeleteObject( oCol:uBmpHead ) EndIf If ! Empty( oCol:uBmpSpcHd ) .and. ! HB_ISBLOCK( oCol:uBmpSpcHd ) DeleteObject( oCol:uBmpSpcHd ) EndIf If ! Empty( oCol:uBmpFoot ) .and. ! HB_ISBLOCK( oCol:uBmpFoot ) DeleteObject( oCol:uBmpFoot ) EndIf Next EndIf If ::lDestroyAll If Valtype( ::aSuperHead ) == "A" .and. ! Empty( ::aSuperHead ) AEval( ::aSuperHead, {|a| If( Empty(a[8]) .or. HB_ISBLOCK(a[8]), , DeleteObject( a[8] ) ) } ) EndIf EndIf If Valtype( ::aBitMaps ) == "A" .and. ! Empty( ::aBitMaps ) AEval( ::aBitMaps, {|hBmp| If( Empty( hBmp ), , DeleteObject( hBmp ) ) } ) EndIf #ifndef _TSBFILTER7_ If ::lFilterMode ::lFilterMode := .F. If Select( ::cAlias ) != 0 ::SetFilter() EndIf EndIf #endif ::hWnd := 0 Return 0 [/pre2]
gfilatov2002: SergKis пишет: Предлагаю добавить в тсб переменную и такой вид :Destroy() Добавил предложенные изменения (очистка использованных ресурсов - это всегда важно) Благодарю за помощь
gfilatov2002: Обновил сборку 19.04 (Update 2) с учетом последних исправлений и пожеланий (в TsBrowse и др,) * Fixed: The missed 'Make New Folder' button in the function GetFolder() at a specified initial path (introduced in the build 2.5.1). Problem was reported by Jayadev <jayadev65/at/yahoo.com>. Contributed by Grigory Filatov <gfilatov@inbox.ru> (see demo in folder \samples\Basic\GetFolder) * Enhanced: The Image control supports now a changing of the BACKGROUNDCOLOR property at runtime. You can set this property with: - function syntax: SetProperty ( Form, Image, 'BackGroundColor', aColor ) - pseudo-OOP syntax: FormName.ImageName.BackGroundColor := aRGBColor | nRGBColor FormName.TabName(nPage).ImageName.BackGroundColor := aColor Requested by Verchenko Andrey <verchenkoag@gmail.com>. Contributed by Grigory Filatov <gfilatov@inbox.ru> (see demo in folder \samples\Basic\GetColorRowCol) * Updated: Adaptation FiveWin Class TSBrowse 9.0 in HMG: - minor modification in the method Destroy(). Contributed by Sergej Kiselev. * New: 'Order Service System' sample: using MySQL through the TMySql class. Test passed with MySQL version 5.1.44 at Windows 7. Don't miss this very interesting example! Contributed by Marcelo Neves <marcelo.souza.das.neves@gmail.com> (see in folder \samples\Applications\OrderService) * New: 'Little wizard for create the controls' utility. Based upon a contribution of HMG user Dragan Cizmarevic. Adapted for Minigui Extended by Grigory Filatov <gfilatov@inbox.ru> (see in folder \Utils\hmg_wizard) * Updated: 'Data-Bound Controls' sample: - redesigned the input window for a new look. Contributed by Grigory Filatov <gfilatov@inbox.ru> (see demo2.prg in folder \samples\Basic\DATA_BOUND) * Updated: 'Using <Tab> key for navigation into a celled Grid' sample. Based upon a contribution of HMG user KDJ. Revised by Grigory Filatov <gfilatov@inbox.ru> (see demo2.prg in folder \samples\Basic\Grid_Test)
Andrey: Всем привет. Появилась ошибка в давно работающем модуле печати. Т.е. в новой версии МиниГуи появилась ошибка. Из таблицы вызываю форму печати через &cRun(cMenu, cForma, cAls2,..), там доп.окно MODAL Form_Dolg на которой в цикле вывод 10 значений: [pre2] cObj := "GetBox_Dolg" + HB_NtoS(nI) @ nRowGet, nColGet GETBOX &cObj VALUE aSumma[nI] ; PICTURE "@Z 99999.99" ; ..... ON CHANGE { || DolgGetBoxChange(aSumma) } SetProperty( ThisWindow.Name, cObj, "Cargo", nI )[/pre2] Оставляю курсор на форме допустим на 3-ем GetBox_Dolg3 (в дальнейшем будет ошибка по нему) и делаю печать. Все отлично, форма закрывается, ошибок нет. При возврате в главную таблицу - появляется ОШИБКА: Error MGERROR/0 Control: GetBox_Dolg3 Of Form_Dolg Not defined. Program terminated. --------------------------------- Stack Trace --------------------------------- Called from MSGMINIGUIERROR(99) in module: h_error.prg Called from GETPROPERTY(4585) in module: h_controlmisc.prg Called from (b)BUTTON_UPMENUTABLE(2271) in module: Tbrw_table.prg Called from (b)METRO3BUTTON(51) in module: Metro3button.prg Called from _DOCONTROLEVENTPROCEDURE(1865) in module: h_windows.prg Called from EVENTS(1825) in module: h_events.prg Called from DOMESSAGELOOP(0) Called from _ACTIVATEWINDOW(1499) in module: h_windows.prg Called from DOMETHOD(5155) in module: h_controlmisc.prg Called from FORM_MYTABLE(246) in module: Tbrw_table.prg Called from TBRWDOGOVOR(15) in module: Tbrw_1Run.prg Called from (b)MAIN(643) in module: 10main.prg Called from _DOCONTROLEVENTPROCEDURE(1865) in module: h_windows.prg Called from EVENTS(1825) in module: h_events.prg Called from DOMESSAGELOOP(0) Called from _ACTIVATEWINDOW(1499) in module: h_windows.prg Called from MAIN(688) in module: 10main.prg Почему ? Форма давно убита, ошибок по ней не было... Если КУРСОР будет стоять в GetBox_Dolg8, то ошибка будет: Error MGERROR/0 Control: GetBox_Dolg8 Of Form_Dolg Not defined. Program terminated. Т.е. сохраняется АКТИВНОЕ местоположение КУРСОРА в GetBox. Ошибка оказывается появилась давно. В версии 18.11 ошибка тоже появляется. Ниже протестировать пока не удалось. Очень срочно нужна помощь.... Что делать мне ?
SergKis: Andrey Стоит более жесткая проверка в Set\GetProperty[pre2] IF .NOT. _IsControlDefined ( Arg2 , Arg1 ) MsgMiniGuiError ( "Control: " + Arg2 + " Of " + Arg1 + " Not defined." ) ENDIF [/pre2] Понял из твоего сообщения, что Form_Dolg закрылась при возвращении на гл. таблицу, т.е. окна нет уже. Возможно, в button_upmenutable есть обращение к контролу, которое раньше игнорировалось.
Andrey: SergKis пишет: Понял из твоего сообщения, что Form_Dolg закрылась при возвращении на гл. таблицу, т.е. окна нет уже. Возможно, в button_upmenutable есть обращение к контролу, которое раньше игнорировалось. Да ! Больше я НИГДЕ не обращаюсь к GetBox_Dolg3/4/5/6... Это единственная форма с такими переменными. Если КУРСОР будет стоять в GetBox_Dolg8, то ошибка будет: Error MGERROR/0 Control: GetBox_Dolg8 Of Form_Dolg Not defined. Program terminated. Как убрать ошибку ?
SergKis: Andrey пишет Попробуй убрать[pre2] FUNCTION GetProperty ( Arg1 , Arg2 , Arg3 , Arg4 , Arg5 , Arg6 , Arg7 ) ... line 8584 /* IF .NOT. _IsControlDefined ( Arg2 , Arg1 ) MsgMiniGuiError ( "Control: " + Arg2 + " Of " + Arg1 + " Not defined." ) ENDIF */ [/pre2] и пересобери MiniGui.lib
Andrey: SergKis пишет: FUNCTION GetProperty ( Arg1 , Arg2 , Arg3 , Arg4 , Arg5 , Arg6 , Arg7 ) ... line 8584 /* IF .NOT. _IsControlDefined ( Arg2 , Arg1 ) MsgMiniGuiError ( "Control: " + Arg2 + " Of " + Arg1 + " Not defined." ) ENDIF */ В исходнике C:\MiniGUI\SOURCE\h_controlmisc.prg строк всего 7183 ... Где искать ? Нашёл в строке 3814 - то ?
Andrey: Нашел в коде h_controlmisc.prg, где у меня ошибка возникает: [pre2]#endif IF ( Upper( Arg2 ) == "VSCROLLBAR" .OR. Upper( Arg2 ) == "HSCROLLBAR" ) IF .NOT. _IsWindowDefined ( Arg1 ) MsgMiniGuiError ( "Window: " + Arg1 + " is not defined." ) ENDIF ELSE IF .NOT. _IsControlDefined ( Arg2 , Arg1 ) MsgMiniGuiError ( "Control: " + Arg2 + " Of " + Arg1 + " Not defined. 4585 !!!" ) ENDIF ENDIF[/pre2] За комментировал этот блок: [pre2]/* IF .NOT. _IsControlDefined ( Arg2 , Arg1 ) MsgMiniGuiError ( "Control: " + Arg2 + " Of " + Arg1 + " Not defined. 4585 !!!" ) ENDIF */[/pre2] Теперь другая ошибка лезет: Error MGERROR/0 Control Of Form_Table_Dog Not defined. Program terminated. Called from MSGMINIGUIERROR(99) in module: h_error.prg Called from GETPROPERTY(4410) in module: h_controlmisc.prg Called from (b)BUTTON_UPMENUTABLE(2273) in module: Tbrw_table.prg Called from (b)METRO3BUTTON(51) in module: Metro3button.prg Called from _DOCONTROLEVENTPROCEDURE(1865) in module: h_windows.prg Called from EVENTS(1828) in module: h_events.prg Called from DOMESSAGELOOP(0) Called from _ACTIVATEWINDOW(1499) in module: h_windows.prg Called from DOMETHOD(5156) in module: h_controlmisc.prg Called from FORM_MYTABLE(246) in module: Tbrw_table.prg Called from TBRWDOGOVOR(15) in module: Tbrw_1Run.prg Called from (b)MAIN(643) in module: 10main.prg Called from _DOCONTROLEVENTPROCEDURE(1865) in module: h_windows.prg Called from EVENTS(1828) in module: h_events.prg Called from DOMESSAGELOOP(0) Called from _ACTIVATEWINDOW(1499) in module: h_windows.prg Called from MAIN(688) in module: 10main.prg Т.е. теперь потерялась форма Form_Table_Dog ? Но она же есть на экране ! Вот функция (b)BUTTON_UPMENUTABLE(): [pre2] aObj2But[12,12] := { || SetProperty(cForm, This.Name, "Enabled", .F.) ,; DogListAbon(cForm, "nTable","","","") ,; MsgDebug( "Проверка выхода", cForm ) ,; MsgDebug( ThisWindow.Name, This.Name ) ,; SetProperty(cForm, This.Name, "Enabled", .T.) ,; Brw4Focus(nTable) } // строка 2273[/pre2] Т.е. это вызов на кнопке - ACTION aObj2But[12,12] Другие формы печати работают без ошибок, а где есть с GETBOX - то вылетает. Такое впечатление, что после GETBOX портится - MsgDebug( ThisWindow.Name, This.Name ) ?
SergKis: Andrey Попробуй в ON RELEASE формы с GetBox поставить самым последним вызов _PopEventInfo() для восстановления среды This, т.к. по сообщению об ошибке видно, что нет имени контрола
SergKis: PS Дело в том, что при создании новой формы\окна информация о предыдущей форме\окне среды This теряется, что и происходит, т.е. нет гарантии, что она будет соответствовать. При Release окна среда This, которая была не восстанавливается, т.к. окна могут закрываться не в том порядке, как открывались. Выход 1. Сохранять\восстанавливать среду This самому 2. Работать без This с конкретным именем окна (основное правило hmg) 3. Раскладывать последовательность действий на события и выполнять события по сообщениям. Для каждого события будет создана среда This окна или контрола, в зависимости как укажешь в сообщении. Пример у тебя есть
Andrey: SergKis пишет: Попробуй в ON RELEASE формы с GetBox поставить самым последним вызов _PopEventInfo() для восстановления среды This, т.к. по сообщению об ошибке видно, что нет имени контрола Да, это помогло, только если работаешь только в программе ! Если окно Far или Мозилу переключаешь, то вылет с другой ошибкой: Error BASE/1081 Неверный аргумент: + Called from GETPROPERTY(4410) in module: h_controlmisc.prg Called from (b)BUTTON_UPMENUTABLE(2273) in module: Tbrw_table.prg Остановился на варианте 2 ![pre2] aObj2But[12,12] := { || SetProperty(cForm, This.Name, "Enabled", .F.) ,; DogListAbon(cForm, "nTable","","","") ,; SetProperty(cForm, "oBut_SpAbon", "Enabled", .T.) ,; Brw4Focus(nTable) } [/pre2] Вылет прекратился... Переделал везде где нашёл. СПАСИБО ОГРОМНОЕ ! Не забыть бы это для других случаев...
SergKis: Andrey пишет Не забыть бы это для других случаев... Первый вариант получше будет[pre2] aObj2But[12,12] := { |cw,cn| cw := ThisWindow.Name, cn := This.Name, ; SetProperty(cw, cn, "Enabled", .F.) , ; DogListAbon(cw, "nTable","","","") , ; SetProperty(cw, cn, "Enabled", .T.) , ; Brw4Focus(nTable) } [/pre2]
SergKis: Andrey пишет Остановился на варианте 2 ! Если использовать функцию[pre2] *-----------------------------------------------------------------------------* FUNCTION _ThisInfo( aThis ) *-----------------------------------------------------------------------------* IF HB_ISARRAY( aThis ) _HMG_ThisFormIndex := aThis [1] _HMG_ThisEventType := aThis [2] _HMG_ThisType := aThis [3] _HMG_ThisIndex := aThis [4] _HMG_ThisFormName := aThis [5] _HMG_ThisControlName := aThis [6] RETURN NIL ENDIF RETURN { _HMG_ThisFormIndex, _HMG_ThisEventType, _HMG_ThisType, _HMG_ThisIndex, _HMG_ThisFormName, _HMG_ThisControlName } то твой блок будет выглядеть так aObj2But[12,12] := { |at| at := _ThisInfo(), ; This.Name.Enabled := .F., ; DogListAbon(cw, "nTable","","",""), ; _ThisInfo(at), ; This.Name.Enabled := .T., ; Brw4Focus(nTable) } [/pre2]
SergKis: PS Упс. Магнитная буря. [pre2] aObj2But[12,12] := { |at| at := _ThisInfo(), ; This.Enabled := .F., ; DogListAbon(cw, "nTable","","",""), ; _ThisInfo(at), ; This.Enabled := .T., ; Brw4Focus(nTable) } [/pre2]
Andrey: SergKis пишет: Первый вариант получше будет aObj2But[12,12] := { |cw,cn| cw := ThisWindow.Name, cn := This.Name, ; SetProperty(cw, cn, "Enabled", .F.) , ; DogListAbon(cw, "nTable","","","") , ; SetProperty(cw, cn, "Enabled", .T.) , ; Brw4Focus(nTable) } Да, это написание более понятней ! Все названия сохранены через переменные и при обнулении This уже путаницы не будет. Спасибо !
SergKis: Andrey пишет Да, это написание более понятней ! Если исходить из правила hmg в блоке кода контрола ACTION, ON CHANGE и т.д., должна быть установлена и сохраняться среда переменных _THIS_..., то вариант с функцией более правильный, т.е.[pre2] aObj2But[12,12] := { |at| at := _ThisInfo(), This.Enabled := .F., ; DogListAbon(ThisWindow.Name, "nTable","","",""), ; _ThisInfo(at), This.Enabled := .T., ; Brw4Focus(nTable) } [/pre2]
SergKis: PS И лучше использовать ф-ю внутри своей DogListAbon(...) LOCAL aThis := _ThisInfo() ... ACTIVATE WINDOW ... _ThisInfo(aThis) RETURN
gfilatov2002: Подготовил 2-ю бетку для новой сборки 19.06 со следующим списком изменений: [pre2] * Fixed: Problem with a handling <Esc> key into the function HMG_Alert() (introduced in the build 18.02). Processing of a closing of a window in the Alert* family functions is similar to the system dialogs in Windows 7. Bug was reported by Grzegorz Wojnarowski. Contributed by Grigory Filatov <gfilatov@inbox.ru> (see demo in folder \samples\Basic\AlertBoxes) * Fixed: Problem with using of the function AScan() without <lExact> switch into the function HMG_GetFormControls() (introduced in the build 19.04). Bug was reported by Grzegorz Wojnarowski. Contributed by Grigory Filatov <gfilatov@inbox.ru> (see demo in folder \samples\Basic\MAINDEMO_(SYNTAX_I)) * Fixed: The wrong using of the Registry class was fixed in the function DeleteRegistryKey( nKey, cRegKey ). Added the new command DELETE [REGISTRY] SECTION <cKey> FROM [KEY] <hKey> instead of the mistaked command DELETE KEY <cKey> OF <oReg>. Sample code: CREATE REGISTRY oReg KEY HKEY_CURRENT_USER SECTION "_TEST" IF IsRegistryKey( HKEY_CURRENT_USER, "_TEST" ) SET VALUE "test" OF oReg TO "myval" CLOSE REGISTRY oReg MsgInfo( GetRegistryValue( HKEY_CURRENT_USER, "_TEST", "test" ) ) DELETE REGISTRY SECTION "_TEST" FROM KEY HKEY_CURRENT_USER ENDIF Contributed by Grigory Filatov <gfilatov@inbox.ru> * Modified: Correction of SetKey events processing in the GetBox control. You can modify an action of the predefined keys in GetBox now. Sample code: @ 10, 10 GETBOX GetBox1 OBJ oGet VALUE Space( 30 ) oGet:SetKeyEvent( VK_RETURN, {|| MsgInfo("Enter pressed") } ) oGet:SetKeyEvent( VK_DOWN, {|| MsgInfo("Down pressed") } ) Requested by Dusko Radojcin. Contributed by Grigory Filatov <gfilatov@inbox.ru> (see demo in folder \samples\Basic\GetBox_3) * Updated: Harbour contrib HbFImage library: - update for using FreeImage DLL version 3.18.0 (from 3.15.0). (see source in folder \Source\hbfimage) Contributed by Grigory Filatov <gfilatov@inbox.ru> (see demo in folder \samples\Advanced\FREEVIEW) * Updated: RDDLeto client library by Rolf 'elch' Beckmann. Contributed by Grigory Filatov <gfilatov@inbox.ru> (see demo in folder \samples\Advanced\LetoDBf) * Updated: HbSQLite3 library: - update for using SQLITE3 latest version 3.29.0dev. Contributed by Grigory Filatov <gfilatov@inbox.ru> * New: Added the auxiliary add-on binary archive for a correct launching of the MiniGUI advanced samples. This archive contains the following tools: - CUrl dlls; - FreeImage dll; - MySQL dll; - PageScript dll; - SumatraPDF application; - QHTM installer; - RMChart installer; - VLC ActiveX Control. Contributed by Grigory Filatov <gfilatov@inbox.ru> * New: 'GetFont dialog with the monospace fonts' sample. Based upon a contribution of HMG user KDJ. Adapted for Minigui Extended by Grigory Filatov <gfilatov@inbox.ru> (see demo2.prg in folder \samples\Basic\GetFont) * Updated: 'Alert Boxes usage' sample. Contributed by Grigory Filatov <gfilatov@inbox.ru> (see in folder \samples\Basic\AlertBoxes) * Updated: 'Contactos' sample. Contributed by Pierpaolo Martinello <pier.martinello[at]alice.it> (see in folder \samples\Basic\CONTACTOS) * Updated: MPM utility: - fixed using of the function DeleteRegistryKey(). Contributed by Grigory Filatov <gfilatov@inbox.ru> (see in folder \Utils\MPM) [/pre2] Постараюсь не затягивать с выпуском финальной сборки Также после нескольких попыток удалось собрать Харбор для свежей версии MinGW 9.1 Harbour 3.2.0dev (r1904111533) Copyright (c) 1999-2019, https://harbour.github.io/ Harbour Build Info --------------------------- Version: Harbour 3.2.0dev (r1904111533) Compiler: MinGW GNU C 9.1.1 (32-bit) Platform: Windows 10 10.0 PCode version: 0.3 ChangeLog last entry: 2019-04-11 17:33 UTC+0200 Przemyslaw Czerpak (druzus/at/poczta.onet.pl) ChangeLog ID: ba87964f6754d037f86be597c07a08e02f4cb9e0 Built on: Jun 3 2019 14:19:21 Extra Harbour compiler options: -gc0 Extra C compiler options: -DHB_GC_AUTO -DHB_GUI -DHB_NO_TRACE Build options: (Clipper 5.3b) (Clipper 5.x undoc) --------------------------- и успешно протестировать работу библиотеки с этой версией Си-компилятора
gfilatov2002: Завершена подготовка новой сборки 19.06, которая будет опубликована на следующей неделе. Я отказался от поддержки бесплатного компилятора BCC 10.1 и старой сборки для xHarbour.com вследствие нулевого интереса со стороны пользователей библиотеки. Собрал новую сборку только для слкдующих компиляторов: - BCC 5.5 (Базовый дистрибутив); - MinGW 9.1 (32- и 64-бит). Сборки для других Си-компиляторов будут выполняться только под заказ (на платной основе)
gfilatov2002: Опубликована новая сборка 19.06 для BCC 5.5.1 и компиляторов Harbour и xHarbour. Базовый дистрибутив находится по адресу http://hmgextended.com/files/CONTRIB/hmg-19.06-setup.exe Также имеются дополнительные сборки для следующих Си-компиляторов: - MinGW 9.1.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.4 (32-bit) для Harbour 3.2.0dev; (под заказ) - Open Watcom C/C++ 2.0 (32-bit) для Harbour 3.2.0dev. (под заказ) Благодарю за Ваше внимание
Andrey: Григорий, спасибо большое за новую версию ! А что примеры - назначений событий на объекты формы не добавил ? Это же самые понятные примеры для новичков. Мне Сергей давно советовал делать так - через события, а я всё не понимал как это работает. В Виндах всё же через события происходят, а большинство делает по старинке, через функции. А в этих примерах всё просто демонстрируется... Да и ещё один классный пример я высылал - универсальное затенение формы со всеми объектами, включая картинки. FormDarken(1.2).7z Код маленький и короткий, удобно очень встраивать к себе в программу другим программистам.
gfilatov2002: Обновил сборку 19.06 (Update 1) с учетом последних наработок Базовый дистрибутив находится по адресу http://hmgextended.com/files/CONTRIB/hmg-19.06-setup.exe Что нового: * Modified: Stability fix in the internal function _SetTextEditReadOnly(). You can modify a ReadOnly mode at runtime for the enabled controls only. Problem was reported by Rafael Moran <webrmoran/at/yahoo.com>. Contributed by Grigory Filatov <gfilatov@inbox.ru> * Enhanced: Added 'ON DBLCLICK' clause (optional) to LABEL and IMAGE controls. NOTE: Don't register click and dblclick events on the same element: it's impossible to distinguish single-click events from click events that lead to a dblclick event. Contributed by Grigory Filatov <gfilatov@inbox.ru> * New: Added the useful function HMG_IsEqualArr ( aData1, aData2 ) for comparing of the two arrays. Sample code: aValue1 := Form.Grid1.Value aValue2 := Form.Grid2.Value lResult := HMG_IsEqualArr ( aValue1, aValue2 ) Requested by Paola Bruccoleri <pbruccoleri/at/adinet.com.uy>. Based upon a contribution of Roberto Lopez <mail.box.hmg@gmail.com> * New: Added the Harbour contrib library for 7zip compression. This is a wrapper of 7-zip32.dll, another variant of the Open-Source 7Zip compression library. All calls are pointing to 7-zip32.dll, thus the such dll must exist in a search path. Based on an original work of Andi Jahja <andi.jahja/at/yahoo.co.id>. (see source in folder \Source\SevenZip) Contributed by Grigory Filatov <gfilatov@inbox.ru> (see demos in folder \samples\Advanced\sevenzip) * New: 'Button Gradient Test' sample. Based upon a contribution of MiniGUI user. Revised by Grigory Filatov <gfilatov@inbox.ru> (see in folder \samples\Basic\Button_Gradient) * New: 'Weather-forecast' sample is based on the service site http://wttr.in. Based upon a contribution of Vagelis Prodromidis. Revised by Grigory Filatov <gfilatov@inbox.ru> (see in folder \samples\Advanced\Weather-forecast)
Alex_Cher: gfilatov2002 пишет: Обновил сборку 19.06 (Update 1) с учетом последних наработок Уважаемый Григорий (повторная просьба) можно обновить хотя бы один из примеров (типа \MiniGUI\SAMPLES\Applications\MultipleMail) чтобы была возможность отправлять e-mail на mail.ru, yandex.ru и т.п. с учетом SSL. Сейчас ни один из примеров не работают ... Заранее благодарен ...
gfilatov2002: Alex_Cher пишет: отправлять e-mail на mail.ru, yandex.ru и т.п. с учетом SSL Эта тема уже обсуждалась на форуме здесь и здесь Могу только добавить, что все требуемые библиотеки для поддержки SSL есть в поставке МиниГУИ: hbtip hbssl libeay32 ssleay32.
SergKis: gfilatov2002 Может добавить функцию (по аналогии с HMG_GetFormControls()) ? K примеру[pre2] FUNCTION HMG_GetForms( cTyp, lObj ) LOCAL i, o, lTyp, lHand, aNames:={} cTyp := iif( HB_ISCHAR( cTyp ), Upper(cTyp), '' ) lHand := iif( HB_ISLOGICAL( lObj ), ! lObj, .F. ) lObj := _HMG_lOOPEnabled .and. ! empty(lObj) FOR i := 1 TO Len( _HMG_aFormNames ) IF _HMG_aFormDeleted [ i ]; LOOP ENDIF IF ( lTyp := iif( Empty(cTyp), .T., _HMG_aFormType [ i ] $ cTyp ) ) If lHand AAdd(aNames, _HMG_aFormHandles [ i ] ) #ifdef _OBJECT_ ElseIf lObj o := do_obj( _HMG_aFormHandles [ i ] ) If HB_ISOBJECT( o ) AAdd(aNames, o) EndIf #endif Else AAdd(aNames, _HMG_aFormNames [ i ] ) EndIf ENDIF NEXT RETURN aNames [/pre2]
gfilatov2002: SergKis пишет: Может добавить функцию Принято с благодарностью
gfilatov2002: Адаптировал свежую версию библиотеки для работы с Microsoft Visual C++ 2019 (32- и 64-бит). По шагам: 1) скачал полный дистрибутив MSVC 2019 (примерно 22 ГБ) и установил его. 2) сделал консольную версию MSVC 2019 из вышеуказанного дистрибутива (около 454 МБ). 3) собрал компилятор Харбор из сырцов с помощью консольной версии MSVC 2019. 4) собрал и успешно протестировал библиотеку Минигуи с этим компилятором Ваши комментарии приветствуются
Andrey: gfilatov2002 пишет: Адаптировал свежую версию библиотеки для работы с Microsoft Visual C++ 2019 (32- и 64-бит) Отличная новость ! Теперь надо будет нужные проги переводить на MSVC. Надеюсь будет работать лучше, чем на BCC.
Dima: Andrey пишет: Надеюсь будет работать лучше, чем на BCC. скорее всего разницы и не заметишь
gfilatov2002: Dima пишет: разницы и не заметишь Если сравнивать по скорости выполнения простых операций, то разница есть (см. ниже) 2019-07-02 14:17:48 Windows 10 10.0 Harbour 3.2.0dev (r1904111533) Borland C++ 5.5.1 (32-bit) x86 THREADS: 0 N_LOOPS: 1000000 [ T000: empty loop overhead ]...................................0.02 ==================================================================== [ T001: x := L_C ]..............................................0.03 [ T002: x := L_N ]..............................................0.03 [ T003: x := L_D ]..............................................0.03 [ T004: x := S_C ]..............................................0.03 [ T005: x := S_N ]..............................................0.05 [ T006: x := S_D ]..............................................0.03 [ T007: x := M->M_C ]...........................................0.05 [ T008: x := M->M_N ]...........................................0.03 [ T009: x := M->M_D ]...........................................0.03 [ T010: x := M->P_C ]...........................................0.05 [ T011: x := M->P_N ]...........................................0.03 [ T012: x := M->P_D ]...........................................0.03 [ T013: x := F_C ]..............................................0.03 [ T014: x := F_N ]..............................................0.02 [ T015: x := F_D ]..............................................0.03 [ T016: x := o:Args ]...........................................0.09 [ T017: x := o[ 2 ] ]...........................................0.08 [ T018: Round( i / 1000, 2 ) ]..................................0.11 [ T019: Str( i / 1000 ) ].......................................0.31 [ T020: Val( s ) ]..............................................0.11 [ T021: Val( a [ i % 16 + 1 ] ) ]...............................0.22 [ T022: DToS( d - i % 10000 ) ].................................0.25 [ T023: Eval( {|| i % 16 } ) ]..................................0.19 [ T024: Eval( bc := {|| i % 16 } ) ]............................0.13 [ T025: Eval( {| x | x % 16 }, i ) ]............................0.17 [ T026: Eval( bc := {| x | x % 16 }, i ) ]......................0.13 [ T027: Eval( {| x | f1( x ) }, i ) ]...........................0.22 [ T028: Eval( bc := {| x | f1( x ) }, i ) ].....................0.19 [ T029: Eval( bc := &( "{| x | f1( x ) }" ), i ) ]..............0.19 [ T030: x := &( "f1(" + Str( i ) + ")" ) ]......................1.30 [ T031: bc := &( "{| x | f1( x ) }" ), Eval( bc, i ) ]..........1.59 [ T032: x := ValType( x ) + ValType( i ) ]......................0.20 [ T033: x := StrZero( i % 100, 2 ) $ a[ i % 16 + 1 ] ]..........0.38 [ T034: x := a[ i % 16 + 1 ] == s ].............................0.17 [ T035: x := a[ i % 16 + 1 ] = s ]..............................0.19 [ T036: x := a[ i % 16 + 1 ] >= s ].............................0.17 [ T037: x := a[ i % 16 + 1 ] <= s ].............................0.19 [ T038: x := a[ i % 16 + 1 ] < s ]..............................0.19 [ T039: x := a[ i % 16 + 1 ] > s ]..............................0.17 [ T040: AScan( a, i % 16 ) ]....................................0.16 [ T041: AScan( a, {| x | x == i % 16 } ) ]......................1.36 [ T042: iif( i % 1000 == 0, a := {}, ), AAdd(a,{i,1,.T.,s, ]....0.44 [ T043: x := a ]................................................0.03 [ T044: x := {} ]...............................................0.06 [ T045: f0() ]..................................................0.03 [ T046: f1( i ) ]...............................................0.08 [ T047: f2( c[1...8] ) ]........................................0.05 [ T048: f2( c[1...40000] ) ]....................................0.05 [ T049: f2( @c[1...40000] ) ]...................................0.05 [ T050: f2( @c[1...40000] ), c2 := c ]..........................0.06 [ T051: f3( a, a2, s, i, s2, bc, i, n, x ) ]....................0.20 [ T052: f2( a ) ]...............................................0.06 [ T053: x := f4() ].............................................0.44 [ T054: x := f5() ].............................................0.11 [ T055: x := Space( 16 ) ]......................................0.08 [ T056: f_prv( c ) ]............................................0.17 ==================================================================== [ total application time: ]....................................11.72 [ total real time: ]...........................................11.75 2019-07-02 14:18:48 Windows 10 10.0 Harbour 3.2.0dev (r1904111533) Microsoft Visual C++ 19.21.27702 (32-bit) x86 THREADS: 0 N_LOOPS: 1000000 [ T000: empty loop overhead ]...................................0.02 ==================================================================== [ T001: x := L_C ]..............................................0.00 [ T002: x := L_N ]..............................................0.02 [ T003: x := L_D ]..............................................0.00 [ T004: x := S_C ]..............................................0.02 [ T005: x := S_N ]..............................................0.00 [ T006: x := S_D ]..............................................0.02 [ T007: x := M->M_C ]...........................................0.00 [ T008: x := M->M_N ]...........................................0.02 [ T009: x := M->M_D ]...........................................0.02 [ T010: x := M->P_C ]...........................................0.00 [ T011: x := M->P_N ]...........................................0.02 [ T012: x := M->P_D ]...........................................0.02 [ T013: x := F_C ]..............................................0.00 [ T014: x := F_N ]..............................................0.00 [ T015: x := F_D ]..............................................0.02 [ T016: x := o:Args ]...........................................0.05 [ T017: x := o[ 2 ] ]...........................................0.02 [ T018: Round( i / 1000, 2 ) ]..................................0.06 [ T019: Str( i / 1000 ) ].......................................0.14 [ T020: Val( s ) ]..............................................0.08 [ T021: Val( a [ i % 16 + 1 ] ) ]...............................0.13 [ T022: DToS( d - i % 10000 ) ].................................0.20 [ T023: Eval( {|| i % 16 } ) ]..................................0.11 [ T024: Eval( bc := {|| i % 16 } ) ]............................0.08 [ T025: Eval( {| x | x % 16 }, i ) ]............................0.09 [ T026: Eval( bc := {| x | x % 16 }, i ) ]......................0.06 [ T027: Eval( {| x | f1( x ) }, i ) ]...........................0.09 [ T028: Eval( bc := {| x | f1( x ) }, i ) ].....................0.08 [ T029: Eval( bc := &( "{| x | f1( x ) }" ), i ) ]..............0.08 [ T030: x := &( "f1(" + Str( i ) + ")" ) ]......................0.69 [ T031: bc := &( "{| x | f1( x ) }" ), Eval( bc, i ) ]..........0.75 [ T032: x := ValType( x ) + ValType( i ) ]......................0.09 [ T033: x := StrZero( i % 100, 2 ) $ a[ i % 16 + 1 ] ]..........0.19 [ T034: x := a[ i % 16 + 1 ] == s ].............................0.08 [ T035: x := a[ i % 16 + 1 ] = s ]..............................0.09 [ T036: x := a[ i % 16 + 1 ] >= s ].............................0.08 [ T037: x := a[ i % 16 + 1 ] <= s ].............................0.09 [ T038: x := a[ i % 16 + 1 ] < s ]..............................0.09 [ T039: x := a[ i % 16 + 1 ] > s ]..............................0.08 [ T040: AScan( a, i % 16 ) ]....................................0.13 [ T041: AScan( a, {| x | x == i % 16 } ) ]......................0.83 [ T042: iif( i % 1000 == 0, a := {}, ), AAdd(a,{i,1,.T.,s, ]....0.27 [ T043: x := a ]................................................0.00 [ T044: x := {} ]...............................................0.03 [ T045: f0() ]..................................................0.02 [ T046: f1( i ) ]...............................................0.03 [ T047: f2( c[1...8] ) ]........................................0.02 [ T048: f2( c[1...40000] ) ]....................................0.03 [ T049: f2( @c[1...40000] ) ]...................................0.02 [ T050: f2( @c[1...40000] ), c2 := c ]..........................0.03 [ T051: f3( a, a2, s, i, s2, bc, i, n, x ) ]....................0.11 [ T052: f2( a ) ]...............................................0.03 [ T053: x := f4() ].............................................0.13 [ T054: x := f5() ].............................................0.06 [ T055: x := Space( 16 ) ]......................................0.05 [ T056: f_prv( c ) ]............................................0.08 ==================================================================== [ total application time: ].....................................6.34 [ total real time: ]............................................6.35
SergKis: gfilatov2002 Добавьте в CLASS TWndData [pre2] ACCESS Title INLINE GetWindowText ( ::nHandle ) ASSIGN Title( cVal ) INLINE SetWindowText ( ::nHandle, cVal ) ACCESS Enabled INLINE IsWindowEnabled( ::nHandle ) ASSIGN Enabled( xVal ) INLINE iif ( Empty( xVal ), DisableWindow ( ::nHandle ), EnableWindow ( ::nHandle ) ) [/pre2] Пример для проверки на базе BASIC\ChildAsModal [pre2] /* */ #define _HMG_OUTLOG #include "hmg.ch" PROCEDURE main LOCAL cActiveFormName := 'Form_2' SET OOP ON DEFINE WINDOW Form_1 ; AT 0, 0 ; WIDTH 640 HEIGHT 480 ; TITLE 'Main Window'; MAIN DEFINE MAIN MENU POPUP 'Child Window' ITEM 'Open Win 2' ACTION {|| DoWindow2() } END POPUP END MENU DEFINE BUTTON B_OK ROW 20 COL 30 WIDTH 100 HEIGHT 28 ACTION Msgbox( 'OK' ) CAPTION "OK" END BUTTON // DEFINE TIMER T_1 INTERVAL 250 ACTION SetProperty( ThisWindow.Name, "Enabled", ( _IsWindowActive( cActiveFormName ) == .F. ) ) END WINDOW CENTER WINDOW Form_1 ACTIVATE WINDOW Form_1 RETURN ***************************************************************************** PROCEDURE DoWindow2() // LOCAL cActiveFormName := 'Form_3' LOCAL cOwnerFormName := ThisWindow.Name, cOwnerFormTitle := ThisWindow.Title LOCAL oWnd := ThisWindow.Object LOCAL cTit := oWnd:Title DEFINE WINDOW Form_2 ; AT App.Row + 30, App.Col + 30 ; WIDTH 600 HEIGHT 400 ; TITLE 'Win 2' ; CHILD ; ON INIT ( oWnd:Title := cTit + " - Disabled", oWnd:Enabled := .F. ) ; ON RELEASE ( oWnd:Enabled := .T., oWnd:Title := cTit, oWnd:SetFocus() ) /* ON INIT ( SetProperty( cOwnerFormName, "Title", cOwnerFormTitle + " - Disabled" ) ) ; ON RELEASE ( SetProperty( cOwnerFormName, "Title", cOwnerFormTitle ) ) ; */ @ 20, 40 BUTTON Button_2 caption 'Child Win 3' WIDTH 100 HEIGHT 28 ACTION {|| DoWindow3() } // DEFINE TIMER T_1 INTERVAL 250 ACTION SetProperty( ThisWindow.Name, "Enabled", ( _IsWindowActive( cActiveFormName ) == .F. ) ) END WINDOW ACTIVATE WINDOW Form_2 RETURN ***************************************************************************** PROCEDURE DoWindow3() // LOCAL cOwnerFormName := ThisWindow.Name, cOwnerFormTitle := ThisWindow.Title LOCAL oWnd := ThisWindow.Object LOCAL cTit := oWnd:Title DEFINE WINDOW Form_3 ; AT App.Row + 60, App.Col + 60 ; WIDTH 600 HEIGHT 400 ; TITLE 'Win 3' ; CHILD ; ON INIT ( oWnd:Title := cTit + " - Disabled", oWnd:Enabled := .F. ) ; ON RELEASE ( oWnd:Enabled := .T., oWnd:Title := cTit, oWnd:SetFocus() ) /* ON INIT ( SetProperty( cOwnerFormName, "Title", cOwnerFormTitle + " - Disabled" ) ) ; ON RELEASE ( SetProperty( cOwnerFormName, "Enabled", .T. ), SetProperty( cOwnerFormName, "Title", cOwnerFormTitle ), ; DoMethod( cOwnerFormName, "setFocus" ) ) */ @ 50, 100 BUTTON Button_2 caption 'OK' WIDTH 100 HEIGHT 28 ACTION {|| MsgBox( 'OK' ) } END WINDOW ACTIVATE WINDOW Form_3 RETURN [/pre2]
gfilatov2002: SergKis пишет: Добавьте в CLASS TWndData Спасибо, добавил
gfilatov2002: Обновил сборку 19.06 (Update 2) с учетом последних наработок Базовый дистрибутив находится по адресу http://hmgextended.com/files/CONTRIB/hmg-19.06-setup.exe Что нового: [pre2] * New: Added the useful function HMG_GetForms( [ cFormTypes ] [, lObj ] ) for retrieving of an array of the form's names (or handles). Contributed by Sergej Kiselev (see demo in folder \samples\Basic\MAINDEMO_(SYNTAX_I)) * Modified: The local OS detecting functions were replaced with a native [x]Harbour implementation (instead of using the MiniGUI function WindowsVersion()). NOTE: The C-functions IsWinXPorLater() and IsVistaOrLater() are defined as pseudo-functions now. It was a postponed modification. Contributed by Grigory Filatov <gfilatov@inbox.ru> (see i_pseudofunc.ch in folder Include\) * Modified: The function IsExe64() is replaced with a native Harbour implementation. The compatibility with xHarbour compiler is provided also. Contributed by Grigory Filatov <gfilatov@inbox.ru> (see i_pseudofunc.ch in folder Include\) * Updated: Header file i_hmgcompat.ch for compatibility with Official HMG: - added pseudo-function IsMaximized( hWnd ). Contributed by Grigory Filatov <gfilatov@inbox.ru> (see demo in folder \samples\Advanced\ImageFromWeb) * Updated: Pacified the warnings in the C-code for compatibility with MS Visual C++ 2019 (32-bit) compiler. Contributed by Grigory Filatov <gfilatov@inbox.ru> * Updated: OpenSSL wrapper for using of the version 1.0.2s. Contributed by Grigory Filatov <gfilatov@inbox.ru> (look at ReadMe.txt in folder \harbour) * Updated: 'MiniGUI DataBase Utility' sample. Contributed by Grigory Filatov <gfilatov@inbox.ru> (see in folder \Utils\mgDBU) [/pre2]
SergKis: gfilatov2002 Думается функция _hmg_OnHideFocusManagement ( i ) для окна STANDART работает не точно. Подправленный пример (был выше) тут https://TransFiles.ru/b0lgp Нажатие кнопок на окнах CHILD и MODAL работает нормально, а на окне STANDART на передний план выводится окно MAIN и потом окно AlertInf(...). Если, в ф-ии _DO_BTN_( oBtn ), убрать строку (выделено цветом)[pre2] STATIC FUNC _DO_BTN_( oBtn ) LOCAL cBtn := oBtn:Name //This.Name LOCAL cCapt := This.Caption LOCAL cWnd := ThisWindow.Name LOCAL cTitl := ThisWindow.Title LOCAL cType := ThisWindow.Type LOCAL lStbP := 'Export' $ cBtn LOCAL cText := iif( lStbP, CRLF+CRLF+'Start ProgressBar', '' ) LOCAL aThis := _ThisInfo() _OUT_(.T., cWnd, cType) AlertInfo(cBtn + CRLF + cCapt + CRLF + cTitl + CRLF + cType + cText, cWnd) _OUT_(.F.) _ThisInfo(aThis) This.Chk_Lock.Value := .F. // oBtn:SetFocus() If lStbP; StbProgressBar() EndIf This.Chk_Lock.Value := .T. RETURN Nil [/pre2] окно MAIN так и останется на переднем плане в фокусе.
gfilatov2002: SergKis пишет: на окне STANDART на передний план выводится окно MAIN Да, это верно Но это плата за то, что у этого окна нет родительского окна-хозяина (в отличие от CHILD). SergKis пишет: Если, в ф-ии _DO_BTN_( oBtn ), убрать строку Поэтому и требуется предложенный Вами костыль. Как это победить по-другому, я не нашел...
SergKis: gfilatov2002 пишет Как это победить по-другому, я не нашел... Получается при первом STANDART надо убирать MAIN в hide (костыль в придачу), тогда, вроде, похоже на правду [pre2] STATIC FUNC Main_Btn_Run( oBtn, nEvent ) ... LOCAL nY, nX, nW, nH, nN, aYX LOCAL nTypW := 0 LOCAL cTypW := '' ... DEF WINDOW &cForm AT 0,0 WIDTH 1100 HEIGHT 650 ; ... ON RELEASE Nil cTypW := This.Type nTypW := Len( HMG_GetForms('S') ) If cTypW == 'S' .and. nTypW == 1 do_obj( _HMG_MainHandle, {|ow| ow:Hide() } ) EndIf DEFINE STATUSBAR ... CENTER WINDOW &cForm ACTIVATE WINDOW &cForm If cTypW == 'S' .and. nTypW == 1 do_obj( _HMG_MainHandle, {|ow| ow:Show() } ) EndIf If Len(HMG_GetForms()) == 1; oChk:Value := .T. EndIf RETURN Nil [/pre2]
Andrey: Заметил такую неприятность. В функциях пользуюсь определением имени формы [pre2] ? ThisWindow.Name, _HMG_ThisFormName, cStaticGlobalForm возвращает: Form_Main Form_Main Form_AYC [/pre2] cStaticGlobalForm - делаю определение сразу под созданием окна. Т.е. должно всегда возвращаться Form_AYC !!! Значит - ThisWindow.Name, _HMG_ThisFormName нельзя использовать ? Правда у меня на форме Form_Main включён таймер на каждую секунду (для тестирования). Может он влияет на псевдо-функции ThisWindow.Name, _HMG_ThisFormName ?
SergKis: Andrey пишет Значит - ThisWindow.Name, _HMG_ThisFormName нельзя использовать ? Перечитай http://clipper.borda.ru/?1-1-0-00000521-000-280-0-1563229132 Лучшее решение, по мне, функция aThis := _ThisInfo(), работаешь как с Alias(), сохраняешь\восстанавливаешь
SergKis: PS т.е. в TIMER блоке на Form_Main ставишь aThis := _ThisInfo() // в начале ... _ThisInfo(aThis) // в конце
SergKis: PPS Наврал, на TIMER не получится, там ставится среда This для Form_Main, sory
Andrey: Понял, что с TIMER нужно аккуратно работать. Всё таки решение через STATIC переменную типа cStaticThisForm более простое. SergKis пишет: Лучшее решение, по мне, функция aThis := _ThisInfo(), работаешь как с Alias(), сохраняешь\восстанавливаешь Буду иметь ввиду. Уже кое где применил.
SergKis: Andrey пишет Всё таки решение через STATIC переменную типа cStaticThisForm более простое. Теряется универсальность. Надо каждое окно делать в отдельном prg файле, иначе для каждого окна свою переменную, что фактически означает работу по имени окна, т.е. Form_Main.Btn1.Value и т.д.
PSP: SergKis пишет: Теряется универсальность. Надо каждое окно делать в отдельном prg файле, иначе для каждого окна свою переменную, что фактически означает работу по имени окна, т.е. Form_Main.Btn1.Value и т.д. hash-массив не поможет в этом случае?
Andrey: PSP пишет: hash-массив не поможет в этом случае? Да зачем усложнять то код написания. Нужно проще писать код, чтобы когда нужно править так лет через 10, понимать что и как написано. А то открываешь свой код написанный 12 лет назад и думаешь, кто так фигово написал то.... и почему до сих пор работает ?
SergKis: PSP пишет Как это может помочь при плавающем cForm [pre2] WHILE _IsWindowDefined( cForm := cFrm+'_'+hb_ntos(++nFrm) ) ENDDO [/pre2]
SergKis: Упс, промахнулся по клавише. PSP пишет hash-массив не поможет в этом случае?
SergKis: Andrey пишет Правда у меня на форме Form_Main включён таймер на каждую секунду (для тестирования). Может он влияет на псевдо-функции ThisWindow.Name, _HMG_ThisFormName ? Предлагаю такую схему для TIMER на Form_Main[pre2] Выполнение основного тела блока кода перенести на событие приложения, т.е. FUNCTION Main(...) ... SetsEnv() WITH OBJECT oDlu2Pixel() :Event( 1, {|| AEval(_ThisInfo(), {|xv,nv| _LogFile(.T., nv, cValToChar(xv)) }), ; SetProperty('Form_Main', 'Timer_1', 'Enabled', .T.) }) END WITH ... DEFINE WINDOW Form_Main AT nY, nX WIDTH nW HEIGHT nH ; ... DEFINE TIMER Timer_1 INTERVAL 2000 ACTION ( This.Enabled := .F., oDlu2Pixel():Post(1) ) END WINDOW ... [/pre2] Работа блока кода Timer_1 будет оч. короткой, среда This восстановлена после него, какая была. В установленном событии oDlu2Pixel():Event(1) This среда не важна, должна быть.
SergKis: PS Точнее так[pre2] WITH OBJECT oDlu2Pixel() :Event( 1, {|| SetProperty('Form_Main', 'Timer_1', 'Enabled', .F.) ; AEval(_ThisInfo(), {|xv,nv| _LogFile(.T., nv, cValToChar(xv)) }), ; SetProperty('Form_Main', 'Timer_1', 'Enabled', .T.) }) END WITH ... DEFINE WINDOW Form_Main AT nY, nX WIDTH nW HEIGHT nH ; ... DEFINE TIMER Timer_1 INTERVAL 2000 ACTION oDlu2Pixel():Post(1) ) [/pre2]
SergKis: gfilatov2002 [pre2] #xcommand DEFINE TBROWSE <name> OBJ <obrw> ; ... [ ON INIT <bInit> ] ; ... =>; <obrw> :=_DefineTBrowse (<"name"> , ; ... [ <.lAutoCol.> ], [ \{<aColSel>\} ], ; <bInit> );; // так лучше, по мне, чем <{bInit}> with object <obrw> ... [/pre2] Это видно на примере https://TransFiles.ru/uw4af В моем варианте (исправленном ch) работают блоки кода [pre2] *-----------------------------------------------------------------------------* STAT FUNC Brw_Age( nY, nX, nW, nH ) *-----------------------------------------------------------------------------* LOCAL cBrw := This.E0.Cargo LOCAL aFont := { GetFontHandle('FontBold'), GetFontHandle('FontBold') } LOCAL aClr := {} LOCAL aDatos := AgeSelect(.T.) // Init value LOCAL oBrw LOCAL bInit := {|ob| Brw_Init(ob) } , ; bEnd := {|ob| Brw_End (ob) } ... [/pre2]
SergKis: gfilatov2002 Так все решается[pre2] #xcommand DEFINE TBROWSE <name> ; ... #xcommand DEFINE TBROWSE <name> OBJ <obrw> ; ... [ <.lAutoCol.> ], [ \{<aColSel>\} ], ; iif( Valtype( <bInit> ) == 'B', <bInit>, <{bInit}> ) );; with object <obrw> ... и #command END TBROWSE ; [ ON END <bInit> ] ; =>; _EndTBrowse ( iif( Valtype( <bInit> ) == 'B', <bInit>, <{bInit}> ) );; end with [/pre2]
gfilatov2002: SergKis пишет: В моем варианте (исправленном ch) работают блоки кода Это решается и без изменений в заголовке tsbrowse.ch Попробуйте передавать эти блоки кода таким образом DEFINE TBROWSE &cBrw OBJ oBrw AT nY, nX WIDTH nW HEIGHT nH CELL ; COLORS aColor ON INIT Eval( bInit ) ... END TBROWSE ON END Eval( bEnd )
SergKis: gfilatov2002 пишет Попробуйте передавать эти блоки кода таким образом Вопрос стоит передаваемых параметров в блок кода. В таком виде Eval(bInit), Eval(bEnd) параметры ( ob переменная ) не передаются {|ob| Brw_...(ob) }
SergKis: PS Можно и без параметров отработать, для блоков кода создается среда This тек. TsBrowse[pre2] *-----------------------------------------------------------------------------* STAT FUNC Brw_Age( nY, nX, nW, nH ) *-----------------------------------------------------------------------------* ... LOCAL bInit := {|| Brw_Age_Init() } LOCAL bEnd := {|| Brw_Age_End () } *-----------------------------------------------------------------------------* STATIC FUNC Brw_Age_Init() *-----------------------------------------------------------------------------* WITH OBJECT (This.Object):Tsb ... *-----------------------------------------------------------------------------* STATIC FUNC Brw_Age_End() *-----------------------------------------------------------------------------* WITH OBJECT (This.Object):Tsb ... и DEFINE TBROWSE &cBrw OBJ oBrw AT nY, nX WIDTH nW HEIGHT nH CELL ; COLORS aColor ON INIT Eval( bInit ) ... END TBROWSE ON END Eval( bEnd ) [/pre2]
gfilatov2002: SergKis пишет: Можно и без параметров отработать Да, так работает
SergKis: gfilatov2002 пишет Да, так работает Вариант поинтересней, более "правильный"[pre2] ... DEFINE WINDOW &cWnd AT 0,0 WIDTH 980 HEIGHT 650 ; ... WITH OBJECT This.Object :StatusBar:Say(MiniGUIVersion(), 3) :Event( 1, {|ow,ky,ap| AgeReport(ow, ky, ap) } ) :Event( 91, {|oc | Brw_Age_Init(oc:Tsb) } ) :Event( 92, {|oc | Brw_Age_End (oc:Tsb) } ) :Event( 99, {|ow | ow:Release() } ) END WITH ... *-----------------------------------------------------------------------------* STATIC FUNC Brw_Age_Init( oBrw ) *-----------------------------------------------------------------------------* DEFAULT oBrw := (This.Object):Tsb WITH OBJECT oBrw ... *-----------------------------------------------------------------------------* STATIC FUNC Brw_Age_End( oBrw ) *-----------------------------------------------------------------------------* DEFAULT oBrw := (This.Object):Tsb WITH OBJECT oBrw ... DEFINE TBROWSE &cBrw OBJ oBrw AT nY, nX WIDTH nW HEIGHT nH CELL ; COLORS aColor ON INIT _wPost( 91, This.Index ) DO EVENTS ... END TBROWSE ON END _wPost( 92, This.Index ) DO EVENTS [/pre2] bInit и bEnd можно убрать везде
SergKis: PS Расширить настройку TsBrowse можно так[pre2] WITH OBJECT This.Object :StatusBar:Say(MiniGUIVersion(), 3) :Event( 1, {|ow,ky,ap| AgeReport(ow, ky, ap) } ) :Event( 91, {|oc | Brw_Age_Init(oc:Tsb) } ) :Event( 92, {|oc | Brw_Age_End (oc:Tsb) } ) :Event( 93, {|oc | Brw_Age_Body(oc:Tsb) } ) :Event( 99, {|ow | ow:Release() } ) END WITH ... *-----------------------------------------------------------------------------* STATIC FUNC Brw_Age_Body( oBrw ) *-----------------------------------------------------------------------------* WITH OBJECT oBrw // эти строки перенесены из функции Brw_Age_Init(...) для примера :nHeightCell += 5 :nHeightHead := :nHeightCell + 2 :nHeightFoot := :nHeightCell + 2 END WITH RETURN Nil ... DEFINE TBROWSE &cBrw OBJ oBrw AT nY, nX WIDTH nW HEIGHT nH CELL ; COLORS aColor ON INIT _wPost( 91, This.Index ) DO EVENTS :SetArrayTo(aArray, aFont, aHead, aSize, aFoot, aPict, aAlign, aName) AEval(:aColumns, {|oc| oc:lEmptyValToChar := .T., oc:lFixLite := .T. }) _wSend( 93, GetControlIndex( :cControlName, :cParentWnd ) ) If lAdj :AdjColumns() EndIf :ResetVScroll( .T. ) :oHScroll:SetRange(0,0) END TBROWSE ON END _wPost( 92, This.Index ) DO EVENTS [/pre2]
SergKis: gfilatov2002 Не работает This.ToolBar_1.Caption Правка[pre2] *-----------------------------------------------------------------------------* FUNCTION _GetCaption ( ControlName , ParentForm ) *-----------------------------------------------------------------------------* LOCAL cRetVal As String LOCAL i IF ( i := GetControlIndex ( ControlName , ParentForm ) ) > 0 IF _HMG_aControlType [ i ] == 'TOOLBAR' .OR. _HMG_aControlType [ i ] == 'TOOLBUTTON' .OR. ; _HMG_aControlType [ i ] == 'MENU' .OR. _HMG_aControlType [ i ] == 'RADIOGROUP' ... RETURN cRetVal [/pre2] Пример https://TransFiles.ru/8cp1d
SergKis: gfilatov2002 Может сделать в Tsb, чтобы не задумываться где какой элемент в :aSuperHead, так[pre2] METHOD cTextSupHdGet( nCol, aSuperHead, cText ) CLASS TSBrowse LOCAL xDef := '', xVal Default nCol := 1, aSuperHead := ::aSuperHead If nCol > 0 .and. nCol <= Len( aSuperHead ) xVal := ::GetValProp( aSuperHead[ nCol, 3 ], xDef, nCol ) If HB_ISCHAR(cText) ::aSuperHead[ nCol, 3 ] := cText EndIf EndIf If xVal == Nil; xVal := xDef EndIf RETURN xVal [/pre2] Используем вместо :aSuperHead[1][3] := This.ToolBar_1.Caption + ' ' + cCapt так :cTextSupHdGet( 1, , This.ToolBar_1.Caption + ' ' + cCapt ) Аналогично можно сделать в методах METHOD hFontSupHdGet( nCol, aSuperHead, uFont ) CLASS TSBrowse METHOD nForeSupHdGet( nCol, aSuperHead, nClrText ) CLASS TSBrowse METHOD nBackSupHdGet( nCol, aSuperHead, nClrPane ) CLASS TSBrowse METHOD nAlignSupHdGet( nCol, lHAlign, aSuperHead, nHAlign ) CLASS TSBrowse или аналогичные методы с названием Set вместо Get
gfilatov2002: SergKis пишет: Не работает This.ToolBar_1.Caption Правка Принято с благодарностью SergKis пишет: аналогичные методы с названием Set вместо Get Выбрал этот вариант Благодарю за подсказку
SergKis: gfilatov2002 Добавил в пример (выше) сохранение позиции курсора при повторном нажатии на одну и ту же кнопку (с перемещением курсора на др. страницы тсб). :GotoRec(...) не работает с массивом, может кому интересно будет Тут [pre2] *-----------------------------------------------------------------------------* STATIC FUNC AgeReport( oWnd, nEvent, aSelect ) *-----------------------------------------------------------------------------* LOCAL aDatos, aArray, aSize LOCAL cCapt := 'All' LOCAL cBrw := This.E0.Cargo // TsBrowse name LOCAL nRec, nPos, nCol, cBtnC nEvent := Val( This.Name ) // Button name oWnd:Action := .F. oWnd:StatusBar:Say('W A I T') If aSelect[1] != Nil cCapt := hb_ntos(aSelect[1])+'-'+hb_ntos(aSelect[2]) EndIf cBtnC := This.E0.Caption This.E0.Caption := cCapt ; DO EVENTS aDatos := AgeSelect( aSelect[1], aSelect[2] ) aArray := aDatos[1] aSize := aDatos[3] WITH OBJECT (This.&(cBrw).Object):Tsb // oWnd:GetObj(cBrw):Tsb :Hide() nRec := :nAt nPos := :nRowPos nCol := :nCell AEval(:aColumns, {|oc,nc| oc:nWidth := aSize[ nc ] }) :HideColumns( 'STREET', ! 'All' $ cCapt ) // :cTextSupHdSet( 1, This.ToolBar_1.Caption + ' ' + cCapt ) :aSuperHead[1][3] := This.ToolBar_1.Caption + ' ' + cCapt :Display() :AdjColumns() DO EVENTS :SetArray(aArray, .T.) :Reset() :GetColumn('AGE'):cFooting := hb_ntos(:nLen) :ResetVScroll( .T. ) :oHScroll:SetRange(0,0) DO EVENTS If cCapt == cBtnC // нажали ту же кнопку, удерживаем курсор как был If nPos <= :nRowCount() .and. :nLen <= :nRowCount() :GoPos( nPos, nCol ) Else // :nLen > :nRowCount() :Skip(nRec-nPos) :nCell := nCol :Refresh() If nPos > 1 WHILE nPos-- > 1 :GoDown() ENDDO EndIf EndIf EndIf :Show() DO EVENTS :SetFocus() END WITH oWnd:StatusBar:Say('') oWnd:Action := .T. RETURN Nil [/pre2]
SergKis: PS Строку [pre2] :nCell := nCol // :Refresh() If nPos > 1 [/pre2] убрать можно, оставил скорее по "привычке"
SergKis: gfilatov2002 Можно чуть поправить HMG_Alert(...)[pre2] DEFINE WINDOW &cForm WIDTH 0 HEIGHT 0 TITLE cTitle MODAL NOSIZE BACKCOLOR aBackColor ; ON INTERACTIVECLOSE ( lPressButton .OR. lClosable ) ; ON RELEASE iif( ! lPressButton .AND. lClosable, _HMG_ModalDialogReturn := 0, NIL ) FillDlg( cMsg, aOptions, nLineas, cIcoFile, nIcoSize, aBtnColors, bInit, lClosable ) END WINDOW // ACTIVATE WINDOW &cForm ON INIT FillDlg( cMsg, aOptions, nLineas, cIcoFile, nIcoSize, aBtnColors, bInit, lClosable ) ACTIVATE WINDOW &cForm [/pre2] Разницы нет, а достраивать доп. контролами удобнее в такой комбинации строк.
gfilatov2002: SergKis пишет: чуть поправить HMG_Alert(...) Сделал, конечно. Благодарю за предложение
SergKis: gfilatov2002 Не нашел функций в lib для использования в блоках кода для работы с RGB. Приходится все время таскать ToRGB( aColor ), n2RGB( nColor ). Может сделать что то такое[pre2] *-----------------------------------------------------------------------------* FUNCTION HMG_RGB2n( p1, p2, p3 ) *-----------------------------------------------------------------------------* If HB_ISARRAY ( p1 ); RETURN RGB( p1[1], p1[2], p1[3] ) ElseIf HB_ISNUMERIC( p2 ); RETURN RGB( p1 , p2 , p3 ) EndIf RETURN p1 *-----------------------------------------------------------------------------* FUNCTION HMG_n2RGB( nColor ) *-----------------------------------------------------------------------------* RETURN { GetRed( nColor ), GetGreen( nColor ), GetBlue( nColor ) } [/pre2]
gfilatov2002: SergKis пишет: ToRGB( aColor ), n2RGB( nColor ) Псевдо-функция nRGB2Arr( nColor ) уже определена (и активно используется) в библиотеке и примерах. SetProperty( cFormName, "BackColor", nRGB2Arr( GetSysColor( COLOR_WINDOW ) ) ) А предложенная функция HMG_RGB2n() - это просто обертка для псевдо-функции RGB(). Если что-то неправильно понял - аргументируйте...
SergKis: gfilatov2002 пишет аргументируйте... [pre2] LOCAL aClr := {} AAdd( aClr, { CLR_FOCUSB, { |a,b,c| iif( c:nCell == b, ; // CLR_FOCUSB { HMG_RGB2n( 66, 255, 236), HMG_RGB2n(209, 227, 248) }, ; { HMG_RGB2n(220, 220, 220), HMG_RGB2n(220, 220, 220) } ) } } ) AAdd( aClr, { CLR_HEADF , {|| HMG_RGB2n( YELLOW ) } } ) // 3 , текста шапки таблицы AAdd( aClr, { CLR_HEADB , {|| { HMG_RGB2n(40, 122, 237), ; HMG_RGB2n(48, 29, 26) } } } ) // 4 , фона шапка таблицы oBrw := Brw2Arr(cBrw, nY, nX, nW, nH, aDatos, aClr, aFont) [/pre2]
gfilatov2002: SergKis пишет: HMG_RGB2n( YELLOW ) Кстати, еще есть такая псевдо-функция ArrayRGB_TO_COLORREF(aRGB) SergKis пишет: HMG_RGB2n(40, 122, 237) Проще RGB(40, 122, 237)
SergKis: gfilatov2002 пишет RGB(40, 122, 237) Использование псевдо функции в блоке кода приведет к сообщению Error: Unresolved external '_HB_FUN_RGB' referenced ...
SergKis: gfilatov2002 пишет Проще RGB(40, 122, 237) Мои названия RGB2n(...) и n2RGB(...) добавил HMG_... для общей схемы. Может и не надо добавлять.
gfilatov2002: SergKis пишет: Использование псевдо функции в блоке кода приведет к сообщению Нет, такая ошибка не возникла в следующем коде: [pre2] AAdd( aClr, { 6, { |a,b,c| iif( c:nCell == b, ; // CLR_FOCUSB { RGB( 66, 255, 236), RGB(209, 227, 248) }, ; { RGB(220, 220, 220), RGB(220, 220, 220) } ) } } ) AAdd( aClr, { CLR_HEADF , {|| ArrayRGB_TO_COLORREF( YELLOW ) } } ) // 3 , текста шапки таблицы AAdd( aClr, { CLR_HEADB , {|| { RGB(40, 122, 237), ; RGB(48, 29, 26) } } } ) // 4 , фона шапка таблицы oBrw := Brw2Arr(cBrw, nY, nX, nW, nH, aDatos, aClr, aFont) [/pre2]Пример отработал нормально с этими кодо-блоками
SergKis: gfilatov2002 пишет Пример отработал нормально с этими кодо-блоками Да. Отработал Мой косяк, переносил текст и перенес RGB( { 40, 122, 237 } ), RGB( YELLOW ) с лишними скобками {} Но ArrayRGB_TO_COLORREF( YELLOW ) не вспомнишь как пишется. Останусь на своих RGB2n(...), n2RGB(...) Спасибо.
Andrey: SergKis пишет: Но ArrayRGB_TO_COLORREF( YELLOW ) не вспомнишь как пишется. Останусь на своих RGB2n(...), n2RGB(...) Да это точно такую функцию и не вспомнишь.... да и эту тоже nRGB2Arr() Я тоже замучился из проекта в проект таскать эти ToRgb()... Сергей правильно предложил HMG_RGB2n() и HMG_n2RGB() . Можно и сократить до MG_RGB2n() и MG_n2RGB() Лишь бы были и не таскать из проекта в проект.
SergKis: gfilatov2002 пишет аргументируйте... Небольшой аргумент в пользу функций (не псевдо) - это хранение цветов в файлах ini, xml или использование hb_macroBlock(...) для создания блоков кода.
gfilatov2002: Andrey пишет: Сергей правильно предложил HMG_RGB2n() и HMG_n2RGB() С учетом обсуждения (и поддержки) добавил эти макросы в заголовок i_pseudofunc.ch Теперь код ниже [pre2] LOCAL aClr := {} AAdd( aClr, { CLR_FOCUSB, { |a,b,c| iif( c:nCell == b, ; // CLR_FOCUSB { HMG_RGB2n( 66, 255, 236), HMG_RGB2n(209, 227, 248) }, ; { HMG_RGB2n(220, 220, 220), HMG_RGB2n(220, 220, 220) } ) } } ) AAdd( aClr, { CLR_HEADF , {|| HMG_RGB2n( YELLOW ) } } ) // 3 , текста шапки таблицы AAdd( aClr, { CLR_HEADB , {|| { HMG_RGB2n(40, 122, 237), ; HMG_RGB2n(48, 29, 26) } } } ) // 4 , фона шапка таблицы oBrw := Brw2Arr(cBrw, nY, nX, nW, nH, aDatos, aClr, aFont)[/pre2] отработал без проблем
SergKis: gfilatov2002 Можно изменить в HMG_Alert() строки[pre2] STATIC FUNCTION FillDlg( cMsg, aOptions, nLineas, cIcoFile, nIcoSize, aBtnColors, bBlock, lClosable ) ... This.Closable := lClosable This.&( aBut[ Max( 1, Min( nLenaOp, _HMG_ModalDialogReturn ) ) ] ).SetFocus() This.Center() IF lClosable ON KEY ESCAPE OF &cForm ACTION ( _HMG_ModalDialogReturn := 0, lPressButton := .T., ThisWindow.Release() ) ENDIF IF HB_ISBLOCK( bBlock ) Do_WindowEventProcedure( bBlock, This.Index, 'WINDOW_ACTIVATE' ) ENDIF IF _IsControlDefined( "oTimer", cForm ) This.oTimer.Enabled := .T. ENDIF ... [/pre2]
gfilatov2002: SergKis пишет: изменить в HMG_Alert() строки Сделал, конечно
SergKis: gfilatov2002 Предлагаю добавить метод в TsColumn (при работе с dbf заполняются :nFieldTyp, :nFieldLen на колонки)[pre2] METHOD ToWidth( uLen, nKfc ) CLASS TSColumn LOCAL nWidth, nLen, cTyp, cChr := 'B' Default nKfc := 1 If ! empty( ::cPicture ) .and. HB_ISCHAR( ::cPicture ) If empty( uLen ) cChr := ::cPicture If Left(cChr, 2) == '@K' cChr := AllTrim(Substr(cChr, 3)) EndIf nLen := Len( cChr ) Else If '9' $ ::cPicture; cChr := '9' ElseIf 'X' $ ::cPicture; cChr := 'X' EndIf nLen := uLen cChr := Replicate(cChr, nLen) EndIf Else cTyp := ::cFieldTyp nLen := iif( empty(uLen), ::nFieldLen, uLen ) If cTyp $ 'CML'; cChr := 'B' ElseIf cTyp == 'ND'; cChr := '9' EndIf nLen := iif( empty(nLen), 7, nLen ) cChr := Replicate(cChr, nLen) EndIf nWidth := GetTextWidth( 0, cChr, ::hFont ) nWidth := Int( nWidth * nKfc ) RETURN nWidth Применять так к примеру with object oBrw For i := 1 To Len( :aColumns ) oc := :aColumns[ i ] cp := oc:cName xv := :GetValue(cp) cn := '_' + cp s := iif( oc:nFieldLen > 40, 40, Nil ) nl := oc:ToWidth( s ) @ y, x LABEL &cn ; VALUE oc:cHeading ; WIDTH l HEIGHT h ; VCENTERALIGN @ y, x+l+20 GETBOX &cp ; VALUE xv ; WIDTH nl HEIGHT h ; PICTURE :cPictureGet(, i) y += This.&(cn).Height + 20 Next end with [/pre2]
gfilatov2002: SergKis пишет: добавить метод в TsColumn Принято с благодарностью
Andrey: SergKis пишет: Предлагаю добавить метод в TsColumn (при работе с dbf заполняются :nFieldTyp, :nFieldLen на колонки) А как код будет выглядеть ?
SergKis: Andrey пишет А как код будет выглядеть ? SergKis пишет Применять так к примеру with object oBrw For i := 1 To Len( :aColumns ) oc := :aColumns[ i ] cp := oc:cName xv := :GetValue(cp) cn := '_' + cp s := iif( oc:nFieldLen > 40, 40, Nil ) nl := oc:ToWidth( s ) @ y, x LABEL &cn ; VALUE oc:cHeading ; WIDTH l HEIGHT h ; VCENTERALIGN @ y, x+l+20 GETBOX &cp ; VALUE xv ; WIDTH nl HEIGHT h ; PICTURE :cPictureGet(, i) y += This.&(cn).Height + 20 Next end with или :LoadFields(.F.) nKfc := 0.8 // коэффициент для коррекции nWidth полученной при расчете, если надо такая поправка AEval( :aColumns, {|oc| oc:nWidth := oc:ToWidth(iif( oc:nFieldLen > 40, 40, Nil ), nKfc) } )
SergKis: gfilatov2002 Предлагаю такой HMG_Alert(), добавил параметр cFont, для исп. вместо DlgFont. Тогда можно применять Alert...() ф-ии с DlgFont. [pre2] *-----------------------------------------------------------------------------* FUNCTION HMG_Alert( cMsg, aOptions, cTitle, nType, cIcoFile, nIcoSize, aBtnColors, bInit, lClosable, cFont ) *-----------------------------------------------------------------------------* LOCAL nLineas LOCAL aIcon := { "ALERT", "QUESTION", "INFO", "STOP" } LOCAL lFont := .F. LOCAL lEmpty := ( Empty( aOptions ) .OR. ISNUMERIC( aOptions ) ) LOCAL cForm := "oDlg" IF _IsWindowDefined( cForm ) nLineas := 0 WHILE _IsWindowDefined( cForm := 'oDlg' + hb_ntos( ++nLineas ) ) END ENDIF lPressButton := .F. lIsWin10 := hb_osisWin10() hb_default( @aBackColor, nRGB2Arr( GetSysColor( COLOR_BTNFACE ) ) ) hb_default( @aFontColor, nRGB2Arr( GetSysColor( COLOR_BTNTEXT ) ) ) DEFAULT cTitle TO "Attention", aOptions TO { "&OK" }, lClosable TO .F. IF ValType( aOptions ) == "A" DEFAULT nType := iif( Len( aOptions ) > 1, 2, 1 ) ELSE DEFAULT nType := 1 ENDIF #ifdef _HMG_COMPAT_ CHECK TYPE cMsg AS USUAL, ; aOptions AS USUAL, ; cTitle AS CHARACTER, ; nType AS NUMERIC, ; cIcoFile AS USUAL, ; nIcoSize AS USUAL, ; aBtnColors AS USUAL, ; bInit AS USUAL, ; lClosable AS LOGICAL #endif IF nType < 1 .OR. nType > 4 nType := 1 ENDIF AEval( aIcon, {|x, i| aIcon[ i ] := "ZZZ_B_" + x } ) DEFAULT cIcoFile := aIcon[ nType ], nIcoSize := 32, cFont := "DlgFont" IF GetFontHandle( cFont ) == 0 lFont := .T. DEFINE FONT &cFont FONTNAME GetDefaultFontName() SIZE GetDefaultFontSize() - iif( lIsWin10, 1, 0 ) ENDIF cMsg := cValToChar( cMsg ) cMsg := StrTran( cMsg, ";", CRLF ) nLineas := MLCount( cMsg, 254 ) IF lEmpty lClosable := .T. _HMG_ModalDialogReturn := 0 ELSE hb_default( @_HMG_ModalDialogReturn, 0 ) ENDIF DEFINE WINDOW &cForm WIDTH 0 HEIGHT 0 TITLE cTitle MODAL NOSIZE BACKCOLOR aBackColor ; ON INTERACTIVECLOSE ( lPressButton .OR. lClosable ) ; ON RELEASE iif( ! lPressButton .AND. lClosable, _HMG_ModalDialogReturn := 0, NIL ) FillDlg( cMsg, aOptions, nLineas, cIcoFile, nIcoSize, aBtnColors, bInit, lClosable, cFont ) END WINDOW ACTIVATE WINDOW &cForm IF lFont RELEASE FONT &cFont ENDIF RETURN _HMG_ModalDialogReturn *-----------------------------------------------------------------------------* STATIC FUNCTION FillDlg( cMsg, aOptions, nLineas, cIcoFile, nIcoSize, aBtnColors, bBlock, lClosable, cFont ) *-----------------------------------------------------------------------------* LOCAL hWnd LOCAL hDC LOCAL hDlgFont LOCAL aBut := {} LOCAL cForm := ThisWindow.Name LOCAL cLblName LOCAL cBtnName LOCAL nCol LOCAL nOpc := 1 LOCAL nMaxLin := 0 LOCAL nMaxBoton := 0 LOCAL nLenBotones LOCAL nLenaOp LOCAL nWidthCli, nHeightCli LOCAL nWidthDlg, nHeightDlg LOCAL nChrHeight LOCAL nHeightBtn LOCAL nVMARGIN_BUTTON := VMARGIN_BUTTON LOCAL nSeconds LOCAL n LOCAL lExt #ifdef _HMG_COMPAT_ CHECK TYPE cMsg AS CHARACTER, ; aOptions AS USUAL, ; nLineas AS NUMERIC, ; cIcoFile AS CHARACTER, ; nIcoSize AS NUMERIC #endif IF ValType( aOptions ) == "N" nSeconds := aOptions aOptions := { "&OK" } DEFINE TIMER oTimer OF &cForm INTERVAL nSeconds * 1000 ACTION ( lPressButton := .T., ThisWindow.Release() ) This.oTimer.Enabled := .F. ENDIF nLenaOp := iif( ValType( aOptions ) == "A", Len( aOptions ), 1 ) IF ( lExt := ( ISARRAY( aBtnColors ) .AND. Len( aBtnColors ) == nLenaOp ) ) nVMARGIN_BUTTON := 3 * VMARGIN_BUTTON ENDIF hDlgFont := GetFontHandle( cFont ) // calculate the column of the text output nCol := MARGIN_ICON + iif( nIcoSize == 32, 0, MARGIN_ICON / iif( nIcoSize == 64, 2.8, 3.2 ) ) hWnd := This.Handle hDC := GetDC( hWnd ) // calculate the character height for the dialog font nChrHeight := GetTextHeight( hDC, aOptions[ 1 ], hDlgFont ) + nVMARGIN_BUTTON / 2 // calculate the maximum width of the lines FOR n := 1 TO nLineas nMaxLin := Max( nMaxLin, GetTextWidth( hDC, AllTrim( MemoLine( cMsg,, n ) ), hDlgFont ) ) NEXT // calculate the maximum width of the buttons FOR n := 1 TO nLenaOp nMaxBoton := Max( nMaxBoton, GetTextWidth( hDC, aOptions[ n ], hDlgFont ) ) NEXT ReleaseDC( hWnd, hDC ) nMaxBoton += ( HMARGIN_BUTTON * iif( ! lExt .AND. lIsWin10 .AND. nLenAop > 2, 1.1, iif( nLenAop > 1, 2, 3 ) ) ) // calculate the width of the options + their separations nLenBotones := ( nMaxBoton + SEP_BUTTON ) * nLenaOp nHeightBtn := nVMARGIN_BUTTON + nChrHeight + nVMARGIN_BUTTON // calculate the width of the client area nWidthCli := Max( MARGIN_ICON + nMaxLin + MARGIN, MARGIN + nLenBotones + MARGIN - HMARGIN_BUTTON ) + iif( nIcoSize > 48, MARGIN / 4, 0 ) nWidthDlg := nWidthCli + GetBorderWidth() nHeightCli := ( ( nLineas + iif( nLineas == 1, 4, 3 ) ) * nChrHeight ) + nVMARGIN_BUTTON + nHeightBtn + GetBorderHeight() nHeightDlg := nHeightCli + GetTitleHeight() + SEP_BUTTON + GetBorderHeight() / iif( lIsWin10, 2.5, 1 ) IF MSC_VER() > 0 .AND. _HMG_IsThemed nWidthDlg += 10 nHeightDlg += 10 ENDIF This.Width := nWidthDlg This.Height := nHeightDlg IF nLineas > 1 FOR n := 1 TO nLineas cLblName := "Say_" + StrZero( n, 2 ) @ nChrHeight * ( n + iif( nLineas == 1, .5, 0 ) ) + GetBorderHeight(), nCol ; LABEL &cLblName VALUE AllTrim( MemoLine( cMsg,, n ) ) OF &cForm ; FONT cFont WIDTH nWidthCli - nCol - GetBorderWidth() - MARGIN / 4 HEIGHT nChrHeight ; FONTCOLOR aFontColor BACKCOLOR aBackColor VCENTERALIGN NEXT n ELSE @ nChrHeight * 1.5 + GetBorderHeight(), nCol ; LABEL Say_01 VALUE AllTrim( cMsg ) OF &cForm ; FONT cFont WIDTH nWidthCli - nCol - GetBorderWidth() - MARGIN / 4 HEIGHT nChrHeight ; FONTCOLOR aFontColor BACKCOLOR aBackColor VCENTERALIGN ENDIF DRAW ICON IN WINDOW &cForm ; AT nChrHeight + GetBorderHeight(), MARGIN / iif( nIcoSize == 32, 1.4, iif( nIcoSize == 48, 1.7, 2 ) ) ; PICTURE cIcoFile WIDTH nIcoSize HEIGHT nIcoSize TRANSPARENT FOR n := 1 TO nLenaOp cBtnName := "Btn_" + StrZero( n, 2 ) AAdd( aBut, cBtnName ) IF lExt @ 0, 0 BUTTONEX &cBtnName OF &cForm CAPTION aOptions[ n ] ; FONTCOLOR aFontColor BACKCOLOR aBtnColors[ n ] NOXPSTYLE HANDCURSOR ; FONT cFont WIDTH nMaxBoton HEIGHT nVMARGIN_BUTTON + nChrHeight + nVMARGIN_BUTTON ; ACTION ( _HMG_ModalDialogReturn := This.Cargo, lPressButton := .T., ThisWindow.Release() ) ELSE @ 0, 0 BUTTON &cBtnName OF &cForm CAPTION aOptions[ n ] ; FONT cFont WIDTH nMaxBoton HEIGHT nVMARGIN_BUTTON + nChrHeight + nVMARGIN_BUTTON ; ACTION ( _HMG_ModalDialogReturn := This.Cargo, lPressButton := .T., ThisWindow.Release() ) ENDIF This.&( aBut[ nOpc ] ).Cargo := nOpc++ NEXT n nOpc := 1 FOR n := nLenaOp TO 1 STEP -1 This.&( aBut[ n ] ).Row := nHeightCli + SEP_BUTTON + GetBorderHeight() / iif( lIsWin10, 2.5, .9 ) - nChrHeight - nHeightBtn This.&( aBut[ n ] ).Col := nWidthCli + iif( lIsWin10, 0, GetBorderWidth() / 2 ) - ( nMaxBoton + SEP_BUTTON ) * nOpc++ NEXT n This.Closable := lClosable This.&( aBut[ Max( 1, Min( nLenaOp, _HMG_ModalDialogReturn ) ) ] ).SetFocus() This.Center() IF lClosable ON KEY ESCAPE OF &cForm ACTION ( _HMG_ModalDialogReturn := 0, lPressButton := .T., ThisWindow.Release() ) ENDIF IF HB_ISBLOCK( bBlock ) Do_WindowEventProcedure( bBlock, This.Index, 'WINDOW_ACTIVATE' ) ENDIF IF _IsControlDefined( "oTimer", cForm ) This.oTimer.Enabled := .T. ENDIF RETURN NIL [/pre2] Т.е. в примере можно сделать[pre2] FUNCTION Main() ... SET DIALOGBOX CENTER OF PARENT SET CENTERWINDOW RELATIVE PARENT ... DEFINE FONT FontBold FONTNAME _HMG_DefaultFontName SIZE _HMG_DefaultFontSize BOLD DEFINE FONT AgeCard FONTNAME "Verdana" SIZE 12 BOLD DEFINE FONT DlgFont FONTNAME "Tahoma" SIZE 12 ... STATIC FUNC AgeCard( oWnd, oBrw, oCnl ) ... LOCAL cFont := 'AgeCard' If ! empty( oBrw:GetValue('AGE') ) .or. ! empty( oBrw:GetValue('FIRST') ) HMG_Alert( cMsg, aButt, cTitl, , cBmp, , aClr, bInit, .T., cFont ) EndIf ... STATIC FUNC Age_CardSave( oBrw, lSave ) ... If empty( lSave ) .and. ThisWindow.Cargo // lMsg := MsgYesNo('Save card - '+cValToChar(This.AGE.Value )+CRLF+ ; lMsg := AlertYesNo('Save card - '+cValToChar(This.AGE.Value )+CRLF+ ; cValToChar(This.FIRST.Value)+CRLF+ ; cValToChar(This.LAST.Value ), ; 'NR. '+hb_ntos(oBrw:nAt)+ ' RECNO ' + cValToChar(nRec)) EndIf ... [/pre2]
gfilatov2002: SergKis пишет: Предлагаю такой HMG_Alert(), добавил параметр cFont Принято
SergKis: gfilatov2002 Можете пояснить зачем удаляется фонт из списка, если в контролах он не создается (не увидел) ? [pre2] *-----------------------------------------------------------------------------* FUNCTION _EraseControl ( i, p ) *-----------------------------------------------------------------------------* LOCAL hWnd LOCAL mVar LOCAL t, x x := _HMG_aControlFontHandle IF ISNUMERIC ( x ) .AND. !Empty ( x ) .AND. !( x == GetFontHandle ( "DlgFont" ) ) DeleteObject ( x ) ENDIF ... [/pre2] такая штука удаляет фонт, если он не DlgFont, созданный по DEFINE FONT ... и использованный в контроле.
gfilatov2002: SergKis пишет: такая штука удаляет фонт, если он не DlgFont, созданный по DEFINE FONT ... и использованный в контроле Да, все верно. В момент удаления мы ведь не знаем название шрифта, а только указатель (handle) на него. Сейчас этот фрагмент кода выглядит так [pre2] FUNCTION _EraseControl ( i , p ) ... IF ISNUMERIC ( x ) .AND. !Empty ( x ) .AND. ; !( x == GetFontHandle ( "DlgFont" ) ) .AND. !( x == GetFontHandle ( _HMG_ActiveDialogFontName ) ) DeleteObject ( x ) ENDIF [/pre2]
SergKis: gfilatov2002 пишет В момент удаления мы ведь не знаем название шрифта, а только указатель (handle) на него. Зачем удалять фонт, созданный (сохранен в базе _HMG_aControlType == 'FONT') по DEFINE FONT ... ? Его удаляем по RELEASE FONT, а в контролах, если не найден в базе фонтов, используем _HMG_DefaultFontName, или фонт установленный на окно. Или я что то упускаю ?
SergKis: PS Ведь все фонты по DEFINE FONT ... цепляются к _FORMNAME_ 'Main' и там живут
SergKis: PPS Если фонтов нет в списке DEFINE FONT ..., работают С ф-ии _SetFont(...), _SetFontHandle(...), а они не используют базу. По мне, команды удаления фонтов в _EraseControl() не нужны.
SergKis: SergKis пишет По мне, команды удаления фонтов в _EraseControl() не нужны Уточню, если они находятся в секции 'Main' - удалять не нужно.
gfilatov2002: SergKis пишет: Зачем удалять фонт, созданный (сохранен в базе _HMG_aControlType == 'FONT') по DEFINE FONT ... ? Поправил этот фрагмент кода с учетом Вашего предложения: [pre2] *-----------------------------------------------------------------------------* FUNCTION _EraseControl ( i, p ) *-----------------------------------------------------------------------------* LOCAL hWnd LOCAL mVar LOCAL t, x x := _HMG_aControlFontHandle [ i ] IF ISNUMERIC ( x ) .AND. !Empty ( x ) .AND. AScan( _HMG_aControlHandles, x ) == 0 DeleteObject ( x ) ENDIF[/pre2]Благодарю за помощь
gfilatov2002: Подготовил 2-й релиз-кандидат для новой сборки 19.08 со следующим списком изменений: [pre2]* Fixed missed hiding of all controls on a FOCUSED deleted TabPage in the function _DeleteTabPage(). It exists in the official version too. * Added possibility to modify the following Windows events at runtime: - OnInit - OnRelease - OnInteractiveClose - OnGotFocus - OnLostFocus - OnNotifyClick - OnMouseclick - OnMouseDrag - OnMouseMove - OnMove - OnSize - OnMaximize - OnMinimize - OnPaint - OnRestore - OnDropFiles * Added the useful pseudo-functions RGB2n( n1 [, n2] [, n3] ) and n2RGB( n ) for converting of a color array. * The 'Cursor' property is supported in the function GetProperty() for the Forms. * Added possibility to modify of 'OnEnter' event for the controls at runtime. * Added possibility to modify of the 'OnListDisplay/OnDropDown' and 'OnListClose/OnCloseUp' events for ComboBox control at runtime. * The Spinner control supports now a changing of the INCREMENT property at runtime. * The Timer control supports now a changing of the INTERVAL and ONCE properties at runtime. * The BTNTEXTBOX control supports now a changing of the separated TOOLTIPs for the edit box and buttons at runtime. * The GETBOX control supports now a changing of the separated TOOLTIPs for the edit box and buttons at runtime. * The global fonts which were defined by the command DEFINE FONT <font> FONTNAME <name> ... will preserved after closing of a form. * A 'Value' property will changed to a first available item in the RadioGroup control if a focused item was disabled with a putting of 'ReadOnly' property. * Updated the TSBrowse, HBPrinter and Sqlite3 libraries. * Added the new interesting samples and updated some Basic and Advanced samples. [/pre2] Хотя эта сборка работает стабильно, выпуск финальной версии отложен по финансовым причинам
SergKis: gfilatov2002 Может добавить для фонта[pre2] PROCEDURE _DefineFont( FontName, fName, fSize, bold, italic, underline, strikeout, nAngle, default, charset ) ... _HMG_aControlWidth [k] := GetTextWidth ( 0, 'B', FontHandle ) _HMG_aControlHeight [k] := GetTextHeight( 0, 'B', FontHandle ) ... FUNCTION GetFontParam( FontHandle ) ... aFontAttr := { _HMG_DefaultFontName, _HMG_DefaultFontSize, .F., .F., .F., .F., 0, 0, 0 } ... iif( Len( _HMG_aControlFontAttributes[ i ] ) == 5, _HMG_aControlFontAttributes[ i, FONT_ATTR_ANGLE ], 0 ), ; _HMG_aControlWidth [ i ], _HMG_aControlHeight [ i ] } ENDIF ... И псевдо функции FUNC GetFontWidth( FontName, nLen ) RETUNR GetFontParam( GetFontHandle( FontName ) )[8] * nLen FUNC GetFontHeight( FontName ) RETUNR GetFontParam( GetFontHandle( FontName ) )[9] [/pre2]
SergKis: PS Может покороче назвать FontWidth(...), FontHeight(...) ?
gfilatov2002: SergKis пишет: добавить для фонта Добавил конечно, но оставил названия псевдо-функций с Get (так понятнее). Благодарю за помощь
SergKis: gfilatov2002 Предложение добавить[pre2] *-----------------------------------------------------------------------------* PROCEDURE _PopEventInfo( n ) *-----------------------------------------------------------------------------* LOCAL l IF ( l := Len ( _HMG_aEventInfo ) ) > 0 DEFAULT n := 0 IF n > 0 .and. n <= l; l := n ENDIF _HMG_ThisFormIndex := _HMG_aEventInfo [l] [1] _HMG_ThisEventType := _HMG_aEventInfo [l] [2] _HMG_ThisType := _HMG_aEventInfo [l] [3] _HMG_ThisIndex := _HMG_aEventInfo [l] [4] _HMG_ThisFormName := _HMG_aEventInfo [l] [5] _HMG_ThisControlName := _HMG_aEventInfo [l] [6] IF n == 0 ASize ( _HMG_aEventInfo , l - 1 ) ENDIF ELSE ... [/pre2] Тогда в блоке кода на окно, контрол можно ставить среду This запомненную ранее, к примеру, на TIMER другого окна ACTION {|| _PopEventInfo( Len( _HMG_aEventInfo ) - 1 ), ... }
gfilatov2002: SergKis пишет: Предложение добавить Добавил, хотя эта коррекция является опасным хаком, на мой взгляд
SergKis: gfilatov2002 пишет Добавил, хотя эта коррекция является опасным хаком, на мой взгляд Большой опасности нет (не удаляем из стека, применяя n), на мой взгляд, но понимать, что происходит, конечно надо. Вариантов больше получается, к примеру 1 define window ... (сохраняет среду), если сделать _PushEventInfo ... end window (восстановит среду, но останется доп. установка) action window ... _PopEventInfo() (окончательно восстановит среду до работы окна) This среда будет стоять для окна (в блоках контролов среда ставится\восстанавливается для тек. окна) 2 В Timer (к примеру, на Main окне) поставив This среду по n (который можно определить по разному) можно анализировать ThisWindow.Name и даже This.Name, что бы проделывать разные операции в зависимости от имен. Завершение блока кода Timer восстановит из последнего элемента _HMG_aEventInfo, т.е. то что было при входе.
gfilatov2002: SergKis пишет: понимать, что происходит, конечно надо Вот в этом и проблема - обычно пользователи библиотеки (они же прикладные разработчики) редко хотят заморачиваться такими вещами. Но как дополнительная возможность - не помешает, я думаю.
SergKis: gfilatov2002 Поправил LoadFields() для работы с др. alias [pre2] METHOD LoadFields( lEditable, aColSel, cAlsSel, aNameSel ) CLASS TSBrowse Local n, nE, cHeading, nAlign, nSize, cData, cType, nDec, hFont, cPicture, ; cBlock, nCols, aNames, cKey, ; aColSizes := ::aColSizes, ; cOrder, nEle, ; cAlias, ; // := ::cAlias, ; aAlign := { "LEFT", "CENTER", "RIGHT", "VERT" }, ; aStru //:= ( ::cAlias )->( DbStruct() ) Local cName Default lEditable := ::lEditable, ; aColSizes := {} cAlias := If( HB_ISCHAR ( cAlsSel ), cAlsSel, ::cAlias ) aStru := ( cAlias )->( DbStruct() ) aNames := If( HB_ISARRAY( aColSel ), aColSel, ::aColSel ) // aNames := ::aColSel nCols := If( aNames == Nil, ( cAlias )->( FCount() ), Len( aNames ) ) aColSizes := If( Len( ::aColumns ) == Len( aColSizes ), Nil, aColSizes ) For n := 1 To nCols nE := If( aNames == Nil, n, ( cAlias )->( FieldPos( aNames[ n ] ) ) ) If ValType( ::aHeaders ) == "A" .and. ! Empty( ::aHeaders ) .and. n <= Len( ::aHeaders ) cHeading := ::aHeaders[ n ] Else cHeading := ::Proper( ( cAlias )->( Field( nE ) ) ) EndIf If ( nEle := AScan( ::aTags, {|e| Upper( cHeading ) $ Upper( e[ 2 ] ) } ) ) > 0 cOrder := ::aTags[ nEle, 1 ] cKey := ( cAlias )->( OrdKey() ) If Upper( cHeading ) $ Upper( cKey ) ::nColOrder := If( Empty( ::nColOrder ), Len( ::aColumns ) + 1, ::nColOrder ) EndIf Else cOrder := "" EndIf nAlign := If( ::aJustify != Nil .and. Len( ::aJustify ) >= nE, ::aJustify[ nE ], ; If( ( cAlias )->( ValType( FieldGet( nE ) ) ) == "N", 2, ; If( ( cAlias )->( ValType( FieldGet( nE ) ) ) == "L", 1, 0 ) ) ) nAlign := If( ValType( nAlign ) == "L", If( nAlign, 2, 0 ), ; If( ValType( nAlign ) == "C", AScan( aAlign, nAlign ) - 1, nAlign ) ) nSize := If( ! aColSizes == Nil .and. Len( aColsizes ) >= nE, aColSizes[ nE ], Nil ) cType := aStru[ nE, 2 ] If cType == "C" cPicture := "@K " + Replicate( 'X', aStru[ nE, 3 ] ) ElseIf cType == "N" cPicture := Replicate( '9', aStru[ nE, 3 ] ) IF aStru[ nE, 4 ] > 0 cPicture := SubStr( cPicture, 1, aStru[ nE, 3 ]-aStru[ nE, 4 ] - 1 ) + '.' + Replicate( '9', aStru[ nE, 4 ] ) endif cPicture := "@K " + cPicture EndIf If nSize == Nil cData := ( cAlias )->( FieldGet( nE ) ) cType := aStru[ nE, 2 ] nSize := aStru[ nE, 3 ] nDec := aStru[ nE, 4 ] hFont := If( ::hFont != Nil, ::hFont, 0 ) If cType == "C" cData := PadR( Trim( cData ), nSize, "B" ) nSize := GetTextWidth( 0, cData, hFont ) ElseIf cType == "N" cData := StrZero( cData, nSize, nDec ) nSize := GetTextWidth( 0, cData, hFont ) ElseIf cType == "D" cData := cValToChar( If( Empty( cData ), Date(), cData ) ) nSize := Int( GetTextWidth( 0, cData + "B", hFont ) ) + If( lEditable, 30, 0 ) ElseIf cType == "M" nSize := If( ::nMemoWV == Nil, 200, ::nMemoWV ) Else cData := cValToChar( cData ) nSize := GetTextWidth( 0, cData, hFont ) EndIf nSize := Max( GetTextWidth( 0, Replicate( "B", Len( cHeading ) ), hFont ), nSize ) nSize += If( ! Empty( cOrder ), 14, 0 ) ElseIf ValType( ::aColSizes ) == "A" .and. ! Empty( ::aColSizes ) .and. n <= Len( ::aColSizes ) nSize := ::aColSizes[ n ] EndIf If ValType( ::aFormatPic ) == "A" .and. ! Empty( ::aFormatPic ) .and. n <= Len( ::aFormatPic ) cPicture := ::aFormatPic[ n ] EndIf cBlock := 'FieldWBlock("' + aStru[ nE, 1 ] + '",Select("' + cAlias + '"))' ::AddColumn( TSColumn():New( cHeading, FieldWBlock( aStru[ nE, 1 ], Select( cAlias ) ),cPicture, ; { ::nClrText, ::nClrPane }, { nAlign, DT_CENTER }, nSize,, lEditable,,, cOrder,,,, ; 5,,,, Self, cBlock ) ) cName := ( cAlias )->( FieldName( nE ) ) ATail( ::aColumns ):cData := cAlias + "->" + FieldName( nE ) // ATail( ::aColumns ):cName := ( cAlias )->( FieldName( nE ) ) // 21.07.2015 ATail( ::aColumns ):cField := ( cAlias )->( FieldName( nE ) ) // 08.06.2018 ATail( ::aColumns ):cFieldTyp := aStru[ nE, 2 ] // 18.07.2018 ATail( ::aColumns ):nFieldLen := aStru[ nE, 3 ] // 18.07.2018 ATail( ::aColumns ):nFieldDec := aStru[ nE, 4 ] // 18.07.2018 If HB_ISARRAY( aNameSel ) .and. Len( aNameSel ) > 0 .and. n <= Len( aNameSel ) If HB_ISCHAR( aNameSel[ n ] ) .and. !Empty( aNameSel[ n ] ) cName := aNameSel[ n ] EndIf EndIf ATail( ::aColumns ):cName := cName If cType == "L" ATail( ::aColumns ):lCheckBox := .T. EndIf If ! Empty( cOrder ) ATail( ::aColumns ):lIndexCol := .T. EndIf Next If ::nLen == 0 cAlias := ::cAlias ::nLen := If( ::bLogicLen == Nil, Eval( ::bLogicLen := {||( cAlias )->( LastRec() ) } ), Eval( ::bLogicLen ) ) EndIf Return Self [/pre2] Пример для проверки https://TransFiles.ru/1z51g
SergKis: PS Для работы с MEMIO (пропустил, не доделал), надо[pre2] REQUEST DBFCDX, DBFFPT, DBFNTX, HB_MEMIO *-----------------------------------------------------------------------------* FUNCTION Main( cPath ) *-----------------------------------------------------------------------------* LOCAL nY, nX, nW, nH, hSpl, oBrw LOCAL cWnd := 'wMain', cAlias, aStru LOCAL cOut := 'OUT' LOCAL cTmp := 'mem:out' ... [/pre2] и Compile.bat call ..\..\..\batch\compile.bat demo /l hbmemio %1 %2 %3 %4 %5 %6 %7 %8 %9
SergKis: PPS Если сделать изменения, то можно менять поля в dbf из которого выборка [pre2] :LoadFields(.F., aColSel, cOut, aNamSel) aColSel := {"FIRST" , "LAST" , "STATE" , "AGE" , "ZIP", "MARRIED" } :LoadFields(.T., aColSel, cAls) FOR nI := 1 TO Len( aColSel ) :GetColumn(aColSel[ nI ]):bPrevEdit := {|| (cAls)->( RLock() ) } IF 'MARR' $ aColSel[ nI ] :GetColumn(aColSel[ nI ]):bPostEdit := {|| (cAls)->MARRIED := ! (cAls)->MARRIED, ; (cAls)->( dbUnLock() ) } ELSE :GetColumn(aColSel[ nI ]):bPostEdit := {|| (cAls)->( dbUnLock() ) } ENDIF NEXT AEval(:aColumns, {|oc,nc| oc:lEmptyValToChar := .T., ; oc:lFixLite := .T. }) [/pre2]
gfilatov2002: SergKis пишет: Поправил LoadFields() для работы с др. alias Принято с благодарностью
SergKis: gfilatov2002 Андрей сказал, что у меня в примере простая карточка, без вызова справочника. Исправил пример, добавив имитацию вызова справочников у 2х GetBox кнопками Так же сделал на этих GetBox F5 и DublClick для вызова справочника + ToolTip информация Пример тут https://TransFiles.ru/ocym6
SergKis: PS Небольшая бяка в примере. Если карточка изменена, фокус на GetBox и нажимаем Esc, то запрос на сохранение карточки, сделанный на AletYesNo(...), улетает в координаты 0,0. Правка такая[pre2] STATIC FUNC Age_CardSave( oBrw, lSave ) ... LOCAL nRec := ATail(aRec) LOCAL cFocu := This.FocusedControl If empty( lSave ) .and. ThisWindow.Cargo If ! empty(cFocu) .and. ! 'BUTT' $ This.&(cFocu).Type This.Btn_04.SetFocus DO EVENTS EndIf // lMsg := MsgYesNo('Save card - '+cValToChar(This.AGE.Value )+CRLF+ ; lMsg := AlertYesNo('Save card - '+cValToChar(This.AGE.Value )+CRLF+ ; ... [/pre2]
gfilatov2002: SergKis пишет: Исправил пример, добавив имитацию вызова справочников у 2х GetBox кнопками Благодарю за помощь
SergKis: gfilatov2002 Если добавить методы в [pre2]CLASS TGetData INHERIT TCnlData ... METHOD SetKeyEvent ( nKey, bKey, lCtrl, lShift, lAlt ) INLINE ::Get:SetKeyEvent(nKey, bKey, lCtrl, lShift, lAlt) METHOD SetDublClick( bBlock ) INLINE ::Get:SetKeyEvent( , bBlock ) METHOD Destroy() INLINE ::oGetBox := ::Super:Destroy() ... то удобней писать (This.&(o:GetName).Object):SetKeyEvent ( VK_F5, hb_MacroBlock(o:BtnAction) ) (This.&(o:GetName).Object):SetDublClick( hb_MacroBlock(o:BtnAction) ) [/pre2]
gfilatov2002: SergKis пишет: добавить методы Добавил эти методы, но, конечно, переименовал SetDublClick в SetDoubleClick Благодарю за помощь
SergKis: gfilatov2002 Мелочь, но поправьте [pre2] #translate System.ClientWidth => ( GetDesktopWidth () - GetBorderWidth () ) #translate System.ClientHeight => ( GetDesktopHeight() - GetBorderHeight() - GetTaskBarHeight() ) [/pre2]
gfilatov2002: SergKis пишет: поправьте OK
SergKis: gfilatov2002 Для простого определения принадлежности колонки к алиасу добавил [pre2] CLASS TSColumn ... DATA cError // Bad valid error message DATA cArea INIT "" // Alias name of column DATA cField INIT "" // Field Name of column ... METHOD LoadFields( lEditable, aColSel, cAlsSel, aNameSel ) CLASS TSBrowse ... ATail( ::aColumns ):cArea := cAlias ATail( ::aColumns ):cData := cAlias + "->" + FieldName( nE ) ... METHOD LoadRelated( cAlias, lEditable, aNames, aHeaders ) CLASS TSBrowse ... ATail( ::aColumns ):cAlias := cAlias ATail( ::aColumns ):cData := cAlias + "->" + FieldName( nE ) ATail( ::aColumns ):cField := cAlias + "->" + FieldName( nE ) ATail( ::aColumns ):cName := cAlias + "->" + ( cAlias )->( FieldName( nE ) ) ATail( ::aColumns ):cArea := cAlias ATail( ::aColumns ):cFieldTyp := aStru[ nE, 2 ] ATail( ::aColumns ):nFieldLen := aStru[ nE, 3 ] ATail( ::aColumns ):nFieldDec := aStru[ nE, 4 ] Next ... [/pre2]
gfilatov2002: SergKis пишет: определения принадлежности колонки к алиасу добавил Продублировал эти изменения также, хотя и не очень понятно, почему недостаточно ATail( ::aColumns ):cAlias := cAlias и требуется дублировать это значение в еще одну переменную cArea
SergKis: gfilatov2002 пишет требуется дублировать это значение в еще одну переменную cArea oBrw:cAlias опр. рабочую область тсб, oCol:cAlias задействован в работе блока кода, для массива то же срабатывает. oCol:cArea позволит связать колонку с полем в базе, не меняя "старые" алгоритмы, в том числе и при тсб массива. Выделять из oCol:cData алиас можно, но не очень удобно. Код (выделен) [pre2] :LoadFields(.T., aColSel, cAls) FOR nI := 1 TO Len( aColSel ) :GetColumn(aColSel[ nI ]):bPrevEdit := {|| (cAls)->( RLock() ) } :GetColumn(aColSel[ nI ]):bPostEdit := {|| (cAls)->( dbUnLock() ) } NEXT :GetColumn("MARRIED" ):bEncode := {|lx| ! lx } [/pre2] Можно, в дальнейшем, убрать в тсб, где cAls брать из oCol:cArea, т.к. сейчас при LOCK свойстве тсб блокируется \ разблокируется запись oBrw:cAlias
gfilatov2002: SergKis пишет: oCol:cArea позволит связать колонку с полем в базе Понятно, благодарю за разъяснение SergKis пишет: Можно, в дальнейшем, убрать в тсб, где cAls брать из oCol:cArea Тогда ожидаю такую модификацию, если она потребуется...
SergKis: gfilatov2002 пишет Тогда ожидаю такую модификацию Сделал так [pre2] CLASS TSBrowse FROM TControl ... DATA lRecLockArea AS LOGICAL INIT .F. // flag to lock record for oCol:cArea alias ... METHOD PostEdit( uTemp, nCol, bValid ) CLASS TSBrowse ... Local lLockArea, cArea ... bAddRec := If( ! Empty( ::bAddRec ), ::bAddRec, {|| ( cAlias )->( dbAppend() ), ! NetErr() } ) cArea := ::aColumns[ nCol ]:cArea lLockArea := ::lRecLockArea .and. ! Empty( cArea ) .and. Select( cArea ) > 0 If bValid != Nil ... If ::lIsDbf If Eval( If( ! ::lAppendMode, bRecLock, bAddRec ), uTemp ) If lLockArea If ( cArea )->( RLock() ) ::bDataEval( ::aColumns[ nCol ], uTemp, nCol ) EndIf Else ::bDataEval( ::aColumns[ nCol ], uTemp, nCol ) EndIf SysRefresh() ... if !("SQL" $ ::cDriver) ( cAlias )->( DbUnLock() ) endif If lLockArea ( cArea )->( dbUnLock() ) ( cArea )->( DbSkip( 0 ) ) EndIf If lAppend ... [/pre2] Пример проверки тут https://TransFiles.ru/xe6ti
gfilatov2002: SergKis пишет: Сделал так Принято с благодарностью SergKis пишет: Пример проверки Работает отлично Я только добавил :GetColumn("MARRIED" ):nEditMove := DT_DONT_MOVE чтобы не убегал курсор после нажатия Enter на этом поле
SergKis: gfilatov2002 Возможно, будет интересно. Подключил в примерах Tsb_ReportAge и Tsb_SetFieldsTo работу с LetoDbf, работают с одной базой Employee.dbf. Сервер из каталога SAMPLES\Advanced\LetoDbf\SERVER должен быть запущен. Запуск в обоих случаях Demo.exe * На сервер переписывается таблица Employee.dbf, если первым запустить Tsb_ReportAge, то на сервере в таблице будет 1000 записей, если Tsb_SetFieldsTo, то 11000 Tsb_ReportAge тут https://TransFiles.ru/etjm9 Tsb_SetFieldsTo тут https://TransFiles.ru/l8587
gfilatov2002: SergKis пишет: Подключил в примерах Tsb_ReportAge и Tsb_SetFieldsTo работу с LetoDbf Спасибо! Да, примеры работают с сервером при запуске demo.exe * Заметил, что в Tsb_SetFieldsTo количество отобранных записей в подвале правильно обновляется только со второй попытки...
SergKis: gfilatov2002 пишет количество отобранных записей в подвале правильно обновляется только со второй попытки... Добавьте прорисовку подвала [pre2] oBrw:GetColumn("NN"):cFooting := hb_ntos( (cOut)->( OrdKeyCount() ) ) oBrw:DrawFooters() [/pre2]
SergKis: gfilatov2002 Модифицировал пример, добавив справочник STATE.DBF, колонки в тсб набираются смешано с 3х алиасов. Работает запуск и с сервером тоже Пример тут https://TransFiles.ru/xuqt2
SergKis: gfilatov2002 Предлагаю добавить в тсб[pre2] METHOD IsEditable( nCol ) INLINE ::lCellBrw .and. ::aColumns[ nCol ]:lEdit .and. ; ( ::aColumns[ nCol ]:bWhen == Nil .or. Eval( ::aColumns[ nCol ]:bWhen, Self ) ) ACCESS IsEdit INLINE ! Empty( ::aColumns[ ::nCell ]:oEdit ) ... использовать, к примеру, вместо // ON KEY ESCAPE ACTION iif( Empty(oBrw:aColumns[ oBrw:nCell ]:oEdit), _wPost(99), ) ON KEY ESCAPE ACTION iif( oBrw:IsEdit, , _wPost(99) ) [/pre2]
SergKis: PS Добавить параметр[pre2] METHOD LoadFields( lEditable, aColSel, cAlsSel, aNameSel, aHeadSel ) CLASS TSBrowse ... If ValType( ::aHeaders ) == "A" .and. ! Empty( ::aHeaders ) .and. n <= Len( ::aHeaders ) cHeading := ::aHeaders[ n ] Else cHeading := ::Proper( ( cAlias )->( Field( nE ) ) ) EndIf If HB_ISARRAY( aHeadSel ) .and. Len( aHeadSel ) > 0 .and. n <= Len( aHeadSel ) .and. aHeadSel[ n ] != Nil cHeading := aHeadSel[ n ] EndIf ... тогда можно так делать ( удобнее ) :LoadFields(.F., {"REC" }, cOut , {"IDN"}, {"Id"}) :LoadFields(.F., {"STATE"}, cAls ) :LoadFields(.F., {"NAME" }, cAlsS, , {"State name"}) :LoadFields(.T., {"CITY", "STREET", "ZIP", "FIRST", "LAST", "AGE", "MARRIED" }, cAls) AEval(:aColumns, {|oc,nc| oc:lEmptyValToChar := .T., ; oc:lFixLite := .T. }) // :GetColumn("IDN" ):cHeading := "Id" // :GetColumn("NAME"):cHeading := "State name" ... [/pre2]
gfilatov2002: SergKis пишет: Модифицировал пример, добавив справочник STATE.DBF ОК SergKis пишет: Предлагаю добавить в тсб Принято с благодарностью
gfilatov2002: SergKis пишет: ON KEY ESCAPE ACTION iif( oBrw:IsEdit, , _wPost(99) ) Записал эту строку так: ON KEY ESCAPE ACTION iif( oBrw:IsEdit, oBrw:PostMsg( WM_KEYDOWN, VK_ESCAPE, 0 ), _wPost(99) ) Работает нормально
SergKis: gfilatov2002 пишет ON KEY ESCAPE ACTION iif( oBrw:IsEdit, oBrw:PostMsg( WM_KEYDOWN, VK_ESCAPE, 0 ), _wPost(99) Может добавить[pre2] METHOD PostMsg( nMsg, wParam, lParam ) INLINE ::Super:PostMsg( hb_defaultValue(nMsg, WM_KEYDOWN), wParam, hb_defaultValue(lParam, 0) ) Мелочь, но тогда короче писать можно (клавишных сообщений исп. достаточно) ON KEY ESCAPE ACTION iif( oBrw:IsEdit, oBrw:PostMsg(, VK_ESCAPE), _wPost(99) ) [/pre2]
gfilatov2002: SergKis пишет: Может добавить Нет, на мой взгляд такой синтаксис oBrw:PostMsg( WM_KEYDOWN, VK_ESCAPE, 0 ) нагляднее В противном случае, надо помнить, что сообщение WM_KEYDOWN используется по умолчанию (и не забыть поставить запятую перед VK_ESCAPE), но ведь есть и другие сообщения
SergKis: gfilatov2002 пишет такой синтаксис нагляднее Согласен Хотелось покороче писать, к примеру, методами oBrw:PostKeyDown( VK_ESCAPE ) oBrw:PostKeyUp( VK_ESCAPE ) но короче не получается, а вот последний параметр можно не задавать. oBrw:PostMsg( WM_KEYDOWN, VK_ESCAPE, 0 )
Andrey: Всем привет ! Вопрос возник, а почему в ресурсах МиниГуи нет иконки самого МиниГуи - официальной ? Примеры тестовые делать можно было бы с официальной иконкой, а то и не знаешь какой вариант использовать. И второй вопрос, почему нет в ядре МиниГуи функции _ShowContextMenu() ? Замучился таскать её в проекты, частенько использую для тестовых проектов. Григорий, добавь пожалуйста эту функцию в ядро.
gfilatov2002: Andrey пишет: Вопрос возник, а почему в ресурсах МиниГуи нет иконки самого МиниГуи - официальной ? Спасибо за вопрос Дело в том, что в разное время были разные иконки, а сейчас - такая, как на моей аватарке. Поэтому проще просто поместить эту иконку в папку с примером и подключать ее из файла, а не из ресурсов Andrey пишет: второй вопрос, почему нет в ядре МиниГуи функции _ShowContextMenu() ? Потому, что эта функция не доработана до конца (в частности, режим центрирования).
Andrey: gfilatov2002 пишет: Потому, что эта функция не доработана до конца (в частности, режим центрирования). Доработайте пожалуйста и включите, нужна очень. Вроде нормально работает в приложениях, нормально центрируется.
gfilatov2002: Andrey пишет: включите, нужна очень Добавил эту функцию в новую сборку 19.08
Andrey: gfilatov2002 пишет: Добавил эту функцию в новую сборку 19.08 Спасибо ! Выслал примеры по Tsbrowse с карточкой + блокировка записей на почту. Вопрос возник по Tab. Показываю окно с Tab карточкой юзеру. На медленных компах видно как этот Tab дергается, т.е. на Tab вывожу объекты Label и GetBox. Там их много, порядка 150 объектов. Вот и дергается Tab. Можно как то это "дерганье" убрать ?
SergKis: gfilatov2002 Предложение по растяжке предпоследней колонки показа, если последняя не помещается в размер тсб, при горизонтальном скроллинге колонок.[pre2] CLASS TSBrowse FROM TControl ... DATA lAdjColumn AS LOGICAL INIT .F. // column expands to flush table window right ... METHOD GetDeltaLen( nCol, nStartCol, nMaxWidth, aColSizes ) CLASS TSBrowse Local nDeltaLen := 0 If ::lAdjColumn .and. nCol < Len( ::aColumns ) If ( nStartCol + aColSizes[ nCol ] + aColSizes[ nCol + 1 ] ) > nMaxWidth nDeltaLen := nMaxWidth - ( nStartCol + aColSizes[ nCol ] ) EndIf EndIf RETURN nDeltaLen ... METHOD DrawHeaders( lFooters ) CLASS TSBrowse ... Local nDeltaLen ... For nI := nBegin To nLastCol If nStartCol >= nMaxWidth Exit EndIf nJ := If( nI < ::nColPos, nJ + 1, nI ) oColumn := If( nJ > Len( ::aColumns ), ::oPhant, ::aColumns[ nJ ] ) nDeltaLen := ::GetDeltaLen( nJ, nStartCol, nMaxWidth, aColSizes ) ... TSDrawCell( hWnd, ; // 1 hDC, ; // 2 0, ; // 3 nStartCol, ; // 4 aColSizes[ nJ ] + nDeltaLen, ; // 5 ... IF ::lDrawSpecHd ... TSDrawCell( hWnd, ; // 1 hDC, ; // 2 0, ; // 3 nStartCol, ; // 4 aColSizes[nJ] + nDeltaLen, ; // 5 ... If ::lFooting .and. ::lDrawFooters ... TSDrawCell( hWnd, ; // 1 hDC, ; // 2 ::nRowCount(), ; // 3 nStartCol, ; // 4 aColSizes[nJ] + nDeltaLen, ; // 5 ... EndIf nStartCol += aColSizes[nJ] + nDeltaLen Next Return Self ... METHOD DrawLine( xRow ) CLASS TSBrowse ... Local nDeltaLen ... For nI := nBegin To nLastCol If nStartCol >= nMaxWidth Exit EndIf nJ := If( nI < ::nColPos, nJ + 1, nI ) lSelected := If( nJ == nLastCol, .F., lSelected ) nLineStyle := ::nLineStyle oColumn := If( nJ > Len( ::aColumns ), ::oPhant, ::aColumns[ nJ ] ) nDeltaLen := ::GetDeltaLen( nJ, nStartCol, nMaxWidth, aColSizes ) ... TSDrawCell( hWnd, ; // 1 hDC, ; // 2 xRow, ; // 3 nStartCol , ; // 4 aColSizes[ nJ ] + nDeltaLen, ; // 5 ... nStartCol += aColSizes[ nJ ] + nDeltaLen Next EndIf Return Self ... METHOD DrawSelect( xRow ) CLASS TSBrowse ... Local nDeltaLen ... For nI := nBegin To nLastCol If nStartCol >= nMaxWidth Exit EndIf nJ := If( nI < ::nColPos, nJ + 1, nI ) oColumn := If( nJ > Len( ::aColumns ), ::oPhant, ::aColumns[ nJ ] ) nLineStyle := ::nLineStyle nDeltaLen := ::GetDeltaLen( nJ, nStartCol, nMaxWidth, aColSizes ) ... TSDrawCell( hWnd, ; // 1 hDC, ; // 2 nRowPos, ; // 3 nStartCol, ; // 4 aColSizes[ nJ ] + nDeltaLen, ; // 5 ... !(::lCellBrw .and. nJ != ::nCell) ) // 32 Invert color nStartCol += aColSizes[ nJ ] + nDeltaLen Next EndIf ... [/pre2] SuperHeader не поддерживает, надо править расчет. Пример проверки тут https://TransFiles.ru/34r31
SergKis: PS Для работы корректировки надо[pre2] CLASS TSColumn ... DATA nEditWidth AS NUMERIC // DATA nEditMove AS NUMERIC // post editing cursor movement ... METHOD DrawSelect( xRow ) CLASS TSBrowse ... EndIf oColumn:nEditWidth := 0 If nDeltaLen > 0 oColumn:nEditWidth := aColSizes[ nJ ] + nDeltaLen EndIf TSDrawCell( hWnd, ; // 1 ... METHOD Edit( uVar, nCell, nKey, nKeyFlags, cPicture, bValid, nClrFore, ; nClrBack ) CLASS TSBrowse ... EndIf If oCol:nEditWidth > 0 nWidth := oCol:nEditWidth If ! ::lNoVScroll nWidth -= GetVScrollBarWidth() EndIf EndIf If oCol:cResName != Nil .or. oCol:lBtnGet ... [/pre2] В примере ON KEY ESCAPE ACTION iif( oBrw:IsEdit, oBrw:PostMsg(WM_KEYDOWN, VK_ESCAPE), _wPost(99) ) END WINDOW ... FUNCTION Brw2Fld( nY, nX, nW, nH, cBrw, aColor ) ... :LoadFields(.T.) ...
gfilatov2002: SergKis пишет: Для работы корректировки Принято с благодарностью Проверил на Вашем примере - работает
SergKis: gfilatov2002 Добавил в пример проверку работы метода :GetCellinfo(...). На кл. F3 в Footer колонки вкл. GetBox для ввода Пример https://TransFiles.ru/958i8
gfilatov2002: SergKis пишет: проверку работы метода :GetCellinfo(...) По-видимому, были еще внесены изменения в код, поскольку у меня этот метод так красиво не отрабатывает, как в Вашем откомпилированном примере. Что-то я потерял в этих модификациях
gfilatov2002: P.S. Понял, что надо изменить метод :GetCellinfo(...) также, как и метод Edit(). Сейчас Ваш пример у меня работает нормально Благодарю за помощь
SergKis: gfilatov2002 пишет По-видимому, были еще внесены изменения в код Отвлекли на другое и забыл об изменениях внесенных в :GetCellInfo, извините. У меня они такие[pre2] METHOD GetCellInfo( nRowPos, nCell, lColSpecHd ) CLASS TSBrowse ... endif If oCol:nEditWidth > 0 nWidth := oCol:nEditWidth If ! ::lNoVScroll nWidth -= GetVScrollBarWidth() EndIf EndIf nRow += ::aEditCellAdjust[1] nCol += ::aEditCellAdjust[2] nWidth += ::aEditCellAdjust[3] + 2 nHeight += ::aEditCellAdjust[4] ... [/pre2]
gfilatov2002: SergKis пишет: У меня они такие METHOD GetCellInfo( nRowPos, nCell, lColSpecHd ) CLASS TSBrowse Аналогично Благодарю за подтверждение
SergKis: gfilatov2002 Правка (тогда :lNoHScroll := .F.\.T. работает правильно)[pre2] METHOD SetNoHoles( nDelta, lSet ) CLASS TSBrowse ... nHole := _GetClientRect( ::hWnd )[ 4 ] - ; ::nHeightHead - ::nHeightSuper - ; ::nHeightFoot - ::nHeightSpecHd //- ; // If( ::lNoHScroll, 0, GetHScrollBarHeight() ) ... и METHOD GetCellInfo( nRowPos, nCell, lColSpecHd ) CLASS TSBrowse ... Local lHead := .F. Local lFoot := .F. If HB_ISLOGICAL( nRowPos ) If nRowPos ; lHead := .T. Else ; lFoot := .T. EndIf nRowPos := NIL lColSpecHd := .F. EndIf ... endif If lHead nRow := ::nHeightSuper + If( oCol:l3DLook, 2, 0 ) + 1 nHeight := ::nHeightHead ElseIf lFoot nRow := _GetClientRect( ::hWnd )[4] - ::nHeightFoot + 1 nHeight := ::nHeightFoot EndIf ix := GetControlIndex ( cBrw, cForm ) if _HMG_aControlContainerRow [ix] == -1 ... тогда в примере сделать DEFINE TOOLBAR ToolBar_3 CAPTION "" BUTTONSIZE 42,32 FLAT BUTTON 99 CAPTION 'Exit' PICTURE 'exit' ACTION _PushKey(VK_ESCAPE) END TOOLBAR ... oBrw:UserKeys(VK_F3, {|ob| _wPost(3, ob, ob) }) oBrw:UserKeys(VK_F4, {|ob| _wPost(4, ob, ob) }) (This.Object):Event( 3, {|ot,oi,ob,y,x,w,h,cn| cn := ot:Name, ; oi := ob:GetCellinfo(.T., ob:nCell), ; // Header y := oi:nRow, ; x := oi:nCol, ; w := oi:nWidth, ; h := ob:nHeightFoot, ; This.MyFoot.Row := y, ; This.MyFoot.Col := x, ; This.MyFoot.Width := w, ; This.MyFoot.Height := h, ; This.MyFoot.Show, DoEvents(), ; This.MyFoot.SetFocus } ) (This.Object):Event( 4, {|ot,oi,ob,y,x,w,h,cn| cn := ot:Name, ; oi := ob:GetCellinfo(.F., ob:nCell), ; // Footer y := oi:nRow, ; x := oi:nCol, ; w := oi:nWidth, ; h := ob:nHeightFoot, ; This.MyFoot.Row := y, ; This.MyFoot.Col := x, ; This.MyFoot.Width := w, ; This.MyFoot.Height := h, ; This.MyFoot.Show, DoEvents(), ; This.MyFoot.SetFocus } ) ... [/pre2]
gfilatov2002: SergKis пишет: Правка (тогда :lNoHScroll := .F.\.T. работает правильно) Благодарю за исправление
SergKis: gfilatov2002 Предложение [pre2] HB_FUNC( TSDRAWCELL ) ... int iTxtW = 0; BOOL bDraw = FALSE; memset( &bm, 0, sizeof( BITMAP ) ); ... if( lCursor ) cDrawCursor( hWnd, &rct, lCursor, clrFore ); } bDraw = TRUE; } DeleteObject( hGrayPen ); DeleteObject( hWhitePen ); hb_retl( bDraw ); ... CLASS TSBrowse FROM TControl ... DATA aDrawCols AS ARRAY INIT {} // list of columns in display ... METHOD DrawSelect( xRow ) CLASS TSBrowse ... Local nDeltaLen, lDraw := .F. Default xRow := nRowPos ::nPaintRow := xRow ::aDrawCols := {} If Empty( ::aColumns ) ... If nDeltaLen > 0 oColumn:nEditWidth := aColSizes[ nJ ] + nDeltaLen EndIf lDraw := TSDrawCell( hWnd, ; // 1 ... nStartCol += aColSizes[ nJ ] + nDeltaLen If lDraw AAdd( ::aDrawCols, nJ ) EndIf Next ... [/pre2]
SergKis: PS В примере получим список колонок в отображении[pre2] oBrw:UserKeys(VK_F5, {|ob| _wPost(5, ob, ob) }) ... (This.Object):Event( 5, {|ot,oi,ob| _LogFile(.T., hb_valtoexp(ob:aDrawCols)) }) ... [/pre2]
gfilatov2002: SergKis пишет: Предложение Сергей, Добавить эти изменения можно без проблем, но только использовать их - в целях отладки. Или я что-то упустил
SergKis: gfilatov2002 пишет Добавить эти изменения можно без проблем, но только использовать их - в целях отладки Сейчас трудно понять список колонок, которые проходят в методах прорисовки :Draw...(), т.к. определяется реально в функции TSDrawCell(...) по nStartCol и размером тсб GetClientRect( hWnd, &rct ), что затрудняет переделать :DrawSuper к примеру, т.к. там пляшет от ::aColSizes и aColSizes, понять мне не удалось, есть значения не совпадающие ни oCol:nWidth, oCol:nEditWidth и нет ясности в списке колонок. Для начала на :aDrawCols сделать прорисовку :DrawSuper() для режима :ladjColumn := .T. Может еще где пригодится
gfilatov2002: SergKis пишет: на :aDrawCols сделать прорисовку :DrawSuper() для режима :ladjColumn := .T. Понял, уже добавляю... Благодарю за разъяснение
SergKis: gfilatov2002 Что то получилось с :DrawSuper(). Изменения [pre2] METHOD DrawSelect( xRow, lDrawCell ) CLASS TSBrowse ... Local nDeltaLen, lDraw := .F. Default xRow := nRowPos, lDrawCell := .T. ... If lDrawCell lDraw := TSDrawCell( hWnd, ; // 1 ... !(::lCellBrw .and. nJ != ::nCell) ) // 32 Invert color Else lDraw := .T. EndIf nStartCol += aColSizes[ nJ ] + nDeltaLen ... METHOD DrawSuper() CLASS TSBrowse Local nI, nJ, nBegin, nStartCol, l3DLook, nClrFore, lAdjBmp, nClrTo, lOpaque, nClrBack, hFont, cHeading, hBitMap, ; lMulti, nHAlign, nVAlign, nWidth, nS, nLineStyle, lBrush, ; nMaxWidth := ::nWidth() , ; aColSizes := AClone( ::aColSizes ), ; // use local copies for speed aSuperHead := AClone( ::aSuperHead ), ; nHeightHead := ::nHeightHead, ; nHeightFoot := ::nHeightFoot, ; nHeightSuper := ::nHeightSuper, ; nHeightSpecHd:= ::nHeightSpecHd Local hWnd := ::hWnd, ; hDC := ::hDc, ; nClrText := ::nClrText, ; nClrPane := ::nClrPane, ; nClrLine := ::nClrLine Local l3DText, nClr3dL, nClr3dS Local oCol, aDrawCols If Empty( ::aColumns ) Return Nil EndIf ::DrawSelect( , .F. ) ; aDrawCols := ::aDrawCols // create current draw columns array nClrFore := ::nForeSupHdGet( 1, aSuperHead ) nClrBack := ::nBackSupHdGet( 1, aSuperHead ) l3DLook := aSuperHead[ 1, 6 ] hFont := ::hFontSupHdGet( 1, aSuperHead ) nLineStyle := aSuperHead[ 1, 10 ] nClrLine := aSuperHead[ 1, 11 ] nBegin := nI := 1 While nI <= Len( aSuperHead ) If aSuperHead[ nI, 1 ] > nBegin nJ := aSuperHead[ nI, 1 ] - 1 ASize( aSuperHead, Len( aSuperHead ) + 1 ) AIns( aSuperHead, nI ) aSuperHead[ nI ] := { nBegin, nJ, "", nClrFore, nClrBack, l3DLook , hFont, .F., .F., nLineStyle, ; nClrLine, 1, 1, .F. } nBegin := nJ + 1 Else nBegin := aSuperHead[ nI++, 2 ] + 1 EndIf EndDo nI := Len( aSuperHead ) nClrFore := ::nForeSupHdGet( nI, aSuperHead ) nClrBack := ::nBackSupHdGet( nI, aSuperHead ) l3DLook := aSuperHead[ nI, 6 ] hFont := ::hFontSupHdGet( nI, aSuperHead ) nLineStyle := aSuperHead[ nI, 10 ] nClrLine := aSuperHead[ nI, 11 ] If ( nI := ATail( aSuperHead )[ 2 ] ) < Len( ::aColumns ) AAdd( aSuperHead, { nI + 1, Len( ::aColumns ), "", nClrFore, nClrBack, l3DLook, hFont, .F., .F., nLineStyle, ; nClrLine, 1, 1, .F. } ) EndIf nStartCol := nWidth := 0 If ::lAdjColumn nS := 1 FOR nI := 1 TO Len( ::aColumns ) oCol := ::aColumns[ nI ] If oCol:nEditWidth > 0 aColSizes[ nI ] := oCol:nEditWidth - iif( ::lNoVScroll, GetVScrollBarWidth(), 0 ) Else aColSizes[ nI ] := oCol:nWidth EndIf NEXT For nI := 1 To Len( aSuperHead ) For nJ := aSuperHead[ nI, 1 ] To aSuperHead[ nI, 2 ] If nI == 1 .and. AScan(aDrawCols, nJ) > 0 nWidth += aColSizes[ nJ ] EndIf Next Next Else nBegin := If( ::nColPos == ::nFreeze + 1, ::nColPos - ::nFreeze, ::nColPos ) For nS := 1 To Len( aSuperHead ) If nBegin >= aSuperHead[ nS, 1 ] .and. nBegin <= aSuperHead[ nS, 2 ] Do Case Case nBegin > aSuperHead[ nS, 1 ] .and. nS == 1 For nJ := aSuperHead[ nS, 1 ] To nBegin - 1 nStartCol -= ::aColSizes[ nJ ] Next For nJ := aSuperHead[ nS, 1 ] To aSuperHead[ nS, 2 ] nWidth += aColSizes[ nJ ] Next Case nBegin > aSuperHead[ nS, 1 ] .and. nS > 1 For nJ := 1 To ::nFreeze nStartCol += ::aColSizes[ nJ ] Next For nJ := nBegin To aSuperHead[ nS, 2 ] nWidth += aColSizes[ nJ ] Next OtherWise If nBegin > 1 For nJ := 1 To ::nFreeze nStartCol += ::aColSizes[ nJ ] Next EndIf For nJ := aSuperHead[ nS, 1 ] To aSuperHead[ nS, 2 ] nWidth += aColSizes[ nJ ] Next EndCase Exit EndIf Next EndIf For nI := nS To Len( aSuperHead ) + 1 If nStartCol > nMaxWidth Exit EndIf If nI <= Len( aSuperHead ) nClrFore := ::nForeSupHdGet( nI, aSuperHead ) nClrBack := ::nBackSupHdGet( nI, aSuperHead ) lBrush := Valtype( nClrBack ) == "O" If ValType( nClrBack ) == "A" nClrBack := ::nClrBackArr( nClrBack, nI ) nClrTo := nClrBack[ 2 ] nClrBack := nClrBack[ 1 ] Else nClrTo := nClrBack EndIf cHeading := ::cTextSupHdGet( nI, aSuperHead ) lMulti := Valtype( cHeading ) == "C" .and. At( Chr( 13 ), cHeading ) > 0 l3DLook := aSuperHead[ nI, 6 ] hFont := ::hFontSupHdGet( nI, aSuperHead ) hBitMap := aSuperHead[ nI, 8 ] hBitMap := If( ValType( hBitMap ) == "B", Eval( hBitMap ), hBitMap ) hBitMap := If( ValType( hBitMap ) == "O", Eval( ::bBitMapH, hBitMap ), hBitMap ) lAdjBmp := aSuperHead[ nI, 9 ] nLineStyle := aSuperHead[ nI, 10 ] nClrLine := aSuperHead[ nI, 11 ] nHAlign := aSuperHead[ nI, 12 ] nVAlign := aSuperHead[ nI, 13 ] lOpaque := aSuperHead[ nI, 14 ] Default hBitMap := 0, ; lOpaque := .T. lOpaque := ! lOpaque Else cHeading := "" nWidth := ::nPhantom hBitmap := 0 lOpaque := .F. nClrBack := If( ::nPhantom == -2, nClrPane, Atail( aSuperHead)[ 5 ] ) nClrBack := ::GetValProp( nClrBack, nClrBack, nI ) If ValType( nClrBack ) == "A" nClrBack := ::nClrBackArr( nClrBack, nI ) nClrTo := nClrBack[ 2 ] nClrBack := nClrBack[ 1 ] Else nClrTo := nClrBack endif EndIf If nI <= Len( aSuperHead ) .and. ::aColumns[ aSuperHead[ nI, 1 ] ]:l3DTextHead != Nil l3DText := ::aColumns[ aSuperHead[ nI, 1 ] ]:l3DTextHead nClr3dL := ::aColumns[ aSuperHead[ nI, 1 ] ]:nClr3DLHead nClr3dS := ::aColumns[ aSuperHead[ nI, 1 ] ]:nClr3DSHead nClr3dL := If( ValType( nClr3dL ) == "B", Eval( nClr3dL, 0, nStartCol ), nClr3dL ) nClr3dS := If( ValType( nClr3dS ) == "B", Eval( nClr3dS, 0, nStartCol ), nClr3dS ) Else l3DText := nClr3dL := nClr3dS := Nil EndIf TSDrawCell( hWnd, ; // 1 hDC, ; // 2 0, ; // 3 nStartCol, ; // 4 nWidth, ; // 5 cHeading, ; // 6 nHAlign, ; // 7 nClrFore, ; // 8 nClrBack, ; // 9 hFont, ; // 10 hBitMap, ; // 11 nHeightHead, ; // 12 l3DLook, ; // 13 nLineStyle, ; // 14 nClrLine, ; // 15 3, ; // 16 1=Header 2=Footer 3=Super nHeightHead, ; // 17 nHeightFoot, ; // 18 nHeightSuper, ; // 19 nHeightSpecHd, ; // 20 lAdjBmp, ; // 21 lMulTi, ; // 22 Multiline text nVAlign, ; // 23 0, ; // 24 nVertLine nClrTo, ; // 25 lOpaque, ; // 26 If( lBrush, ; nClrBack:hBrush, 0 ), ; // 27 l3DText, ; // 28 3D text nClr3dL, ; // 29 3D text light color nClr3dS ) // 30 3D text shadow color nStartCol += nWidth nWidth := 0 If nI < Len( aSuperHead ) For nJ := aSuperHead[ nI + 1, 1 ] To aSuperHead[ nI + 1, 2 ] If ::lAdjColumn If AScan(aDrawCols, nJ) > 0 nWidth += aColSizes[ nJ ] EndIf Else nWidth += aColSizes[ nJ ] EndIf Next EndIf Next Return Nil ... [/pre2] Пример тут https://TransFiles.ru/qjle1 Работает и пример из Advanced\TsBrowse\sbsuperh.prg (с выделенной строкой и без нее)[pre2] MENUITEM "Super Columns" ACTION fSuperCol() ... Function fSuperCol() ... DEFINE TBROWSE oBrw AT 0,0 ALIAS "Products" CELLED ; WIDTH 490 HEIGHT 350 ; COLORS {CLR_BLACK, CLR_NBLUE} ; oBrw:nFreeze := 2 oBrw:nHeightCell += 1 oBrw:SetAppendMode( .T. ) oBrw:SetDeleteMode( .T., .T.) oBrw:lAdjColumn := .T. [/pre2]
gfilatov2002: SergKis пишет: получилось с :DrawSuper() Благодарю за все Ваши усилия Возможно, переменная lAdjColumn д.б. установлена в .T. по умолчанию
SergKis: gfilatov2002 пишет Возможно, переменная lAdjColumn д.б. установлена в .T. по умолчанию Конфликта с :AdjColumns() быть не должно, это для работы - ширина всех колонок < ширины тсб, :lAdjColumn := .T. имеет смысл, если ширина всех колонок > ширины тсб, при этом сменится (от old версии) показ колонок. Как реагировать пользователи будут ? Можно попробовать поставить :lAdjColumn := .T.
gfilatov2002: SergKis пишет: :lAdjColumn := .T. имеет смысл, если ширина всех колонок > ширины тсб Понятно SergKis пишет: при этом сменится (от old версии) показ колонок. Как реагировать пользователи будут ? Думаю, будут реагировать негативно... Поэтому оставил по умолчанию :lAdjColumn := .F., как и было предложено изначально
gfilatov2002: Опубликована новая сборка 19.08 для BCC 5.5.1 и компиляторов Harbour и xHarbour. Базовый дистрибутив находится по адресу http://hmgextended.com/files/CONTRIB/hmg-19.08-setup.exe Также имеются дополнительные сборки для следующих Си-компиляторов: - MinGW 9.1.1 32-bit для Harbour 3.2.0dev; (есть в наличии) - MinGW 9.2.1 32-bit для Harbour 3.2.0dev; (под заказ) - MinGW 8.2.0 64-bit для Harbour 3.4.0dev; (есть в наличии) - MS VisualC 2019 32-bit для Harbour 3.2.0dev; (под заказ) - MS VisualC 2019 64-bit для Harbour 3.2.0dev; (под заказ) - Pelles C 8.0 32-bit для xHarbour b10253; (под заказ) - Pelles C 9.0 64-bit для xHarbour b10253; (под заказ) - Borland/Embarcadero C++ 7.4 (32-bit) для Harbour 3.2.0dev; (под заказ) - Open Watcom C/C++ 2.0 (32-bit) для Harbour 3.2.0dev. (под заказ) Благодарю за Ваше внимание и поддержку
Andrey: Поставил новую версию. Начал просматривать примеры. При запуске - вылет: Application: C:\MiniGUI\SAMPLES\Advanced\Tsb_menu\demo.exe Time from start: 0 days 0 hours 0 mins 0 secs Error MGERROR/0 Window: unrecognized property 'TS_OB1'. Program terminated. --------------------------------- Stack Trace --------------------------------- Called from MSGMINIGUIERROR(100) in module: h_error.prg Called from SETPROPERTY(3952) in module: h_controlmisc.prg Called from TSMENU(127) in module: p_menu.prg Called from (b)MAIN(246) in module: demo.prg Called from _PROCESSINITPROCEDURE(1674) in module: h_windows.prg Called from _ACTIVATEWINDOW(1489) in module: h_windows.prg Called from MAIN(254) in module: demo.prg
gfilatov2002: Andrey Благодарю за сообщение Уже поправил с помощью "тихого" апдейта
Andrey: gfilatov2002 пишет: - MS VisualC 2019 32-bit для Harbour 3.2.0dev; (под заказ) - MS VisualC 2019 64-bit для Harbour 3.2.0dev; (под заказ) Как получить сборку под этот компилятор ?
gfilatov2002: Andrey пишет: Как получить сборку под этот компилятор ? Отправил ссылки в личку (см. Л.С.)
gfilatov2002: Обновил сборку 19.08 (Update 1) с учетом последних наработок Базовый дистрибутив находится по адресу http://hmgextended.com/files/CONTRIB/hmg-19.08-setup.exe Что нового: [pre2] * Enhanced: Added possibility to modify of 'OnDblClick' event for the LABEL and IMAGE controls at run-time with: - function syntax: SetProperty(Form,Control,'OnDblClick',{|| MsgInfo('New action')}) - pseudo-OOP syntax: Form.Control.OnDblClick := {|| MsgInfo('New action')} Contributed by Grigory Filatov <gfilatov@inbox.ru> (see demo in folder \samples\Advanced\MP3Info) * Enhanced: Added possibility of in-line usage of the commands [DE]ACTIVATE TIMER <name> OF <parent> for the Timer control. Contributed by Grigory Filatov <gfilatov@inbox.ru> (see demo in folder \samples\Advanced\MP3Info) * Updated: HbSQLite3 library: - update for using SQLITE3 version 3.30.0dev (from 3.29.0). Contributed by Grigory Filatov <gfilatov@inbox.ru> * New: 'MP3 Info Class Test' sample. Based upon a contribution of Victor Daniel Cuatecatl Leon for FiveWin library. Adapted for Minigui Extended by Grigory Filatov <gfilatov@inbox.ru> (see in folder \samples\Advanced\TestMP3Info) * Updated: 'Replacement for Clipper ALERT() function' sample: - New: using of the codeblock bOnInit in the Alert* functions. Contributed by Grigory Filatov <gfilatov@inbox.ru> (see in folder \samples\Basic\WALERT_2) * Updated: 'DOS-like menu with using of TsBrowse' sample. - updated for the recent changes in Minigui core. Problem was reported by Verchenko Andrey. (see in folder \samples\Advanced\Tsb_menu) [/pre2]
Andrey: Пере собрал некоторые программы ! Полёт нормальный ! Вопрос по COMBOBOXEX возник. А нельзя увеличить ту часть со стрелкой вниз ? А то её через микроскоп разглядывать нужно. Взять стрелку с вертикального скролинга и повесить вместо этого значка. Юзера слёзно просят увеличить.
gfilatov2002: Обновил сборку 19.08 (Update 2) с учетом последних наработок Базовый дистрибутив находится по адресу http://hmgextended.com/files/CONTRIB/hmg-19.08-setup.exe Что нового: [pre2] * New: Added the useful pseudo-function HMG_TimeMS( TS1 [, TS2] ) for calculation of an elapsed time in the milliseconds. Sample code: #include "minigui.ch" STATIC s_tStartTime INIT PROCEDURE OnStartup() s_tStartTime := hb_DateTime() RETURN PROCEDURE main() hb_idleSleep(.1) RETURN EXIT PROCEDURE OnExit() ? "You used this program by", HMG_TimeMS( s_tStartTime ) RETURN Suggested and contributed by Sergej Kiselev. * Updated: HbSQLite3 library: - update for using SQLITE3 latest version 3.30.0dev. Contributed by Grigory Filatov <gfilatov@inbox.ru> * New: 'HMG Misc' sample. Borrowed from HMG 4 project. Adapted by Grigory Filatov <gfilatov@inbox.ru> (see in folder \samples\Basic\Misc) * New: 'OrdWildSeek() Test' sample. Note: Harbour has this function in core without documentation. Based upon a contribution of Mario Mansilla and Pete D. (see in folder \samples\Basic\OrdWildSeek) * New: 'PE Test' sample. Contributed by Pierpaolo Martinello <pier.martinello[at]alice.it> (see in folder \samples\Advanced\PE_Test) * Updated: 'Multi Instance' sample: - updated for the recent changes in Minigui core. Contributed by Grigory Filatov <gfilatov@inbox.ru> (see in folder \samples\Basic\MULTI_INSTANCE) * Updated: 'MiniGUI DataBase Utility' sample: - updated a memo field editing with using of the function InputBox(). Suggested by Pierpaolo Martinello <pier.martinello[at]alice.it>. Contributed by Grigory Filatov <gfilatov@inbox.ru> (see in folder \Utils\mgDBU) [/pre2] Благодарю за Ваше внимание и поддержку
Avf: Что изменилось в последних версиях, что при трансляции старых программ появилось это : Error: Unresolved external '_HB_FUN_WIN_OSVERSIONINFO' referenced from C:\MINIGUI\HARBOUR\LIB\XHB.LIB|xwin_ver Error: Unresolved external '_HB_FUN_WIN_OSISNT' referenced from C:\MINIGUI\HARBOUR\LIB\XHB.LIB|xwin_ver Error: Unresolved external '_HB_FUN_WIN_OSISNT351' referenced from C:\MINIGUI\HARBOUR\LIB\XHB.LIB|xwin_ver Error: Unresolved external '_HB_FUN_WIN_OSISNT4' referenced from C:\MINIGUI\HARBOUR\LIB\XHB.LIB|xwin_ver Error: Unresolved external '_HB_FUN_WIN_OSIS2000ORUPPER' referenced from C:\MINIGUI\HARBOUR\LIB\XHB.LIB|xwin_ver Error: Unresolved external '_HB_FUN_WIN_OSIS2000' referenced from C:\MINIGUI\HARBOUR\LIB\XHB.LIB|xwin_ver Error: Unresolved external '_HB_FUN_WIN_OSISXP' referenced from C:\MINIGUI\HARBOUR\LIB\XHB.LIB|xwin_ver Error: Unresolved external '_HB_FUN_WIN_OSISWINXPORUPPER' referenced from C:\MINIGUI\HARBOUR\LIB\XHB.LIB|xwin_ver Error: Unresolved external '_HB_FUN_WIN_OSIS2003' referenced from C:\MINIGUI\HARBOUR\LIB\XHB.LIB|xwin_ver Error: Unresolved external '_HB_FUN_WIN_OSISVISTA' referenced from C:\MINIGUI\HARBOUR\LIB\XHB.LIB|xwin_ver Error: Unresolved external '_HB_FUN_WIN_OSISVISTAORUPPER' referenced from C:\MINIGUI\HARBOUR\LIB\XHB.LIB|xwin_ver Error: Unresolved external '_HB_FUN_WIN_OSIS7' referenced from C:\MINIGUI\HARBOUR\LIB\XHB.LIB|xwin_ver Error: Unresolved external '_HB_FUN_WIN_OSIS8' referenced from C:\MINIGUI\HARBOUR\LIB\XHB.LIB|xwin_ver Error: Unresolved external '_HB_FUN_WIN_OSIS9X' referenced from C:\MINIGUI\HARBOUR\LIB\XHB.LIB|xwin_ver Error: Unresolved external '_HB_FUN_WIN_OSIS95' referenced from C:\MINIGUI\HARBOUR\LIB\XHB.LIB|xwin_ver Error: Unresolved external '_HB_FUN_WIN_OSIS98' referenced from C:\MINIGUI\HARBOUR\LIB\XHB.LIB|xwin_ver Error: Unresolved external '_HB_FUN_WIN_OSISME' referenced from C:\MINIGUI\HARBOUR\LIB\XHB.LIB|xwin_ver Error: Unresolved external '_HB_FUN_WIN_OSISTSCLIENT' referenced from C:\MINIGUI\HARBOUR\LIB\XHB.LIB|xwin_ver Error: Unresolved external '_HB_FUN_WIN_OSNETREGOK' referenced from C:\MINIGUI\HARBOUR\LIB\XHB.LIB|xwin_ver Error: Unresolved external '_HB_FUN_WIN_OSNETVREDIROK' referenced from C:\MINIGUI\HARBOUR\LIB\XHB.LIB|xwin_ver
gfilatov2002: Avf пишет: Error: Unresolved external '_HB_FUN_WIN_OSVERSIONINFO' referenced from C:\MINIGUI\HARBOUR\LIB\XHB.LIB|xwin_ver Error: Unresolved external '_HB_FUN_WIN_OSISNT' referenced from C:\MINIGUI\HARBOUR\LIB\XHB.LIB|xwin_ver Error: Unresolved external '_HB_FUN_WIN_OSISNT351' referenced from C:\MINIGUI\HARBOUR\LIB\XHB.LIB|xwin_ver Error: Unresolved external '_HB_FUN_WIN_OSISNT4' referenced from C:\MINIGUI\HARBOUR\LIB\XHB.LIB|xwin_ver Error: Unresolved external '_HB_FUN_WIN_OSIS2000ORUPPER' referenced from C:\MINIGUI\HARBOUR\LIB\XHB.LIB|xwin_ver Error: Unresolved external '_HB_FUN_WIN_OSIS2000' referenced from C:\MINIGUI\HARBOUR\LIB\XHB.LIB|xwin_ver Error: Unresolved external '_HB_FUN_WIN_OSISXP' referenced from C:\MINIGUI\HARBOUR\LIB\XHB.LIB|xwin_ver Error: Unresolved external '_HB_FUN_WIN_OSISWINXPORUPPER' referenced from C:\MINIGUI\HARBOUR\LIB\XHB.LIB|xwin_ver Error: Unresolved external '_HB_FUN_WIN_OSIS2003' referenced from C:\MINIGUI\HARBOUR\LIB\XHB.LIB|xwin_ver Error: Unresolved external '_HB_FUN_WIN_OSISVISTA' referenced from C:\MINIGUI\HARBOUR\LIB\XHB.LIB|xwin_ver Error: Unresolved external '_HB_FUN_WIN_OSISVISTAORUPPER' referenced from C:\MINIGUI\HARBOUR\LIB\XHB.LIB|xwin_ver Error: Unresolved external '_HB_FUN_WIN_OSIS7' referenced from C:\MINIGUI\HARBOUR\LIB\XHB.LIB|xwin_ver Error: Unresolved external '_HB_FUN_WIN_OSIS8' referenced from C:\MINIGUI\HARBOUR\LIB\XHB.LIB|xwin_ver Error: Unresolved external '_HB_FUN_WIN_OSIS9X' referenced from C:\MINIGUI\HARBOUR\LIB\XHB.LIB|xwin_ver Error: Unresolved external '_HB_FUN_WIN_OSIS95' referenced from C:\MINIGUI\HARBOUR\LIB\XHB.LIB|xwin_ver Error: Unresolved external '_HB_FUN_WIN_OSIS98' referenced from C:\MINIGUI\HARBOUR\LIB\XHB.LIB|xwin_ver Error: Unresolved external '_HB_FUN_WIN_OSISME' referenced from C:\MINIGUI\HARBOUR\LIB\XHB.LIB|xwin_ver Error: Unresolved external '_HB_FUN_WIN_OSISTSCLIENT' referenced from C:\MINIGUI\HARBOUR\LIB\XHB.LIB|xwin_ver Error: Unresolved external '_HB_FUN_WIN_OSNETREGOK' referenced from C:\MINIGUI\HARBOUR\LIB\XHB.LIB|xwin_ver Error: Unresolved external '_HB_FUN_WIN_OSNETVREDIROK' referenced from C:\MINIGUI\HARBOUR\LIB\XHB.LIB|xwin_ver Эти функции появились в Харборе 10 лет назад (в ноябре 2009 года). По-видимому, используется более старая версия Харбора
Новичок: Добавь список констант для MS Word "word.ch", MS Excel "excel.ch" если не трудно
gfilatov2002: Новичок пишет: список констант для MS Word "word.ch", MS Excel "excel.ch" Такие списки уже есть в папке samples\Advanced\Tsb_Export
Новичок: Видел, устарели уже - добавлял константы да и желательно в основной каталог перебросить, чтобы там постоянно жило :)
gfilatov2002: Подготовил первую бету для новой сборки 19.10 со следующим списком изменений: * New: Added a new command for managing of the Splash Windows: [ SHOW ] SPLASH WINDOW PICTURE <image> ; [ DELAY <delay> ] ; [ ON INIT <InitProcedure> ] ; [ ON RELEASE <ReleaseProcedure> ] where <image> may be BMP, JPG, PNG, GIF or TIF image from application's resources or from a disk file. Note that above command should be launched at ON INIT event of a MAIN form. Contributed by Grigory Filatov <gfilatov@inbox.ru> (see demo in folder \samples\Basic\SPLASHDEMO) * New: Added the new commands for tuning of the Status Items properties at runtime: SET STATUSITEM <nItem> OF <Form> ; [ FONTCOLOR | BACKCOLOR | ALIGN | ACTION ] [ TO ] <xValue> Contributed by Grigory Filatov <gfilatov@inbox.ru> (see demos in folder \samples\Basic\Status) * New: Added the useful pseudo-function HMG_SysWait( [ <nSeconds> ] ) which based upon the Harbour function hb_idleSleep(). Contributed by Grigory Filatov <gfilatov@inbox.ru> (see demo in folder \samples\Advanced\MP3Info) * Modified: The first code refactoring attempt was made using of the individual modules for: - the extended and owner-draw controls; - the filenames management functions; - the nonclient C-functions; - the databases conversion auxiliary functions. Requested by Pete D. <pete_westg/at/yahoo.gr>. Contributed by Grigory Filatov <gfilatov@inbox.ru> * Enhanced: The ButtonEX control supports now an optional clause HOTKEY <KeyName>. Requested by Verchenko Andrey <verchenkoag@gmail.com>. Contributed by Grigory Filatov <gfilatov@inbox.ru> (see demo in folder\samples\Basic\Button_Hotkey) * Updated: Synchronized Extended HMG for compatibility with Official HMG: - New: function IsContextMenuDefined ( cFormName ); - New: function IsNotifyMenuDefined ( cFormName ). Contributed by Grigory Filatov <gfilatov@inbox.ru> (see demo in folder \samples\Basic\MENU_Dynamic) * Updated: HbSQLite3 library: - update for using SQLITE3 latest version 3.30.0dev. Contributed by Grigory Filatov <gfilatov@inbox.ru> * Updated: Harbour Compiler 3.2.0dev (SVN 2019-09-11 10:16). Contributed by Grigory Filatov <gfilatov@inbox.ru> (look at ReadMe.txt in folder \harbour) * New: 'Extended Dynamic Context Menu' sample. Contributed by Sergej Kiselev and Verchenko Andrey (see menudemo6.prg in folder \samples\Basic\Menu) * Updated: 'Show Password without the asterisks and vice versa' sample. Contributed by Grigory Filatov <gfilatov@inbox.ru> (see in folder \samples\Basic\ShowPassword) * Updated: 'Splash Screen' sample. Contributed by Grigory Filatov <gfilatov@inbox.ru> (see in folder \samples\Basic\SPLASHDEMO) Ваши комментарии приветствуются
SergKis: gfilatov2002 О чем речь ? * Modified: The first code refactoring attempt was made using of the individual modules for: - the extended and owner-draw controls; - the filenames management functions; - the nonclient C-functions; - the databases conversion auxiliary functions. Requested by Pete D. <pete_westg/at/yahoo.gr>
gfilatov2002: SergKis пишет: О чем речь Речь о том, что сегментация редко используемого кода в ядре библиотеки позволила уменьшить размер экзешника mgDBU на 5 килобайт, например
SergKis: gfilatov2002 пишет Речь о том Спасибо за пояснение.
Avf: После перехода с версии Minigui 19.02 на 19.03 ( и более поздние ) при выполнении * Form_1.Browse_1.Value := RecNo() DoMethod('Form_1','Browse_1','Value',RecNo()) (например,в Sample/Basic/Browse_1) если Arg3 = "Value" ( и наверное не только ) выполнение идет на OTHERWISE MsgMiniGuiError( "Control: unrecognized method '" + Arg3 + "'." ) в h_controlmisc.prg. Зачем это было сделано и что надо исправить в исходниках ? Спасибо за внимание.
Andrey: Avf пишет: DoMethod('Form_1','Browse_1','Value',RecNo()) Может я и не прав, но DoMethod() нельзя так использовать. Здесь нужно использовать SetProperty()
Avf: Почему нельзя ? До марта 2019 было можно и все работало. Кроме того, в другой нотации ( Form_1.Browse_1.Value := RecNo() ) не всегда удобно использовать вместо имен окна/бровса переменные.
gfilatov2002: Avf пишет: Зачем это было сделано Для быстрого обнаружения ошибок или опечаток при неправильном применении свойств и методов. Andrey пишет: DoMethod() нельзя так использовать Да, верно. Потому что VALUE - это свойство, а не метод у элемента управления
Avf: Спасибо за разъяснение.
SergKis: Avf пишет Кроме того, в другой нотации ( Form_1.Browse_1.Value := RecNo() ) не всегда удобно использовать вместо имен окна/бровса переменные. Для бровсе и др. контролов будет работать через переменные cNam := 'Browse_1' This.&(cNam).Value := ... // др. свойства\методы тоже будут работать Form_1.&(cNam).Value := ... Если использовать SET OOP ON и события, то в них будет среда This всегда и доступны команды This.&(cNam).Value := ... и т.д.
Avf: Именно использование макроподстановки и является неудобством. Если использовать SET OOP ON и события, то в них будет среда This всегда Спасибо.
SergKis: Avf пишет Именно использование макроподстановки и является неудобством Смотря когда. Пример [pre2] as := dbStruct() y := x := 10 for each af in as @ y, x label &( af[1]+'_lbl' ) .... value af[1] ... x += This.&( af[1]+'_lbl' ).Width + 10 @ y, x getbox &( af[1] ) .... value &(af[1]) ... y += This.&( af[1]+'_lbl' ).Height + 10 next ... Писать с именами всегда можно nOld := This.Browse_1.Value This.Browse_1.Value := ... [/pre2]
Avf: Error: Unresolved external '_HB_FUN_WIN_OSVERSIONINFO' referenced from C:\MINIGUI\HARBOUR\LIB\XHB.LIB|xwin_ver Error: Unresolved external '_HB_FUN_WIN_OSISNT' referenced from C:\MINIGUI\HARBOUR\LIB\XHB.LIB|xwin_ver Error: Unresolved external '_HB_FUN_WIN_OSISNT351' referenced from C:\MINIGUI\HARBOUR\LIB\XHB.LIB|xwin_ver Error: Unresolved external '_HB_FUN_WIN_OSISNT4' referenced from C:\MINIGUI\HARBOUR\LIB\XHB.LIB|xwin_ver Error: Unresolved external '_HB_FUN_WIN_OSIS2000ORUPPER' referenced from C:\MINIGUI\HARBOUR\LIB\XHB.LIB|xwin_ver Error: Unresolved external '_HB_FUN_WIN_OSIS2000' referenced from C:\MINIGUI\HARBOUR\LIB\XHB.LIB|xwin_ver Error: Unresolved external '_HB_FUN_WIN_OSISXP' referenced from C:\MINIGUI\HARBOUR\LIB\XHB.LIB|xwin_ver Error: Unresolved external '_HB_FUN_WIN_OSISWINXPORUPPER' referenced from C:\MINIGUI\HARBOUR\LIB\XHB.LIB|xwin_ver Error: Unresolved external '_HB_FUN_WIN_OSIS2003' referenced from C:\MINIGUI\HARBOUR\LIB\XHB.LIB|xwin_ver Error: Unresolved external '_HB_FUN_WIN_OSISVISTA' referenced from C:\MINIGUI\HARBOUR\LIB\XHB.LIB|xwin_ver Error: Unresolved external '_HB_FUN_WIN_OSISVISTAORUPPER' referenced from C:\MINIGUI\HARBOUR\LIB\XHB.LIB|xwin_ver Error: Unresolved external '_HB_FUN_WIN_OSIS7' referenced from C:\MINIGUI\HARBOUR\LIB\XHB.LIB|xwin_ver Error: Unresolved external '_HB_FUN_WIN_OSIS8' referenced from C:\MINIGUI\HARBOUR\LIB\XHB.LIB|xwin_ver Error: Unresolved external '_HB_FUN_WIN_OSIS9X' referenced from C:\MINIGUI\HARBOUR\LIB\XHB.LIB|xwin_ver Error: Unresolved external '_HB_FUN_WIN_OSIS95' referenced from C:\MINIGUI\HARBOUR\LIB\XHB.LIB|xwin_ver Error: Unresolved external '_HB_FUN_WIN_OSIS98' referenced from C:\MINIGUI\HARBOUR\LIB\XHB.LIB|xwin_ver Error: Unresolved external '_HB_FUN_WIN_OSISME' referenced from C:\MINIGUI\HARBOUR\LIB\XHB.LIB|xwin_ver Error: Unresolved external '_HB_FUN_WIN_OSISTSCLIENT' referenced from C:\MINIGUI\HARBOUR\LIB\XHB.LIB|xwin_ver Error: Unresolved external '_HB_FUN_WIN_OSNETREGOK' referenced from C:\MINIGUI\HARBOUR\LIB\XHB.LIB|xwin_ver Error: Unresolved external '_HB_FUN_WIN_OSNETVREDIROK' referenced from C:\MINIGUI\HARBOUR\LIB\XHB.LIB|xwin_ver Эти функции появились в Харборе 10 лет назад (в ноябре 2009 года). По-видимому, используется более старая версия Харбора В последней версии сборки(19.08) эти функции перебрались из xhb.lib в hbwin.lib.
Avf: Смотря когда Я согласен. Но это уже особенности языка.
avf2007: Случайно обратил внимание : в h_browse.prg : *-----------------------------------------------------------------------------* FUNCTION _GetBrowseFnValue ( cTemp ) *-----------------------------------------------------------------------------* LOCAL cRet := 'Nil' SWITCH ValType ( cTemp ) CASE 'N' cRet := hb_ntos ( &cTemp ) ... наверное, должно быть : SWITCH ValType ( &cTemp )
Andrey: На нормальных компах под Win7 заметно очень скачки окна HMG_Alert(). Сначала окно появляется чуток пониже верха экрана и в левом углу, потом скачет в центр экрана. Под Win8.1 вроде не замечал, но у меня комп побыстрее обычного, офисного компа. Почему так ? Можно ли убрать эти скачки ?
SergKis: Поправь h_alert.prg [pre2] DEFINE WINDOW &cForm WIDTH 0 HEIGHT 0 TITLE cTitle MODAL NOSIZE BACKCOLOR aBackColor ; ON INTERACTIVECLOSE ( lPressButton .OR. lClosable ) ; ON INIT Nil ; ON RELEASE iif( !lPressButton .AND. lClosable, _HMG_ModalDialogReturn := 0, NIL ) FillDlg( cMsg, aOptions, nLineas, cIcoFile, nIcoSize, aBtnColors, bInit, lClosable, cFontName ) END WINDOW ACTIVATE WINDOW &cForm ON INIT This.Center() [/pre2] В ON INIT окно уже на экране в нач. координатах, this.center() там -> передергивает в центр.
SergKis: PS или как обычно CENTER WINDOW &cForm ACTIVATE WINDOW &cForm
SergKis: PPS УПС. Вспомнил. В предыдущей версии hmg было [pre2] ON INTERACTIVECLOSE ( lPressButton .OR. lClosable ) ; ON RELEASE iif( ! lPressButton .AND. lClosable, _HMG_ModalDialogReturn := 0, NIL ) FillDlg( cMsg, aOptions, nLineas, cIcoFile, nIcoSize, aBtnColors, bInit, lClosable, cFont ) END WINDOW ACTIVATE WINDOW &cForm ... *-----------------------------------------------------------------------------* STATIC FUNCTION FillDlg( cMsg, aOptions, nLineas, cIcoFile, nIcoSize, aBtnColors, bBlock, lClosable, cFont ) *-----------------------------------------------------------------------------* ... This.&( aBut[ Max( 1, Min( nLenaOp, _HMG_ModalDialogReturn ) ) ] ).SetFocus() This.Center() IF lClosable ON KEY ESCAPE OF &cForm ACTION ( _HMG_ModalDialogReturn := 0, lPressButton := .T., ThisWindow.Release() ) ENDIF IF HB_ISBLOCK( bBlock ) Do_WindowEventProcedure( bBlock, This.Index, 'WINDOW_ACTIVATE' ) ENDIF IF _IsControlDefined( "oTimer", cForm ) This.oTimer.Enabled := .T. ENDIF RETURN NIL [/pre2] Это более правильно, по мне, т.к. в bInit можно изменить размеры окна и повторить This.Center для них или не делать центровку, а задать row, col позицию
SergKis: PS к этому (из пред. версии) можно в DEFINE WINDOW ... добавить NOSHOW, а в ON INIT This.Show()
SergKis: SergKis пишет к этому (из пред. версии) можно в DEFINE WINDOW ... добавить NOSHOW, а в ON INIT This.Show() Проверил на примере Advanced\App_OopReport\demo2.prg Все нормально, перемещал main окно в разные углы, вызывал карточку, менял вызывая справочник, жал Cancel ... все HMG_Alert() отработали как надо.
Andrey: SergKis пишет: Все нормально, перемещал main окно в разные углы, вызывал карточку, менял вызывая справочник, жал Cancel ... все HMG_Alert() отработали как надо. Теперь бы в самой библиотеке МиниГуи поменять, чтобы в следующей версии это не вылезло опять !
gfilatov2002: SergKis пишет: В предыдущей версии hmg было Сделал, как в предыдущей версии... Кстати, это SergKis попросил изменить, когда работал с карточкой в примере Advanced\App_OopReport\demo2.prg Andrey пишет: Теперь бы в самой библиотеке МиниГуи поменять OK
SergKis: gfilatov2002 Попробовал mgDbu, для ntx все нормально, для cdx без fpt не вышло поставить rdd dbfcdx. Изменил и смог отработать [pre2] Procedure Main( cDBFName ) Local lMaximized, nTop, nLeft, nWidth, nHeight Local cDBFPath, cFile, nW, nH, cRddName PUBLIC cFilter := "" // Harbour commands SET CENTURY ON SET DATE GERMAN //BRITISH SET EXCLUSIVE ON // MiniGUI commands SET FONT TO "Tahoma", 9 SET DEFAULT ICON TO "ICONA" IF IsVistaOrLater() SET CENTERWINDOW RELATIVE PARENT ENDIF SET AUTOSCROLL OFF SET NAVIGATION EXTENDED IF !Empty(cDBFName) cRddName := iif( upper(cDBFName) == 'CDX', 'DBFCDX', 'DBFNTX' ) cDBFName := NIL ENDIF // Input parameter processing DEFAULT cDBFName := "test" IF Empty( cDBFPath := cFilePath( cDBFName ) ) cDBFPath := GetStartupFolder() ENDIF cDBFPath += "\" // Set default RDD and open a data file IF ! Empty( cRddName ) rddSetDefault( cRddName ) ELSEIF Empty( File( cDBFPath + cFileNoExt( cDBFName ) + ".fpt" ) ) .and. ; Empty( File( cDBFPath + cFileNoExt( cDBFName ) + ".cdx" ) ) rddSetDefault( "DBFNTX" ) ELSE rddSetDefault( "DBFCDX" ) ENDIF ... PROCEDURE OpenDataTable( cFile ) ... // Set default RDD and open a data file IF File( ChangeFileExt( cFile, ".fpt" ) ) .or. ; File( ChangeFileExt( cFile, ".cdx" ) ) rddSetDefault( "DBFCDX" ) ELSE rddSetDefault( "DBFNTX" ) ENDIF ... [/pre2]
SergKis: PS При создании tag без FOR опция UNIQUE недоступна, на Key тоже может быть unique
SergKis: PPS Правильнее[pre2] IF !Empty(cDBFName) cRddName := iif( upper(cDBFName) == 'CDX', 'DBFCDX', NIL ) cDBFName := NIL ENDIF [/pre2]
gfilatov2002: SergKis пишет: Изменил и смог отработать Благодарю за помощь SergKis пишет: на Key тоже может быть unique Поправил Эти изменения будут включены в 4-ю бета-версию новой сборки
SergKis: gfilatov2002 Может в StatusBar завести item для индикации RddSetDefault() и click для установки\смены ACTION {|| RddSetDefault( iif( RddSetDefault() == 'DBFCDX', 'DBFNTX', 'DBFCDX' ) ) }
gfilatov2002: SergKis пишет: в StatusBar завести item для индикации RddSetDefault() и click для установки\смены Сделал, конечно Благодарю за помощь
SergKis: gfilatov2002 По мне, использовать GetStartupFolder() при работе с dbf не очень хорошо. Работаю в Far и мне нужно тек. каталог, т.е. mgDbu.exe U09.dbf или mgDbu.exe .\2019\R08.dbf а зацеплено везде GetStartupFolder()
gfilatov2002: SergKis пишет: использовать GetStartupFolder() при работе с dbf не очень хорошо Заменил эту функцию на GetCurrentFolder() Благодарю за помощь
SergKis: gfilatov2002 Немного правки[pre2] METHOD SetArrayTo( aArray, uFontHF, aHead, aSizes, uFooter, aPicture, aAlign, aName ) CLASS TSBrowse ... EndIf If hFontHead != Nil ::hFontHead := hFontHead EndIf If hFontFoot != Nil ::hFontFoot := hFontFoot EndIf ::aArray := aArray ::lPickerMode := .F. ... METHOD InsColumn( nPos, oColumn ) CLASS TSBrowse ... If oColumn:lDefineColumn oColumn:DefColor( Self, oColumn:aColors ) oColumn:DefFont ( Self ) EndIf IF ! Empty( ::hFontHead ) oColumn:hFontHead := ::hFontHead ENDIF IF ! Empty( ::hFontFoot ) oColumn:hFontFoot := ::hFontFoot ENDIF Default nPos := 1 ... [/pre2]
SergKis: PS METHOD InsColumn( nPos, oColumn ) CLASS TSBrowse Не надо править. В oColumn:DefFont( Self ) такая установка есть, не увидел.
gfilatov2002: SergKis пишет: Немного правки Поправил, конечно. Благодарю за помощь
SergKis: gfilatov2002 Предложение. У себя сделал для многострочных колонок, прошло на ура.[pre2] CLASS TSColumn ... DATA nEditRow AS NUMERIC // DATA nEditCol AS NUMERIC // DATA nEditHeight AS NUMERIC // DATA nEditWidth AS NUMERIC // ... METHOD Edit( uVar, nCell, nKey, nKeyFlags, cPicture, bValid, nClrFore, nClrBack ) CLASS TSBrowse ... ::cChildControl := GetUniqueName( "GetBox" ) nRow += ::aEditCellAdjust[1] nCol += ::aEditCellAdjust[2] nWidth += ::aEditCellAdjust[3] nHeight += ::aEditCellAdjust[4] If oCol:nEditHeight > 0 nHeight := oCol:nEditHeight IF oCol:nEditRow > 0 nRow := oCol:nEditRow ENDIF IF oCol:nEditCol > 0 nCol := oCol:nEditCol ENDIF EndIf oCol:oEdit := TGetBox():New( nRow, nCol, bSETGET( uValue ), Self, nWidth, nHeight, ; ... Применение. Двухстрочная строка тсб. Есть 2е колонки с ценой, 1ая показ в первой строке, 2ая во второй. Цены надо править, т.е GetBox там где своя цена соответсвено. В программе дл тсб :InsColumn( 1, gCols( ArrayNo )) // первая цена oCol := :GetColumn("R_10") oCol:bDecode := {|nv| hb_ntos(nv)+CRLF+' ' } oCol:bPrevEdit := {|nv,ob| Prev_Cena0(ob, 1 ) } oCol:bPostEdit := {|nv,ob| Post_Cena0(ob, 1, nv) } oCol:lEdit := .T. // вторая цена, вторая строка oCol := :GetColumn("R_12") oCol:bDecode := {|nv| ' ' + CRLF + hb_ntos(nv) } oCol:bPrevEdit := {|nv,ob| Prev_Cena0(ob, 2 ) } oCol:bPostEdit := {|nv,ob| Post_Cena0(ob, 2, nv) } oCol:lEdit := .T. ADD SUPER HEADER TO oBrw FROM 1 TO :nColumn("R_2") TITLE "Excel" ADD SUPER HEADER TO oBrw FROM :nColumn("R_2" )+1 TO :nColumn("R_10")-1 TITLE gTxt(Material) ADD SUPER HEADER TO oBrw FROM :nColumn("R_10") TO :nColCount() TITLE gTxt(Ucen) ... *-----------------------------------------------------------------------------* STAT FUNC Prev_Cena0( oBrw, nLine ) *-----------------------------------------------------------------------------* LOCAL oCol, aLine, cPic := '99999.9999' WITH OBJECT oBrw IF nLine == 1 oCol := :GetColumn("R_10") oCel := :GetCellSize( :nColumn("R_10"), :nRowPos ) oCol:nEditHeight := int( oCel:nHeight / 2 ) + 2 oCol:nEditRow := oCel:nRow oCol:nEditCol := oCel:nCol - 1 oCol:cPicture := cPic Else aLine := :aArray[ :nAt ] If Empty( aLine[ Len(aLine) - 1 ] ) ; RETURN .F. // нет кода материала EndIf oCol := :GetColumn("R_12") oCel := :GetCellSize( :nColumn("R_12"), :nRowPos ) oCol:nEditHeight := int( oCel:nHeight / 2 ) + 2 oCol:nEditRow := oCel:nRow + ( oCel:nHeight - oCol:nEditHeight ) oCol:nEditCol := oCel:nCol - 1 oCol:cPicture := cPic EndIf END WITH RETURN .T. *-----------------------------------------------------------------------------* STAT FUNC Post_Cena0( oBrw, nLine, nCena ) *-----------------------------------------------------------------------------* LOCAL aLine, cKodK, nCenK, cKod, nCnt LOCAL nColC := oBrw:nCell - 1 // 7 LOCAL nColK := Len(oBrw:aArray[1]) - 1 // 9 nCenK := Val( StrZero(nCena, 11, 4) ) WITH OBJECT oBrw If nLine == 1 :aArray[ :nAt ][ nColC ] := nCenK :DrawSelect() Else cKodK := :aArray[ :nRowPos ][ nColK ] nCnt := 0 FOR EACH aLine IN :aArray nCnt += 1 cKod := aLine[ nColK ] If ! Empty( cKod ) .and. cKodK == cKod :aArray[ nCnt ][ nColC ] := nCenK EndIf NEXT :Refresh() EndIf END WITH RETURN .T. ... [/pre2] В методе :Edit() сделанное для GetBox можно распространить для всех контролов, кроме EditBox
gfilatov2002: SergKis пишет: В методе :Edit() сделанное для GetBox можно распространить для всех контролов, кроме EditBox Добавил эти изменения, хотя у меня создается впечатление, что кроме Вас никто это не будет использовать Благодарю за помощь в любом случае...
SergKis: gfilatov2002 пишет Добавил эти изменения, хотя у меня создается впечатление, что кроме Вас никто это не будет использовать Ради только меня не стоит это делать. В моей версии это есть. TBrowse таблица, как бы, осноаной рабочий инструмент. Разве не возникает потребности организовать ввод в отдельной строке (задаем заранее в каждой колонке координаты) или все колонки вводить в одних координатах (как в Excel) ? Это все без доп. GetBox и ... в связке с тсб. PS В TSCOLUMN добавлен еще, т.к. Picture отображения тсб колонки и Edit ее могут быть разными. DATA cEditPicture [pre2] ... METHOD Edit( uVar, nCell, nKey, nKeyFlags, cPicture, bValid, nClrFore, nClrBack ) CLASS TSBrowse ... If oCol:nEditHeight > 0 nHeight := oCol:nEditHeight IF oCol:nEditRow > 0 nRow := oCol:nEditRow ENDIF IF oCol:nEditCol > 0 nCol := oCol:nEditCol ENDIF EndIf If oCol:cEditPicture != Nil cPicture := oCol:cEditPicture EndIf ... [/pre2]
gfilatov2002: SergKis пишет: В TSCOLUMN добавлен еще, т.к. Picture отображения тсб колонки и Edit ее могут быть разными. DATA cEditPicture Добавил такое свойство (и его обработку) также. Благодарю за помощь
Andrey: gfilatov2002 пишет: Добавил эти изменения, хотя у меня создается впечатление, что кроме Вас никто это не будет использовать Я буду использовать. Сталкивался с таким, и не знал как сделать. Только бы надо примерчик небольшой сделать или показать уже в готовом примере как такое можно использовать. SergKis пишет: TBrowse таблица, как бы, осноаной рабочий инструмент. Просто отличный инструмент !!! Вот так можно сделать TBrowse-таблицу:
SergKis: gfilatov2002 Немного изменил, что бы не перекрывались :nEditWidth при перерисовке с :llAdjColumns и заданным :nEditWidth для Edit[pre2] DATA cEditPicture // DATA nEditRow AS NUMERIC // DATA nEditCol AS NUMERIC // DATA nEditHeight AS NUMERIC // DATA nEditWidth AS NUMERIC // DATA nEditWidthDraw AS NUMERIC // DATA nEditMove AS NUMERIC // post editing cursor movement ... METHOD DrawSelect( xRow, lDrawCell ) CLASS TSBrowse ... oColumn:nEditWidthDraw := 0 If nDeltaLen > 0 oColumn:nEditWidthDraw := aColSizes[ nJ ] + nDeltaLen EndIf If lDrawCell ... METHOD DrawSuper() CLASS TSBrowse ... For nI := 1 To Len( ::aColumns ) oCol := ::aColumns[ nI ] If oCol:nEditWidthDraw > 0 aColSizes[ nI ] := oCol:nEditWidthDraw - iif( ::lNoVScroll, GetVScrollBarWidth(), 0 ) Else aColSizes[ nI ] := oCol:nWidth EndIf Next ... METHOD GetCellInfo( nRowPos, nCell, lColSpecHd ) CLASS TSBrowse ... If oCol:nEditWidthDraw > 0 nWidth := oCol:nEditWidthDraw If ! ::lNoVScroll nWidth -= GetVScrollBarWidth() EndIf EndIf If lHead ... METHOD Edit( uVar, nCell, nKey, nKeyFlags, cPicture, bValid, nClrFore, ; ... If oCol:nEditWidthDraw > 0 nWidth := oCol:nEditWidthDraw If ! ::lNoVScroll nWidth -= GetVScrollBarWidth() EndIf EndIf If oCol:cResName != Nil .or. oCol:lBtnGet ... [/pre2] Пример использования на базе Advanced\Tsb_Basic_2\demo5.prg [pre2] /* * MINIGUI - Harbour Win32 GUI library Demo * Copyright 2018 Sergej Kiselev <bilance@bilance.lv> * * Tsbrowse: Таблица и работа с базой - Seek, Find, Scope, Complex Scope * Tsbrowse: Table and work with the base - Seek, Find, Scope, Complex Scope */ #define _HMG_OUTLOG #include "hmg.ch" #include "TSBrowse.ch" REQUEST DBFCDX PROCEDURE Main LOCAL oBrw, aAlias, hSpl, o, w, h LOCAL cTitle := "(5) TsBrowse Demo: Seek + Find + Scope + Complex Scope" rddSetDefault( 'DBFCDX' ) SET EPOCH TO 2000 SET DATE TO GERMAN SET CENTURY ON SET DELETED ON SET AUTOPEN OFF SET OOP ON SET FONT TO "Arial", 10 SET DIALOGBOX CENTER OF PARENT aAlias := UseOpenBase() DEFINE WINDOW Form_0 ; At 0, 0 ; WIDTH 800 ; HEIGHT 720 ; TITLE cTitle ; ICON "MG_ICO" ; MAIN ; NOMAXIMIZE NOSIZE ; ON INIT ( _wPost(1, oBrw, oBrw), oBrw:SetFocus(), DoEvents() ) ; ON RELEASE AEval(aAlias, {|wa| dbCloseArea(wa) }) DEFINE STATUSBAR STATUSITEM "Item 1" STATUSITEM cTitle WIDTH 390 FONTCOLOR BLUE STATUSITEM "Order: " + HB_NtoS(INDEXORD()) + " " + OrdName(INDEXORD()) WIDTH 140 KEYBOARD END STATUSBAR DEFINE SPLITBOX HANDLE hSpl DEFINE TOOLBAR ToolBar_1 CAPTION "" BUTTONSIZE 100,32 FLAT BUTTON Seek CAPTION 'Seek' PICTURE 'n1' SEPARATOR WHOLEDROPDOWN DEFINE DROPDOWN MENU BUTTON Seek ITEM "Seek first 15.10.2018" IMAGE 'n1' ACTION mySeek(oBrw, 1, .F.) ITEM "Seek last 15.10.2018" IMAGE 'n2' ACTION mySeek(oBrw, 1, .T.) SEPARATOR ITEM "Seek first 17.10.2018" IMAGE 'n3' ACTION mySeek(oBrw, 2, .F.) ITEM "Seek last 17.10.2018" IMAGE 'n4' ACTION mySeek(oBrw, 2, .T.) SEPARATOR ITEM "Seek first 20.10.2018" IMAGE 'n5' ACTION mySeek(oBrw, 3, .F.) ITEM "Seek last 20.10.2018" IMAGE 'n6' ACTION mySeek(oBrw, 3, .T.) END MENU BUTTON Find CAPTION 'Find' PICTURE 'n2' SEPARATOR WHOLEDROPDOWN DEFINE DROPDOWN MENU BUTTON Find ITEM 'Find first "aaa"' IMAGE 'n1' ACTION myFind(oBrw, 'aaa', .F.) ITEM 'Find next "aaa"' IMAGE 'n2' ACTION myFind(oBrw, 'aaa', .T.) SEPARATOR ITEM 'Find first "ccc"' IMAGE 'n3' ACTION myFind(oBrw, 'ccc', .F.) ITEM 'Find next "ccc"' IMAGE 'n4' ACTION myFind(oBrw, 'ccc', .T.) END MENU BUTTON Scope CAPTION 'Scope' PICTURE 'n3' SEPARATOR WHOLEDROPDOWN DEFINE DROPDOWN MENU BUTTON Scope ITEM "Scope first 15.10.2018" IMAGE 'n1' ACTION myScope(oBrw, 1, .F.) ITEM "Scope last 15.10.2018" IMAGE 'n2' ACTION myScope(oBrw, 1, .T.) SEPARATOR ITEM "Scope first 17.10.2018" IMAGE 'n3' ACTION myScope(oBrw, 2, .F.) ITEM "Scope last 17.10.2018" IMAGE 'n4' ACTION myScope(oBrw, 2, .T.) SEPARATOR ITEM "Scope first 20.10.2018" IMAGE 'n5' ACTION myScope(oBrw, 3, .F.) ITEM "Scope last 20.10.2018" IMAGE 'n6' ACTION myScope(oBrw, 3, .T.) SEPARATOR ITEM "Scope first 15.10.2018-17.10.2018" IMAGE 'n7' ACTION myScope(oBrw, 4, .F.) ITEM "Scope last 15.10.2018-17.10.2018" IMAGE 'n8' ACTION myScope(oBrw, 4, .T.) SEPARATOR ITEM "Scope first 17.10.2018-20.10.2018" IMAGE 'n9' ACTION myScope(oBrw, 5, .F.) ITEM "Scope last 17.10.2018-20.10.2018" IMAGE 'n10' ACTION myScope(oBrw, 5, .T.) SEPARATOR ITEM "Reset scope first" IMAGE 'n11' ACTION myScope(oBrw, 0, .F.) ITEM "Reset scope last " IMAGE 'n12' ACTION myScope(oBrw, 0, .T.) END MENU BUTTON Scope2 CAPTION 'Complex Scope' PICTURE 'n4' SEPARATOR WHOLEDROPDOWN DEFINE DROPDOWN MENU BUTTON Scope2 ITEM "Complex Scope first Nr.=444" IMAGE 'n1' ACTION myScope2(oBrw, 1, .F.) ITEM "Complex Scope last Nr.=444" IMAGE 'n2' ACTION myScope2(oBrw, 1, .T.) SEPARATOR ITEM "Complex Scope first Nr.=555" IMAGE 'n3' ACTION myScope2(oBrw, 2, .F.) ITEM "Complex Scope last Nr.=555" IMAGE 'n4' ACTION myScope2(oBrw, 2, .T.) SEPARATOR ITEM "Reset scope first" IMAGE 'n5' ACTION myScope2(oBrw, 0, .F.) ITEM "Reset scope last " IMAGE 'n6' ACTION myScope2(oBrw, 0, .T.) END MENU BUTTON Delete CAPTION 'Delete tag' PICTURE 'n5' SEPARATOR WHOLEDROPDOWN DEFINE DROPDOWN MENU BUTTON Delete ITEM "Goto first" IMAGE 'n1' ACTION myDelete(oBrw, 0, .F.) ITEM "Goto last " IMAGE 'n2' ACTION myDelete(oBrw, 0, .T.) SEPARATOR ITEM "Set deleted on" IMAGE 'n3' ACTION myDelete(oBrw, 1, .F.) ITEM "Reset view" IMAGE 'n4' ACTION myDelete(oBrw, 2, .F.) END MENU BUTTON InfoDb CAPTION 'Info-Dbase' PICTURE 'n0' SEPARATOR WHOLEDROPDOWN DEFINE DROPDOWN MENU BUTTON InfoDb ITEM "Database Information" IMAGE 'n0' ACTION InfoDbase() END MENU END TOOLBAR DEFINE TOOLBAR ToolBar_2 CAPTION "" BUTTONSIZE 42,32 FLAT BUTTON Exit CAPTION 'Exit' PICTURE 'exit' ACTION ThisWindow.Release() END TOOLBAR END SPLITBOX y := x := 5 g := 2 w := 90 h := 30 y += GetWindowHeight(hSpl) x := 5 @ y, x LABEL Label_1 WIDTH This.ClientWidth - x * 2 HEIGHT 24 VALUE ' ' ; VCENTERALIGN y += 24 + 2 w := This.ClientWidth - x * 2 h := This.ClientHeight - y - 2 - This.StatusBar.Height oBrw := CreateBrowse(y, x, w, h) oBrw:bChange := {|ob| _wPost(1, ob, ob) } FOR EACH o IN oBrw:aColumns o:bGotFocus := {|no,nc,ob| _wPost(1, ob, ob) } o:nEditRow := This.Label_1.Row o:nEditCol := This.Label_1.Col o:nEditWidth := This.Label_1.Width o:nEditHeight := This.Label_1.Height o:lEdit := .T. NEXT (This.Object):Event( 1, {|ots,ky,ob| ky := ob:bDataEval(ob:nCell), ; This.Label_1.Value := cValToChar(ky) } ) END WINDOW Form_0.Center Form_0.Activate RETURN FUNCTION CreateBrowse( y, x, w, h ) LOCAL nI, aFields, oBrw DEFINE TBROWSE oBrw AT y, x ; OF Form_0 ; ALIAS "TEST" ; WIDTH w ; HEIGHT h ; GRID ; COLORS { CLR_BLACK, CLR_BLUE } :SetAppendMode( .F. ) // вставка записи запрещена (в конце базы стрелкой вниз) :SetDeleteMode( .T., .T. ) // удаление записи разрешено :lNoHScroll := .T. // показ горизонтального скролинга :lCellBrw := .F. :lInsertMode := .T. // флаг для переключения режима Вставки при редактировании :lPickerMode := .F. // ввод формата колонки типа ДАТА сделать через цифры END TBROWSE ADD COLUMN TO TBROWSE oBrw DATA {|| hb_ntoc((oBrw:cAlias)->( OrdKeyNo() )) } ; HEADER "№№" SIZE 40 ; COLORS {CLR_BLACK, WHITE} ALIGN DT_CENTER, DT_CENTER, DT_CENTER ; NAME NN // initial columns aFields := { "F2", "F1", "F0", "F5","F3", "F4" } LoadFields( "oBrw", "Form_0", .F., aFields ) ADD COLUMN TO TBROWSE oBrw DATA {|| hb_ntoc((oBrw:cAlias)->( RecNo() )) } ; HEADER "Recno" SIZE 70 ; COLORS {CLR_BLACK, WHITE} ALIGN DT_CENTER ; NAME REC // Set columns width oBrw:SetColSize( oBrw:nColumn( "F0" ), 60 ) oBrw:SetColSize( oBrw:nColumn( "F5" ), 60 ) oBrw:SetColSize( oBrw:nColumn( "F1" ), 80 ) oBrw:SetColSize( oBrw:nColumn( "F2" ), 200 ) oBrw:SetColSize( oBrw:nColumn( "F3" ), 80 ) oBrw:SetColSize( oBrw:nColumn( "F4" ), 70 ) // Set names for the table header oBrw:GetColumn( "F0" ):cHeading := "Nr." oBrw:GetColumn( "F0" ):nAlign := DT_CENTER oBrw:GetColumn( "F5" ):cHeading := "Room" oBrw:GetColumn( "F5" ):nAlign := DT_CENTER oBrw:GetColumn( "F2" ):cHeading := "Text" oBrw:GetColumn( "F1" ):cHeading := "Date" oBrw:GetColumn( "F1" ):nAlign := DT_CENTER oBrw:GetColumn( "F3" ):cHeading := "Number" oBrw:GetColumn( "F4" ):cHeading := "Logical" oBrw:GetColumn('F1'):cPicture := Nil // пустые поля отображать как пробел oBrw:GetColumn('NN'):cFooting := {|nc, ob| nc := ob:nLen, iif( Empty( nc ), '', hb_ntos( nc ) ) } oBrw:nWheelLines := 1 oBrw:nColOrder := 0 oBrw:nClrLine := COLOR_GRID // цвет линий между ячейками таблицы oBrw:lNoChangeOrd := TRUE // убрать сортировку по полю oBrw:nColOrder := 0 // убрать значок сортировки по полю oBrw:lCellBrw := TRUE oBrw:lNoVScroll := TRUE // отключить показ горизонтального скролинга oBrw:hBrush := CreateSolidBrush( 242, 245, 204 ) // цвет фона под таблицей // prepare for showing of Double cursor AEval( oBrw:aColumns, {| oCol | oCol:lFixLite := .T., ; oCol:lEdit := .F., ; oCol:lOnGotFocusSelect := .T., ; oCol:lEmptyValToChar := .T. } ) // oCol:lOnGotFocusSelect := .T. - включат засинение данных при получении фокуса // GetBox-ом и сбрасывает, очищает поле при нажатии первого символа // oCol:lEmptyValToChar := .T. - при .T. переводит empty(...) значение поля в "" oBrw:nHeightCell += 10 // к высоте ячеек таблицы добавим oBrw:nHeightHead += 5 // к высоте шапки таблицы добавим oBrw:SetColor( { 1 }, { RGB( 0, 12, 120 ) } ) oBrw:SetColor( { 2 }, { RGB( 242, 245, 204 ) } ) oBrw:SetColor( { 5 }, { RGB( 0, 0, 0 ) } ) oBrw:SetColor( { 6 }, { { | a, b, oBr | IF( oBr:nCell == b, { RGB( 66, 255, 236 ), RGB( 111, 183, 155 ) }, ; { CLR_HRED, CLR_HCYAN } ) } } ) // cursor backcolor // ставим цвет по условию For nI := 1 To oBrw:nColCount() oCol := oBrw:aColumns[ nI ] oCol:nClrFore := {|| iif( DELETED(), CLR_YELLOW, CLR_BLACK ) } oCol:nClrBack := {|| iif( DELETED(), CLR_GRAY , RGB( 242, 245, 204 ) ) } Next oBrw:ResetVScroll() // показ вертикального скролинга таблицы oBrw:lFooting := .T. // использовать подвал таблицы oBrw:lDrawFooters := .T. // рисовать подвал таблицы oBrw:nHeightFoot := oBrw:nHeightCell-6 // высота строки подвала таблицы oBrw:DrawFooters() // выполнить прорисовку подвала таблицы oBrw:nFreeze := 1 // Заморозить столбец oBrw:lLockFreeze := .T. // Избегать прорисовки курсора на замороженных столбцах oBrw:AdjColumns() oBrw:SetNoHoles() // убрать дырку внизу таблицы перед подвалом oBrw:GoPos( 7,3 ) // передвинуть МАРКЕР на 5 строку и 3 колонку RETURN oBrw FUNCTION UseOpenBase() LOCAL aStr := {} LOCAL cDbf := GetStartUpFolder() + "\test5" LOCAL cIndx := cDbf LOCAL lDbfNo, aChr := {} LOCAL aAlias := {} LOCAL i, c, d, j, n := 0 LOCAL a := {'aaa','bbb','ccc','ddd','eee'} LOCAL r := {'c','b','a',' '} FOR i := 64 TO 240 AADD( aChr, CHR(i) ) NEXT IF ( lDbfNo := ! File( cDbf+'.dbf' ) ) AAdd( aStr, { 'F0', 'N', 7, 0 } ) AAdd( aStr, { 'F1', 'D', 8, 0 } ) AAdd( aStr, { 'F2', 'C', 60, 0 } ) AAdd( aStr, { 'F3', 'N', 10, 2 } ) AAdd( aStr, { 'F4', 'L', 1, 0 } ) AAdd( aStr, { 'F5', 'C', 5, 0 } ) dbCreate( cDbf, aStr ) ENDIF IF lDbfNo .OR. !File( cIndx+'.cdx' ) USE ( cDbf ) ALIAS TEST EXCLUSIVE NEW c := CtoD('20.10.2018') WHILE TEST->( RecCount() ) < ( 15 * 4 ) d := c - n++ TEST->( dbAppend() ) TEST->F1 := d TEST->F2 := "Line - " + str( n, 3 ) + " " + REPL(aChr[n], 12 ) TEST->F3 := n TEST->F4 := ( n % 2 ) == 0 For i := 1 To Len(a) TEST->( dbAppend() ) TEST->F1 := d TEST->F0 := i TEST->F2 := a[ i ] TEST->F3 := i * 10 Next END n := 10 c := 10 j := 1 GO TOP DO WHILE !EOF() i := RECNO() TEST->F5 := HB_NtoS(n) IF ( i % 2 ) == 0 TEST->F5 := HB_NtoS(n) + r[1] ENDIF IF ( i % 3 ) == 0 TEST->F5 := HB_NtoS(n) + r[2] ENDIF IF ( i % 4 ) == 0 TEST->F5 := HB_NtoS(n) + r[3] ENDIF IF ( i % 5 ) == 0 n++ ENDIF IF ( i % 8 ) == 0 .OR. ( i % 9 ) == 0 TEST->F0 := 444 TEST->F2 := ALLTRIM(TEST->F2) + " (444)" TEST->F5 := HB_NtoS(c) + r[j] j++ j := IIF(j > LEN(r), 1, j) c-- ENDIF IF ( i % 11 ) == 0 .OR. ( i % 12 ) == 0 TEST->F0 := 555 TEST->F2 := ALLTRIM(TEST->F2) + " (555)" TEST->F5 := HB_NtoS(c) + r[j] c-- ENDIF c := IIF(c < 1, 8, c) IF ( i % 6 ) == 0 TEST->F2 := " (deleted records)" TEST->F1 := CTOD("") TEST->F0 := 0 TEST->F3 := 0 TEST->F4 := .F. TEST->F5 := "" DbDelete() ENDIF SKIP ENDDO GO TOP INDEX ON DTOS(F1)+STR(F0) TAG DTN FOR !Deleted() INDEX ON RECNO() TAG DEL FOR Deleted() // Необходимо для этого индекса указать длину, иначе нет ясности к какой длине приводить // It is necessary to specify the length for this index, otherwise it is not clear what length to bring INDEX ON STR(F0, 7)+STR(VAL(F5), 4)+F5 TAG ROOM FOR !Deleted() USE ENDIF SET AUTOPEN ON USE ( cDbf ) ALIAS TEST SHARED NEW If OrdCount() > 0 OrdSetFocus(1) EndIf GO TOP SET AUTOPEN OFF AADD( aAlias, ALIAS() ) RETURN aAlias FUNCTION mySeek( oBrw, nDat, lLast ) LOCAL lRet, cDat, cVal LOCAL aDat := { ; CtoD('15.10.2018'), ; CtoD('17.10.2018'), ; CtoD('20.10.2018'), ; } DbSetOrder(1) cVal := "Order: " + HB_NtoS(INDEXORD()) + " " + OrdName(INDEXORD()) SetProperty( ThisWindow.Name, "StatusBar" , "Item" , 3, cVal ) cDat := DtoS(aDat[ nDat ]) lRet := oBrw:SeekRec(cDat, .T., lLast) oBrw:SetFocus() RETURN lRet FUNCTION myFind( oBrw, cTxt, lNext ) LOCAL lRet, b, l := len(cTxt) DbSetOrder(0) oBrw:Refresh() cVal := "Order: " + HB_NtoS(INDEXORD()) + " " + OrdName(INDEXORD()) SetProperty( ThisWindow.Name, "StatusBar" , "Item" , 3, cVal ) b := hb_macroblock( 'left(F2, '+hb_ntos(l)+') == "'+cTxt+'"' ) lRet := oBrw:FindRec(b, lNext) oBrw:SetFocus() RETURN lRet FUNCTION myScope( oBrw, nDat, lBottom ) LOCAL lRet, cDat, cEnd, cVal LOCAL aDat := { ; CtoD('15.10.2018'), ; CtoD('17.10.2018'), ; CtoD('20.10.2018'), ; } If empty(nDat) ElseIf nDat == 4 cDat := DtoS(aDat[ 1 ]) cEnd := DtoS(aDat[ 2 ]) ElseIf nDat == 5 cDat := DtoS(aDat[ 2 ]) cEnd := DtoS(aDat[ 3 ]) Else cDat := DtoS(aDat[ nDat ]) cEnd := cDat EndIf DbSetOrder(1) cVal := "Order: " + HB_NtoS(INDEXORD()) + " " + OrdName(INDEXORD()) SetProperty( ThisWindow.Name, "StatusBar" , "Item" , 3, cVal ) lRet := oBrw:ScopeRec(cDat, cEnd, lBottom) oBrw:SetFocus() FUNCTION myScope2( oBrw, nKey, lBottom ) LOCAL lRet, cDat, cEnd, cVal LOCAL aDat := { 444, 555 } // INDEX ON STR(F0, 7)+STR(VAL(F5), 4)+F5 TAG ROOM FOR !Deleted() // выражение для Scope делаем равным индексу If empty(nKey) ElseIf nKey == 1 cDat := STR(aDat[ 1 ], 7) cEnd := STR(aDat[ 1 ], 7) ElseIf nKey == 2 cDat := STR(aDat[ 2 ], 7) cEnd := STR(aDat[ 2 ], 7) Else cDat := Nil // STR(aDat[ nKey ]) cEnd := Nil // cDat EndIf SET ORDER TO TAG ROOM cVal := "Order: " + HB_NtoS(INDEXORD()) + " " + OrdName(INDEXORD()) SetProperty( ThisWindow.Name, "StatusBar" , "Item" , 3, cVal ) lRet := oBrw:ScopeRec(cDat, cEnd, lBottom) DO EVENTS oBrw:SetFocus() RETURN lRet FUNCTION myDelete( oBrw, nKey, lBottom ) LOCAL lRet, cDat, cEnd, cVal DEFAULT nKey := 0 If empty(nKey); SET DELETED OFF Else ; SET DELETED ON EndIf If nKey == 2 SET ORDER TO 1 SET SCOPE TO GO TOP oBrw:Reset() Else SET ORDER TO TAG DEL cVal := "Order: " + HB_NtoS(INDEXORD()) + " " + OrdName(INDEXORD()) SetProperty( ThisWindow.Name, "StatusBar" , "Item" , 3, cVal ) lRet := oBrw:ScopeRec(cDat, cEnd, lBottom) EndIf DO EVENTS oBrw:SetFocus() RETURN lRet FUNCTION InfoDbase() RETURN MsgInfo( Base_Current(), "Open databases" ) #include "Dbinfo.ch" FUNCTION Base_Current(cPar) LOCAL cMsg, nI, nSel, nOrder, cAlias, cIndx, aIndx := {} cAlias := ALIAS() nSel := SELECT(cAlias) IF nSel == 0 cMsg := "No open BASE !" + CRLF RETURN cMsg ENDIF nOrder := INDEXORD() cMsg := "Open Database - alias: " + cAlias + " RddName: " + RddName() + CRLF cMsg += "Path to the database - " + DBINFO(DBI_FULLPATH) + CRLF + CRLF cMsg += "Open indexes: " IF nOrder == 0 cMsg += " (no indexes) !" + CRLF ELSE cMsg += ' DBOI_ORDERCOUNT: ( ' + HB_NtoS(DBORDERINFO(DBOI_ORDERCOUNT)) + ' )' + CRLF + CRLF FOR nI := 1 TO 100 cIndx := ALLTRIM( DBORDERINFO(DBOI_FULLPATH,,ORDNAME(nI)) ) IF cIndx == "" EXIT ELSE DBSetOrder( nI ) cMsg += STR(nI,3) + ') - Index file: ' + DBORDERINFO(DBOI_FULLPATH) + CRLF cMsg += ' Index Focus: ' + ORDSETFOCUS() + ", DBSetOrder(" + HB_NtoS(nI)+ ")" + CRLF cMsg += ' Index key: "' + DBORDERINFO( DBOI_EXPRESSION ) + '"' + CRLF cMsg += ' FOR index: "' + OrdFor() + '" ' + SPACE(5) cMsg += ' DBOI_KEYCOUNT: ( ' + HB_NtoS(DBORDERINFO(DBOI_KEYCOUNT )) + ' )' + CRLF + CRLF AADD( aIndx, STR(nI,3) + " OrdName: " + OrdName(nI) + " OrdKey: " + OrdKey(nI) ) ENDIF NEXT DBSetOrder( nOrder ) cMsg += "Current index = "+HB_NtoS(nOrder)+" , Index Focus: " + ORDSETFOCUS() ENDIF cMsg += " Number of records = " + HB_NtoS(ORDKEYCOUNT()) + CRLF RETURN cMsg [/pre2]
gfilatov2002: SergKis пишет: Немного изменил Благодарю за помощь и тестовый пример
SergKis: gfilatov2002 Лучше сделать так [pre2] METHOD Edit( uVar, nCell, nKey, nKeyFlags, cPicture, bValid, nClrFore, ; ... nRow += ::aEditCellAdjust[1] nCol += ::aEditCellAdjust[2] nWidth += 2+::aEditCellAdjust[3] nHeight += 2+::aEditCellAdjust[4] If oCol:nEditWidth > 0 nWidth := oCol:nEditWidth EndIf If oCol:nEditHeight > 0 nHeight := oCol:nEditHeight EndIf If oCol:nEditRow > 0 nRow := oCol:nEditRow EndIf If oCol:nEditCol > 0 nCol := oCol:nEditCol EndIf If oCol:cEditPicture != Nil cPicture := oCol:cEditPicture EndIf oCol:oEdit := TGetBox():New( nRow, nCol, ; bSETGET( uValue ), Self, nWidth, nHeight, ; ... [/pre2]
gfilatov2002: SergKis пишет: Лучше сделать так OK, сделал Благодарю за подсказку
SergKis: gfilatov2002 Предлагаю дополнить[pre2] CLASS Get EXPORTED: DATA Index INIT 0 DATA BadDate INIT .F. ... FUNCTION _DefineGetBox ( ControlName, ParentFormName, x, y, w, h, Value, ; ... oGet:UpdateBuffer() oGet:Index := k Public &mVar. := k ... CLASS TGetBox FROM TControl ... METHOD VarGet() ACCESS Index INLINE ::oGet:Index ACCESS Handle INLINE iif( Empty( ::Index ), 0, _HMG_aControlHandles [ ::Index ] ) ENDCLASS ... h_controlmisc.prg ============ ... *-----------------------------------------------------------------------------* FUNCTION _SetAlign ( ControlName, ParentForm, cAlign, Index ) *-----------------------------------------------------------------------------* LOCAL i := iif( pCount() > 3, Index, GetControlIndex ( ControlName, ParentForm ) ) LOCAL a := { "LEFT", "CENTER", "RIGHT", "VCENTER" } IF i > 0 IF HB_ISNUMERIC( cAlign ) IF ( cAlign + 1 ) > Len( a ) ; cAlign := 0 ENDIF cAlign := a[ cAlign + 1 ] ENDIF DO CASE CASE cAlign == "LEFT" ChangeStyle ( _HMG_aControlHandles [ i ] , , ES_CENTER + ES_RIGHT ) CASE cAlign == "CENTER" ChangeStyle ( _HMG_aControlHandles [ i ] , ES_CENTER , ES_CENTER + ES_RIGHT ) CASE cAlign == "RIGHT" ChangeStyle ( _HMG_aControlHandles [ i ] , ES_RIGHT , ES_CENTER + ES_RIGHT ) CASE cAlign == "VCENTER" ChangeStyle ( _HMG_aControlHandles [ i ] , SS_CENTERIMAGE ) ENDCASE _Refresh ( i ) ENDIF RETURN Nil ... CLASS TSColumn ... DATA cEditPicture // DATA nEditAlign // DATA nEditRow AS NUMERIC // ... METHOD Edit( uVar, nCell, nKey, nKeyFlags, cPicture, bValid, nClrFore, ; ... If oCol:cEditPicture != Nil cPicture := oCol:cEditPicture EndIf oCol:oEdit := TGetBox():New( nRow, nCol, ; bSETGET( uValue ), Self, nWidth, nHeight, ; cPicture,, nClrFore, nClrBack, hFont, ::cChildControl, cWnd, ; cMsg,,,,, bChange, .T.,, lSpinner .and. cType $ "ND", bUp, bDown, ; bMin, bMax, oCol:lNoMinus ) If oCol:nEditAlign != Nil _SetAlign( , , oCol:nEditAlign, oCol:oEdit:Index ) EndIf If ! Empty( oCol:aKeyEvent ) ... тогда в примере (был выше) добавим FOR EACH o IN oBrw:aColumns o:bGotFocus := {|no,nc,ob| _wPost(1, ob, ob) } o:nEditRow := This.Label_1.Row o:nEditCol := This.Label_1.Col o:nEditWidth := This.Label_1.Width o:nEditHeight := This.Label_1.Height o:nEditAlign := DT_LEFT o:lEdit := .T. NEXT ... тогда GetBox будут, как и Label, в одной позиции Еще можно добавить свойство ALIGN в команды #command @ <row>, <col> GETBOX <name> ; ... [/pre2]
gfilatov2002: SergKis пишет: CLASS TGetBox FROM TControl ... METHOD VarGet() ACCESS Index INLINE ::oGet:Index ACCESS Handle INLINE iif( Empty( ::Index ), 0, _HMG_aControlHandles [ ::Index ] ) А зачем эти новые переменные в классе Ведь эти значения уже есть в классе: - oGet:Index - это oGet:Atx - oGet:Handle - это oGet:hWnd
SergKis: gfilatov2002 пишет Ведь эти значения уже есть в классе Если есть, то, конечно, не нужны. Сильно не вникал, но названия особенно :Atx - догадываться надо. Скопировал со своей версии. Но чтобы голова не болела, сделал бы ACCESS Index INLINE ::Atx ACEESS Handle INLINE ::hWnd
gfilatov2002: SergKis пишет: If oCol:nEditAlign != Nil _SetAlign( , , oCol:nEditAlign, oCol:oEdit:Index ) EndIf If ! Empty( oCol:aKeyEvent ) ... тогда в примере (был выше) добавим FOR EACH o IN oBrw:aColumns o:bGotFocus := {|no,nc,ob| _wPost(1, ob, ob) } o:nEditRow := This.Label_1.Row o:nEditCol := This.Label_1.Col o:nEditWidth := This.Label_1.Width o:nEditHeight := This.Label_1.Height o:nEditAlign := DT_LEFT o:lEdit := .T. NEXT Выравнивание в oGet сделал (работает в Вашем примере). Благодарю за предложение
Andrey: Всем привет. Использую в МиниГуи такую функцию:[pre2] ? ProcNameLine(0) ? ProcNameLine(1) ? ProcNameLine(2) FUNCTION ProcNameLine(nVal) DEFAULT nVal := 0 RETURN "Вызов из: " + ProcName( nVal + 1 ) + "(" + hb_ntos( ProcLine( nVal + 1 ) ) + ") --> " + ProcFile( nVal + 1 ) [/pre2] Удобнее писать в прогах... Может занести в саму МиниГуи ?
gfilatov2002: Опубликована новая сборка 19.10 для BCC 5.8.2 и компиляторов Harbour и xHarbour. Базовый дистрибутив находится по адресу http://hmgextended.com/files/CONTRIB/hmg-19.10-setup.exe Также имеются дополнительные сборки для следующих Си-компиляторов: - MinGW 9.2.1 32-bit для Harbour 3.2.0dev; (есть в наличии) - MinGW 8.2.0 64-bit для Harbour 3.4.0dev; (есть в наличии) - MS VisualC 2019 32-bit для Harbour 3.2.0dev; (под заказ) - MS VisualC 2019 64-bit для Harbour 3.2.0dev; (под заказ) - Pelles C 8.0 32-bit для xHarbour b10253; (под заказ) - Pelles C 9.0 64-bit для xHarbour b10253; (под заказ) - Borland/Embarcadero C++ 7.4 (32-bit) для Harbour 3.2.0dev; (под заказ) - Open Watcom C/C++ 2.0 (32-bit) для Harbour 3.2.0dev. (под заказ) Благодарю за Ваше внимание и поддержку
SergKis: gfilatov2002 После установки new 19.10 (C:\MiniGui) примеры не собираются, сообщение "The system find path specified" Вернул предыдущую - все ok!
Dima: SergKis Собираются норм , обрати внимание что был сделан переход с Bcc55 на Bcc58 Пути поправь
SergKis: Dima пишет был сделан переход с Bcc55 на Bcc58 У меня его и нет совсем. Он же, вроде, коммерческий был.
Dima: SergKis пишет: У меня его и нет совсем Теперь есть http://hmgextended.com/files/MISC/bcc582.zip
SergKis: Dima Спасибо. А как с лицензией ? Если она коммерческая, то, наверно и ставить не буду.
Andrey: > Какой статус лицензии у BCC 5.8 ? Григорий так мне написал: [pre2]Лицензия подобна BCC 5.5 (она есть в архиве BCC 5.8 на сайте). В любом случае, это такой же устаревший продукт (2006 года выпуска), как и BCC 5.5.[/pre2]
SergKis: Andrey пишет это такой же устаревший продукт (2006 года выпуска), как и BCC 5.5. Достаточно[pre2] LIMITED WARRANTY Except with respect to the Redistributables, which are provided "as is," without warranty of any kind, Borland warrants that the Software, as updated and when properly used, will perform substantially in accordance with the accompanying documentation, and the Software media will be free from defects in materials and workmanship, for a period of ninety (90) days from the date of receipt. Any implied warranties on the Software are limited to ninety (90) days. Some states/jurisdictions do not allow limitations on duration of an implied warranty, so the above limitation may not apply to you.[/pre2] Доказывать, что ты не "верблюд", в наших краях себе дороже выйдет. В таком варианте, для меня, проект hmg закрыт
gfilatov2002: SergKis пишет: Достаточно LIMITED WARRANTY Except with respect to the Redistributables, which are provided "as is," without warranty of any kind, Borland warrants that the Software, as updated and when properly used, will perform substantially in accordance with the accompanying documentation, and the Software media will be free from defects in materials and workmanship, for a period of ninety (90) days from the date of receipt. Any implied warranties on the Software are limited to ninety (90) days. Some states/jurisdictions do not allow limitations on duration of an implied warranty, so the above limitation may not apply to you. Доказывать, что ты не "верблюд", в наших краях себе дороже выйдет. В таком варианте, для меня, проект hmg закрыт Может я чего то не понял, но точно такая же ограниченная гарантия есть у BCC 5.5 В чем тогда проблема с BCC 5.8.2
SergKis: gfilatov2002 пишет В чем тогда проблема с BCC 5.8.2 Везде про bcc 55 пишутОсобенностью этого программного продукта, кроме бесплатной лицензии, является отсутствие интегрированной визуальной среды разработки и библиотек компонентов, входящих в состав полного коммерческого продукта Borland Builder C++. Однако в бесплатный пакет входят почти все заголовочные и библиотечные файлы, необходимые для разработки 32-разрядных приложений под Windows Про bcc 5.8.2 не видел. У нас есть организация, следящая за лицензиями (ходят по клиентам с проверками). Если я приду и попаду у клиента на такую шнягу, то мой ноут может оказаться забранным на n-ое время, а вернется ли, х.з. Стукачков много развелось (по разным причинам) к тому же. На bcc 5.5 в целом программ нет (небольшая утилита), вся основная работа на vc hmg 2.07 версии. Так что, лучше bcc 5.8 не буду устанавливать совсем
Dima: SergKis MinGW поставь
gfilatov2002: SergKis пишет: лучше bcc 5.8 не буду устанавливать совсем По большому счету, этот компилятор можно не устанавливать, поскольку все библиотеки, скомпилированные BCC 5.8, прекрасно работают с BCC 5.5. У них полная бинарная совместимость
SergKis: Dima пишет MinGW поставь Зачем ? Рабочая версия на vc есть. Версия с bcc 55 использовалась как пример исследования новшеств. Unicode нет версии. Из hmg в рабочей версии исп. только browse и tsbrowse. Все печати, EAN коды, pdf, mail, ... vo 2.7 все umicode TsBrowse у меня практически идентичны ...
Dima: SergKis пишет: Зачем ? я пошутил )
SergKis: gfilatov2002 пишет У них полная бинарная совместимость А поковыряться ? Пересобрать lib-ы ?
Andrey_IV: Всем доброго времени суток! В BCC 5.5 (да и в BCC 5.6), если в файле ресурсов .RC писал русскими буквами в кодировке Win-1251 - то на экране все отображалось корректно Когда попробовал в компилировать программу в BCC 5.82 - получил крякозябры. Попробовал забить вместо латинских, русскими в примере: C:\MiniGUI\SAMPLES\BASIC\TEST_APPLICATION\demo.rc - та-же история. Крякозябры вместо русских букв. Это только в файле ресурсов. Если просто в .PRG пишу русскими - все нормально. Это вообще можно победить ? Не может-же быть такого, что компилятор не дружит с кодировкой Win-1251 ТОЛЬКО в ресурсах. Или может ???
Dima: Andrey_IV пишет: Это вообще можно победить ? Можно Andrey_IV пишет: C:\MiniGUI\SAMPLES\BASIC\TEST_APPLICATION\demo.rc - та-же история Нет там ни какой истории , demo.rc в кодировке 866 , переведи в 1251 и будет как надо
gfilatov2002: Andrey_IV пишет: Попробовал забить вместо латинских, русскими в примере: C:\MiniGUI\SAMPLES\BASIC\TEST_APPLICATION\demo.rc Сделал такую проверку также #include "resource.h" // Application icon. IDI_APPICON ICON "Application.ico" // Our main menu. IDR_MAINMENU MENU { POPUP "&Файл" { MENUITEM "В&ыход", ID_FILE_EXIT } POPUP "&Помощь" { MENUITEM "&О программе", ID_HELP_ABOUT } } и этот пример нормально показывает меню по-русски
Andrey: SergKis пишет: Рабочая версия на vc есть. Версия с bcc 55 использовалась как пример исследования новшеств. Давайте тогда перейдём полностью на MSVC ?
Andrey_IV: Не точно выразился 1) Кодировка RC-файла конечно-же Win-1251 2) Речь идёт не об этом блоке RC-файла, который привёл в приме Григорий { POPUP "&Файл" { MENUITEM "&Выход", ID_FILE_EXIT } POPUP "&Помощь" { MENUITEM "&О программе", ID_HELP_ABOUT } } а вот об этом (то, что в проводнике "Свойства файла", закладка "Подробно" - в общем информация "О программе" (проверял в Windows 7). Возьмем файл: C:\MiniGUI\SAMPLES\Applications\SysInfo\SysInfo.rc Меняю кодировку на Win-1251, пишу на русском (извините - просто пример) 1 VERSIONINFO FILEVERSION 1,1,0,0 PRODUCTVERSION 1,0,0,0 FILEOS 0x4 FILETYPE 0x1 { BLOCK "StringFileInfo" { BLOCK "040904b0" { VALUE "FileDescription", "Системная информация\000" VALUE "FileVersion", "1.1.0.0" VALUE "InternalName", "SysInfo\000" VALUE "LegalCopyright", "Freeware 2003-2012\000" VALUE "LegalTrademarks", "Harbour" VALUE "OriginalFilename", "SysInfo.exe" VALUE "CompanyName", "" VALUE "ProductName", "Утилита MiniGUI" VALUE "ProductVersion", "1.0.0.0" VALUE "Comments", "Создано Григорием Филатовым <gfilatov@inbox.ru>\000" } } BLOCK "VarFileInfo" { VALUE "Translation", 0x0409 0x04B0 } } Компилирую, в проводнике в свойствах файла в описании файла и в названии продукта вижу крякозябры Пробовал менять Английский на Русский // BLOCK "040904b0" BLOCK "041904e3" и // VALUE "Translation", 0x0409 0x04B0 VALUE "Translation", 0x0419 0x04E3 Ничего не даёт
Dima: Там вроде нужно прикручивать windows manifest и кодировка в rc должна быть utf-8
gfilatov2002: Обновил сборку 19.10 (Update 1) с учетом последних наработок Базовый дистрибутив находится по адресу http://hmgextended.com/files/CONTRIB/hmg-19.10-setup.exe Что нового: * Fixed: Problem with a handling of 'Transparent' property of a label which was placed on top of an image (introduced in the build 19.10). Bug was reported by Valtecom Jose Martins. Contributed by Grigory Filatov <gfilatov@inbox.ru> * Modified: ButtonEx: using of the Harbour function hb_tokenCount() instead of a local implementation. Contributed by Grigory Filatov <gfilatov@inbox.ru> (see demo3.prg in folder \samples\Basic\ButtonEx) * Enhanced: Added the Metro color's constants to the header file include\i_color.ch. Contributed by Grigory Filatov <gfilatov@inbox.ru> * Updated: HBPrinter library v.2.48: - modified toolbar buttons placing in the Preview form and a look of Options dialog; - updated Greek language translation. Based upon a contribution of Pete D. <pete_westg/at/yahoo.gr>. Revised by Grigory Filatov <gfilatov@inbox.ru> (see demo in folder \samples\Advanced\HBPrinter) * Updated: Harbour Compiler 3.2.0dev (SVN 2019-09-11 10:16): * Updated: OpenSSL wrapper for using of the version 1.0.2t. Contributed by Grigory Filatov <gfilatov@inbox.ru> (look at ReadMe.txt in folder \harbour) * New: 'Circle Progress Animation' sample. Contributed by Grigory Filatov <gfilatov@inbox.ru> (see in folder \samples\Basic\CircleProgressAnimation)
gfilatov2002: Обновил сборку 19.10 (Update 2) с учетом последних наработок Базовый дистрибутив для BCC 5.8.2 находится по адресу http://hmgextended.com/files/CONTRIB/hmg-19.10-setup.exe Что нового: [pre2] * Updated: HbSQLite3 library: - update for using SQLITE3 version 3.31.0dev (from 3.30.1). Contributed by Grigory Filatov <gfilatov@inbox.ru> * Updated: Harbour Compiler 3.2.0dev (SVN 2019-09-11 10:16): * the hbrdd and hbrtl core libraries were compiled with the default switch -l for a smallest size. Note: the minimal supported platform is Windows XP now. The recommended platforms are Windows 7 and later. Contributed by Grigory Filatov <gfilatov@inbox.ru> (look at ReadMe.txt in folder \harbour) * Updated: HMGS-IDE v.1.4.3.7 Project Manager and Two-Way Visual Form Designer: * Changed: the default C-compiler is BCC 5.8 now instead of BCC 5.5. * Updated: in mpmc.prg use Harbour contrib hbziparc library instead of obsolete ziparchive library. Contributed by Grigory Filatov <gfilatov@inbox.ru> (see demo in folder \Ide\Samples\Zip) * Updated: MPM and MPMC utilities will use Harbour contrib hbziparc library. Contributed by Grigory Filatov <gfilatov@inbox.ru> (see in folders \Utils\MPM and \Utils\MPMC) [/pre2]
rvu: gfilatov2002 пишет: Может я чего то не понял, но точно такая же ограниченная гарантия есть у BCC 5.5 А как связаны ограниченная гарантия и авторские права? Меня тоже авторские права интересуют. Хочется чистоты. И какую версия они сами сейчас раздают? https://www.embarcadero.com/free-tools/ccompiler/free-download
gfilatov2002: rvu пишет: какую версия они сами сейчас раздают? Они раздают бесплатно 32-битный компилятор BCC 10.1, который основан на LLVM/Clang C 3.3.1 и датирован 2016 годом. Проблема в том, что собрать Харбор для этого компилятора стандартным образом не получится. После многих попыток мне, правда, удалось это сделать. Результат см. ниже Harbour 3.2.0dev (r1902111251) Copyright (c) 1999-2019, https://harbour.github.io/ Harbour Build Info --------------------------- Version: Harbour 3.2.0dev (r1902111251) Compiler: LLVM/Clang C 3.3.1 (35832.6139226.5cda94d) (32-bit) Platform: Windows 7 6.1 SP1 PCode version: 0.3 ChangeLog last entry: 2019-02-11 13:51 UTC+0100 Przemyslaw Czerpak (druzus/at/poczta.onet.pl) ChangeLog ID: 1d06956f746c166a6c53f00036a261952796fca6 Built on: Feb 12 2019 21:44:56 Extra C compiler options: -DHB_GC_AUTO -DHB_GUI Build options: (Clipper 5.3b) (Clipper 5.x undoc) ---------------------------
Andrey: Всем привет. Пример MiniGUI\SAMPLES\BASIC\Button_Hotkey Туда бы добавить для наглядности небольшое добавление: [pre2] @ 100, nX BUTTONEX button_1 ; CAPTION " 1 " ; ACTION _wPost( 10, This.button_1.Index ) ; WIDTH nW ; HEIGHT 28 ; TOOLTIP "HotKey 1 or F1" ; HOTKEY { 1, F1 } [/pre2] Если массив нельзя, то тогда бы сделать перечисление клавиш: [pre2] ON KEY F1 ACTION _wPost( 10 , .... здесь не знаю как .... ) ON KEY F2 ACTION _wPost( 10 , .... здесь не знаю как .... ) ......[/pre2] Юзера просят горячие клавиши сразу по F1/F2 ... ну или просто по 1/2 .... Я понимаю что горячая клавиша ОДНА, но блин нашему юзеру всё мало.... Просто в старых программах сделал так, теперь просят такого же в МиниГуи.
SergKis: Andrey пишет ON KEY F1 ACTION _wPost( 10 , .... здесь не знаю как .... ) ON KEY F2 ACTION _wPost( 10 , .... здесь не знаю как .... ) ...... так же[pre2] ON KEY F1 ACTION _wPost( 10 , This.button_1.Index ) ON KEY F2 ACTION _wPost( 10 , This.button_1.Index ) ...... [/pre2] создается в событии 10 среда This для button1, как и для ACTION кнопки, по указанному индексу
SergKis: PS т.е. если делать _wPost(10), то в событии 10 This.Name - имя окна, ThisWindow.Name - тоже, если делать _wPost( 10 , This.button_1.Index ), то в событии 10 This.Name - имя кнопки, ThisWindow.Name - имя окна
Andrey: SergKis пишет: ON KEY F1 ACTION _wPost( 10 , This.button_1.Index ) ON KEY F2 ACTION _wPost( 10 , This.button_1.Index ) ...... Чуток ошибся:[pre2] ON KEY F1 ACTION _wPost( 10 , This.button_1.Index ) ON KEY F2 ACTION _wPost( 10 , This.button_2.Index ) ON KEY F3 ACTION _wPost( 10 , This.button_3.Index ) [/pre2] А если будут две формы и будут такие же кнопки, то горячие клавиши будут различаться ? This.button_1.Index - это для каждого окна своя кнопка ?
SergKis: Andrey пишет Чуток ошибся: Именно так и хотел написать, о назначении ОДНОГО события для button_1 разным клавишам, т.е. одной кнопке назначаем нажатия "1", "F1", "CTRL+F1", "SHIFT+F1", "CTRL+1", ... и при всех нажатиях будет исполнен блок кода события 10 со средой This, для кнопки "button_1" То что ты добавил\исправил на F2 - это может быть доп. множество клавиш для др. кнопки "button_2" А если будут две формы и будут такие же кнопки, то горячие клавиши будут различаться ? This.button_1.Index - это для каждого окна своя кнопка ? На каждой форме-окне контролы могут называться одинаково, они, как и события "привязаны" к своему окну. Т.е. если создаешь окно по переменной cForm := <имя> и DEFINE WINDOW &cForm ... то сменив имя окна-формы => получишь новое окно, на котором имена контролов будут одинаковы с первым и события совпадут. Если в них исп. public (не static) функции они будут вызываться одни и те же при наступлении события, но внутри будут иметь разную среду This для окна, This.Name контрола совпадать, ThisWindow.Name разное
gfilatov2002: Подготовил 1-й релиз-кандидат для новой сборки 19.12 со следующим списком изменений (кратко): [pre2] * Fixed: The 'OnChange' event fired by a mouse click in a Browse control without changing of the row. It exists in the official version too. * Fixed: A potential RTE at using of a TRANSPARENT checkbox control into SplitChild window. * Revised GdiPlus.dll system library handling: - added the new function HMG_SaveImage( FileName, cOutName [, cEncoder] [, nJpgQuality] ; [, aOutSize] ), where cEncoder parameter may be "BMP", "JPEG", "PNG", "GIF" or "TIFF" value ("BMP" is a default). * The Image control supports now ICON images from the resources via using of a dynamic loading of the system library GdiPlus.dll. * The CHECKBOX, FRAME and RADIOGROUP controls supports the FontColor and BackColor properties in the THEMED Operating Systems. It was a postponed user's request. * The PROGRESSBAR control supports the ForeColor and BackColor properties at a definition in the THEMED Operating Systems. * The function InputWindow() supports now an optional 11th logical parameter to use a Switcher control for a managing of the logical variables (default value is false). * The internal function ErrorMessage() will return an information about the mistaked arguments of calling function from error object. * The minor modification of a data value position in the BAR GRAPH. * Updated header file i_hmgcompat.ch for compatibility with Official HMG. * Updated HMGS-IDE v.1.4.3.8 and Sqlite3 library. * Added the new interesting samples and updated some Basic and Advanced samples. [/pre2]Благодарю за внимание
SergKis: gfilatov2002 Предлагаю добавить [pre2] HB_FUNC ( ENUMWINDOWS ) { PHB_ITEM pArray = hb_itemArrayNew( 0 ); EnumWindows( ( WNDENUMPROC ) EnumWindowsProc, ( LPARAM ) pArray ); hb_itemReturnRelease( pArray ); pArray = NULL; } тогда можно получать handle внешних программ так (эту ф-ю можно не вкл. lib) *-----------------------------------------------------------------------------* STATIC FUNCTION HandlesHbWin( cText, cClass, lUpper ) *-----------------------------------------------------------------------------* LOCAL i, h, t LOCAL aWnd := EnumWindows() LOCAL aTmp := aWnd LOCAL aRet := {} IF ! empty(cClass) AEVal( aWnd, {|hw| iif( GetClassName(hw) == cClass, AAdd( aTmp, hw ), )} ) ENDIF IF ! empty(cText) .and. HB_ISCHAR(cText) .and. Len(aTmp) > 0 lUpper := ! empty( lUpper ) IF lUpper cText := upper( cText ) ENDIF FOR EACH h IN aTmp t := GetWindowText( h ) IF lUpper ; t := upper( t ) ENDIF IF cText $ t ; AAdd( aRet, h ) ENDIF NEXT ELSE aRet := aTmp ENDIF RETURN aRet т.е. aHandle := HandlesHbWin( , 'Form1_Main' ) // окна hmg с именем Form1_Main, по доп. cText выделить нужное aWvt := HandlesHbWin( cText, 'Harbour_WVT_Class' ) // handles wvt окон aDos := HandlesHbWin( 'DOSBox ', 'SDL_app' ) // handles загруженных DosBox программ и .т.д. [/pre2]
gfilatov2002: SergKis пишет: Предлагаю добавить HB_FUNC ( ENUMWINDOWS ) Благодарю за предложение. Но вроде уже живет эта функция в примерах: - SAMPLES\Advanced\ProcInfo; - SAMPLES\Advanced\ExternalApp_2 Кстати, там еще д.б. сишная дополнительная функция EnumWindowsProc, которая заполняет массив pArray
SergKis: gfilatov2002 пишет Но вроде уже живет эта функция в примерах Не увидел, пропустил. Хорошо, что есть в примерах, мне не хватило в lib. Пришлось позаниматься управлением внешних программ из hmg. Предложил по причине, что она более удобна, во многих случаях, чем та которая есть в hmg FindWindow
gfilatov2002: SergKis пишет: Предложил по причине, что она более удобна Буду рассматривать эту функцию для следующей сборки. Поскольку подготовка декабрьского релиза уже завершена, и эта сборка будет опубликована завтра.
gfilatov2002: Опубликована новая сборка 19.12 для BCC 5.8.2 и компиляторов Harbour и xHarbour. Базовый дистрибутив находится по адресу http://hmgextended.com/files/CONTRIB/hmg-19.12-setup.exe Добавил также архив для бесплатного Embarcadero C++ 10.1 Berlin compiler http://hmgextended.com/files/CONTRIB/hmg1912_bcc101.exe Благодарю Сергея Киселева и Андрея Верченко за помощь при подготовке этого релиза
SergKis: gfilatov2002 пишет Добавил также архив для бесплатного Embarcadero C++ 10.1 Berlin compiler Установил, собрал несколько примеров. Работают. Спасибо
SergKis: gfilatov2002 Может стоит заменить в InitCodePage() использование ф-ии cLang := hb_UserLang() на что то другое, т.к. она не точна, т.е.[pre2] REQUEST HB_CODEPAGE_LVWIN, HB_LANG_LV function main() LOCAL i hb_cdpSelect( "LVWIN" ) HB_LANGSELECT("LV") SET DATE GERMAN ? HB_LANGSELECT(), hb_UserLang(), Set ( _SET_LANGUAGE ) for i := 1 to 12 ? hb_StrToUtf8(CMONTH(CTOD("01."+StrZero(i,2)+".2019"))) next ? "" for i := 1 to 7 ? hb_StrToUtf8(CDOW(Date() + i)) next ... будет результат LV.LVWIN ru-RU LV.LVWIN Janvāris Februāris Marts Aprīlis Maijs Jūnijs Jūlijs Augusts Septembris Oktobris Novembris Decembris '' Sestdiena Svētdiena Pirmdiena Otrdiena Trešdiena Ceturtdiena Piektdiena [/pre2] Все правильно, кроме выделенного цветом, а это работа hb_UserLang()
gfilatov2002: SergKis пишет: заменить в InitCodePage() использование ф-ии cLang := hb_UserLang() Работа этой функция основана на WinAPI функции GetUserDefaultLangID(). Кроме того, она используется для определения языка пользователя в утилите hbmk2 Кстати, для того чтобы исправить поведение этой функции, можно определить системную константу LANG. Если эта глобальная переменная определена, то значение для возврата функции берется из нее. set LANG=lv-LV
SergKis: gfilatov2002 Спасибо за разъяснение По сути, в работе hb_UserLang() лучше не использовать, что бы не колбаситься с Set LANG=lv-LV
gfilatov2002: Подготовил 1-й релиз-кандидат для новой сборки 20.01 со следующим списком изменений (кратко): [pre2] * Added the new C-function C_SaveHIconToFile( cIconName, { hIcon1, ... } ) for saving a multipages icon to a disk file. * Added the new useful C-functions - ShowBalloonTip ( hWnd, cText [ , cTitle ] [ , nTypeIcon ] ) - HideBalloonTip ( hWnd ) for displaying a balloon tip associated with an edit control. * Added the useful C-function aHWnds := EnumWindows() for retrieving of an array of the external windows handles. * Added the optional ON INIT <bBlock> clause to a TextBox control. It was a postponed modification. * Synchronized Extended HMG for compatibility with Official HMG: - New: Added a readonly property 'ColumnCount' for Browse/Grid; - New: Added a read/write property 'ColumnDisplayPosition' for Browse and Grid controls. Based upon a C-code contributed by Petr Chornyj which fixes GPF in the official version (hb_xfree must be used for hb_xgrab memory). - New: Added the following properties for Forms: - ThisWindow | <FormName>.AlphaBlendTransparent := nAlphaBlend (0 to 255, Completely Transparent = 0, Opaque = 255); - ThisWindow | <FormName>.BackColorTransparent := aRGBColor. * Updated header file i_hmgcompat.ch for compatibility with Official HMG. * Updated Harbour Compiler 3.2.0dev: - New: Added the Harbour HbMxml contrib library is based upon the Mini-XML library 2.7 by Michael R Sweet. * Updated HMGS-IDE v.1.4.3.9, RDDLeto and Sqlite3 libraries. * Added the new interesting samples and updated some Basic and Advanced samples. [/pre2]Благодарю за ваше внимание
Andrey: gfilatov2002 пишет: Подготовил 1-й релиз-кандидат для новой сборки 20.01
gfilatov2002: Завершена подготовка новой сборки 20.01, которая будет опубликована на следующей неделе. Уже готовы дистрибутивы для следующих Си-компиляторов: - Borland C++ 5.8; - Borland/Embarcadero C++ 10.1; - MinGW GNU C 9.2.1 (32-bit и 64-bit); - MS Visual C++ 2019 19.24.28314 (32-bit и 64-bit). Если у Вас есть дополнения (или идеи) для реализации в библиотеке Минигуи, то я с удовольствием их учту при подготовке следующей сборки. Благодарю за внимание
gfilatov2002: Опубликована новая сборка 20.01 для BCC 5.8.2 и компиляторов Harbour и xHarbour. Базовый дистрибутив находится по адресу http://hmgextended.com/files/CONTRIB/hmg-20.01-setup.exe Добавил также архив для бесплатного Embarcadero C++ 10.1 Berlin compiler http://hmgextended.com/files/CONTRIB/hmg2001_bcc101.exe Это - юбилейная 100-я сборка библиотеки и, возможно, последняя в ее истории. Выпуск последующих обновлений будет зависеть от активности и поддержки со стороны пользователей ее (библиотеки) разработки. Отдельная благодарность - Андрею Верченко, Диме (админу этого форума) и Саше Савову из Болгарии за их материальную поддержку
kkg: а функция GetControlTabPage доступна в текущей версии ?
gfilatov2002: kkg пишет: функция GetControlTabPage доступна Нет, теперь это служебная внутренняя функция
kkg: А ещё вопросик, на Embarcadero текущая версия bcc102. Можно ли получить ссылочку на bcc101 ?
gfilatov2002: kkg пишет: ссылочку на bcc101 ? Полная версия этого Си-компилятора включена в поставку по адресу http://hmgextended.com/files/CONTRIB/hmg2001_bcc101.exe т.е. эта сборка полностью готова к работе (ничего дополнительно скачивать не требуется).
kkg: Спасибо.
kkg: Ещё раз спасибо за http://hmgextended.com/files/CONTRIB/hmg2001_bcc101.exe миграция прошла успешно, не сработала команда LOAD WINDOW и не хватило в поставке библиотеки HbXlsXml но это мелочи.
gfilatov2002: Обновил сборку 20.01 (Update 2) с учетом последних наработок Базовый дистрибутив для BCC 5.8.2 находится по адресу http://hmgextended.com/files/CONTRIB/hmg-20.01-setup.exe Что нового: [pre2] * Updated: Synchronized Extended HMG for compatibility with Official HMG: - Fixed: 'HeaderImages' property for Grid and Browse controls was not showed automatically after the above controls definition. This property is a character array containing image filenames or resource names (one for each column). Problem was reported by Ivanil Marcelino <ivanil/at/linkbr.com.br>. Contributed by Grigory Filatov <gfilatov@inbox.ru> (see demo in folder \samples\Basic\BROWSE_8) (see demo.prg in folder \samples\Basic\Grid_Test) * Updated: Harbour Compiler 3.2.0dev (SVN 2020-01-31 15:34). Contributed by Grigory Filatov <gfilatov@inbox.ru> (look at ReadMe.txt in folder \harbour) * Updated: 'Sort Grid Columns' sample: - using of standard OnInit event instead of tricky OnGotFocus event. Contributed by Grigory Filatov <gfilatov@inbox.ru> (see in folder \samples\Basic\HeaderImage) [/pre2]
kkg: Добрый день, в BCC101 функции aMonths(), CDOW( Date()) как то неправильно реагируют на REQUEST HB_LANG_RUWIN HB_LANGSELECT( "RUWIN" ) это лечится ? Спасибо.
gfilatov2002: kkg пишет: это лечится ? Для русского языка можно написать свои функции-аналоги Другие (не кириллические) языки отрабатывают нормально
kkg: gfilatov2002 пишет: Для русского языка можно написать свои функции-аналоги спасибо.
gfilatov2002: Обновил сборку 20.01 (Update 3) с учетом последних наработок Базовый дистрибутив для BCC 5.8.2 находится по адресу http://hmgextended.com/files/CONTRIB/hmg-20.01-setup.exe Кстати, там исправлена ошибка с неправильной нумерацией замороженных столбцов в Tbrowse с использованием enumerator, которая озвучивалась здесь, на форуме
kkg: gfilatov2002 пишет: Обновил сборку 20.01 (Update 3) а можно в стандартный комплект поставки bcc101 добавить библиотечку SQLMIX (hbsqldd.lib) ? Спасибо.
SergKis: gfilatov2002 Надо поправить [pre2] METHOD LoadFields( lEditable, aColSel, cAlsSel, aNameSel, aHeadSel ) CLASS TSBrowse ... Local cTmp ... If ValType(::aHeaders) == "A" .and. ! empty(::aHeaders) .and. n <= Len( ::aHeaders ) cHeading := ::aHeaders[ n ] IF CRLF $ cHeading cData := "" FOR EACH cTmp IN hb_ATokens(cHeading, CRLF) IF Len(cTmp) > Len(cData) cData := cTmp EndIf NEXT cHeading := cData cData := NIL ENDIF Else cHeading := ::Proper( ( cAlias )->( Field( nE ) ) ) EndIf ... [/pre2]
gfilatov2002: SergKis пишет: Надо поправить При добавлении этого кода в заголовок таблицы попадет только одна строка наибольшей длины из много-строчного заголовка. Остальные строки этого много-строчного заголовка будут удалены. В чем смысл этой поправки
SergKis: gfilatov2002 пишет При добавлении этого кода в заголовок таблицы попадет только одна строка наибольшей длины из много-строчного заголовка. Остальные строки этого много-строчного заголовка будут удалены. В чем смысл этой поправки Эта поправка для правильного расчета ширины колонки, берется самое длинное слово для участия в расчете, иначе ширина колонки получается по всем словам с учетом CRLF. Текст в header потом выводится правильный, полностью все с переносом и ширина max от выделенного слова и значения в колонке. Так работает в моей версии. После такой правки колонка после LoadFields рассчитана хорошо и показывает аналогично.
SergKis: gfilatov2002 пишет При добавлении этого кода в заголовок таблицы попадет только одна строка наибольшей длины из много-строчного заголовка. Прошу прощения, упустил, что у меня стоит перед созданием колонки [pre2] If ValType(::aHeaders) == "A" .and. ! empty(::aHeaders) .and. n <= Len( ::aHeaders ) // .08. cHeading := ::aHeaders[ n ] EndIf If HB_ISARRAY( aHeadSel ) .and. Len( aHeadSel ) > 0 .and. n <= Len( aHeadSel ) .and. aHeadSel[ n ] != Nil cHeading := aHeadSel[ n ] EndIf т.е. восстанавливаются данные cHeading + я упустил из вида вариант If HB_ISARRAY( aHeadSel ) .and. Len( aHeadSel ) > 0 .and. n <= Len( aHeadSel ) .and. aHeadSel[ n ] != Nil cHeading := aHeadSel[ n ] EndIf при выделении слова из заголовка. Наверно проще переделать так Local cTmp, cHead ... If ValType(::aHeaders) == "A" .and. ! empty(::aHeaders) .and. n <= Len( ::aHeaders ) // .08. cHeading := ::aHeaders[ n ] cHead := cHeading Else cHeading := ::Proper( ( cAlias )->( Field( nE ) ) ) EndIf If HB_ISARRAY( aHeadSel ) .and. Len( aHeadSel ) > 0 .and. n <= Len( aHeadSel ) .and. aHeadSel[ n ] != Nil cHeading := aHeadSel[ n ] cHead := cHeading EndIf IF CRLF $ cHeading cData := "" FOR EACH cTmp IN hb_ATokens(cHeading, CRLF) IF Len(cTmp) > Len(cData) cData := cTmp EndIf NEXT cHeading := cData cData := NIL ENDIF ... If HB_ISCHAR(cHead) cHeading := cHead EndIf cBlock := 'FieldWBlock("' + aStru[ nE, 1 ] + '",Select("' + cAlias + '"))' ::AddColumn( TSColumn():New( cHeading, FieldWBlock( aStru[ nE, 1 ], Select( cAlias ) ),cPicture, ; ... [/pre2]
SergKis: PS Правда у меня всегда включен расчет nSize, т.е. [pre2] cPicture := "@K "+cPicture EndIf // If nSize == Nil cData := ( cAlias )->( FieldGet( nE ) ) ... nSize += If( ! Empty( cOrder ), 14, 0 ) //V90 // EndIf [/pre2] но это связано связано с переносом :LoadFields(...) под команды файла ch, изложенное во флайме сегодня.
gfilatov2002: SergKis пишет: проще переделать так Да, после такой переделки обработка заголовка отработала нормально Благодарю за помощь
Andrey: SergKis пишет: Эта поправка для правильного расчета ширины колонки, берется самое длинное слово для участия в расчете, иначе ширина колонки получается по всем словам с учетом CRLF. Текст в header потом выводится правильный, полностью все с переносом и ширина max от выделенного слова и значения в колонке. Так работает в моей версии. После такой правки колонка после LoadFields рассчитана хорошо и показывает аналогично. Классно ! Это когда будет включено в МиниГуи ? А то у меня своя функция криво работает...
SergKis: gfilatov2002 Поправил у себя [pre2] METHOD AdjColumns( aColumns, nDelta ) CLASS TSBrowse // BK 2018.03.20 ... LOCAL nBrwLen := GetWindowWidth( ::hWnd ) - iif( ::lNoVScroll, 0, GetVScrollBarWidth() ) - ; iif( HB_ISNUMERIC(nDelta), nDelta, 1 ) IF HB_ISLOGICAL(aColumns) IF ! aColumns ; RETURN NIL ENDIF aColumns := NIL ENDIF If empty(aColumns) ... [/pre2]
gfilatov2002: SergKis пишет: Поправил у себя Добавил такую проверку также
SergKis: gfilatov2002 Предлагаю добавить проверку [pre2] IF w > GetDesktopWidth() ; w := GetDesktopWidth() ENDIF IF h > ( GetDesktopHeight() - GetTaskBarHeight() ) ; h := GetDesktopHeight() - GetTaskBarHeight() ENDIF перед строкой с mVar := '_' + FormName в функции FUNCTION _DefineWindow ( FormName, Caption, x, y, w, h, nominimize, nomaximize, ; FUNCTION _DefineModalWindow ( FormName, Caption, x, y, w, h, Parent, nosize, nosysmenu, nocaption, aMin, aMax, ; [/pre2] Если высота ширина заданы, то есть шанс при переносе на др. комп, с др. монитором попадать на размеры окна > экрана, что произошло с примером CBru.exe на др. pc.
SergKis: PS У меня, еще, такая штука присутствует [pre2] IF y > 0 .and. y < 1 ; y := int( GetClientHeight(0) * y ) ENDIF IF x > 0 .and. x < 1 ; x := int( GetClientWidth (0) * x ) ENDIF IF w > 0 .and. w < 1 ; w := int( GetClientWidth (0) * w ) ENDIF IF h > 0 .and. h < 1 ; h := int( GetClientHeight(0) * h ) ENDIF IF w > GetClientWidth (0) ; w := GetClientWidth (0) ENDIF IF h > GetClientHeight(0) ; h := GetClientHeight(0) ENDIF ... для управления положением окна с отключенным CENTER WINDOW ... , т.е. DEFINE WINDOW Form_0 ; At 0.5,0.5 ; WIDTH 0.5 ; HEIGHT 0.5 ; ... разместит окно в правом нижнем углу [/pre2] но может это и баловство ?
gfilatov2002: SergKis пишет: добавить проверку Благодарю за предложение. Пока сделал эту проверку таким образом: IF ! ISNUMBER( w ) .AND. ! ISNUMBER( h ) ... ELSE w := Min( w, GetDesktopWidth() ) h := Min( h, GetDesktopHeight() - GetTaskBarHeight() ) ENDIF mVar := '_' + FormName ...
SergKis: gfilatov2002 пишет Пока сделал эту проверку таким образом: В большинстве случаев задаю ширину, высоту окон в процентном отношении к клиентской обл. Descktop, т.е. w := GetClientWidth(0) * 0.4 h := GetClientHeight(0)*0.6 оказалось, что удобно располагать окно по координатам, также в процентах, т.е. запись удобна [pre2] DEFINE WINDOW Form_0 ; At 0.4,0.6 ; WIDTH 0.4 ; HEIGHT 0.6 ; для расположения в правом нижнем углу экрана DEFINE WINDOW Form_0 ; At 0,0.6 ; WIDTH 0.4 ; HEIGHT 0.6 ; для расположения в правом верхнем углу экрана DEFINE WINDOW Form_0 ; At 0.4,0 ; WIDTH 0.4 ; HEIGHT 0.5 ; в левом нижнем и т.д. т.е. оформив y,x,w,h как параметры, на мой взгляд, удобно динамически, при вызовах, задавать позиции и размеры окна. Это актуально для небольших, в размерах, справочниках. Располагая сразу, при вызове, удобно для клиента, часто, не надо делать запоминание координат и размеров для одного и того же окна справочника. [/pre2]
SergKis: gfilatov2002 Не было учтено в ch для tbrowse :lAdjColumn := .T. Сделал у себя так [pre2] Function _DefineTBrowse ( ControlName, ParentFormName, nCol, nRow, nWidth, nHeight,; ... oBrw:nHeightCell += 4 IF ! ( Adjust == NIL .and. lAdjust == NIL ) IF HB_ISLOGICAL(lAdjust) .and. lAdjust Adjust := lAdjust ENDIF IF Adjust != NIL oBrw:AdjColumns(Adjust) ENDIF ENDIF ... METHOD AdjColumns( aColumns, nDelta ) CLASS TSBrowse // BK 2018.03.20 ... IF HB_ISLOGICAL(aColumns) IF ! aColumns ::lAdjColumn := .T. RETURN NIL ENDIF aColumns := NIL ENDIF ... тогда в примере CBru.prg ... DEFINE TBROWSE oBrw AT nY, nX ALIAS cAlias WIDTH nW HEIGHT nH GRID ; ... FOOTERS .T. ; LOADFIELDS FIXED ... не будет работать :AdjColumns() ... FOOTERS .T. ; LOADFIELDS FIXED ; COLADJUST .T. // или {...} будет работать :AdjColumns(.T.) // :AdjColumns({...}) FOOTERS .T. ; LOADFIELDS FIXED ; COLADJUST .F. будет работать :AdjColumns(.F.), т.е. установка :lAdjColumn := .T. [/pre2]
gfilatov2002: SergKis пишет: Не было учтено в ch для tbrowse Благодарю за поправку
gfilatov2002: Обновил сборку 20.01 (Update 4) с учетом последних предложений Сергея Киселева Базовый дистрибутив для BCC 5.8.2 находится по адресу http://hmgextended.com/files/CONTRIB/hmg-20.01-setup.exe Обновил также архив для бесплатного Embarcadero C++ 10.1 Berlin compiler по адресу http://hmgextended.com/files/CONTRIB/hmg2001_bcc101.exe Благодарю за ваше внимание
gfilatov2002: Обновил сборку 20.01 (Update 5) с учетом последних наработок Базовый дистрибутив для BCC 5.8.2 находится по адресу http://hmgextended.com/files/CONTRIB/hmg-20.01-setup.exe Обновил также архив для бесплатного Embarcadero C++ 10.1 Berlin compiler по адресу http://hmgextended.com/files/CONTRIB/hmg2001_bcc101.exe Выпуск дальнейших обновлений (и сборок) не планируется по понятным причинам...
gfilatov2002: Снова обновил сборку 20.01 (Update 6) с учетом последних наработок Базовый дистрибутив для BCC 5.8.2 находится по адресу http://hmgextended.com/files/CONTRIB/hmg-20.01-setup.exe Обновил также архив для бесплатного Embarcadero C++ 10.1 Berlin compiler по адресу http://hmgextended.com/files/CONTRIB/hmg2001_bcc101.exe Добавлен новый/старый редактор форм GuiDes Андрею должно понравится такое изменение: * Fixed: Removed ButtonEx`s flickering at a MOUSEHOVER event. Contributed by Milomir Zecevic <zeka/at/bnbos.rs> (see menulist_2.prg in folder \samples\Advanced\MenuList)
SergKis: gfilatov2002 пишет Снова обновил сборку 20.01 (Update 6) с учетом последних наработок Андрей говорил, дать правку для TBrowse, а я не дал. Для одинаковой работы с колонкой в :bDecode и :bPrevEdit[pre2] METHOD Edit( uVar, nCell, nKey, nKeyFlags, cPicture, bValid, nClrFore, ; ... If oCol:bPrevEdit != Nil If ::lIsArr .and. ( ::lAppendMode .or. ::nAt > Len( ::aArray ) ) // append mode for arrays ElseIf nKey != VK_RETURN // GF 15-10-2015 uVar := Eval( oCol:bPrevEdit, uValue, Self, nCell, oCol ) If ValType( uVar ) == "L" .and. ! uVar nKey := VK_RETURN EndIf EndIf EndIf ... METHOD KeyDown( nKey, nFlags ) CLASS TSBrowse ... ::oWnd:nLastKey := nKey If ::aColumns[ nCol ]:bPrevEdit != Nil If ::lIsArr .and. ( ::lAppendMode .or. ::nAt > Len( ::aArray ) ) // append mode for arrays Else // GF 16-05-2008 uVal := ::bDataEval( ::aColumns[ nCol ] ) uVal := Eval( ::aColumns[ nCol ]:bPrevEdit, uVal, Self, nCol, ::aColumns[ nCol ] ) If ValType( uVal ) == "L" .and. ! uVal Return 0 EndIf EndIf EndIf... ... что бы не делать доп. переменных, а использовать :cargo колонки, например (от Андрея): a2Dim4 := Get2DimCol4() // получить массив для колонки 4 меняем oCol := oBrw:GetColumn("Name_4") oCol:Cargo := Get2DimCol4() // получить массив для колонки 4 oCol:bDecode := {|val,ob,nc,oc| nc:=ob, Select2Array(val, oc:Cargo) } oCol:nAlign := DT_CENTER oCol:cPicture := REPL("x",25) oCol:lEdit := .T. oCol:bPrevEdit := {|val,ob,nc,oc| SelectWho(ob, oc:Cargo), WriteColum4(ob), ob:Setfocus(), FALSE } ... [/pre2]
полная версия страницы