Автор | Сообщение |
gfilatov
|
| модератор
|
Пост N: 699
Зарегистрирован: 25.05.05
|
|
Отправлено: 29.01.08 13:59. Заголовок: Новая версия Расширенного релиза библиотеки MiniGUI (часть VI ) (продолжение)
Начало темы находится здесь, а теперь АНОНС * АНОНС * АНОНС * АНОНС * АНОНС Готовится к опубликованию новая сборка №48, которая выйдет в конце недели. Если у Вас есть интересные наработки для включения в новый релиз, то сейчас самое удобное время для их отправки мне Кратко, что нового: - исправление обнаруженных ошибок и неточностей кода; - новый класс HEADERIMAGE для Grid и Browse; - свойство Address в Hyperlink может теперь открывать папку или файл на диске; - добавлен NOTABSTOP класс для Browse; - поддержка пользовательских компонентов (заимствована из оффициального релиза); - расширения и исправления в библиотеках TsBrowse и PropGrid; - обновлены сборки Харбор и HMGS-IDE; - новые и обновленные старые примеры (как обычно ).
| |
|
Ответов - 300
, стр:
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
All
[только новые]
|
|
Haz
|
| |
Пост N: 1492
Зарегистрирован: 20.02.11
|
|
Отправлено: 27.04.19 07:55. Заголовок: SergKis пишет: Ente..
SergKis пишет: цитата: | Enter просто перемещает на след. строку в той же колонке. В целом удобно, без мыши проделать операции. |
| Никогда не пользовался в данном виде. Стрелками проще UP/DOWN. Раз будет переменная, будет и выбор на любой вкус.
| |
|
SergKis
|
| постоянный участник
|
Пост N: 2474
Зарегистрирован: 17.02.12
|
|
Отправлено: 27.04.19 08:48. Заголовок: Haz пишет Никогда не..
Haz пишет цитата: | Никогда не пользовался в данном виде. Стрелками проще UP/DOWN. |
| Такой режим существовал и не стоит его трогать. Для переменной, возможен вариант 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. .T. - включит для всех, остальные значения - работа от значения :lCheckBoxNoReturn в колонке
| |
|
Haz
|
| |
Пост N: 1493
Зарегистрирован: 20.02.11
|
|
Отправлено: 27.04.19 09:12. Заголовок: SergKis пишет: Тако..
SergKis пишет: цитата: | Такой режим существовал и не стоит его трогать. |
| Да пусть живет Главное всегда должен быть выбор. И про него сейчас разговор. Мне больше две переменные нравятся в твоем последнем предложении.
| |
|
Andrey
|
| постоянный участник
|
Пост N: 6278
Зарегистрирован: 12.09.06
|
|
Отправлено: 28.04.19 21:56. Заголовок: Перешёл на новую вер..
Перешёл на новую версию МиниГуи. Опять вылетает с ошибкой: 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 Т.е. выдаёт ошибку на работающем коде @ 230, 50 IMAGE Image_Warning PARENT Form_Calc ; PICTURE 'Warning128' WIDTH 128 HEIGHT 128 ; STRETCH TRANSPARENT BACKGROUNDCOLOR aBackColor INVISIBLE Григорий, верни назад как ранее была обработка, как советовал Сергей ! h_controlmisc.prg line 4025 CASE Arg3 == "BACKCOLOR" .OR. Arg3 == "GRADIENTOVER" .OR. Arg3 == "BACKGROUNDCOLOR" добавь и пересобери libу Вот это помогло !
| |
|
Andrey
|
| постоянный участник
|
Пост N: 6279
Зарегистрирован: 12.09.06
|
|
Отправлено: 30.04.19 14:56. Заголовок: В новой версии опять..
В новой версии опять часто вылетает на такой ошибке: 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
|
| moderator
|
Пост N: 1503
Зарегистрирован: 11.02.10
|
|
Отправлено: 30.04.19 16:58. Заголовок: Andrey пишет: Можно..
Andrey пишет: цитата: | Можно туда (до строки 341) вставить проверку |
| Поправил, конечно Благодарю за сообщение
| |
|
gfilatov2002
|
| moderator
|
Пост N: 1504
Зарегистрирован: 11.02.10
|
|
Отправлено: 02.05.19 09:55. Заголовок: Обновил сборку 19.04..
Обновил сборку 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
|
| постоянный участник
|
Пост N: 6280
Зарегистрирован: 12.09.06
|
|
Отправлено: 03.05.19 16:36. Заголовок: gfilatov2002 пишет: ..
gfilatov2002 пишет: цитата: | Обновил сборку 19.04 (Update 1) с учетом последних исправлений (в TsBrowse и др,) |
| Григорий, про это не забудь пожалуйста: h_controlmisc.prg line 4025 CASE Arg3 == "BACKCOLOR" .OR. Arg3 == "GRADIENTOVER" .OR. Arg3 == "BACKGROUNDCOLOR"
| |
|
gfilatov2002
|
| moderator
|
Пост N: 1505
Зарегистрирован: 11.02.10
|
|
Отправлено: 03.05.19 17:51. Заголовок: Andrey пишет: Arg3 ..
Andrey пишет: цитата: | Arg3 == "BACKGROUNDCOLOR" |
|
Сделал Благодарю за напоминание
| |
|
SergKis
|
| постоянный участник
|
Пост N: 2520
Зарегистрирован: 17.02.12
|
|
Отправлено: 04.05.19 07:12. Заголовок: gfilatov2002 Надо у..
gfilatov2002 Надо убрать в h_checklabel.prg, похоже пересеклись по адресам /* 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
| |
|
SergKis
|
| постоянный участник
|
Пост N: 2524
Зарегистрирован: 17.02.12
|
|
Отправлено: 04.05.19 10:30. Заголовок: PS это видно на прим..
PS это видно на примере CheckLabel_2 SET OOP ON пропадают картинки
| |
|
|
gfilatov2002
|
| moderator
|
Пост N: 1506
Зарегистрирован: 11.02.10
|
|
Отправлено: 04.05.19 10:47. Заголовок: SergKis пишет: Надо..
SergKis пишет: цитата: | Надо убрать в h_checklabel.prg |
| Сделал ремарку, конечно Благодарю за помощь
| |
|
SergKis
|
| постоянный участник
|
Пост N: 2525
Зарегистрирован: 17.02.12
|
|
Отправлено: 04.05.19 18:38. Заголовок: gfilatov2002 Давайт..
gfilatov2002 Давайте сделаем 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 Картинок можно больше складывать и на ходу менять по ситуевинам разным
| |
|
gfilatov2002
|
| moderator
|
Пост N: 1507
Зарегистрирован: 11.02.10
|
|
Отправлено: 04.05.19 20:17. Заголовок: SergKis пишет: Дава..
SergKis пишет: Сделал, конечно Благодарю за помощь
| |
|
SergKis
|
| постоянный участник
|
Пост N: 2535
Зарегистрирован: 17.02.12
|
|
Отправлено: 07.05.19 12:32. Заголовок: gfilatov2002 Сейчас..
gfilatov2002 Сейчас в тсб :Destroy() отрабатывают не на все переменные DeleteObject(), загруженных по LoadImage() и их надо отрабатывать собственными обработчиками или складывать картинки в public переменные Предлагаю добавить в тсб переменную и такой вид :Destroy() 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
| |
|
gfilatov2002
|
| moderator
|
Пост N: 1508
Зарегистрирован: 11.02.10
|
|
Отправлено: 07.05.19 13:13. Заголовок: SergKis пишет: Пред..
SergKis пишет: цитата: | Предлагаю добавить в тсб переменную и такой вид :Destroy() |
| Добавил предложенные изменения (очистка использованных ресурсов - это всегда важно) Благодарю за помощь
| |
|
gfilatov2002
|
| moderator
|
Пост N: 1509
Зарегистрирован: 11.02.10
|
|
Отправлено: 08.05.19 10:06. Заголовок: Обновил сборку 19.04..
Обновил сборку 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
|
| постоянный участник
|
Пост N: 6281
Зарегистрирован: 12.09.06
|
|
Отправлено: 14.05.19 11:06. Заголовок: Всем привет. Появила..
Всем привет. Появилась ошибка в давно работающем модуле печати. Т.е. в новой версии МиниГуи появилась ошибка. Из таблицы вызываю форму печати через &cRun(cMenu, cForma, cAls2,..), там доп.окно MODAL Form_Dolg на которой в цикле вывод 10 значений: 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 ) Оставляю курсор на форме допустим на 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
|
| постоянный участник
|
Пост N: 2546
Зарегистрирован: 17.02.12
|
|
Отправлено: 14.05.19 12:16. Заголовок: Andrey Стоит более ..
Andrey Стоит более жесткая проверка в Set\GetProperty IF .NOT. _IsControlDefined ( Arg2 , Arg1 ) MsgMiniGuiError ( "Control: " + Arg2 + " Of " + Arg1 + " Not defined." ) ENDIF Понял из твоего сообщения, что Form_Dolg закрылась при возвращении на гл. таблицу, т.е. окна нет уже. Возможно, в button_upmenutable есть обращение к контролу, которое раньше игнорировалось.
| |
|
Andrey
|
| постоянный участник
|
Пост N: 6282
Зарегистрирован: 12.09.06
|
|
Отправлено: 14.05.19 12:28. Заголовок: SergKis пишет: Поня..
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
|
| постоянный участник
|
Пост N: 2548
Зарегистрирован: 17.02.12
|
|
Отправлено: 14.05.19 13:14. Заголовок: Andrey пишет Попроб..
Andrey пишет [quote]` Попробуй убрать FUNCTION GetProperty ( Arg1 , Arg2 , Arg3 , Arg4 , Arg5 , Arg6 , Arg7 ) ... line 8584 /* IF .NOT. _IsControlDefined ( Arg2 , Arg1 ) MsgMiniGuiError ( "Control: " + Arg2 + " Of " + Arg1 + " Not defined." ) ENDIF */ и пересобери MiniGui.lib
| |
|
|
Andrey
|
| постоянный участник
|
Пост N: 6283
Зарегистрирован: 12.09.06
|
|
Отправлено: 14.05.19 14:03. Заголовок: SergKis пишет: FUNC..
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
|
| постоянный участник
|
Пост N: 6284
Зарегистрирован: 12.09.06
|
|
Отправлено: 14.05.19 14:33. Заголовок: Нашел в коде h_contr..
Нашел в коде h_controlmisc.prg, где у меня ошибка возникает: #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 За комментировал этот блок: /* IF .NOT. _IsControlDefined ( Arg2 , Arg1 ) MsgMiniGuiError ( "Control: " + Arg2 + " Of " + Arg1 + " Not defined. 4585 !!!" ) ENDIF */ Теперь другая ошибка лезет: 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(): 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 Т.е. это вызов на кнопке - ACTION aObj2But[12,12] Другие формы печати работают без ошибок, а где есть с GETBOX - то вылетает. Такое впечатление, что после GETBOX портится - MsgDebug( ThisWindow.Name, This.Name ) ?
| |
|
SergKis
|
| постоянный участник
|
Пост N: 2549
Зарегистрирован: 17.02.12
|
|
Отправлено: 14.05.19 16:22. Заголовок: Andrey Попробуй в O..
Andrey Попробуй в ON RELEASE формы с GetBox поставить самым последним вызов _PopEventInfo() для восстановления среды This, т.к. по сообщению об ошибке видно, что нет имени контрола
| |
|
SergKis
|
| постоянный участник
|
Пост N: 2550
Зарегистрирован: 17.02.12
|
|
Отправлено: 14.05.19 16:35. Заголовок: PS Дело в том, что п..
PS Дело в том, что при создании новой формы\окна информация о предыдущей форме\окне среды This теряется, что и происходит, т.е. нет гарантии, что она будет соответствовать. При Release окна среда This, которая была не восстанавливается, т.к. окна могут закрываться не в том порядке, как открывались. Выход 1. Сохранять\восстанавливать среду This самому 2. Работать без This с конкретным именем окна (основное правило hmg) 3. Раскладывать последовательность действий на события и выполнять события по сообщениям. Для каждого события будет создана среда This окна или контрола, в зависимости как укажешь в сообщении. Пример у тебя есть
| |
|
Andrey
|
| постоянный участник
|
Пост N: 6285
Зарегистрирован: 12.09.06
|
|
Отправлено: 14.05.19 18:24. Заголовок: SergKis пишет: Попр..
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 ! aObj2But[12,12] := { || SetProperty(cForm, This.Name, "Enabled", .F.) ,; DogListAbon(cForm, "nTable","","","") ,; SetProperty(cForm, "oBut_SpAbon", "Enabled", .T.) ,; Brw4Focus(nTable) } Вылет прекратился... Переделал везде где нашёл. СПАСИБО ОГРОМНОЕ ! Не забыть бы это для других случаев...
| |
|
SergKis
|
| постоянный участник
|
Пост N: 2551
Зарегистрирован: 17.02.12
|
|
Отправлено: 15.05.19 01:50. Заголовок: Andrey пишет Не забы..
Andrey пишет цитата: | Не забыть бы это для других случаев... |
| Первый вариант получше будет 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) }
| |
|
SergKis
|
| постоянный участник
|
Пост N: 2552
Зарегистрирован: 17.02.12
|
|
Отправлено: 15.05.19 10:11. Заголовок: Andrey пишет Останов..
Andrey пишет цитата: | Остановился на варианте 2 ! |
| Если использовать функцию *-----------------------------------------------------------------------------* 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) }
| |
|
SergKis
|
| постоянный участник
|
Пост N: 2553
Зарегистрирован: 17.02.12
|
|
Отправлено: 15.05.19 10:16. Заголовок: PS Упс. Магнитная бу..
PS Упс. Магнитная буря. aObj2But[12,12] := { |at| at := _ThisInfo(), ; This.Enabled := .F., ; DogListAbon(cw, "nTable","","",""), ; _ThisInfo(at), ; This.Enabled := .T., ; Brw4Focus(nTable) }
| |
|
Andrey
|
| постоянный участник
|
Пост N: 6286
Зарегистрирован: 12.09.06
|
|
Отправлено: 15.05.19 11:10. Заголовок: SergKis пишет: Перв..
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
|
| постоянный участник
|
Пост N: 2554
Зарегистрирован: 17.02.12
|
|
Отправлено: 15.05.19 11:55. Заголовок: Andrey пишет Да, это..
Andrey пишет цитата: | Да, это написание более понятней ! |
| Если исходить из правила hmg в блоке кода контрола ACTION, ON CHANGE и т.д., должна быть установлена и сохраняться среда переменных _THIS_..., то вариант с функцией более правильный, т.е. aObj2But[12,12] := { |at| at := _ThisInfo(), This.Enabled := .F., ; DogListAbon(ThisWindow.Name, "nTable","","",""), ; _ThisInfo(at), This.Enabled := .T., ; Brw4Focus(nTable) }
| |
|
|
SergKis
|
| постоянный участник
|
Пост N: 2555
Зарегистрирован: 17.02.12
|
|
Отправлено: 15.05.19 12:10. Заголовок: PS И лучше использов..
PS И лучше использовать ф-ю внутри своей DogListAbon(...) LOCAL aThis := _ThisInfo() ... ACTIVATE WINDOW ... _ThisInfo(aThis) RETURN
| |
|
gfilatov2002
|
| moderator
|
Пост N: 1510
Зарегистрирован: 11.02.10
|
|
Отправлено: 10.06.19 11:44. Заголовок: Всем кому это интересно
Подготовил 2-ю бетку для новой сборки 19.06 со следующим списком изменений: Скрытый текст
* 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)
| Постараюсь не затягивать с выпуском финальной сборки Также после нескольких попыток удалось собрать Харбор для свежей версии 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
|
| moderator
|
Пост N: 1511
Зарегистрирован: 11.02.10
|
|
Отправлено: 14.06.19 11:28. Заголовок: Завершена подготовка..
Завершена подготовка новой сборки 19.06, которая будет опубликована на следующей неделе. Я отказался от поддержки бесплатного компилятора BCC 10.1 и старой сборки для xHarbour.com вследствие нулевого интереса со стороны пользователей библиотеки. Собрал новую сборку только для слкдующих компиляторов: - BCC 5.5 (Базовый дистрибутив); - MinGW 9.1 (32- и 64-бит). Сборки для других Си-компиляторов будут выполняться только под заказ (на платной основе)
| |
|
gfilatov2002
|
| moderator
|
Пост N: 1512
Зарегистрирован: 11.02.10
|
|
Отправлено: 18.06.19 09:44. Заголовок: Всем кому это интересно
Опубликована новая сборка 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
|
| постоянный участник
|
Пост N: 6304
Зарегистрирован: 12.09.06
|
|
Отправлено: 20.06.19 18:57. Заголовок: Григорий, спасибо бо..
Григорий, спасибо большое за новую версию ! А что примеры - назначений событий на объекты формы не добавил ? Это же самые понятные примеры для новичков. Мне Сергей давно советовал делать так - через события, а я всё не понимал как это работает. В Виндах всё же через события происходят, а большинство делает по старинке, через функции. А в этих примерах всё просто демонстрируется... Да и ещё один классный пример я высылал - универсальное затенение формы со всеми объектами, включая картинки. FormDarken(1.2).7z Код маленький и короткий, удобно очень встраивать к себе в программу другим программистам.
| |
|
gfilatov2002
|
| moderator
|
Пост N: 1513
Зарегистрирован: 11.02.10
|
|
Отправлено: 26.06.19 09:51. Заголовок: Обновил сборку 19.06..
Обновил сборку 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
|
| |
Пост N: 70
Зарегистрирован: 18.06.15
|
|
Отправлено: 27.06.19 07:58. Заголовок: gfilatov2002 пишет: ..
gfilatov2002 пишет: цитата: | Обновил сборку 19.06 (Update 1) с учетом последних наработок |
| Уважаемый Григорий (повторная просьба) можно обновить хотя бы один из примеров (типа \MiniGUI\SAMPLES\Applications\MultipleMail) чтобы была возможность отправлять e-mail на mail.ru, yandex.ru и т.п. с учетом SSL. Сейчас ни один из примеров не работают ... Заранее благодарен ...
| |
|
gfilatov2002
|
| moderator
|
Пост N: 1514
Зарегистрирован: 11.02.10
|
|
Отправлено: 27.06.19 14:35. Заголовок: Alex_Cher пишет: о..
Alex_Cher пишет: цитата: | отправлять e-mail на mail.ru, yandex.ru и т.п. с учетом SSL |
| Эта тема уже обсуждалась на форуме здесь и здесь Могу только добавить, что все требуемые библиотеки для поддержки SSL есть в поставке МиниГУИ: hbtip hbssl libeay32 ssleay32.
| |
|
SergKis
|
| постоянный участник
|
Пост N: 2612
Зарегистрирован: 17.02.12
|
|
Отправлено: 01.07.19 13:13. Заголовок: gfilatov2002 Может ..
gfilatov2002 Может добавить функцию (по аналогии с HMG_GetFormControls()) ? K примеру 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
| |
|
gfilatov2002
|
| moderator
|
Пост N: 1515
Зарегистрирован: 11.02.10
|
|
Отправлено: 01.07.19 14:06. Заголовок: SergKis пишет: Може..
SergKis пишет: Принято с благодарностью
| |
|
|
gfilatov2002
|
| moderator
|
Пост N: 1516
Зарегистрирован: 11.02.10
|
|
Отправлено: 02.07.19 09:33. Заголовок: Всем кому это интересно
Адаптировал свежую версию библиотеки для работы с Microsoft Visual C++ 2019 (32- и 64-бит). По шагам: 1) скачал полный дистрибутив MSVC 2019 (примерно 22 ГБ) и установил его. 2) сделал консольную версию MSVC 2019 из вышеуказанного дистрибутива (около 454 МБ). 3) собрал компилятор Харбор из сырцов с помощью консольной версии MSVC 2019. 4) собрал и успешно протестировал библиотеку Минигуи с этим компилятором Ваши комментарии приветствуются
| |
|
Andrey
|
| постоянный участник
|
Пост N: 6321
Зарегистрирован: 12.09.06
|
|
Отправлено: 02.07.19 13:46. Заголовок: gfilatov2002 пишет: ..
gfilatov2002 пишет: цитата: | Адаптировал свежую версию библиотеки для работы с Microsoft Visual C++ 2019 (32- и 64-бит) |
| Отличная новость ! Теперь надо будет нужные проги переводить на MSVC. Надеюсь будет работать лучше, чем на BCC.
| |
|
Dima
|
| |
Пост N: 7059
Зарегистрирован: 17.05.05
|
|
Отправлено: 02.07.19 13:47. Заголовок: Andrey пишет: Надею..
Andrey пишет: цитата: | Надеюсь будет работать лучше, чем на BCC. |
| скорее всего разницы и не заметишь
| |
|
gfilatov2002
|
| moderator
|
Пост N: 1517
Зарегистрирован: 11.02.10
|
|
Отправлено: 02.07.19 14:22. Заголовок: Dima пишет: разницы..
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
|
| постоянный участник
|
Пост N: 2615
Зарегистрирован: 17.02.12
|
|
Отправлено: 03.07.19 16:48. Заголовок: gfilatov2002 Добавь..
gfilatov2002 Добавьте в CLASS TWndData 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 ) ) Пример для проверки на базе BASIC\ChildAsModal Скрытый текст
/* */ #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
|
| |
|
gfilatov2002
|
| moderator
|
Пост N: 1518
Зарегистрирован: 11.02.10
|
|
Отправлено: 03.07.19 17:32. Заголовок: SergKis пишет: Доба..
SergKis пишет: цитата: | Добавьте в CLASS TWndData |
| Спасибо, добавил
| |
|
gfilatov2002
|
| moderator
|
Пост N: 1519
Зарегистрирован: 11.02.10
|
|
Отправлено: 04.07.19 09:45. Заголовок: Обновил сборку 19.06..
Обновил сборку 19.06 (Update 2) с учетом последних наработок Базовый дистрибутив находится по адресу http://hmgextended.com/files/CONTRIB/hmg-19.06-setup.exe Что нового: Скрытый текст
* 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)
|
| |
|
SergKis
|
| постоянный участник
|
Пост N: 2627
Зарегистрирован: 17.02.12
|
|
Отправлено: 09.07.19 09:47. Заголовок: gfilatov2002 Думает..
gfilatov2002 Думается функция _hmg_OnHideFocusManagement ( i ) для окна STANDART работает не точно. Подправленный пример (был выше) тут https://TransFiles.ru/b0lgp Нажатие кнопок на окнах CHILD и MODAL работает нормально, а на окне STANDART на передний план выводится окно MAIN и потом окно AlertInf(...). Если, в ф-ии _DO_BTN_( oBtn ), убрать строку (выделено цветом) Скрытый текст
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
| окно MAIN так и останется на переднем плане в фокусе.
| |
|
gfilatov2002
|
| moderator
|
Пост N: 1520
Зарегистрирован: 11.02.10
|
|
Отправлено: 09.07.19 11:54. Заголовок: SergKis пишет: на о..
SergKis пишет: цитата: | на окне STANDART на передний план выводится окно MAIN |
| Да, это верно Но это плата за то, что у этого окна нет родительского окна-хозяина (в отличие от CHILD). SergKis пишет: цитата: | Если, в ф-ии _DO_BTN_( oBtn ), убрать строку |
| Поэтому и требуется предложенный Вами костыль. Как это победить по-другому, я не нашел...
| |
|
SergKis
|
| постоянный участник
|
Пост N: 2630
Зарегистрирован: 17.02.12
|
|
Отправлено: 09.07.19 13:05. Заголовок: gfilatov2002 пишет К..
gfilatov2002 пишет цитата: | Как это победить по-другому, я не нашел... |
| Получается при первом STANDART надо убирать MAIN в hide (костыль в придачу), тогда, вроде, похоже на правду Скрытый текст
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
|
| |
|
Andrey
|
| постоянный участник
|
Пост N: 6337
Зарегистрирован: 12.09.06
|
|
Отправлено: 16.07.19 17:11. Заголовок: Заметил такую неприя..
Заметил такую неприятность. В функциях пользуюсь определением имени формы ? ThisWindow.Name, _HMG_ThisFormName, cStaticGlobalForm возвращает: Form_Main Form_Main Form_AYC cStaticGlobalForm - делаю определение сразу под созданием окна. Т.е. должно всегда возвращаться Form_AYC !!! Значит - ThisWindow.Name, _HMG_ThisFormName нельзя использовать ? Правда у меня на форме Form_Main включён таймер на каждую секунду (для тестирования). Может он влияет на псевдо-функции ThisWindow.Name, _HMG_ThisFormName ?
| |
|
SergKis
|
| постоянный участник
|
Пост N: 2643
Зарегистрирован: 17.02.12
|
|
Отправлено: 16.07.19 18:03. Заголовок: Andrey пишет Значит ..
| |
|
SergKis
|
| постоянный участник
|
Пост N: 2644
Зарегистрирован: 17.02.12
|
|
Отправлено: 16.07.19 18:08. Заголовок: PS т.е. в TIMER блок..
PS т.е. в TIMER блоке на Form_Main ставишь aThis := _ThisInfo() // в начале ... _ThisInfo(aThis) // в конце
| |
|
SergKis
|
| постоянный участник
|
Пост N: 2645
Зарегистрирован: 17.02.12
|
|
Отправлено: 16.07.19 18:11. Заголовок: PPS Наврал, на TIMER..
PPS Наврал, на TIMER не получится, там ставится среда This для Form_Main, sory
| |
|
Andrey
|
| постоянный участник
|
Пост N: 6338
Зарегистрирован: 12.09.06
|
|
Отправлено: 16.07.19 18:24. Заголовок: Понял, что с TIMER н..
Понял, что с TIMER нужно аккуратно работать. Всё таки решение через STATIC переменную типа cStaticThisForm более простое. SergKis пишет: цитата: | Лучшее решение, по мне, функция aThis := _ThisInfo(), работаешь как с Alias(), сохраняешь\восстанавливаешь |
| Буду иметь ввиду. Уже кое где применил.
| |
|
SergKis
|
| постоянный участник
|
Пост N: 2646
Зарегистрирован: 17.02.12
|
|
Отправлено: 16.07.19 18:30. Заголовок: Andrey пишет Всё так..
Andrey пишет цитата: | Всё таки решение через STATIC переменную типа cStaticThisForm более простое. |
| Теряется универсальность. Надо каждое окно делать в отдельном prg файле, иначе для каждого окна свою переменную, что фактически означает работу по имени окна, т.е. Form_Main.Btn1.Value и т.д.
| |
|
PSP
|
| постоянный участник
|
Пост N: 1536
Зарегистрирован: 27.01.07
|
|
Отправлено: 16.07.19 19:38. Заголовок: SergKis пишет: Теря..
SergKis пишет: цитата: | Теряется универсальность. Надо каждое окно делать в отдельном prg файле, иначе для каждого окна свою переменную, что фактически означает работу по имени окна, т.е. Form_Main.Btn1.Value и т.д. |
| hash-массив не поможет в этом случае?
| |
|
Andrey
|
| постоянный участник
|
Пост N: 6339
Зарегистрирован: 12.09.06
|
|
Отправлено: 16.07.19 21:45. Заголовок: PSP пишет: hash-мас..
PSP пишет: цитата: | hash-массив не поможет в этом случае? |
| Да зачем усложнять то код написания. Нужно проще писать код, чтобы когда нужно править так лет через 10, понимать что и как написано. А то открываешь свой код написанный 12 лет назад и думаешь, кто так фигово написал то.... и почему до сих пор работает ?
| |
|
SergKis
|
| постоянный участник
|
Пост N: 2647
Зарегистрирован: 17.02.12
|
|
Отправлено: 16.07.19 22:21. Заголовок: PSP пишет Как это м..
PSP пишет [quote]` Как это может помочь при плавающем cForm WHILE _IsWindowDefined( cForm := cFrm+'_'+hb_ntos(++nFrm) ) ENDDO
| |
|
SergKis
|
| постоянный участник
|
Пост N: 2648
Зарегистрирован: 17.02.12
|
|
Отправлено: 16.07.19 22:24. Заголовок: Упс, промахнулся по ..
Упс, промахнулся по клавише. PSP пишет цитата: | hash-массив не поможет в этом случае? |
|
| |
|
SergKis
|
| постоянный участник
|
Пост N: 2649
Зарегистрирован: 17.02.12
|
|
Отправлено: 17.07.19 07:26. Заголовок: Andrey пишет Правда ..
Andrey пишет цитата: | Правда у меня на форме Form_Main включён таймер на каждую секунду (для тестирования). Может он влияет на псевдо-функции ThisWindow.Name, _HMG_ThisFormName ? |
| Предлагаю такую схему для TIMER на Form_Main Выполнение основного тела блока кода перенести на событие приложения, т.е. 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 ... Работа блока кода Timer_1 будет оч. короткой, среда This восстановлена после него, какая была. В установленном событии oDlu2Pixel():Event(1) This среда не важна, должна быть.
| |
|
SergKis
|
| постоянный участник
|
Пост N: 2650
Зарегистрирован: 17.02.12
|
|
Отправлено: 17.07.19 07:40. Заголовок: PS Точнее так WI..
PS Точнее так 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) )
| |
|
SergKis
|
| постоянный участник
|
Пост N: 2655
Зарегистрирован: 17.02.12
|
|
Отправлено: 19.07.19 10:18. Заголовок: gfilatov2002 #xcom..
gfilatov2002 #xcommand DEFINE TBROWSE <name> OBJ <obrw> ; ... [ ON INIT <bInit> ] ; ... =>; <obrw> :=_DefineTBrowse (<"name"> , ; ... [ <.lAutoCol.> ], [ \{<aColSel>\} ], ; <bInit> );; // так лучше, по мне, чем <{bInit}> with object <obrw> ... Это видно на примере https://TransFiles.ru/uw4af В моем варианте (исправленном ch) работают блоки кода *-----------------------------------------------------------------------------* 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) } ...
| |
|
SergKis
|
| постоянный участник
|
Пост N: 2658
Зарегистрирован: 17.02.12
|
|
Отправлено: 19.07.19 13:15. Заголовок: gfilatov2002 Так все..
gfilatov2002 Так все решается #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
| |
|
gfilatov2002
|
| moderator
|
Пост N: 1523
Зарегистрирован: 11.02.10
|
|
Отправлено: 19.07.19 13:53. Заголовок: SergKis пишет: В мо..
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
|
| постоянный участник
|
Пост N: 2659
Зарегистрирован: 17.02.12
|
|
Отправлено: 19.07.19 14:17. Заголовок: gfilatov2002 пишет П..
gfilatov2002 пишет цитата: | Попробуйте передавать эти блоки кода таким образом |
| Вопрос стоит передаваемых параметров в блок кода. В таком виде Eval(bInit), Eval(bEnd) параметры ( ob переменная ) не передаются {|ob| Brw_...(ob) }
| |
|
SergKis
|
| постоянный участник
|
Пост N: 2660
Зарегистрирован: 17.02.12
|
|
Отправлено: 19.07.19 14:48. Заголовок: PS Можно и без парам..
PS Можно и без параметров отработать, для блоков кода создается среда This тек. TsBrowse *-----------------------------------------------------------------------------* 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 )
| |
|
gfilatov2002
|
| moderator
|
Пост N: 1524
Зарегистрирован: 11.02.10
|
|
Отправлено: 19.07.19 17:42. Заголовок: SergKis пишет: Можн..
SergKis пишет: цитата: | Можно и без параметров отработать |
| Да, так работает
| |
|
SergKis
|
| постоянный участник
|
Пост N: 2661
Зарегистрирован: 17.02.12
|
|
Отправлено: 20.07.19 08:15. Заголовок: gfilatov2002 пишет Д..
gfilatov2002 пишет Вариант поинтересней, более "правильный" ... 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 bInit и bEnd можно убрать везде
| |
|
SergKis
|
| постоянный участник
|
Пост N: 2662
Зарегистрирован: 17.02.12
|
|
Отправлено: 20.07.19 08:48. Заголовок: PS Расширить настрой..
PS Расширить настройку TsBrowse можно так 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
| |
|
SergKis
|
| постоянный участник
|
Пост N: 2663
Зарегистрирован: 17.02.12
|
|
Отправлено: 20.07.19 10:45. Заголовок: gfilatov2002 Не рабо..
gfilatov2002 Не работает This.ToolBar_1.Caption Правка *-----------------------------------------------------------------------------* 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 Пример https://TransFiles.ru/8cp1d
| |
|
SergKis
|
| постоянный участник
|
Пост N: 2664
Зарегистрирован: 17.02.12
|
|
Отправлено: 20.07.19 11:21. Заголовок: gfilatov2002 Может ..
gfilatov2002 Может сделать в Tsb, чтобы не задумываться где какой элемент в :aSuperHead, так 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 Используем вместо :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
|
| moderator
|
Пост N: 1525
Зарегистрирован: 11.02.10
|
|
Отправлено: 20.07.19 20:58. Заголовок: SergKis пишет: Не р..
SergKis пишет: цитата: | Не работает This.ToolBar_1.Caption Правка |
| Принято с благодарностью SergKis пишет: цитата: | аналогичные методы с названием Set вместо Get |
| Выбрал этот вариант Благодарю за подсказку
| |
|
SergKis
|
| постоянный участник
|
Пост N: 2665
Зарегистрирован: 17.02.12
|
|
Отправлено: 21.07.19 13:34. Заголовок: gfilatov2002 Добави..
gfilatov2002 Добавил в пример (выше) сохранение позиции курсора при повторном нажатии на одну и ту же кнопку (с перемещением курсора на др. страницы тсб). :GotoRec(...) не работает с массивом, может кому интересно будет Тут Скрытый текст
*-----------------------------------------------------------------------------* 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
|
| |
|
SergKis
|
| постоянный участник
|
Пост N: 2666
Зарегистрирован: 17.02.12
|
|
Отправлено: 21.07.19 13:41. Заголовок: PS Строку ..
PS Строку :nCell := nCol // :Refresh() If nPos > 1 убрать можно, оставил скорее по "привычке"
| |
|
SergKis
|
| постоянный участник
|
Пост N: 2677
Зарегистрирован: 17.02.12
|
|
Отправлено: 23.07.19 19:53. Заголовок: gfilatov2002 Можно ..
gfilatov2002 Можно чуть поправить HMG_Alert(...) 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 Разницы нет, а достраивать доп. контролами удобнее в такой комбинации строк.
| |
|
gfilatov2002
|
| moderator
|
Пост N: 1527
Зарегистрирован: 11.02.10
|
|
Отправлено: 23.07.19 20:24. Заголовок: SergKis пишет: чуть..
SergKis пишет: цитата: | чуть поправить HMG_Alert(...) |
| Сделал, конечно. Благодарю за предложение
| |
|
SergKis
|
| постоянный участник
|
Пост N: 2678
Зарегистрирован: 17.02.12
|
|
Отправлено: 24.07.19 13:07. Заголовок: gfilatov2002 Не наш..
gfilatov2002 Не нашел функций в lib для использования в блоках кода для работы с RGB. Приходится все время таскать ToRGB( aColor ), n2RGB( nColor ). Может сделать что то такое *-----------------------------------------------------------------------------* 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 ) }
| |
|
gfilatov2002
|
| moderator
|
Пост N: 1528
Зарегистрирован: 11.02.10
|
|
Отправлено: 24.07.19 13:42. Заголовок: SergKis пишет: ToRG..
SergKis пишет: цитата: | ToRGB( aColor ), n2RGB( nColor ) |
| Псевдо-функция nRGB2Arr( nColor ) уже определена (и активно используется) в библиотеке и примерах. цитата: | SetProperty( cFormName, "BackColor", nRGB2Arr( GetSysColor( COLOR_WINDOW ) ) ) |
| А предложенная функция HMG_RGB2n() - это просто обертка для псевдо-функции RGB(). Если что-то неправильно понял - аргументируйте...
| |
|
SergKis
|
| постоянный участник
|
Пост N: 2679
Зарегистрирован: 17.02.12
|
|
Отправлено: 24.07.19 14:49. Заголовок: gfilatov2002 пишет а..
gfilatov2002 пишет 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)
| |
|
gfilatov2002
|
| moderator
|
Пост N: 1529
Зарегистрирован: 11.02.10
|
|
Отправлено: 24.07.19 15:03. Заголовок: SergKis пишет: HMG_..
SergKis пишет: Кстати, еще есть такая псевдо-функция ArrayRGB_TO_COLORREF(aRGB) SergKis пишет: Проще RGB(40, 122, 237)
| |
|
SergKis
|
| постоянный участник
|
Пост N: 2680
Зарегистрирован: 17.02.12
|
|
Отправлено: 24.07.19 15:09. Заголовок: gfilatov2002 пишет R..
gfilatov2002 пишет Использование псевдо функции в блоке кода приведет к сообщению Error: Unresolved external '_HB_FUN_RGB' referenced ...
| |
|
SergKis
|
| постоянный участник
|
Пост N: 2681
Зарегистрирован: 17.02.12
|
|
Отправлено: 24.07.19 15:14. Заголовок: gfilatov2002 пишет П..
gfilatov2002 пишет Мои названия RGB2n(...) и n2RGB(...) добавил HMG_... для общей схемы. Может и не надо добавлять.
| |
|
gfilatov2002
|
| moderator
|
Пост N: 1530
Зарегистрирован: 11.02.10
|
|
Отправлено: 24.07.19 15:17. Заголовок: SergKis пишет: Испо..
SergKis пишет: цитата: | Использование псевдо функции в блоке кода приведет к сообщению |
| Нет, такая ошибка не возникла в следующем коде: 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) Пример отработал нормально с этими кодо-блоками
| |
|
SergKis
|
| постоянный участник
|
Пост N: 2682
Зарегистрирован: 17.02.12
|
|
Отправлено: 24.07.19 15:29. Заголовок: gfilatov2002 пишет П..
gfilatov2002 пишет цитата: | Пример отработал нормально с этими кодо-блоками |
| Да. Отработал Мой косяк, переносил текст и перенес RGB( { 40, 122, 237 } ), RGB( YELLOW ) с лишними скобками {} Но ArrayRGB_TO_COLORREF( YELLOW ) не вспомнишь как пишется. Останусь на своих RGB2n(...), n2RGB(...) Спасибо.
| |
|
Andrey
|
| постоянный участник
|
Пост N: 6359
Зарегистрирован: 12.09.06
|
|
Отправлено: 24.07.19 17:35. Заголовок: SergKis пишет: Но A..
SergKis пишет: цитата: | Но ArrayRGB_TO_COLORREF( YELLOW ) не вспомнишь как пишется. Останусь на своих RGB2n(...), n2RGB(...) |
| Да это точно такую функцию и не вспомнишь.... да и эту тоже nRGB2Arr() Я тоже замучился из проекта в проект таскать эти ToRgb()... Сергей правильно предложил HMG_RGB2n() и HMG_n2RGB() . Можно и сократить до MG_RGB2n() и MG_n2RGB() Лишь бы были и не таскать из проекта в проект.
| |
|
SergKis
|
| постоянный участник
|
Пост N: 2683
Зарегистрирован: 17.02.12
|
|
Отправлено: 24.07.19 19:39. Заголовок: gfilatov2002 пишет а..
gfilatov2002 пишет Небольшой аргумент в пользу функций (не псевдо) - это хранение цветов в файлах ini, xml или использование hb_macroBlock(...) для создания блоков кода.
| |
|
gfilatov2002
|
| moderator
|
Пост N: 1531
Зарегистрирован: 11.02.10
|
|
Отправлено: 24.07.19 20:43. Заголовок: Andrey пишет: Серге..
Andrey пишет: цитата: | Сергей правильно предложил HMG_RGB2n() и HMG_n2RGB() |
| С учетом обсуждения (и поддержки) добавил эти макросы в заголовок i_pseudofunc.ch Теперь код ниже цитата: | 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) |
| отработал без проблем
| |
|
SergKis
|
| постоянный участник
|
Пост N: 2684
Зарегистрирован: 17.02.12
|
|
Отправлено: 25.07.19 08:21. Заголовок: gfilatov2002 Можно ..
gfilatov2002 Можно изменить в HMG_Alert() строки 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 ...
| |
|
gfilatov2002
|
| moderator
|
Пост N: 1532
Зарегистрирован: 11.02.10
|
|
Отправлено: 25.07.19 10:06. Заголовок: SergKis пишет: изме..
SergKis пишет: цитата: | изменить в HMG_Alert() строки |
| Сделал, конечно
| |
|
SergKis
|
| постоянный участник
|
Пост N: 2685
Зарегистрирован: 17.02.12
|
|
Отправлено: 25.07.19 13:59. Заголовок: gfilatov2002 Предла..
gfilatov2002 Предлагаю добавить метод в TsColumn (при работе с dbf заполняются :nFieldTyp, :nFieldLen на колонки) 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
| |
|
gfilatov2002
|
| moderator
|
Пост N: 1533
Зарегистрирован: 11.02.10
|
|
Отправлено: 25.07.19 15:03. Заголовок: SergKis пишет: доба..
SergKis пишет: цитата: | добавить метод в TsColumn |
| Принято с благодарностью
| |
|
Andrey
|
| постоянный участник
|
Пост N: 6360
Зарегистрирован: 12.09.06
|
|
Отправлено: 25.07.19 15:06. Заголовок: SergKis пишет: Пред..
SergKis пишет: цитата: | Предлагаю добавить метод в TsColumn (при работе с dbf заполняются :nFieldTyp, :nFieldLen на колонки) |
| А как код будет выглядеть ?
| |
|
SergKis
|
| постоянный участник
|
Пост N: 2686
Зарегистрирован: 17.02.12
|
|
Отправлено: 25.07.19 15:57. Заголовок: Andrey пишет А как к..
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
|
| постоянный участник
|
Пост N: 2694
Зарегистрирован: 17.02.12
|
|
Отправлено: 29.07.19 14:57. Заголовок: gfilatov2002 Предла..
gfilatov2002 Предлагаю такой HMG_Alert(), добавил параметр cFont, для исп. вместо DlgFont. Тогда можно применять Alert...() ф-ии с DlgFont. Скрытый текст
*-----------------------------------------------------------------------------* 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
| Т.е. в примере можно сделать 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 ...
| |
|
gfilatov2002
|
| moderator
|
Пост N: 1539
Зарегистрирован: 11.02.10
|
|
Отправлено: 29.07.19 16:04. Заголовок: SergKis пишет: Пред..
SergKis пишет: цитата: | Предлагаю такой HMG_Alert(), добавил параметр cFont |
| Принято
| |
|
SergKis
|
| постоянный участник
|
Пост N: 2695
Зарегистрирован: 17.02.12
|
|
Отправлено: 30.07.19 10:51. Заголовок: gfilatov2002 Можете..
gfilatov2002 Можете пояснить зачем удаляется фонт из списка, если в контролах он не создается (не увидел) ? *-----------------------------------------------------------------------------* 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 ... такая штука удаляет фонт, если он не DlgFont, созданный по DEFINE FONT ... и использованный в контроле.
| |
|
gfilatov2002
|
| moderator
|
Пост N: 1540
Зарегистрирован: 11.02.10
|
|
Отправлено: 30.07.19 11:12. Заголовок: SergKis пишет: така..
SergKis пишет: цитата: | такая штука удаляет фонт, если он не DlgFont, созданный по DEFINE FONT ... и использованный в контроле |
| Да, все верно. В момент удаления мы ведь не знаем название шрифта, а только указатель (handle) на него. Сейчас этот фрагмент кода выглядит так цитата: | FUNCTION _EraseControl ( i , p ) ... IF ISNUMERIC ( x ) .AND. !Empty ( x ) .AND. ; !( x == GetFontHandle ( "DlgFont" ) ) .AND. !( x == GetFontHandle ( _HMG_ActiveDialogFontName ) ) DeleteObject ( x ) ENDIF |
|
| |
|
SergKis
|
| постоянный участник
|
Пост N: 2696
Зарегистрирован: 17.02.12
|
|
Отправлено: 30.07.19 11:20. Заголовок: gfilatov2002 пишет В..
gfilatov2002 пишет цитата: | В момент удаления мы ведь не знаем название шрифта, а только указатель (handle) на него. |
| Зачем удалять фонт, созданный (сохранен в базе _HMG_aControlType == 'FONT') по DEFINE FONT ... ? Его удаляем по RELEASE FONT, а в контролах, если не найден в базе фонтов, используем _HMG_DefaultFontName, или фонт установленный на окно. Или я что то упускаю ?
| |
|
SergKis
|
| постоянный участник
|
Пост N: 2697
Зарегистрирован: 17.02.12
|
|
Отправлено: 30.07.19 11:23. Заголовок: PS Ведь все фонты по..
PS Ведь все фонты по DEFINE FONT ... цепляются к _FORMNAME_ 'Main' и там живут
| |
|
SergKis
|
| постоянный участник
|
Пост N: 2698
Зарегистрирован: 17.02.12
|
|
Отправлено: 30.07.19 11:38. Заголовок: PPS Если фонтов нет ..
PPS Если фонтов нет в списке DEFINE FONT ..., работают С ф-ии _SetFont(...), _SetFontHandle(...), а они не используют базу. По мне, команды удаления фонтов в _EraseControl() не нужны.
| |
|
SergKis
|
| постоянный участник
|
Пост N: 2699
Зарегистрирован: 17.02.12
|
|
Отправлено: 30.07.19 11:44. Заголовок: SergKis пишет По мне..
SergKis пишет цитата: | По мне, команды удаления фонтов в _EraseControl() не нужны |
| Уточню, если они находятся в секции 'Main' - удалять не нужно.
| |
|
gfilatov2002
|
| moderator
|
Пост N: 1541
Зарегистрирован: 11.02.10
|
|
Отправлено: 30.07.19 12:03. Заголовок: SergKis пишет: Заче..
SergKis пишет: цитата: | Зачем удалять фонт, созданный (сохранен в базе _HMG_aControlType == 'FONT') по DEFINE FONT ... ? |
| Поправил этот фрагмент кода с учетом Вашего предложения: цитата: | *-----------------------------------------------------------------------------* 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 |
|
Благодарю за помощь
| |
|
gfilatov2002
|
| moderator
|
Пост N: 1542
Зарегистрирован: 11.02.10
|
|
Отправлено: 31.07.19 10:43. Заголовок: Всем кому это интересно
Подготовил 2-й релиз-кандидат для новой сборки 19.08 со следующим списком изменений: Скрытый текст
* 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.
| Хотя эта сборка работает стабильно, выпуск финальной версии отложен по финансовым причинам
| |
|
SergKis
|
| постоянный участник
|
Пост N: 2701
Зарегистрирован: 17.02.12
|
|
Отправлено: 01.08.19 11:28. Заголовок: gfilatov2002 Может ..
gfilatov2002 Может добавить для фонта 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]
| |
|
SergKis
|
| постоянный участник
|
Пост N: 2702
Зарегистрирован: 17.02.12
|
|
Отправлено: 01.08.19 11:44. Заголовок: PS Может покороче на..
PS Может покороче назвать FontWidth(...), FontHeight(...) ?
| |
|
gfilatov2002
|
| moderator
|
Пост N: 1545
Зарегистрирован: 11.02.10
|
|
Отправлено: 01.08.19 12:18. Заголовок: SergKis пишет: доб..
SergKis пишет: Добавил конечно, но оставил названия псевдо-функций с Get (так понятнее). Благодарю за помощь
| |
|
SergKis
|
| постоянный участник
|
Пост N: 2706
Зарегистрирован: 17.02.12
|
|
Отправлено: 02.08.19 09:22. Заголовок: gfilatov2002 Предло..
gfilatov2002 Предложение добавить *-----------------------------------------------------------------------------* 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 ... Тогда в блоке кода на окно, контрол можно ставить среду This запомненную ранее, к примеру, на TIMER другого окна ACTION {|| _PopEventInfo( Len( _HMG_aEventInfo ) - 1 ), ... }
| |
|
gfilatov2002
|
| moderator
|
Пост N: 1546
Зарегистрирован: 11.02.10
|
|
Отправлено: 02.08.19 10:30. Заголовок: SergKis пишет: Пред..
SergKis пишет: Добавил, хотя эта коррекция является опасным хаком, на мой взгляд
| |
|
SergKis
|
| постоянный участник
|
Пост N: 2707
Зарегистрирован: 17.02.12
|
|
Отправлено: 02.08.19 10:55. Заголовок: gfilatov2002 пишет Д..
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
|
| moderator
|
Пост N: 1547
Зарегистрирован: 11.02.10
|
|
Отправлено: 02.08.19 11:01. Заголовок: SergKis пишет: пони..
SergKis пишет: цитата: | понимать, что происходит, конечно надо |
| Вот в этом и проблема - обычно пользователи библиотеки (они же прикладные разработчики) редко хотят заморачиваться такими вещами. Но как дополнительная возможность - не помешает, я думаю.
| |
|
SergKis
|
| постоянный участник
|
Пост N: 2709
Зарегистрирован: 17.02.12
|
|
Отправлено: 04.08.19 10:03. Заголовок: gfilatov2002 Поправ..
gfilatov2002 Поправил LoadFields() для работы с др. alias Скрытый текст
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
| Пример для проверки https://TransFiles.ru/1z51g
| |
|
SergKis
|
| постоянный участник
|
Пост N: 2710
Зарегистрирован: 17.02.12
|
|
Отправлено: 04.08.19 11:06. Заголовок: PS Для работы с MEMI..
PS Для работы с MEMIO (пропустил, не доделал), надо 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' ... и Compile.bat call ..\..\..\batch\compile.bat demo /l hbmemio %1 %2 %3 %4 %5 %6 %7 %8 %9
| |
|
SergKis
|
| постоянный участник
|
Пост N: 2711
Зарегистрирован: 17.02.12
|
|
Отправлено: 04.08.19 13:47. Заголовок: PPS Если сделать изм..
PPS Если сделать изменения, то можно менять поля в dbf из которого выборка :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. })
| |
|
gfilatov2002
|
| moderator
|
Пост N: 1548
Зарегистрирован: 11.02.10
|
|
Отправлено: 04.08.19 18:55. Заголовок: SergKis пишет: Попр..
SergKis пишет: цитата: | Поправил LoadFields() для работы с др. alias |
| Принято с благодарностью
| |
|
SergKis
|
| постоянный участник
|
Пост N: 2712
Зарегистрирован: 17.02.12
|
|
Отправлено: 05.08.19 10:17. Заголовок: gfilatov2002 Андрей..
gfilatov2002 Андрей сказал, что у меня в примере простая карточка, без вызова справочника. Исправил пример, добавив имитацию вызова справочников у 2х GetBox кнопками Так же сделал на этих GetBox F5 и DublClick для вызова справочника + ToolTip информация Пример тут https://TransFiles.ru/ocym6
| |
|
SergKis
|
| постоянный участник
|
Пост N: 2713
Зарегистрирован: 17.02.12
|
|
Отправлено: 05.08.19 11:02. Заголовок: PS Небольшая бяка в ..
PS Небольшая бяка в примере. Если карточка изменена, фокус на GetBox и нажимаем Esc, то запрос на сохранение карточки, сделанный на AletYesNo(...), улетает в координаты 0,0. Правка такая 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+ ; ...
| |
|
gfilatov2002
|
| moderator
|
Пост N: 1549
Зарегистрирован: 11.02.10
|
|
Отправлено: 05.08.19 11:24. Заголовок: SergKis пишет: Испр..
SergKis пишет: цитата: | Исправил пример, добавив имитацию вызова справочников у 2х GetBox кнопками |
| Благодарю за помощь
| |
|
SergKis
|
| постоянный участник
|
Пост N: 2714
Зарегистрирован: 17.02.12
|
|
Отправлено: 05.08.19 15:11. Заголовок: gfilatov2002 Если д..
gfilatov2002 Если добавить методы в 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) )
| |
|
gfilatov2002
|
| moderator
|
Пост N: 1550
Зарегистрирован: 11.02.10
|
|
Отправлено: 05.08.19 15:35. Заголовок: SergKis пишет: доба..
SergKis пишет: Добавил эти методы, но, конечно, переименовал SetDublClick в SetDoubleClick Благодарю за помощь
| |
|
SergKis
|
| постоянный участник
|
Пост N: 2716
Зарегистрирован: 17.02.12
|
|
Отправлено: 05.08.19 20:58. Заголовок: gfilatov2002 Мелочь..
gfilatov2002 Мелочь, но поправьте #translate System.ClientWidth => ( GetDesktopWidth () - GetBorderWidth () ) #translate System.ClientHeight => ( GetDesktopHeight() - GetBorderHeight() - GetTaskBarHeight() )
| |
|
gfilatov2002
|
| moderator
|
Пост N: 1551
Зарегистрирован: 11.02.10
|
|
Отправлено: 05.08.19 21:17. Заголовок: SergKis пишет: попр..
SergKis пишет: OK
| |
|
SergKis
|
| постоянный участник
|
Пост N: 2717
Зарегистрирован: 17.02.12
|
|
Отправлено: 06.08.19 10:47. Заголовок: gfilatov2002 Для пр..
gfilatov2002 Для простого определения принадлежности колонки к алиасу добавил 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 ...
| |
|
gfilatov2002
|
| moderator
|
Пост N: 1552
Зарегистрирован: 11.02.10
|
|
Отправлено: 06.08.19 11:07. Заголовок: SergKis пишет: опре..
SergKis пишет: цитата: | определения принадлежности колонки к алиасу добавил |
| Продублировал эти изменения также, хотя и не очень понятно, почему недостаточно цитата: | ATail( ::aColumns ):cAlias := cAlias |
| и требуется дублировать это значение в еще одну переменную cArea
| |
|
SergKis
|
| постоянный участник
|
Пост N: 2718
Зарегистрирован: 17.02.12
|
|
Отправлено: 06.08.19 13:44. Заголовок: gfilatov2002 пишет т..
gfilatov2002 пишет цитата: | требуется дублировать это значение в еще одну переменную cArea |
| oBrw:cAlias опр. рабочую область тсб, oCol:cAlias задействован в работе блока кода, для массива то же срабатывает. oCol:cArea позволит связать колонку с полем в базе, не меняя "старые" алгоритмы, в том числе и при тсб массива. Выделять из oCol:cData алиас можно, но не очень удобно. Код (выделен) :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 } Можно, в дальнейшем, убрать в тсб, где cAls брать из oCol:cArea, т.к. сейчас при LOCK свойстве тсб блокируется \ разблокируется запись oBrw:cAlias
| |
|
gfilatov2002
|
| moderator
|
Пост N: 1553
Зарегистрирован: 11.02.10
|
|
Отправлено: 06.08.19 14:02. Заголовок: SergKis пишет: oCol..
SergKis пишет: цитата: | oCol:cArea позволит связать колонку с полем в базе |
| Понятно, благодарю за разъяснение SergKis пишет: цитата: | Можно, в дальнейшем, убрать в тсб, где cAls брать из oCol:cArea |
| Тогда ожидаю такую модификацию, если она потребуется...
| |
|
SergKis
|
| постоянный участник
|
Пост N: 2720
Зарегистрирован: 17.02.12
|
|
Отправлено: 07.08.19 13:56. Заголовок: gfilatov2002 пишет Т..
gfilatov2002 пишет цитата: | Тогда ожидаю такую модификацию |
| Сделал так 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 ... Пример проверки тут https://TransFiles.ru/xe6ti
| |
|
gfilatov2002
|
| moderator
|
Пост N: 1554
Зарегистрирован: 11.02.10
|
|
Отправлено: 07.08.19 14:53. Заголовок: SergKis пишет: Сдел..
SergKis пишет: Принято с благодарностью SergKis пишет: Работает отлично Я только добавил цитата: | :GetColumn("MARRIED" ):nEditMove := DT_DONT_MOVE |
| чтобы не убегал курсор после нажатия Enter на этом поле
| |
|
SergKis
|
| постоянный участник
|
Пост N: 2723
Зарегистрирован: 17.02.12
|
|
Отправлено: 08.08.19 11:41. Заголовок: gfilatov2002 Возмож..
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
|
| moderator
|
Пост N: 1555
Зарегистрирован: 11.02.10
|
|
Отправлено: 08.08.19 15:13. Заголовок: SergKis пишет: Подк..
SergKis пишет: цитата: | Подключил в примерах Tsb_ReportAge и Tsb_SetFieldsTo работу с LetoDbf |
| Спасибо! Да, примеры работают с сервером при запуске demo.exe * Заметил, что в Tsb_SetFieldsTo количество отобранных записей в подвале правильно обновляется только со второй попытки...
| |
|
SergKis
|
| постоянный участник
|
Пост N: 2724
Зарегистрирован: 17.02.12
|
|
Отправлено: 08.08.19 16:23. Заголовок: gfilatov2002 пишет к..
gfilatov2002 пишет цитата: | количество отобранных записей в подвале правильно обновляется только со второй попытки... |
| Добавьте прорисовку подвала oBrw:GetColumn("NN"):cFooting := hb_ntos( (cOut)->( OrdKeyCount() ) ) oBrw:DrawFooters()
| |
|
SergKis
|
| постоянный участник
|
Пост N: 2727
Зарегистрирован: 17.02.12
|
|
Отправлено: 09.08.19 23:40. Заголовок: gfilatov2002 Модифи..
gfilatov2002 Модифицировал пример, добавив справочник STATE.DBF, колонки в тсб набираются смешано с 3х алиасов. Работает запуск и с сервером тоже Пример тут https://TransFiles.ru/xuqt2
| |
|
SergKis
|
| постоянный участник
|
Пост N: 2728
Зарегистрирован: 17.02.12
|
|
Отправлено: 10.08.19 10:50. Заголовок: gfilatov2002 Предла..
gfilatov2002 Предлагаю добавить в тсб 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) )
| |
|
SergKis
|
| постоянный участник
|
Пост N: 2729
Зарегистрирован: 17.02.12
|
|
Отправлено: 10.08.19 11:57. Заголовок: PS Добавить параметр..
PS Добавить параметр 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" ...
| |
|
gfilatov2002
|
| moderator
|
Пост N: 1557
Зарегистрирован: 11.02.10
|
|
Отправлено: 10.08.19 12:18. Заголовок: SergKis пишет: Моди..
SergKis пишет: цитата: | Модифицировал пример, добавив справочник STATE.DBF |
| ОК SergKis пишет: Принято с благодарностью
| |
|
gfilatov2002
|
| moderator
|
Пост N: 1558
Зарегистрирован: 11.02.10
|
|
Отправлено: 10.08.19 14:13. Заголовок: SergKis пишет: ON K..
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
|
| постоянный участник
|
Пост N: 2731
Зарегистрирован: 17.02.12
|
|
Отправлено: 10.08.19 16:05. Заголовок: gfilatov2002 пишет O..
gfilatov2002 пишет цитата: | ON KEY ESCAPE ACTION iif( oBrw:IsEdit, oBrw:PostMsg( WM_KEYDOWN, VK_ESCAPE, 0 ), _wPost(99) |
| Может добавить 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) )
| |
|
gfilatov2002
|
| moderator
|
Пост N: 1559
Зарегистрирован: 11.02.10
|
|
Отправлено: 11.08.19 17:23. Заголовок: SergKis пишет: Може..
SergKis пишет: Нет, на мой взгляд такой синтаксис цитата: | oBrw:PostMsg( WM_KEYDOWN, VK_ESCAPE, 0 ) |
| нагляднее В противном случае, надо помнить, что сообщение WM_KEYDOWN используется по умолчанию (и не забыть поставить запятую перед VK_ESCAPE), но ведь есть и другие сообщения
| |
|
SergKis
|
| постоянный участник
|
Пост N: 2732
Зарегистрирован: 17.02.12
|
|
Отправлено: 11.08.19 20:36. Заголовок: gfilatov2002 пишет т..
gfilatov2002 пишет цитата: | такой синтаксис нагляднее |
| Согласен Хотелось покороче писать, к примеру, методами oBrw:PostKeyDown( VK_ESCAPE ) oBrw:PostKeyUp( VK_ESCAPE ) но короче не получается, а вот последний параметр можно не задавать. oBrw:PostMsg( WM_KEYDOWN, VK_ESCAPE , 0 )
| |
|
Andrey
|
| постоянный участник
|
Пост N: 6389
Зарегистрирован: 12.09.06
|
|
Отправлено: 15.08.19 12:28. Заголовок: Всем привет ! Вопрос..
Всем привет ! Вопрос возник, а почему в ресурсах МиниГуи нет иконки самого МиниГуи - официальной ? Примеры тестовые делать можно было бы с официальной иконкой, а то и не знаешь какой вариант использовать. И второй вопрос, почему нет в ядре МиниГуи функции _ShowContextMenu() ? Замучился таскать её в проекты, частенько использую для тестовых проектов. Григорий, добавь пожалуйста эту функцию в ядро.
| |
|
gfilatov2002
|
| moderator
|
Пост N: 1560
Зарегистрирован: 11.02.10
|
|
Отправлено: 15.08.19 13:31. Заголовок: Andrey пишет: Вопро..
Andrey пишет: цитата: | Вопрос возник, а почему в ресурсах МиниГуи нет иконки самого МиниГуи - официальной ? |
| Спасибо за вопрос Дело в том, что в разное время были разные иконки, а сейчас - такая, как на моей аватарке. Поэтому проще просто поместить эту иконку в папку с примером и подключать ее из файла, а не из ресурсов Andrey пишет: цитата: | второй вопрос, почему нет в ядре МиниГуи функции _ShowContextMenu() ? |
| Потому, что эта функция не доработана до конца (в частности, режим центрирования).
| |
|
Andrey
|
| постоянный участник
|
Пост N: 6390
Зарегистрирован: 12.09.06
|
|
Отправлено: 15.08.19 15:13. Заголовок: gfilatov2002 пишет: ..
gfilatov2002 пишет: цитата: | Потому, что эта функция не доработана до конца (в частности, режим центрирования). |
| Доработайте пожалуйста и включите, нужна очень. Вроде нормально работает в приложениях, нормально центрируется.
| |
|
gfilatov2002
|
| moderator
|
Пост N: 1561
Зарегистрирован: 11.02.10
|
|
Отправлено: 15.08.19 20:14. Заголовок: Andrey пишет: включ..
Andrey пишет: Добавил эту функцию в новую сборку 19.08
| |
|
Andrey
|
| постоянный участник
|
Пост N: 6392
Зарегистрирован: 12.09.06
|
|
Отправлено: 16.08.19 15:51. Заголовок: gfilatov2002 пишет: ..
gfilatov2002 пишет: цитата: | Добавил эту функцию в новую сборку 19.08 |
| Спасибо ! Выслал примеры по Tsbrowse с карточкой + блокировка записей на почту. Вопрос возник по Tab. Показываю окно с Tab карточкой юзеру. На медленных компах видно как этот Tab дергается, т.е. на Tab вывожу объекты Label и GetBox. Там их много, порядка 150 объектов. Вот и дергается Tab. Можно как то это "дерганье" убрать ?
| |
|
SergKis
|
| постоянный участник
|
Пост N: 2740
Зарегистрирован: 17.02.12
|
|
Отправлено: 17.08.19 14:00. Заголовок: gfilatov2002 Предло..
gfilatov2002 Предложение по растяжке предпоследней колонки показа, если последняя не помещается в размер тсб, при горизонтальном скроллинге колонок. 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 ... SuperHeader не поддерживает, надо править расчет. Пример проверки тут https://TransFiles.ru/34r31
| |
|
SergKis
|
| постоянный участник
|
Пост N: 2741
Зарегистрирован: 17.02.12
|
|
Отправлено: 17.08.19 16:37. Заголовок: PS Для работы коррек..
PS Для работы корректировки надо 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 ... В примере 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
|
| moderator
|
Пост N: 1562
Зарегистрирован: 11.02.10
|
|
Отправлено: 18.08.19 20:12. Заголовок: SergKis пишет: Для ..
SergKis пишет: Принято с благодарностью Проверил на Вашем примере - работает
| |
|
SergKis
|
| постоянный участник
|
Пост N: 2742
Зарегистрирован: 17.02.12
|
|
Отправлено: 18.08.19 23:58. Заголовок: gfilatov2002 Добави..
gfilatov2002 Добавил в пример проверку работы метода :GetCellinfo(...). На кл. F3 в Footer колонки вкл. GetBox для ввода Пример https://TransFiles.ru/958i8
| |
|
gfilatov2002
|
| moderator
|
Пост N: 1563
Зарегистрирован: 11.02.10
|
|
Отправлено: 19.08.19 09:51. Заголовок: SergKis пишет: пров..
SergKis пишет: цитата: | проверку работы метода :GetCellinfo(...) |
| По-видимому, были еще внесены изменения в код, поскольку у меня этот метод так красиво не отрабатывает, как в Вашем откомпилированном примере. Что-то я потерял в этих модификациях
| |
|
gfilatov2002
|
| moderator
|
Пост N: 1564
Зарегистрирован: 11.02.10
|
|
Отправлено: 19.08.19 10:12. Заголовок: P.S. Понял, что надо..
P.S. Понял, что надо изменить метод :GetCellinfo(...) также, как и метод Edit(). Сейчас Ваш пример у меня работает нормально Благодарю за помощь
| |
|
SergKis
|
| постоянный участник
|
Пост N: 2743
Зарегистрирован: 17.02.12
|
|
Отправлено: 19.08.19 10:29. Заголовок: gfilatov2002 пишет П..
gfilatov2002 пишет цитата: | По-видимому, были еще внесены изменения в код[quote] |
|
` Отвлекли на другое и забыл об изменениях внесенных в :GetCellInfo, извините. У меня они такие 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] ...
| |
|
gfilatov2002
|
| moderator
|
Пост N: 1565
Зарегистрирован: 11.02.10
|
|
Отправлено: 19.08.19 11:20. Заголовок: SergKis пишет: У ме..
SergKis пишет: цитата: | У меня они такие METHOD GetCellInfo( nRowPos, nCell, lColSpecHd ) CLASS TSBrowse |
| Аналогично Благодарю за подтверждение
| |
|
SergKis
|
| постоянный участник
|
Пост N: 2744
Зарегистрирован: 17.02.12
|
|
Отправлено: 19.08.19 13:29. Заголовок: gfilatov2002 Правка..
gfilatov2002 Правка (тогда :lNoHScroll := .F.\.T. работает правильно) 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 } ) ...
| |
|
gfilatov2002
|
| moderator
|
Пост N: 1566
Зарегистрирован: 11.02.10
|
|
Отправлено: 19.08.19 14:39. Заголовок: SergKis пишет: Прав..
SergKis пишет: цитата: | Правка (тогда :lNoHScroll := .F.\.T. работает правильно) |
| Благодарю за исправление
| |
|
SergKis
|
| постоянный участник
|
Пост N: 2745
Зарегистрирован: 17.02.12
|
|
Отправлено: 19.08.19 17:49. Заголовок: gfilatov2002 Предло..
gfilatov2002 Предложение 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 ...
| |
|
SergKis
|
| постоянный участник
|
Пост N: 2746
Зарегистрирован: 17.02.12
|
|
Отправлено: 19.08.19 17:52. Заголовок: PS В примере получим..
PS В примере получим список колонок в отображении oBrw:UserKeys(VK_F5, {|ob| _wPost(5, ob, ob) }) ... (This.Object):Event( 5, {|ot,oi,ob| _LogFile(.T., hb_valtoexp(ob:aDrawCols)) }) ...
| |
|
gfilatov2002
|
| moderator
|
Пост N: 1567
Зарегистрирован: 11.02.10
|
|
Отправлено: 19.08.19 20:37. Заголовок: SergKis пишет: Пред..
SergKis пишет: Сергей, Добавить эти изменения можно без проблем, но только использовать их - в целях отладки. Или я что-то упустил
| |
|
SergKis
|
| постоянный участник
|
Пост N: 2747
Зарегистрирован: 17.02.12
|
|
Отправлено: 19.08.19 20:59. Заголовок: gfilatov2002 пишет Д..
gfilatov2002 пишет цитата: | Добавить эти изменения можно без проблем, но только использовать их - в целях отладки |
| Сейчас трудно понять список колонок, которые проходят в методах прорисовки :Draw...(), т.к. определяется реально в функции TSDrawCell(...) по nStartCol и размером тсб GetClientRect( hWnd, &rct ), что затрудняет переделать :DrawSuper к примеру, т.к. там пляшет от ::aColSizes и aColSizes, понять мне не удалось, есть значения не совпадающие ни oCol:nWidth, oCol:nEditWidth и нет ясности в списке колонок. Для начала на :aDrawCols сделать прорисовку :DrawSuper() для режима :ladjColumn := .T. Может еще где пригодится
| |
|
gfilatov2002
|
| moderator
|
Пост N: 1568
Зарегистрирован: 11.02.10
|
|
Отправлено: 19.08.19 21:20. Заголовок: SergKis пишет: на :..
SergKis пишет: цитата: | на :aDrawCols сделать прорисовку :DrawSuper() для режима :ladjColumn := .T. |
| Понял, уже добавляю... Благодарю за разъяснение
| |
|
SergKis
|
| постоянный участник
|
Пост N: 2749
Зарегистрирован: 17.02.12
|
|
Отправлено: 20.08.19 08:54. Заголовок: gfilatov2002 Что то..
gfilatov2002 Что то получилось с :DrawSuper(). Изменения Скрытый текст
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 ...
| Пример тут https://TransFiles.ru/qjle1 Работает и пример из Advanced\TsBrowse\sbsuperh.prg (с выделенной строкой и без нее) 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.
| |
|
gfilatov2002
|
| moderator
|
Пост N: 1569
Зарегистрирован: 11.02.10
|
|
Отправлено: 20.08.19 10:13. Заголовок: SergKis пишет: полу..
SergKis пишет: цитата: | получилось с :DrawSuper() |
| Благодарю за все Ваши усилия Возможно, переменная lAdjColumn д.б. установлена в .T. по умолчанию
| |
|
SergKis
|
| постоянный участник
|
Пост N: 2750
Зарегистрирован: 17.02.12
|
|
Отправлено: 20.08.19 11:22. Заголовок: gfilatov2002 пишет В..
gfilatov2002 пишет цитата: | Возможно, переменная lAdjColumn д.б. установлена в .T. по умолчанию |
| Конфликта с :AdjColumns() быть не должно, это для работы - ширина всех колонок < ширины тсб, :lAdjColumn := .T. имеет смысл, если ширина всех колонок > ширины тсб, при этом сменится (от old версии) показ колонок. Как реагировать пользователи будут ? Можно попробовать поставить :lAdjColumn := .T.
| |
|
gfilatov2002
|
| moderator
|
Пост N: 1570
Зарегистрирован: 11.02.10
|
|
Отправлено: 20.08.19 11:32. Заголовок: SergKis пишет: :lAd..
SergKis пишет: цитата: | :lAdjColumn := .T. имеет смысл, если ширина всех колонок > ширины тсб |
| Понятно SergKis пишет: цитата: | при этом сменится (от old версии) показ колонок. Как реагировать пользователи будут ? |
| Думаю, будут реагировать негативно... Поэтому оставил по умолчанию :lAdjColumn := .F., как и было предложено изначально
| |
|
gfilatov2002
|
| moderator
|
Пост N: 1571
Зарегистрирован: 11.02.10
|
|
Отправлено: 21.08.19 09:11. Заголовок: Всем кому это интересно
Опубликована новая сборка 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
|
| постоянный участник
|
Пост N: 6398
Зарегистрирован: 12.09.06
|
|
Отправлено: 21.08.19 13:47. Заголовок: Поставил новую верси..
Поставил новую версию. Начал просматривать примеры. При запуске - вылет: 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
|
| moderator
|
Пост N: 1572
Зарегистрирован: 11.02.10
|
|
Отправлено: 21.08.19 14:22. Заголовок: Andrey Благодарю за..
Andrey Благодарю за сообщение Уже поправил с помощью "тихого" апдейта
| |
|
Andrey
|
| постоянный участник
|
Пост N: 6401
Зарегистрирован: 12.09.06
|
|
Отправлено: 22.08.19 14:27. Заголовок: gfilatov2002 пишет: ..
gfilatov2002 пишет: цитата: | - MS VisualC 2019 32-bit для Harbour 3.2.0dev; (под заказ) - MS VisualC 2019 64-bit для Harbour 3.2.0dev; (под заказ) |
| Как получить сборку под этот компилятор ?
| |
|
gfilatov2002
|
| moderator
|
Пост N: 1573
Зарегистрирован: 11.02.10
|
|
Отправлено: 22.08.19 16:19. Заголовок: Andrey пишет: Как п..
Andrey пишет: цитата: | Как получить сборку под этот компилятор ? |
| Отправил ссылки в личку (см. Л.С.)
| |
|
gfilatov2002
|
| moderator
|
Пост N: 1574
Зарегистрирован: 11.02.10
|
|
Отправлено: 29.08.19 10:01. Заголовок: Обновил сборку 19.08..
Обновил сборку 19.08 ( Update 1) с учетом последних наработок Базовый дистрибутив находится по адресу http://hmgextended.com/files/CONTRIB/hmg-19.08-setup.exe Что нового: Скрытый текст
* 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)
|
| |
|
Andrey
|
| постоянный участник
|
Пост N: 6410
Зарегистрирован: 12.09.06
|
|
Отправлено: 29.08.19 13:08. Заголовок: Пере собрал некоторы..
Пере собрал некоторые программы ! Полёт нормальный ! Вопрос по COMBOBOXEX возник. А нельзя увеличить ту часть со стрелкой вниз ? А то её через микроскоп разглядывать нужно. Взять стрелку с вертикального скролинга и повесить вместо этого значка. Юзера слёзно просят увеличить.
| |
|
gfilatov2002
|
| moderator
|
Пост N: 1577
Зарегистрирован: 11.02.10
|
|
Отправлено: 05.09.19 10:19. Заголовок: Всем кому это интересно
Обновил сборку 19.08 ( Update 2) с учетом последних наработок Базовый дистрибутив находится по адресу http://hmgextended.com/files/CONTRIB/hmg-19.08-setup.exe Что нового: Скрытый текст
* 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)
| Благодарю за Ваше внимание и поддержку
| |
|
Avf
|
| |
Пост N: 30
Зарегистрирован: 19.10.05
|
|
Отправлено: 11.09.19 10:37. Заголовок: Что изменилось в пос..
Что изменилось в последних версиях, что при трансляции старых программ появилось это : 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
|
| moderator
|
Пост N: 1579
Зарегистрирован: 11.02.10
|
|
Отправлено: 11.09.19 11:49. Заголовок: Avf пишет: Error: U..
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 года). По-видимому, используется более старая версия Харбора
| |
|
Новичок
|
| |
Пост N: 75
Зарегистрирован: 22.04.15
|
|
Отправлено: 13.09.19 11:22. Заголовок: Добавь список конста..
Добавь список констант для MS Word "word.ch", MS Excel "excel.ch" если не трудно
| |
|
gfilatov2002
|
| moderator
|
Пост N: 1582
Зарегистрирован: 11.02.10
|
|
Отправлено: 13.09.19 11:44. Заголовок: Новичок пишет: спис..
Новичок пишет: цитата: | список констант для MS Word "word.ch", MS Excel "excel.ch" |
| Такие списки уже есть в папке samples\Advanced\Tsb_Export
| |
|
Новичок
|
| |
Пост N: 76
Зарегистрирован: 22.04.15
|
|
Отправлено: 13.09.19 12:10. Заголовок: Видел, устарели уже ..
Видел, устарели уже - добавлял константы да и желательно в основной каталог перебросить, чтобы там постоянно жило :)
| |
|
gfilatov2002
|
| moderator
|
Пост N: 1583
Зарегистрирован: 11.02.10
|
|
Отправлено: 16.09.19 10:32. Заголовок: Всем кому это интересно
Подготовил первую бету для новой сборки 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
|
| постоянный участник
|
Пост N: 2884
Зарегистрирован: 17.02.12
|
|
Отправлено: 16.09.19 10:52. Заголовок: gfilatov2002 О чем ..
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
|
| moderator
|
Пост N: 1584
Зарегистрирован: 11.02.10
|
|
Отправлено: 16.09.19 10:56. Заголовок: SergKis пишет: О че..
SergKis пишет: Речь о том, что сегментация редко используемого кода в ядре библиотеки позволила уменьшить размер экзешника mgDBU на 5 килобайт, например
| |
|
SergKis
|
| постоянный участник
|
Пост N: 2886
Зарегистрирован: 17.02.12
|
|
Отправлено: 16.09.19 11:27. Заголовок: gfilatov2002 пишет Р..
gfilatov2002 пишет Спасибо за пояснение.
| |
|
Avf
|
| |
Пост N: 31
Зарегистрирован: 19.10.05
|
|
Отправлено: 16.09.19 12:02. Заголовок: После перехода с вер..
После перехода с версии 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
|
| постоянный участник
|
Пост N: 6443
Зарегистрирован: 12.09.06
|
|
Отправлено: 16.09.19 12:08. Заголовок: Avf пишет: DoMethod..
Avf пишет: цитата: | DoMethod('Form_1','Browse_1','Value',RecNo()) |
| Может я и не прав, но DoMethod() нельзя так использовать. Здесь нужно использовать SetProperty()
| |
|
Avf
|
| |
Пост N: 32
Зарегистрирован: 19.10.05
|
|
Отправлено: 16.09.19 12:14. Заголовок: Почему нельзя ? До м..
Почему нельзя ? До марта 2019 было можно и все работало. Кроме того, в другой нотации ( Form_1.Browse_1.Value := RecNo() ) не всегда удобно использовать вместо имен окна/бровса переменные.
| |
|
gfilatov2002
|
| moderator
|
Пост N: 1585
Зарегистрирован: 11.02.10
|
|
Отправлено: 16.09.19 12:24. Заголовок: Avf пишет: Зачем эт..
Avf пишет: Для быстрого обнаружения ошибок или опечаток при неправильном применении свойств и методов. Andrey пишет: цитата: | DoMethod() нельзя так использовать |
| Да, верно. Потому что VALUE - это свойство, а не метод у элемента управления
| |
|
Avf
|
| |
Пост N: 33
Зарегистрирован: 19.10.05
|
|
Отправлено: 16.09.19 12:30. Заголовок: Спасибо за разъяснен..
Спасибо за разъяснение.
| |
|
SergKis
|
| постоянный участник
|
Пост N: 2888
Зарегистрирован: 17.02.12
|
|
Отправлено: 16.09.19 12:39. Заголовок: Avf пишет Кроме того..
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
|
| |
Пост N: 34
Зарегистрирован: 19.10.05
|
|
Отправлено: 16.09.19 13:33. Заголовок: Именно использование..
Именно использование макроподстановки и является неудобством. цитата: | Если использовать SET OOP ON и события, то в них будет среда This всегда |
| Спасибо.
| |
|
SergKis
|
| постоянный участник
|
Пост N: 2889
Зарегистрирован: 17.02.12
|
|
Отправлено: 16.09.19 14:56. Заголовок: Avf пишет Именно исп..
Avf пишет цитата: | Именно использование макроподстановки и является неудобством |
| Смотря когда. Пример 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 := ...
| |
|
Avf
|
| |
Пост N: 35
Зарегистрирован: 19.10.05
|
|
Отправлено: 16.09.19 15:21. Заголовок: Error: Unresolved ex..
цитата: | 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
|
| |
Пост N: 36
Зарегистрирован: 19.10.05
|
|
Отправлено: 16.09.19 15:25. Заголовок: Смотря когда Я согла..
Я согласен. Но это уже особенности языка.
| |
|
avf2007
|
| |
Пост N: 3
Зарегистрирован: 18.02.11
|
|
Отправлено: 21.09.19 10:53. Заголовок: Случайно обратил вни..
Случайно обратил внимание : в h_browse.prg : *-----------------------------------------------------------------------------* FUNCTION _GetBrowseFnValue ( cTemp ) *-----------------------------------------------------------------------------* LOCAL cRet := 'Nil' SWITCH ValType ( cTemp ) CASE 'N' cRet := hb_ntos ( &cTemp ) ... наверное, должно быть : SWITCH ValType ( &cTemp )
| |
|
Andrey
|
| постоянный участник
|
Пост N: 6448
Зарегистрирован: 12.09.06
|
|
Отправлено: 21.09.19 22:06. Заголовок: На нормальных компах..
На нормальных компах под Win7 заметно очень скачки окна HMG_Alert(). Сначала окно появляется чуток пониже верха экрана и в левом углу, потом скачет в центр экрана. Под Win8.1 вроде не замечал, но у меня комп побыстрее обычного, офисного компа. Почему так ? Можно ли убрать эти скачки ?
| |
|
SergKis
|
| постоянный участник
|
Пост N: 2909
Зарегистрирован: 17.02.12
|
|
Отправлено: 21.09.19 22:19. Заголовок: Поправь h_alert.prg ..
Поправь h_alert.prg 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() В ON INIT окно уже на экране в нач. координатах, this.center() там -> передергивает в центр.
| |
|
SergKis
|
| постоянный участник
|
Пост N: 2910
Зарегистрирован: 17.02.12
|
|
Отправлено: 21.09.19 22:21. Заголовок: PS или как обычно CE..
PS или как обычно CENTER WINDOW &cForm ACTIVATE WINDOW &cForm
| |
|
SergKis
|
| постоянный участник
|
Пост N: 2911
Зарегистрирован: 17.02.12
|
|
Отправлено: 21.09.19 22:32. Заголовок: PPS УПС. Вспомнил. ..
PPS УПС. Вспомнил. В предыдущей версии hmg было 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 Это более правильно, по мне, т.к. в bInit можно изменить размеры окна и повторить This.Center для них или не делать центровку, а задать row, col позицию
| |
|
SergKis
|
| постоянный участник
|
Пост N: 2912
Зарегистрирован: 17.02.12
|
|
Отправлено: 21.09.19 22:43. Заголовок: PS к этому (из пред...
PS к этому (из пред. версии) можно в DEFINE WINDOW ... добавить NOSHOW, а в ON INIT This.Show()
| |
|
SergKis
|
| постоянный участник
|
Пост N: 2913
Зарегистрирован: 17.02.12
|
|
Отправлено: 21.09.19 23:07. Заголовок: SergKis пишет к этом..
SergKis пишет цитата: | к этому (из пред. версии) можно в DEFINE WINDOW ... добавить NOSHOW, а в ON INIT This.Show() |
| Проверил на примере Advanced\App_OopReport\demo2.prg Все нормально, перемещал main окно в разные углы, вызывал карточку, менял вызывая справочник, жал Cancel ... все HMG_Alert() отработали как надо.
| |
|
Andrey
|
| постоянный участник
|
Пост N: 6449
Зарегистрирован: 12.09.06
|
|
Отправлено: 21.09.19 23:16. Заголовок: SergKis пишет: Все ..
SergKis пишет: цитата: | Все нормально, перемещал main окно в разные углы, вызывал карточку, менял вызывая справочник, жал Cancel ... все HMG_Alert() отработали как надо. |
| Теперь бы в самой библиотеке МиниГуи поменять, чтобы в следующей версии это не вылезло опять !
| |
|
gfilatov2002
|
| moderator
|
Пост N: 1586
Зарегистрирован: 11.02.10
|
|
Отправлено: 22.09.19 14:18. Заголовок: SergKis пишет: В пр..
SergKis пишет: цитата: | В предыдущей версии hmg было |
| Сделал, как в предыдущей версии... Кстати, это SergKis попросил изменить, когда работал с карточкой в примере Advanced\App_OopReport\demo2.prg Andrey пишет: цитата: | Теперь бы в самой библиотеке МиниГуи поменять |
| OK
| |
|
SergKis
|
| постоянный участник
|
Пост N: 2919
Зарегистрирован: 17.02.12
|
|
Отправлено: 25.09.19 06:07. Заголовок: gfilatov2002 Попроб..
gfilatov2002 Попробовал mgDbu, для ntx все нормально, для cdx без fpt не вышло поставить rdd dbfcdx. Изменил и смог отработать Скрытый текст
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 ...
|
| |
|
SergKis
|
| постоянный участник
|
Пост N: 2920
Зарегистрирован: 17.02.12
|
|
Отправлено: 25.09.19 06:12. Заголовок: PS При создании tag ..
PS При создании tag без FOR опция UNIQUE недоступна, на Key тоже может быть unique
| |
|
SergKis
|
| постоянный участник
|
Пост N: 2921
Зарегистрирован: 17.02.12
|
|
Отправлено: 25.09.19 06:16. Заголовок: PPS Правильнее IF..
PPS Правильнее IF !Empty(cDBFName) cRddName := iif( upper(cDBFName) == 'CDX', 'DBFCDX', NIL ) cDBFName := NIL ENDIF
| |
|
gfilatov2002
|
| moderator
|
Пост N: 1588
Зарегистрирован: 11.02.10
|
|
Отправлено: 25.09.19 12:39. Заголовок: SergKis пишет: Изме..
SergKis пишет: цитата: | Изменил и смог отработать |
| Благодарю за помощь SergKis пишет: цитата: | на Key тоже может быть unique |
| Поправил Эти изменения будут включены в 4-ю бета-версию новой сборки
| |
|
SergKis
|
| постоянный участник
|
Пост N: 2923
Зарегистрирован: 17.02.12
|
|
Отправлено: 25.09.19 12:50. Заголовок: gfilatov2002 Может ..
gfilatov2002 Может в StatusBar завести item для индикации RddSetDefault() и click для установки\смены ACTION {|| RddSetDefault( iif( RddSetDefault() == 'DBFCDX', 'DBFNTX', 'DBFCDX' ) ) }
| |
|
gfilatov2002
|
| moderator
|
Пост N: 1589
Зарегистрирован: 11.02.10
|
|
Отправлено: 25.09.19 14:54. Заголовок: SergKis пишет: в St..
SergKis пишет: цитата: | в StatusBar завести item для индикации RddSetDefault() и click для установки\смены |
| Сделал, конечно Благодарю за помощь
| |
|
SergKis
|
| постоянный участник
|
Пост N: 2924
Зарегистрирован: 17.02.12
|
|
Отправлено: 26.09.19 11:07. Заголовок: gfilatov2002 По мне..
gfilatov2002 По мне, использовать GetStartupFolder() при работе с dbf не очень хорошо. Работаю в Far и мне нужно тек. каталог, т.е. mgDbu.exe U09.dbf или mgDbu.exe .\2019\R08.dbf а зацеплено везде GetStartupFolder()
| |
|
gfilatov2002
|
| moderator
|
Пост N: 1590
Зарегистрирован: 11.02.10
|
|
Отправлено: 26.09.19 12:07. Заголовок: SergKis пишет: исп..
SergKis пишет: цитата: | использовать GetStartupFolder() при работе с dbf не очень хорошо |
| Заменил эту функцию на GetCurrentFolder() Благодарю за помощь
| |
|
SergKis
|
| постоянный участник
|
Пост N: 2926
Зарегистрирован: 17.02.12
|
|
Отправлено: 28.09.19 22:34. Заголовок: gfilatov2002 Немног..
gfilatov2002 Немного правки 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 ...
| |
|
SergKis
|
| постоянный участник
|
Пост N: 2927
Зарегистрирован: 17.02.12
|
|
Отправлено: 28.09.19 22:51. Заголовок: PS METHOD InsColumn(..
PS METHOD InsColumn( nPos, oColumn ) CLASS TSBrowse Не надо править. В oColumn:DefFont( Self ) такая установка есть, не увидел.
| |
|
gfilatov2002
|
| moderator
|
Пост N: 1591
Зарегистрирован: 11.02.10
|
|
Отправлено: 29.09.19 18:52. Заголовок: SergKis пишет: Немн..
SergKis пишет: Поправил, конечно. Благодарю за помощь
| |
|
SergKis
|
| постоянный участник
|
Пост N: 2928
Зарегистрирован: 17.02.12
|
|
Отправлено: 29.09.19 22:37. Заголовок: gfilatov2002 Предло..
gfilatov2002 Предложение. У себя сделал для многострочных колонок, прошло на ура. 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. ... В методе :Edit() сделанное для GetBox можно распространить для всех контролов, кроме EditBox
| |
|
gfilatov2002
|
| moderator
|
Пост N: 1592
Зарегистрирован: 11.02.10
|
|
Отправлено: 30.09.19 10:34. Заголовок: SergKis пишет: В ме..
SergKis пишет: цитата: | В методе :Edit() сделанное для GetBox можно распространить для всех контролов, кроме EditBox |
| Добавил эти изменения, хотя у меня создается впечатление, что кроме Вас никто это не будет использовать Благодарю за помощь в любом случае...
| |
|
SergKis
|
| постоянный участник
|
Пост N: 2929
Зарегистрирован: 17.02.12
|
|
Отправлено: 30.09.19 12:32. Заголовок: gfilatov2002 пишет Д..
gfilatov2002 пишет цитата: | Добавил эти изменения, хотя у меня создается впечатление, что кроме Вас никто это не будет использовать |
| Ради только меня не стоит это делать. В моей версии это есть. TBrowse таблица, как бы, осноаной рабочий инструмент. Разве не возникает потребности организовать ввод в отдельной строке (задаем заранее в каждой колонке координаты) или все колонки вводить в одних координатах (как в Excel) ? Это все без доп. GetBox и ... в связке с тсб. PS В TSCOLUMN добавлен еще, т.к. Picture отображения тсб колонки и Edit ее могут быть разными. DATA cEditPicture ... 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 ...
| |
|
gfilatov2002
|
| moderator
|
Пост N: 1593
Зарегистрирован: 11.02.10
|
|
Отправлено: 30.09.19 14:16. Заголовок: SergKis пишет: В TS..
SergKis пишет: цитата: | В TSCOLUMN добавлен еще, т.к. Picture отображения тсб колонки и Edit ее могут быть разными. DATA cEditPicture |
| Добавил такое свойство (и его обработку) также. Благодарю за помощь
| |
|
Andrey
|
| постоянный участник
|
Пост N: 6457
Зарегистрирован: 12.09.06
|
|
Отправлено: 30.09.19 18:45. Заголовок: gfilatov2002 пишет: ..
gfilatov2002 пишет: цитата: | Добавил эти изменения, хотя у меня создается впечатление, что кроме Вас никто это не будет использовать |
| Я буду использовать. Сталкивался с таким, и не знал как сделать. Только бы надо примерчик небольшой сделать или показать уже в готовом примере как такое можно использовать. SergKis пишет: цитата: | TBrowse таблица, как бы, осноаной рабочий инструмент. |
| Просто отличный инструмент !!! Вот так можно сделать TBrowse-таблицу:
| |
|
SergKis
|
| постоянный участник
|
Пост N: 2930
Зарегистрирован: 17.02.12
|
|
Отправлено: 02.10.19 19:19. Заголовок: gfilatov2002 Немног..
gfilatov2002 Немного изменил, что бы не перекрывались :nEditWidth при перерисовке с :llAdjColumns и заданным :nEditWidth для Edit 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 ... Пример использования на базе Advanced\Tsb_Basic_2\demo5.prg Скрытый текст
/* * 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
|
| |
|
gfilatov2002
|
| moderator
|
Пост N: 1594
Зарегистрирован: 11.02.10
|
|
Отправлено: 02.10.19 19:38. Заголовок: SergKis пишет: Немн..
SergKis пишет: Благодарю за помощь и тестовый пример
| |
|
SergKis
|
| постоянный участник
|
Пост N: 2931
Зарегистрирован: 17.02.12
|
|
Отправлено: 02.10.19 19:54. Заголовок: gfilatov2002 Лучше ..
gfilatov2002 Лучше сделать так 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, ; ...
| |
|
gfilatov2002
|
| moderator
|
Пост N: 1595
Зарегистрирован: 11.02.10
|
|
Отправлено: 02.10.19 20:24. Заголовок: SergKis пишет: Лучш..
SergKis пишет: OK, сделал Благодарю за подсказку
| |
|
SergKis
|
| постоянный участник
|
Пост N: 2932
Зарегистрирован: 17.02.12
|
|
Отправлено: 03.10.19 15:22. Заголовок: gfilatov2002 Предла..
gfilatov2002 Предлагаю дополнить 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> ; ...
| |
|
gfilatov2002
|
| moderator
|
Пост N: 1596
Зарегистрирован: 11.02.10
|
|
Отправлено: 03.10.19 16:53. Заголовок: SergKis пишет: CLA..
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
|
| постоянный участник
|
Пост N: 2933
Зарегистрирован: 17.02.12
|
|
Отправлено: 03.10.19 17:20. Заголовок: gfilatov2002 пишет В..
gfilatov2002 пишет цитата: | Ведь эти значения уже есть в классе |
| Если есть, то, конечно, не нужны. Сильно не вникал, но названия особенно :Atx - догадываться надо. Скопировал со своей версии. Но чтобы голова не болела, сделал бы ACCESS Index INLINE ::Atx ACEESS Handle INLINE ::hWnd
| |
|
gfilatov2002
|
| moderator
|
Пост N: 1597
Зарегистрирован: 11.02.10
|
|
Отправлено: 03.10.19 17:35. Заголовок: SergKis пишет: ..
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
|
| постоянный участник
|
Пост N: 6485
Зарегистрирован: 12.09.06
|
|
Отправлено: 18.10.19 13:22. Заголовок: Всем привет. Использ..
Всем привет. Использую в МиниГуи такую функцию: ? ProcNameLine(0) ? ProcNameLine(1) ? ProcNameLine(2) FUNCTION ProcNameLine(nVal) DEFAULT nVal := 0 RETURN "Вызов из: " + ProcName( nVal + 1 ) + "(" + hb_ntos( ProcLine( nVal + 1 ) ) + ") --> " + ProcFile( nVal + 1 ) Удобнее писать в прогах... Может занести в саму МиниГуи ?
| |
|
gfilatov2002
|
| moderator
|
Пост N: 1611
Зарегистрирован: 11.02.10
|
|
Отправлено: 22.10.19 09:18. Заголовок: Опубликована новая с..
Опубликована новая сборка 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
|
| постоянный участник
|
Пост N: 2956
Зарегистрирован: 17.02.12
|
|
Отправлено: 22.10.19 12:04. Заголовок: gfilatov2002 После ..
gfilatov2002 После установки new 19.10 (C:\MiniGui) примеры не собираются, сообщение "The system find path specified" Вернул предыдущую - все ok!
| |
|
Dima
|
| |
Пост N: 7125
Зарегистрирован: 17.05.05
|
|
Отправлено: 22.10.19 12:10. Заголовок: SergKis Собираются ..
SergKis Собираются норм , обрати внимание что был сделан переход с Bcc55 на Bcc58 Пути поправь
| |
|
SergKis
|
| постоянный участник
|
Пост N: 2957
Зарегистрирован: 17.02.12
|
|
Отправлено: 22.10.19 12:20. Заголовок: Dima пишет был сдела..
Dima пишет цитата: | был сделан переход с Bcc55 на Bcc58 |
| У меня его и нет совсем. Он же, вроде, коммерческий был.
| |
|
Dima
|
| |
Пост N: 7126
Зарегистрирован: 17.05.05
|
|
Отправлено: 22.10.19 12:22. Заголовок: Теперь есть http://h..
| |
|
SergKis
|
| постоянный участник
|
Пост N: 2958
Зарегистрирован: 17.02.12
|
|
Отправлено: 22.10.19 12:28. Заголовок: Dima Спасибо. А как..
Dima Спасибо. А как с лицензией ? Если она коммерческая, то, наверно и ставить не буду.
| |
|
Andrey
|
| постоянный участник
|
Пост N: 6490
Зарегистрирован: 12.09.06
|
|
Отправлено: 22.10.19 13:39. Заголовок: > Какой статус л..
> Какой статус лицензии у BCC 5.8 ? Григорий так мне написал: Лицензия подобна BCC 5.5 (она есть в архиве BCC 5.8 на сайте). В любом случае, это такой же устаревший продукт (2006 года выпуска), как и BCC 5.5.
| |
|
SergKis
|
| постоянный участник
|
Пост N: 2959
Зарегистрирован: 17.02.12
|
|
Отправлено: 22.10.19 15:08. Заголовок: Andrey пишет это так..
Andrey пишет цитата: | это такой же устаревший продукт (2006 года выпуска), как и BCC 5.5. |
| Достаточно 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 закрыт
| |
|
gfilatov2002
|
| moderator
|
Пост N: 1612
Зарегистрирован: 11.02.10
|
|
Отправлено: 22.10.19 15:20. Заголовок: SergKis пишет: Дост..
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
|
| постоянный участник
|
Пост N: 2960
Зарегистрирован: 17.02.12
|
|
Отправлено: 22.10.19 15:39. Заголовок: gfilatov2002 пишет В..
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
|
| |
Пост N: 7127
Зарегистрирован: 17.05.05
|
|
Отправлено: 22.10.19 15:49. Заголовок: SergKis MinGW поста..
SergKis MinGW поставь
| |
|
gfilatov2002
|
| moderator
|
Пост N: 1613
Зарегистрирован: 11.02.10
|
|
Отправлено: 22.10.19 15:54. Заголовок: SergKis пишет: лучш..
SergKis пишет: цитата: | лучше bcc 5.8 не буду устанавливать совсем |
| По большому счету, этот компилятор можно не устанавливать, поскольку все библиотеки, скомпилированные BCC 5.8, прекрасно работают с BCC 5.5. У них полная бинарная совместимость
| |
|
SergKis
|
| постоянный участник
|
Пост N: 2961
Зарегистрирован: 17.02.12
|
|
Отправлено: 22.10.19 15:58. Заголовок: Dima пишет MinGW пос..
Dima пишет Зачем ? Рабочая версия на vc есть. Версия с bcc 55 использовалась как пример исследования новшеств. Unicode нет версии. Из hmg в рабочей версии исп. только browse и tsbrowse. Все печати, EAN коды, pdf, mail, ... vo 2.7 все umicode TsBrowse у меня практически идентичны ...
| |
|
Dima
|
| |
Пост N: 7128
Зарегистрирован: 17.05.05
|
|
Отправлено: 22.10.19 16:01. Заголовок: SergKis пишет: Заче..
SergKis пишет: я пошутил )
| |
|
SergKis
|
| постоянный участник
|
Пост N: 2962
Зарегистрирован: 17.02.12
|
|
Отправлено: 22.10.19 16:02. Заголовок: gfilatov2002 пишет У..
gfilatov2002 пишет цитата: | У них полная бинарная совместимость |
| А поковыряться ? Пересобрать lib-ы ?
| |
|
Andrey_IV
|
| |
Пост N: 31
Зарегистрирован: 20.04.07
|
|
Отправлено: 23.10.19 02:28. Заголовок: BCC 5.82 Кодировка Win-1251 в файле ресурсов
Всем доброго времени суток! В BCC 5.5 (да и в BCC 5.6), если в файле ресурсов .RC писал русскими буквами в кодировке Win-1251 - то на экране все отображалось корректно Когда попробовал в компилировать программу в BCC 5.82 - получил крякозябры. Попробовал забить вместо латинских, русскими в примере: C:\MiniGUI\SAMPLES\BASIC\TEST_APPLICATION\demo.rc - та-же история. Крякозябры вместо русских букв. Это только в файле ресурсов. Если просто в .PRG пишу русскими - все нормально. Это вообще можно победить ? Не может-же быть такого, что компилятор не дружит с кодировкой Win-1251 ТОЛЬКО в ресурсах. Или может ???
| |
|
Dima
|
| |
Пост N: 7129
Зарегистрирован: 17.05.05
|
|
Отправлено: 23.10.19 12:17. Заголовок: Andrey_IV пишет: Эт..
Andrey_IV пишет: цитата: | Это вообще можно победить ? |
| Можно Andrey_IV пишет: цитата: | C:\MiniGUI\SAMPLES\BASIC\TEST_APPLICATION\demo.rc - та-же история |
| Нет там ни какой истории , demo.rc в кодировке 866 , переведи в 1251 и будет как надо
| |
|
gfilatov2002
|
| moderator
|
Пост N: 1614
Зарегистрирован: 11.02.10
|
|
Отправлено: 23.10.19 12:54. Заголовок: Andrey_IV пишет: По..
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
|
| постоянный участник
|
Пост N: 6491
Зарегистрирован: 12.09.06
|
|
Отправлено: 23.10.19 13:40. Заголовок: SergKis пишет: Рабо..
SergKis пишет: цитата: | Рабочая версия на vc есть. Версия с bcc 55 использовалась как пример исследования новшеств. |
| Давайте тогда перейдём полностью на MSVC ?
| |
|
Andrey_IV
|
| |
Пост N: 32
Зарегистрирован: 20.04.07
|
|
Отправлено: 24.10.19 10:00. Заголовок: BCC 5.82 Кодировка Win-1251 в файле ресурсов - УТОЧНЕНИЕ
Не точно выразился 1) Кодировка RC-файла конечно-же Win-1251 2) Речь идёт не об этом блоке RC-файла, который привёл в приме Григорий [quote]` { POPUP "&Файл" { MENUITEM "&Выход", ID_FILE_EXIT } POPUP "&Помощь" { MENUITEM "&О программе", ID_HELP_ABOUT } } [quote]` а вот об этом (то, что в проводнике "Свойства файла", закладка "Подробно" - в общем информация "О программе" (проверял в Windows 7). Возьмем файл: C:\MiniGUI\SAMPLES\Applications\SysInfo\SysInfo.rc Меняю кодировку на Win-1251, пишу на русском (извините - просто пример) [quote]` 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 } } [quote]` Компилирую, в проводнике в свойствах файла в описании файла и в названии продукта вижу крякозябры Пробовал менять Английский на Русский // BLOCK "040904b0" BLOCK "041904e3" и // VALUE "Translation", 0x0409 0x04B0 VALUE "Translation", 0x0419 0x04E3 Ничего не даёт
| |
|
Dima
|
| |
Пост N: 7132
Зарегистрирован: 17.05.05
|
|
Отправлено: 24.10.19 20:32. Заголовок: Там вроде нужно прик..
Там вроде нужно прикручивать windows manifest и кодировка в rc должна быть utf-8
| |
|
gfilatov2002
|
| moderator
|
Пост N: 1615
Зарегистрирован: 11.02.10
|
|
Отправлено: 25.10.19 09:34. Заголовок: Всем кому это интересно
Обновил сборку 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
|
| moderator
|
Пост N: 1616
Зарегистрирован: 11.02.10
|
|
Отправлено: 30.10.19 10:47. Заголовок: Всем кому это интересно
Обновил сборку 19.10 ( Update 2) с учетом последних наработок Базовый дистрибутив для BCC 5.8.2 находится по адресу http://hmgextended.com/files/CONTRIB/hmg-19.10-setup.exe Что нового: Скрытый текст
* 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)
|
| |
|
rvu
|
| |
Пост N: 186
Зарегистрирован: 05.11.05
|
|
Отправлено: 15.11.19 11:08. Заголовок: gfilatov2002 пишет: ..
gfilatov2002 пишет: цитата: | Может я чего то не понял, но точно такая же ограниченная гарантия есть у BCC 5.5 |
| А как связаны ограниченная гарантия и авторские права? Меня тоже авторские права интересуют. Хочется чистоты. И какую версия они сами сейчас раздают? https://www.embarcadero.com/free-tools/ccompiler/free-download
| |
|
gfilatov2002
|
| moderator
|
Пост N: 1622
Зарегистрирован: 11.02.10
|
|
Отправлено: 15.11.19 12:59. Заголовок: rvu пишет: какую ве..
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
|
| постоянный участник
|
Пост N: 6525
Зарегистрирован: 12.09.06
|
|
Отправлено: 27.11.19 01:16. Заголовок: Всем привет. Пример ..
Всем привет. Пример MiniGUI\SAMPLES\BASIC\Button_Hotkey Туда бы добавить для наглядности небольшое добавление: @ 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 } Если массив нельзя, то тогда бы сделать перечисление клавиш: ON KEY F1 ACTION _wPost( 10 , .... здесь не знаю как .... ) ON KEY F2 ACTION _wPost( 10 , .... здесь не знаю как .... ) ...... Юзера просят горячие клавиши сразу по F1/F2 ... ну или просто по 1/2 .... Я понимаю что горячая клавиша ОДНА, но блин нашему юзеру всё мало.... Просто в старых программах сделал так, теперь просят такого же в МиниГуи.
| |
|
SergKis
|
| постоянный участник
|
Пост N: 2963
Зарегистрирован: 17.02.12
|
|
Отправлено: 27.11.19 02:01. Заголовок: Andrey пишет O..
Andrey пишет цитата: | ON KEY F1 ACTION _wPost( 10 , .... здесь не знаю как .... ) ON KEY F2 ACTION _wPost( 10 , .... здесь не знаю как .... ) ...... |
| так же ON KEY F1 ACTION _wPost( 10 , This.button_1.Index ) ON KEY F2 ACTION _wPost( 10 , This.button_1.Index ) ...... создается в событии 10 среда This для button1, как и для ACTION кнопки, по указанному индексу
| |
|
SergKis
|
| постоянный участник
|
Пост N: 2964
Зарегистрирован: 17.02.12
|
|
Отправлено: 27.11.19 02:13. Заголовок: PS т.е. если делать ..
PS т.е. если делать _wPost(10), то в событии 10 This.Name - имя окна, ThisWindow.Name - тоже, если делать _wPost( 10 , This.button_1.Index ), то в событии 10 This.Name - имя кнопки, ThisWindow.Name - имя окна
| |
|
Andrey
|
| постоянный участник
|
Пост N: 6526
Зарегистрирован: 12.09.06
|
|
Отправлено: 27.11.19 09:26. Заголовок: SergKis пишет: ON K..
SergKis пишет: цитата: | ON KEY F1 ACTION _wPost( 10 , This.button_1.Index ) ON KEY F2 ACTION _wPost( 10 , This.button_1.Index ) ...... |
| Чуток ошибся: 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 ) А если будут две формы и будут такие же кнопки, то горячие клавиши будут различаться ? This.button_1.Index - это для каждого окна своя кнопка ?
| |
|
SergKis
|
| постоянный участник
|
Пост N: 2965
Зарегистрирован: 17.02.12
|
|
Отправлено: 27.11.19 12:16. Заголовок: Andrey пишет Чуток о..
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
|
| moderator
|
Пост N: 1626
Зарегистрирован: 11.02.10
|
|
Отправлено: 28.11.19 17:35. Заголовок: Всем кому это интересно
Подготовил 1-й релиз-кандидат для новой сборки 19.12 со следующим списком изменений (кратко): Скрытый текст
* 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.
|
Благодарю за внимание
| |
|
SergKis
|
| постоянный участник
|
Пост N: 2997
Зарегистрирован: 17.02.12
|
|
Отправлено: 11.12.19 15:44. Заголовок: gfilatov2002 Предла..
gfilatov2002 Предлагаю добавить 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 программ и .т.д.
| |
|
gfilatov2002
|
| moderator
|
Пост N: 1633
Зарегистрирован: 11.02.10
|
|
Отправлено: 11.12.19 18:40. Заголовок: SergKis пишет: Пред..
SergKis пишет: цитата: | Предлагаю добавить HB_FUNC ( ENUMWINDOWS ) |
| Благодарю за предложение. Но вроде уже живет эта функция в примерах: - SAMPLES\Advanced\ProcInfo; - SAMPLES\Advanced\ExternalApp_2 Кстати, там еще д.б. сишная дополнительная функция EnumWindowsProc, которая заполняет массив pArray
| |
|
SergKis
|
| постоянный участник
|
Пост N: 2998
Зарегистрирован: 17.02.12
|
|
Отправлено: 11.12.19 19:58. Заголовок: gfilatov2002 пишет Н..
gfilatov2002 пишет цитата: | Но вроде уже живет эта функция в примерах |
| Не увидел, пропустил. Хорошо, что есть в примерах, мне не хватило в lib. Пришлось позаниматься управлением внешних программ из hmg. Предложил по причине, что она более удобна, во многих случаях, чем та которая есть в hmg FindWindow
| |
|
gfilatov2002
|
| moderator
|
Пост N: 1634
Зарегистрирован: 11.02.10
|
|
Отправлено: 11.12.19 21:01. Заголовок: SergKis пишет: Пред..
SergKis пишет: цитата: | Предложил по причине, что она более удобна |
| Буду рассматривать эту функцию для следующей сборки. Поскольку подготовка декабрьского релиза уже завершена, и эта сборка будет опубликована завтра.
| |
|
gfilatov2002
|
| moderator
|
Пост N: 1635
Зарегистрирован: 11.02.10
|
|
Отправлено: 12.12.19 10:27. Заголовок: Всем кому это интересно
| |
|
SergKis
|
| постоянный участник
|
Пост N: 2999
Зарегистрирован: 17.02.12
|
|
Отправлено: 12.12.19 19:53. Заголовок: gfilatov2002 пишет Д..
gfilatov2002 пишет цитата: | Добавил также архив для бесплатного Embarcadero C++ 10.1 Berlin compiler |
| Установил, собрал несколько примеров. Работают. Спасибо
| |
|
SergKis
|
| постоянный участник
|
Пост N: 3003
Зарегистрирован: 17.02.12
|
|
Отправлено: 20.12.19 15:52. Заголовок: gfilatov2002 Может ..
gfilatov2002 Может стоит заменить в InitCodePage() использование ф-ии cLang := hb_UserLang() на что то другое, т.к. она не точна, т.е. 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 Все правильно, кроме выделенного цветом, а это работа hb_UserLang()
| |
|
gfilatov2002
|
| moderator
|
Пост N: 1636
Зарегистрирован: 11.02.10
|
|
Отправлено: 20.12.19 21:43. Заголовок: SergKis пишет: заме..
SergKis пишет: цитата: | заменить в InitCodePage() использование ф-ии cLang := hb_UserLang() |
| Работа этой функция основана на WinAPI функции GetUserDefaultLangID(). Кроме того, она используется для определения языка пользователя в утилите hbmk2 Кстати, для того чтобы исправить поведение этой функции, можно определить системную константу LANG. Если эта глобальная переменная определена, то значение для возврата функции берется из нее.
| |
|
SergKis
|
| постоянный участник
|
Пост N: 3004
Зарегистрирован: 17.02.12
|
|
Отправлено: 20.12.19 23:25. Заголовок: gfilatov2002 Спасиб..
gfilatov2002 Спасибо за разъяснение По сути, в работе hb_UserLang() лучше не использовать, что бы не колбаситься с Set LANG=lv-LV
| |
|
gfilatov2002
|
| moderator
|
Пост N: 1639
Зарегистрирован: 11.02.10
|
|
Отправлено: 13.01.20 11:57. Заголовок: Всем кому это интересно
Подготовил 1-й релиз-кандидат для новой сборки 20.01 со следующим списком изменений (кратко): Скрытый текст
* 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.
|
Благодарю за ваше внимание
| |
|
Andrey
|
| постоянный участник
|
Пост N: 6558
Зарегистрирован: 12.09.06
|
|
Отправлено: 13.01.20 16:03. Заголовок: gfilatov2002 пишет: ..
| |
|
gfilatov2002
|
| moderator
|
Пост N: 1640
Зарегистрирован: 11.02.10
|
|
Отправлено: 23.01.20 16:12. Заголовок: Всем кому это интересно
Завершена подготовка новой сборки 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
|
| moderator
|
Пост N: 1643
Зарегистрирован: 11.02.10
|
|
Отправлено: 28.01.20 10:25. Заголовок: Всем кому это интересно
Опубликована новая сборка 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
|
| |
Пост N: 13
Зарегистрирован: 29.11.19
|
|
Отправлено: 28.01.20 17:19. Заголовок: а функция GetControl..
а функция GetControlTabPage доступна в текущей версии ?
| |
|
gfilatov2002
|
| moderator
|
Пост N: 1644
Зарегистрирован: 11.02.10
|
|
Отправлено: 28.01.20 17:25. Заголовок: kkg пишет: функция ..
kkg пишет: цитата: | функция GetControlTabPage доступна |
| Нет, теперь это служебная внутренняя функция
| |
|
kkg
|
| |
Пост N: 14
Зарегистрирован: 29.11.19
|
|
Отправлено: 29.01.20 01:01. Заголовок: А ещё вопросик, на E..
А ещё вопросик, на Embarcadero текущая версия bcc102. Можно ли получить ссылочку на bcc101 ?
| |
|
gfilatov2002
|
| moderator
|
Пост N: 1645
Зарегистрирован: 11.02.10
|
|
Отправлено: 29.01.20 10:08. Заголовок: kkg пишет: ссылочку..
| |
|
kkg
|
| |
Пост N: 15
Зарегистрирован: 29.11.19
|
|
Отправлено: 29.01.20 10:36. Заголовок: Спасибо...
Спасибо.
| |
|
kkg
|
| |
Пост N: 16
Зарегистрирован: 29.11.19
|
|
Отправлено: 30.01.20 10:36. Заголовок: Ещё раз спасибо за h..
| |
|
gfilatov2002
|
| moderator
|
Пост N: 1646
Зарегистрирован: 11.02.10
|
|
Отправлено: 03.02.20 11:07. Заголовок: Всем кому это интересно
Обновил сборку 20.01 ( Update 2) с учетом последних наработок Базовый дистрибутив для BCC 5.8.2 находится по адресу http://hmgextended.com/files/CONTRIB/hmg-20.01-setup.exe Что нового: Скрытый текст
* 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)
|
| |
|
kkg
|
| |
Пост N: 17
Зарегистрирован: 29.11.19
|
|
Отправлено: 05.02.20 13:51. Заголовок: Добрый день, в BCC10..
Добрый день, в BCC101 функции aMonths(), CDOW( Date()) как то неправильно реагируют на REQUEST HB_LANG_RUWIN HB_LANGSELECT( "RUWIN" ) это лечится ? Спасибо.
| |
|
gfilatov2002
|
| moderator
|
Пост N: 1647
Зарегистрирован: 11.02.10
|
|
Отправлено: 05.02.20 18:24. Заголовок: kkg пишет: это лечи..
kkg пишет: Для русского языка можно написать свои функции-аналоги Другие (не кириллические) языки отрабатывают нормально
| |
|
kkg
|
| |
Пост N: 18
Зарегистрирован: 29.11.19
|
|
Отправлено: 05.02.20 19:54. Заголовок: gfilatov2002 пишет: ..
gfilatov2002 пишет: цитата: | Для русского языка можно написать свои функции-аналоги |
| спасибо.
| |
|
gfilatov2002
|
| moderator
|
Пост N: 1648
Зарегистрирован: 11.02.10
|
|
Отправлено: 07.02.20 10:48. Заголовок: Всем кому это интересно
Обновил сборку 20.01 ( Update 3) с учетом последних наработок Базовый дистрибутив для BCC 5.8.2 находится по адресу http://hmgextended.com/files/CONTRIB/hmg-20.01-setup.exe Кстати, там исправлена ошибка с неправильной нумерацией замороженных столбцов в Tbrowse с использованием enumerator, которая озвучивалась здесь, на форуме
| |
|
kkg
|
| |
Пост N: 19
Зарегистрирован: 29.11.19
|
|
Отправлено: 09.02.20 11:00. Заголовок: gfilatov2002 пишет: ..
gfilatov2002 пишет: цитата: | Обновил сборку 20.01 (Update 3) |
| а можно в стандартный комплект поставки bcc101 добавить библиотечку SQLMIX (hbsqldd.lib) ? Спасибо.
| |
|
SergKis
|
| постоянный участник
|
Пост N: 3036
Зарегистрирован: 17.02.12
|
|
Отправлено: 09.02.20 12:49. Заголовок: gfilatov2002 Надо п..
gfilatov2002 Надо поправить 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 ...
| |
|
gfilatov2002
|
| moderator
|
Пост N: 1649
Зарегистрирован: 11.02.10
|
|
Отправлено: 09.02.20 19:27. Заголовок: SergKis пишет: Надо..
SergKis пишет: При добавлении этого кода в заголовок таблицы попадет только одна строка наибольшей длины из много-строчного заголовка. Остальные строки этого много-строчного заголовка будут удалены. В чем смысл этой поправки
| |
|
SergKis
|
| постоянный участник
|
Пост N: 3040
Зарегистрирован: 17.02.12
|
|
Отправлено: 09.02.20 19:49. Заголовок: gfilatov2002 пишет П..
gfilatov2002 пишет цитата: | При добавлении этого кода в заголовок таблицы попадет только одна строка наибольшей длины из много-строчного заголовка. Остальные строки этого много-строчного заголовка будут удалены. В чем смысл этой поправки |
| Эта поправка для правильного расчета ширины колонки, берется самое длинное слово для участия в расчете, иначе ширина колонки получается по всем словам с учетом CRLF. Текст в header потом выводится правильный, полностью все с переносом и ширина max от выделенного слова и значения в колонке. Так работает в моей версии. После такой правки колонка после LoadFields рассчитана хорошо и показывает аналогично.
| |
|
SergKis
|
| постоянный участник
|
Пост N: 3041
Зарегистрирован: 17.02.12
|
|
Отправлено: 09.02.20 20:25. Заголовок: gfilatov2002 пишет П..
gfilatov2002 пишет цитата: | При добавлении этого кода в заголовок таблицы попадет только одна строка наибольшей длины из много-строчного заголовка. |
| Прошу прощения, упустил, что у меня стоит перед созданием колонки 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, ; ...
| |
|
SergKis
|
| постоянный участник
|
Пост N: 3042
Зарегистрирован: 17.02.12
|
|
Отправлено: 09.02.20 20:32. Заголовок: PS Правда у меня все..
PS Правда у меня всегда включен расчет nSize, т.е. cPicture := "@K "+cPicture EndIf // If nSize == Nil cData := ( cAlias )->( FieldGet( nE ) ) ... nSize += If( ! Empty( cOrder ), 14, 0 ) //V90 // EndIf но это связано связано с переносом :LoadFields(...) под команды файла ch, изложенное во флайме сегодня.
| |
|
gfilatov2002
|
| moderator
|
Пост N: 1650
Зарегистрирован: 11.02.10
|
|
Отправлено: 09.02.20 20:43. Заголовок: SergKis пишет: прощ..
SergKis пишет: Да, после такой переделки обработка заголовка отработала нормально Благодарю за помощь
| |
|
Andrey
|
| постоянный участник
|
Пост N: 6583
Зарегистрирован: 12.09.06
|
|
Отправлено: 10.02.20 10:01. Заголовок: SergKis пишет: Эта ..
SergKis пишет: цитата: | Эта поправка для правильного расчета ширины колонки, берется самое длинное слово для участия в расчете, иначе ширина колонки получается по всем словам с учетом CRLF. Текст в header потом выводится правильный, полностью все с переносом и ширина max от выделенного слова и значения в колонке. Так работает в моей версии. После такой правки колонка после LoadFields рассчитана хорошо и показывает аналогично. |
| Классно ! Это когда будет включено в МиниГуи ? А то у меня своя функция криво работает...
| |
|
SergKis
|
| постоянный участник
|
Пост N: 3044
Зарегистрирован: 17.02.12
|
|
Отправлено: 10.02.20 12:54. Заголовок: gfilatov2002 Поправ..
gfilatov2002 Поправил у себя 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) ...
| |
|
gfilatov2002
|
| moderator
|
Пост N: 1651
Зарегистрирован: 11.02.10
|
|
Отправлено: 10.02.20 13:51. Заголовок: SergKis пишет: Попр..
SergKis пишет: Добавил такую проверку также
| |
|
SergKis
|
| постоянный участник
|
Пост N: 3051
Зарегистрирован: 17.02.12
|
|
Отправлено: 11.02.20 12:21. Заголовок: gfilatov2002 Предла..
gfilatov2002 Предлагаю добавить проверку 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, ; Если высота ширина заданы, то есть шанс при переносе на др. комп, с др. монитором попадать на размеры окна > экрана, что произошло с примером CBru.exe на др. pc.
| |
|
SergKis
|
| постоянный участник
|
Пост N: 3052
Зарегистрирован: 17.02.12
|
|
Отправлено: 11.02.20 12:53. Заголовок: PS У меня, еще, така..
PS У меня, еще, такая штука присутствует 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 ; ... разместит окно в правом нижнем углу но может это и баловство ?
| |
|
gfilatov2002
|
| moderator
|
Пост N: 1654
Зарегистрирован: 11.02.10
|
|
Отправлено: 11.02.20 13:29. Заголовок: SergKis пишет: доба..
SergKis пишет: Благодарю за предложение. Пока сделал эту проверку таким образом: цитата: | IF ! ISNUMBER( w ) .AND. ! ISNUMBER( h ) ... ELSE w := Min( w, GetDesktopWidth() ) h := Min( h, GetDesktopHeight() - GetTaskBarHeight() ) ENDIF mVar := '_' + FormName ... |
|
| |
|
SergKis
|
| постоянный участник
|
Пост N: 3056
Зарегистрирован: 17.02.12
|
|
Отправлено: 12.02.20 08:35. Заголовок: gfilatov2002 пишет П..
gfilatov2002 пишет цитата: | Пока сделал эту проверку таким образом: |
| В большинстве случаев задаю ширину, высоту окон в процентном отношении к клиентской обл. Descktop, т.е. w := GetClientWidth(0) * 0.4 h := GetClientHeight(0)*0.6 оказалось, что удобно располагать окно по координатам, также в процентах, т.е. запись удобна 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 как параметры, на мой взгляд, удобно динамически, при вызовах, задавать позиции и размеры окна. Это актуально для небольших, в размерах, справочниках. Располагая сразу, при вызове, удобно для клиента, часто, не надо делать запоминание координат и размеров для одного и того же окна справочника.
| |
|
SergKis
|
| постоянный участник
|
Пост N: 3057
Зарегистрирован: 17.02.12
|
|
Отправлено: 12.02.20 09:55. Заголовок: gfilatov2002 Не был..
gfilatov2002 Не было учтено в ch для tbrowse :lAdjColumn := .T. Сделал у себя так 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.
| |
|
gfilatov2002
|
| moderator
|
Пост N: 1655
Зарегистрирован: 11.02.10
|
|
Отправлено: 12.02.20 10:54. Заголовок: SergKis пишет: Не б..
SergKis пишет: цитата: | Не было учтено в ch для tbrowse |
| Благодарю за поправку
| |
|
gfilatov2002
|
| moderator
|
Пост N: 1656
Зарегистрирован: 11.02.10
|
|
Отправлено: 12.02.20 11:39. Заголовок: Всем кому это интересно
| |
|
gfilatov2002
|
| moderator
|
Пост N: 1658
Зарегистрирован: 11.02.10
|
|
Отправлено: 19.02.20 11:41. Заголовок: Всем кому это интересно
| |
|
gfilatov2002
|
| moderator
|
Пост N: 1659
Зарегистрирован: 11.02.10
|
|
Отправлено: 25.02.20 11:14. Заголовок: Снова обновил сборку..
Снова обновил сборку 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
|
| постоянный участник
|
Пост N: 3073
Зарегистрирован: 17.02.12
|
|
Отправлено: 25.02.20 12:32. Заголовок: gfilatov2002 пишет С..
gfilatov2002 пишет цитата: | Снова обновил сборку 20.01 (Update 6) с учетом последних наработок |
| Андрей говорил, дать правку для TBrowse, а я не дал. Для одинаковой работы с колонкой в :bDecode и :bPrevEdit 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 } ...
| |
|
Ответов - 300
, стр:
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
All
[только новые]
|
|
|