Форум » 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.

Ответов - 127, стр: 1 2 3 4 5 6 7 All

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(...) работает



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