Форум » GUI » Примеры из Минигуи -ошибки, вопросы..... (продолжение) » Ответить
Примеры из Минигуи -ошибки, вопросы..... (продолжение)
Andrey: Всем привет. Взялся смотреть примеры из МиниГуи, так не все работают. Может кто подскажет что там "допилить" нужно ? А заодно может и исправить и добавить новые.... Очень красочный пример: \MiniGUI\SAMPLES\Advanced\AVI_Animation - не работает под Win7 (наверно AVI-шки нет в ресурсах) Предложение Григорию: Можно ли добавить еще один пример с отдельным AVI-файлом в ресурсах проекта и показом такого же бегунка ? Пример: \MiniGUI\SAMPLES\Advanced\DisplayMode - не работает под ХР и далее.... Пример: \MiniGUI\SAMPLES\Advanced\Tsb_filter - вылетает на ХР -------------------------------------------------------------------------------- Harbour MiniGUI Errorlog File Harbour MiniGUI Extended Edition 2.0.1 - 2011.09.21 -------------------------------------------------------------------------------- Date: 11/15/2011 Time: 22:13:24 Error BASE/1124 Argument error: LEFT Called from LEFT(0) Called from SCANSOFT(195) Called from MAIN(84) Пример: \MiniGUI\SAMPLES\BASIC\MsgEdit - не собирается... Z:\MiniGUI\SAMPLES\BASIC\MsgEdit>call ..\..\..\batch\compile.bat demo /L shell32 Harbour 3.1.0dev (Rev. 17042) Copyright (c) 1999-2011, http://harbour-project.org/ Compiling 'demo.prg'... Lines 20133, Functions/Procedures 30 Generating C source output to 'demo.c'... Done. Borland C++ 5.5.1 for Win32 Copyright (c) 1993, 2000 Borland demo.c: Error E2141 demo.prg 993: Declaration syntax error *** 1 errors in Compile *** C compile error.
Andrey: SergKis пишет: Маловато будет ? Об этом забыл вообще.... Спасибо !
Andrey: Всем привет ! Хочу получить расчёт по времени вот такого вида - 00:00:00.0145 В C# есть такой формат даты, нагляден очень. А в Харборе такого нет. Можно прикрутить такой формат времени в МиниГуи ? Для расчётов самый раз будет, а то Seconds() не всегда даёт разницу по времени. Выдаёт типа 00:00:00 Можно конечно написать свою функцию, но тогда её каждый раз нужно будет таскать из своих исходников.
SergKis: Andrey пишет В C# есть такой формат даты, нагляден очень. А в Харборе такого нет. А если немного подумать, то все получится[pre2] Local k, t := hb_datetime() ... k := hb_datetime() - t ? t, k, t + k,'|', hb_StrToTS('') + k получишь такой результат 2019-08-27 18:33:23.825 0.000005 2019-08-27 18:33:24.262 | 00:00:00.437 [/pre2]
Andrey: Хотелось бы проще, типа такого: [pre2]t := hb_datetime() CalcToDbf() // расчёт ? "Время расчёта =", MG_MilliSeconds( hb_datetime() - t ) Время расчёта = 00:00:00.437 [/pre2]
SergKis: Andrey пишет Хотелось бы проще Твой вариант #xtranslate MG_MilliSeconds( k ) => Ltrim( hb_TSToStr( hb_StrToTS('') + k, .T. ) )
Andrey: SergKis пишет: Твой вариант Что-то ошибку выдаёт: Turbo Incremental Link 5.66 Copyright (c) 1997-2002 Borland Error: Unresolved external '_HB_FUN_MG_MILLISECONDS' referenced from W:\HB_PROJECT\OBJ\FORM_CALC1.OBJ hbmk2[Calc_5Menu]: Error: Running linker. 2
SergKis: Andrey #xtranslate MG_MilliSeconds( <k> ) => Ltrim( hb_TSToStr( hb_StrToTS('') + <k>, .T. ) ) k := hb_datetime() - t ? mg_MilliSeconds( k ) ? mg_MilliSeconds( (hb_datetime() - t) ) результат 00:00:00.57 00:00:00.574
Andrey: Доброго утра всем ! Наверное лучше функцию назвать так HMG_TimeMS(). В виде функции у меня работает, а если делаю в мой INCLUDE #xtranslate MG_MilliSeconds( <k> ) => Ltrim( hb_TSToStr( hb_StrToTS('') + <k>, .T. ) ) то не собирается exe-ник.
Andrey: Всем привет. Хочу чтобы по кнопкам юзер мог нажимать цифирки 1,2,3.... Знаю что можно назначить горячую клавишу, не хочу этого. Можно ли повесить событие на кнопки по цифрам ? Очень понравилась такая структура назначение событий: [pre2] DEFINE WINDOW Form_Main ; ..... ON INIT {|| _wPost(3) } ..... WITH OBJECT This.Object :Event( 0, {| | InkeyGui(200) } ) :Event( 1, {| | Form_Main.Btn_Start1.Setfocus , _PushKey( VK_RETURN ) } ) :Event( 2, {| | Form_Main.Btn_Start2.Setfocus , _PushKey( VK_RETURN ) } ) :Event( 3, {| | Form_Main.Btn_Start3.Setfocus , _PushKey( VK_RETURN ) } ) :Event( 4, {| | Form_Main.Btn_Start4.Setfocus , _PushKey( VK_RETURN ) } ) :Event( 5, {| | Form_Main.Btn_Start5.Setfocus , _PushKey( VK_RETURN ) } ) :Event(99, {|ow| ow:Release() } ) END WITH [/pre2]
SergKis: Andrey пишет Можно ли повесить событие на кнопки по цифрам ? Надо знать куда хочешь вешать, к примеру для тсб (пример Tsb_lAdjColumn) вместо (для твоей таблицы событий) [pre2] // oBrw:UserKeys(VK_F3, {|ob| _wPost(3, ob, ob) }) // oBrw:UserKeys(VK_F4, {|ob| _wPost(4, ob, ob) }) ставим oBrw:UserKeys(VK_1, {|ob| _wPost(1, ob, ob) }) oBrw:UserKeys(VK_2, {|ob| _wPost(2, ob, ob) }) и т.д. для горячей клавиши SET KEY VK_1 ACTION _wPost(1, oBrw, oBrw) SET KEY VK_2 ACTION _wPost(2, oBrw, oBrw) и т.д. в событии Event будет устанавливаться среда This для Tsb для GetBox так же можно ставить событие нажатия клавиш (примеры в basic\GetBox...) [/pre2]
gfilatov2002: Andrey пишет: Можно ли повесить событие на кнопки по цифрам ? Посмотри рабочий пример ниже [pre2]#include "hmg.ch" FUNCTION main DEFINE WINDOW button_test ; AT 0,0 ; WIDTH 800 ; HEIGHT 600 ; MAIN ; TITLE "button program test" @ 100, 10 BUTTON butt_0959_A ; CAPTION " 1 " ; ACTION msgInfo( 1 ) ; WIDTH 100 ; HEIGHT 30 HOTKEY 1 @ 100, 140 BUTTON butt_0959_B ; CAPTION " 2 " ; ACTION msgInfo( 2 ) ; WIDTH 100 ; HEIGHT 30 HOTKEY 2 @ 100, 270 BUTTON butt_0959_C ; CAPTION " 3 " ; ACTION msgInfo( 3 ) ; WIDTH 100 ; HEIGHT 30 HOTKEY 3 @ 100, 400 BUTTON butt_0959_D ; CAPTION " 4 " ; ACTION msgInfo( 4 ) ; WIDTH 100 ; HEIGHT 30 HOTKEY 4 @ 100, 530 BUTTON butt_0959_E ; CAPTION " 5 " ; ACTION msgInfo( 5 ) ; WIDTH 100 ; HEIGHT 30 HOTKEY 5 @ 100, 660 BUTTON butt_0959_F ; CAPTION " 6 " ; ACTION msgInfo( 6 ) ; WIDTH 100 ; HEIGHT 30 HOTKEY 6 @ 145.00, 10 BUTTON butt_0959_G ; CAPTION " 7 " ; ACTION msgInfo( 7 ) ; WIDTH 100 ; HEIGHT 30 HOTKEY 7 @ 145.00, 140 BUTTON butt_0959_H ; CAPTION " 8 " ; ACTION msgInfo( 8 ) ; WIDTH 100 ; HEIGHT 30 HOTKEY 8 @ 145.00, 270 BUTTON butt_0959_I ; CAPTION " 9 " ; ACTION msgInfo( 9 ) ; WIDTH 100 ; HEIGHT 30 HOTKEY 9 END WINDOW CENTER WINDOW button_test ACTIVATE WINDOW button_test RETURN [/pre2]
SergKis: gfilatov2002 пишет Посмотри рабочий пример ниже Для BUTONEX нет HOTKEY, а у Andrey в основном используются они.
SergKis: PS По указанному свойству HOTKEY кнопки ставится горячая клавиша, т.е. большой разницы нет писать HOTKEY 9 в кнопке или ставить горячую клавишу SET KEY VK_9 ACTION ...
Andrey: SergKis пишет: Для BUTONEX нет HOTKEY, а у Andrey в основном используются они. Да, я про эту фичу. А нельзя сделать для BUTONEX эту фичу HOTKEY в следующих версиях ? Для окна можно обойтись пока и так ON KEY ESCAPE OF Form_Main ACTION _wPost(99) ON KEY VK_1 OF Form_Main ACTION _wPost(1) и будет отрабатывать [pre2] :Event( 1, {| | Form_Main.Btn_Start1.Setfocus , _PushKey( VK_RETURN ) } ) [/pre2] Спасибо за подсказку !
Andrey: Что то не получается... Это отрабатывает нормально - ON KEY ESCAPE OF Form_Main ACTION _wPost(99) А как задать цифирки 1, 2, 3 .... Пробовал так [pre2]ON KEY VK_1 OF Form_Main ACTION _wPost(1) ON KEY VK_2 OF Form_Main ACTION _wPost(2) ON KEY VK_3 OF Form_Main ACTION _wPost(3)[/pre2] Не компилируется, выдаёт ошибку... Смотрел \Include\ i_keybd.ch и i_keybd_ext.ch что то не нашёл... Меню просто из 4-5-6 кнопок. Больше на форме ничего нет. Как подключить цифирки 1, 2, 3 ... ? P.S. Пока подключил так:[pre2] _DefineHotKey ( "Form_Main" , 0 , 49 , {|| _wPost(1) } ) _DefineHotKey ( "Form_Main" , 0 , 50 , {|| _wPost(2) } ) _DefineHotKey ( "Form_Main" , 0 , 51 , {|| _wPost(3) } )[/pre2]
SergKis: Andrey пишет Смотрел \Include\ i_keybd.ch и i_keybd_ext.ch что то не нашёл... Надо без VK_... вариант по имени #xcommand ON KEY <key> [ OF <parent> ] ACTION <action> [ RESULT ] TO <lresult> ; => ; <lresult> := _SetHotKeyByName ( <"parent"> , <"key"> , <{action}> ) т.е. ON KEY 1 OF Form_Main ACTION _wPost(1) ON KEY 2 OF Form_Main ACTION _wPost(2) ON KEY 3 OF Form_Main ACTION _wPost(3)
Andrey: SergKis пишет: ON KEY 1 OF Form_Main ACTION _wPost(1) ON KEY 2 OF Form_Main ACTION _wPost(2) ON KEY 3 OF Form_Main ACTION _wPost(3) Всем доброго утра ! Всё равно не собирает. Выдаёт ошибку: Harbour 3.2.0dev (r1904111533) Copyright (c) 1999-2019, https://harbour.github.io/ form_ZaivkaNew.prg(1611) Error E0030 Syntax error "syntax error at 'KEY'" form_ZaivkaNew.prg(1612) Error E0030 Syntax error "syntax error at 'KEY'" form_ZaivkaNew.prg(1613) Error E0030 Syntax error "syntax error at 'KEY'" 3 errors No code generated.
SergKis: Andrey Специально для тебя вынес сюда команду, но ты на нее все равно не смотришь #xcommand ON KEY <key> [ OF <parent> ] ACTION <action> [ RESULT ] TO <lresult> ; => ; <lresult> := _SetHotKeyByName ( <"parent"> , <"key"> , <{action}> ) Чтобы писать как ты сделал надо в команде поправить #xcommand ON KEY <key> [ OF <parent> ] ACTION <action> [ RESULT ] [ TO <lresult> ] ; => ; [ <lresult> := ] _SetHotKeyByName ( <"parent"> , <"key"> , <{action}> )
Andrey: SergKis пишет: Специально для тебя вынес сюда команду, но ты на нее все равно не смотришь Да, есть такое за мной... SergKis пишет: Чтобы писать как ты сделал надо в команде поправить Это каждый раз мне придётся в МиниГуи \include\ править ?
Andrey: А как на кнопку повесить обработку ENTER ? Делаю так: ON KEY RETURN OF Form_NewZ ACTION {|| Form_NewZ.Button_Find.Setfocus, InkeyGui(200), _PushKey( VK_RETURN ) } И вся форма вешается... Почему ? ENTER зацикливается ?
SergKis: Andrey пишет ENTER зацикливается ? Конечно. Измени[pre2] WITH OBJECT This.Object :Event( 0, {| | InkeyGui(200) } ) :Event( 1, {| | Form_Main.Btn_Start1.Setfocus , _PushKey( VK_SPACE ) } ) :Event( 2, {| | Form_Main.Btn_Start2.Setfocus , _PushKey( VK_SPACE ) } ) :Event( 3, {| | Form_Main.Btn_Start3.Setfocus , _PushKey( VK_SPACE ) } ) :Event( 4, {| | Form_Main.Btn_Start4.Setfocus , _PushKey( VK_SPACE ) } ) :Event( 5, {| | Form_Main.Btn_Start5.Setfocus , _PushKey( VK_SPACE ) } ) :Event(99, {|ow| ow:Release() } ) END WITH [/pre2]
SergKis: Andrey пишет Это каждый раз мне придётся в МиниГуи \include\ править ? Что то мне подсказывает, что Григорий и HOTKEY добавит в BUTTONEX и команду поправит. Команду предлагаю так сделать[pre2] #xcommand ON KEY <key> [ OF <parent> ] ACTION <action> [ RESULT ] [ TO <lresult> ] ; => ; [ <lresult> := ] iif( HB_ISNUMERIC( <key> ) , _DefineHotKey ( <"parent"> , 0 , <key> , <{action}> ) , ; _SetHotKeyByName ( <"parent"> , <"key"> , <{action}> ) ) [/pre2] тогда можно писать ON KEY VK_7 ACTION ... и ON KEY 7 ACTION ...
SergKis: SergKis пишет Команду предлагаю так сделать Нет, так не пойдет команда, все время число будет. Возможно, в функцию добавить[pre2] FUNCTION _SetHotKeyByName ( cParentForm, cKey, bAction ) ... ENDIF IF Val(cKey) ) >= 1 RETURN _DefineHotKey( cParentForm, 0, Val(cKey), bAction ) ENDIF IF !Empty ( cKey ) .AND. ISCHARACTER ( cKey ) [/pre2]
SergKis: SergKis пишет Возможно, в функцию добавить Будет то же самое - число. Куда то меня унесло, ушел отдыхать.
Andrey: SergKis пишет: Конечно. Измени Не работает. В другом окне делаю так: [pre2] ON KEY RETURN OF Form_NewZ ACTION {|| Form_NewZ.Button_Find.Setfocus, InkeyGui(200), _PushKey( VK_SPACE ) } ON KEY ESCAPE OF Form_NewZ ACTION {|| aRet := {}, Form_NewZ.Release() } END WINDOW[/pre2] Видно что курсор прыгает на кнопку, а отработки нет. ESC - срабатывает нормально. Дело в том что у меня на кнопке Button_Find - большой код, там несколько функций. Хотелось бы не переписывать, а заставить кнопку Button_Find срабатывать на ENTER !
SergKis: Andrey пишет Пример от Григория поправил (2а варианта назначения)[pre2] #include "hmg.ch" FUNCTION main Local nW := 40, nX := 10, nS := 10 SET CENTURY ON SET DATE GERMAN SET OOP ON DEFINE WINDOW button_test ; AT 0,0 ; WIDTH 800 ; HEIGHT 400 ; MAIN ; TITLE "button program test" @ 100, nX BUTTON butt_1 ; CAPTION " 1 " ; ACTION MsgInfo(This.Caption+' '+This.Name, ThisWindow.Name) ; WIDTH nW ; HEIGHT 30 nX += nW + nS @ 100, nX BUTTON butt_2 ; CAPTION " 2 " ; ACTION MsgInfo(This.Caption+' '+This.Name, ThisWindow.Name) ; WIDTH nW ; HEIGHT 30 nX += nW + nS @ 100, nX BUTTON butt_3 ; CAPTION " 3 " ; ACTION MsgInfo(This.Caption+' '+This.Name, ThisWindow.Name) ; WIDTH nW ; HEIGHT 30 nX += nW + nS @ 100, nX BUTTON butt_4 ; CAPTION " 4 " ; ACTION MsgInfo(This.Caption+' '+This.Name, ThisWindow.Name) ; WIDTH nW ; HEIGHT 30 nX += nW + nS @ 100, nX BUTTON butt_5 ; CAPTION " 5 " ; ACTION MsgInfo(This.Caption+' '+This.Name, ThisWindow.Name) ; WIDTH nW ; HEIGHT 30 nX += nW + nS @ 100, nX BUTTON butt_6 ; CAPTION " 6 " ; ACTION MsgInfo(This.Caption+' '+This.Name, ThisWindow.Name) ; WIDTH nW ; HEIGHT 30 nX += nW + nS @ 100, nX BUTTON butt_7 ; CAPTION " 7 " ; ACTION MsgInfo(This.Caption+' '+This.Name, ThisWindow.Name) ; WIDTH nW ; HEIGHT 30 nX += nW + nS @ 100, nX BUTTON butt_8 ; CAPTION " 8 " ; ACTION MsgInfo(This.Caption+' '+This.Name, ThisWindow.Name) ; WIDTH nW ; HEIGHT 30 nX += nW + nS @ 100, nX BUTTON butt_9 ; CAPTION " 9 " ; ACTION MsgInfo(This.Caption+' '+This.Name, ThisWindow.Name) ; WIDTH nW ; HEIGHT 30 nX += nW + nS * 5 /* @ 100, nX BUTTON butt_F ; CAPTION " F " ; ACTION MsgInfo(This.Caption+' '+This.Name, ThisWindow.Name) ; WIDTH nW ; HEIGHT 30 */ @ 100, nX BUTTON butt_F ; CAPTION " F " ; ACTION _wPost(11, This.Index) ; WIDTH nW ; HEIGHT 30 WITH OBJECT This.Object :Event( 1 , {|| This.butt_1.SetFocus, DoEvents(), _PushKey( VK_SPACE ) } ) :Event( 2 , {|| This.butt_2.SetFocus, DoEvents(), _PushKey( VK_SPACE ) } ) :Event( 3 , {|| This.butt_3.SetFocus, DoEvents(), _PushKey( VK_SPACE ) } ) :Event( 4 , {|| This.butt_4.SetFocus, DoEvents(), _PushKey( VK_SPACE ) } ) :Event( 5 , {|| This.butt_5.SetFocus, DoEvents(), _PushKey( VK_SPACE ) } ) :Event( 6 , {|| This.butt_6.SetFocus, DoEvents(), _PushKey( VK_SPACE ) } ) :Event( 7 , {|| This.butt_7.SetFocus, DoEvents(), _PushKey( VK_SPACE ) } ) :Event( 8 , {|| This.butt_8.SetFocus, DoEvents(), _PushKey( VK_SPACE ) } ) :Event( 9 , {|| This.butt_9.SetFocus, DoEvents(), _PushKey( VK_SPACE ) } ) :Event( 10 , {|| This.butt_F.SetFocus, DoEvents(), _PushKey( VK_SPACE ) } ) :Event( 11 , {|ob| MsgInfo(ob:Name+' '+This.Caption+' '+This.Name, 'Find button') } ) :Event( 99 , {|ow| ow:Release() } ) END WITH ON KEY ESCAPE ACTION _wPost(99) ON KEY 1 ACTION _wPost(1) ON KEY 2 ACTION _wPost(2) ON KEY 3 ACTION _wPost(3) ON KEY 4 ACTION _wPost(4) ON KEY 5 ACTION _wPost(5) ON KEY 6 ACTION _wPost(6) ON KEY 7 ACTION _wPost(7) ON KEY 8 ACTION _wPost(8) ON KEY 9 ACTION _wPost(9) // ON KEY RETURN ACTION _wPost(10) ON KEY RETURN ACTION _wPost(11, This.butt_F.Index) END WINDOW CENTER WINDOW button_test ACTIVATE WINDOW button_test RETURN [/pre2]
Andrey: SergKis пишет: Пример от Григория поправил (2а варианта назначения) Спасибо ! То что нужно ! SergKis пишет: ставим oBrw:UserKeys(VK_1, {|ob| _wPost(1, ob, ob) }) oBrw:UserKeys(VK_2, {|ob| _wPost(2, ob, ob) }) и т.д. За это тоже СПАСИБО !
Andrey: SergKis пишет: :Event( 1 , {|| This.butt_1.SetFocus, DoEvents(), _PushKey( VK_SPACE ) } ) :Event( 2 , {|| This.butt_2.SetFocus, DoEvents(), _PushKey( VK_SPACE ) } ) :Event( 3 , {|| This.butt_3.SetFocus, DoEvents(), _PushKey( VK_SPACE ) } ) Как можно сделать эмуляцию перехода мышкой на кнопку если включён градиент на кнопке ? Т.е. на кнопке сделано[pre2] aColor := CLR_GREEN aGrOverB2 := { { 0.5, CLR_BLACK, aColor }, { 0.5, aColor , CLR_BLACK } } aGrFillB2 := { { 0.5, aColor , CLR_WHITE }, { 0.5, CLR_WHITE, aColor } } ..... BACKCOLOR aGrOverB2 GRADIENTFILL aGrFillB2 ; ON MOUSEHOVER ( This.Fontcolor := aBtnClr2, This.Icon := cIco2x2, This.GradientFill := aGrFillB2 ) ; ON MOUSELEAVE ( This.Fontcolor := aBtnClr0, This.Icon := cIco2x1, This.GradientOver := aGrOverB2 ) ; ACTION {|| _wPost(2) } [/pre2] Использование This.butt_2.SetFocus - не подсвечивает кнопку ! Только текст кнопки подсвечивает. Хотелось бы - нажал горячую клавишу, кнопка под светилась и юзер понял какую кнопку нажал. Это для красоты.
SergKis: Andrey пишет Как можно сделать эмуляцию перехода мышкой на Как то так [pre2] FUNCTION HMG_SetMousePos( nHandle, y1, x1 ) Local y := GetWindowRow(nHandle) Local x := GetWindowCol(nHandle) Default y1 := 1, x1 := 1 SetCursorPos( x + x1, y + y1 ) RETURN Nil [/pre2] В примере выше добавить :Event( 12, {|| HMG_SetMousePos(This.butt_F.Handle) } ) ... ON KEY F3 ACTION _wPost(12) ...
Andrey: SergKis пишет: Как то так Да ! Классно выходит. СПАСИБО ! SergKis пишет: Пример от Григория поправил (2а варианта назначения)С Что то не получается в моём случае. Делаю так:[pre2] @ ... BUTTONEX Button_Find ; ........ ACTION { || SaveSeekAdres(cFileMemo,nCity,cCity,nStreet,cStreet,nDom,cDom,; nStro,cStro,nKorp,cKorp,nPodz,cPodz,nKvar,cKvar),; SaveZaivkMenu(cFileMemo2, nZDmfAnt, nZDBase, nZDogAb) ,; aDimAdr := {nCity,cCity,nStreet,cStreet,nDom,cDom,nStro,cStro,nKorp,cKorp,nPodz,cPodz,nKvar,cKvar} ,; aDimZaS := {nLastDay,lOtmena,lOst,lKeyOff,lZClose,lDClose } ,; cVal := Form_NewZ.Label_Adres.Value ,; aRet := FindListZaivka(nZDmfAnt, nZDBase, nZDogAb, aDimZaS, aDimAdr, cVal) ,; Form_NewZ.Release() } @ ........ BUTTONEX Button_Exit ; ........... ACTION { || aRet := {}, DoEvents(), Form_NewZ.Release() } ........... WITH OBJECT This.Object :Event( 1, {|| Form_NewZ.Button_Find.Setfocus, DoEvents(), _PushKey( VK_SPACE ) } ) :Event(99, {|ow| ow:Release() } ) END WITH ON KEY RETURN OF Form_NewZ ACTION _wPost(1 , This.button_Find.Index) ON KEY ESCAPE OF Form_NewZ ACTION _wPost(99, This.button_Exit.Index) END WINDOW[/pre2] Как сделать не перетаскивая код-блока из кнопки, чтобы срабатывал _wPost(1) и _wPost(99) ? Не хочется перетаскивать код из кнопки. Или так нельзя делать ? Если перетащу код из кнопки в :Event( 1, {|| ..... - то всё работает отлично !
SergKis: Andrey пишет Что то не получается в моём случае. Из своего примера[pre2] (This.Object):Event(11, {|| SetMousePos(This.Btn_1.Handle), This.Btn_1.SetFocus, DoEvents(), _PushKey( VK_SPACE ) }) ... ON KEY F3 ACTION _wPost(11) [/pre2]Если перетащу код из кнопки в :Event( 1, {|| ..... - то всё работает отлично ! Именно так и должно быть, на контролах, всегда, только сообщения
SergKis: PS [pre2] ACTION _wPost(1, This.Index) :Event( 1, { || SaveSeekAdres(cFileMemo,nCity,cCity,nStreet,cStreet,nDom,cDom,; nStro,cStro,nKorp,cKorp,nPodz,cPodz,nKvar,cKvar),; SaveZaivkMenu(cFileMemo2, nZDmfAnt, nZDBase, nZDogAb) ,; aDimAdr := {nCity,cCity,nStreet,cStreet,nDom,cDom,nStro,cStro,nKorp,cKorp,nPodz,cPodz,nKvar,cKvar} ,; aDimZaS := {nLastDay,lOtmena,lOst,lKeyOff,lZClose,lDClose } ,; cVal := Form_NewZ.Label_Adres.Value ,; aRet := FindListZaivka(nZDmfAnt, nZDBase, nZDogAb, aDimZaS, aDimAdr, cVal) ,; _wSend(99) } ) ON KEY RETURN OF Form_NewZ ACTION ( SetMousePos(This.button_Find.Handle), This.button_Find.SetFocus, DoEvents(), _wPost(1, This.button_Find.Index) ) ON KEY ESCAPE OF Form_NewZ ACTION _wPost(99) [/pre2]
SergKis: PPS Для кнопки Exit [pre2] @ ........ BUTTONEX Button_Exit ; ........... ACTION _wPost(2, This.Index) ; :Event( 2, { || aRet := {}, _wSend(99) } ) ON KEY ESCAPE OF Form_NewZ ACTION ( SetMousePos(This.button_Exit.Handle), This.button_Exit.SetFocus, DoEvents(), _wPost(2, This.button_Exit.Index) ) или если есть LOCAL aRet := {} то сразу делать @ ........ BUTTONEX Button_Exit ; ........... ACTION _wPost(99) ; ON KEY ESCAPE ACTION ( SetMousePos(This.button_Exit.Handle), This.button_Exit.SetFocus, DoEvents(), _PushKey( VK_SPACE ) /* или _wPost(99) или _wSend(99) */ ) [/pre2]
Andrey: Всем привет. А как объявить в проге, что нужно линковать функцию, у которой нет явного вызова ? Т.е. вызов функции объявлен в массиве меню, примерно так: AADD( aDim, {"FLAG_RU.bmp" , "Test menu - Russian ", "RunTest1", "Stroka1" , 1 } ) чтобы потом можно было вызвать RunTest1() ? А то сейчас пишет, что нет такой функции в ехе-файле. В библиотеке которую линкую эта функция есть.
gfilatov2002: Andrey пишет: как объявить в проге, что нужно линковать функцию Попробуй добавить REQUEST RunTest1
Andrey: gfilatov2002 пишет: Попробуй добавить Спасибо !
Andrey: Обнаружил небольшой баг в примере MiniGUI\SAMPLES\BASIC\Menu\menudemo5.prg Выбираем меню Options и потом любое другое меню. После выхода из меню можно кликнуть правой кнопкой мышки и это же меню появиться опять на форме. В Options-2 и Options-3 от этого избавился, как рекомендовал раньше. Больше такого избавления в примерах нигде нет ! А новичкам это тоже будет интересно. Последний пример совместно написанный с Сергеем выслал на почту.
gfilatov2002: Andrey пишет: Обнаружил небольшой баг в примере Благодарю за сообщение Добавил две новые функции для проверки - New: function IsContextMenuDefined ( cFormName ); - New: function IsNotifyMenuDefined ( cFormName ). Andrey пишет: Больше такого избавления в примерах нигде нет Посмотри как это работает в примере из папки \samples\Basic\MENU_Dynamic Andrey пишет: пример совместно написанный с Сергеем выслал на почту Благодарю за пример Уже включил его в первую бету новой сборки, которую подготовил сегодня * New: 'Extended Dynamic Context Menu' sample. Contributed by Sergej Kiselev and Verchenko Andrey (see menudemo6.prg in folder \samples\Basic\Menu)
Andrey: Можно ли включить в Минигуи стандартную функцию расчёта размера фонта в зависимости от ширины и высоты LABEL ? Свои есть, но что-то не дотягивают до стандарта. И не знаю как рассчитать размеры для фонтов BOLD ? Вот например есть такая у меня функция: [pre2]////////////////////////////////////////////////////////////////// // Функция вернёт максимальный размер фонта для заданной строки по заданной ширине FUNCTION FontSizeMaxAutoFit( cText, cFName, nWinWidth ) LOCAL nTxtWidth, nFSize, lExit := .T. nFSize := 6 DO WHILE lExit nTxtWidth := GetTxtWidth( cText, nFSize, cFName ) IF nTxtWidth >= nWinWidth lExit := .F. ELSE nFSize++ ENDIF ENDDO RETURN nFSize[/pre2] Если текст короткий то половина слова показывается на LABEL, нижняя часть слова обрезается, слишком большой фонт. Помогите сделать такие универсальные функции !
SergKis: Andrey пишет Помогите сделать такие универсальные функции ! Они уже в тек. версии есть, для регистрированного фонта, посмотри changelog[pre2] * New: Added the useful pseudo-functions GetFontWidth( FontName, nLen ) and GetFontHeight( FontName ) for receiving of the font's parameters. Note that a font should be defined by command DEFINE FONT <FontName> FONTNAME <sysfont> ... [/pre2] и пример, который отсылал Григорию, там есть применение GetFontWidth( FontName, nLen ) для меню. Универсальность nW := 0; AEval(aText, {|ct| nW := Max(nW, GetFontWidth( 'Font_1', Len(ct) ) })
SergKis: PS можешь применить коэффициент, если надо уменьшить\увеличить размер nW := 0; AEval(aText, {|ct| nW := Max(nW, GetFontWidth( 'Font_1', Len(ct) ) * 0.8 /* 1.05 */ })
SergKis: Andrey пишет Помогите сделать такие универсальные функции ! Для реальных размеров текста можно такую ф-ю[pre2] *----------------------------------------------------------------------------* FUNCTION GetTextWidthHeight( aTxt, FontName, FontSize ) *----------------------------------------------------------------------------* LOCAL hFont, lFont, nWidth := 0, nHeigth := 0, cTxt DEFAULT aTxt := { 'W' }, FontName := App.FontName, FontSize := App.FontSize IF VALTYPE( aTxt ) == 'C' aTxt := { aTxt } ENDIF hFont := GetFontHandle( FontName ) IF ( lFont := hFont == 0 ) hFont := InitFont( FontName, FontSize ) ENDIF FOR EACH cTxt IN aTxt IF Len(cTxt) == 0 cTxt := 'W' ENDIF nWidth := Max( nWidth, GetTextWidth( 0, cTxt, hFont ) ) IF nHeight == 0 nHeight := GetTextHeight( 0, cTxt, hFont ) ENDIF NEXT IF lFont DeleteObject( hFont ) EndIf RETURN { nWidth, nHeight } [/pre2]
SergKis: PS Фонты с BOLD и др. атрибутами надо регистрировать DEFINE FONT ...
Andrey: SergKis пишет: добавить NOSHOW, а в ON INIT This.Show() Это относится к окну. Понял. Спасибо большое ! У меня проблема большая... по Tab. Показываю окно с Tab карточкой юзеру. На медленных компах видно как этот Tab дергается, т.е. на Tab вывожу объекты Label и GetBox. Там их много, порядка 150 объектов. Вот и дергается Tab. Можно как то это "дерганье" убрать ? Код почти такой же как в примере MiniGUI\SAMPLES\BASIC\COLORED_TAB Вот мой код [pre2] DEFINE TAB Tab_1 OF Form_Card ; ......... ON CHANGE SizePageBack( Form_Card.Tab_1.Value ) _HMG_ActiveTabBottom := .F. // lBottomStyle FOR nI := 1 TO LEN( aTabName ) IF aStatCheckTabView[nI] // показ вкладки разрешено ! PAGE aTabName[ nI ] //IMAGE cResTabImage cNameLabel := 'Page_' + hb_ntos( nI ) @ 24, 2 LABEL &cNameLabel VALUE "" WIDTH 0 HEIGHT 0 BACKCOLOR aTabColor[nI] // вывести поля карточки ShowPageCard( nI, nRowTab, aTabColor[ nI ], aDimCard[ nI ],; aFontNames, aFontFields, lEditPrg, nFSizeTab ) END PAGE ENDIF NEXT END TAB // Assign the colors to the Tab bookmarks Form_Card.Tab_1.Cargo := aTabColor[/pre2]
SergKis: Andrey пишет Это относится к окну. Понял. Спасибо большое ! Перенеси, обязательно, This.Center как в пред. версии hmg Там их много, порядка 150 объектов. Вот и дергается Tab. Попробуй окну NOSHOW и в ON INIT This.Show, как выше
Andrey: SergKis пишет: Попробуй окну NOSHOW и в ON INIT This.Show, как выше Нет, окну не могу. Нужно для объекта Tab.
SergKis: Andrey Приведенный тобой код, он в каком месте работает, в ON INIT ... или до END WINDOW ?
SergKis: Andrey пишет Нет, окну не могу. Нужно для объекта Tab. Почему ? В чем причина ? Можно показать готовое окно из hide и не видеть как мелькает при формировании.
Andrey: SergKis пишет: Почему ? В чем причина ? Можно показать готовое окно из hide и не видеть как мелькает при формировании. Я окно карточки делаю набегающим, т.е. в цикле увеличиваю размеры окна карточки (мини анимация). Это делаю всё в [pre2] ON INIT { || MyInitCard(cTableForm,lEditPrg,hCursorTable),; ResizeCardForm(cTableForm) , SizePageBack(1) } ; [/pre2] Построение DEFINE TAB Tab_1 OF Form_Card до END WINDOW: [pre2] SetTab_1Card(nRowTab,nFWidth,nFHeight,cFNameTab,nFSizeTab,lEditPrg,aBackColor,; aTabName, aTabColor, aDimCard, aFontNames, aFontFields, aTabFColor2 ) ON KEY ESCAPE OF Form_Card ACTION ThisWindow.Release ON KEY PRIOR OF Form_Card ACTION MyPageUpCard(cTableForm) // это PageUp ON KEY NEXT OF Form_Card ACTION MyPageDownCard(cTableForm) // это PageDown END WINDOW ACTIVATE WINDOW Form_Card [/pre2] Можно ли скрыть построение TAB Tab_1 а потом его показать ?
SergKis: Andrey пишет Можно ли скрыть построение TAB Tab_1 а потом его показать ? Если найдешь хандле всех дочерних окон - page, то, наверно, сможешь. Сделай 2а окна, с tab -> hide, 2ое для анимации, т.е. заполняешь первое, размеры меняешь у второго. Потом 1му -> размеры 2го и выводишь из hide+topmost+-, второму release. Вроде, были примеры на анимацию окна, но не помню так ли.
SergKis: Andrey пишет ON INIT { || MyInitCard(cTableForm,lEditPrg,hCursorTable),; ResizeCardForm(cTableForm) , SizePageBack(1) } ; Все как в примере colored_tab, на глаз видно передергивание (маленькое) перерисовки Сделал NOSHOW + ON INIT ( ..., This.Show() ), все чистенько стало. А так, ты сам елку (анимацию) сделал
Andrey: Всем привет ! Попросил сделать пример с TAB объектом на C# для WinForm. Чуток по другому дергается для большлого кол-ва вкладок с TextBox. Видать это особенность Win-api для WinForm. Но есть одна особенность, в C# можно скрыть объект, а после прорисовки его показать ! Тогда "дерганья" не видно вообще ! Посмотрел хелп по МиниГуи. Для TAB нет свойства INVISIBLE. Для других объектов есть, а для TAB нет. Если бы был, то тогда было бы всё отлично ! Строим скрытый объект TAB, а потом можно было бы сделать в ON INIT { || Form_Card.Tab_1.Show ..... Григорий, можно ли добавить для TAB свойство INVISIBLE ?
PSP: Andrey пишет: Если бы был, то тогда было бы всё отлично ! Строим скрытый объект TAB, а потом можно было бы сделать в ON INIT { || Form_Card.Tab_1.Show ..... Я, конечно, могу ошибаться, но разве Сергей тебе не то же самое предложил? SergKis пишет: Сделал NOSHOW + ON INIT ( ..., This.Show() ), все чистенько стало.
Andrey: PSP пишет: Я, конечно, могу ошибаться, но разве Сергей тебе не то же самое предложил? У объекта TAB по хелпу нет свойства NOSHOW. Сергей предложил сделать NOSHOW для всего окна. Для меня показ окна обязателен. Предложения с подменой окон уж очень сложен.
gfilatov2002: Andrey пишет: можно ли добавить для TAB свойство INVISIBLE ? Для этого у всех контролов есть методы Hide/Show Попробуй *-----------------------------------------------------------------------------* PROCEDURE Hide_CLick *-----------------------------------------------------------------------------* Form_1.Tab_1.Visible := .F. RETURN *-----------------------------------------------------------------------------* PROCEDURE Show_CLick *-----------------------------------------------------------------------------* Form_1.Tab_1.Visible := .T. RETURN
Andrey: gfilatov2002 пишет: Для этого у всех контролов есть методы Hide/Show А как этот метод заставить работать сразу при построение Tab_1 ? Если делать так: [pre2] DEFINE TAB Tab_1 OF Form_Card ; ......... ON CHANGE SizePageBack( Form_Card.Tab_1.Value ) Form_Card.Tab_1.Visible := .F. _HMG_ActiveTabBottom := .F. // lBottomStyle FOR nI := 1 TO LEN( aTabName ) IF aStatCheckTabView[nI] // показ вкладки разрешено ! PAGE aTabName[ nI ] //IMAGE cResTabImage cNameLabel := 'Page_' + hb_ntos( nI ) @ 24, 2 LABEL &cNameLabel VALUE "" WIDTH 0 HEIGHT 0 BACKCOLOR aTabColor[nI] // вывести поля карточки ShowPageCard( nI, nRowTab, aTabColor[ nI ], aDimCard[ nI ],; aFontNames, aFontFields, lEditPrg, nFSizeTab ) END PAGE ENDIF NEXT END TAB [/pre2] То происходит вылет программы. Нужно строить объект DEFINE TAB сразу скрытым. Как это сделать ?
Andrey: Всем привет ! Сделал тестовый пример, показ из массива 20 вкладок по 25 объектов LABEL + 25 объектов GetBox Построение на TAB происходит моментально, без "дерганья". Значит эффект "дерганья" происходит тогда, когда считываются значения полей из базы. Буду дальше пилить тестовый пример.
Andrey: Наконец то смог закончить проверку "дерганья" карточки в TAB. Мой косяк, делаю перерисовку всех объектов TAB в SizeTest. Сам виноват, не там нужно было делать. И вот это: Form_1.Tab_1.Visible := .F. Form_1.Tab_1.Visible := .T. помогло убрать "дерганье" карточки в TAB ! Спасибо всем подсказчикам !
Andrey: Всем привет ! Standard Window: @ <nRow> ,<nCol> FRAME <ControlName> [ ID <nId> ] [ OF | PARENT | DIALOG <ParentWindowName> ] [ CAPTION <cCaption> ] [ WIDTH <nWidth> ] [ HEIGHT <nHeight> ] [ FONT <cFontName> ] [ SIZE <nFontSize> ] [ BOLD ] [ ITALIC ] [ UNDERLINE ] [ STRIKEOUT ] [ BACKCOLOR <anBackColor> ] [ FONTCOLOR <anFontColor> ] [ OPAQUE ] [ TRANSPARENT ] [ INVISIBLE ] [ ON INIT <bInit> ] Использую это объект. Заголовок всегда черным цветом. Можно ли его сделать другим цветом ? Попробовал разные варианты, у меня не получилось.
Andrey: Посмотрел тест на ХР и Win8.1 - цвет заголовка FRAME тоже черный ! Думал опять какая то бодяга в Win8.1.. Смотрел ppo файл - цвет передается нормально ! [pre2]_BeginFrame ( cObj,, nY, nX, nWFrm, nHFrm , aObjFrm[nI,2] , , , .F. , .F., .F., .F., .F. , aBackColor , {255, 0, 0} , .F. , .F. , , ) [/pre2] Значит в МиниГуи что-то сломалось.... Поставил проверку в h_frame.prg на строки[pre2] _HMG_aControlType [k] := "FRAME" _HMG_aControlNames [k] := ControlName _HMG_aControlHandles [k] := ControlHandle ............... _HMG_aControlBkColor [k] := backcolor _HMG_aControlFontColor [k] := fontcolor ? "_HMG_aControlFontColor["+HB_NtoS(K)+"]", HB_ValToExp( _HMG_aControlFontColor[k] )[/pre2] Цвет передаётся нормально: [pre2]_HMG_aControlFontColor[27] {255, 0, 0} [/pre2] А дальше не знаю где смотреть.... Посмотрите/попробуйте пожалуйста объект FRAME, это только у меня или везде так ЧЕРНЫМ цветом
gfilatov2002: Andrey пишет: это только у меня или везде так ЧЕРНЫМ цветом Эта проблема уже обсуждалась ранее: если используется THEMED Винда, то цвет текста в заголовке FRAME и в подписи CHECKBOX всегда черный. Для того, чтобы увидеть цветной заголовок, надо использовать Классический вид в Винде, т.е. как в Windows 98
Andrey: gfilatov2002 пишет: Эта проблема уже обсуждалась ранее: Пропустил наверное... Пока сам на грабли не налетел, не запомнишь ! СПАСИБО, понял. А в C# (он называется GroupBox) на любых темах цвет заголовка FRAME можно делать любым... Вот пример - https://cloud.mail.ru/public/Ba8K/kzjVDx7tc Может можно как нибудь сделать изменение цвета заголовка и для МиниГуи ? Это не срочно, но чтобы было такое в МиниГуи.
gfilatov2002: Andrey пишет: Может можно как нибудь сделать изменение цвета заголовка и для МиниГуи ? Да, есть уже. Посмотри функцию MyFrame() в примере из папки samples\Basic\LABEL_3
Andrey: gfilatov2002 пишет: Посмотри функцию MyFrame() в примере из папки samples\Basic\LABEL_3 Посмотрел... Что-то не совсем понятно как прицепить эту функцию в модуль Form_fonts.prg проекта Tsb_composite ? Там несколько FRAME и имена объектов разные.
Andrey: Вроде получилось сделать несколько FRAME через функцию MyFrame(), но пришлось убрать имя и размер фонта в этой функции. И не по центру текста проходиь полоса, но пойдёт и так ! Спасибо Григорий !
Andrey: Всем привет ! Вот что за ерунда получается, как юзер добивается ошибки в работающей программе ? Пробовал сам - не вылетает, а юзер что-то делает и вылетает. Вот например такая ошибка: Error MGERROR/0 Window: Form_Dim is already defined. Program terminated. Called from MSGMINIGUIERROR(100) in module: h_error.prg Called from _DEFINEMODALWINDOW(487) in module: h_windows.prg Called from FORM_SEL_DIM(632) in module: Source\Sel_Dim_Hmg.prg Called from SEL_DIM(561) in module: Source\Sel_Dim_Hmg.prg В исходнике все правильно, у меня работает без ошибок: [pre] DEFINE WINDOW Form_Dim ; .... MODAL NOSYSMENU ; NOSIZE ; ON INIT {|| OnInitFormDim(lKeyPass), oBrw_5:Setfocus() } // строка 632 [/pre] Как расшифровать ошибку ? Может доп.отладку какую то сделать ? Окно Form_Dim только в ОДНОМ исходнике, и оно MODAL, т.е. другое окно не сделаешь, пока это окно не закроешь. Или я чего-то не до понимаю ?
Dima: Andrey пишет: Пробовал сам - не вылетает, а юзер что-то делает и вылетает. Проставь ему пиво , пусть колется как
MIKHAIL: Andrey пишет: Может доп.отладку какую то сделать ? Я в терминалке сделал второй поток и отслеживаю нажатые клавиши и сохраняю изменения экрана, имитирую видеопоток. Сохраняю все в базу, потом можно просматривать что делал пользователь, что нажимал в какой момент времени, снимок состояния базы и т.д. Иногда помогает понять что накосячили, да и подловить недобросовестных пользователей можно.... Наверное в гуи более затратно будте вести постоянную запись, но последние минуту -другую до вылета проги можно сохранять и выкладывать на ftp например
Andrey: Andrey пишет: Вот например такая ошибка: Error MGERROR/0 Window: Form_Dim is already defined. Program terminated. Called from MSGMINIGUIERROR(100) in module: h_error.prg Called from _DEFINEMODALWINDOW(487) in module: h_windows.prg Called from FORM_SEL_DIM(632) in module: Source\Sel_Dim_Hmg.prg Вроде разобрался с подсказки Сергея - почему так выходит, т.е. юзер ловит ошибку, а я нет . У меня система Win8.1, у юзера Win7 и WinServer2008. Юзер по кнопке успевает 2 раза кликнуть по мышке и 2 раза вызвать модальное окно с одинаковым именем. У меня так не получается... Сделал теперь в кнопке так: [pre2] ACTION {|cw,cn| cw := ThisWindow.Name, cn := This.Name ,; SetProperty(cw,cn, "Enabled", .F.) ,; Form_Sel_Dim() ,; // вызов справочника iif( _IsWindowActive(cw), Setproperty(cw,cn, "Enabled", .T.), Nil ) ,; Form_Seek.Label_Buff.Setfocus } [/pre2]
kkg: Всем привет ! в примере \MiniGUI\SAMPLES\Advanced\Tsb_array_2\demo.prg, если увеличить количество колонок (раза в 3, выход за ширину TSBROWS) и после запуска программы на горизонтальном SCRLLBAR удерживать кнопку движения вправо, всё подвисает. Может кто то подскажет как побороть ?
SergKis: kkg пишет и после запуска программы на горизонтальном SCRLLBAR удерживать кнопку движения вправо, всё подвисает Попробуйте сделать для колонок (при быстром скролинге не успевает за ним прорисовка тсб) AEval( oBrw:aColumns, {|oc| oc:bGotFocus := {|| DoEvents() } } ) Если не поможет, то надо уменьшать количество колонок в просмотре, используя oc:Visible := .F. для скрытия и показываете, сгруппировав частями, переключая по выбору на нужную группу.
kkg: SergKis пишет AEval( oBrw:aColumns, {|oc| oc:bGotFocus := {|| DoEvents() } } ) Спасибо за идею, но не помогло, хотя улучшило. Попробую через oBrw:bEvents "разжижить" событие WM_HSCROLL , SB_LINERIGHT
gfilatov2002: kkg пишет: после запуска программы на горизонтальном SCRLLBAR удерживать кнопку движения вправо, всё подвисает Да, это известная проблема с большим числом колонок и беспрерывным нажатием на стрелку Как вариант решения, предлагается пример ниже: [pre2] #include "minigui.ch" #include "tsbrowse.ch" REQUEST SQLMIX Procedure Main() rddSetDefault( "SQLMIX" ) DEFINE WINDOW Form1 ; AT 0,0 ; WIDTH (RR_GetDesktopArea()[4] * 0.99) ; HEIGHT (RR_GetDesktopArea()[3] * 0.91) ; TITLE "TsBrowse Array Test" ; MAIN ; FONT 'Tahoma' SIZE 9 END WINDOW Test() Form1.Center Form1.ACTIVATE Return *-------------------------------------------------------------- Function Test() local i := 0 local j := 0 Local aStr := {} local cAlias := "TEST" local cBrw := "BRW" PUBLIC &cBrw FOR j := 1 TO 300 AADD( aStr, {"F_" + NTOC(j) , "N", 14, 2 } ) NEXT dbCreate( cAlias, aStr,, .T., cAlias ) FOR i := 1 TO 100 (cAlias)->( DbAppend() ) FOR j := 1 TO 300 (cAlias)->( FieldPut(j, i*j) ) NEXT NEXT DEFINE TBROWSE &cBrw ; At 20, 5 ; ALIAS cAlias ; OF Form1 ; WIDTH (Form1.Width - 20) ; HEIGHT (Form1.Height - 70) ; COLORS { CLR_BLACK, CLR_WHITE } ; FONT "MS Sans Serif" ; SIZE 8 ; CELL; SELECTOR .T. END TBROWSE &cBrw:bUserKeys := { |x,y,z| left_right_key(x, y, z) } &cBrw:bChange := { |x| tbrow_refresh(x) } &cBrw:LoadFields( FALSE ) Return Nil function left_right_key(pnKey, pnFlags, pSelf) if pnKey == VK_LEFT .or. pNKey == VK_RIGHT pSelf:refresh(.F.,.T.) INKEYGUI(100) pSelf:refresh(.F.,.T.) end return(pnKey) function tbrow_refresh(x) x:RefreshARow(x:nRowPos) if x:nRowPos == x:nRowCount() .or. x:nRowPos == x:nRowCount() + 1 x:refresh(.F.,.T.) end return(NIL) [/pre2]
kkg: gfilatov2002 пишет: Как вариант решения, предлагается пример ниже: Григорий спасибо, но и с SQLMIX и с массивом, результат всё равно крах. click here
SergKis: kkg пишет с SQLMIX и с массивом, результат всё равно крах Правильнее, по мне, отработать счетчиками нажатия (+) и отпускания (сброс) клавиш VK_LEFT, VK_RIGHT, т.е. если, к примеру, счетчик нажатий будет > 5, то не делать :GoLeft(), :GoRight() пока не отпустят или не закончится прорисовка тсб. Похожая схема работает в моей версии (7+часть из 9) тсб при VK_UP, VK_DOWN, нажатиях, если их >= :nRowCount(), то делаю листание страницы, вместо движения построчно. Таким образом обхожу зависание прорисовки в 7ой версии тсб.
SergKis: SergKis пишет отработать счетчиками Измененный пример от Григория со счетчиками [pre2] #include "minigui.ch" #include "tsbrowse.ch" REQUEST SQLMIX Procedure Main() rddSetDefault( "SQLMIX" ) DEFINE WINDOW Form1 ; AT 0,0 ; WIDTH (RR_GetDesktopArea()[4] * 0.99) ; HEIGHT (RR_GetDesktopArea()[3] * 0.91) ; TITLE "TsBrowse Array Test" ; MAIN ; FONT 'Tahoma' SIZE 9 END WINDOW Test() Form1.Center Form1.ACTIVATE Return *-------------------------------------------------------------- Function Test() local i := 0 local j := 0 Local aStr := {} local cAlias := "TEST" local cBrw := "BRW" PUBLIC &cBrw FOR j := 1 TO 300 AADD( aStr, {"F_" + NTOC(j) , "N", 14, 2 } ) NEXT dbCreate( cAlias, aStr,, .T., cAlias ) FOR i := 1 TO 100 (cAlias)->( DbAppend() ) FOR j := 1 TO 300 (cAlias)->( FieldPut(j, i*j) ) NEXT NEXT DEFINE TBROWSE &cBrw ; At 20, 5 ; ALIAS cAlias ; OF Form1 ; WIDTH (Form1.Width - 20) ; HEIGHT (Form1.Height - 70) ; COLORS { CLR_BLACK, CLR_WHITE } ; FONT "MS Sans Serif" ; SIZE 8 ; CELL; SELECTOR .T. END TBROWSE //&cBrw:bUserKeys := { |x,y,z| left_right_key(x, y, z) } //&cBrw:bChange := { |x| tbrow_refresh(x) } &cBrw:LoadFields( FALSE ) &cBrw:bEvents := {|ob,nm,np,nl| tsb_events(ob,nm,np,nl) } Return Nil function tsb_events( oBrw, nMsg, nWParam, nLParam ) Local nRet := 0, nKey, nFlag Local lCtrl := _GetKeyState( VK_CONTROL ) Local lShift := _GetKeyState( VK_SHIFT ) Local lAlt := _GetKeyState( VK_MENU ) Static n_CntLeft := 0, n_CntRight := 0, n_LeftRight := 5 nKey := nWParam nFlag := nLParam If lCtrl .or. lShift .or. lAlt ElseIf nMsg == WM_KEYDOWN If nKey == VK_LEFT n_CntLeft ++ If n_CntLeft >= n_LeftRight nRet := 1 InkeyGui(100) n_CntLeft := 0 EndIf DoEvents() ElseIf nKey == VK_RIGHT n_CntRight ++ If n_CntRight >= n_LeftRight nRet := 1 InkeyGui(100) n_CntRight := 0 EndIf DoEvents() EndIf ElseIf nMsg == WM_KEYUP n_CntLeft := n_CntRight := 0 EndIf return nRet [/pre2] Вроде работает
kkg: SergKis пишет: Вроде работает на этом примере да , но на примере из поставки с массивом + nFreeze на счётчиках не работает (по крайней мере у меня не получается), только с временной задержкой #include "minigui.ch" #include "TSBrowse.ch" static CountEvents := 1 PROCEDURE MAIN LOCAL oBrw, aDatos, aArray, aHead, aSize, aFoot, aPict, aAlign, aName, aFontHF LOCAL aFont := {} // Local hFontHead, hFontFoot LOCAL cFontName := _HMG_DefaultFontName LOCAL nFontSize := 11 Public nbUserKeys := seconds(), CountEvents:= {0,0} SET DECIMALS TO 4 SET DATE TO GERMAN SET EPOCH TO 2000 SET CENTURY ON SET EXACT ON DEFINE FONT Font_1 FONTNAME cFontName SIZE nFontSize DEFINE FONT Font_2 FONTNAME cFontName SIZE nFontSize BOLD AAdd( aFont, GetFontHandle( "Font_1" ) ) AAdd( aFont, GetFontHandle( "Font_2" ) ) DEFINE WINDOW test ; TITLE "SetArray For Report Demo" ; MAIN ; NOMAXIMIZE NOSIZE DEFINE STATUSBAR FONT cFontName SIZE nFontSize STATUSITEM "0" // WIDTH 0 FONTCOLOR BLACK STATUSITEM "Item 1" WIDTH 230 // FONTCOLOR BLACK STATUSITEM "Item 2" WIDTH 230 // FONTCOLOR BLACK STATUSITEM "Item 3" WIDTH 230 // FONTCOLOR BLACK END STATUSBAR DEFINE TBROWSE oBrw ; AT 1 + iif( IsVistaOrLater(), GetBorderWidth()/2, 0 ), ; 1 + iif( IsVistaOrLater(), GetBorderHeight()/2, 0 ) ; WIDTH test.WIDTH - 2 * GetBorderWidth() ; HEIGHT test.HEIGHT - GetTitleHeight() - ; GetProperty( "test", "StatusBar", "Height" ) - ; 2 * GetBorderHeight() ; ENUMERATOR ; FONT cFontName SIZE nFontSize ; GRID EDIT aDatos := CreateDatos() aArray := aDatos[ 1 ] aHead := aDatos[ 2 ] aSize := aDatos[ 3 ] aFoot := aDatos[ 4 ] aPict := aDatos[ 5 ] aAlign := aDatos[ 6 ] aName := aDatos[ 7 ] // hFontHead := aFont[1] // normal Header // hFontFoot := aFont[2] // bold Footer // aFontHF := { hFontHead, hFontFoot } // aFontHF := aFont[1] // normal Header, Footer aFontHF := aFont[2] // bold Header, Footer oBrw := SetArrayTo( "oBrw", "test", aArray, aFontHF, aHead, aSize, aFoot, aPict, aAlign, aName ) oBrw:nWheelLines := 1 oBrw:nClrLine := COLOR_GRID oBrw:nHeightCell += 5 oBrw:nHeightHead += 5 IF ! Empty( aFoot ) oBrw:nHeightFoot += 5 ENDIF IF oBrw:lEnum oBrw:nHeightSpecHd := oBrw:nHeightCell ENDIF END TBROWSE oBrw:nFreeze:=4 oBrw:lLockFreeze:=.f. // AEval( oBrw:aColumns, {|oc| oc:bGotFocus := {|| (DoEvents()) } } ) // oBrw:bUserKeys := {|nKy,nFl,oBr| my_bUserKeys(@nKy, @nFl, oBr) } //{|nKey,nFlags| nKey = my_bUserKeys(nKey,nFlags) } oBrw:bEvents := {| oBrw, nMsg, nWParam, nLParam| tsb_events(oBrw, nMsg, nWParam, nLParam) } END WINDOW DoMethod( "test", "Activate" ) RETURN * ====================================================================== STATIC FUNCTION CreateDatos() LOCAL i, k := 1000, aDatos, aHead, aSize, aFoot, aPict, aAlign, aName aDatos := Array( k ) FOR i := 1 TO k aDatos[ i ] := { ; " ", ; // 1 i, ; // 2 ntoc( i ) + "_123", ; // 3 Date() + i, ; // 4 PadR( "Test line - " + ntoc( i ), 20 ), ; // 5 Round( ( 10000 -i ) * i / 3, 2 ), ; // 6 100.00 * i, ; // 7 0.12, ; // 8 Round( 100.00 * i * 0.12, 2 ), ; // 9 Round( 1234567.00 / i, 3 ), ; // 10 PadR( "Line " + StrZero( i, 5 ), 20 ), ; // 11 Date(), ; // 12 Time(), ; // 13 i % 2 == 0, ; // 14 " ", ; // 1 i, ; // 2 ntoc( i ) + "_123", ; // 3 Date() + i, ; // 4 PadR( "Test line - " + ntoc( i ), 20 ), ; // 5 Round( ( 10000 -i ) * i / 3, 2 ), ; // 6 100.00 * i, ; // 7 0.12, ; // 8 Round( 100.00 * i * 0.12, 2 ), ; // 9 Round( 1234567.00 / i, 3 ), ; // 10 PadR( "Line " + StrZero( i, 5 ), 20 ), ; // 11 Date(), ; // 12 Time(), ; // 13 i % 2 == 0, ; // 14 " ", ; // 1 i, ; // 2 ntoc( i ) + "_123", ; // 3 Date() + i, ; // 4 PadR( "Test line - " + ntoc( i ), 20 ), ; // 5 Round( ( 10000 -i ) * i / 3, 2 ), ; // 6 100.00 * i, ; // 7 0.12, ; // 8 Round( 100.00 * i * 0.12, 2 ), ; // 9 Round( 1234567.00 / i, 3 ), ; // 10 PadR( "Line " + StrZero( i, 5 ), 20 ), ; // 11 Date(), ; // 12 Time(), ; // 13 i % 2 == 0, ; // 14 " ", ; // 1 i, ; // 2 ntoc( i ) + "_123", ; // 3 Date() + i, ; // 4 PadR( "Test line - " + ntoc( i ), 20 ), ; // 5 Round( ( 10000 -i ) * i / 3, 2 ), ; // 6 100.00 * i, ; // 7 0.12, ; // 8 Round( 100.00 * i * 0.12, 2 ), ; // 9 Round( 1234567.00 / i, 3 ), ; // 10 PadR( "Line " + StrZero( i, 5 ), 20 ), ; // 11 Date(), ; // 12 Time(), ; // 13 i % 2 == 0, ; // 14 i, ; // 2 ntoc( i ) + "_123", ; // 3 Date() + i, ; // 4 PadR( "Test line - " + ntoc( i ), 20 ), ; // 5 Round( ( 10000 -i ) * i / 3, 2 ), ; // 6 100.00 * i, ; // 7 0.12, ; // 8 Round( 100.00 * i * 0.12, 2 ), ; // 9 Round( 1234567.00 / i, 3 ), ; // 10 PadR( "Line " + StrZero( i, 5 ), 20 ), ; // 11 Date(), ; // 12 Time(), ; // 13 i % 2 == 0, ; // 14 " ", ; // 1 i, ; // 2 ntoc( i ) + "_123", ; // 3 Date() + i, ; // 4 PadR( "Test line - " + ntoc( i ), 20 ), ; // 5 Round( ( 10000 -i ) * i / 3, 2 ), ; // 6 100.00 * i, ; // 7 0.12, ; // 8 Round( 100.00 * i * 0.12, 2 ), ; // 9 Round( 1234567.00 / i, 3 ), ; // 10 PadR( "Line " + StrZero( i, 5 ), 20 ), ; // 11 Date(), ; // 12 Time(), ; // 13 i % 2 == 0 ; // 14 } NEXT aHead := AClone( aDatos[ 1 ] ) // AEval(aHead, {|x,n| aHead[ n ] := "Head_" + hb_ntos(n) }) AEval( aHead, {| x, n| aHead[ n ] := "Head" + hb_ntos( n ) + ; iif( n % 2 == 0, CRLF + "SubHead" + hb_ntos( n ), "" ) } ) aFoot := Array( Len( aDatos[ 1 ] ) ) AEval( aFoot, {| x, n| aFoot[ n ] := n } ) // aFoot := .T. // подножие есть с пустыми значениями aPict := Array( Len( aDatos[ 1 ] ) ) // можно не задавать, формируются aPict[ 10 ] := "99999999999.999" // автоматом для C,N по мах значению aSize := Array( Len( aDatos[ 1 ] ) ) // можно не задавать, формируются aSize[ 10 ] := aPict[ 10 ] // автоматом по мах значению в колонке aAlign := Array( Len( aDatos[ 1 ] ) ) // тип поля C - DT_LEFT aAlign[ 2 ] := DT_CENTER // D,L - DT_CENTER // N - DT_RIGHT aName := Array( Len( aDatos[ 1 ] ) ) AEval( aName, {| x, n| aName[ n ] := "MyName_" + hb_ntos( n ) } ) RETURN { aDatos, aHead, aSize, aFoot, aPict, aAlign, aName } function tsb_events( oBrw, nMsg, nWParam, nLParam ) Local nRet := 0, nKey, nFlag Local lCtrl := _GetKeyState( VK_CONTROL ) Local lShift := _GetKeyState( VK_SHIFT ) Local lAlt := _GetKeyState( VK_MENU ) Static n_CntLeft := 0, n_CntRight := 0, n_LeftRight := 5 nKey := nWParam nFlag := nLParam If lCtrl .or. lShift .or. lAlt ElseIf nMsg == WM_KEYDOWN If nKey == VK_LEFT n_CntLeft ++ If n_CntLeft >= n_LeftRight nRet := 1 InkeyGui(100) n_CntLeft := 0 EndIf DoEvents() ElseIf nKey == VK_RIGHT n_CntRight ++ If n_CntRight >= n_LeftRight nRet := 1 InkeyGui(100) n_CntRight := 0 EndIf DoEvents() EndIf ElseIf nMsg == WM_KEYUP n_CntLeft := n_CntRight := 0 EndIf return nRet
SergKis: kkg пишет на этом примере да , но на примере из поставки с массивом + nFreeze на счётчиках не работает (по крайней мере у меня не получается), только с временной задержкой Уменьшите значение Static n_CntLeft := 0, n_CntRight := 0, n_LeftRight := 3 Вот пример Tsb_Array_2 с учетом :nFreeze [pre2] #include "minigui.ch" #include "TSBrowse.ch" PROCEDURE MAIN LOCAL oBrw, aDatos, aArray, aHead, aSize, aFoot, aPict, aAlign, aName, aFontHF LOCAL aFont := {} // Local hFontHead, hFontFoot LOCAL cFontName := _HMG_DefaultFontName LOCAL nFontSize := 11 SET DECIMALS TO 4 SET DATE TO GERMAN SET EPOCH TO 2000 SET CENTURY ON SET EXACT ON DEFINE FONT Font_1 FONTNAME cFontName SIZE nFontSize DEFINE FONT Font_2 FONTNAME cFontName SIZE nFontSize BOLD AAdd( aFont, GetFontHandle( "Font_1" ) ) AAdd( aFont, GetFontHandle( "Font_2" ) ) DEFINE WINDOW test ; TITLE "SetArray For Report Demo" ; MAIN ; NOMAXIMIZE NOSIZE DEFINE STATUSBAR FONT cFontName SIZE nFontSize STATUSITEM "0" // WIDTH 0 FONTCOLOR BLACK STATUSITEM "Item 1" WIDTH 230 // FONTCOLOR BLACK STATUSITEM "Item 2" WIDTH 230 // FONTCOLOR BLACK STATUSITEM "Item 3" WIDTH 230 // FONTCOLOR BLACK END STATUSBAR DEFINE TBROWSE oBrw ; AT 1 + iif( IsVistaOrLater(), GetBorderWidth()/2, 0 ), ; 1 + iif( IsVistaOrLater(), GetBorderHeight()/2, 0 ) ; WIDTH test.WIDTH - 2 * GetBorderWidth() ; HEIGHT test.HEIGHT - GetTitleHeight() - ; GetProperty( "test", "StatusBar", "Height" ) - ; 2 * GetBorderHeight() ; ENUMERATOR ; FONT cFontName SIZE nFontSize ; GRID EDIT aDatos := CreateDatos() aArray := aDatos[ 1 ] aHead := aDatos[ 2 ] aSize := aDatos[ 3 ] aFoot := aDatos[ 4 ] aPict := aDatos[ 5 ] aAlign := aDatos[ 6 ] aName := aDatos[ 7 ] // hFontHead := aFont[1] // normal Header // hFontFoot := aFont[2] // bold Footer // aFontHF := { hFontHead, hFontFoot } // aFontHF := aFont[1] // normal Header, Footer aFontHF := aFont[2] // bold Header, Footer oBrw := SetArrayTo( "oBrw", "test", aArray, aFontHF, aHead, aSize, aFoot, aPict, aAlign, aName ) oBrw:nWheelLines := 1 oBrw:nClrLine := COLOR_GRID oBrw:nHeightCell += 5 oBrw:nHeightHead += 5 IF ! Empty( aFoot ) oBrw:nHeightFoot += 5 ENDIF IF oBrw:lEnum oBrw:nHeightSpecHd := oBrw:nHeightCell ENDIF oBrw:nFreeze := 2 oBrw:lLockFreeze := .T. oBrw:bEvents := {|ob,nm,np,nl| tsb_events(ob,nm,np,nl) } oBrw:nCell := oBrw:nFreeze + 1 END TBROWSE oBrw:SetNoHoles() oBrw:SetFocus() END WINDOW DoMethod( "test", "Activate" ) RETURN * ====================================================================== STATIC FUNCTION CreateDatos() LOCAL a, b, i, j, k := 1000, n LOCAL aDatos, aHead, aSize, aFoot, aPict, aAlign, aName aDatos := Array( k ) FOR i := 1 TO k a := { " ", ; // 1 i, ; // 2 ntoc( i ) + "_123", ; // 3 Date() + i, ; // 4 PadR( "Test line - " + ntoc( i ), 20 ), ; // 5 Round( ( 10000 -i ) * i / 3, 2 ), ; // 6 100.00 * i, ; // 7 0.12, ; // 8 Round( 100.00 * i * 0.12, 2 ), ; // 9 Round( 1234567.00 / i, 3 ), ; // 10 PadR( "Line " + StrZero( i, 5 ), 20 ), ; // 11 Date(), ; // 12 Time(), ; // 13 i % 2 == 0 } // 14 n := Len(a) FOR b := 1 TO 10 FOR j := 1 TO n ; AAdd(a, a[ j ]) NEXT NEXT aDatos[ i ] := a NEXT aHead := AClone( aDatos[ 1 ] ) // AEval(aHead, {|x,n| aHead[ n ] := "Head_" + hb_ntos(n) }) AEval( aHead, {| x, n| aHead[ n ] := "H_" + hb_ntos( n ) + ; iif( n % 2 == 0, CRLF + "S_" + hb_ntos( n ), "" ) } ) aFoot := Array( Len( aDatos[ 1 ] ) ) AEval( aFoot, {| x, n| aFoot[ n ] := n } ) // aFoot := .T. // подножие есть с пустыми значениями aPict := Array( Len( aDatos[ 1 ] ) ) // можно не задавать, формируются aPict[ 10 ] := "99999999999.999" // автоматом для C,N по мах значению aSize := Array( Len( aDatos[ 1 ] ) ) // можно не задавать, формируются aSize[ 10 ] := aPict[ 10 ] // автоматом по мах значению в колонке aAlign := Array( Len( aDatos[ 1 ] ) ) // тип поля C - DT_LEFT aAlign[ 2 ] := DT_CENTER // D,L - DT_CENTER // N - DT_RIGHT aName := Array( Len( aDatos[ 1 ] ) ) AEval( aName, {| x, n| aName[ n ] := "MyName_" + hb_ntos( n ) } ) RETURN { aDatos, aHead, aSize, aFoot, aPict, aAlign, aName } function tsb_events( oBrw, nMsg, nWParam, nLParam ) Local nRet := 0, nKey, nFlag, nCol, nFrez Local lCtrl := _GetKeyState( VK_CONTROL ) Local lShift := _GetKeyState( VK_SHIFT ) Local lAlt := _GetKeyState( VK_MENU ) Static n_CntLeft := 0, n_CntRight := 0, n_LeftRight := 3 nCol := oBrw:nCell nFrez := oBrw:nFreeze + 1 nKey := nWParam nFlag := nLParam If lCtrl .or. lShift .or. lAlt ElseIf nMsg == WM_KEYDOWN If nKey == VK_LEFT .and. nCol > nFrez n_CntLeft ++ If n_CntLeft >= n_LeftRight nRet := 1 InkeyGui(100) n_CntLeft := 0 EndIf DoEvents() ElseIf nKey == VK_RIGHT .and. nCol <= oBrw:nColCount() n_CntRight ++ If n_CntRight >= n_LeftRight nRet := 1 InkeyGui(100) n_CntRight := 0 EndIf DoEvents() EndIf ElseIf nMsg == WM_KEYUP n_CntLeft := n_CntRight := 0 EndIf return nRet [/pre2]
kkg: SergKis пишет: Уменьшите значение Static n_CntLeft := 0, n_CntRight := 0, n_LeftRight := 3 Вот пример Tsb_Array_2 с учетом :nFreeze так всё равно виснет если двигать зажатой кнопкой скрола в право
SergKis: kkg пишет так всё равно виснет если двигать зажатой кнопкой скрола в право В моей сборки вправо и влево зажатый скролл работает по всей линейке и не виснет (hmg 19.09.2 сборка) Если виснет у вас, то можно пробовать обработку сообщения WM_HSCROLL (цветом выделено) [pre2] function tsb_events( oBrw, nMsg, nWParam, nLParam ) Local nRet := 0, nKey, nFlag, nCol, nFrez Local lCtrl := _GetKeyState( VK_CONTROL ) Local lShift := _GetKeyState( VK_SHIFT ) Local lAlt := _GetKeyState( VK_MENU ) Static n_CntLeft := 0, n_CntRight := 0, n_LeftRight := 3 nCol := oBrw:nCell nFrez := oBrw:nFreeze + 1 nKey := nWParam nFlag := nLParam If lCtrl .or. lShift .or. lAlt ElseIf nMsg == WM_KEYDOWN If nKey == VK_LEFT .and. nCol > nFrez n_CntLeft ++ If n_CntLeft >= n_LeftRight nRet := 1 InkeyGui(100) n_CntLeft := 0 EndIf DoEvents() ElseIf nKey == VK_RIGHT .and. nCol <= oBrw:nColCount() n_CntRight ++ If n_CntRight >= n_LeftRight nRet := 1 InkeyGui(100) n_CntRight := 0 EndIf DoEvents() EndIf Elseif nMsg == WM_HSCROLL If ! oBrw:lDontchange oBrw:HScroll( Loword( nKey ), HiWord( nFlag ) ) nRet := 1 InkeyGui(100) DoEvents() EndIf ElseIf nMsg == WM_KEYUP n_CntLeft := n_CntRight := 0 EndIf return nRet [/pre2] Если скролл побежал до конца\начала, надо пощелкать по тсб мышкой, для активации тсб или по полунку скролла Причину такого поведения надо искать, разбирать тсб и скролл работу
kkg: SergKis пишет: В моей сборки вправо и влево зажатый скролл работает по всей линейке и не виснет (hmg 19.09.2 сборка) Если виснет у вас, то можно пробовать обработку сообщения WM_HSCROLL (цветом выделено) у меня сборка Harbour MiniGUI Extended Edition 19.10 (Update 2), на ней не работает. заработало только так. #include "minigui.ch" #include "TSBrowse.ch" PROCEDURE MAIN LOCAL oBrw, aDatos, aArray, aHead, aSize, aFoot, aPict, aAlign, aName, aFontHF LOCAL aFont := {} // Local hFontHead, hFontFoot LOCAL cFontName := _HMG_DefaultFontName LOCAL nFontSize := 11 SET DECIMALS TO 4 SET DATE TO GERMAN SET EPOCH TO 2000 SET CENTURY ON SET EXACT ON DEFINE FONT Font_1 FONTNAME cFontName SIZE nFontSize DEFINE FONT Font_2 FONTNAME cFontName SIZE nFontSize BOLD AAdd( aFont, GetFontHandle( "Font_1" ) ) AAdd( aFont, GetFontHandle( "Font_2" ) ) DEFINE WINDOW test ; TITLE "SetArray For Report Demo" ; MAIN ; NOMAXIMIZE NOSIZE DEFINE STATUSBAR FONT cFontName SIZE nFontSize STATUSITEM "0" // WIDTH 0 FONTCOLOR BLACK STATUSITEM "Item 1" WIDTH 230 // FONTCOLOR BLACK STATUSITEM "Item 2" WIDTH 230 // FONTCOLOR BLACK STATUSITEM "Item 3" WIDTH 230 // FONTCOLOR BLACK END STATUSBAR DEFINE TBROWSE oBrw ; AT 1 + iif( IsVistaOrLater(), GetBorderWidth()/2, 0 ), ; 1 + iif( IsVistaOrLater(), GetBorderHeight()/2, 0 ) ; WIDTH test.WIDTH - 2 * GetBorderWidth() ; HEIGHT test.HEIGHT - GetTitleHeight() - ; GetProperty( "test", "StatusBar", "Height" ) - ; 2 * GetBorderHeight() ; ENUMERATOR ; FONT cFontName SIZE nFontSize ; GRID EDIT aDatos := CreateDatos() aArray := aDatos[ 1 ] aHead := aDatos[ 2 ] aSize := aDatos[ 3 ] aFoot := aDatos[ 4 ] aPict := aDatos[ 5 ] aAlign := aDatos[ 6 ] aName := aDatos[ 7 ] // hFontHead := aFont[1] // normal Header // hFontFoot := aFont[2] // bold Footer // aFontHF := { hFontHead, hFontFoot } // aFontHF := aFont[1] // normal Header, Footer aFontHF := aFont[2] // bold Header, Footer oBrw := SetArrayTo( "oBrw", "test", aArray, aFontHF, aHead, aSize, aFoot, aPict, aAlign, aName ) oBrw:nWheelLines := 1 oBrw:nClrLine := COLOR_GRID oBrw:nHeightCell += 5 oBrw:nHeightHead += 5 IF ! Empty( aFoot ) oBrw:nHeightFoot += 5 ENDIF IF oBrw:lEnum oBrw:nHeightSpecHd := oBrw:nHeightCell ENDIF oBrw:nFreeze := 4 oBrw:lLockFreeze := .F. oBrw:bEvents := {|ob,nm,np,nl| tsb_events(ob,nm,np,nl) } oBrw:nCell := oBrw:nFreeze + 1 END TBROWSE oBrw:SetNoHoles() oBrw:SetFocus() END WINDOW DoMethod( "test", "Activate" ) RETURN * ====================================================================== STATIC FUNCTION CreateDatos() LOCAL a, b, i, j, k := 1000, n LOCAL aDatos, aHead, aSize, aFoot, aPict, aAlign, aName aDatos := Array( k ) FOR i := 1 TO k a := { " ", ; // 1 i, ; // 2 ntoc( i ) + "_123", ; // 3 Date() + i, ; // 4 PadR( "Test line - " + ntoc( i ), 20 ), ; // 5 Round( ( 10000 -i ) * i / 3, 2 ), ; // 6 100.00 * i, ; // 7 0.12, ; // 8 Round( 100.00 * i * 0.12, 2 ), ; // 9 Round( 1234567.00 / i, 3 ), ; // 10 PadR( "Line " + StrZero( i, 5 ), 20 ), ; // 11 Date(), ; // 12 Time(), ; // 13 i % 2 == 0 } // 14 n := Len(a) FOR b := 1 TO 10 FOR j := 1 TO n ; AAdd(a, a[ j ]) NEXT NEXT aDatos[ i ] := a NEXT aHead := AClone( aDatos[ 1 ] ) // AEval(aHead, {|x,n| aHead[ n ] := "Head_" + hb_ntos(n) }) AEval( aHead, {| x, n| aHead[ n ] := "H_" + hb_ntos( n ) + ; iif( n % 2 == 0, CRLF + "S_" + hb_ntos( n ), "" ) } ) aFoot := Array( Len( aDatos[ 1 ] ) ) AEval( aFoot, {| x, n| aFoot[ n ] := n } ) // aFoot := .T. // подножие есть с пустыми значениями aPict := Array( Len( aDatos[ 1 ] ) ) // можно не задавать, формируются aPict[ 10 ] := "99999999999.999" // автоматом для C,N по мах значению aSize := Array( Len( aDatos[ 1 ] ) ) // можно не задавать, формируются aSize[ 10 ] := aPict[ 10 ] // автоматом по мах значению в колонке aAlign := Array( Len( aDatos[ 1 ] ) ) // тип поля C - DT_LEFT aAlign[ 2 ] := DT_CENTER // D,L - DT_CENTER // N - DT_RIGHT aName := Array( Len( aDatos[ 1 ] ) ) AEval( aName, {| x, n| aName[ n ] := "MyName_" + hb_ntos( n ) } ) RETURN { aDatos, aHead, aSize, aFoot, aPict, aAlign, aName } function tsb_events( oBrw, nMsg, nWParam, nLParam ) Local nRet := 0, anW:={}, nKey, nFlag, nCol, nFrez := 0, nObrW := 0, nFW := 0, nC := 0, nW:=0, i, j Local lCtrl := _GetKeyState( VK_CONTROL ) Local lShift := _GetKeyState( VK_SHIFT ) Local lAlt := _GetKeyState( VK_MENU ) Static n_CntLeft := 0, n_CntRight := 0, n_LeftRight := 3 nCol := oBrw:nCell nRow := oBrw:nAt nFrez := oBrw:nFreeze + 1 nKey := nWParam nFlag := nLParam If lCtrl .or. lShift .or. lAlt ElseIf nMsg == WM_KEYDOWN If nKey == VK_LEFT .and. nCol > nFrez n_CntLeft ++ If n_CntLeft >= n_LeftRight nRet := 1 // InkeyGui(100) n_CntLeft := 0 EndIf // DoEvents() ElseIf nKey == VK_RIGHT .and. nCol <= oBrw:nColCount() n_CntRight ++ If n_CntRight >= n_LeftRight nRet := 1 // InkeyGui(100) n_CntRight := 0 EndIf // DoEvents() EndIf Elseif nMsg == WM_HSCROLL If ! oBrw:lDontchange nObrW := GetProperty(if(Empty(oBrw:cParentWnd),ThisWindow.Name,oBrw:cParentWnd),oBrw:cControlName,"Width") aEval( oBrw:aColumns,{|x| aadd(anW,x:nWidth) } ) if oBrw:nFreeze > 0; aEval(anW,{|y| nFW += y}, 1, oBrw:nFreeze); Endif if Loword( nKey ) = 5 nW := nFW; i:=.f. for j=oBrw:nColCount to oBrw:nColPos step -1 nW += anW[j] if nW <= nObrW .and. j <= nFW i:=.t.; exit endif if nW > nObrW exit endif next if i oBrw:GoPos( nRow, oBrw:nColCount ) oBrw:GoPos( nRow, HiWord( nKey )) return 1 endif return 0 endif do case case nKey == SB_LINELEFT case nKey == SB_LINERIGHT i:=0; aEval(anW,{|y| if(nW+y<nObrW,{i++,nW += y, nC:=i},nil) }, oBrw:nColPos, oBrw:nColCount ) if nC = nCol .and. nCol+1 <= oBrw:nColCount oBrw:GoPos( nRow, oBrw:nColCount) oBrw:GoPos( nRow, nCol+1) return 1 Endif case nKey == SB_THUMBPOSITION ;Return 1 case nKey == SB_THUMBTRACK ;Return 1 case nKey == SB_PAGELEFT ;Return 1 case nKey == SB_PAGERIGHT ;Return 1 endcase n_CntRight ++ If n_CntRight >= n_LeftRight nRet := 1 // InkeyGui(100) n_CntRight := 0 EndIf EndIf ElseIf nMsg == WM_KEYUP n_CntLeft := n_CntRight := 0 EndIf return nRet
SergKis: kkg пишет заработало только так hmg 19.09.2 сборка вашего примера скролл работает аналогично моего варианта, после двойных кликов по крайним кнопкам скролла (сообщения автоматом), при достижении крайних значений колонок, надо кликами на тсб активировать тсб работу. Разваливается - :nFreeze установленный (влево уходит на 1ю колонку) :nFreeze := 4 - Shift+End и Shift+Home (переход в конец\начало строки) - врет с нумерацией SpecHeader, меняя нумерацию у :nFreeze колонок и соответсвенно у остальных
SergKis: PS Надо отметить, что и в моем примере SpecHeader врет одинаково и Shift+Home уст. на 1ю колонку, но по -> правильно перепрыгивает на колонку с учетом :nFreeze. Это, наверно, общая неточность в тсб.
kkg: Ещё, после отпускания кнопки на скролбаре не сбрасывается сброс счётчика. Допиливать нужно, но пока хоть не сваливается. Уже приемлемо.
SergKis: kkg пишет Допиливать нужно, но пока хоть не сваливается Что то допиливать надо, но у меня сборка hmg 19.10.2 на bcc 5.8 работает? не виснет по скроллу и клавишам. Вот пример этой сборки https://TransFiles.ru/8n29c Гонял туда-сюда работает и не виснет, так же как сборка bcc 5.5 hmg 19.09.2
SergKis: Повторю ссылку https://TransFiles.ru/bwhwh
kkg: SergKis пишет: Что то допиливать надо, но у меня сборка hmg 19.10.2 на bcc 5.8 работает? не виснет по скроллу и клавишам. с oBrw:lLockFreeze := .F. на сборке 19.10.2 виснет + бегунок не дотягивает до последнего столбца
SergKis: kkg пишет с oBrw:lLockFreeze := .F. на сборке 19.10.2 виснет При :nFreeze := 4 задан, надо :lLockFreeze := .T., избегать прорисовки замороженных колонок По примеру с :lLockFreeze := .F. видно, что при работе левой кнопки скроллбар курсор добегает до 1ой колнки, а должен остановиться на 4ой, что и происходит при :lLockFreeze := .T.. Уже видно рассогласование в прорисовке.
kkg: SergKis пишет: При :nFreeze := 4 задан, надо :lLockFreeze := .F., избегать прорисовки замороженных колонок На тяжёлых многоуровневых формах (много колонок) nFreeze нужен для замораживания ключевой информации, а lLockFreeze := .F. нужен чтобы передать на следующий уровень строку с данными и номер (имя) кликнутой колонки, но зачастую необходимая колонка находится в замороженной зоне поэтому и нужно чтобы курсор в неё заходил. Для наглядности можно переставить местами oBrw:lLockFreeze:=.f. oBrw:nFreeze:=4 Ещё бывает необходимость редактировать данные в замороженной области
SergKis: kkg пишет На тяжёлых многоуровневых формах (много колонок) nFreeze нужен для замораживания ключевой информации, а lLockFreeze := .F. нужен чтобы передать на следующий уровень строку с данными и номер (имя) кликнутой колонки, но зачастую необходимая колонка находится в замороженной зоне поэтому и нужно чтобы курсор в неё заходил. OK! Попробуйте добавить в h_tbrowse.prg [pre2] METHOD DrawLine( xRow ) CLASS TSBrowse ... Next DoEvents() EndIf Return Self ... METHOD DrawSelect( xRow, lDrawCell ) CLASS TSBrowse ... If lDraw AAdd( ::aDrawCols, nJ ) EndIf Next DoEvents() EndIf If ::bOnDraw != Nil ... [/pre2] и пересобрать либу MakeLib.bat Пример с :lLockFreeze := .F. мой вариант, вроде не виснет, покрутил туда-сюда какое то время.
SergKis: SergKis пишет вроде не виснет, покрутил туда-сюда какое то время Стало обвисать перемещение клавишами, к сожалению, а скроллбар нет.
SergKis: kkg Попробуйте вариант, вроде работаеат, не обвисает у меня [pre2] #include "minigui.ch" #include "TSBrowse.ch" PROCEDURE MAIN LOCAL oBrw, aDatos, aArray, aHead, aSize, aFoot, aPict, aAlign, aName, aFontHF LOCAL aFont := {} // Local hFontHead, hFontFoot LOCAL cFontName := _HMG_DefaultFontName LOCAL nFontSize := 11 SET DECIMALS TO 4 SET DATE TO GERMAN SET EPOCH TO 2000 SET CENTURY ON SET EXACT ON DEFINE FONT Font_1 FONTNAME cFontName SIZE nFontSize DEFINE FONT Font_2 FONTNAME cFontName SIZE nFontSize BOLD AAdd( aFont, GetFontHandle( "Font_1" ) ) AAdd( aFont, GetFontHandle( "Font_2" ) ) DEFINE WINDOW test ; TITLE "SetArray For Report Demo" ; MAIN ; NOMAXIMIZE NOSIZE DEFINE STATUSBAR FONT cFontName SIZE nFontSize STATUSITEM "0" // WIDTH 0 FONTCOLOR BLACK STATUSITEM "Item 1" WIDTH 230 // FONTCOLOR BLACK STATUSITEM "Item 2" WIDTH 230 // FONTCOLOR BLACK STATUSITEM "Item 3" WIDTH 230 // FONTCOLOR BLACK END STATUSBAR DEFINE TBROWSE oBrw ; AT 1 + iif( IsVistaOrLater(), GetBorderWidth()/2, 0 ), ; 1 + iif( IsVistaOrLater(), GetBorderHeight()/2, 0 ) ; WIDTH test.WIDTH - 2 * GetBorderWidth() ; HEIGHT test.HEIGHT - GetTitleHeight() - ; GetProperty( "test", "StatusBar", "Height" ) - ; 2 * GetBorderHeight() ; ENUMERATOR ; FONT cFontName SIZE nFontSize ; GRID EDIT aDatos := CreateDatos() aArray := aDatos[ 1 ] aHead := aDatos[ 2 ] aSize := aDatos[ 3 ] aFoot := aDatos[ 4 ] aPict := aDatos[ 5 ] aAlign := aDatos[ 6 ] aName := aDatos[ 7 ] // hFontHead := aFont[1] // normal Header // hFontFoot := aFont[2] // bold Footer // aFontHF := { hFontHead, hFontFoot } // aFontHF := aFont[1] // normal Header, Footer aFontHF := aFont[2] // bold Header, Footer oBrw := SetArrayTo( "oBrw", "test", aArray, aFontHF, aHead, aSize, aFoot, aPict, aAlign, aName ) oBrw:nWheelLines := 1 oBrw:nClrLine := COLOR_GRID oBrw:nHeightCell += 5 oBrw:nHeightHead += 5 IF ! Empty( aFoot ) oBrw:nHeightFoot += 5 ENDIF IF oBrw:lEnum oBrw:nHeightSpecHd := oBrw:nHeightCell ENDIF oBrw:nFreeze := 4 oBrw:lLockFreeze := .F. oBrw:bEvents := {|ob,nm,np,nl| tsb_events(ob,nm,np,nl) } oBrw:nCell := oBrw:nFreeze + 1 oBrw:lAdjColumn := .T. END TBROWSE oBrw:SetNoHoles() oBrw:SetFocus() END WINDOW DoMethod( "test", "Activate" ) RETURN * ====================================================================== STATIC FUNCTION CreateDatos() LOCAL a, b, i, j, k := 1000, n LOCAL aDatos, aHead, aSize, aFoot, aPict, aAlign, aName aDatos := Array( k ) FOR i := 1 TO k a := { " ", ; // 1 i, ; // 2 ntoc( i ) + "_123", ; // 3 Date() + i, ; // 4 PadR( "Test line - " + ntoc( i ), 20 ), ; // 5 Round( ( 10000 -i ) * i / 3, 2 ), ; // 6 100.00 * i, ; // 7 0.12, ; // 8 Round( 100.00 * i * 0.12, 2 ), ; // 9 Round( 1234567.00 / i, 3 ), ; // 10 PadR( "Line " + StrZero( i, 5 ), 20 ), ; // 11 Date(), ; // 12 Time(), ; // 13 i % 2 == 0 } // 14 n := Len(a) FOR b := 1 TO 21 FOR j := 1 TO n ; AAdd(a, a[ j ]) NEXT NEXT aDatos[ i ] := a NEXT aHead := AClone( aDatos[ 1 ] ) // AEval(aHead, {|x,n| aHead[ n ] := "Head_" + hb_ntos(n) }) AEval( aHead, {| x, n| aHead[ n ] := "H_" + hb_ntos( n ) + ; iif( n % 2 == 0, CRLF + "S_" + hb_ntos( n ), "" ) } ) aFoot := Array( Len( aDatos[ 1 ] ) ) AEval( aFoot, {| x, n| aFoot[ n ] := n } ) // aFoot := .T. // яюфэюцшх хёЄ№ ё яєёЄ√ьш чэрўхэш ьш aPict := Array( Len( aDatos[ 1 ] ) ) // ьюцэю эх чрфртрЄ№, ЇюЁьшЁє■Єё aPict[ 10 ] := "99999999999.999" // ртЄюьрЄюь фы C,N яю ьрї чэрўхэш■ aSize := Array( Len( aDatos[ 1 ] ) ) // ьюцэю эх чрфртрЄ№, ЇюЁьшЁє■Єё aSize[ 10 ] := aPict[ 10 ] // ртЄюьрЄюь яю ьрї чэрўхэш■ т ъюыюэъх aAlign := Array( Len( aDatos[ 1 ] ) ) // Єшя яюы C - DT_LEFT aAlign[ 2 ] := DT_CENTER // D,L - DT_CENTER // N - DT_RIGHT aName := Array( Len( aDatos[ 1 ] ) ) AEval( aName, {| x, n| aName[ n ] := "MyName_" + hb_ntos( n ) } ) RETURN { aDatos, aHead, aSize, aFoot, aPict, aAlign, aName } FUNCTION Tsb_Events( oBrw, nMsg, nWParam, nLParam ) Local nRet := 0, nKey, nFlag, nCol, nFrez Local lCtrl := _GetKeyState( VK_CONTROL ) Local lShift := _GetKeyState( VK_SHIFT ) Local lAlt := _GetKeyState( VK_MENU ) Static n_CntKeysLR := 0, n_MaxKeysLR := 3 Static n_CntScroll := 0, n_MaxScroll := 3 nCol := oBrw:nCell nFrez := oBrw:nFreeze + 1 nKey := Loword( nWParam ) nFlag := HiWord( nWParam ) If lCtrl .or. lShift .or. lAlt ElseIf nMsg == WM_KEYDOWN If nKey == VK_LEFT .and. nCol > nFrez n_CntKeysLR ++ If n_CntKeysLR >= n_MaxKeysLR nRet := 1 n_CntKeysLR := 0 EndIf DoEvents() ElseIf nKey == VK_RIGHT .and. nCol < oBrw:nColCount() n_CntKeysLR ++ If n_CntKeysLR >= n_MaxKeysLR nRet := 1 n_CntKeysLR := 0 EndIf DoEvents() EndIf ElseIf nMsg == WM_KEYUP n_CntKeysLR := 0 Elseif nMsg == WM_HSCROLL If ! oBrw:lDontchange .and. oBrw:lEnabled IF nKey == SB_LINEUP ; n_CntScroll ++ ELSEIF nKey == SB_LINEDOWN ; n_CntScroll ++ ELSE ; n_CntScroll := 0 ENDIF IF n_CntScroll >= n_MaxScroll nRet := 1 n_CntScroll := 0 ENDIF EndIf EndIf RETURN nRet [/pre2]
kkg: SergKis пишет: Попробуйте вариант, вроде работаеат я уже два дня на юзерах проверяю, вот такой вариант [pre2] #include "minigui.ch" #include "TSBrowse.ch" Static nbCtrlKeys,nbCtrlCount:=0, nbUserKeys PROCEDURE MAIN LOCAL oBrw, aDatos, aArray, aHead, aSize, aFoot, aPict, aAlign, aName, aFontHF LOCAL aFont := {} // Local hFontHead, hFontFoot LOCAL cFontName := _HMG_DefaultFontName LOCAL nFontSize := 11 SET DECIMALS TO 4 SET DATE TO GERMAN SET EPOCH TO 2000 SET CENTURY ON SET EXACT ON DEFINE FONT Font_1 FONTNAME cFontName SIZE nFontSize DEFINE FONT Font_2 FONTNAME cFontName SIZE nFontSize BOLD AAdd( aFont, GetFontHandle( "Font_1" ) ) AAdd( aFont, GetFontHandle( "Font_2" ) ) DEFINE WINDOW test ; TITLE "SetArray For Report Demo" ; MAIN ; NOMAXIMIZE NOSIZE DEFINE STATUSBAR FONT cFontName SIZE nFontSize STATUSITEM "0" // WIDTH 0 FONTCOLOR BLACK STATUSITEM "Item 1" WIDTH 230 // FONTCOLOR BLACK STATUSITEM "Item 2" WIDTH 230 // FONTCOLOR BLACK STATUSITEM "Item 3" WIDTH 230 // FONTCOLOR BLACK END STATUSBAR DEFINE TBROWSE oBrw ; AT 1 + iif( IsVistaOrLater(), GetBorderWidth()/2, 0 ), ; 1 + iif( IsVistaOrLater(), GetBorderHeight()/2, 0 ) ; WIDTH test.WIDTH - 2 * GetBorderWidth() ; HEIGHT test.HEIGHT - GetTitleHeight() - ; GetProperty( "test", "StatusBar", "Height" ) - ; 2 * GetBorderHeight() ; ENUMERATOR ; FONT cFontName SIZE nFontSize ; GRID EDIT aDatos := CreateDatos() aArray := aDatos[ 1 ] aHead := aDatos[ 2 ] aSize := aDatos[ 3 ] aFoot := aDatos[ 4 ] aPict := aDatos[ 5 ] aAlign := aDatos[ 6 ] aName := aDatos[ 7 ] // hFontHead := aFont[1] // normal Header // hFontFoot := aFont[2] // bold Footer // aFontHF := { hFontHead, hFontFoot } // aFontHF := aFont[1] // normal Header, Footer aFontHF := aFont[2] // bold Header, Footer oBrw := SetArrayTo( "oBrw", "test", aArray, aFontHF, aHead, aSize, aFoot, aPict, aAlign, aName ) oBrw:nWheelLines := 1 oBrw:nClrLine := COLOR_GRID oBrw:nHeightCell += 5 oBrw:nHeightHead += 5 IF ! Empty( aFoot ) oBrw:nHeightFoot += 5 ENDIF IF oBrw:lEnum oBrw:nHeightSpecHd := oBrw:nHeightCell ENDIF oBrw:lLockFreeze := .F. oBrw:nFreeze := 4 oBrw:bUserKeys := {|nKy,nFl,oBr| my_bUserKeys(oBr,@nKy,@nFl ) } oBrw:bEvents := {|ob,nm,np,nl| tsb_events(ob,@nm,@np,@nl) } oBrw:nCell := 1 END TBROWSE oBrw:SetNoHoles() oBrw:SetFocus() END WINDOW DoMethod( "test", "Activate" ) RETURN * ====================================================================== STATIC FUNCTION CreateDatos() LOCAL a, b, i, j, k := 6000, n LOCAL aDatos, aHead, aSize, aFoot, aPict, aAlign, aName aDatos := Array( k ) FOR i := 1 TO k a := { " ", ; // 1 i, ; // 2 ntoc( i ) + "_123", ; // 3 Date() + i, ; // 4 PadR( "Test line - " + ntoc( i ), 20 ), ; // 5 Round( ( 10000 -i ) * i / 3, 2 ), ; // 6 100.00 * i, ; // 7 0.12, ; // 8 Round( 100.00 * i * 0.12, 2 ), ; // 9 Round( 1234567.00 / i, 3 ), ; // 10 PadR( "Line " + StrZero( i, 5 ), 20 ), ; // 11 Date(), ; // 12 Time(), ; // 13 i % 2 == 0 } // 14 n := Len(a) FOR b := 1 TO 10 FOR j := 1 TO n ; AAdd(a, a[ j ]) NEXT NEXT aDatos[ i ] := a NEXT aHead := AClone( aDatos[ 1 ] ) // AEval(aHead, {|x,n| aHead[ n ] := "Head_" + hb_ntos(n) }) AEval( aHead, {| x, n| aHead[ n ] := "H_" + hb_ntos( n ) + ; iif( n % 2 == 0, CRLF + "S_" + hb_ntos( n ), "" ) } ) aFoot := Array( Len( aDatos[ 1 ] ) ) AEval( aFoot, {| x, n| aFoot[ n ] := n } ) // aFoot := .T. // подножие есть с пустыми значениями aPict := Array( Len( aDatos[ 1 ] ) ) // можно не задавать, формируются aPict[ 10 ] := "99999999999.999" // автоматом для C,N по мах значению aSize := Array( Len( aDatos[ 1 ] ) ) // можно не задавать, формируются aSize[ 10 ] := aPict[ 10 ] // автоматом по мах значению в колонке aAlign := Array( Len( aDatos[ 1 ] ) ) // тип поля C - DT_LEFT aAlign[ 2 ] := DT_CENTER // D,L - DT_CENTER // N - DT_RIGHT aName := Array( Len( aDatos[ 1 ] ) ) AEval( aName, {| x, n| aName[ n ] := "MyName_" + hb_ntos( n ) } ) RETURN { aDatos, aHead, aSize, aFoot, aPict, aAlign, aName } function tsb_events( oBrw, nMsg, nWParam, nLParam ) Local lCtrl := _GetKeyState( VK_CONTROL ) Local lShift := _GetKeyState( VK_SHIFT ) Local lAlt := _GetKeyState( VK_MENU ) Local i If lCtrl .or. lShift .or. lAlt; Return 0; EndIf do case case nMsg == WM_KEYDOWN do case case nWParam == VK_RIGHT; Return tsb_events_Right( oBrw ) case nWParam == VK_LEFT ; Return tsb_events_Left ( oBrw ) endcase case nMsg == WM_KEYUP Do while InkeyGui(1)!=0 Enddo case nMsg == WM_HSCROLL .and. lCtrl; nMsg := nil; Return 1 case nMsg == WM_HSCROLL .and. !lCtrl If ! oBrw:lDontchange if Loword( nWParam ) = 5; i := HiWord( nWParam ) if oBrw:nCell=i ; nMsg := nil; Return 1; EndIf if i <= oBrw:nFreeze; oBrw:GoPos( oBrw:nAt, oBrw:nFreeze + 1 ); oBrw:GoPos( oBrw:nAt, i ) ; nMsg := nil; Return 1; EndIf oBrw:GoPos( oBrw:nAt, i ) nMsg := nil Return 1 Endif do case case nWParam == SB_LINELEFT ;Return tsb_events_Left ( oBrw ) case nWParam == SB_LINERIGHT ;Return tsb_events_Right( oBrw ) case nWParam == SB_PAGELEFT ;nMsg := nil; Return 1 case nWParam == SB_PAGERIGHT ;nMsg := nil; Return 1 endcase EndIf case nMsg == WM_VSCROLL If ! oBrw:lDontchange do case case nWParam == SB_PAGELEFT ;nMsg := nil; Return 1 case nWParam == SB_PAGERIGHT ;nMsg := nil; Return 1 endcase EndIf endcase return 0 function tsb_events_Left ( oBrw ) Local anW:={}, nObrW := 0, nFW := 0, nC := 0, nW:=0, j:=0, nG:=0 Local nCol := oBrw:nCell, nRow := oBrw:nAt IF nCol=1; nMsg := nil; Return 1; EndIf nObrW := GetProperty(if(Empty(oBrw:cParentWnd),ThisWindow.Name,oBrw:cParentWnd),oBrw:cControlName,"Width") aEval( oBrw:aColumns,{|x| aadd(anW,x:nWidth) } ) if oBrw:nFreeze > 0; aEval(anW,{|y| nFW += y}, 1, oBrw:nFreeze); Endif if nCol <= oBrw:nFreeze+1; Return 0; Endif if oBrw:nColPos = nCol nW := nFW for j=nCol to 1 step -1 nW += anW[j] if nW > nObrW; exit; endif next if j-1 < nCol oBrw:GoPos( nRow, 1) if j-1>oBrw:nFreeze; oBrw:GoPos( nRow, j-1); Endif oBrw:GoPos( nRow, max(nCol-1,1)) nMsg := nil; Return 1 Endif EndIf return 0 function tsb_events_Right( oBrw, nColFors, lRes ) Local anW:={}, nObrW := 0, nFW := 0, nC := 0, nW:=0, j:=0 Local nCol := oBrw:nCell, nRow := oBrw:nAt Local nNewCol := if( Empty(nColFors), nCol+1, nColFors) IF nCol=oBrw:nColCount.and.Empty(nColFors); nMsg := nil; Return 1; EndIf if Empty(nbUserKeys); nbUserKeys:=seconds(); Endif if Seconds() < nbUserKeys Do while (i:=InkeyGui(1))=VK_RIGHT.or.i!=0 Enddo nMsg := nil; Return 1 endif nObrW := GetProperty(if(Empty(oBrw:cParentWnd),ThisWindow.Name,oBrw:cParentWnd),oBrw:cControlName,"Width") aEval( oBrw:aColumns,{|x| aadd(anW,x:nWidth) } ) if oBrw:nFreeze > 0; aEval(anW,{|y| nFW += y}, 1, oBrw:nFreeze); Endif nW := nFW for j=oBrw:nColCount to oBrw:nColPos step -1 nW += anW[j] if nW > nObrW; exit; endif next if nCol > j oBrw:GoRight(.f.) return 1 endif if nCol >= j - 1 oBrw:GoPos( nRow, oBrw:nColCount ) oBrw:GoPos( nRow, nNewCol) nbUserKeys := Seconds()+0.15 Return 1 endif nW := nFW for j=oBrw:nColPos to oBrw:nColCount nW += anW[j] if nW > nObrW; exit; endif next if ! nCol < j-1 .and. Empty(nColFors) oBrw:GoPos( nRow, oBrw:nColCount ) oBrw:GoPos( nRow, j-1) oBrw:GoPos( nRow, nNewCol) nbUserKeys := Seconds()+0.15 Return 1 Endif If Empty(nColFors) oBrw:GoRight(.f.) return 1 EndIF return 0 func my_bUserKeys(oBrw, nKey, nFlags) Local lRet := .t., anW:={}, nColPosEnd:=0, nW:=0, nFreezeWidth:=0, nCW:=0,i,j//,c,w Local lCtrl := _GetKeyState( VK_CONTROL ) Local lShift := _GetKeyState( VK_SHIFT ) Local lAlt := _GetKeyState( VK_MENU ) if valtype(nKey) != 'N' return lRet endif if nKey = 36 // home oBrw:GoPos( oBrw:nAT, 1) lRet := .F.; nKey := nil; nFlags := nil return lRet endif if nKey = 35 //end oBrw:GoPos( oBrw:nAT, len(oBrw:aColumns), 1) lRet := .F.; nKey := nil; nFlags := nil return lRet endif if ! (nKey >= 37 .and. nKey <= 40 ) Return .t. Endif if Empty(nbUserKeys); nbUserKeys:=seconds(); Endif // сдвиг не нужен if ; ( nKey = 39 .and. oBrw:nColCount = oBrw:nCell ) .or.; ( nKey = 37 .and. oBrw:nCell = 1 ) .or.; ( nKey = 38 .and. oBrw:nAt = 1 ) .or.; ( nKey = 40 .and. oBrw:nAt = oBrw:nLen ) Do while InkeyGui(1)!=0 Enddo lRet := .F.; nKey := nil; nFlags := nil return lRet endif if lCtrl .and. (nKey >= 37 .and. nKey <= 40) if nKey = 38 .or. nKey = 40 i := Loword( nFlags ) if i != 1; nKey = nil; nFlags := nil; Return .F.; endif Endif nW := GetProperty(oBrw:cParentWnd,oBrw:cControlName,"Width") //- oBrw:oHScroll:nWidth aEval( oBrw:aColumns,{|x| aadd(anW,x:nWidth) } ) if oBrw:nFreeze > 0 aEval(anW,{|y| nFreezeWidth += y}, 1, oBrw:nFreeze) Endif nCW := nFreezeWidth; i := oBrw:nColPos; nColPosEnd:=oBrw:nCell aEval(anW,{|y| if(nCW+y<nW,{nCW += y, nColPosEnd:=i, i++},nil) }, i, oBrw:nColCount ) if nKey = 39 // право IF oBrw:nCell <= oBrw:nFreeze oBrw:GoPos( oBrw:nAT, oBrw:nFreeze + 1) Return .F. Endif if oBrw:nCell = oBrw:nColPos .or. nColPosEnd = oBrw:nCell oBrw:GoPos( oBrw:nAT, oBrw:nColCount) oBrw:GoPos( oBrw:nAT, nColPosEnd) Return .F. Endif if oBrw:nCell < nColPosEnd oBrw:GoPos( oBrw:nAT, nColPosEnd) Return .F. Endif endif if nKey = 37 // лево if oBrw:nCell > oBrw:nColPos oBrw:GoPos( oBrw:nAT, oBrw:nColPos) Return .F. Endif if oBrw:nCell <= oBrw:nFreeze oBrw:GoPos( oBrw:nAT, 1) Return .F. // lRet Endif if oBrw:nCell = oBrw:nColPos .and. oBrw:nColPos > oBrw:nFreeze nCW := nFreezeWidth i:=.f. for j=oBrw:nColPos to oBrw:nFreeze step -1 nCW += anW[j] if nCW >= nW .and. j > oBrw:nFreeze i:=.t.; exit endif if nCW > nW exit endif next if i j++ i := oBrw:nColPos oBrw:GoPos( oBrw:nAT, 1) oBrw:GoPos( oBrw:nAT, i) oBrw:GoPos( oBrw:nAT, j) Return .F. Endif Endif if oBrw:nCell = oBrw:nFreeze + 1 oBrw:GoPos( oBrw:nAT, if(oBrw:lLockFreeze,oBrw:nFreeze + 1,1)) Return .F. endif if oBrw:nColPos = oBrw:nCell oBrw:GoPos( oBrw:nAT, oBrw:nFreeze + 1) Return .F. endif oBrw:GoPos( oBrw:nAT, oBrw:nColPos) Return .F. endif if nKey = 38 // вниз if (i:=oBrw:nAT - oBrw:nRowPos + 1) != oBrw:nAT // i := if(i<1,1,i) oBrw:GoPos( i, oBrw:nCell) Return .F. Else // i := oBrw:nAT - oBrw:nRowCount + 1 i := if(i<1,1,i) oBrw:GoPos( i, oBrw:nCell) Return .F. endif endif if nKey = 40 // вниз i := oBrw:nAT - oBrw:nRowPos + 1 i := if(i<1,1,i) + oBrw:nRowCount - 1 i := min(i,oBrw:nLen) if i != oBrw:nAT oBrw:GoPos( i, oBrw:nCell) lRet := .F.; nKey := nil; nFlags := nil Return .F. Else i := if(i<1,1,i) + oBrw:nRowCount - 1 i := if(i>oBrw:nLen,oBrw:nLen,i) oBrw:GoPos( i, oBrw:nCell) lRet := .F.; nKey := nil; nFlags := nil Return .F. endif endif nbUserKeys:=seconds()+0.15 endif return lRet [/pre2] но чтоб избежать лишнего Refresh пришлось поправить, h_tbrowse.prg METHOD GoRight( lRefresh ) CLASS TSBrowse Local nTxtWid, nWidth, nCell, nSkip //, default lRefresh := ( ::lCanAppend .or. ::lIsArr ) . . . if !Empty(lRefresh) // lRefresh := ( ::lCanAppend .or. ::lIsArr ) While ! ::IsColVisible( ::nCell ) .and. ::nColPos < ::nCell ::nColPos ++ lRefresh := .T. EndDo endif пока полёт нормальный, не учёл только не отображаемые колонки, но я их не использую
kkg: SergKis пишет: Попробуйте вариант, вроде работаеат спасибо, у меня не подвисает
SergKis: kkg Используйте в редакторе для сохранения отступов моноширинный шрифт - левая, первая кнопка с 123. т.е. [ more ][ pre2 ] тут текст [ /pre2 ][ /more ] очень трудно смотреть выложенный текст без выравнивания
kkg: SergKis пишет: Используйте в редакторе для сохранения отступов моноширинный шрифт ок
Andrey: SergKis пишет: Попробуйте вариант, вроде работаеат, не обвисает у меня Тоже столкнулся с таким же повисанием. У меня таблица из 46 столбцов, вешает прогу наглухо. Я так понял что достаточно добавить oBrw:bEvents := {|ob,nm,np,nl| tsb_events(ob,nm,np,nl) } и саму функцию обработки ? У меня нет клавиш :bUserKeys PS Попробовал, не собирается, выдаёт ошибку: Harbour 3.2.0dev (r1909261630) Copyright (c) 1999-2019, https://harbour.github.io/ tsb_prnExp.prg(462) Warning W0003 Variable 'NLPARAM' declared but not used in function 'TSB_EVENTS(399)' hbmk2[5Tbrw_table]: Error: Running Harbour compiler (built-in). 1
SergKis: Andrey Попробовал, не собирается, выдаёт ошибку: Посмотреть и исправить (или сменить режим компилятора на не строгий), наверно, ни как ? [pre2] nCol := oBrw:nCell nFrez := oBrw:nFreeze + 1 nKey := Loword( nWParam ) nFlag := HiWord( nWParamnLParam ) If lCtrl .or. lShift .or. lAlt [/pre2]
Andrey: SergKis пишет: Посмотреть и исправить (или сменить режим компилятора на не строгий), наверно, ни как ? Не могу. Контроль нужен. Спасибо ! Заработало !
SergKis: Andrey пишет Заработало ! В своей версии сделал[pre2] CLASS TSBrowse FROM TControl ... DATA lMoreFields AS LOGICAL INIT .F. DATA nCntKeysLR AS NUMERIC INIT 0 DATA nMaxKeysLR AS NUMERIC INIT 3 DATA nCntScroll AS NUMERIC INIT 0 DATA nMaxScroll AS NUMERIC INIT 3 ... METHOD MoreFields( nMsg, nWParam, nLParam ) CLASS TSBrowse Local nRet := 0, nCol, nFrez, nKey, nPos Local lCtrl := _GetKeyState( VK_CONTROL ) Local lShift := _GetKeyState( VK_SHIFT ) Local lAlt := _GetKeyState( VK_MENU ) If lCtrl .or. lShift .or. lAlt ; RETURN nRet EndIf nCol := ::nCell nFrez := ::nFreeze + 1 nKey := Loword( nWParam ) nPos := HiWord( nLParam ) If nMsg == WM_KEYDOWN If nKey == VK_LEFT .and. nCol > nFrez ::nCntKeysLR ++ If ::nCntKeysLR >= ::nMaxKeysLR nRet := 1 ::nCntKeysLR := 0 EndIf DO EVENTS ElseIf nKey == VK_RIGHT .and. nCol < ::nColCount() ::nCntKeysLR ++ If ::nCntKeysLR >= ::nMaxKeysLR nRet := 1 ::nCntKeysLR := 0 EndIf DO EVENTS EndIf ElseIf nMsg == WM_KEYUP ::nCntKeysLR := 0 Elseif nMsg == WM_HSCROLL If ! ::lDontchange .and. ::lEnabled IF nKey == SB_LINEUP ; ::nCntScroll ++ ELSEIF nKey == SB_LINEDOWN ; ::nCntScroll ++ ELSE ; ::nCntScroll := 0 ENDIF IF ::nCntScroll >= ::nMaxScroll nRet := 1 ::nCntScroll := 0 ENDIF EndIf EndIf RETURN nRet ... METHOD HandleEvent( nMsg, nWParam, nLParam ) CLASS TSBrowse ... IF ::lMoreFields IF ! Empty( ::MoreFields( nMsg, nWParam, nLParam ) ) RETURN 1 ENDIF ENDIF If hb_IsBlock( ::bEvents ) If ! Empty( ar := EVal( ::bEvents, Self, nMsg, nWParam, nLParam ) ) Return 1 EndIf EndIf ... тогда в примере oBrw:nFreeze := 4 oBrw:lLockFreeze := .F. oBrw:lMoreFields := .T. // oBrw:bEvents := {|ob,nm,np,nl| tsb_events(ob,nm,np,nl) } oBrw:nCell := oBrw:nFreeze + 1 oBrw:lAdjColumn := .T. ... [/pre2]
gfilatov2002: SergKis пишет: В своей версии сделал CLASS TSBrowse FROM TControl Добавил эти изменения в новую сборку 19.12 Благодарю за помощь
Andrey: SergKis пишет: тогда в примере oBrw:nFreeze := 4 oBrw:lLockFreeze := .F. oBrw:lMoreFields := .T. // oBrw:bEvents := {|ob,nm,np,nl| tsb_events(ob,nm,np,nl) } oBrw:nCell := oBrw:nFreeze + 1 oBrw:lAdjColumn := .T. gfilatov2002 пишет: Добавил эти изменения в новую сборку 19.12 Т.е. в новой сборке это не нужно будет делать ? А если оставить ? Конфликты будут ?
gfilatov2002: Andrey пишет: в новой сборке это не нужно будет делать ? Да Andrey пишет: если оставить ? Конфликты будут ? Нет, проблем не будет (если Вы не определите дополнительно oBrw:lMoreFields := .T., конечно )
SergKis: Andrey пишет если оставить ? Конфликты будут ? Погонял пример с установками, т.е. работают метод и ф-я (hmg 19.09.2) oBrw:lMoreFields := .T. oBrw:bEvents := {|ob,nm,np,nl| tsb_events(ob,nm,np,nl) } все OK не виснет, т.е. конфликта нет, работает
Andrey: Всем привет ! Периодически у моих юзеров появляется такая ошибка: Вот строка Html_LineText( nHandle, "Free disk space....: " + strvalue( Round( DiskSpace() / ( 1024 * 1024 ), 0 ) ) + " MB" ) Но надиске 90 Гб свободного места. У меня свой, чуток исправленный ErrorSys.prg Что эта за ошибка и как от неё избавиться ?
PSP: Andrey пишет: Что эта за ошибка и как от неё избавиться ? BASE/2018 Open error (DISKSPACE() function) Default Behavior: The program continues after returning an empty value. Explanation: The disk does not exist or is not ready upon an attempt to access it with the DISKSPACE() function. Action: Make sure to supply the correct drive number (for fixed disks) or call the DISKSPACE() function in a loop with a user warning when checking the readiness of a floppy drive. See Also: COPY FILE command
Andrey: Да не делаю я переключений между дисками. У юзера диски C D и флешка. Файлы не копирую не куда. Делаю отправку записи на PostgesSQL
SergKis: Andrey пишет У меня свой, чуток исправленный ErrorSys.prg Так правь дальше, что то типа такого nSpace := -1 begin sequnce ... nSpace := DiskSpace() end if nSpace < 0 ? hb_disk(), ... EndIf
Andrey: Всем привет ! Опять такая же ошибка. Только система не Win10, a Win7. Т.е. на разных системах появляется такие одинаковые ошибки. Строка 233 в модуле ErrorSys.prg: [pre2] Html_LineText( nHandle, "Free disk space....: " + strvalue( Round( DiskSpace() / ( 1024 * 1024 ), 0 ) ) + " MB" ) [/pre2] На обоих дисках свободно - C: 34Гб D: 200-Гб Почему вылазит такая ошибка ? Как исправить, чтобы не появлялась в дальнейшем ? Нашёл в недописанном ErrorLog.htm [pre2]Workstation name...: SERVER Active user name...: Администратор Available memory...: 1986 MB Current disk.......: A Current directory..: \Server\ABONENT\ABONENT2\COMMO[/pre2] Я так понял - сбой непонятный. На диск А: не переключался ! И сетевой путь должен быть \\Server\ABONENT\ABONENT2\COMMO
PSP: Видимо, DiskSpace() не умеет работать с сетевыми дисками/шарами. Ты ему подсовываешь "\\Server\ABONENT\ABONENT2\COMMO", а он берет первый символ этой строки и интерпретирует его как "А".
SergKis: Вместо DiskSpace, надо применять nFreeSpace := hb_vfDirSpace( cDirName, [ nInfoType ] ) (см. у А. Кресина на сайте)
Andrey: Попробовал сетевой диск на своём компе - вроде работает... [pre2] ? M->SetPathSrv ?? DiskSpace(M->SetPathSrv) \\Andrey8\work_uchet\VxIsxDoc 155406909440 [/pre2] Может проблема с сетью у заказчика ? Хотя базы работают без проблем. А при ошибке - фигня...
Haz: Andrey пишет: Может проблема с сетью у заказчика Есть мнение что unc пути работают корректно только под админом. У себя во всяком на этом не раз обжегся
rvu: Удивительная ошибка обнаружилась. Пишу: @ 10,10 LABEL LABEL_NAME VALUE NameBase Когда переменной присваивается значение из одной базы, показывается нормально, а из другой не показывается. Переменная есть, всё с ней в порядке. Поставил спереди пробел и заработало: @ 10,10 LABEL LABEL_NAME VALUE ' '+NameBase Кто-нибудь с таким сталкивался? Что это может быть? У меня стоит версия 19.06, на новые версии с другими компиляторами пока не перебрался.
SergKis: rvu пишетКто-нибудь с таким сталкивался? Что это может быть? Возможно причина в том, что не задано WIDTH у LABEL и ширина считается при каждом присвоении от значения и возникло внутреннее "недопонимание" при выводе на экран.
rvu: SergKis пишет: что не задано WIDTH С заданой тоже не работает. Вернее так же — то работает, то нет. А при добавлении явного символа всегда работает.
SergKis: Попробуйте так[pre2] Если в лабел данные из полей дбф, то используйте имя поля для лабел, если для поля исп. еще getbox, то для него исп. имя поля, для лабел добавляйте '_'. получается просто в использовании. Т.е. кода создаете форму, данных из базы не используете, потом выполняете процедуру заполнения данными Пример y := x := 10 FOR EACH aFld IN (cAls)->( dbStruct() ) cFld := aFld[1] @ y,x LABEL &( cFld+'_' ) VALUE ' ' WIDTH nW HEIGHT nH This.&(cFld+'_').Value := Trim(cValToChar( (cAls)->&cFld ))+' ' y += 10 NEXT ... Ваш вариант ... cN := 'NAME' @ y,x LABEL LABEL_NAME VALUE ' ' WIDTH nW HEIGHT nH ... FUNC Refr_Lbl( oBrw ) LOCAL cAls := oBrw:cAlias This.LABEL_NAME.Value := Trim(cValToChar( (cAls)->NAME ))+' ' ... RETU Nil [/pre2]
rvu: SergKis пишет: Trim(cValToChar( (cAls)->NAME ))+' ' А для чего в конце добавляется пробел?
SergKis: rvu пишет А для чего в конце добавляется пробел? Если поле пустое, то получается 0-я длина, будет ли вывод при этом ? Сегодня - да, а завтра ? Добавляю, скорее, по привычке
rvu: SergKis пишет: Если поле пустое, то получается 0-я длина, будет ли вывод при этом ? Сегодня - да, а завтра ? Добавляю, скорее, по привычке Так если пробел все равно добавлять, то с ним и так работает. Вот заменил вообще на поле БД: @ 10,10 LABEL LABEL_NAME VALUE ' '+ALLTRIM(BASECONFIG->NAME) WIDTH 1500 Только работает с пробелом в начале, с пробелом в конце не работает.
SergKis: rvu пишет Так если пробел все равно добавлять, то с ним и так работает. Вот заменил вообще на поле БД: Я предлагал разделить создание контролов и заполнение их данными в разные процедуры, т.е.[pre2] DEFINE WINDOW Form1 ... Label_Crt() END WINDOW ACTION WINDOW Form1 ON INIT {|| Label_Val() } // или в ON INIT окна или ставим в :Event(1, {|| Label_Val() }), активируя сообщением ... STAT FUNC Label_Crt() ... @ 10,10 LABEL NAME VALUE ' ' WIDTH 1500 VCENTERALIGN ... RETU Nil STAT FUNC Label_Val() LOCAL cAls := 'BASECONFIG' ... This.NAME.Value := Trim( (cAls)->NAME )+' ' * Form1.NAME.Value := Trim( (cAls)->NAME )+' ' // или такую форму записи ... RETU Nil [/pre2] Вызывая Label_Val() повторно (изменив поле NAME) производите переотображение Label NAME Добавление пробела слева смещает текст отображения вправо на ширину пробела в пикселях, т.е. сменили координату X у лабел
rvu: SergKis пишет: Добавление пробела слева смещает текст отображения вправо на ширину пробела в пикселях, т.е. сменили координату X у лабел Это понятно. SergKis пишет: Я предлагал разделить создание контролов и заполнение их данными в разные процедуры Может быть это и правильно. Будет побольше времени надо будет попробовать. Спасибо за идею!
Andrey: Запускаю прогу на МиниГуи. На форме есть таймер. [pre2] DEFINE TIMER Timer_1 ; INTERVAL (StaticTimeUpdate * 100) * 1000 ACTION OperatUsers2() .... // Функция чтения всех работающих в журнале программы / заглушка Function OperatUsers2() LOCAL nSel := SELECT() ? "Timer всех работающих в программе !", TIME(), ProcNameLine(0) Form_Main.Label_0.Value := "+" + TIME() SELECT(nSel) RETURN NIL[/pre2] После запуска проги, в Фаре работать нельзя, отрубаются клавиши. Запускаю TeamViewer, пытаюсь набрать пароль в нём, пароль неверен. Закрываю прогу на МиниГуи - всё прекрасно начинает работать. Что то с таймером беда... Или опять я нахимичил ....
Haz: я в тупике , примитивный код [pre2] for n := 1 To 3 hb_IdleSleep(1) // дает на втором шаге Error BASE/1102 Неверный аргумент: UPPER</p> end [/pre2] не соображу причем тут слип трассер ошибки [pre2] <br/></summary> Called from UPPER(0) <BR> Called from (b)TCNLDATA(737) in module: h_objects.prg <BR> Called from TCNLDATA:DEL(0) <BR> Called from (b)TCNLDATA(776) in module: h_objects.prg <BR> Called from TCNLDATA:DESTROY(0) <BR> Called from TWNDDATA:__msgDestructor(678) in module: h_objects.prg <BR> Called from HB_IDLESLEEP(0) [/pre2] условия такие Operating system...: Windows 7 6.1 SP1<BR> MiniGUI version....: Harbour MiniGUI Extended Edition 19.08 (32-bit)<BR> Harbour version....: Harbour 3.2.0dev (r1904111533)<BR> Harbour built on...: Apr 11 2019 19:43:19<BR> C/C++ compiler.....: Borland C++ 5.5.1 (32-bit)<BR> Multi Threading....: YES<BR> VM Optimization....: YES<BR>
SergKis: Haz пишет не соображу причем тут слип Идет, похоже, разрушение\destroy окна во время Sleep, которого уже нет, т.е.[pre2] METHOD Destroy() INLINE ( ::Del(), ; ... и METHOD Del() INLINE ( iif( HB_ISOBJECT( ::oWin:oName ), ::oWin:oName:Del( Upper( ::cName ) ), ), ; iif( HB_ISOBJECT( ::oWin:oHand ), ::oWin:oHand:Del( ::nHandle ), ) ) ... [/pre2] Не знаю, не смотрел, как устроен hb_IdleSleep(...), я использую wApi_Sleep(...)
SergKis: PS Т.е. во время Sleep идет обработка сообщений очереди. Для задержки использую wApi_Sleep(...), для обработки очереди без задержки DoEvents().
Haz: SergKis пишет: я использую wApi_Sleep(...) работает
Andrey: Столкнулся с очередной непоняткой. Как сдвинуть дату немного вправо в объекте DATEPICKER ? На картинке вот так выглядит:
Andrey: Очередная засада в МиниГуи. Имеется GetBox , ввожу в него: [pre2]"1238881818АА" "1238881818БББ" "1238881818ЯЯЯ"[/pre2] В отладке получаю вот это: [pre2]Gbox_1 This.&(cGetBox).Value = 1238881818└└ Gbox_1 This.&(cGetBox).Value = 1238881818┴┴┴ Gbox_1 This.&(cGetBox).Value = 1238881818▀▀▀ [/pre2] Куда делись русские буквы АА и БББ и ЯЯЯ ? Маленькие русские буквы отлично отображаются !!! Вот код проверки: [pre2] FOR nJ := 1 TO LEN(aGetBoxObj) cGetBox := aGetBoxObj[nJ] cVal := This.&(cGetBox).Value ? cGetBox, "This.&(cGetBox).Value = ",cVal ............... [/pre2] А сам объект формируется так:[pre2] aPict := { REPL('x',18) } ...... cObj2 := "Gbox_" + HB_NtoS(nI) @ ... GETBOX &cObj2 VALUE aRcPlt[nI] ... ; PICTURE aPict[nI] .... ; ON CHANGE {|| _wSend(10, This.Index), This.Value := aRcPlt[This.Cargo] } ; ON INIT {|| This.Cargo := nI, This.Value := aRcPlt[nI] } AADD( aGetBoxObj, cObj2 ) // для проверки на русские буквы ........ // назначаем на getbox и checkbox событие (This.Object):Event(10, {|| aRcPlt[ This.Cargo ] := This.Value })[/pre2]
Pasha: Да кодировка у дебаггера не той системы Буква А, код в 1251 - 0xc1, в cp866 как раз отображается такой закорлючкой
Andrey: Pasha пишет: Да кодировка у дебаггера не той системы Буква А, код в 1251 - 0xc1, в cp866 как раз отображается такой закорлючкой У меня в МиниГуи кодировка RU1251 Соответственно GETBOX должнен быть в RU1251 И при доп. выводе в файл получаю, беру ASC(символа) : [pre2] └ 192 ┴ 193 ▀ 223[/pre2] И код не работает по проверке на русские буквы ВЕРХНЕГО РЕГИСТРА: [pre2]STATIC FUNCTION CheckingRussianGet( aGetBoxObj ) // Проверка на русские буквы LOCAL lRet := .T., nI, cC, nJ, cVal LOCAL cGetBox, cTbl := ' 0123456789' , cMsg := "" FOR nI := 128 TO 175 cTbl += CHR(nI) NEXT FOR nI := 224 TO 239 cTbl += CHR(nI) NEXT ? cTbl FOR nJ := 1 TO LEN(aGetBoxObj) cGetBox := aGetBoxObj[nJ] cVal := This.&(cGetBox).Value ? cGetBox, "This.&(cGetBox).Value = ",cVal FOR nI := 1 TO Len(cVal) cC := subs(cVal, nI, 1) ? nI, cC, ASC(cC), " logika[ ! cC $ cTbl ]=", ! cC $ cTbl If ! cC $ cTbl cMsg += 'Неверный символ "'+cC+'" позиция '+hb_ntos(nI) cMsg += ' строка '+hb_ntos(nJ)+";" lRet := .F. EXIT EndIf NEXT NEXT IF ! lRet cMsg += 'БУКВЫ должны быть русскими !;;' cMsg += "Исправьте, иначе поиск будет неправилен !;;" MG_Stop(cMsg, 'Ошибка') This.&(cGetBox).SetFocus DO EVENTS ENDIF RETURN lRet [/pre2]
Pasha: Andrey пишет: FOR nI := 128 TO 175 cTbl += CHR(nI) NEXT FOR nI := 224 TO 239 cTbl += CHR(nI) NEXT Так в cp1251 символы начинаются с кода 192. Такая проверка годится для cp866, а никак не для cp1251
Andrey: Pasha пишет: Так в cp1251 символы начинаются с кода 192. Такая проверка годится для cp866, а никак не для cp1251 А на экране строка выглядит так: [pre2][ 0123456789АБВГДЕЖЗИЙКЛМНОПРСТУФХЦЧШЩЪЫЬЭЮЯабвгдежзийклмнопрстуфхцчшщъыьэюя][/pre2] Pasha пишет: Такая проверка годится для cp866, а никак не для cp1251 Понял. Опять моя ошибка. СПАСИБО !
Pasha: Andrey пишет: А на экране строка выглядит так: Правильно выглядит для кодировки 866 Еще хорошо бы выдать: ? hb_cdpSelect()
Andrey: Pasha пишет: ? hb_cdpSelect() Выдает то что надо ! RU1251 СПАСИБО Паша ! Это я опять поторопился, когда делал. Всё спешка проклятая. Сейчас юзера выдают мне мои ошибки по спешке.
i3t4j6: Для заставки в программе использую функцию Paintdegrade() из примера \Minigui\Samples\Advanced\PaintDegrade\Demo.prg. Если в пример вставить строку SET PROGRAMMATICCHANGE OFF , то цветовая гамма не появляется. Это несоответствие появилось еще с версии 17.04 . Как решить эту проблему?
gfilatov2002: i3t4j6 пишет: Как решить эту проблему? Попробуй [pre2] DEFINE WINDOW Form_Main ; AT 0, 0 ; WIDTH 600 HEIGHT 400 ; TITLE 'Ejemplo Degradado en Ventanas' ; MAIN ; ON INIT paint_it( This.Handle ) ; ON PAINT paint_it( This.Handle ) ... [/pre2]
i3t4j6: Спасибо!!! Все работает.
Andrey: Всем привет ! А есть возможность узнать какая тема для контекстного меню установлена ? Типа [pre2] nThemes := SetThemes(2) ..... SetThemes(nThemes )[/pre2] И ещё нужно узнать какой цвет фона установлен у HMG_Alert() ? [pre2]SET MSGALERT BACKCOLOR TO ..... nVal := GetMsgAlert() [/pre2] Тоже для восстановления потом.
Andrey: Всем привет ! Очередная китайская загадка. На форму вывожу так: [pre2]? nY, nX, nWtb1, nHTxt, cFileSbln, aBColorTxt @ nY, nX TEXTBOX TbShbl_1 VALUE cFileSbln WIDTH nWtb1 HEIGHT nHTxt ; FONTCOLOR BLACK BACKCOLOR aBColorTxt ON CHANGE {|| cFileSbln := This.TbSbln_1.Value } пробовал и так: @ nY, nX TEXTBOX TbShbl_1 VALUE cFileSbln WIDTH nWtb1 HEIGHT nHTxt ; FONTCOLOR BLACK BACKCOLOR aBColorTxt ; ON CHANGE {|| cFileSbln := Form_SetCmp.TbSbln_1.Value } // строка 192 [/pre2] Форму строит нормально, но при попытке ввода - вылет с ошибкой: [pre2]Error MGERROR/0 Control: TbSbln_1 Of Form_SetCmp Not defined. Program terminated. --------------------------------- Stack Trace --------------------------------- Called from MSGMINIGUIERROR(100) in module: h_error.prg Called from GETPROPERTY(4856) in module: h_controlmisc.prg Called from (b)FORM_OPENCOMPSET(192) in module: aTopMenu2.prg Called from _DOCONTROLEVENTPROCEDURE(1901) in module: h_windows.prg Called from EVENTS(1912) in module: h_events.prg Called from DOMESSAGELOOP(0) Called from _ACTIVATEWINDOW(1514) in module: h_windows.prg Called from FORM_OPENCOMPSET(401) in module: aTopMenu2.prg [/pre2] Все переменные определены, точно такой же оператор стоит в другом окне - работает без проблем. А почему здесь не работает, что не так делаю ?
Dima: Andrey пишет: Очередная китайская загадка. Тема называется "Примеры из Минигуи -ошибки, вопросы"
Haz: Andrey пишет: пробовал и так: @ nY, nX TEXTBOX TbShbl_1 VALUE cFileSbln WIDTH nWtb1 HEIGHT nHTxt ; FONTCOLOR BLACK BACKCOLOR aBColorTxt ; ON CHANGE {|| cFileSbln := Form_SetCmp.TbSbln_1.Value } Как минимум в этом. Тема называется "Примеры из Минигуи -ошибки, вопросы" согласен с Димой, тема относится к примерам. Про личную невнимательность лучше писать не здесь.
Andrey: Haz пишет: Про личную невнимательность лучше писать не здесь Ну извините меня. Запутался в переменной... с кем не бывает ?
Andrey: А вот дальше у меня точно НЕ МОЯ ошибка или баг. При использовании отладки в лог-файл допустим _MsgLog.txt после использования команды GetFile(...) перестаёт писаться в текущий лог, создаёт НОВЫЙ лог в папке где был использован последний путь из GetFile(...) Почему ?
SergKis: Andrey пишет после использования команды GetFile(...) перестаёт писаться в текущий лог Исходники для того, что бы их смотреть h_ini.prg[pre2] *-----------------------------------------------------------------------------* FUNCTION _SetGetLogFile( cFile ) *-----------------------------------------------------------------------------* LOCAL cOld STATIC MLog_File cOld := MLog_File IF cFile != NIL MLog_File := cFile RETURN MLog_File ENDIF RETURN cOld *-----------------------------------------------------------------------------* #ifndef __XHARBOUR__ FUNCTION _LogFile( lCrLf, ... ) #else FUNCTION _LogFile( ... ) #endif *-----------------------------------------------------------------------------* LOCAL hFile, i, xVal, cTp LOCAL aParams := hb_AParams() LOCAL nParams := Len( aParams ) LOCAL cFile := hb_defaultValue( _SetGetLogFile(), GetStartUpFolder() + "\_MsgLog.txt" ) #ifdef __XHARBOUR__ LOCAL lCrLf #endif IF !Empty( cFile ) hFile := iif( File( cFile ), FOpen( cFile, FO_READWRITE ), FCreate( cFile, FC_NORMAL ) ) IF hFile == F_ERROR RETURN .F. ENDIF FSeek( hFile, 0, FS_END ) IF nParams > 1 #ifdef __XHARBOUR__ lCrLf := aParams[ 1 ] #endif IF ( lCrLf := hb_defaultValue( lCrLf, .T. ) ) FWrite( hFile, CRLF, 2 ) ENDIF IF nParams == 2 .AND. HB_ISNIL( aParams[ 2 ] ) .AND. lCrLf ELSE FOR i := 2 TO nParams xVal := aParams[ i ] cTp := ValType( xVal ) IF cTp == 'C' ; xVal := iif( Empty( xVal ), "'" + "'", Trim( xVal ) ) ELSEIF cTp == 'N' ; xVal := hb_ntos( xVal ) ELSEIF cTp == 'L' ; xVal := iif( xVal, ".T.", ".F." ) #ifdef __XHARBOUR__ ELSEIF cTp == 'D' ; xVal := DToC( xVal ) #else ELSEIF cTp == 'D' ; xVal := hb_DToC( xVal, 'DD.MM.YYYY' ) #endif ELSEIF cTp == 'A' ; xVal := "ARRAY[" + hb_ntos( Len( xVal ) ) + "]" ELSEIF cTp == 'H' ; xVal := "HASH[" + hb_ntos( Len( xVal ) ) + "]" ELSEIF cTp == 'B' ; xVal := "'" + "B" + "'" ELSEIF cTp == 'T' ; xVal := hb_TSToStr( xVal, .T. ) ELSEIF cTp == 'U' ; xVal := 'NIL' ELSE ; xVal := "'" + cTp + "'" ENDIF FWrite( hFile, xVal + Chr( 9 ) ) NEXT ENDIF ELSE FWrite( hFile, CRLF, 2 ) ENDIF FClose( hFile ) ENDIF RETURN .T. ... [/pre2] А GetFile() до фонаря эти ф-ии, внутри работает C ф-я, где то использована выделенная цветом
Andrey: Использую виндовую функцию GetColor() из h_dialogs.prg Открывается аж на другом конце экрана, по позиции окна примерно 10x10. Окно с ТСБ на весь экран, колонка с изменением цвета в правом углу. Вызываешь эту функцию и она показывается в левом углу... Блин юзера задолбают вопросом - сдвинуть там где колонка. А можно как то задать позицию этого GetColor() ? В старом примере Tsb_Config тоже так же, только там задание цвета в отдельном окне и выходит по центру. Более менее красиво.
gfilatov2002: Andrey пишет: А можно как то задать позицию этого GetColor() ? Попробуй задать команду SET DIALOGBOX CENTER OF PARENT
Andrey: gfilatov2002 пишет: Попробуй задать команду Так получше ! А как можно снять эту команду, т.е. отменить её потом ?
Dima: Andrey пишет: А как можно снять эту команду, т.е. отменить её потом ? Не судьба глянуть i_hmgcompat.ch ?
gfilatov2002: Andrey пишет: отменить её потом ? Dima пишет: глянуть i_hmgcompat.ch SET DIALOGBOX [ POSITION ] DISABLE
Andrey: Dima пишет: Не судьба глянуть i_hmgcompat.ch ? Да тормознул... gfilatov2002 пишет: SET DIALOGBOX [ POSITION ] DISABLE Спасибо !
Andrey: Всем привет. Фигня какая то получается. Пишу в коде:[pre2] #define VIRT_COLUMN_END 6 #define VIRT_COLUMN_MAX VIRT_COLUMN_END + 1 .... nCol0 := nCol - VIRT_COLUMN_MAX ? "nCol=",nCol, "- VIRT_COLUMN_MAX=",VIRT_COLUMN_MAX, "nCol0 =",nCol0[/pre2] В отладке выводит так: [pre2] nCol= 9 - VIRT_COLUMN_MAX= 7 nCol0 = 4 [/pre2] т.е. получается 9-7=4 Почему ?
SergKis: Andrey пишет #define VIRT_COLUMN_MAX VIRT_COLUMN_END + 1 Если используешь в вычислениях, то надо скобки #define VIRT_COLUMN_MAX ( VIRT_COLUMN_END + 1 )
Andrey: Спасибо !
rvu: C:\MiniGUI\SAMPLES\Advanced\ActiveX\ Пример браузера. Наблюдается такое: выделяешь выражение, если вызвать меню мышкой, то Копировать работает. А по CTRL+C не копирует. Как это исправить? Какие могут быть причины? По идее это виндовый браузер, в нем же это работает.
Andrey: Можно ли на объекте BUTTONEX сделать отключение показа окантовки кнопки внизу/вверху/справа/слева ? Очень удобно при совмещении кнопки и FRAME сделать объект единым, т.е. совмещать два объекта. В коде примерно так: @ nR, nC BUTTONEX Button_11 CAPTION "Page (1)" WIDTH nWBth HEIGHT nHBth ; PARENT &cForm FONTCOLOR BLACK BACKCOLOR aColors[1] FONT cFname SIZE nFSize BOLD ; SETBORDER {.T.,.T.,.T.,.F.} FLAT NOXPSTYLE ACTION {|| myAction(1), myFocus() } Да и для LABEL тоже бы такое хотелось бы.
Andrey: Можно ли при старте MAIN окна сделать запуск отдельной формы (с наворотами) в отдельном потоке ? Этот поток должен существовать до конца закрытия программы. И как тогда обращаться к этой форме в другом потоке (вывод на форму) ?
SergKis: Andrey пишет Можно ли при старте MAIN окна сделать запуск отдельной формы (с наворотами) в отдельном потоке ? А.Кресин (http://www.kresin.ru/hrbfaq_3.html#Doc11) Отдельные Public и Private переменные могут передаваться потоку при его создании ... Поэтому в тех случаях, когда потоки используют какие-либо общие ресурсы ( чаще всего - переменные ), необходимы средства синхронизации работы потоков, чтобы они не обращались к общим ресурсам одновременно. Такими средствами являются семафоры и одна из их разновидностей - mutex ... Учитывая что _HMG_SYSDATA это глобальный массив с ~ _HMG_SYSDATA\[455] (_HMG_aFormNames, _HMG_aFormHandles, ...) элементами, то совместный доступ организовать будет не возможно, учитывая, что обработчик всего общая ф-я Events(...). Забудь. Запускай свою же прогу повторно с др. параметрами при первом старте и общайся между ними по потребностям
Andrey: SergKis пишет: Запускай свою же прогу повторно с др. параметрами при первом старте и общайся между ними по потребностям Да уже ехе-ник перевалил за 25 Мб. Лучше уж новый сделать на 3-4 Мб.
Andrey: Как в МиниГуи сделать скрин всего экрана в файл?
Dima: \MiniGUI\SAMPLES\Applications\ScreenshotMaker\
Andrey: Спасибо !
Andrey: А есть возможность в МиниГуи цеплять большие курсоры для мышки ? А то при выборе в ТСБ записи медленно окно карточки прорисовывается, пока построит всё объекты на окне, юзер давит на кнопку или мышкой затыкивает запись в ТСБ. Нужно показать немедленную реакцию программы - типа большие часики показать и юзер увидит реакцию проги и не будет нервничать. У кого есть большие курсоры для мышки и как это сделать для МиниГуи ? P.S. Нашёл в инете только ОДИН большой курсор Circle.ani - 350 кб, добавил в пример MiniGUI\SAMPLES\BASIC\CURSOR_2 заработал, а вот собираться в ехе-ник этот курсор не хочет. Выдаёт ошибку: [pre2]Borland Resource Compiler Version 5.40 Copyright (c) 1990, 1999 Inprise Corporation. All rights reserved. Error MyCurcor.rc 2 45: Invalid cursor format hbmk2[5Tbrw_table_2]: Error: Running resource compiler. 20018 [/pre2]Ошибку выдаёт и на других курсорах: HMG.cur Working in Background.ani Почему ?
SergKis: Andrey пишет Выдаёт ошибку: У меня выдает DEMO.RC (61) : error RC2175 : resource file .\Cursors\Circle.ani is not in 3.00 format Ошибка компилятора ресурсов RC2175 имя файла ресурсного файла не в формате 3.00 Указанный ресурс использовал формат более ранней, чем версия 3.00. Файл ресурсов должен быть преобразован или воссоздан с использованием формата версии 3.00 или новее.
Andrey: Вопрос возник опять по окнам. Есть окно модал1, далее строю модал2 с ТСБ. В ячейки таблицы вызываю редактирование - окно модал3. Иногда у заказчика (да и я сам один раз словил) идёт переключение сразу на модал1. Нашёл алгоритм, который роняет прогу: Колёсико мышки в ТСБ вверх/вниз, выхожу обратно на модал2 и после закрытия редактирования ячейки (модал3 закрывается) - идёт переключение на модал1 и становиться АКТИВНЫМ !!! Т.е. окно модал2 под ним и переключиться на него НЕ МОГУ ! Почему ? Как это исправить ?
SergKis: Andrey пишет Т.е. окно модал2 под ним и переключиться на него НЕ МОГУ ! Похожая картина происходит в MDI окнах, если их 3-и и больше и на тек. окне ввод в GETBOX, то по завершении ввода фокус улетает на окно mdi child другое (точно уже не помню, но кажется первое) и все там и сидит. Где то управление окнами в h_events.prg подрабатывает. Определить не смог.
Andrey: Понял тебя. Благо это в одном месте, переделал на контекстное меню. Пропала ошибка...
SergKis: Andrey пишет Благо это в одном месте, переделал на контекстное меню. Если есть потребность 3-го окна, то надо убирать 2-е и вместо него делать, типа, 3-е, отработать и убрав 3-е, пересоздать 2-е, учитывая данные с 3-го. В MDI тек. hmg (так пробовал делать и не было перескоков фокуса).
alex_II: Пример со строчным курсором: MiniGUI\SAMPLES\Advanced\Tsb_linedrag Для решения задачи все ячейки делаются редактируемыми ... // prepare for showing of Double cursor AEval( oBrw:aColumns, {| oCol | oCol:lFixLite := oCol:lEdit := TRUE } ) ... и хотя для предотвращения входа в редактирование я устанавливал в описании столбца PREEDIT {|| .F.} это не спасает от ошибочного входа в редактирование первого столбца Пользователь зачастую не глядя редактирует быстро колонки и ИНОГДА кусок введеных данных оказывается введен параллельно и в первую колонку TSBrowse. Вышел из этой ситуации таким образом: DATA FieldWBlock('ls', Select('sity')) --> DATA str(sity->ls,6,0)
SergKis: alex_II пишет Вышел из этой ситуации таким образом: DATA FieldWBlock('ls', Select('sity')) --> DATA str(sity->ls,6,0) Возможно, так удобнее было бы[pre2] :lInsertMode := .T. :nFreeze := 1 :lLockFreeze := .T. :nCell := 2 END TBROWSE [/pre2] Не используемая в Edit 1-ая колонка не попадала в фокус, отпадают лишние движения
SergKis: PS Если фокус на 1-ой колонке надо иметь, то проще поступать так[pre2] LoadFields( "oBrw", "Form_0", .T., aField ) oBrw:GetColumn(1):lEdit := .F. и убрать строку AEval( oBrw:aColumns, {| oCol | oCol:lFixLite := oCol:lEdit := TRUE } ) если у вас создание колонок из ini, то и установку :lEdit надо делать из ini oBrw:GetColumn( "F1" ):lEdit := "T" $ hIni[ "F1" ][ "Edit" ] oBrw:GetColumn( "F2" ):lEdit := "T" $ hIni[ "F2" ][ "Edit" ] oBrw:GetColumn( "F3" ):lEdit := "T" $ hIni[ "F3" ][ "Edit" ] oBrw:GetColumn( "F4" ):lEdit := "T" $ hIni[ "F4" ][ "Edit" ] добавив FOR n := 1 TO TEST->( FCount() ) hIni[ aField[ n ] ] := hb_Hash() hIni[ aField[ n ] ][ "Position" ] := hb_ntos( n ) hIni[ aField[ n ] ][ "Width" ] := hb_ntos( 100 ) hIni[ aField[ n ] ][ "Heading" ] := aField[ n ] hIni[ aField[ n ] ][ "Edit" ] := iif( aField[ n ] == "F2", ".F.", ".T." ) NEXT [/pre2]
SergKis: PS2 и убрать в строке AEval( oBrw:aColumns, {| oCol | oCol:lFixLite := oCol:lEdit := TRUE } )
Andrey: Блин, опять забыл как сделать передачу параметров для запуска программы. Программа запускается так: import.exe "блабла" 2021 "ок" А как сделать этот параметр в файле import.hbp ? Т.е. чтобы запускать на компиляцию hbmk2.bat import.hbp и после сборки предавалась эта командная строка - "блабла" 2021 "ок"
Dima: Andrey пишет: Блин, опять забыл Андрей у врача давно был ? Склероз явно прогрессирует
Haz: Andrey пишет: Т.е. чтобы запускать на компиляцию hbmk2.bat import.hbp и после сборки предавалась эта командная строка - "блабла" 2021 "ок" http://clipper.borda.ru/?1-4-1632858128412-00000886-000-10001-0#010.001
Andrey: А что поделать, памяти после ковида вообще нет. Год назад об этом спрашивал оказывается, забыл. На форуме в поиске задавал ключ поиска -run и выдало 0 страниц. Поиск на форуме вообще не фурычит. Haz пишет: 2) читаем справку , там есть -runflag=<f> pass single flag to output executable when -run option is used Пробовал этот ключ, что то не пошёл он у меня. Задаю так: [pre2]-runflag="/PLATAIMPORT" "2021" "20" "Оператор 20" [/pre2] Выдаёт вот это: [pre2]Harbour 3.2.0dev (r2104281802) Copyright (c) 1999-2021, https://harbour.github.io/ Cannot open 2021.prg, assumed external No code generated. hbmk2[opl_import]: Error: Running Harbour compiler (built-in). 1[/pre2] Если кавычки убрать, то всё равно такая же ошибка.
SergKis: Andrey Не мучай параметры, создавай ini с параметрами и читай их, без ограничений в кол-ве и качестве
Andrey: SergKis пишет: Не мучай параметры, создавай ini с параметрами и читай их, без ограничений в кол-ве и качестве Да у меня отдельная задача запускается через командную строку. Вот для неё и хотел сделать.
Haz: Andrey пишет: Пробовал этот ключ, что то не пошёл он у меня. Там же написано single flag . т.е. один параметр одной строкой. Убери все пробелы и кавычки ( они точно не нужны т.к. через командную строку передаются только строки) В программе распарсишь полученную строку на нужные составляюшие
SergKis: Andrey пишет Да у меня отдельная задача запускается через командную строку. Тем более. Будешь в link прописывать или Haz пишет распарсишь полученную строку на нужные составляюшие Ini удобнее. Тот пример, что у тебя есть demo5, там только одна строка и парсить ничего не надо
Andrey: Haz пишет: Там же написано single flag . т.е. один параметр одной строкой. Спасибо ! Блин, год назад делал так же, нашёл у себя. Да уж, памяти совсем нет...
SergKis: Пример demo5.prg [pre2] /* * MINIGUI - Harbour Win32 GUI library Demo * * Copyright 2021 Sergej Kiselev <bilance@bilance.lv> * Copyright 2021 Verchenko Andrey <verchenkoag@gmail.com> Dmitrov, Moscow region * * Пример работы с ини-файлом через контейнер oHmgData() и Class TIniData * Преобразование строки ини-файла в нужные типы * An example of working with an ini file through a container oHmgData() and Class TIniData * Converting an ini file string to desired types */ #define _HMG_OUTLOG #include "hmg.ch" #include "hbclass.ch" ANNOUNCE RDDSYS Function Main() LOCAL oApp, oIni, oCom, aSec, cSec, oSec, nI, cFile, hIni, oTmp LOCAL cIni := GetStartUpFolder() + "\demo5-utf8.ini" // кодировка Utf-8 LOCAL cIni2 := GetStartUpFolder() + "\demo5-utf8.2-ini" // новый файл LOCAL cFileLog := GetStartUpFolder() + "\_5Msg.log" //SET CODEPAGE TO UNICODE // for Unicode version SET CODEPAGE TO RUSSIAN SET LANGUAGE TO RUSSIAN SET DATE TO GERMAN App.Cargo := oHmgData() ; oApp := App.Cargo oApp:cLog := cFileLog ; fErase( oApp:cLog ) oApp:cIni := cIni oApp:cIni2 := cIni2 SET LOGFILE TO (oApp:cLog) // отладочный log файл oApp:oIni := oIniData( cIni, .T. ):Read() //oApp:oIni := oIniData( cIni, .T. ) ; oIni:Read() //oApp:oIni := oIniRead( cIni, .T. ) // в качестве примера чтение нескольких ини-файлов //oApp:oIni1 := oIniRead( ".\demo1.ini", .T. ) // .T. - lMacro //oApp:oIni2 := oIniRead( ".\demo2.ini", .T. ) ? Repl("-",20) + " example log file: " + cFileNoPath( App.ExeName ) + Repl("-",20) ; ? // oIni := App.Cargo:oIni oIni := oApp:oIni // берем адрес объекта oIni и от него работаем aSec := oIni:Keys() // все секции ини-файла ? "все секции ини-файла " + cIni+" =", aSec, hb_valtoexp(aSec) ; ? FOR EACH cSec IN oIni:Keys() // перебираем секции oSec := oIni:Get(cSec) ? cSec, oSec:GetAll() ; ?v oSec:GetAll() ; ? NEXT cSec := [COM] //[COMMON] /* нет такой секции */ oCom := oIni:Get(cSec, oIniData()) // секция [COM], параметр 2, если нет [COM] ? cSec+" =", oCom:GetAll() ; ?v oCom:GetAll() ; ? aSec := oCom:GetAll() // вытаскиваем все из секции FOR nI := 1 TO LEN(aSec) aVal := aSec[ nI ] cKey := aVal[1] xVal := aVal[2] ? nI, cKey, VALTYPE(xVal) , xVal NEXT // или так IF Len(aSec) > 0 FOR EACH aVal IN aSec cKey := aVal[1] xVal := aVal[2] ? hb_enumindex(aVal), cKey, VALTYPE(xVal) , xVal NEXT ENDIF // Проверка наличия ключа oApp:lLanguage := oCom:Pos("Language") > 0 // позиция ключа в контейнере IF oApp:lLanguage ? "["+cSec+"] Есть ключ Language=", oCom:Language ELSE ? "["+cSec+"] НЕТ ключа Language = !" ENDIF Test( oIni ) // проверка переменных из ини // записать новый ини-файл cFile := oApp:cIni2 ? "New file ini =", cFile //oIni:cCommentBegin := "# my Start !" //oIni:cCommentEnd := "# my Stop !" //oIni:lYesNo := .T. // Yes или No в логических значениях при создании ini используем //oIni:aYesNo := {"Да", "Нет"} // Yes или No в логических значениях при создании ini //oIni:Write( cFile, .F. ) // НЕ UTF8, т.е. нет BOM на выходе (на входе был с BOM) oIni:Write( cFile ) // как оригинальный файл UTF8 с BOM ? ; ? "--- End ---" DO EVENTS // показать отладочный файл cStr := HB_MemoRead(App.Cargo:cLog) cFileLog := GetStartUpFolder() + "\_"+Set( _SET_CODEPAGE )+".log" HB_MemoWrit( cFileLog, cStr ) ShellExecute(0,"Open",cFileLog,,,SW_SHOWNORMAL) Return /////////////////////////////////////////////////////////////////////// FUNCTION Test( oIni ) LOCAL nMode, lLog, cPath, aLang, bClr1, xTest, cBtn5, xVal LOCAL oCom, cSec := [COM], Dtm1, Dtm2, Dtm3, Bufer, Buf2 ? "------------- проверка переменных из ини ---------" // читать переменные - секция [RU] переменная "Btn_05" cBtn5 := oIni:RU:Btn_05 ; Default cBtn5 := "none" ? "oIni:RU:Btn_05 = ", cBtn5 // читать переменные - секция [COM] переменная "ModeBAK" nMode := oIni:Com:ModeBAK ; Default nMode := 0 // или так oCom := oIni:Get( cSec, oIniData() ) // это просто адрес в oCom nMode := oCom:ModeBAK ; Default nMode := 0 // можно в отдельной ф-ии проверить все ключи и добавить их в oIni в // нужную секцию, что бы потом просто работать без Default nMode := 0 nMode := oCom:Get("ModeBAK", 0) // это функция-метод nMode := oCom:ModeBAK ; Default nMode := 0 // это удобно нет кавычек // писать\устанавливать в oIni:COM nMode := 21 oCom:ModeBAK := nMode oCom:Set("ModeBAK", nMode) // это функция-метод nMode := oCom:Get("ModeBAK" , 0 ) lLog := oCom:Get("lLangLog", .F. ) cPath := oCom:Get("PathXml" , "" ) aLang := oCom:Get("aLangName", {} ) bClr1 := oCom:Get("Color_1" , {||Nil} ) xTest := oCom:Get("PathXXX" , "not" ) Dtm1 := oCom:Dtm1 Dtm2 := oCom:Dtm2 Dtm3 := oCom:Dtm3 Bufer := oCom:Buffer Buf2 := oCom:Buffer2 xVal := oCom:None // такой переменной нет ? "nMode=", ValType(nMode) , nMode ? "lLog =", ValType(lLog ) , lLog ? "cPath=", ValType(cPath) , cPath ? "aLang=", ValType(aLang) , aLang, HB_ValToExp(aLang) ? "bClr1=", ValType(bClr1) , bClr1 ? "xTest=", ValType(xTest) , xTest ? "Dtm1 =", ValType(Dtm1 ) , Dtm1 ? "Dtm2 =", ValType(Dtm2 ) , Dtm2 ? "Dtm3 =", ValType(Dtm3 ) , Dtm3 ? "Bufer=", ValType(Bufer) , Bufer ? "Buf2 =", ValType(Buf2) , Buf2 ? "xVal =", ValType(xVal) , xVal ? "------- через свою функцию GetHmgData() ------" ? "ModeBAK" , GetIniData( oIni, [COM], "ModeBAK" , 0 ) ? "ModeNone", GetIniData( oIni, [COM], "ModeNone" , -1 ) ? Return Nil /////////////////////////////////////////////////////////////////////// FUNCTION GetIniData(oIni, cSection, cKey, xDefault) LOCAL oSect, cSect, cErr, cIni := App.Cargo:cIni oSect := oIni:Get(cSection, oIniData()) // Проверка наличия ключа IF oSect:Pos(cKey) > 0 // позиция ключа в контейнере xRet := oSect:Get(cKey) // xRet := oSect:&(cKey) // можно и так ELSE cErr := 'Ошибка ! Секция [' + cSection + ']' + CRLF cErr += 'Нет ключа "' + cKey + '" = ...' + CRLF cErr += 'Исправьте ключ в ини-файле !' + CRLF + CRLF cErr += 'Чтение ини-файла ' + cIni + CRLF + CRLF cErr += 'Error! Section ['+ cSection +'] '+ CRLF cErr += 'No key "' + cKey + '" = ...' + CRLF cErr += 'Correct the key in the ini file!' + CRLF + CRLF cErr += 'Reading ini-file' + cIni + CRLF + CRLF cErr += ProcName(0) + "(" + HB_NtoS(ProcLine(0)) + ")" + CRLF cErr += ProcName(1) + "(" + HB_NtoS(ProcLine(1)) + ")" + CRLF cErr += ProcName(2) + "(" + HB_NtoS(ProcLine(2)) + ")" + CRLF MsgStop(cErr, "Error ini-files" ) xRet := xDefault ENDIF Return xRet FUNCTION oIniData( cIni, lMacro, lUtf8, cRazd ) RETURN TIniData():New( cIni, lMacro, lUtf8, cRazd ) FUNCTION oIniRead( cIni, lMacro, lUtf8, cRazd ) RETURN oIniData( cIni, lMacro, lUtf8, cRazd ):Read() #define _METHOD METHOD CLASS TIniData INHERIT THmgData VAR oIni VAR hHash INIT { => } VAR hKeys INIT { => } VAR hLens INIT { => } VAR cBOM AS STRING INIT hb_utf8Chr( 0xFEFF ) VAR cIni AS STRING INIT "" VAR lIni AS LOGICAL INIT .F. VAR lUtf AS LOGICAL INIT .F. VAR lUtf8 AS LOGICAL INIT .F. VAR cCommentChar AS STRING INIT ";" VAR cCommentBegin AS STRING INIT "" VAR cCommentEnd AS STRING INIT "" VAR lAutoMain AS LOGICAL INIT .F. VAR lMacro AS LOGICAL INIT .F. VAR lYesNo AS LOGICAL INIT .F. VAR aYesNo AS ARRAY INIT { "Yes", "No" } METHOD New( cIni, lMacro, lUtf8, cChar ) INLINE ( ::Super:New( .T. ), ; ::Def( cIni, lMacro, lUtf8, cChar ), Self ) CONSTRUCTOR _METHOD Def( cIni, lMacro, lUtf8, cChar ) _METHOD Read() _METHOD Write( cFile, lUtf8 ) _METHOD ToValue( cStr ) _METHOD ToString( xVal ) END CLASS METHOD Def( cIni, lMacro, lUtf8, cChar ) CLASS TIniData ::cIni := hb_DefaultValue( cIni, ::cIni ) ::lMacro := hb_DefaultValue( lMacro, ::lMacro ) ::lUtf8 := ! Empty( lUtf8 ) ::lUtf := Set( _SET_CODEPAGE ) == "UTF8" ::cCommentChar := hb_DefaultValue( cChar, ::cCommentChar ) IF ! Empty( ::cIni ) IF ! hb_FileExists( ::cIni ) hb_memoWrit( ::cIni, iif( ::lUtf8, ::cBOM, "" ) + CRLF ) ENDIF ::lIni := hb_FileExists( ::cIni ) ENDIF RETURN Self METHOD Read() CLASS TIniData LOCAL hIni, cStr, cBuf, aBuf, nBuf, cSec, hSec, oSec, nLen := 1024 LOCAL cChr := ::cCommentChar, xVal, hKey, nKey, cNote IF ::lIni .and. ( hIni := FOpen( ::cIni, 2 ) ) > 0 cStr := space( Len(::cBOM) ) cBuf := space( nLen ) FRead( hIni, @cStr, Len(::cBOM) ) FSeek( hIni, 0, 0 ) FRead( hIni, @cBuf, nLen ) ::lUtf8 := ( cStr == ::cBOM ) aBuf := hb_ATokens( cBuf, CRLF ) FOR EACH cBuf IN aBuf IF left( cBuf, 1 ) == "#" IF ! ::lUtf .and. ::lUtf8 ::cCommentBegin := hb_Utf8ToStr( cBuf ) ELSE ::cCommentBegin := cBuf ENDIF EXIT ENDIF NEXT cBuf := space( nLen ) FSeek( hIni, -nLen, 2 ) FRead( hIni, @cBuf, nLen ) aBuf := hb_ATokens( cBuf, CRLF ) FOR nBuf := Len(aBuf) TO 1 STEP -1 cBuf := aBuf[ nBuf ] IF left( cBuf, 1 ) == "#" IF ! ::lUtf .and. ::lUtf8 ::cCommentEnd := hb_Utf8ToStr( cBuf ) ELSE ::cCommentEnd := cBuf ENDIF EXIT ENDIF NEXT FClose( hIni ) ::hHash := hb_hSetCaseMatch( hb_IniRead( ::cIni, , , ::lAutoMain ), .T. ) FOR EACH cSec, hSec IN hb_HKeys( ::hHash ), hb_HValues( ::hHash ) IF ! ::lUtf .and. ::lUtf8 cSec := hb_Utf8ToStr( cSec ) ENDIF oSec := oHmgData() nKey := 0 hKey := { => } FOR EACH cStr, cBuf IN hb_HKeys( hSec ), hb_HValues( hSec ) cNote := "" IF ! ::lUtf .and. ::lUtf8 cStr := hb_Utf8ToStr( cStr ) cBuf := hb_Utf8ToStr( cBuf ) ENDIF IF left(cBuf, 2) == "{|" .or. left(cBuf, 3) == "{ |" cNote := cBuf ENDIF IF ! Empty( cChr ) .and. ( nBuf := At( cChr, cBuf ) ) > 0 IF ! ( left(cBuf, 2) == "{|" .or. left(cBuf, 3) == "{ |" ) cNote := subs( cBuf, nBuf ) ENDIF cBuf := Alltrim( Left( cBuf, nBuf - 1 ) ) ENDIF nKey := Max( nKey, Len( cStr ) ) hb_HSet( hKey, upper(cStr), { cStr, cNote } ) IF ::lMacro .and. ! HB_ISNIL( xVal := ::ToValue( cBuf ) ) oSec:Set( cStr, xVal ) ELSE oSec:Set( cStr, cBuf ) ENDIF NEXT ::Set( cSec, oSec ) hb_HSet( ::hKeys, cSec, hKey ) hb_HSet( ::hLens, cSec, nKey ) NEXT ::hHash := NIL DO EVENTS hb_gcAll() DO EVENTS ENDIF RETURN Self METHOD ToValue( cStr ) CLASS TIniData LOCAL xVal IF Empty( cStr ) ; RETURN cStr ENDIF IF left(cStr, 1) == "{" .and. right(cStr, 1) == "}" .or. ; left(cStr, 1) == "'" .and. right(cStr, 1) == "'" .or. ; left(cStr, 1) == '"' .and. right(cStr, 1) == '"' .or. ; left(cStr, 2) == 'e"' .and. right(cStr, 1) == '"' .or. ; left(cStr, 2) == 't"' .and. right(cStr, 1) == '"' .or. ; left(cStr, 4) == '0d20' .and. Len(cStr) == 10 BEGIN SEQUENCE WITH { |e|break(e) } xVal := &(cStr) END SEQUENCE IF left(cStr, 2) == 't"' .and. right(cStr, 1) == '"' .and. ; Valtype(xVal) == "T" .and. Len( subs(cStr, 3) ) == 11 xVal := hb_TtoD( xVal ) ENDIF ELSEIF hb_ntos(Val(cStr)) == cStr xVal := Val(cStr) ELSEIF cStr == "T" .or. cStr == ".T." .or. cStr == ".t." .or. ; cStr == "Y" .or. cStr == ::aYesNo[1] // "Yes" xVal := .T. ELSEIF cStr == "F" .or. cStr == ".F." .or. cStr == ".f." .or. ; cStr == "N" .or. cStr == ::aYesNo[2] // "No" xVal := .F. ELSE xVal := cStr ENDIF RETURN xVal METHOD ToString( xVal ) CLASS TIniData LOCAL cStr := "", lE := .F. IF HB_ISCHAR( xVal ) cStr := Alltrim( xVal ) IF ! Empty(cStr) IF CRLF $ cStr lE := .T. cStr := StrTran( cStr, CRLF, "\r\n" ) ENDIF IF chr(9) $ cStr lE := .T. cStr := StrTran( cStr, chr(9), "\t" ) ENDIF IF lE IF left ( cStr, 1 ) == '"' ; cStr := subs( cStr, 2 ) ENDIF IF right( cStr, 1 ) == '"' ; cStr := left( cStr, Len(cStr) - 1 ) ENDIF cStr := 'e"' + cStr + '"' ENDIF ENDIF ELSEIF HB_ISLOGICAL( xVal ) .and. ::lYesNo cStr := ::aYesNo[ iif( xVal, 1, 2 ) ] ELSE cStr := hb_valtoexp( xVal ) ENDIF RETURN cStr METHOD Write( cFile, lUtf8 ) CLASS TIniData LOCAL lRet := .F., aSec, cSec, oSec, hSec, hKey, nLen LOCAL hIni := { => }, cKey, cVal, xVal, cStr, lBlk LOCAL cIni := "_"+DtoS(Date())+"_"+StrTran(hb_ntos(Seconds()), ".", "" )+"_"+".ini" LOCAL cBegin := "", cEnd := "" DEFAULT cFile := ::cIni, lUtf8 := ::lUtf8 FOR EACH cSec IN ::Keys() // перебираем секции oSec := ::Get( cSec ) hSec := { => } hKey := hb_hSetCaseMatch( hb_HGetDef( ::hKeys, cSec, { => } ), .T. ) nLen := hb_HGetDef( hb_hSetCaseMatch( ::hLens, .T. ), cSec, 11 ) + 1 FOR EACH aSec IN oSec:GetAll() cKey := aSec[1] xVal := aSec[2] lBlk := HB_ISBLOCK( xVal ) cVal := ::ToString( xVal ) IF ! ::lUtf .and. lUtf8 cKey := hb_StrToUtf8( cKey ) cVal := hb_StrToUtf8( cVal ) ENDIF cStr := hb_HGetDef( hKey, cKey, Nil ) IF HB_ISARRAY( cStr ) .and. Len( cStr ) > 1 cKey := cStr[1] IF ! Empty( cStr[2] ) IF lBlk cVal := iif( ! ::lUtf .and. lUtf8, hb_StrToUtf8( cStr[2] ), cStr[2] ) ELSE cVal += space(3) + iif( ! ::lUtf .and. lUtf8, hb_StrToUtf8( cStr[2] ), cStr[2] ) ENDIF ENDIF ENDIF IF nLen > Len( cKey ) ; cKey := left( cKey + space( nLen ), nLen ) ENDIF hb_HSet( hSec, cKey, " " + cVal ) NEXT hb_HSet( hIni, cSec, hSec ) NEXT IF ! Empty( ::cCommentBegin ) cBegin += iif( left(::cCommentBegin, 1) == "#", "", "#" ) + ::cCommentBegin IF ! ::lUtf .and. lUtf8 cBegin := hb_StrToUtf8( cBegin ) ENDIF ENDIF cBegin := iif( lUtf8, ::cBOM + CRLF, "" ) + cBegin IF ! Empty( ::cCommentEnd ) cEnd += CRLF + iif( left(::cCommentEnd, 1) == "#", "", "#" ) + ::cCommentEnd IF ! ::lUtf .and. lUtf8 cEnd := hb_StrToUtf8( cEnd ) ENDIF ENDIF IF Empty( cBegin ) ; cBegin := Nil ENDIF IF Empty( cEnd ) ; cEnd := Nil ENDIF hb_iniWrite( cIni, hIni, cBegin, cEnd, ::lAutoMain ) IF hb_vfExists( cFile ) lRet := Empty( hb_vfErase( cFile ) ) IF lRet lRet := Empty( hb_vfRename( cIni, cFile ) ) ENDIF ELSE lRet := Empty( hb_vfRename( cIni, cFile ) ) ENDIF RETURN lRet [/pre2] ini к нему demo5-utf8.ini (utf8 с BOM) [pre2] # Hello - Start ! [COM] DiskArc = D:\eAlarm\BACKUP ; Archives storage location (files *.7z) PathArc = .\BAKS ; Archived copies daemon_*.7z for timing PathXml = .\XML ; directory for excel reporting PathBAK = .\BAK ; Auto loading files *.fdb from files *.bak ModeBAK = 1 ; 1 - delete fdb after loading fdb, 0 - no delete LoadBAK = 1 ; loaded: 0 - last bak, 1 - all bak files from directoy ModeFDB = 1 ; 1 - delete all dbf after loading fdb, 0 - no delete User = sysdba ; FDB user Password = masterkey ; FDB password TimerSek = 30 ; usage: 60*60 = 1 hour or 60*60*3 = 3 hours TimeLoad = 17:15:00 ; , 23:00:00-23:59:59 ; time load *.7z => *.bak Host = 127.0.0.1 ; Language = RU aLangName = { 'Русский', 'Белорусский', 'Украинский', 'Латышский' } ; список языков aLangList = { 'RU' , 'BE' , 'UA' , 'LV' } aLangNum = { 1, 2, 3, 4 } ; список кодов языков aLangLog = { .T., .F., .F., .F. } ; логический список lLangLog = .t. ; логическая переменная cVersion = 22.09.21 ; текстовая дата Dtm1 = t"2021-09-01 17:10:11" ; переменная времени Dtm2 = 0d20210902 ; переменная дата Dtm3 = t"2021-09-02" ; переменная времени - дата Buffer = e" aaaaa bbbbb cccc " ; переменная буфера Buffer2 = e". \r\n \t line: \r\n \t 1. aaaaa \r\n \t 2. bbbbb \r\n \t 3. cccc " ; переменная буфера 4 строки Color_0 = "--------- условия показа ----------" Color_1 = {|| DELETED() } Color_2 = {|| (ALIAS())->KVipZa == 0 } Color_3 = {|| (ALIAS())->KVipZa == 1 } Color_4 = {|| (ALIAS())->KVipZa == 2 } [RU] Title = Демонстрация меню и нескольких языков у себя в проекте Label_0 = Демо для своего проекта МойПроект5 Label_1 = (©) Copyright by Andrey Verchenko <verchenkoag@gmail.com> 2021. All rights reserved. Dmitrov, Russia Btn_01 = Помощь Btn_02 = Настройки Btn_03 = Проверка Btn_04 = Резерв Btn_05 = Выход [BE] Title = 222 Демонстрация меню и нескольких языков у себя в проекте Label_0 = 222 Демо для своего проекта МойПроект5 Label_1 = ---игнорировать Btn_01 = 222 Помощь Btn_02 = 222 Настройки Btn_03 = 222 Проверка Btn_04 = 222 Резерв Btn_05 = 222 Выход [UA] Title = 333 Демонстрация меню и нескольких языков у себя в проекте Label_0 = 333 Демо для своего проекта МойПроект5 Label_1 = ---игнорировать Btn_01 = 333 Помощь Btn_02 = 333 Настройки Btn_03 = 333 Проверка Btn_04 = 333 Резерв Btn_05 = 333 Выход [LV] Title = 444 Демонстрация меню и нескольких языков у себя в проекте Label_0 = 444 Демо для своего проекта МойПроект5 Label_1 = ---игнорировать Btn_01 = 444 Помощь Btn_02 = 444 Настройки Btn_03 = 444 Проверка Btn_04 = 444 Резерв Btn_05 = 444 Выход # Hello - Stop ! [/pre2]
SergKis: Пример demo4.prg (более простой вариант работы с ini) [pre2] /* * MINIGUI - Harbour Win32 GUI library Demo * * Copyright 2021 Sergej Kiselev <bilance@bilance.lv> * Copyright 2021 Verchenko Andrey <verchenkoag@gmail.com> Dmitrov, Moscow region * * Пример работы с ини-файлом через контейнер oHmgData() * An example of working with an ini file through a container oHmgData() */ #define _HMG_OUTLOG #include "minigui.ch" ANNOUNCE RDDSYS Function Main() Local o := oHmgData() // oIni Local c := oHmgData() // oSection Local a := oHmgData() // oLanguage Local cIni := "demo4.ini", s, aDim Local cLog := GetStartUpFolder() + "\_4Msg.log" SET CODEPAGE TO RUSSIAN SET LANGUAGE TO RUSSIAN SET LOGFILE TO (cLog) // отладочный log файл SET DATE TO GERMAN fErase( cLog ) IsIniFile(cIni) // проверка на наличие ini-файла ? "--------------- example log file: " + cFileNoPath( App.ExeName ) o:Set(hb_IniRead(cIni, .F.)) // ключи в upper (секция MAIN дбавляется, если нет ее) // все секции ини-файла ? "File " + cIni,"=", o:Keys(), HB_ValToExp(o:Keys()) ; ? ? "INI =", o:GetAll() ; ?v o:GetAll() ; ? c:Set(o:Com) // секция [COM] ? "COM =", c:GetAll() ; ?v c:GetAll() ; ? "---- выборочные значения -----" ? " Number = ", ValType(c:Number ) , c:Number ? " String = ", ValType(c:String ) , c:String ? " Logical = ", ValType(c:Logical ) , c:Logical ? " Date = ", ValType(c:Date ) , c:Date ? " Host = ", ValType(c:Host ) , c:Host ? " aLangName = ", ValType(c:aLangName) , c:aLangName ? " aLangList = ", ValType(c:aLangList) , c:aLangList aDim := hb_Atokens( c:aLangName, "," ) ? " aLangName = ",aDim,ValType(aDim), hb_ValToExp(aDim) aDim := hb_Atokens( c:aLangList, "," ) ? " aLangList = ",aDim,ValType(aDim), hb_ValToExp(aDim) ? "------------------------------" s := c:Language // язык IF ! s $ "RU,EN" s := iif( Set( _SET_CODEPAGE ) == 'RU1251', [RU], [EN] ) ENDIF ? "Language =", s a:Set(o:Get(s)) // секция [RU] или [EN] ? "Text =", a:GetAll() ; ?v a:GetAll() ; ? ? a:Title ? a:Btn_01 ? a:Btn_02 ? a:Btn_03 ? a:Btn_04 ? "---- End ----" ShellExecute(0,"Open",cLog,,,SW_SHOWNORMAL) // показать отладочный файл Return Nil ///////////////////////////////////////////////////////////////////// Function IsIniFile(cIni) LOCAL cText, lUtf := Set( _SET_CODEPAGE ) == "UTF8" IF !File( cIni) cText := "[Information]" + CRLF cText += "Program = " + Application.ExeName + CRLF cText += "Free Open Source Software = " + Version() + CRLF cText += "Free Compiler = " + hb_compiler() + CRLF cText += "Free Library = " + MiniGUIVersion() + CRLF cText += CRLF cText += "[Main]" + CRLF cText += "cIni = " + cIni + CRLF cText += "cCode = " + Set( _SET_CODEPAGE ) + CRLF cText += "lUtf8 = " + cValToChar(lUtf) + CRLF cText += CRLF cText += "[COM]" + CRLF cText += "Number = 13" + CRLF cText += "String = Строка пример / Example string" + CRLF cText += "Logical = " + cValToChar(lUtf) + CRLF cText += "Date = " + DtoC(Date()) + CRLF cText += "Host = 127.0.0.1" + CRLF cText += "aLangName = Русский,Белорусский,Украинский,Латышский" + CRLF cText += "aLangList = RU,BE,UA,LV" + CRLF cText += "Language = RU" + CRLF cText += CRLF cText += "[RU]" + CRLF cText += "Title = Демонстрация работы с ини-файлом через контейнер oHmgData()" + CRLF cText += "Btn_01 = Помощь" + CRLF cText += "Btn_02 = Настройки" + CRLF cText += "Btn_03 = Проверка" + CRLF cText += "Btn_04 = Выход" + CRLF cText += CRLF cText += "[EN]" + CRLF cText += "Title = Demonstration of working with ini-file through the oHmgData() container" + CRLF cText += "Btn_01 = Help" + CRLF cText += "Btn_02 = Settings" + CRLF cText += "Btn_03 = Check" + CRLF cText += "Btn_04 = Exit" + CRLF hb_MemoWrit( cIni, cText ) ENDIF Return Nil [/pre2]
Haz: SergKis пишет: читай их, без ограничений в кол-ве и качестве кроме как приведение типов. Давно перешел на json. Вот где без ограничений, да и hash гонится элементарно.
SergKis: Haz пишет Вот где без ограничений Формат даты в json не понимается никак, имеется ввиду обратно, только конкретное имя, типа dMyDate, по первому символу, да и не встроен json в hb как продолжение языка, синтаксис (hb_H... ф-ии не совсем то в процессе работы, по мне+с xhb это "две большие разницы"). В demo5 все по типам туда и обратно + встроились в hb, как объект, но ... удобно, если работаешь с объектами. Запись для команд hmg для работы (препроцессор) и запись работы с oHmgData() (oIniData()) практически идентичны, т.е. Form_1.Btn_01.Value и oIni:RU:Btn_01 и т.д. ... hash гонится элементарно. Если много hash - это как с alias(), работать DbSelectArea(...) и работать (cAls := alias(), ..., (cAls)->.... защита данных по алиасу), или с hash всегда "правильно" иметь нужный hash (имя переменной правильно, не ошибившись таскать с собой) hb_HGet(<hHash>, .....), или объект, где все на hash внутри и оперируешь только переменной объекта
Haz: SergKis пишет: Формат даты в json не понимается никак, имеется ввиду обратно, не приходилось пока использовать формат даты, не проверял, верю. При старте программы считываю локальные настройки пользователя из папки его профиля. К примеру видимости и порядок колонок бровсов, ширину этих колонок, цветовые настройки и пр. Раньше писал в INI, каких только изввратов не придумал. Бровсов много, параметров бровсов много в INI реализация вложенности на нуле.. А если еще и шифровать, так вообще пляски иначе продвинутые юзера туда лезли. Перешел на json и выдохнул., все структуры данных разложены как надо, вложенность и ветвления без ограничений. От дурака защита реализуется легко. В общем каждому своё 👍
SergKis: Haz пишет Бровсов много, параметров бровсов много в INI реализация вложенности на нуле.. Не соглашусь, т.к. еще со времен VO вариант ini для реализации окон и контролов работает на ура[pre2] [MAIN] Start = Form_1 ... [Form_1] Control_1 = [Label_1] Control_2 = [GetBox_1] Control_3 = [Browse_1] ... [Label_1] Row = .. Col = ... Width = ... Height = ... Value = ... ... [GetBox_1] .... [Browse_1] ... [/pre2] дерево строится практически как в xml Если исп. механизм LayOut (авто компоновка контролов на окне), то еще проще [MAIN] ... [Form_1] 01 = [Label_1], [GetBox_1] 02 = [Label_2], [GetBox_3], [Label_3], [GetBox_4] ... NN = [Browse_1] ...
Haz: SergKis пишет: дерево строится практически как в xml в том и дело , что нет желания строительством занимается.. Тут собрал структуру в хеш, и выплюнул в джсон и все. Обратно так же. С alias() работать для меня не вариант, база в ads на словарях, все под SQL. Сторонние таблицы явно проигрывают в удобстве хранения данных , так как требуют унификации полей. Мне в работе json проще и понятнее чем XML, компактнее , современнее и универсальное. Более торо , обмен в этом формате между разными системами реализуется проще, хоть через диск, хоть через порт , хоть через pipe и пр. Плюс для работы внешних редакторов полно любых. Так что не убедил 😎. Просто для себя взял стандартом. Конфигурации храню в json, обмен с 1с в json, коммуникации с Битрикс в json. Даже выгрузку из конструкторского по в кривом CSV , сначала гоню в json ( hash) а потом только разбираю. В общем дело привычки 🧐
Haz: SergKis пишет: Не соглашусь, т.к. еще со времен VO вариант ini для реализации окон и контролов работает на ура работает, но в json это проще делать тк вложенность ключей прямая а не косвенная
SergKis: Haz пишет Так что не убедил Особо не собираюсь, но ~ 20 справочников (до 20 строк, которые практически не меняются, типа пол: мужской, женский) подчитанных в 20 hash переменных и потом работа с ними и работа с 20 переменными объектов-контейнеров ... , она практически одинакова, только тебе надо оперировать hb_HSet\GetDef(<имя спр.>, ...), а мне <имя спр.>:имя ключа, т.е. мнемоника, или <имя спр.>:Get\Set(...), если это работа с html и js, то вариантов нет, json и при обратной обработке, дата - это проблема, т.е. полная привязка к именам json, не факт, что это совпадает с полями dbf-базы, т.е. строим какие то перекодировки. В общем дело привычки Это да, привычки в нашей жизни, РУЛЯТ. Мы как собаки Павлова, к чему привыкли, так и делаем,в др. случаях надо напрягаться, организм сопротивляется
SergKis: PS Разговор, вообще то шел о параметрах для программы, т.е. Там же написано single flag . т.е. один параметр одной строкой. На мой взгляд, параметры для программы проще передать, через ini, чем строкой, которую потом надо парсить. Т.е. для прогр. создаем ini (руками или программой не важно) и в запускаемой программе обрабатываем. Сделать Local oIni := oIniRead( ".\Start.ini", .T. ):COM ? oIni:nMode, oIni:... проще, чем что то другое, даже, если этого ini нет
SergKis: Haz пишет Тут собрал структуру в хеш, и выплюнул в джсон и все Тут, немного ты, скрыл алгоритм, для вложенных jcon, как секции в ini, т.е. надо построить примерно (как в demo4, в demo5 это скрыто внутри) такое по hash [pre2] 1 {"MAIN", {"CINI"=>"demo4.ini", "CCODE"=>"RU1251", "LUTF8"=>"F"}} 2 {"INFORMATION", {"PROGRAM"=>"C:\MiniGuiBcc58\SAMPLES\_Test\_2\demo4.exe", "FREE OPEN SOURCE SOFTWARE"=>"Harbour 3.2.0dev (r2104281802)", "FREE COMPILER"=>"Borland C++ 5.8.2 (32-bit)", "FREE LIBRARY"=>"Harbour MiniGUI Extended Edition 21.09.0 (32-bit) ANSI"}} 3 {"COM", {"NUMBER"=>"13", "STRING"=>"Строка пример / Example string", "LOGICAL"=>"F", "DATE"=>"29.09.21", "HOST"=>"127.0.0.1", "ALANGNAME"=>"Русский,Белорусский,Украинский,Латышский", "ALANGLIST"=>"RU,BE,UA,LV", "LANGUAGE"=>"RU"}} 4 {"RU", {"TITLE"=>"Демонстрация работы с ини-файлом через контейнер oHmgData()", "BTN_01"=>"Помощь", "BTN_02"=>"Настройки", "BTN_03"=>"Проверка", "BTN_04"=>"Выход"}} 5 {"EN", {"TITLE"=>"Demonstration of working with ini-file through the oHmgData() container", "BTN_01"=>"Help", "BTN_02"=>"Settings", "BTN_03"=>"Check", "BTN_04"=>"Exit"}} [/pre2] в примере это подается в объект, но можно подать это и json, перебрав секции и превратив ее в json, в целом, "хрен редьки не слаще", вопрос для каких целей делаем. Наглядности в сравнении с json5, json (hb ф-ии) мало дает, делая ключи в кавычках и как не крути json в hb слабоват, на мой взгляд, т.е. json в js (html) уже практически отсутствует, применяется json5, т.е. к тебе приходят данные в json5 их надо превратить в hash
Haz: SergKis пишет: Тут, немного ты, скрыл алгоритм, для вложенных jcon Да , утаил. Но он элементарный. Json5 проблем и пока не доставлял. Плюс автоматом экранирует служебные символы. К примеру заголовок с разделителями CRLF не нужно обрабатывать перед чтением или записью. Пользую давно, функционала хватает. И главное, как уже писал, могу сохранить на диск и 1С 7.7 спокойно эта прочтет и разберет своими штатными средствами (компонент под json полно). С навороченным INI в 1С придется попотеть, тк. нет там никаких объектов и oKeyData и логику разбора из харбур не перенести. Зачем мне две одинаковые по смыслу сущности , одну из которых не поднять в 1С ? Обмен с 1С через dbf только с виду прост, на деле проблем множество и тут пока только текстом через диск. Порт слушать 1С 7.7 не умеет, сообщения окну обрабатывать не чем, остается только pipe , а это тот же файловый обмен. Зато спасибо микрософту , элементарно из 1С шлется json в порт программы приемника. Вот и пришел к выводу, что мне удобнее json т.к он везде поддерживается и везде одинаков.
Haz: SergKis пишет: На мой взгляд, параметры для программы проще передать, через ini, чем строкой, которую потом надо парсить. Т.е. для прогр. создаем ini (руками или программой не важно) и в запускаемой программе обрабатываем тогда уж проще прям в коде забить. Хотя соглашусь, параметром может быть файл, где все разложено. так проще но не нужно. Андрею при отладке лень каждый раз эти параметры руками бить. Иначе при чем тут .hbp ? поэтому проще всего в коде
SergKis: Игорь, мы немного о разном. Ты об обмене данными со сторонними программами (тут от их правил не отпрыгнешь), а я о внутреннем употреблении в prg hmg с учетом языковых данных. 1C с 8-ой версии стала unicode, вроде, да и у вас редко стоит вопрос разных языковых текстов в prg (для Gui). А у нас язык на 1-м месте, Формы для России, ЕС, Латвии разные + тексты языковые к ним (клиент сам может правильно править перевод), так что приходится организовывать хранилища и ini простой и удобный вариант
Haz: SergKis пишет: мы немного о разном. Сергей, конечно о разном. Базовая реализация INI просто убогая. Твой пример погоняю раньше не натыкался на него и такую реализацию INI. Да, для ситуации когда (клиент сам может правильно править перевод) от незаменим.
SergKis: Haz пишет Андрею при отладке лень каждый раз эти параметры руками бить. Иначе при чем тут .hbp ? Как он написал параметры (назначение), то это 1-текст, 2-режим базы, 3-текст кнопки "ok" т.е. все может быть разным, в hbp он меняя набирает и отлаживает режимы prg, потом будет для них запуск ShellExecute с кнопок и меню, т.е. вид параметров my.exe {"bla bla bla",2021,"ok"} и потом внутри aParam := &cParam
Andrey: Сделайте пожалуйста пример на jcon в библиотеку МиниГуи ! Хотя я его 2-3 раза всего использовал, мне он не понравился, может и не распробовал.
SergKis: Andrey пишет Сделайте пожалуйста пример на jcon в библиотеку МиниГуи ! Поищи в SAMPLES "json" Нашел у себя еще и пример от 01.08.2020 на твоем массиве [pre2] /* * MINIGUI - Harbour Win32 GUI library Demo * * Copyright 2019 Verchenko Andrey <verchenkoag@gmail.com> */ ANNOUNCE RDDSYS #define _HMG_OUTLOG #include "hmg.ch" REQUEST HB_CODEPAGE_RU1251, HB_CODEPAGE_RU866 ///////////////////////////////////////////////////////////////////////// Function Main SET EPOCH TO ( Year(Date()) - 50 ) SET LANGUAGE TO RUSSIAN SET CODEPAGE TO RUSSIAN SET Date TO GERMAN SET MULTIPLE OFF WARNING SET FONT TO "Tahona", 16 SET OOP ON _SetGetLogFile( ChangeFileExt( Application.ExeName, ".log" ) ) fErase( _SetGetLogFile() ) ? "======================= Запуск программы - "+TIME() + " =======================" ? MiniGuiVersion() SET WINDOW MAIN OFF Test_Dim_json() SET WINDOW MAIN ON Return Nil ///////////////////////////////////////////////////////////////////// FUNCTION Test_Dim_json() LOCAL nI, aDim, tTime, cStr LOCAL cFileLog := ChangeFileExt( Application.ExeName, ".log" ) LOCAL cFileDim := ChangeFileExt( Application.ExeName, ".dim" ) LOCAL cFileJson := ChangeFileExt( Application.ExeName, ".json" ) LOCAL a,h,i,j,k,v,o, hDim aDim := {{13, "% Сбора", "=RC[-4]*100/RC[-5]", DATE()}, {14, "ЗП за;подъезд", '=ЕСЛИ(RC[-3]="общ";R1C3;ЕСЛИ(RC[-8]=0;R1C1;ЕСЛИ(И(1<=RC[-4];RC[-4]<9);R1C1;R1C2)))', DATE()}, {15, "####", "", DATE()}, {16, "% от;начисл.1", "=RC[-8]/100*R1C9", DATE()}, {17, "##", "", DATE()}, {18, "% от;начисл.2", "=RC[-10]/100*R2C9", DATE()}, {19, "##", "", DATE()}, {20, "% от;начисл.3", "=RC[-12]/100*R3C9", DATE()}, {21, "% Выплаты", "=100*RC[-8]/R2C9", DATE()}, {22, "ЗП мастеру;за п от %", "=RC[-8]/100*RC[-1]", DATE()}, {23, "ЗП мастеру", '=ЕСЛИ(RC[-12]="юл";RC[-9];ЕСЛИ(RC[-14]<RC[-7];0;ЕСЛИ(RC[-14]>RC[-3];RC[-9]/100*R3C7;RC[-9]/100*RC[-2])))', DATE()}} ? "------------------ пример массив -----------" ? "массив aDim=", aDim ; ?v aDim tTime := HB_DATETIME() // массив в файл HB_MemoWrit( cFileDim, HB_ValToExp(aDim) ) // строка из файла cStr := HB_MemoRead(cFileDim) cStr := ALLTRIM( cStr ) // чтобы было без ошибки IF AT( "{", cStr ) > 0 .AND. AT( "}", cStr ) > 0 aDim := &cStr ELSE aDim := {} // пустой массив ENDIF ? ; ? "------------------ пример json 1 ----------------" h := hb_hash() For i := 1 To Len(aDim) h[ StrZero(i,2) ] := aDim[ i ] Next cStr := hb_jsonEncode(h,.F.) ? "hb_jsonEncode(h,.F.) =", cStr HB_MemoWrit( ".\_h_.json", cStr) ? ; ? "------------------ пример json 2 ----------------" h := hb_hash() h["columnY"] := 5 h["color"] := { 251,250,174 } h["columns"] := aDim cStr := hb_jsonEncode(h,.F.) // json в файл hb_MemoWrit( cFileJson, cStr) ? "hb_jsonEncode(h,.F.) =", cStr // json из файла cStr := hb_MemoRead(cFileJson) a := hb_hash() hb_jsonDecode(cStr, @a) ? "json из файла ! кол-во элементов:", len(a) For i :=1 to len(a) ? hb_hKeyAt(a,i),"=>", v:= hb_hValueAt(a,i), valtype(v) Next ? x1 := a["columnY"] ; ? 'a["columnY"]'; ? x1 x2 := a["color"] ; ? 'a["color"] '; ? x2 ; ?v x2 x3 := a["columns"] ; ? 'a["columns"]'; ? x3 ; ?v x3 ? ; ? "------------------ пример json 3 ----------------" a:=hb_hash() a['dat'] := date() a['0'] := 222 a['TYP'] := "text" a['1'] := "text2" a['kod'] := 7777 ? "длинна массива:",len(a) ? "кодируем:" ? j:=hb_jsonEncode(a,.T.) ? k:=hb_jsonEncode(a,.F.) ? HB_MemoWrit( ".\_j_.json", j) HB_MemoWrit( ".\_k_.json", k) o := oKeyData() o:Set(a) hb_MemoWrit( "_o_.json", o:Json(.F.)) ? "декодируем обратно:" J := hb_memoread(".\_j_.json") ; h := J J := SubS( J, At ("{", J) ) J := Left( J, RAt("}", J) ) hb_jsonDecode(J,@a) ? "получена длинна массива:",len(a) for i:=1 to len(a) ? hb_hKeyAt(a,i),"=>",v:=hb_hValueAt(a,i),valtype(v) next ? a := oKeyData() ? "a = ", a:Json(h) ?v a:GetAll(.F.) ? "." ? "--- End test ----", HMG_TimeMS( tTime ) ShellExecute( 0, "Open", cFileLog,,, 1 ) RETURN NIL [/pre2]
Andrey: SergKis пишет: Нашел у себя еще и пример от 01.08.2020 на твоем массиве Это простой слишком пример. И только у меня. Это до ковида своего делал ещё. По поиску в библиотеке 3 примера всего, и непонятные. Что-нибудь интересней нужно в качестве примера.
Haz: Andrey пишет: Это простой слишком пример А что там может быть сложно? json строка это строковое соответствие хэш массива. Функции хеш в json и обратно есть в базе. Смысл примера непонятен.
Andrey: У меня 4 окна с таблицами WINDOWTYPE STANDARD которые можно открыть поочерёдно на экране. С каждой таблицы можно открыть ТОЛЬКО одну карточку - окно MODAL, это чтобы юзер не запутался ещё и в карточках. Можно ли заблокировать переключение на другие окна из MODAL окна. Т.е. если юзер открыл окно, то пока не закроет его, то пусть в нём и СИДИТ !!! А то если открыты другие таблицы, юзер пытается туда переключаться без закрытия окна предыдущей карточки. И переключается текущий алиас базы. Можно эти переключения на другие таблицы, как то блокировать ? Или заменять после переключения на таблицу от которой открыта карточка ? Предупреждение можно вывести в этот момент, типа закройте карточку, а потом переключайтесь на другую таблицу ?
Andrey: Нашёл пример SAMPLES\Advanced\AESDEMO - MiniGUI-23.09 Не собирается... Выдаёт ошибку: [pre2]Harbour 3.2.0dev (r2307062207) Copyright (c) 1999-2023, https://harbour.github.io/ D:\TEMP\hbmk_9mjo9p.dir\aesdemo.c: D:\TEMP\hbmk_iqc6dr.c: Turbo Incremental Link 5.69 Copyright (c) 1997-2005 Borland Error: Unresolved external '_HB_FUN_ENCRYPTFILEAES' referenced from D:\TEMP\HBMK_9MJO9P.DIR\AESDEMO.OBJ Error: Unresolved external '_HB_FUN_DECRYPTFILEAES' referenced from D:\TEMP\HBMK_9MJO9P.DIR\AESDEMO.OBJ hbmk2[aesdemo]: Error: Running linker. 2[/pre2] Что нужно добавить ? Есть ли ещё в МиниГуи функции шифрования/дешифрования файлов и строк ?
Dima: MiniGUI-23.09 MiniGUI-23.07 Собирается норм
Andrey: Собирал так: c:\MiniGui-23.09\batch\hbmk2.bat aesdemo.hbp из за этого и выдавало ошибку. Добавил в aesdemo.hbp строку -lhbaes и всё собралось ! Спасибо Dima
Dima: LOL
Andrey: Ну и что из этого ? Забыл что раньше делал, памяти после ковида нет совсем... Не доделал тогда тот пример у себя, заново сейчас до него руки дошли.
SergKis: Пример TrayBalloon с SET OOP ON тут https://TransFiles.ru/2b4pa Если кому интересно это
Andrey: Пытался из этого примера перенести в другой модуль, где весь С-код util_c_code.prg: [pre2]/* * C-level */ #pragma BEGINDUMP[/pre2] Не получается. Потом не собирается util_c_code.prg, выдаёт ошибку:[pre2] Harbour 3.2.0dev (r2307062207) Copyright (c) 1999-2023, https://harbour.github.io/ OBJ\util_c_code.c: Warning W8017 util_c_code.prg 94: Redefinition of '_WIN32_IE' is not identical Warning W8017 util_c_code.prg 95: Redefinition of '_WIN32_WINNT' is not identical Error E2451 util_c_code.prg 110: Undefined symbol 'NOTIFYICONDATA' in function ShowNotifyInfo Error E2379 util_c_code.prg 110: Statement missing ; in function ShowNotifyInfo Error E2451 util_c_code.prg 112: Undefined symbol 'nid' in function ShowNotifyInfo Error E2109 util_c_code.prg 112: Not an allowed type in function ShowNotifyInfo Error E2109 util_c_code.prg 114: Not an allowed type in function ShowNotifyInfo Error E2451 util_c_code.prg 118: Undefined symbol 'NIF_INFO' in function ShowNotifyInfo Error E2451 util_c_code.prg 126: Undefined symbol 'NIM_ADD' in function ShowNotifyInfo Warning W8065 util_c_code.prg 126: Call to function 'Shell_NotifyIcon' with no prototype in function ShowNotifyInfo Error E2451 util_c_code.prg 128: Undefined symbol 'NIM_DELETE' in function ShowNotifyInfo Warning W8065 util_c_code.prg 128: Call to function 'Shell_NotifyIcon' with no prototype in function ShowNotifyInfo Warning W8057 util_c_code.prg 132: Parameter 'hWnd' is never used in function ShowNotifyInfo *** 8 errors in Compile *** hbmk2[Demo]: Error: Running C/C++ compiler. 1[/pre2] Как можно это решить (перенести в отдельный модуль) ?
Alex_Cher: Пример TrayBalloon с SET OOP ON тут https://TransFiles.ru/2b4pa Если кому интересно это Сережа, файлика нет, обнови пожалуйста .....
SergKis: Не могу. Без компьютера. Только на телефоне. Может кто-нибудь выложит.
Andrey: Вот этот пример - https://cloud.mail.ru/public/KMmF/LqQp2UDHW
SergKis: Alex_Cher Собрал немного модифицированный пример, с иконками, тут https://TransFiles.ru/6wfob
Andrey: SergKis пишет: Собрал немного модифицированный пример, с иконками, тут Тестировал пример, работает и на Win7 ! В примере надо бы исправить IF IsWinNT() на Win7 и выше...
Andrey: Григорий, что мне делать ? Собираю свою большую прогу MiniGui 23.09.2 Перетасовал свой main.prg Теперь после запуска прога падает с ошибкой: [pre2]Error BASE/1004 Message not found: TWNDDATA:EVENT Args: [1] = O TWNDDATA Called from __ERRRT_SBASE(0) Called from TWNDDATA:ERROR(0) Called from (b)HBOBJECT(0) Called from TWNDDATA:MSGNOTFOUND(0) Called from TWNDDATA:EVENT(0) Called from MAIN(178) in module: Source\main.prg[/pre2] Вот код:[pre2] ? ProcNL(), Repl("*",10) + " DEFINE WINDOW " + Repl("*",10), "Set_bEvents('MyEventsHandler')" DoEvents() Set_bEvents( {|hH,nM,wP,lP| MyEventsHandler(hH,nM,wP,lP) } ) // блок кода обработчика событий программы DEFINE WINDOW Form_Main ; AT 0,0 WIDTH 640 HEIGHT 480 ; TITLE cTitle ICON cIcon ; MAIN NOSHOW ; NOMAXIMIZE NOSIZE NOCAPTION ; ON INIT {|| DoEvents(), _wPost(0) } ; ON RELEASE {|| _LogFile(.T., CRLF + ">>> STOP <<< " + HMG_TimeMS(App.Cargo:tStart) ) } ; ON INTERACTIVECLOSE {|| IIF( lStaticErrorClose, MyExit(), Nil ) } ? ProcNL(), Repl("*",10) + " DEFINE WINDOW " + Repl("*",10), "после" ... o := This.Object o:Event( 0, {|ow| // запуск при инициализации окна Local hWnd, cWnd hWnd := ow:Handle cWnd := ow:Name ? REPL(".", 90 ) ? SPACE(5) + ":Event(0)", ProcNL(), hWnd, IsIconic( hWnd ), cWnd, _HMG_MainHandle myInitForm() DO EVENTS _wSend(1, ow) // запуск события 1 DO EVENTS _wSend(2, ow) // запуск события 2 DO EVENTS _wPost(3, ow) // запуск события 3 Return Nil }) // <<<<<<------------- строка 178[/pre2]
Andrey: Есть такой рабочий код для проверки ранее запущенной программы. [pre2]/* * Проверка запуска программы на ВТОРУЮ копию программы * Check the start of the program on the second copy of the program */ FUNCTION OnlyOneInstance( cAppTitle ) LOCAL hWnd := FindWindowEx( ,,, cAppTitle ) IF hWnd # 0 iif( IsIconic( hWnd ), _Restore( hWnd ), SetForeGroundWindow( hWnd ) ) ExitProcess( 0 ) ENDIF RETURN NIL[/pre2] Код отлично работает с 2013 года, но есть подвох. Если MAIN окно сделать HIDE, то код перестаёт работать. Как это исправить, если MAIN окно всегда HIDE ?
PSP: Andrey пишет: ... LOCAL hWnd := FindWindowEx( ,,, cAppTitle ) ... Как это исправить, если MAIN окно всегда HIDE ? В интернетах пишут, что можно найти в хэндлу дочернего окна. Это - второй параметр этой функции.
Dima: Andrey пишет: Проверка запуска программы на ВТОРУЮ копию программы Для этого существует IsExeRunning
SergKis: Dima hWnd := FindWindowEx( ,,, cAppTitle ) позволяет проверять наличие программы по Title main окна, т.е. один запуск с таким заголовком IsExeRunning() - создает mutex, который проверяется на наличие, по default mutex такой _HMG_IsMultiple := IsExeRunning ( StrTran( GetExeFileName (), '\', '_' ) ) но можно mutex строить от full имени ini + [секция], т.е. несколько запусков exe, но разные параметры, например [pre2] PROCEDURE MAIN(cParam) Local cMutex Default cParam := "0" cMutex := StrTran( GetExeFileName ()+"_"+cParam, '\', '_' ) _HMG_IsMultiple := IsExeRunning ( cMutex ) SET MULTIPLE QUIT WARNING ... [/pre2]
Dima: Andrey а что кажет IsWindowVisible(hwnd) если окно скрыто ?
Andrey: Dima пишет: а что кажет IsWindowVisible(hwnd) если окно скрыто ? [pre2] ? " #### " + ProcNL(), cAppTitle, hWnd, IsWindowVisible(hWnd) Выдаёт в лог: #### Call from: ONLYONEINSTANCE(27) --> main_misc.prg Template of the finished program on MiniGui 263598 .F. [/pre2] Программа cAppTitle должна запускаться ТОЛЬКО ОДИН раз ! Повторные запуски из других каталогов - запретить ! Программа cAppTitle имеет всегда видимое окно Forma_MenuMain. Нужно достучаться до второго окна допустим Forma_MenuMain. И если уже ранее было запущено, то поднять нужно на передний план экрана. Это можно как то сделать ?
Andrey: Фигня какая то при выводе больших строк в AlertInfo(): Как это исправить ?
SergKis: Andrey Выведи весь список Label и увидишь, что они формируются по окну, т.е. длинные строки разбиваются на несколько Label, делай как надо сам, например так [pre2] /* * MINIGUI - Harbour Win32 GUI library Demo */ #define _HMG_OUTLOG #include "hmg.ch" #include "TSBrowse.ch" /////////////////////////////////////////////////////////////////////////////// FUNCTION Main() LOCAL aGrOver, aBtn, aGrFill, aGrOverX, aGrFillX LOCAL cLog := "_msg.log" SET OOP ON _SetGetLogFile(cLog) ; fErase(cLog) // Button Colors aGrOver := { { 0.5, CLR_BLACK, CLR_VK }, { 0.5, CLR_VK , CLR_BLACK } } aGrFill := { { 0.5, CLR_VK , CLR_WHITE }, { 0.5, CLR_WHITE , CLR_VK } } aGrOverX := { { 0.5, CLR_RED , CLR_HRED }, { 0.5, CLR_HRED , CLR_RED } } aGrFillX := { { 0.5, CLR_HRED , CLR_WHITE }, { 0.5, CLR_WHITE , CLR_HRED } } aBtn := {} // 1.NameObj 2.Text 3.ExtFuncRun or CodeBlock 4.Icons.5 6.Colors.7 8.HotKey 9.nFSize AADD( aBtn, { "Btn_01", "1. Selection menu (pg)", {|p1,p2,p3,p4| MyTest(1,p1,p2,p3,p4)} , "iSantax1", "iSantax2", aGrOver , aGrFill , { VK_F1, 49 }, 0 } ) AADD( aBtn, { "Btn_02", "2. Selection menu (pg)", {| | MyTest(2) } , "iFolder1", "iFolder2", aGrOver , aGrFill , { VK_F2, 50 }, 0 } ) AADD( aBtn, { "Btn_03", "3. Selection menu (pg)", "MyTest(3)" , "iHPx1" , "iHPx2" , aGrOver , aGrFill , { VK_F3, 51 }, 0 } ) AADD( aBtn, { "Btn_04", "4. Selection menu (pg)", "MyTest(4)" , "iHMGx1" , "iHMGx2" , aGrOver , aGrFill , { VK_F4, 52 }, 0 } ) AADD( aBtn, { "Btn_05", "Exit programm" , "MyExit(99)" , "iExitx1" , "iExitx2" , aGrOverX, aGrFillX, VK_ESCAPE , 0 } ) ToAlertDim(aBtn) RETURN NIL ////////////////////////////////////////////////////// FUNCTION MyTest( nPar, oWnd, nBtn, aSel, aBtn ) MsgDebug( nPar, pCount(), Valtype(oWnd), Valtype(nBtn), Valtype(aSel), Valtype(aBtn) ) RETURN Nil //////////////////////////////////////////////////////////////////////////// FUNCTION ToAlertDim(aBtn) LOCAL bOnInit, aColors, cText := "" // for HMG_Alert() and AlertXXX() DEFINE FONT DlgFont FONTNAME "DejaVu Sans Mono" SIZE 10 SET MSGALERT BACKCOLOR TO {248,209,211} aColors := { { 210, 225, 240 }, { 210, 225, 240 } } ?v aBtn ? cText := "" AEval(Array(Len(aBtn)), {|a| a := repl("*", 50), cText += a + CRLF}) bOnInit := {|| // свои параметры окна Local nW := System.DesktopWidth * 0.95 Local ow := ThisWindow.Object Local oc, cv, nn, nL, nG := 10 This.Width := nW This.Center nL := This.ClientWidth - This.Say_01.Col - nG ? "window Width", This.Width, ow:Width, nL ? ?v aBtn ? FOR EACH oc IN ow:GetObj4Type("LABEL") nn := hb_enumindex(oc) cv := hb_ntos(nn) + ". " + hb_valtoexp(aBtn[ nn ]) ? nn, oc:type, oc:name, oc:Width, cv oc:Width := nL oc:Value := cv NEXT This.Btn_01.Col := This.ClientWidth - This.Btn_01.Width - nG This.Btn_01.SetFocus Return Nil } //AlertInfo( Message, Title, Icon, nSize, aColors, lTopMost, bInit, lNoSound ) AlertInfo(cText,'Menu Array', , ,aColors, .F. /*topmost*/, bOnInit, .T.) RETURN cText [/pre2]
Andrey: Спасибо БОЛЬШОЕ !
Andrey: Есть окно с POPUP меню. Что нужно поставить в ON INIT, чтобы при запуске это меню открывалось ? [pre2] DEFINE WINDOW Win1 AT 0, 0 WIDTH System.DesktopWidth HEIGHT 90 ; TITLE PROGRAM MAIN ON INIT {|| Nil } DEFINE MAIN MENU DEFINE POPUP 'Menu examples' MENUITEM 'Menu without icons' ACTION ... MENUITEM 'Menu with icons' ACTION ... Separator MENUITEM 'Exit' ACTION Win1.Release() END POPUP END MENU END WINDOW[/pre2]
Andrey: Пример \MiniGUI\SAMPLES\BASIC\ButtonEx_3 Там есть команды: [pre2] PICTALIGNMENT TOP PICTALIGNMENT LEFT PICTALIGNMENT RIGHT PICTALIGNMENT BOTTOM[/pre2] А как можно задать такие команды после построения кнопки ? Т.е. через SetProperty ( ххх, ххх, , ) Что-то в доке такого нет вообще...
gfilatov2002: Andrey пишет: Пример \MiniGUI\SAMPLES\BASIC\ButtonEx_3 Там есть команды: PICTALIGNMENT TOP PICTALIGNMENT LEFT PICTALIGNMENT RIGHT PICTALIGNMENT BOTTOM Эти команды предназначены только для совместимости с кодом официальной версии HMG. Это было сделано для удобства миграции кода с HMG в МиниГуи. Все подробности надо см. в файле minigui\include\i_hmgcompat.ch
Andrey: Понял. Надоело писать много IF в коде с кнопками, например в APP_OOPTEMPLATE функция util_button.prg Там сплошные IF.... Хотелось бы просто задавать свойства кнопки через SetProperty ( ххх, ххх, , ) или так This.&(cObj).Action := {|| .... } Кстати ещё вопрос, а можно после построения кнопки задать MOUSEHOVER и MOUSELEAVE ? [pre2] @ y, x BUTTONEX &cObj PARENT &cForm ; ... FONT aFnt[1] SIZE aFnt[2] BOLD VERTICAL ; ON MOUSEHOVER ( This.Backcolor := aBtnClr[2] , This.Fontcolor := aFntClr[2] ,; This.Icon := LoadIconByName(aIcon[2],nSizeIcon,nSizeIcon) ); ON MOUSELEAVE ( This.Backcolor := aBtnClr[1] , This.Fontcolor := aFntClr[1] ,; This.Icon := LoadIconByName(aIcon[1],nSizeIcon,nSizeIcon) ); [/pre2]
gfilatov2002: Andrey пишет: можно после построения кнопки задать MOUSEHOVER и MOUSELEAVE ? Да, это возможно в такой форме: This.Btn_01.OnGotFocus := {|| DrawRR( RED ) } This.Btn_01.OnLostFocus := {|| DrawRR( .F. ) } Рабочий пример demo9.prg см. в папке \minigui\SAMPLES\Advanced\Tsb_Basic_3
Andrey: Спасибо БОЛЬШОЕ ! Заработало у меня. Ещё вопрос по кнопкам: [pre2] @ .. BUTTONEX &cObj .... ; ..... IIF(lTextVert, VERTICAL, Nil) ; // так можно ? IIF(lTextLeft, LEFTTEXT, Nil) ; // так можно ? ON INIT {|| This.Cargo := nwPost } ; .....[/pre2] Попробовал, не компилируется.... Я вспомнил, что задавал этот вопрос, вы советовали использовать другой синтаксис этой команды. Григорий, можно как то добавить свойства для этого - SetProperty ( ххх, ххх, , ) ? Примерно такого нового синтаксиса: [pre2] ICO_LEFT 0 ICO_RIGHT 1 ICO_TOP 2 ICO_BOTTOM 3 .... SetProperty( ххх, ххх, "PICTALIGNMENT", ICO_LEFT ) или This.&(cObj).PICTALIGNMENT := ICO_BOTTOM [/pre2]
полная версия страницы