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

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

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

Ответов - 300, стр: 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 All

SergKis: gfilatov2002 Поправил в своей lib[pre2] *------------------------------------------------------------------------------* FUNC Do_Obj( nHandle, bBlock, p1, p2, p3 ) *------------------------------------------------------------------------------* LOCAL o If empty (nHandle) ; nHandle := _HMG_ThisFormName ElseIf HB_ISOBJECT(nHandle) If nHandle:ClassName == 'TSBROWSE'; nHandle := nHandle:cParentWnd Else ; nHandle := nHandle:Name EndIf EndIf If HB_ISCHAR(nHandle) ; nHandle := GetFormHandle( nHandle ) EndIf If hmg_IsWindowObject(nHandle) o := hmg_GetWindowObject(nHandle) If HB_ISCHAR(bBlock); bBlock := hb_macroblock( bBlock ) EndIf If HB_ISBLOCK(bBlock) IF o:IsWindow; RETURN Do_WindowEventProcedure ( bBlock, o:Index, o, p1, p2, p3 ) ELSE ; RETURN Do_ControlEventProcedure ( bBlock, o:Index, o, p1, p2, p3 ) ENDIF EndIf Endif RETURN o Для исп. в командах (короче писать), к прмеру #translate doObj( <blk> ) => Do_Obj ( nil , <"blk"> ) #translate doObj( <blk> , <wnd> ) => Do_Obj ( <"wnd">, <"blk"> ) #translate _doObj( <blk> ) => Do_Obj ( nil , <"blk"> ) #translate _doObj( <blk> , <wnd> ) => Do_Obj ( <wnd> , <"blk"> ) #translate wObj( ) => _WindowObj ( _HMG_ThisFormName ) #translate wObj( <wnd> ) => _WindowObj ( <"wnd"> ) #translate _wObj( ) => _WindowObj ( _HMG_ThisFormName ) #translate _wObj( <wnd> ) => _WindowObj ( <wnd> ) #translate gObj( <ctl> ) => _ControlObj( <"ctl">, _HMG_ThisFormName ) #translate gObj( <ctl> , <wnd> ) => _ControlObj( <"ctl">, <wnd> ) #translate _gObj( <ctl> ) => _ControlObj( <ctl> , _HMG_ThisFormName ) #translate _gObj( <ctl> , <wnd> ) => _ControlObj( <ctl> , <wnd> ) [/pre2]

gfilatov2002: SergKis пишет: Поправил в своей lib Благодарю за внимание! Мы уже обсуждали, что подготовкой входных параметров в идеале должна заниматься вызывающая функция Это позволяет делать функции в ядре компактными По этой причине не принято...

SergKis: gfilatov2002 пишет Это позволяет делать функции в ядре компактными Был не прав, вспылил.


gfilatov2002: Всем кому это интересно Подготовил beta 3 для новой сборки библиотеки со следующим списком изменений [pre2] * Fixed: Missed 'XObject' property reference in the GetProperty() function. Contributed by Grigory Filatov <gfilatov@inbox.ru> (see demos in folder \samples\Advanced\GoogleCharts) * Modified: Added Min and Max range for the NON CLIENT attributes of windows according to the Windows requirements. Contributed by Grigory Filatov <gfilatov@inbox.ru> * Enhanced: Added the useful function EnumChildWindows( hWnd [, lExt] ) for retrieving of array of the child windows for a parent window handle. This implementation is compatible with Official HMG if a second parameter is false (default value). Based upon a contribution of Petr Chornyj <myorg63/at/gmail.com>. Contributed by Grigory Filatov <gfilatov@inbox.ru> (see SumatraPDF.prg in folder \samples\Advanced\PdfView) * Updated: Synchronized Extended HMG for compatibility with Official HMG: - New: SET DIALOGBOX POSITION: Sets the position of the dialog boxes (GetColor, GetFile, GetFolder, GetFont, MessageBoxTimeout, MsgXXX, PutFile, SELECT PRINTER, etc.) Added the following commands: - SET DIALOGBOX [ POSITION ] ROW <nRow>|<@VarCodeBlockRow>|<NIL> ; COL <nCol>|<@VarCodeBlockCol>|<NIL> - SET DIALOGBOX [ POSITION ] CENTER OF PARENT - SET DIALOGBOX [ POSITION ] CENTER OF <hWnd> - SET DIALOGBOX [ POSITION ] CENTER OF DESKTOP - SET DIALOGBOX [ POSITION ] DISABLE Based upon a contribution of Claudio Soto <srvet@adinet.com.uy>. Adapted for Minigui Extended by Grigory Filatov <gfilatov@inbox.ru> (see demo in folder \samples\Advanced\MoveDialogBox) * Updated: 'MiniGUI Extended Edition Common Commands' list: - added the recent entered commands. Contributed by Grigory Filatov <gfilatov@inbox.ru> (look at commands.txt in folder \Doc) * Updated: Adaptation FiveWin Class TSBrowse 9.0 in HMG: - New: added the optional OBJ clause in DEFINE TBROWSE command. - New: added the optional ALIAS clause in DEFINE COLUMN command and the variable :cField in TSColumn class. - New: methods DefColor()(), DefFont() and Clone() in TSColumn class. - New: methods SaveProperty() and RestProperty() in TSColumn class. - New: methods SetProperty() and GetProperty() in TSColumn class. - Updated: improved the methods GetValue(xCol) and SetValue(xCol, xVal). - Updated: improved a colors processing with using of aColors items number, f.e. { CLR_TEXT, RGB( fontcolor[1], fontcolor[2], fontcolor[3] ) } { CLR_PANE, RGB( backcolor[1], backcolor[2], backcolor[3] ) }. Suggested and contributed by Sergej Kiselev (see demo in folder \samples\Advanced\APP_OOPCOLUMNS) * New: 'Using DEFINE COLUMN commands as container for design of TBROWSE' sample. Contributed by Sergej Kiselev (see in folder \samples\Advanced\APP_OOPCOLUMNS) * New: 'Get Tasks' sample is based on calling of EnumChildWindows() function. Contributed by Grigory Filatov <gfilatov@inbox.ru> (see in folder \samples\Advanced\GETTASKS) * New: 'Google Charts' samples: using of a static image and a html file. Based upon a contribution of HMG user Edward. Adapted for Minigui Extended by Grigory Filatov <gfilatov@inbox.ru> (see in folder \samples\Advanced\GoogleCharts) * New: 'TSBrowse Export data to XLS/XML/DOC/DBF files with a coloring' sample. Contributed by Verchenko Andrey <verchenkoag@gmail.com> (see in folder \samples\Advanced\Tsb_Export) * Updated: 'Move a standard dialog box in the screen' sample: - added an example of centering of the GetFolder() dialog related to an application's window. Contributed by Grigory Filatov <gfilatov@inbox.ru> (see in folder \samples\Advanced\MoveDialogBox) * Updated: The following samples are revised for compatibility with the recent Minigui modification: - demo2.prg in folder \samples\Advanced\ExternalApp_3; - demo3.prg in folder \samples\Basic\TaskDialogs\TTaskDialog. Contributed by Grigory Filatov <gfilatov@inbox.ru> [/pre2] Благодарю за Ваше внимание Особая благодарность Сергею Киселеву за неоценимую помощь в развитии библиотеки TsBrowse

SergKis: gfilatov2002 Если модальному окну добавить свойство lFocusBreack := [.F.]\.T. Добавить в место, где обработка потери фокуса мод. окном с морганием, проверку lFocusBreack. Если .T., не моргать, а завершать мод.окно (как по X), будет похоже на child поведение под модал родителем

SergKis: PS В команду[pre2] #command ADD [ COLUMN ] TO [ TBROWSE ] <oBrw> ; ...[/pre2] надо добавить ALIAS, тогда в команде ADD COLUMN ... DATA hb_macroblock(...) ... ALIAS ... поведение аналогично DEFINE COLUMN будет

gfilatov2002: SergKis пишет: надо добавить ALIAS, тогда в команде ADD COLUMN Да, это было сделано сразу при модификации аналогично DEFINE COLUMN SergKis пишет: Если модальному окну добавить свойство lFocusBreack Предложение интересное, но требуется небольшой пример для проверки этого нового свойства

SergKis: gfilatov2002 пишет требуется небольшой пример Свойство условное, имел ввиду такое[pre2] FUNCTION _DefineModalWindow ( FormName, Caption, x, y, w, h, Parent, nosize, nosysmenu, nocaption, aMin, aMax, ; ... NoAutoRelease, InteractiveCloseProcedure, MoveProcedure, DropProcedure, clientwidth, clientheight, lLostExit ) ... _HMG_aFormMiscData1 [ k ] := {lLostExit} ... [/pre2] В обработчике, при потере фокуса на окне типа 'M' проверить разрешен выход или нет.

SergKis: PS в команду #xcommand DEFINE WINDOW <w> ; добавить [pre2] [ <helpbutton: HELPBUTTON> ] ; [ <FocusExit: FOCUSEXIT> => ; DECLARE WINDOW <w> ;; ... к примеру [/pre2]

gfilatov2002: SergKis пишет: Свойство условное Решил назвать это свойство модального окна FLASHEXIT и сохранять его в элементе массива _HMG_aFormFocused [ i ] У меня уже работает следующий пример: [pre2]#include "Minigui.ch" ************* function MAIN ************* DEFINE WINDOW cDlgMain AT 0 , 0 WIDTH 400 HEIGHT 300 TITLE "Main" MAIN DEFINE BUTTONEX ButtonEX_1 ROW 225 COL 79 WIDTH 100 HEIGHT 30 CAPTION "Child&Modal" ICON NIL ACTION CHILD_MODAL() END BUTTONEX DEFINE BUTTONEX ButtonEX_2 ROW 225 COL 219 WIDTH 100 HEIGHT 30 CAPTION "&Quit" ICON NIL ACTION cDlgMain.release END BUTTONEX END window cDlgMain.center cDlgMain.activate return NIL ************************* static function CHILD_MODAL ************************* IF iswindowdefined(cDlgChild1) doMethod( "cDlgChild1", "SETFOCUS" ) return NIL ENDIF DEFINE WINDOW cDlgChild1 AT 0 , 0 WIDTH 400 HEIGHT 300 TITLE "Child" CHILD ; ON GOTFOCUS iif((i := GetFormIndex( "cDlgModal1" )) > 0, _HMG_aFormFocused [ i ] := .T., THIS.TITLE := "GOTFOCUS") END window DEFINE WINDOW cDlgModal1 AT 0 , 0 WIDTH 100 HEIGHT 100 TITLE "Modal" MODAL ; ON LOSTFOCUS cDlgChild1.TITLE := "FLASHEXIT" END window cDlgChild1.center activate window cDlgModal1, cDlgChild1 return NIL [/pre2] Прошу проверить и подтвердить, что я двигаюсь в правильном направлении

gfilatov2002: P.S. В файле h_events.prg сделал такую вставку [pre2]... IF iswinnt() .OR. _HMG_aFormType [ i ] != 'M' BringWindowToTop ( _HMG_ActiveModalHandle ) FOR x := 1 TO Len ( _HMG_aFormHandles ) IF _HMG_aFormHandles [x] == _HMG_ActiveModalHandle .AND. _HMG_aFormFocused [x] PostMessage( _HMG_ActiveModalHandle, WM_CLOSE, 0, 0 ) ENDIF NEXT x ENDIF ... [/pre2]

SergKis: gfilatov2002 пишет Прошу проверить Более наглядный пример (по мне)[pre2] #include "Minigui.ch" ************* function MAIN ************* SET OOP ON DEFINE WINDOW cDlgMain AT 0 , 0 WIDTH 400 HEIGHT 300 TITLE "Main" MAIN WITH OBJECT This.Object // ---- Window events :Event( 01, {|ow | Modal_1(ow) } ) :Event( 99, {|ow | ow:Release() } ) END WITH // ---- Window events DEFINE BUTTONEX ButtonEX_1 ROW 225 COL 79 WIDTH 100 HEIGHT 30 CAPTION "Modal 1" ICON NIL ACTION (ThisWindow.Object):PostMsg(1) END BUTTONEX DEFINE BUTTONEX ButtonEX_2 ROW 225 COL 219 WIDTH 100 HEIGHT 30 CAPTION "&Quit" ICON NIL ACTION (ThisWindow.Object):PostMsg(99) END BUTTONEX END window cDlgMain.center cDlgMain.activate return NIL ************************* static function MODAL_1( oParent ) ************************* LOCAL y := App.Row+40 LOCAL x := App.Col+40 DEFINE WINDOW cModal1 AT y, x WIDTH 400 HEIGHT 300 TITLE "Modal 1" MODAL WITH OBJECT This.Object // ---- Window events :Event( 01, {|ow | _HMG_aFormFocused [ ow:Index ] := .F., ; Modal_2(ow) } ) :Event( 02, {|ow | _HMG_aFormFocused [ ow:Index ] := .T., ; oParent:SetFocus('ButtonEX_1') } ) :Event( 99, {|ow | ow:Release() } ) END WITH // ---- Window events DEFINE BUTTONEX ButtonEX_1 ROW 225 COL 79 WIDTH 100 HEIGHT 30 CAPTION "Modal 2" ICON NIL ACTION (ThisWindow.Object):PostMsg(1) END BUTTONEX DEFINE BUTTONEX ButtonEX_2 ROW 225 COL 219 WIDTH 100 HEIGHT 30 CAPTION "Focus Main" ICON NIL ACTION (ThisWindow.Object):PostMsg(2) END BUTTONEX END window Activate window cModal1 return NIL ************************* static function MODAL_2( oParent ) ************************* LOCAL y := App.Row+80 LOCAL x := App.Col+80 DEFINE WINDOW cModal2 AT y, x WIDTH 400 HEIGHT 300 TITLE "Modal 2" MODAL WITH OBJECT This.Object // ---- Window events :Event( 01, {|ow| _HMG_aFormFocused [ ow:Index ] := .T., ; oParent:SetFocus('ButtonEX_1') } ) :Event( 99, {|ow| ow:Release() } ) END WITH // ---- Window events DEFINE BUTTONEX ButtonEX_1 ROW 225 COL 79 WIDTH 100 HEIGHT 30 CAPTION "Focus Modal 1" ICON NIL ACTION (ThisWindow.Object):PostMsg(1) END BUTTONEX END window Activate window cModal2 return NIL [/pre2] С модал 1 фокус на маин окно и с маин 2 фокус на маин 1. Если нажав на модал 1 кнопку Focus Main, переключить на far и обратно - срабатывает, модал 1 уходит.

SergKis: SergKis пишет С модал 1 фокус на маин окно и с маин 2 фокус на маин 1. читать С модал 1 фокус на маин окно и с модал 2 фокус на модал 1.

SergKis: gfilatov2002 Такой манипуляцией, запустил child окно под modal [pre2] ************************* static function MODAL_2( oParent ) ************************* LOCAL y := App.Row+80 LOCAL x := App.Col+80 LOCAL m := _HMG_IsModalActive LOCAL h := _HMG_ActiveModalHandle _HMG_IsModalActive := .F. _HMG_ActiveModalHandle := 0 DEFINE WINDOW cModal2 AT y, x WIDTH 400 HEIGHT 300 TITLE "Modal 2" CHILD ON GOTFOCUS This.Release ... [/pre2]

SergKis: SergKis пишет Такой манипуляцией, запустил child окно под modal Работающий вариант с modal окна запустить child окно (это против системы). Функция на замену к примеру выше [pre2] ************************* static function MODAL_2( oParent ) ************************* LOCAL y := App.Row+80 LOCAL x := App.Col+80 LOCAL lM := _HMG_IsModalActive LOCAL hM := _HMG_ActiveModalHandle _HMG_IsModalActive := .F. _HMG_ActiveModalHandle := 0 DEFINE WINDOW cModal2 AT y, x WIDTH 400 HEIGHT 300 TITLE "Child" CHILD ; ON LOSTFOCUS do_Obj(ThisWindow.Handle, {|ow| ow:PostMsg(99) }) WITH OBJECT This.Object // ---- Window events :Event( 01, {|ow| oParent:SetFocus('ButtonEX_1') } ) :Event( 99, {|ow| ow:Release() } ) END WITH // ---- Window events DEFINE BUTTONEX ButtonEX_1 ROW 225 COL 79 WIDTH 100 HEIGHT 30 CAPTION "Focus Modal 1" ICON NIL ACTION (ThisWindow.Object):PostMsg(01) END BUTTONEX END window Activate window cModal2 _HMG_IsModalActive := lM _HMG_ActiveModalHandle := hM oParent:SetFocus('ButtonEX_1') return NIL [/pre2]

SergKis: gfilatov2002 Сделал в своей версии [pre2] CLASS TSColumn ... DATA bSeek // ... METHOD DrawLine( xRow ) CLASS TSBrowse ... If ::lIsArr .and. ( ::lAppendMode .or. ::nAt > Len( ::aArray ) ) uData := "" // append mode for arrays Elseif cColAls != Nil If Valtype( oColumn:bSeek ) == 'B' ( cColAls )->( Eval( oColumn:bSeek, Self, nJ ) ) EndIf uData := ( cColAls )->( Eval( oColumn:bData ) ) Else If Valtype( oColumn:bSeek ) == 'B' Eval( oColumn:bSeek, Self, nJ ) EndIf uData := Eval( oColumn:bData ) EndIf ... METHOD DrawSelect( xRow, lFoot ) CLASS TSBrowse ... If ::lIsArr .and. ( ::lAppendMode .or. ::nAt > Len( ::aArray ) ) uData := "" // append mode for arrays Elseif cColAls != Nil If Valtype( oColumn:bSeek ) == 'B' ( cColAls )->( Eval( oColumn:bSeek, Self, nJ ) ) EndIf uData := ( cColAls )->( Eval( oColumn:bData ) ) Else If Valtype( oColumn:bSeek ) == 'B' Eval( oColumn:bSeek, Self, nJ ) EndIf uData := Eval( oColumn:bData ) EndIf ... [/pre2] Может полезно будет. Без relation, сечас, в блоке :bData делаем подвод, с :bSeek можно разделить подвод и :bData : oBrw:aColumns[5]:bSeek := {|obr| iif( obr:cAlias->FLD_3 == STAT, .T., dbSeek( obr:cAlias->FLD_3 ) ) }

gfilatov2002: SergKis пишет: Может полезно будет. Добавил, поскольку Вы находите это полезным Благодарю за помощь

SergKis: Григорий, чем у Вас завершилось свойство модального окна FLASHEXIT У меня срабатывало, при уст. фокуса на внешнее приложении, к примеру Far. На своих окнах hmg -> не срабатывало. Завершил костылем, modal -> child, похожий костыль работает MDI child -> modal давно и стабильно.

gfilatov2002: SergKis пишет: чем у Вас завершилось Завершилось тем, что переписал этот кусок следующим образом: [pre2]... IF _HMG_IsModalActive .AND. Empty ( _HMG_InplaceParentHandle ) .AND. ; ( _HMG_aFormVirtualWidth [ i ] == 0 .OR. _HMG_aFormVirtualHeight [ i ] == 0 ) .AND. ; _HMG_SplitLastControl != "TOOLBAR" IF _HMG_aFormType [ i ] != 'M' IF iswinnt() IF ! _OnFlashExit () BringWindowToTop ( _HMG_ActiveModalHandle ) // Form's caption blinking if a top window is not Modal window FlashWindowEx ( _HMG_ActiveModalHandle, 1, 5, 60 ) ENDIF ELSE IF ! _OnFlashExit () BringWindowToTop ( _HMG_ActiveModalHandle ) ENDIF ENDIF ENDIF ENDIF ... *-----------------------------------------------------------------------------* STATIC FUNCTION _OnFlashExit () *-----------------------------------------------------------------------------* LOCAL x, lExit := .F., nFormCount := Len ( _HMG_aFormNames ) FOR x := 1 TO nFormCount IF _HMG_aFormHandles [x] == _HMG_ActiveModalHandle .AND. _HMG_aFormFocused [x] PostMessage ( _HMG_ActiveModalHandle, WM_CLOSE, 0, 0 ) lExit := .T. EXIT ENDIF NEXT x RETURN lExit [/pre2] Критика принимается...

SergKis: gfilatov2002 пишет переписал этот кусок следующим образом Не понял, как работает ? Простой пример [pre2] #include "Minigui.ch" ************* function MAIN ************* DEFINE WINDOW wMain AT 0 , 0 WIDTH 400 HEIGHT 300 TITLE "Main" MAIN DEFINE BUTTONEX ButtonEX_1 ROW 225 COL 79 WIDTH 100 HEIGHT 30 CAPTION "Modal" ICON NIL ACTION MODAL() END BUTTONEX DEFINE BUTTONEX ButtonEX_2 ROW 225 COL 219 WIDTH 100 HEIGHT 30 CAPTION "&Quit" ICON NIL ACTION ThisWindow.release END BUTTONEX END window wMain.center wMain.activate return NIL ************************* static function MODAL() ************************* DEFINE WINDOW wModal AT 0, 0 WIDTH 100 HEIGHT 100 TITLE "Modal" MODAL ; _HMG_aFormFocused [ This.Index ] := .T. DEFINE BUTTONEX ButtonEX_1 ROW 20 COL 40 WIDTH 100 HEIGHT 30 CAPTION "To wMain" ICON NIL ACTION wMain.ButtonEX_1.SetFocus() END BUTTONEX END window wModal.center wModal.activate return NIL [/pre2] Два окна. wMain -> wModal, на modal ставлю _HMG_aFormFocused [ This.Index ] := .T., при потере фокуса по кнопке или клику по main окну, modal должна убраться. Остается.

gfilatov2002: SergKis пишет: при потере фокуса по кнопке или клику по main окну, modal должна убраться. Работает немного по-другому: модальное окно закрывается при вызове после него любого дочернего окна. Если свойство FlashExit у модального окна не определено, то оно не даст переключиться на новое окно и будет "мигать"

SergKis: gfilatov2002 пишет модальное окно закрывается при вызове после него любого дочернего окна Принимает только след. модальное wModal2 (wChild не проходит) и wModal не уходит, остается. С FlashExit, думалось, будет работать, как костыль на modal -> child, т.е. modal -> modlal2, при потере фокуса modal2 уходит, как child с ON LOSTFOCUS ThisWindow.Release. Исп. это при замене COMBOBOX на окно с TsBROWSE

SergKis: PS Не ту кнопку нажал. Текст примера [pre2] #include "Minigui.ch" ************* function MAIN ************* DEFINE WINDOW wMain AT 0 , 0 WIDTH 400 HEIGHT 300 TITLE "Main" MAIN DEFINE BUTTONEX ButtonEX_1 ROW 225 COL 79 WIDTH 100 HEIGHT 30 CAPTION "Modal" ICON NIL ACTION MODAL() END BUTTONEX DEFINE BUTTONEX ButtonEX_2 ROW 225 COL 219 WIDTH 100 HEIGHT 30 CAPTION "&Quit" ICON NIL ACTION ThisWindow.release END BUTTONEX END window wMain.center wMain.activate return NIL ************************* static function MODAL() ************************* DEFINE WINDOW wModal AT 0, 0 WIDTH 200 HEIGHT 200 TITLE "Modal" MODAL _HMG_aFormFocused [ This.Index ] := .T. DEFINE BUTTONEX ButtonEX_1 ROW 20 COL 40 WIDTH 100 HEIGHT 30 CAPTION "Modal 2" // CAPTION "Child" ICON NIL ACTION MODAL2() // ACTION CHILD() END BUTTONEX END window wModal.center wModal.activate return NIL ************************* static function MODAL2() ************************* DEFINE WINDOW wModal2 AT 0 , 0 WIDTH 100 HEIGHT 100 TITLE "Modal 2" MODAL END window wModal2.center wModal2.activate return NIL ************************* static function CHILD() ************************* DEFINE WINDOW wChild AT 0 , 0 WIDTH 100 HEIGHT 100 TITLE "Child" CHILD END window wChild.center wChild.activate return NIL [/pre2]

gfilatov2002: SergKis пишет: Принимает только след. модальное wModal2 (wChild не проходит) У меня работает с wChild такой пример (немного переработанный): [pre2] #include "Minigui.ch" ************* function MAIN ************* DEFINE WINDOW wMain AT 0 , 0 WIDTH 400 HEIGHT 300 TITLE "Main" MAIN DEFINE BUTTONEX ButtonEX_1 ROW 225 COL 79 WIDTH 100 HEIGHT 30 CAPTION "Modal" ICON NIL ACTION MODAL() END BUTTONEX DEFINE BUTTONEX ButtonEX_2 ROW 225 COL 219 WIDTH 100 HEIGHT 30 CAPTION "&Quit" ICON NIL ACTION ThisWindow.release END BUTTONEX END window wMain.center wMain.activate return NIL ************************* static function MODAL() ************************* DEFINE WINDOW wModal AT 0, 0 WIDTH 200 HEIGHT 200 TITLE "Modal" MODAL _HMG_aFormFocused [ This.Index ] := .T. DEFINE BUTTONEX ButtonEX_1 ROW 20 COL 40 WIDTH 100 HEIGHT 30 // CAPTION "Modal 2" CAPTION "Child" ICON NIL // ACTION MODAL2() ACTION CHILD() END BUTTONEX END window wModal.center wModal.activate return NIL ************************* static function MODAL2() ************************* DEFINE WINDOW wModal2 AT 0 , 0 WIDTH 100 HEIGHT 100 TITLE "Modal 2" MODAL END window wModal2.center wModal2.activate return NIL ************************* static function CHILD() ************************* if IsWindowDefined(wChild) doMethod("wChild", "HIDE") doMethod("wChild", "SHOW") doMethod("wChild", "SETFOCUS") return NIL endif DEFINE WINDOW wChild AT 0 , 0 WIDTH 100 HEIGHT 100 TITLE "Child" CHILD ; NOMAXIMIZE NOMINIMIZE define timer t_1 interval 50 action doMethod("wChild", "SETFOCUS") once END window wChild.center activate window wChild NOWAIT DO MESSAGELOOP return NIL [/pre2]

SergKis: gfilatov2002 пишет работает с wChild такой пример Работает Вот тот же пример с костылем (child окно на модал и на main) [pre2] #include "Minigui.ch" ************* function MAIN ************* SET OOP ON DEFINE WINDOW wMain AT 0 , 0 WIDTH 400 HEIGHT 300 TITLE "Main" MAIN DEFINE BUTTONEX ButtonEX_1 ROW 225 COL 79 WIDTH 100 HEIGHT 30 CAPTION "Modal" ICON NIL ACTION MODAL() END BUTTONEX DEFINE BUTTONEX ButtonEX_2 ROW 225 COL 219 WIDTH 100 HEIGHT 30 // CAPTION "&Quit" CAPTION "Child" ICON NIL ACTION CHILD2( This.Name ) // ACTION ThisWindow.release END BUTTONEX END window wMain.center wMain.activate return NIL ************************* static function MODAL() ************************* DEFINE WINDOW wModal AT 0, 0 WIDTH 200 HEIGHT 200 TITLE "Modal" MODAL // _HMG_aFormFocused [ This.Index ] := .T. DEFINE BUTTONEX ButtonEX_1 ROW 20 COL 40 WIDTH 100 HEIGHT 30 // CAPTION "Modal 2" CAPTION "Child" ICON NIL // ACTION MODAL2() ACTION CHILD2( This.Name ) END BUTTONEX END window wModal.center wModal.activate return NIL ************************* static function MODAL2() ************************* DEFINE WINDOW wModal2 AT 0 , 0 WIDTH 100 HEIGHT 100 TITLE "Modal 2" MODAL END window wModal2.center wModal2.activate return NIL ************************* static function CHILD() ************************* if IsWindowDefined(wChild) doMethod("wChild", "HIDE") doMethod("wChild", "SHOW") doMethod("wChild", "SETFOCUS") return NIL endif DEFINE WINDOW wChild AT 0 , 0 WIDTH 100 HEIGHT 100 TITLE "Child" CHILD ; NOMAXIMIZE NOMINIMIZE define timer t_1 interval 50 action doMethod("wChild", "SETFOCUS") once END window wChild.center activate window wChild NOWAIT DO MESSAGELOOP return NIL ************************* static function CHILD2( cFocusName ) ************************* LOCAL oParent := ThisWindow.Object LOCAL lM LOCAL hM If oParent:Type == 'M' lM := _HMG_IsModalActive hM := _HMG_ActiveModalHandle _HMG_IsModalActive := .F. _HMG_ActiveModalHandle := 0 Endif DEFINE WINDOW wChild AT 0 , 0 WIDTH 100 HEIGHT 100 TITLE "Child" CHILD ; NOMAXIMIZE NOMINIMIZE END window wChild.center wChild.activate If oParent:Type == 'M' _HMG_IsModalActive := lM _HMG_ActiveModalHandle := hM Endif oParent:SetFocus(cFocusName) return NIL [/pre2]

SergKis: PS в CHILD2 добавить (обработка потери фокуса)[pre2] DEFINE WINDOW wChild AT 0 , 0 WIDTH 100 HEIGHT 100 TITLE "Child" CHILD ; NOMAXIMIZE NOMINIMIZE ; ON LOSTFOCUS do_Obj(This.Handle, {|ow| ow:Release() }) [/pre2]

gfilatov2002: SergKis пишет: тот же пример с костылем Так каков вердикт? Нужен этот новый clause FlashExit или достаточно костыля

SergKis: gfilatov2002 пишет Нужен этот новый clause FlashExit или достаточно костыля Не понимаю, надо осознать . Народ подтянуть. Если активировать в примере строку[pre2] DEFINE WINDOW wModal AT 0, 0 WIDTH 200 HEIGHT 200 TITLE "Modal" MODAL // _HMG_aFormFocused [ This.Index ] := .T. [/pre2] модальное окно уберется, с др. стороны есть др. способы убрать модал. Я

Andrey: SergKis пишет: Не понимаю, надо осознать . Народ подтянуть. Читаю как про инопланетян... Для чего это хоть делаете ? На пальцах объясните, по простому, по русски...

SergKis: Andrey Работаем на модальном окне, заменяем combobox модальным окном с тсб списком выбора (без заголовков, с Х). Все работает, кроме клика за пределами окна-списка (только Х завершает). Child окно из под модального - ку-ку. На нем можно делать lostfocus. Вот вокруг запуска окна child из под модального и сыр-бор. С FlashExit child запускается, модал убирается ВСЕГДА. С костылем, child запускается, модал остается (сам убирай). Клик за пределами child и ON LOSTFOCUS окно child убирает.

SergKis: PS в CHILD2 добавить (блокировку X окна wModal), иначе валится при его нажатии и наличии окна child[pre2] ************************* static function CHILD2( cFocusName ) ************************* LOCAL oParent := ThisWindow.Object LOCAL lM LOCAL hM oParent:Action := .F. If oParent:Type == 'M' ... Endif oParent:Action := .T. oParent:SetFocus(cFocusName) return NIL и в функцию добавить ************************* static function MODAL() ************************* DEFINE WINDOW wModal AT 0, 0 WIDTH 200 HEIGHT 200 TITLE "Modal" MODAL ; ON INTERACTIVECLOSE (This.Object):Action ... [/pre2]

gfilatov2002: Выпущена новая сборка 18.06 для BCC 5.51 для компиляторов Harbour и xHarbour Базовый дистрибутив-инсталлятор находится по адресу http://hmgextended.com/files/CONTRIB/hmg-18.06-setup.exe Рекомендуется к использованию Также имеются в наличии готовые сборки для: - MinGW 8.1.0 32-bit для Harbour 3.2.0dev; - MinGW 8.1.0 64-bit для Harbour 3.4.0dev; - MS VisualC 2017 32-bit для Harbour 3.2.0dev; - Borland/Embarcadero C++ 7.3 (32-bit) для Harbour 3.2.0dev. Благодарю за Ваше внимание и поддержку P.S. Доступно зеркало домашней страницы по адресу http://hmgextended.org P.S. 2 Выпуск новых сборок приостановлен на неопределенное время по материальным причинам

Haz: SergKis пишет: Работаем на модальном окне, заменяем combobox модальным окном с тсб списком выбора Сергей, я свой вариант на классе допиливаю потихоньку . У меня с заголовками, но без [X] все работает. В своих проектах заменяю сомбик везде. Для вызова используется oCol:PrevEdit() где обрабатывается примерно такой код [pre2] CASE cCol == "ID_CURR" SQL("T1", "SELECT * FROM CNT_CUR") // Это из под ADS , в стандарте тупо меняется на USE cBase ALIAS 'T1' T1->(OrdSetFocus("NAME")) xLbx := LBX():New() // Создать объект xLbx:cAlias := "T1" // Какой алиас в нем показать xLbx:cRetField := "ID" // какое поле вернуть xLbx:aHeaders := {'A', 'B'} // как назвать заголовки xLbx:aWidth := {35, 100} // ширина колонок xLbx:aAlign := {DT_CENTER, DT_LEFT} // как выровнять xLbx:aField := {'NAME', 'FULLNAME'} // какие поля показать xLbx:nHeightCell := 20 // соответствующие размеры xLbx:nHeightHead := 0 xLbx:nHeightFoot := 0 xLbx:bPostBlock := {|| NIL } // блок который выполнить после выбора xLbx:bSearch := {|| NIL } // блок поиска в таблице объекта xLbx:ListBox( oBrw, xVal ) // непосредственно показ T1->(DBCloseArea()) // убирается за собой lRet := FALSE // не пускаем в режим редактирования [/pre2] click here Предусмотрены футинги и их выравнивание , но пока не делал Если интересно , могу сюда сбросить скомпилированный пример, как это выглядит и исходники разумеется. PS. у дураков мысли сходятся , у меня точно такие же переменные для отлова модала lM и hM

SergKis: Haz пишет Если интересно , могу сюда сбросить скомпилированный пример, как это выглядит и исходники разумеется. Конечно интересно. В итоге может стать заменителем родного ComboBox. у дураков мысли сходятся , у меня точно такие же переменные для отлова модала lM и hM Мне больше нравиться "краткость - сестра таланта" (c) Свои переменные с именем > 4 символов напрягают. "Лень двигатель прогресса" (c) Так что совпадения обоснованные Для вызова используется oCol:PrevEdit() где обрабатывается примерно такой код Аналогично поступаю, только через сообщение, тогда отрываемся от блока :bPrevEdit, имеем среду окна (можно контрола) This, По мне более свободен в действиях, т.к. тсб "свободна" для приема др. сообщений.

Haz: SergKis пишет: Конечно интересно тут спрятал PS. При сборке половина инклюдов в исходнике класса не нужна, просто дернул как есть из проекта в поиске косячек с прорисовкой, только заметил. Сам использую ADS там другая логика. Но как предварительный пример как сделать поиск по справочнику сойдет, тем более что поиск скорее будет у каждого свой. Для исправления достаточно в процедуре поиска добавить [pre2] oBrw:Reset() oBrw:GoTop() oBrw:Refresh(TRUE) [/pre2]

Vlad04: Вызов справочников ввиде TsBrows давно применяю , как основной способ. Combox так же имеет право на существование, смотря по обстоятельствам. Окно модальное немодальное есть некоторые проблемы. Мысль, изложенная выше,закрывать окно справочника при потери фокуса - можно попробовать, но лучше, чтобы окно могло вести как модальное(при установке соответствующего параметра). Описание справочника делаю в текстовом файле, из которого считываются параметры создания окна. В функционале вызов справочника из формы предельно лаконичный .. if ControlName == 'BtnTxt_IM' .or. ControlName == 'BtnTxt_IM_O' Select IM if !empty(sValue) Seek Upper(sValue) if Found() nR:=Recno() endif endif if CreaTBrows('IM.UKS',nR) EditLudi.&(ControlName).Value:=IM->IM endif ... Из Tbrows через :bPrevEdit

SergKis: gfilatov2002 Небольшая правка[pre2] METHOD KeyDown( nKey, nFlags ) CLASS TSBrowse ... line 6912 // uVal := Eval( ::aColumns[ nCol ]:bData ) uVal := ::bDataEval(::aColumns[ nCol ]) uVal := Eval( ::aColumns[ nCol ]:bPrevEdit, uVal, Self ) ... [/pre2]

gfilatov2002: SergKis пишет: Небольшая правка Принято. Благодарю за помощь

SergKis: gfilatov2002 Из этой же темы[pre2] METHOD LDblClick( nRowPix, nColPix, nKeyFlags ) CLASS TSBrowse ... line 7469 ::nColSpecHd := 0 // If ValType( Eval( ::aColumns[ nCol ]:bData ) ) == "L" .and. ; If ValType( ::bDataEval( ::aColumns[ nCol ] ) ) == "L" .and. ; ::aColumns[ nCol ]:lCheckBox // virtual checkbox ::PostMsg( WM_CHAR, VK_SPACE, 0 ) ElseIf ::aColumns[ nCol ]:oEdit != Nil ... [/pre2]

gfilatov2002: SergKis пишет: Из этой же темы

Vlad04: Harbour MiniGUI Extended Edition 18.06 (Release) При сборке старого проекта требует Unable to open file 'HBOLE.LIB'

gfilatov2002: Vlad04 пишет: При сборке старого проекта требует Поскольку, по-видимому, проект собирается с помощью Ide, рекомендую обновить HMGS-IDE по ссылке http://www.hmgextended.com/files/HMGS-IDE/ide.zip

Vlad04: оК! Всё нормально. И ещё об использовании TsBrows для вызова справочников. Если присвоить свойство окну TopMost, то при потере фокуса окно всё равно остается перед глазами- т.е юзер видит, что сделал что-то не то ( из двух вариантов : выбрать или закрыть )

Pasha: Григорий, там в harbour users group вас один товарищ разыскивает

gfilatov2002: Pasha пишет: вас один товарищ разыскивает Спасибо, вроде Esgici уже перечислил ему мои контакты

SergKis: Haz пишет Если интересно , могу сюда сбросить скомпилированный пример, как это выглядит и исходники разумеется. Допилил свой пример на эту тему (красоты не наводил, подключил работу с базой колонок) Пример тут https://my-files.ru/3poc1q Собран на последней версии hmg 18.06 + сделаны предложенные изменения !

SergKis: Упс. С ошибкой собрал. Правка (заменить) [pre2] *----------------------------------------------------------------------------* FUNC Base_Country ( oParent ) *----------------------------------------------------------------------------* ... oParent:Action := .F. // Init TBROWSE columns AAdd( aCols, gCols( OrdKeyNo ) ) AAdd( aCols, gCols( Land.COUNTRYNO ) ) AAdd( aCols, gCols( Land.KOD ) ) AAdd( aCols, gCols( Land.NAME ) ) AAdd( aCols, gCols( Land.ISES ) ) hFontBold := GetFontHandle('FontBold') ... [/pre2] Exe тут https://my-files.ru/inivvh

Haz: SergKis пишет: Допилил свой пример на эту тему Интересно. Приеду на работу, гляну обязательно.

Haz: Haz пишет: Упс. С ошибкой собрал. Правка (заменить) Сергей, а DBF и CDX где лежат ?

SergKis: Haz пишет Сергей, а DBF и CDX где лежат ? Все у exe. В пером архиве все с иходниками как есть (в demo.prg заменить из поста со вторым архивом с exe, им перекрыть пред. exe). У себя в SAMPLES создаю _Test каталог и в нем каталог проект APP_OOPTsbBox и в нем все лежит

SergKis: SergKis пишет Упс. С ошибкой собрал. Правка (заменить) Еще неточность demo.ch[pre2] #translate sColsPrivate() => __mvPrivate( BASE_COLUMNS ) ; _CrtCols( BASE_COLUMNS ) [/pre2]

Haz: SergKis пишет: Все у exe. В пером архиве все с иходниками как есть Все нашел , посмотрел , компактненько получилось. Как и у меня один момент не допилен ) Мы оба ловим позицию по вертикали и открываем справочник сверху или снизу, а вот до горизонтали руки не доходят пока и справочник может открыться за пределами экрана . Но это из разряда "красоты" которую позже можно допилить

SergKis: Haz пишет посмотрел , компактненько получилось Мысль завернуть в DEFINE TSBBOX ... ... END TSBBOX надо обдумать немного, в примере больше возился с базой колонок, а по горизонтали сделаю, вчера просто забыл )

SergKis: Опять упс, прогнать забыл Compile.bat /e /w. Исправленный вариант https://my-files.ru/l23x4s Пора отвалить от компа.

gfilatov2002: Всем кому это интересно Подготовил beta 3 для новой сборки библиотеки со следующим списком изменений [pre2] * Enhanced: DATEPICKER/TIMEPICKER supports BackColor definition for text box (based upon the undocumented trick with an erase background event). Warning: this feature will work at NO THEMED WinXP or earlier only. Contributed by Grigory Filatov <gfilatov@inbox.ru> (see demo.prg in folder \samples\Basic\DatePicker) * Enhanced: The Grid control supports the optional COLUMNWIDTHLIMITS clause and corresponding ON DRAGHEADERITEMS event. Above clause specifies the limits for the column's width which will allowed at the dragging of a column's border via a mouse. Syntax: @ <row>,<col> GRID <name> [ OF <parent> ] ; [ WIDTH <nWidth> ] [ HEIGHT <nHeight> ] ; [ HEADERS <aHeaders> ] [ WIDTHS <aWidths> ] ; [ ITEMS <aItems> ] [ VALUE <value> ] [ COLUMNWIDTHLIMITS <aWidthLimits> ] [ ON DRAGHEADERITEMS <bAction> ] where the array aWidthLimits should have the following values for an each column: { nMinWidth, nMaxWidth } or NIL. The DRAGHEADERITEMS event will be executed after a changing of a header item's position. Based upon a contribution of HMG user KDJ. Adapted for Minigui Extended by Grigory Filatov <gfilatov@inbox.ru> (see demo in folder \samples\Basic\Grid_ColumnsWidth) * Enhanced: The 'System' and 'Application' objects supports the following read only properties: - System.ClientWidth - System.ClientHeight - Application.FontName - Application.FontSize Contributed by Sergej Kiselev (see demo in folder \samples\Advanced\APP_OOPTSBBOX) * Updated: Minor modifications for compatibility with Viktor's Harbour fork 3.4.0 and Borland/Embarcadero C++ 7.3 (32-bit). Contributed by Grigory Filatov <gfilatov@inbox.ru> * Updated: HbSQLite3 library: - update for using SQLITE3 version 3.25.0dev (from 3.24.0). Contributed by Grigory Filatov <gfilatov@inbox.ru> * Updated: HMGS-IDE v.1.4.3.4 Project Manager and Two-Way Visual Form Designer. Contributed by Grigory Filatov <gfilatov@inbox.ru> (look for what's new at changelog.txt in folder \Ide) * New: 'TSBrowse OOP TSBBOX usage' sample. Contributed by Sergej Kiselev (see in folder \samples\Advanced\APP_OOPTSBBOX) * New: 'TSBrowse ListBox custom class usage' sample. Contributed by Igor Nazarov. Revised by Grigory Filatov <gfilatov@inbox.ru> (see in folder \samples\Advanced\Tsb_ListBox) * Updated: 'Print Pie Graph' sample: updated the data for June 2018. Contributed by Grigory Filatov <gfilatov@inbox.ru> (see demo.prg in folder \samples\Basic\GraphPrint) * Updated: 'Grid Columns Width' sample by HMG user KDJ. Contributed by Grigory Filatov <gfilatov@inbox.ru> (see in folder \samples\Basic\Grid_ColumnsWidth) * Updated: 'TSBrowse Demo' sample: - fixed the internal function ComboBrowse(). The bugs were reported by Sylvain Larche. Contributed by Grigory Filatov <gfilatov@inbox.ru> (see in folder \samples\Advanced\TSBrowse) [/pre2] Благодарю за Ваше внимание Особая благодарность за помощь Сергею Киселеву и Игорю Назарову

Dima: gfilatov2002 пишет: Олегу Назарову gfilatov2002 пишет: Contributed by Igor Nazarov Не стыковочка

gfilatov2002: Dima пишет: Не стыковочка Спасибо, поправил...

SergKis: gfilatov2002 Поправьте в примере APP_OOPTSBBOX для полноты действий [pre2] demo.ch ... #translate sColsPrivate() => __mvPrivate( BASE_COLUMNS ); _CrtCols( BASE_COLUMNS ) #translate sCols( <Key>, <oCol> ) => _SetCols( <"Key">, <oCol> ) #translate sCols( <Key>, <Name>, <xVal> ) => _SetCols( <"Key">, <"Name">, <xVal> ) #translate dCols( <Key> ) => _DelCols( <"Key"> ) #translate gCols( <Key> ) => _GetCols( <"Key"> ) #translate gCols() => _GetCols() demo_misk.prg ... *----------------------------------------------------------------------------* FUNC InitBaseCols() *----------------------------------------------------------------------------* LOCAL oCol ... sCols( Land.ISES , nWidth , TxtWidth('Входит') ) // Для проверки, потом можно в комментарии положить или удалить oCol := gCols( Land.ISES ) oCol:cAlias := 'CUST' sCols( Cust.ISES, oCol ) // AEval(gCols() , {|ao,no,oc| oc:=ao[2], _LogFile(.T.,no,ao[1],oc:cAlias,oc:cName,oc:cField,oc:cData,oc:cHeading) }) // AEval(gCols(Land.), {|ao,no,oc| oc:=ao[2], _LogFile(.T.,no,ao[1],oc:cAlias,oc:cName,oc:cField,oc:cData,oc:cHeading) }) // AEval(gCols(Cust.), {|ao,no,oc| oc:=ao[2], _LogFile(.T.,no,ao[1],oc:cAlias,oc:cName,oc:cField,oc:cData,oc:cHeading) }) ? '------------------------ after Add column', AEval(gCols(Cust.), {|ao,no,oc| oc:=ao[2], _LogFile(.T.,no,ao[1],oc:cAlias,oc:cName,oc:cField,oc:cData,oc:cHeading) }) dCols( Cust.ISES ) ? '------------------------ after Del column', AEval(gCols(Cust.), {|ao,no,oc| oc:=ao[2], _LogFile(.T.,no,ao[1],oc:cAlias,oc:cName,oc:cField,oc:cData,oc:cHeading) }) RETURN Nil ... *-----------------------------------------------------------------------------* FUNC _DelCols( cKey, cVarName ) *-----------------------------------------------------------------------------* LOCAL oVar Default cVarName := BASE_COLUMNS IF !__mvExist(cVarName); RETURN .F. ENDIF IF ! HB_ISOBJECT( oVar := __mvGet(cVarName) ); RETURN .F. ENDIF oVar:Del(cKey) RETURN .T. *-----------------------------------------------------------------------------* FUNC _SetCols( cKey, cName, xVal, cVarName ) *-----------------------------------------------------------------------------* LOCAL oVar, oCol Default cVarName := BASE_COLUMNS IF !__mvExist(cVarName); RETURN .F. ENDIF IF ! HB_ISOBJECT( oVar := __mvGet(cVarName) ); RETURN .F. ENDIF IF pCount() < 3 If pCount() == 2 .and. HB_ISOBJECT(cName) oVar:Set(cKey, cName) EndIf RETURN .F. ENDIF If ! HB_ISOBJECT( oCol := oVar:Get( cKey ) ); RETURN .F. EndIf oCol:SetProperty( cName, xVal ) RETURN .T. *-----------------------------------------------------------------------------* FUNC _GetCols( cKey, cVarName ) *-----------------------------------------------------------------------------* LOCAL oVar, aCol := {} Default cVarName := BASE_COLUMNS IF !__mvExist(cVarName); RETURN NIL ENDIF IF ! HB_ISOBJECT( oVar := __mvGet(cVarName) ); RETURN NIL ENDIF IF pCount() > 0 If right(cKey, 1) == '*'; cKey := left(cKey, At('.', cKey)) EndIf If right(cKey, 1) == '.' AEval(oVar:GetAll(), {|ac| iif( cKey $ ac[1], AAdd(aCol, AClone(ac)), Nil ) }) RETURN aCol EndIf RETURN oVar:Get( cKey ):Clone() ENDIF RETURN oVar:GetAll() ... [/pre2]

gfilatov2002: SergKis пишет: Поправьте в примере Что-то эти изменения "не пошли" - препроцессор ругается Давайте лучше рабочий пример P.S. Сам разобрался - уже работает

SergKis: gfilatov2002 пишет уже работает На всякий случай тут https://my-files.ru/9yo3yx

gfilatov2002: SergKis пишет: На всякий случай Благодарю за оперативную помощь

SergKis: gfilatov2002 Добавил в CLASS TSColumn[pre2] DATA cField INIT "" // FieldName column DATA cFieldTyp INIT "" // FieldType column DATA nFieldLen INIT 0 // FieldLen column DATA nFieldDec INIT 0 // FieldDec column ... [/pre2] Помогает плясать от этих данных а не от :bData

Vlad04: Что-то не понял идеи. 1) При открытии справочника и выборе нужной записи, по моим понятиям, должна происходить замена данных в основной таблице ? А ничего не происходит 2)При открытии справочника, я обычно у себя в программах, позиционирую курсор на запись равной записи основной. Если в основной таблице - это имя "ВАСИЛИЙ", то при открытии справочника устанавливаю курсор на имя "ВАСИЛИЙ", если не найдено, то на первую запись

SergKis: Vlad04 пишет Что-то не понял идеи. В каком месте, если в примере, то позиционирование и не делалось, оставлено за скобками (техника), Так же за скобками осталось убрать заголовки окна, добавить элементы запроса для поиска (как у Haz в примере) В примере показана работа с базой колонок (baza 1, baza 2 содержат только поля ссылок на справочники), просмотр по ссылкам (исп. переменная колонки новая :bSeek в 2х вариантах исполнения), т.е. :LoadFields(...) не очень подходит надо доб. описания колонок. В примере исп. созданная база кол. и для работы с base1, base2 и справочн. Добавка в объект доп. переменных, так это для уточнений при работ с колонками. Так имеем :bData и от него пляшем -> :nWidth, :cPicture, :nAlign ставим интуитивно, примерно ... Если отображение через функцию в :bData (к примеру выбрать CHARSET фонта для отображения колонки для данных только типа C), то это опять интуитивное решение, т.к. :cField можент быть выражение с CRLF. А так можно делать проверку только для C типа поля делать, для др. нет или для других.

SergKis: PS В примере base 1, base 2 - Child окна (при этом ведут себя почти как модал Parent окно не реагирует на кнопки, пока не выйдем из окна child base1\2). base 1, base 2 можно сделать modal, при этом вызовы спр. на колонках будут работать, они child.

Haz: Vlad04 пишет: Что-то не понял идеи Еще идею Сергей озвучил пару страниц назад. Это вызов справочников через сообщение, это дает возможность не замораживать обработчик событий tsb на блоке bPrevEdit. Вместо записи в таблицу при выборе из справочника, ведётся лог. Так что пример Сергея как бы и о событиях. Мой пример это кусок из проекта, там запись из справочника есть. Но все через bPrevEdit. Предупредил что пример сырой в фазе вялой доработки. Сделаны блоки bPostblock для выполнения действий после выбора и bSearch для поиска. В плане как минимум bPreBlok для действий перед показом справочника. Используя блоки можно лочить таблицу только в момент записи или установить указатель куда угодно перед показом и пр. Ps Основная претензия к комбо, так это предварительное чтение справочника в массив. При узком канале и длинном справочнике бровс помирает при прорисовке и навигации. Так же нет поиска фильтрации, чекбоксов и прочих прелестей. У себя полностью отказался от комбо в tsb.

gfilatov2002: SergKis пишет: Добавка в объект доп. переменных Продублировал эти дополнения

SergKis: gfilatov2002 Сделал след. изменения[pre2] CLASS TSColumn ... DATA bSeek // Optional code block to seek a column data DATA bDecode // Charset decode or other ... METHOD SetProperty ( cName, xVal ) INLINE iif( __objHasData( Self, cName ), __objSendMsg( Self, '_'+cName, xVal ), Nil ) METHOD GetProperty ( cName ) INLINE iif( __objHasData( Self, cName ), __objSendMsg( Self, cName ), Nil ) METHOD AddProperty ( cName, xVal ) INLINE ( iif(!__objHasData( Self, cName ), __objAddData( Self, cName ), Nil ), ; iif( __objHasData( Self, cName ), __objSendMsg( Self, '_'+cName, xVal ), Nil ) ) ... METHOD DrawLine( xRow ) CLASS TSBrowse ... If ::lIsArr .and. ( ::lAppendMode .or. ::nAt > Len( ::aArray ) ) uData := "" // append mode for arrays ElseIf cColAls != Nil If Valtype( oColumn:bSeek ) == 'B' ( cColAls )->( Eval( oColumn:bSeek, Self, nJ ) ) EndIf uData := ( cColAls )->( Eval( oColumn:bData ) ) If Valtype( oColumn:bDecode ) == 'B' uData := ( cColAls )->( Eval( oColumn:bDecode, uData, Self, nJ ) ) EndIf Else If Valtype( oColumn:bSeek ) == 'B' Eval( oColumn:bSeek, Self, nJ ) EndIf uData := Eval( oColumn:bData ) If Valtype( oColumn:bDecode ) == 'B' uData := Eval( oColumn:bDecode, uData, Self, nJ ) EndIf EndIf ... METHOD DrawSelect( xRow ) CLASS TSBrowse ... If ::lIsArr .and. ( ::lAppendMode .or. ::nAt > Len( ::aArray ) ) uData := "" // append mode for arrays ElseIf cColAls != Nil If Valtype( oColumn:bSeek ) == 'B' ( cColAls )->( Eval( oColumn:bSeek, Self, nJ ) ) EndIf uData := ( cColAls )->( Eval( oColumn:bData ) ) If Valtype( oColumn:bDecode ) == 'B' uData := ( cColAls )->( Eval( oColumn:bDecode, uData, Self, nJ ) ) EndIf Else If Valtype( oColumn:bSeek ) == 'B' Eval( oColumn:bSeek, Self, nJ ) EndIf uData := Eval( oColumn:bData ) If Valtype( oColumn:bDecode ) == 'B' uData := Eval( oColumn:bDecode, uData, Self, nJ ) EndIf EndIf ... METHOD LoadFields( lEditable ) CLASS TSBrowse ... ATail( ::aColumns ):cData := ::cAlias + "->" + FieldName( nE ) ATail( ::aColumns ):cName := ( ::cAlias )->( FieldName( nE ) ) // 21.07.2015 ATail( ::aColumns ):cField := ( ::cAlias )->( FieldName( nE ) ) // 08.06.2018 ATail( ::aColumns ):cFieldTyp := aStru[ nE, 2 ] ATail( ::aColumns ):nFieldLen := aStru[ nE, 3 ] ATail( ::aColumns ):nFieldDec := aStru[ nE, 4 ] ... [/pre2] Пример по исп. CHARSET фонтов тут https://my-files.ru/dofcn3 Суть примера: U04.dbf -в дос кодировке LV866 (языки EN, LV, RU) bk8_c.lib содержит C функцию перекодировки Dos4W5(cString, 1) - dos -> win ansi 1251 RUSIAN_CHARSET Dos4W5(cString, 2) - dos -> win ansi 1257 BALTIC_CHARSET ... TSB показывает колонки в разных фонтах

SergKis: PS demo_ru.prg в OEM кодировке (опр. русских букв в dos) !!!

gfilatov2002: SergKis пишет: Сделал след. изменения Принято. Благодарю за помощь

Haz: SergKis пишет: показывает колонки в разных фонта Сергей, а при записи в поле все ок будет?

SergKis: Игорь, Надо обратную перекодировку делать, т.е. в edit использовать hFont с нужным charset потом перед записью делать win ansi -> dos, для LV866: Dos4W5(cString, 6) - win ansi rusian_charset -> LV866 Dos4W5(cString, 7) - win ansi baltic_charset -> LV866 В тек. версии не пробовал, пока потребности не было, но должно работать, в VO работает схема

Haz: SergKis пишет: Надо обратную перекодировку делать Я делал. Но перекодировки и шрифты назначались в bData. Если поле подстановочное через bSeek или bData и хранит ID, то перекодировка не нужна в общем случае. У меня был авто пополняемый справочник в OEM, в поле хранил ID. Поле это было редактируемо с BTNBox и при нажатии на кнопку был выбор, при редакции - запись в справочник и в поле подстановка нового ID. Ох и намучился я с этим BTN....идея оказалась не удобной для пользователя.

SergKis: Haz пишет Но перекодировки и шрифты назначались в bData :bData с перегрузом была (все в ней делать ... мучение) Мой товарищ по работе не выдерживал и переводил VO в уникод и hmg 2.07 перевел, на ней и работаем, голова не болит. Сейчас решил использовать наработки Андрея tsb -> Excel\OO (много новых мелких отчетов как в примере APP_OOPREPORT). Делать настройки на них в своей версии лениво, вот и полез в тек. версию hmg с charset. Хочу утилитку сделать и запускать

Haz: SergKis пишет: вот и полез в тек. версию hmg с charset тогда уж логичнее обойтись одной проверкой перед TSDrawCell [pre2] If hb_isBlock( oColumn:bDecode ) uData := Eval( oColumn:bDecode, uData, Self, nJ ) EndIf TsDrawCell( ... [/pre2]

SergKis: Haz пишет логичнее обойтись одной проверкой перед TSDrawCell Я тоже так сначала подумал, но опять проверять cColAls != Nil ..., поставил по веткам там где есть. А использовать HB_ISBLOCK логичнее, наверно копипастил

SergKis: gfilatov2002 Поправил xmlxls.lib[pre2] CREATE CLASS ExcelWriterXML ... VAR cCodePage INIT '' ... METHOD ExcelWriterXML:writeData( target ) ... xml += '<ExcelWorkbook xmlns="urn:schemas-microsoft-com:office:excel" />' + hb_eol() xml += "<Styles>" + hb_eol() If empty( ::cCodePage ) xml := hb_StrToUTF8( xml ) Else xml := hb_StrToUTF8( xml , ::cCodePage ) EndIf // xml := hb_StrToUTF8( xml , ::cCodePage ) FWrite( handle, xml ) xml := "" FOR EACH style IN ::styles xml += style:getStyleXML() NEXT xml += "</Styles>" + hb_eol() If empty( ::cCodePage ) xml := hb_StrToUTF8( xml ) Else xml := hb_StrToUTF8( xml , ::cCodePage ) EndIf // xml := hb_StrToUTF8( xml , ::cCodePage ) FWrite( handle, xml ) ... xml += "</Workbook>" If empty( ::cCodePage ) xml := hb_StrToUTF8( xml ) Else xml := hb_StrToUTF8( xml , ::cCodePage ) EndIf // xml := hb_StrToUTF8( xml , ::cCodePage ) FWrite( handle, xml ) ... xlsxml_s.prg CREATE CLASS ExcelWriterXML_Sheet ... LOCAL row, rowData, rowHeight, formula LOCAL cCdp := GetExcelWriterXMLCodePage() ... xml += " <Table>" + hb_eol() If empty( cCdp ) xml := hb_StrToUTF8( xml ) Else xml := hb_StrToUTF8( xml , cCdp ) Endif // xml := hb_StrToUTF8( xml , GetExcelWriterXMLCodePage() ) FWrite( handle, xml ) ... xml += ' <Column ss:Index="' + colIndex + '" ss:AutoFitWidth="0" ss:Width="' + colWidth + '"/>' + hb_eol() NEXT If empty( cCdp ) xml := hb_StrToUTF8( xml ) Else xml := hb_StrToUTF8( xml , cCdp ) Endif // xml := hb_StrToUTF8( xml , GetExcelWriterXMLCodePage() ) FWrite( handle, xml ) ... xml += " </Row>" + hb_eol() If empty( cCdp ) xml := hb_StrToUTF8( xml ) Else xml := hb_StrToUTF8( xml , cCdp ) Endif // xml := hb_StrToUTF8( xml , GetExcelWriterXMLCodePage() ) FWrite( handle, xml ) xml := "" NEXT xml += " </Table>" + hb_eol() xml += "</Worksheet>" + hb_eol() If empty( cCdp ) xml := hb_StrToUTF8( xml ) Else xml := hb_StrToUTF8( xml , cCdp ) Endif // xml := hb_StrToUTF8( xml , GetExcelWriterXMLCodePage() ) FWrite( handle, xml ) ... [/pre2] т.е. по умолчанию работает страница уст. в программе.

gfilatov2002: SergKis пишет: Поправил xmlxls.lib Спасибо

SergKis: gfilatov2002 SergKis пишет ... If empty( cCdp ) xml := hb_StrToUTF8( xml ) Else xml := hb_StrToUTF8( xml , cCdp ) Endif // xml := hb_StrToUTF8( xml , GetExcelWriterXMLCodePage() ) ... Все проще оказалось, достаточно сделать в первоначальном варианте STATIC cCp := Nil // "" REQUEST HB_CODEPAGE_RU1251, HB_CODEPAGE_RU866, HB_CODEPAGE_UTF8 CREATE CLASS ExcelWriterXML VAR styles INIT {} VAR formatErrors INIT { => } VAR sheets INIT {} VAR lShowErrorSheet INIT .F. VAR overwriteFile INIT .F. VAR cCodePage INIT Nil // 'RU1251' ... тогда тоже все работает как надо

gfilatov2002: SergKis пишет: Все проще оказалось

Andrey: Всем привет ! А библу hbole совсем выкинули из версии 18.06 ? Больше её не будет в Харборе ?

gfilatov2002: Andrey пишет: hbole совсем выкинули из версии 18.06 Да, верно Andrey пишет: Больше её не будет Нет, не будет Функционал этой устаревшей библиотеки полностью заменяется связкой contrib библиотек hbwin + xhb

Vlad04: hbole совсем выкинули из версии 18.06 Собираю НОВЫЙ проект в дизайнере. Программа не собирается, требует hbole. Стараы проекты собираются

gfilatov2002: Vlad04 пишет: требует hbole Обнови локально HMGS-IDE до версии 1.4.3.4 или дождись новой сборки 18.07, которая выйдет завтра

gfilatov2002: Выпущена новая сборка 18.07 для BCC 5.51 и компиляторов Harbour и xHarbour Базовый дистрибутив-инсталлятор находится по адресу http://hmgextended.com/files/CONTRIB/hmg-18.07-setup.exe Рекомендуется к использованию Также имеются в наличии готовые сборки для: - MinGW 8.1.0 32-bit для Harbour 3.2.0dev; - MinGW 8.1.0 64-bit для Harbour 3.4.0dev; - MS VisualC 2017 32-bit для Harbour 3.2.0dev; - Borland/Embarcadero C++ 7.3 (32-bit) для Harbour 3.4.0dev (НОВАЯ!). Благодарю за Ваше внимание и поддержку

SergKis: gfilatov2002 Добавил в класс TsBrowse переменную для использования как контейнер handle фонтов[pre2] DATA aFontHandle AS ARRAY INIT {} [/pre2] по мне это удобнее, чем внешние переменные, к примеру вместо STATIC a_Font[pre2] STATIC FUNCTION TsbFont( nAt, nCol, oBrw ) LOCAL hFont, lVal //, nVar STATIC a_Font Default nAt := 0 If a_Font == Nil .or. pCount() == 0 a_Font := {} AAdd( a_Font, GetFontHandle( "Font_1" ) ) AAdd( a_Font, GetFontHandle( "Font_2" ) ) AAdd( a_Font, GetFontHandle( "Font_3" ) ) AAdd( a_Font, GetFontHandle( "Font_4" ) ) AAdd( a_Font, GetFontHandle( "Font_5" ) ) AAdd( a_Font, GetFontHandle( "Font_6" ) ) AAdd( a_Font, GetFontHandle( "Font_7" ) ) ... [/pre2] делать AAdd( :aFontHandle, GetFontHandle( "Font_1" ) ) AAdd( :aFontHandle, GetFontHandle( "Font_2" ) ) AAdd( :aFontHandle, GetFontHandle( "Font_3" ) ) AAdd( :aFontHandle, GetFontHandle( "Font_4" ) ) AAdd( :aFontHandle, GetFontHandle( "Font_5" ) ) AAdd( :aFontHandle, GetFontHandle( "Font_6" ) ) AAdd( :aFontHandle, GetFontHandle( "Font_7" ) ) и использовать в блоке кода от ob:aFontHandle[...] oCol:hFont := {|nr,nc,ob| TsbFont(nr, nc, ob)}

sashaBG: Пример INET_CHECKER зависает после длительной больше 8 часов работы иконка исчезает и с меню тоже неизвестно что творится . А у меня на базе етого примера управление LetoDB прицеплено . Пришлось откатится ! Windows 7 / 32bit, проверьте пожалуйста проявляется ли ето зависание на других версиях, т.к. у меня нет возможности сейчас !

Dima: sashaBG Скорее всего утечка памяти

gfilatov2002: sashaBG пишет: Пример INET_CHECKER зависает Благодарю за сообщение об ошибке Dima пишет: утечка памяти Да, это утечка ресурсов Я уже поправил код обработки изменения иконки в трее (для новой сборки). Сейчас тестирую на длительность работы...

SergKis: gfilatov2002 Немного изменил[pre2] CLASS TSBrowse ... // METHOD SetGetValue( xCol, xVal ) METHOD SetGetValue( xCol, xVal ) INLINE ::bDataEval( ::GetColumn( hb_defaultValue( xCol, ::nCell ) ), xVal ) METHOD SetValue( xCol, xVal ) INLINE ::SetGetValue( xCol, xVal ) METHOD GetValue( xCol ) INLINE ::SetGetValue( xCol ) METHOD bDataEval( oCol, xVal ) // METHOD bDataEval( oCol ) INLINE iif(Empty(oCol:cAlias) .or. '->' $ oCol:cField, ; // Eval( oCol:bData ), (oCol:cAlias)->( Eval( oCol:bData ) )) ... METHOD bDataEval( oCol, xVal ) CLASS TSBrowse LOCAL lNoAls := Empty(oCol:cAlias) .or. '->' $ oCol:cField If xVal == Nil // FieldGet If lNoAls; xVal := Eval( oCol:bData ) Else ; xVal := (oCol:cAlias)->( Eval( oCol:bData ) ) EndIf Else // FieldPut If lNoAls; Eval( oCol:bData, xVal ) Else ; (oCol:cAlias)->( Eval( oCol:bData, xVal ) ) EndIf EndIf RETURN xVal ... [/pre2]

gfilatov2002: SergKis пишет: Немного изменил OK

SergKis: gfilatov2002 Продолжение[pre2] METHOD Edit( uVar, nCell, nKey, nKeyFlags, cPicture, bValid, nClrFore, ; ... Default ::nHeightSuper := 0, ; nKey := VK_RETURN, ; nKeyFlags := 0, ; uVar := ::bDataEval( oCol ), ; // Eval( oCol:bData ), ; cPicture := oCol:cPicture, ; ... // If ValType( Eval( oCol:bData ) ) == "N" If ValType( ::bDataEval( oCol ) ) == "N" nWidth := 0 Aeval( aGet, { |x| nWidth := Max( Len(x), nWidth ) } ) nWidth := Max( GetTextWidth( 0, Replicate( 'B', nWidth ), hFont ), oCol:nWidth ) EndIf ... METHOD Excel2( cFile, lActivate, hProgress, cTitle, lSave, bPrintRow ) CLASS TSBrowse ... cPic := '' // cType := If( Empty( ::aColumns[ nCol ]:cDataType ), ValType( Eval( ::aColumns[ nCol ]:bData ) ), ::aColumns[ nCol ]:cDataType ) cType := If( Empty( ::aColumns[ nCol ]:cDataType ), ValType( ::bDataEval( ::aColumns[ nCol ] ) ), ::aColumns[ nCol ]:cDataType ) if cType == 'N' .and. !Empty( ::aColumns[ nCol ]:cPicture ) ... For nCol := 1 To Len( ::aColumns ) If ::aColumns[ nCol ]:lBitMap Loop EndIf // uData := Eval( ::aColumns[ nCol ]:bData ) uData := ::bDataEval( ::aColumns[ nCol ] ) nAlign := LoWord( ::aColumns[ nCol ]:nAlign ) ... METHOD ExcelOle( cXlsFile, lActivate, hProgress, cTitle, hFont, lSave, bExtern, aColSel, bPrintRow ) CLASS TSBrowse ... For nCol := 1 To Len( ::aColumns ) If aColSel != Nil .and. AScan( aColSel, nCol ) == 0 Loop EndIf // uData := Eval( ::aColumns[ nCol ]:bData ) uData := ::bDataEval( ::aColumns[ nCol ] ) If ValType( uData ) == "C" ... METHOD KeyChar( nKey, nFlags ) CLASS TSBrowse ... If ::lAppendMode Return 0 EndIf ::lNoPaint := .F. // cTypeCol := iif( ::nLen == 0, "U", ValType( Eval( ::aColumns[ ::nCell ]:bData ) ) ) // Modificado por Carlos cTypeCol := iif( ::nLen == 0, "U", ValType( ::bDataEval( ::aColumns[ ::nCell ] ) ) ) // Modificado por Carlos If Upper( ::aMsg[ 1 ] ) == "YES" ... METHOD KeyDown( nKey, nFlags ) CLASS TSBrowse ... ElseIf ::lCellBrw .and. ( nKey == VK_COPY .or. nKey == VK_INSERT ) // uTemp := cValToChar( Eval( ::aColumns[ nCol ]:bData ) ) uTemp := cValToChar( ::bDataEval( ::aColumns[ nCol ] ) ) CopyToClipboard( uTemp ) SysRefresh() ... nCol := ::nColSpecHd If Empty(uTemp) // cType := ValType( Eval( ::aColumns[ nCol ]:bData ) ) cType := ValType( ::bDataEval( ::aColumns[ nCol ] ) ) If cType $ "CM" // uTemp := Space( Len( Eval( ::aColumns[ nCol ]:bData ) ) ) uTemp := Space( Len( ::bDataEval( ::aColumns[ nCol ] ) ) ) ElseIf cType == "N" ... ElseIf ::lAppendMode .and. ::aDefault != Nil If Len( ::aDefault ) < Len( ::aColumns ) ASize( ::aDefault, Len( ::aColumns ) ) EndIf uTemp := If( ::aDefault[ nCol ] != Nil, If( ValType( ::aDefault[ nCol ] ) == "B", ; Eval( ::aDefault[ nCol ], Self ), ::aDefault[ nCol ] ), ::bDataEval( ::aColumns[ nCol ] ) ) // Eval( ::aDefault[ nCol ], Self ), ::aDefault[ nCol ] ), Eval( ::aColumns[ nCol ]:bData ) ) Else // uTemp := Eval( ::aColumns[ nCol ]:bData ) uTemp := ::bDataEval( ::aColumns[ nCol ] ) ... METHOD PostEdit( uTemp, nCol, bValid ) CLASS TSBrowse ... If Eval( If( ! ::lAppendMode, bRecLock, bAddRec ), uTemp ) // Eval( ::aColumns[ nCol ]:bData, uTemp, Self ) ::bDataEval( ::aColumns[ nCol ], uTemp ) SysRefresh() If lAppend If ! Empty( ::aDefault ) ASize( ::aDefault, Len( ::aColumns ) ) AEval( ::aDefault, { | e, n | If( e != Nil .and. n != nCol, If( Valtype( e ) == "B", ; ::bDataEval( ::aColumns[ n ], Eval( e, Self ) ), ; ::bDataEval( ::aColumns[ n ], e ) ), Nil ) } ) // Eval( ::aColumns[ n ]:bData, Eval( e, Self ) ), ; // Eval( ::aColumns[ n ]:bData, e ) ), Nil ) } ) ::DrawLine() EndIf ... EndIf // Eval( ::aColumns[ nCol ]:bData, uTemp ) ::bDataEval( ::aColumns[ nCol ], uTemp ) SysRefresh() If ::aColumns[ nCol ]:bPostEdit != Nil Eval( ::aColumns[ nCol ]:bPostEdit, uTemp, Self, lAppend ) EndIf ::lEditing := .F. ::lPostEdit := .F. If lAppend If ! Empty( ::aDefault ) ASize( ::aDefault, Len( ::aColumns ) ) AEval( ::aDefault, { | e, n | If( e != Nil .and. n != nCol, If( Valtype( e ) == "B", ; ::bDataEval( ::aColumns[ n ], Eval( e, Self ) ), ::bDataEval( ::aColumns[ n ], e ) ), Nil ) } ) // Eval( ::aColumns[ n ]:bData, Eval( e, Self ) ), Eval( ::aColumns[ n ]:bData, e ) ), Nil ) } ) EndIf ::DrawLine() EndIf ... Static Function RecordBrowse( oBrw ) ... For Each oCol In oBrw:aColumns // AAdd( aArr, { oCol:cHeading, Eval( oCol:bData ) } ) AAdd( aArr, { oCol:cHeading, oBrw:bDataEval( oCol ) } ) Next ...[/pre2]

SergKis: gfilatov2002 И еще, если добавить в TsColumn[pre2] DATA bDecode // Charset decode or other DATA bEncode // Charset encode or other ... изменить METHOD bDataEval( oCol, xVal, nCol ) CLASS TSBrowse LOCAL cAlias := oCol:cAlias LOCAL lNoAls := Empty(cAlias) .or. '->' $ oCol:cField If xVal == Nil // FieldGet If lNoAls; xVal := Eval( oCol:bData ) Else ; xVal := (cAlias)->( Eval( oCol:bData ) ) EndIf Else // FieldPut If HB_ISBLOCK(oCol:bEncode) nCol := hb_defaultValue( nCol, ::nCell ) If lNoAls xVal := Eval( oCol:bEncode, xVal, Self, nCol ) Else xVal := (cAlias)->( Eval( oCol:bEncode, xVal, Self, nCol ) ) EndIf EndIf If lNoAls; Eval( oCol:bData, xVal ) Else ; (cAlias)->( Eval( oCol:bData, xVal ) ) EndIf EndIf RETURN xVal ... METHOD PostEdit( uTemp, nCol, bValid ) CLASS TSBrowse ... If Eval( If( ! ::lAppendMode, bRecLock, bAddRec ), uTemp ) // Eval( ::aColumns[ nCol ]:bData, uTemp, Self ) ::bDataEval( ::aColumns[ nCol ], uTemp, nCol ) SysRefresh() If lAppend If ! Empty( ::aDefault ) ASize( ::aDefault, Len( ::aColumns ) ) AEval( ::aDefault, { | e, n | If( e != Nil .and. n != nCol, If( Valtype( e ) == "B", ; ::bDataEval( ::aColumns[ n ], Eval( e, Self ), n ), ; ::bDataEval( ::aColumns[ n ], e, n ) ), Nil ) } ) // Eval( ::aColumns[ n ]:bData, Eval( e, Self ) ), ; // Eval( ::aColumns[ n ]:bData, e ) ), Nil ) } ) ::DrawLine() EndIf ... EndIf // Eval( ::aColumns[ nCol ]:bData, uTemp ) ::bDataEval( ::aColumns[ nCol ], uTemp, nCol ) SysRefresh() If ::aColumns[ nCol ]:bPostEdit != Nil Eval( ::aColumns[ nCol ]:bPostEdit, uTemp, Self, lAppend ) EndIf ... If lAppend If ! Empty( ::aDefault ) ASize( ::aDefault, Len( ::aColumns ) ) AEval( ::aDefault, { | e, n | If( e != Nil .and. n != nCol, If( Valtype( e ) == "B", ; ::bDataEval( ::aColumns[ n ], Eval( e, Self ), n ), ::bDataEval( ::aColumns[ n ], e, n ) ), Nil ) } ) // Eval( ::aColumns[ n ]:bData, Eval( e, Self ) ), Eval( ::aColumns[ n ]:bData, e ) ), Nil ) } ) EndIf ::DrawLine() EndIf ... запись в таблицу будет проще решать при работе с CHARSET [/pre2]

SergKis: PS Можно перенести в :bDataEval и :bDecode, тогда изменения такие [pre2] METHOD bDataEval( oCol, xVal, nCol ) CLASS TSBrowse LOCAL cAlias := oCol:cAlias LOCAL lNoAls := Empty(cAlias) .or. '->' $ oCol:cField If xVal == Nil // FieldGet If lNoAls; xVal := Eval( oCol:bData ) Else ; xVal := (cAlias)->( Eval( oCol:bData ) ) EndIf If HB_ISBLOCK(oCol:bDecode) .and. nCol != Nil If lNoAls; xVal := Eval( oCol:bDecode, xVal, Self, nCol ) Else ; xVal := (cAlias)->( Eval( oCol:bDecode, xVal, Self, nCol ) ) EndIf EndIf Else // FieldPut If HB_ISBLOCK(oCol:bEncode) nCol := hb_defaultValue( nCol, ::nCell ) If lNoAls xVal := Eval( oCol:bEncode, xVal, Self, nCol ) Else xVal := (cAlias)->( Eval( oCol:bEncode, xVal, Self, nCol ) ) EndIf EndIf If lNoAls; Eval( oCol:bData, xVal ) Else ; (cAlias)->( Eval( oCol:bData, xVal ) ) EndIf EndIf RETURN xVal ... METHOD DrawLine( xRow ) CLASS TSBrowse ... ElseIf cColAls != Nil If HB_ISBLOCK( oColumn:bSeek ) ( cColAls )->( Eval( oColumn:bSeek, Self, nJ ) ) EndIf uData := ::bDataEval( oColumn, , nJ ) // uData := ( cColAls )->( Eval( oColumn:bData ) ) // If Valtype( oColumn:bDecode ) == 'B' // uData := ( cColAls )->( Eval( oColumn:bDecode, uData, Self, nJ ) ) // EndIf Else If HB_ISBLOCK( oColumn:bSeek ) Eval( oColumn:bSeek, Self, nJ ) EndIf uData := ::bDataEval( oColumn, , nJ ) // uData := Eval( oColumn:bData ) // If Valtype( oColumn:bDecode ) == 'B' // uData := Eval( oColumn:bDecode, uData, Self, nJ ) // EndIf EndIf ... METHOD DrawSelect( xRow ) CLASS TSBrowse ... ElseIf cColAls != Nil If HB_ISBLOCK( oColumn:bSeek ) ( cColAls )->( Eval( oColumn:bSeek, Self, nJ ) ) EndIf uData := ::bDataEval( oColumn, , nJ ) // uData := ( cColAls )->( Eval( oColumn:bData ) ) // If HB_ISBLOCK( oColumn:bDecode ) // uData := ( cColAls )->( Eval( oColumn:bDecode, uData, Self, nJ ) ) // EndIf Else If HB_ISBLOCK( oColumn:bSeek ) Eval( oColumn:bSeek, Self, nJ ) EndIf uData := ::bDataEval( oColumn, , nJ ) // uData := Eval( oColumn:bData ) // If HB_ISBLOCK( oColumn:bDecode ) // uData := Eval( oColumn:bDecode, uData, Self, nJ ) // EndIf EndIf ... [/pre2]

SergKis: PS Пример из поста 1940 этой темы, работает нормально https://my-files.ru/dofcn3

gfilatov2002: SergKis пишет: Можно перенести в :bDataEval и :bDecode Выполнил предложенные изменения. Благодарю за помощь

SergKis: gfilatov2002 Еще немного поправил[pre2] METHOD SetGetValue( xCol, xVal ) INLINE ::bDataEval ( xCol, xVal ) METHOD SetValue( xCol, xVal ) INLINE ::SetGetValue( xCol, xVal ) METHOD GetValue( xCol ) INLINE ::SetGetValue( xCol ) ... METHOD bDataEval( oCol, xVal, nCol ) CLASS TSBrowse LOCAL cAlias, lNoAls If ! HB_ISOBJECT( oCol ) nCol := iif( HB_ISCHAR( oCol ), ::nColumn( oCol ), oCol ) oCol := ::aColumns[ nCol ] EndIf cAlias := oCol:cAlias lNoAls := Empty(cAlias) .or. '->' $ oCol:cField If xVal == Nil // FieldGet If lNoAls; xVal := Eval( oCol:bData ) Else ; xVal := (cAlias)->( Eval( oCol:bData ) ) EndIf If HB_ISBLOCK(oCol:bDecode) .and. nCol != Nil If lNoAls; xVal := Eval( oCol:bDecode, xVal, Self, nCol ) Else ; xVal := (cAlias)->( Eval( oCol:bDecode, xVal, Self, nCol ) ) EndIf EndIf Else // FieldPut If HB_ISBLOCK(oCol:bEncode) .and. nCol != Nil If lNoAls; xVal := Eval( oCol:bEncode, xVal, Self, nCol ) Else ; xVal := (cAlias)->( Eval( oCol:bEncode, xVal, Self, nCol ) ) EndIf EndIf If lNoAls; Eval( oCol:bData, xVal ) Else ; (cAlias)->( Eval( oCol:bData, xVal ) ) EndIf EndIf RETURN xVal [/pre2]

gfilatov2002: SergKis пишет: немного поправил Принято с благодарностью

gfilatov2002: Всем кому это интересно Подготовил первый релиз-кандидат для новой сборки библиотеки со следующим списком изменений [pre2] * Fixed: Detected resource leakage at a long changing of a notify icon. It exists in the official version too. Problem was reported by Sasha Savov <savovs/at/gmail.com>. Contributed by Grigory Filatov <gfilatov@inbox.ru> (see demo in folder \samples\Advanced\INET_CHECKER) * Fixed: Processing of the 'ColumnWidthLimits' property in a Grid at the column's adding (problem was introduced in the build 18.07). Contributed by Grigory Filatov <gfilatov@inbox.ru> (see demo in folder \samples\Advanced\ReadXLS) * New: A Grid control supports an optional Grouping feature. As its name suggests, this feature allows you to group items based on a particular information. It's conceptually a way to create horizontal columns to group related sets of items, and use the ListView a bit like a simplified grid control. This feature have the following properties and methods: - <Window>.<Grid>.GroupEnabled [ := | -->] lBoolean - <Window>.<Grid>.GroupDeleteAll - <Window>.<Grid>.GroupDelete ( nGroupID ) - <Window>.<Grid>.GroupExpand ( nGroupID ) - <Window>.<Grid>.GroupCollapsed ( nGroupID ) - <Window>.<Grid>.GroupAdd ( nGroupID [, nPosition ] ) - <Window>.<Grid>.GroupInfo ( nGroupID ) [ := | -->] { [cHeader], [nAlignHeader], [cFooter], [nAlingFooter], [nState] } - <Window>.<Grid>.GroupItemID ( nItem ) [ := | -->] nGroupID - nAlignHeader & nAlingFooter --> GRID_GROUP_LEFT | GRID_GROUP_CENTER | GRID_GROUP_RIGHT - nState --> GRID_GROUP_NORMAL | GRID_GROUP_COLLAPSED - <Window>.<Grid>.GroupDeleteAllItems ( nGroupID ) - <Window>.<Grid>.GroupGetAllItemIndex ( nGroupID ) --> anItemIndex - <Window>.<Grid>.GroupCheckBoxAllItems ( nGroupID ) := lCheck Based upon a contribution of Claudio Soto <srvet@adinet.com.uy>. Adapted for Minigui Extended by Grigory Filatov <gfilatov@inbox.ru> (see demo in folder \samples\Basic\Grid_Groups) * New: Added a possibility to set/get the following hidden properties in a Grid/Browse control at runtime: Form.Browse.HeaderDragDrop [ := | -->] lBoolean Form.Grid.InfoTip [ := | -->] lBoolean The default value of the above properties is TRUE (introduced in the build 2.4.5). Contributed by Grigory Filatov <gfilatov@inbox.ru> (see demo in folder \samples\Advanced\ListViewEx) * Updated: Synchronized Extended HMG for compatibility with Official HMG: - New: it is possible to assign any data type or a list of data in a Label control, e.g. @ ... LABEL ... VALUE xDataType Form.Label.Value := xDataType Form.Label.Value := { xDataType, xDataType, ... } (see demo in folder \samples\Basic\DirectoryRecurse) - New: it is possible to set/get the following properties in a Grid/Browse control at runtime: Form.Browse.PaintDoubleBuffer [ := | -->] lBoolean (see Browse6.prg in folder \samples\Basic\Browse_3) Form.Grid.CheckBoxEnabled [ := | -->] lBoolean (see demo in folder \samples\Basic\CheckBox_Grid) - Fixed: 'This' object reference incorrect on Grid VALID procedure. (see demo in folder \samples\Basic\Grid_Virtual) - Modified: when loads a Grid control and 'ColumnControls' property is NIL then converts automatically any data type in a text type, this avoids that column appears with the empty values. (see demo4.prg in folder \samples\Basic\Grid_Test) Based upon a contribution of Claudio Soto <srvet@adinet.com.uy>. Adapted for Minigui Extended by Grigory Filatov <gfilatov@inbox.ru> * Modified: The improved function cValToChar() was moved to MiniGUI core. A dependance of Minigui core from the tsbrowse library was removed (introduced in the build 18.02). Contributed by Grigory Filatov <gfilatov@inbox.ru> (see demo.prg in folder \samples\Basic\Grid_Test) * Updated: Adaptation FiveWin Class TSBrowse 9.0 in HMG: - New: added the optional code block :bEncode in TSColumn class. - Modified: replace Eval( oCol:bData ) with ::bDataEval( oCol ). - Updated: modifications in the methods bDataEval() and PostEdit(). - Updated: modification in the methods DrawLine() and DrawSelect(). Suggested and contributed by Sergej Kiselev. * Updated: Harbour Compiler 3.2.0dev (SVN 2018-06-04 01:30): * Updated: OpenSSL wrapper for using of the version 1.0.2o. Contributed by Grigory Filatov <gfilatov@inbox.ru> (look at ReadMe.txt in folder \harbour) * New: 'How to set/get a number of visible rows in a Grid control' sample. Contributed by Grigory Filatov <gfilatov@inbox.ru> (see demo4.prg in folder \samples\Basic\Grid_Test) * New: 'Simple app for test of Virtual Grid' sample. Based upon a contribution of Marek Olszewski <mol/at/pro.onet.pl>. Adapted for Minigui Extended by Grigory Filatov <gfilatov@inbox.ru> (see in folder \samples\Basic\Grid_Virtual) * Updated: 'Print Pie Graph' sample: updated the data for July 2018. Contributed by Grigory Filatov <gfilatov@inbox.ru> (see demo.prg in folder \samples\Basic\GraphPrint) * Updated: 'Hyper Link' sample: added calling of the function HMG_CallDLL(). Contributed by Grigory Filatov <gfilatov@inbox.ru> (see in folder \samples\Basic\HYPERLINK) * Updated: MAINDEMO (SYNTAX I) sample: updated a notify icon handling. Contributed by Grigory Filatov <gfilatov@inbox.ru> (see at folder \samples\Basic\MAINDEMO_(SYNTAX_I)) * Updated: 'Multi RichEditEx' sample: - fixed the Save options without an opened RTF file. Contributed by Pierpaolo Martinello <pier.martinello[at]alice.it> (see in folder \samples\Advanced\RicheditEx_2) [/pre2] Благодарю за Ваше внимание P.S. И немного о грустном: Кузьме Скрябину сегодня исполнилось бы 50 лет...

SergKis: gfilatov2002 Возможно будет интересно (альтернатива :bData). Ввел в TsColumns DATA bValue. [pre2] METHOD bDataEval( oCol, xVal, nCol ) CLASS TSBrowse LOCAL cAlias, lNoAls If ! HB_ISOBJECT( oCol ) nCol := iif( HB_ISCHAR( oCol ), ::nColumn( oCol ), oCol ) oCol := ::aColumns[ nCol ] EndIf cAlias := oCol:cAlias lNoAls := Empty(cAlias) .or. '->' $ oCol:cField If xVal == Nil // FieldGet If HB_ISBLOCK(oCol:bValue) If lNoAls; xVal := Eval( oCol:bValue , NIL , Self, nCol, oCol ) Else ; xVal := (cAlias)->( Eval( oCol:bValue , NIL , Self, nCol, oCol ) ) EndIf Else If lNoAls; xVal := Eval( oCol:bData ) Else ; xVal := (cAlias)->( Eval( oCol:bData ) ) EndIf EndIf If HB_ISBLOCK(oCol:bDecode) .and. nCol != Nil If lNoAls; xVal := Eval( oCol:bDecode, xVal, Self, nCol ) Else ; xVal := (cAlias)->( Eval( oCol:bDecode, xVal, Self, nCol ) ) EndIf EndIf Else // FieldPut If HB_ISBLOCK(oCol:bEncode) .and. nCol != Nil If lNoAls; xVal := Eval( oCol:bEncode, xVal, Self, nCol ) Else ; xVal := (cAlias)->( Eval( oCol:bEncode, xVal, Self, nCol ) ) EndIf EndIf If HB_ISBLOCK(oCol:bValue) If lNoAls; xVal := Eval( oCol:bValue , xVal, Self, nCol, oCol ) Else ; xVal := (cAlias)->( Eval( oCol:bValue , xVal, Self, nCol, oCol ) ) EndIf Else If lNoAls; Eval( oCol:bData , xVal ) Else ; (cAlias)->( Eval( oCol:bData , xVal ) ) EndIf EndIf EndIf RETURN xVal [/pre2] Использование[pre2] oColum:cName := 'MET' oColum:lChecBox := .T. oColum:Cargo := oKeyData() // контейнер\список для recno отмеченных записей oColum:bValue := {|xval,obrw,ncol,ocol| ; xval := ocol:Cargo:Get((obrw:cAlias)->( RecNo() )), ; ncol := ! empty(xval) } // .T. - при наличии в контейнере ... oBrw:UserKeys( VK_SPACE, {|obr| Local oCol := obr:aColumns[obr:nCell] Local nRec If oCol:cName == 'MET' nRec := (obr:cAlias)->( RecNo() ) If empty(oCol:Cargo:Get(nRec)) // добавим в список oCol:Cargo:Set(nRec, nRec) Else oCol:Cargo:Del(nRec) // уберем из списка EndIf EndIf Return Nil } ) [/pre2]

Andrey: gfilatov2002 пишет: Подготовил первый релиз-кандидат для новой сборки библиотеки со следующим списком изменений Что то не увидел свой пример CallDll2 ? Старался его сделать для других, чтобы было понятно как загружать чужие и свои DLL-ки.

gfilatov2002: Andrey пишет: не увидел свой пример CallDll2 Верно. Andrey пишет: как загружать чужие и свои DLL-ки В этом примере есть Харбор, Си, DLL, но очень мало собственно МиниГУИ. Поэтому пример не вошел в следующую сборку. Если будет интерес в использовании DLL у пользователей, то, конечно, добавлю Ваш пример

gfilatov2002: SergKis пишет: Ввел в TsColumns DATA bValue Принято, конечно. Благодарю за помощь

SergKis: SergKis пишет Использование oColum:cName := 'MET' oColum:lChecBox := .T. oColum:Cargo := oKeyData() // контейнер\список для recno отмеченных записей oColum:bValue := {|xval,obrw,ncol,ocol| ; xval := ocol:Cargo:Get((obrw:cAlias)->( RecNo() )), ; ncol := ! empty(xval) } // .T. - при наличии в контейнере ... oBrw:UserKeys( VK_SPACE, {|obr| Local oCol := obr:aColumns[obr:nCell] Local nRec If oCol:cName == 'MET' nRec := (obr:cAlias)->( RecNo() ) If empty(oCol:Cargo:Get(nRec)) // добавим в список oCol:Cargo:Set(nRec, nRec) Else oCol:Cargo:Del(nRec) // уберем из списка EndIf EndIf Return Nil } ) все проще (по привычке смешал в кучу старое, новое) :UserKeys не надо, достаточно :bValue[pre2] oCol:cAlias := "BASE" oCol:lCheckBox := .T. oCol:lEdit := .T. oCol:Cargo := oKeyData() oCol:bValue := {|xv,ob,nc,oc| Local nRec := RecNo() If xv == Nil xv := ! empty(oc:Cargo:Get(nRec)) ElseIf xv oc:Cargo:Set(nRec, nRec) Else oc:Cargo:Del(nRec) EndIf Return xv } [/pre2]

SergKis: gfilatov2002 пишет Принято Для однотипного вызова, наверно. надо поправить[pre2] METHOD bDataEval( oCol, xVal, nCol ) CLASS TSBrowse ... If lNoAls; xVal := Eval( oCol:bDecode, xVal, Self, nCol, oCol ) Else ; xVal := (cAlias)->( Eval( oCol:bDecode, xVal, Self, nCol, oCol ) ) EndIf ... If lNoAls; xVal := Eval( oCol:bEncode, xVal, Self, nCol, oCol ) Else ; xVal := (cAlias)->( Eval( oCol:bEncode, xVal, Self, nCol, oCol ) ) EndIf ... [/pre2]

SergKis: Упс. Пропало, что выкладывал. Повторю.gfilatov2002 У себя сделал изменения :[pre2]... METHOD bDataEval( oCol, xVal, nCol ) METHOD GetValProp( xVal, xDef, nCol, nAt ) METHOD nClrBackArr( aClrBack, nCol, nAt ) METHOD nColorGet ( xVal, nCol, nAt, lPos ) METHOD nAlignGet ( xVal, nCol, xDef ) METHOD cPictureGet ( xVal, nCol ) METHOD hFontGet ( xVal, nCol ) METHOD hFontHeadGet ( xVal, nCol ) METHOD hFontFootGet ( xVal, nCol ) METHOD hFontSpcHdGet ( xVal, nCol ) METHOD hFontSupHdGet ( nCol, aSuperHead ) METHOD cTextSupHdGet ( nCol, aSuperHead ) METHOD nForeSupHdGet ( nCol, aSuperHead ) METHOD nBackSupHdGet ( nCol, aSuperHead ) METHOD nAlignSupHdGet( nCol, lHAlign, aSuperHead )...METHOD GetValProp( xVal, xDef, nCol, nAt ) CLASS TSBrowse Default nCol := ::nCell If HB_ISBLOCK(xVal) If nAt == Nil; xVal := Eval( xVal, nCol, Self ) Else ; xVal := Eval( xVal, nAt, nCol, Self ) EndIf EndIf If xVal == Nil ; xVal := xDef EndIfRETURN xValMETHOD hFontGet( xVal, nCol ) CLASS TSBrowse LOCAL xDef := iif( ::hFont == Nil, 0, ::hFont ) If HB_ISOBJECT(xVal); xVal := xVal:hFont EndIf xVal := ::GetValProp( xVal, xDef, nCol, ::nAt ) If HB_ISOBJECT(xVal); xVal := xVal:hFont EndIf If xVal == Nil ; xVal := xDef EndIfRETURN xValMETHOD hFontHeadGet( xVal, nCol ) CLASS TSBrowse LOCAL xDef := iif( ::hFont == Nil, 0, ::hFont ) If HB_ISOBJECT(xVal); xVal := xVal:hFontHead EndIf xVal := ::GetValProp( xVal, xDef, nCol, 0 ) If HB_ISOBJECT(xVal); xVal := xVal:hFontHead EndIf If xVal == Nil ; xVal := xDef EndIfRETURN xValMETHOD hFontFootGet( xVal, nCol ) CLASS TSBrowse LOCAL xDef := iif( ::hFont == Nil, 0, ::hFont ) If HB_ISOBJECT(xVal); xVal := xVal:hFontFoot EndIf xVal := ::GetValProp( xVal, xDef, nCol, 0 ) If HB_ISOBJECT(xVal); xVal := xVal:hFontFoot EndIf If xVal == Nil ; xVal := xDef EndIfRETURN xValMETHOD hFontSpcHdGet( xVal, nCol ) CLASS TSBrowse LOCAL xDef := iif( ::hFont == Nil, 0, ::hFont ) If HB_ISOBJECT(xVal); xVal := xVal:hFontSpcHd EndIf xVal := ::GetValProp( xVal, xDef, nCol, 0 ) If HB_ISOBJECT(xVal); xVal := xVal:hFontSpcHd EndIf If xVal == Nil ; xVal := xDef EndIfRETURN xValMETHOD hFontSupHdGet( nCol, aSuperHead ) CLASS TSBrowse LOCAL xDef := iif( ::hFont == Nil, 0, ::hFont ) LOCAL xVal Default nCol := 1, aSuperHead := ::aSuperHead If nCol > 0 .and. nCol <= Len( aSuperHead ) xDef := ::GetValProp( aSuperHead[ 1, 7 ], xDef, 1 ) xVal := ::GetValProp( aSuperHead[ nCol, 7 ], xDef, nCol ) EndIf If xVal == Nil; xVal := xDef EndIfRETURN xValMETHOD cTextSupHdGet( nCol, aSuperHead ) CLASS TSBrowse LOCAL xDef := '', xVal Default nCol := 1, aSuperHead := ::aSuperHead If nCol > 0 .and. nCol <= Len( aSuperHead ) xVal := ::GetValProp( aSuperHead[ nCol, 3 ], xDef, nCol ) EndIf If xVal == Nil; xVal := xDef EndIfRETURN xValMETHOD nForeSupHdGet( nCol, aSuperHead ) CLASS TSBrowse LOCAL xDef := ::nClrText, xVal Default nCol := 1, aSuperHead := ::aSuperHead If nCol > 0 .and. nCol <= Len( aSuperHead ) xDef := ::GetValProp( aSuperHead[ 1, 4 ], xDef, 1 ) xVal := ::GetValProp( aSuperHead[ nCol, 4 ], xDef, nCol ) EndIf If xVal == Nil; xVal := xDef EndIf RETURN xValMETHOD nBackSupHdGet( nCol, aSuperHead ) CLASS TSBrowse LOCAL xDef := ::nClrPane, xVal LOCAL nPos := 0 If HB_ISNUMERIC( aSuperHead ) nPos := aSuperHead aSuperHead := Nil EndIf Default nCol := 1, aSuperHead := ::aSuperHead If nCol > 0 .and. nCol <= Len( aSuperHead ) xDef := ::GetValProp( aSuperHead[ 1, 5 ], xDef, 1 ) xVal := ::GetValProp( aSuperHead[ nCol, 5 ], xDef, nCol ) EndIf If xVal == Nil; xVal := xDef EndIf If HB_ISARRAY(xVal) xVal := ::nClrBackArr( xVal, nCol ) If nPos > 0 If empty( xVal[1] ) nPos := 2 EndIf xVal := xVal[ iif( nPos == 1, 1, 2 ) ] EndIf EndIf RETURN xValMETHOD nAlignSupHdGet( nCol, lHAlign, aSuperHead ) CLASS TSBrowse LOCAL xDef := DT_CENTER, xVal, nPos Default nCol := 1, lHAlign := .T., aSuperHead := ::aSuperHead If nCol > 0 .and. nCol <= Len( aSuperHead ) nPos := iif( lHAlign, 12, 13 ) xDef := ::GetValProp( aSuperHead[ 1, nPos ], xDef, 1 ) xVal := ::GetValProp( aSuperHead[ nCol, nPos ], xDef, nCol ) EndIf If xVal == Nil; xVal := xDef EndIf RETURN xValMETHOD nAlignGet( xVal, nCol, xDef ) CLASS TSBrowseRETURN ::GetValProp( xVal, hb_default(xDef, DT_LEFT), nCol )METHOD nColorGet( xVal, nCol, nAt, lPos ) CLASS TSBrowse LOCAL xDef := ::nClrPane LOCAL nPos := 0 If lPos != Nil nPos := iif( empty(lPos), 2, 1 ) EndIf xVal := ::GetValProp( xVal, xDef, nCol, nAt ) If ValType( xVal ) == "A" xVal := ::nClrBackArr( xVal, nCol, nAt ) If nPos > 0 xVal := xVal[ nPos ] EndIf EndIfRETURN xValMETHOD cPictureGet( xVal, nCol ) CLASS TSBrowse If HB_ISOBJECT(xVal); xVal := xVal:cPicture EndIfRETURN ::GetValProp( xVal, Nil, nCol, ::nAt )METHOD nClrBackArr( aClrBack, nCol, nAt ) CLASS TSBrowse LOCAL nClrBack, nClrTo Default nCol := ::nCell nClrBack := aClrBack[ 1 ] nClrTo := aClrBack[ 2 ] If HB_ISBLOCK(nClrTo) If nAt == Nil; nClrTo := Eval( nClrTo , nCol, Self ) Else ; nClrTo := Eval( nClrTo , nAt, nCol, Self ) EndIf EndIf If HB_ISBLOCK(nClrBack) If nAt == Nil; nClrBack := Eval( nClrBack, nCol, Self ) Else ; nClrBack := Eval( nClrBack, nAt, nCol, Self ) EndIf EndIf If nAt != Nil .and. nCol == 1 .and. ! Empty( ::hBmpCursor ) nClrTo *= -1 EndIfRETURN { nClrBack, nClrTo }...METHOD DrawHeaders( lFooters ) CLASS TSBrowse... If ::lDrawHeaders .and. ! lFooters nVertText := 0 lOrder := ::nColOrder == nJ lDescend := oColumn:lDescend If LoWord( oColumn:nHAlign ) == DT_VERT cHeading := "Arial" hFont := InitFont ( cHeading, -11, .f., .f., .f. , .f. , 900 ) nVAlign := 2 nVertText := 1 Else // hFont := If( oColumn:hFontHead == Nil, ::hFont, oColumn:hFontHead )// hFont := If( ValType( hFont ) == "B", Eval( hFont, 0, nJ, Self ), ;// hFont ) hFont := ::hFontHeadGet( oColumn, nJ ) EndIf l3DLook := oColumn:l3DLookHead nAlign := ::nAlignGet( oColumn:nHAlign, nJ, DT_CENTER )// nAlign := If( ValType( oColumn:nHAlign ) == "B", ;// Eval( oColumn:nHAlign, nJ, Self ), oColumn:nHAlign ) If ( nClrFore := If( ::nColOrder == nI, oColumn:nClrOrdeFore, ; oColumn:nClrHeadFore ) ) == Nil nClrFore := If( ::nColOrder == nI, nClrOrdeFore, ; nClrHeadFore ) EndIf nClrFore := ::GetValProp( nClrFore, nClrFore, nJ )// nClrFore := If( ValType( nClrFore ) == "B", Eval( nClrFore, nJ, Self ), nClrFore ) If !( nJ == 1 .and. ::lSelector ) If ( nClrBack := If( ::nColOrder == nI, oColumn:nClrOrdeBack, oColumn:nClrHeadBack ) ) == Nil nClrBack := If( ::nColOrder == nI, nClrOrdeBack, nClrHeadBack ) EndIf else nClrBack := iif( ::nClrSelectorHdBack == Nil, ATail( ::aColumns ):nClrHeadBack, ::nClrSelectorHdBack ) endif nClrBack := ::GetValProp( nClrBack, nClrBack, nJ )// nClrBack := If( ValType( nClrBack ) == "B", Eval( nClrBack, nJ, Self ), nClrBack ) lBrush := Valtype( nClrBack ) == "O" If ValType( nClrBack ) == "A" nClrBack := ::nClrBackArr( nClrBack, nJ ) nClrTo := nClrBack[ 2 ] nClrBack := nClrBack[ 1 ]// nClrTo := If( ValType( nClrTo ) == "B", Eval( nClrTo ), nClrTo )// nClrBack := If( ValType( nClrBack ) == "B", Eval( nClrBack ), nClrBack ) Else nClrTo := nClrBack EndIf... IF ::lDrawSpecHd // hFont := If( oColumn:hFontSpcHd == Nil, ::hFont, oColumn:hFontSpcHd )// hFont := If( ValType( hFont ) == "B", Eval( hFont, 0, nJ, Self ), hFont ) hFont := ::hFontSpcHdGet( oColumn, nJ ) l3DLook := oColumn:l3DLookHead nAlign := ::nAlignGet( oColumn:nSAlign, nJ, DT_CENTER )// nAlign := If( ValType( oColumn:nSAlign ) == "B", Eval( oColumn:nSAlign, nJ, Self ), oColumn:nSAlign ) If ( nClrFore := If( ::nColOrder == nI, oColumn:nClrOrdeFore, oColumn:nClrSpcHdFore ) ) == Nil nClrFore := If( ::nColOrder == nI, nClrOrdeFore, nClrSpcHdFore ) EndIf nClrFore := ::GetValProp( nClrFore, nClrFore, nJ )// nClrFore := If( ValType( nClrFore ) == "B", Eval( nClrFore, nJ, Self ), nClrFore ) nClrBacks := If( ::nPhantom == -1, ATail( ::aColumns ):nClrSpcHdBack, nClrPane )// nClrBackS := If( ValType( nClrBackS ) == "B", Eval( nClrBackS, nJ, Self ), nClrBackS ) nClrBackS := ::GetValProp( nClrBackS, nClrBackS, nJ ) lBrush := Valtype( nClrBackS ) == "O" If ValType( nClrBackS ) == "A" nClrBackS := ::nClrBackArr( nClrBackS, nJ ) nClrToS := nClrBackS[ 2 ] nClrBackS := nClrBackS[ 1 ]// nClrToS := If( ValType( nClrToS ) == "B", Eval( nClrToS ), nClrToS )// nClrBackS := If( ValType( nClrBackS ) == "B", Eval( nClrBackS ), nClrBackS ) Else nClrToS := nClrBackS EndIf if ::lEnum cHeading := AllTrim(Str(nI - iif(::lSelector, 1, 0))) if nI == nBegin .and. ::lSelector .or. nI == nLastCol cHeading := "" endif else cHeading := If( Valtype( oColumn:cSpcHeading ) == "B", Eval( oColumn:cSpcHeading, nJ, Self ), oColumn:cSpcHeading ) If Empty( oColumn:cPicture ) cHeading := If( Valtype( cHeading ) != "C", cValToChar( cHeading ), cHeading ) Else cHeading := If( cHeading == NIL, "", Transform( cHeading, oColumn:cPicture ) ) EndIf// nAlign := oColumn:nAlign nAlign := ::nAlignGet( oColumn:nAlign, nJ, DT_CENTER ) nClrBackS := If( Empty(cHeading), nClrBackS, CLR_HRED ) nClrBackS := If( oColumn:lEditSpec, nClrBackS, nClrBack ) nClrToS := If( oColumn:lEditSpec, nClrToS , nClrTo ) ENDIF... If ::lFooting .and. ::lDrawFooters // hFont := If( oColumn:hFontFoot == Nil, ::hFont, oColumn:hFontFoot )// hFont := If( ValType( hFont ) == "B", Eval( hFont, 0, nJ, Self ), hFont ) hFont := ::hFontFootGet( oColumn, nJ ) l3DLook := oColumn:l3DLookFoot ::oPhant:l3DLookFoot := l3DLook nAlign := ::nAlignGet( oColumn:nFAlign, nJ, DT_CENTER )// nAlign := If( ValType( oColumn:nFAlign ) == "B", Eval( oColumn:nFAlign ), oColumn:nFAlign ) nClrFore := If( oColumn:nClrFootFore != Nil, oColumn:nClrFootFore , nClrFootFore ) nClrFore := ::GetValProp( nClrFore, nClrFore, nJ )// nClrFore := If( ValType( nClrFore ) == "B", Eval( nClrFore, nJ, Self ), nClrFore ) If !( nJ == 1 .and. ::lSelector ) //JP nClrBack := If( oColumn:nClrFootBack != Nil, oColumn:nClrFootBack, nClrFootBack ) Else nClrBack := ATail( ::aColumns ):nClrFootBack EndIf nClrBack := ::GetValProp( nClrBack, nClrBack, nJ )// nClrBack := If( ValType( nClrBack ) == "B", Eval( nClrBack, nJ, Self ), nClrBack ) lBrush := Valtype( nClrBack ) == "O" If ValType( nClrBack ) == "A" nClrBack := ::nClrBackArr( nClrBack, nJ ) nClrTo := nClrBack[ 2 ] nClrBack := nClrBack[ 1 ]// nClrTo := If( ValType( nClrTo ) == "B", Eval( nClrTo ), nClrTo )// nClrBack := If( ValType( nClrBack ) == "B", Eval( nClrBack ), nClrBack ) Else nClrTo := nClrBack EndIf...METHOD DrawLine( xRow ) CLASS TSBrowse... For nI := nBegin To nLastCol If nStartCol > nMaxWidth Exit EndIf nJ := If( nI < ::nColPos, nJ + 1, nI ) lSelected := If( nJ == nLastCol, .F., lSelected ) oColumn := If( nJ > Len( ::aColumns ), ::oPhant, ::aColumns[ nJ ] )// cPicture := If( ValType( oColumn:cPicture ) == "B", Eval( oColumn:cPicture, ::nAt, nJ, Self ), ;// oColumn:cPicture )// hFont := If( oColumn:hFont == Nil, ::hFont, oColumn:hFont )// hFont := If( ValType( hFont ) == "B", Eval( hFont, ::nAt, nJ, Self ), ;// hFont ) cPicture := ::cPictureGet( oColumn, nJ ) hFont := ::hFontGet ( oColumn, nJ )// hFont := If( hFont == Nil, 0, hFont ) cColAls := If( '->' $ oColumn:cField, Nil, oColumn:cAlias )... EndIf// nAlign := If( ValType( nAlign ) == "B", Eval( nAlign, nJ, Self ), nAlign ) nAlign := ::nAlignGet( oColumn:nAlign, nJ, DT_LEFT ) If ( nClrFore := oColumn:nClrFore ) == Nil .or. ( lSelected .and. ::uBmpSel == Nil ) nClrFore := If( ! lSelected, nClrText, ::nClrSeleFore ) EndIf nClrFore := ::GetValProp( nClrFore, nClrFore, nJ, ::nAt )// nClrFore := If( Valtype( nClrFore ) == "B", Eval( nClrFore, ::nAt, nJ, Self ), nClrFore ) If ( nClrBack := oColumn:nClrBack ) == Nil .or. ; ( lSelected .and. ::uBmpSel == Nil ) nClrBack := If( ! lSelected, nClrPane, ::nClrSeleBack ) EndIf nClrBack := ::GetValProp( nClrBack, nClrBack, nJ, ::nAt )// nClrBack := If( Valtype( nClrBack ) == "B", Eval( nClrBack, ::nAt, nJ, Self ), nClrBack ) lBrush := Valtype( nClrBack ) == "O" If ValType( nClrBack ) == "A" nClrBack := ::nClrBackArr( nClrBack, nJ, ::nAt ) nClrTo := nClrBack[ 2 ] nClrBack := nClrBack[ 1 ]// nClrTo := If( ValType( nClrTo ) == "B", Eval( nClrTo ), nClrTo )// nClrBack := If( ValType( nClrBack ) == "B", Eval( nClrBack ), nClrBack )//// If nJ == 1 .and. ! Empty( ::hBmpCursor )// nClrTo *= -1// EndIf Else nClrTo := nClrBack EndIf...METHOD DrawSelect( xRow ) CLASS TSBrowse... For nI := nBegin To nLastCol If nStartCol > nMaxWidth Exit EndIf nJ := If( nI < ::nColPos, nJ + 1, nI ) oColumn := If( nJ > Len( ::aColumns ), ::oPhant, ::aColumns[ nJ ] )// hFont := If( oColumn:hFont == Nil, ::hFont, oColumn:hFont )// hFont := If( ValType( hFont ) == "B", Eval( hFont, ::nAt, nI, Self ), hFont ) hFont := ::hFontGet( oColumn, nJ )// hFont := If( hFont == Nil, 0, hFont ) lAdjBmp := oColumn:lAdjBmp nAlign := oColumn:nAlign lOpaque := .T. lMulti := .F. cColAls := If( '->' $ oColumn:cField, Nil, oColumn:cAlias )... lMulti := Valtype( uData ) == "C" .and. At( Chr( 13 ), uData ) > 0// cPicture := If( ValType( oColumn:cPicture ) == "B", Eval( oColumn:cPicture, ::nAt, nJ, Self ), ;// oColumn:cPicture ) cPicture := ::cPictureGet( oColumn, nJ ) lCheck := ( oColumn:lCheckBox .and. ValType( uData ) == "L" .and. oColumn:lVisible ) lNoLite := oColumn:lNoLite nVertText := 0 If lCheck... nAlign := ::nAlignGet( oColumn:nAlign, nJ, DT_LEFT )// nAlign := If( ValType( nAlign ) == "B", Eval( nAlign, nJ, Self ), nAlign ) If lNoLite// If ( nClrFore := oColumn:nClrFore ) == Nil// nClrFore := nClrText// EndIf//// nClrFore := If( Valtype( nClrFore ) == "B", Eval( nClrFore, ::nAt, nJ, Self ), nClrFore ) nClrFore := ::GetValProp( oColumn:nClrFore, nClrText, nJ, ::nAt ) nClrBack := ::GetValProp( oColumn:nClrBack, nClrPane, nJ, ::nAt ) // If ( nClrBack := oColumn:nClrBack ) == Nil// nClrBack := nClrPane// EndIf//// nClrBack := If( Valtype( nClrBack ) == "B", Eval( nClrBack, ::nAt, nJ, Self ), nClrBack ) nCursor := 0 Else If ( nClrFore := If( lFocused, oColumn:nClrFocuFore, oColumn:nClrSeleFore ) ) == Nil nClrFore := If( lFocused, nClrFocuFore, nClrSeleFore ) EndIf nClrFore := ::GetValProp( nClrFore, nClrFore, nJ, ::nAt )// nClrFore := If( Valtype( nClrFore ) == "B", Eval( nClrFore, ::nAt, nJ, Self ), nClrFore ) If ( nClrBack := If( lFocused, oColumn:nClrFocuBack, oColumn:nClrSeleBack ) ) == Nil nClrBack := If( lFocused, nClrFocuBack, nClrSeleBack ) EndIf nClrBack := ::GetValProp( nClrBack, nClrBack, nJ, ::nAt )// nClrBack := If( Valtype( nClrBack ) == "B", Eval( nClrBack, ::nAt, nJ, Self ), nClrBack ) If ValType( nClrBack ) == "N" .and. nClrBack < 0 nCursor := Abs( nClrBack ) nClrBack := ::GetValProp( oColumn:nClrBack, nClrPane, nJ, ::nAt )// If ( nClrBack := oColumn:nClrBack ) == Nil// nClrBack := nClrPane// EndIf//// nClrBack := If( Valtype( nClrBack ) == "B", Eval( nClrBack, ::nAt, nJ, Self ), nClrBack ) Else nCursor := 0 EndIf EndIf If ValType( nClrBack ) == "A" nClrBack := ::nClrBackArr( nClrBack, nJ, ::nAt ) nClrTo := nClrBack[2] nClrBack := nClrBack[1]// nClrTo := nClrBack[ 2 ]// nClrBack := nClrBack[ 1 ]// nClrTo := If( ValType( nClrTo ) == "B", Eval( nClrTo ), nClrTo )// nClrBack := If( ValType( nClrBack ) == "B", Eval( nClrBack ), nClrBack )// If nJ == 1 .and. ! Empty( ::hBmpCursor )// nClrTo *= -1// EndIf Else nClrTo := nClrBack EndIf...METHOD DrawSuper() CLASS TSBrowse... If Empty( ::aColumns ) Return Nil EndIf// nClrText := aSuperHead[ 1, 4 ]// nClrBack := aSuperHead[ 1, 5 ] nClrText := ::nForeSupHdGet( 1, aSuperHead ) nClrBack := ::nBackSupHdGet( 1, aSuperHead ) l3DLook := aSuperHead[ 1, 6 ]// hFont := aSuperHead[ 1, 7 ] hFont := ::hFontSupHdGet( 1, aSuperHead ) nLineStyle := aSuperHead[ 1, 10 ] nClrLine := aSuperHead[ 1, 11 ]... EndDo nI := Len( aSuperHead )// nClrText := aSuperHead[ nI, 4 ]// nClrBack := aSuperHead[ nI, 5 ] nClrText := ::nForeSupHdGet( nI, aSuperHead ) nClrBack := ::nBackSupHdGet( nI, aSuperHead ) l3DLook := aSuperHead[ nI, 6 ]// hFont := aSuperHead[ nI, 7 ] hFont := ::hFontSupHdGet( nI, aSuperHead ) nLineStyle := aSuperHead[ nI, 10 ] nClrLine := aSuperHead[ nI, 11 ]... For nI := nS To Len( aSuperHead ) + 1 If nStartCol > nMaxWidth Exit EndIf If nI <= Len( aSuperHead )// nClrFore := If( ValType( aSuperHead[ nI, 4 ] ) == "B", Eval( aSuperHead[ nI, 4 ] ), aSuperHead[ nI, 4 ] )// nClrBack := If( ValType( aSuperHead[ nI, 5 ] ) == "B", Eval( aSuperHead[ nI, 5 ] ), aSuperHead[ nI, 5 ] ) nClrText := ::nForeSupHdGet( nI, aSuperHead ) nClrBack := ::nBackSupHdGet( nI, aSuperHead ) lBrush := Valtype( nClrBack ) == "O" If ValType( nClrBack ) == "A" nClrBack := ::nClrBackArr( nClrBack, nI ) nClrTo := nClrBack[ 2 ] nClrBack := nClrBack[ 1 ]// nClrTo := If( ValType( nClrTo ) == "B", Eval( nClrTo ), nClrTo )// nClrBack := If( ValType( nClrBack ) == "B", Eval( nClrBack ), nClrBack ) Else nClrTo := nClrBack EndIf// cHeading := aSuperHead[ nI, 3 ]// cHeading := If( Valtype( cHeading ) == "B", Eval( cHeading ), cHeading ) cHeading := ::cTextSupHdGet( nI, aSuperHead ) lMulti := Valtype( cHeading ) == "C" .and. At( Chr( 13 ), cHeading ) > 0 l3DLook := aSuperHead[ nI, 6 ]// hFont := aSuperHead[ nI, 7 ] hFont := ::hFontSupHdGet( nI, aSuperHead ) hBitMap := aSuperHead[ nI, 8 ]... Else cHeading := "" nWidth := ::nPhantom hBitmap := 0 lOpaque := .F. nClrBack := If( ::nPhantom == -2, nClrPane, Atail( aSuperHead)[ 5 ] )// nClrBack := If( ValType( nClrBack ) == "B", Eval( nClrBack ), nClrBack ) nClrBack := ::GetValProp( nClrBack, nClrBack, nI ) If ValType( nClrBack ) == "A" nClrBack := ::nClrBackArr( nClrBack, nI ) nClrTo := nClrBack[ 2 ] nClrBack := nClrBack[ 1 ]// nClrTo := If( ValType( nClrTo ) == "B", Eval( nClrTo ), nClrTo )// nClrBack := If( ValType( nClrBack ) == "B", Eval( nClrBack ), nClrBack ) Else nClrTo := nClrBack endif EndIf...[/pre2]Пример Tsb_Brw2Xml с исп. new методов (tsb4xml.prg) и hb_tsbrowse.prg тут https://my-files.ru/6fmntp

SergKis: PS Правка tsb4xml.prg[pre2] METHOD StyleFooter() CLASS Tsb2Xml2Xls ... // If empty( ::nClrHead ) If empty( ::nClrFoot ) nColor := :nColorGet( oCol:nClrFootBack, i ) // nColor := :nColorGet( oCol:nClrFootBack, i ) nColor := ::StyleColor( nColor ) Else // nColor := ::nClrHead nColor := ::nClrFoot EndIf ... [/pre2]

gfilatov2002: SergKis пишет: Пропало, что выкладывал. Повторю. Благодарю за настойчивость Изменения приняты

Andrey: Если будет интерес в использовании DLL у пользователей, то, конечно, добавлю Ваш пример У меня есть интерес, да думаю и другим будет интересен пример: Как собрать свои отдельные модули в отдельной dll-ке и вызов их из главной программы ? Причём как туда в dll-ку можно передать параметры (массив и другие) ? Попытался сам сделать это и не смог. Хочу свой большой проект разделить на части. Вынести готовые (которые не подвегаются правке) модули в отделные DLL-ки.

SergKis: Andrey Помнится, ты даже одну собственную либу не хотел делать, боясь запутаться в версиях. А тут несколько dll да еще разных версий hb, hmg, свои, ... ?

Andrey: А тут несколько dll да еще разных версий hb, hmg, свои, ... ? Чуток разобрался с МиниГуи. Понравились отдельные dll-ки. Вот и хочу свои dll-ки пока на МиниГуи попробовать. Другие языки пока не нужны. Хотелось бы в МиниГуи иметь отдельную папку с таким примером, типа CallDll3 !

SergKis: Andrey пишет Другие языки пока не нужны. Иди по пути hrb, т.е. собери exe, включив все нужные компоненты (lib + request). Окна и алгоритмы получай в hrb. Hrb можешь включать в ресурсные dll, иметь как файлы или как в foxpro, prg и hrb с одним именем, меняем prg, запускается получение hrb и потом он выполняется.

SergKis: PS hrb можешь держать в zip с паролем или без. Собранный, полный exe можно будет менять достаточно редко.

Haz: SergKis пишет: полный exe можно будет менять достаточно редко. Я не вижу принципиальной разницы что менять, exe dll hbr prg. Все кроме prg будет лочиться системой на момент выполнения, а prg требует дополнительной компиляции. То есть все кроме prg требует либо автоматом рубить всех пользователей либо с матами индивидуально. Я в итоге пришёл к решению следующему. Компилируется два exe. Первый просто лончер, который запускает второй. Первый exe имеет настройки, с каким именем запускать второй. У второго от версии к версии инкрементируется расширение. mod.000 mod.001 и так далее. После сборки основного мода его надо закинуть в папку программы и изменить конфигурацию лончер. Всё юзеря могут работать по прежнему, могут получить уведомление о доступности нового. Для обновления потребуется перезапуск лончер и он запустит новый мод. В качестве мода можно подсунуть сервисную программу. Которая к примеру поменяет структуру баз, пересчитатает историю и много чего., а потом пропишет новый мод. Да, лончер запустив мод, сам заканчивает работу

SergKis: Haz пишет Я не вижу принципиальной разницы что менять, exe dll hbr prg. Я не имел ввиду замену версии. В технике с hrb меняются в основном ресурсные dll общие или частные для конкр. клиента. Exe один, не надо следить где какая версия dll hb, hmg и т.д. следить (лежат в тек. каталоге, у exe, в windows,...). Кто и по какой причине (из "добрых" побуждений) подменил\ записал старую версию, перекрыв нужную ... "Добрых" людей много как оказалось. Этого наелся с VO. В итоге оставил минимум dll один exe и все остальное в VO script и ресурсная dll, правда причина такой работы и плохая работа репозитария VO, даже в VO 2.7 такое случалось, т.е. пересобиря exe нельзя быть уверенным (не проверив), что все режимы работают. Первый просто лончер, который запускает второй. Первый exe имеет настройки, с каким именем запускать второй. Инсталяторы тоже так делают, устанавливают и запускают, что укажешь для доинсталяции.

Andrey: В итоге оставил минимум dll один exe Вот я и не смог сделать свою dll-ку на МиниГуи вообще .... Не получается... Хотелось бы в МиниГуи иметь отдельную папку с таким примером, типа CallDll3 !

SergKis: Andrey пишет Вот я и не смог сделать свою dll-ку на МиниГуи вообще В VO dll в поставке, а ты хочешь выделить принудительно, а оно надо ? По мне - не надо. Лучше на технологию hrb потрать время - это будет аналог dll

SergKis: gfilatov2002 Делал для себя константы цветов. Цветовая гамма на сайта https://colorscheme.ru/html-colors.html Может пригодятся [pre2] #define CLR_INDIANRED 6053069 // RGB( 205, 92, 92 ) #define CLR_LIGHTCORAL 8421616 // RGB( 240, 128, 128 ) #define CLR_SALMON 7504122 // RGB( 250, 128, 114 ) #define CLR_DARKSALMON 8034025 // RGB( 233, 150, 122 ) #define CLR_LIGHTSALMON 8036607 // RGB( 255, 160, 122 ) #define CLR_CRIMSON 3937500 // RGB( 220, 20, 60 ) #define CLR_RED 255 // RGB( 255, 0, 0 ) #define CLR_FIREBRICK 2237106 // RGB( 178, 34, 34 ) #define CLR_DARKRED 139 // RGB( 139, 0, 0 ) #define CLR_PINK 13353215 // RGB( 255, 192, 203 ) #define CLR_LIGHTPINK 12695295 // RGB( 255, 182, 193 ) #define CLR_HOTPINK 11823615 // RGB( 255, 105, 180 ) #define CLR_DEEPPINK 9639167 // RGB( 255, 20, 147 ) #define CLR_MEDIUMVIOLETRED 8721863 // RGB( 199, 21, 133 ) #define CLR_PALEVIOLETRED 9662683 // RGB( 219, 112, 147 ) #define CLR_LIGHTSALMON 8036607 // RGB( 255, 160, 122 ) #define CLR_CORAL 5275647 // RGB( 255, 127, 80 ) #define CLR_TOMATO 4678655 // RGB( 255, 99, 71 ) #define CLR_ORANGERED 17919 // RGB( 255, 69, 0 ) #define CLR_DARKORANGE 36095 // RGB( 255, 140, 0 ) #define CLR_ORANGE 42495 // RGB( 255, 165, 0 ) #define CLR_GOLD 55295 // RGB( 255, 215, 0 ) #define CLR_YELLOW 65535 // RGB( 255, 255, 0 ) #define CLR_LIGHTYELLOW 14745599 // RGB( 255, 255, 224 ) #define CLR_LEMONCHIFFON 13499135 // RGB( 255, 250, 205 ) #define CLR_LIGHTGOLDENRODYELLOW 13826810 // RGB( 250, 250, 210 ) #define CLR_PAPAYAWHIP 14020607 // RGB( 255, 239, 213 ) #define CLR_MOCCASIN 11920639 // RGB( 255, 228, 181 ) #define CLR_PEACHPUFF 12180223 // RGB( 255, 218, 185 ) #define CLR_PALEGOLDENROD 11200750 // RGB( 238, 232, 170 ) #define CLR_KHAKI 9234160 // RGB( 240, 230, 140 ) #define CLR_DARKKHAKI 7059389 // RGB( 189, 183, 107 ) #define CLR_LAVENDER 16443110 // RGB( 230, 230, 250 ) #define CLR_THISTLE 14204888 // RGB( 216, 191, 216 ) #define CLR_PLUM 14524637 // RGB( 221, 160, 221 ) #define CLR_VIOLET 15631086 // RGB( 238, 130, 238 ) #define CLR_ORCHID 14053594 // RGB( 218, 112, 214 ) #define CLR_FUCHSIA 16711935 // RGB( 255, 0, 255 ) #define CLR_MAGENTA 16711935 // RGB( 255, 0, 255 ) #define CLR_MEDIUMORCHID 13850042 // RGB( 186, 85, 211 ) #define CLR_MEDIUMPURPLE 14381203 // RGB( 147, 112, 219 ) #define CLR_BLUEVIOLET 14822282 // RGB( 138, 43, 226 ) #define CLR_DARKVIOLET 13828244 // RGB( 148, 0, 211 ) #define CLR_DARKORCHID 13382297 // RGB( 153, 50, 204 ) #define CLR_DARKMAGENTA 9109643 // RGB( 139, 0, 139 ) #define CLR_PURPLE 8388736 // RGB( 128, 0, 128 ) #define CLR_INDIGO 8519755 // RGB( 75, 0, 130 ) #define CLR_SLATEBLUE 13458026 // RGB( 106, 90, 205 ) #define CLR_DARKSLATEBLUE 9125192 // RGB( 72, 61, 139 ) #define CLR_CORNSILK 14481663 // RGB( 255, 248, 220 ) #define CLR_BLANCHEDALMOND 13495295 // RGB( 255, 235, 205 ) #define CLR_BISQUE 12903679 // RGB( 255, 228, 196 ) #define CLR_NAVAJOWHITE 11394815 // RGB( 255, 222, 173 ) #define CLR_WHEAT 11788021 // RGB( 245, 222, 179 ) #define CLR_BURLYWOOD 8894686 // RGB( 222, 184, 135 ) #define CLR_TAN 9221330 // RGB( 210, 180, 140 ) #define CLR_ROSYBROWN 9408444 // RGB( 188, 143, 143 ) #define CLR_SANDYBROWN 6333684 // RGB( 244, 164, 96 ) #define CLR_GOLDENROD 2139610 // RGB( 218, 165, 32 ) #define CLR_DARKGOLDENROD 755384 // RGB( 184, 134, 11 ) #define CLR_PERU 4163021 // RGB( 205, 133, 63 ) #define CLR_CHOCOLATE 1993170 // RGB( 210, 105, 30 ) #define CLR_SADDLEBROWN 1262987 // RGB( 139, 69, 19 ) #define CLR_SIENNA 2970272 // RGB( 160, 82, 45 ) #define CLR_BROWN 2763429 // RGB( 165, 42, 42 ) #define CLR_MAROON 128 // RGB( 128, 0, 0 ) #define CLR_BLACK 0 // RGB( 0, 0, 0 ) #define CLR_GRAY 8421504 // RGB( 128, 128, 128 ) #define CLR_SILVER 12632256 // RGB( 192, 192, 192 ) #define CLR_WHITE 16777215 // RGB( 255, 255, 255 ) #define CLR_FUCHSIA 16711935 // RGB( 255, 0, 255 ) #define CLR_PURPLE 8388736 // RGB( 128, 0, 128 ) #define CLR_RED 255 // RGB( 255, 0, 0 ) #define CLR_MAROON 128 // RGB( 128, 0, 0 ) #define CLR_YELLOW 6053069 // RGB( 205, 92, 92 ) #define CLR_OLIVE 8421616 // RGB( 240, 128, 128 ) #define CLR_LIME 7504122 // RGB( 250, 128, 114 ) #define CLR_GREEN 8034025 // RGB( 233, 150, 122 ) #define CLR_AQUA 6053069 // RGB( 205, 92, 92 ) #define CLR_TEAL 8421616 // RGB( 240, 128, 128 ) #define CLR_BLUE 7504122 // RGB( 250, 128, 114 ) #define CLR_NAVY 8034025 // RGB( 233, 150, 122 ) #define CLR_GREENYELLOW 3145645 // RGB( 173, 255, 47 ) #define CLR_CHARTREUSE 65407 // RGB( 127, 255, 0 ) #define CLR_LAWNGREEN 64636 // RGB( 124, 252, 0 ) #define CLR_LIME 65280 // RGB( 0, 255, 0 ) #define CLR_LIMEGREEN 3329330 // RGB( 50, 205, 50 ) #define CLR_PALEGREEN 10025880 // RGB( 152, 251, 152 ) #define CLR_LIGHTGREEN 9498256 // RGB( 144, 238, 144 ) #define CLR_MEDIUMSPRINGGREEN 10156544 // RGB( 0, 250, 154 ) #define CLR_SPRINGGREEN 8388352 // RGB( 0, 255, 127 ) #define CLR_MEDIUMSEAGREEN 7451452 // RGB( 60, 179, 113 ) #define CLR_SEAGREEN 5737262 // RGB( 46, 139, 87 ) #define CLR_FORESTGREEN 2263842 // RGB( 34, 139, 34 ) #define CLR_GREEN 32768 // RGB( 0, 128, 0 ) #define CLR_DARKGREEN 25600 // RGB( 0, 100, 0 ) #define CLR_YELLOWGREEN 3329434 // RGB( 154, 205, 50 ) #define CLR_OLIVEDRAB 2330219 // RGB( 107, 142, 35 ) #define CLR_OLIVE 32896 // RGB( 128, 128, 0 ) #define CLR_DARKOLIVEGREEN 3107669 // RGB( 85, 107, 47 ) #define CLR_MEDIUMAQUAMARINE 11193702 // RGB( 102, 205, 170 ) #define CLR_DARKSEAGREEN 9419919 // RGB( 143, 188, 143 ) #define CLR_LIGHTSEAGREEN 11186720 // RGB( 32, 178, 170 ) #define CLR_DARKCYAN 9145088 // RGB( 0, 139, 139 ) #define CLR_TEAL 8421376 // RGB( 0, 128, 128 ) #define CLR_AQUA 16776960 // RGB( 0, 255, 255 ) #define CLR_CYAN 16776960 // RGB( 0, 255, 255 ) #define CLR_LIGHTCYAN 16777184 // RGB( 224, 255, 255 ) #define CLR_PALETURQUOISE 15658671 // RGB( 175, 238, 238 ) #define CLR_AQUAMARINE 13959039 // RGB( 127, 255, 212 ) #define CLR_TURQUOISE 13688896 // RGB( 64, 224, 208 ) #define CLR_MEDIUMTURQUOISE 13422920 // RGB( 72, 209, 204 ) #define CLR_DARKTURQUOISE 13749760 // RGB( 0, 206, 209 ) #define CLR_CADETBLUE 10526303 // RGB( 95, 158, 160 ) #define CLR_STEELBLUE 11829830 // RGB( 70, 130, 180 ) #define CLR_LIGHTSTEELBLUE 14599344 // RGB( 176, 196, 222 ) #define CLR_POWDERBLUE 15130800 // RGB( 176, 224, 230 ) #define CLR_LIGHTBLUE 15128749 // RGB( 173, 216, 230 ) #define CLR_SKYBLUE 15453831 // RGB( 135, 206, 235 ) #define CLR_LIGHTSKYBLUE 16436871 // RGB( 135, 206, 250 ) #define CLR_DEEPSKYBLUE 16760576 // RGB( 0, 191, 255 ) #define CLR_DODGERBLUE 16748574 // RGB( 30, 144, 255 ) #define CLR_CORNFLOWERBLUE 15570276 // RGB( 100, 149, 237 ) #define CLR_MEDIUMSLATEBLUE 15624315 // RGB( 123, 104, 238 ) #define CLR_ROYALBLUE 14772545 // RGB( 65, 105, 225 ) #define CLR_BLUE 16711680 // RGB( 0, 0, 255 ) #define CLR_MEDIUMBLUE 13434880 // RGB( 0, 0, 205 ) #define CLR_DARKBLUE 9109504 // RGB( 0, 0, 139 ) #define CLR_NAVY 8388608 // RGB( 0, 0, 128 ) #define CLR_MIDNIGHTBLUE 7346457 // RGB( 25, 25, 112 ) #define CLR_WHITE 16777215 // RGB( 255, 255, 255 ) #define CLR_SNOW 16448255 // RGB( 255, 250, 250 ) #define CLR_HONEYDEW 15794160 // RGB( 240, 255, 240 ) #define CLR_MINTCREAM 16449525 // RGB( 245, 255, 250 ) #define CLR_AZURE 16777200 // RGB( 240, 255, 255 ) #define CLR_ALICEBLUE 16775408 // RGB( 240, 248, 255 ) #define CLR_GHOSTWHITE 16775416 // RGB( 248, 248, 255 ) #define CLR_WHITESMOKE 16119285 // RGB( 245, 245, 245 ) #define CLR_SEASHELL 15660543 // RGB( 255, 245, 238 ) #define CLR_BEIGE 14480885 // RGB( 245, 245, 220 ) #define CLR_OLDLACE 15136253 // RGB( 253, 245, 230 ) #define CLR_FLORALWHITE 15792895 // RGB( 255, 250, 240 ) #define CLR_IVORY 15794175 // RGB( 255, 255, 240 ) #define CLR_ANTIQUEWHITE 14150650 // RGB( 250, 235, 215 ) #define CLR_LINEN 15134970 // RGB( 250, 240, 230 ) #define CLR_LAVENDERBLUSH 16118015 // RGB( 255, 240, 245 ) #define CLR_MISTYROSE 14804223 // RGB( 255, 228, 225 ) #define CLR_GAINSBORO 14474460 // RGB( 220, 220, 220 ) #define CLR_LIGHTGREY 13882323 // RGB( 211, 211, 211 ) #define CLR_LIGHTGRAY 13882323 // RGB( 211, 211, 211 ) #define CLR_SILVER 12632256 // RGB( 192, 192, 192 ) #define CLR_DARKGRAY 11119017 // RGB( 169, 169, 169 ) #define CLR_DARKGREY 11119017 // RGB( 169, 169, 169 ) #define CLR_GRAY 8421504 // RGB( 128, 128, 128 ) #define CLR_GREY 8421504 // RGB( 128, 128, 128 ) #define CLR_DIMGRAY 6908265 // RGB( 105, 105, 105 ) #define CLR_DIMGREY 6908265 // RGB( 105, 105, 105 ) #define CLR_LIGHTSLATEGRAY 10061943 // RGB( 119, 136, 153 ) #define CLR_LIGHTSLATEGREY 10061943 // RGB( 119, 136, 153 ) #define CLR_SLATEGRAY 9470064 // RGB( 112, 128, 144 ) #define CLR_SLATEGREY 9470064 // RGB( 112, 128, 144 ) #define CLR_DARKSLATEGRAY 5197615 // RGB( 47, 79, 79 ) #define CLR_DARKSLATEGREY 5197615 // RGB( 47, 79, 79 ) #define CLR_BLACK 0 // RGB( 0, 0, 0 ) #define HEX_INDIANRED #CD5C5C // RGB( 205, 92, 92 ) #define HEX_LIGHTCORAL #F08080 // RGB( 240, 128, 128 ) #define HEX_SALMON #FA8072 // RGB( 250, 128, 114 ) #define HEX_DARKSALMON #E9967A // RGB( 233, 150, 122 ) #define HEX_LIGHTSALMON #FFA07A // RGB( 255, 160, 122 ) #define HEX_CRIMSON #DC143C // RGB( 220, 20, 60 ) #define HEX_RED #FF0000 // RGB( 255, 0, 0 ) #define HEX_FIREBRICK #B22222 // RGB( 178, 34, 34 ) #define HEX_DARKRED #8B0000 // RGB( 139, 0, 0 ) #define HEX_PINK #FFC0CB // RGB( 255, 192, 203 ) #define HEX_LIGHTPINK #FFB6C1 // RGB( 255, 182, 193 ) #define HEX_HOTPINK #FF69B4 // RGB( 255, 105, 180 ) #define HEX_DEEPPINK #FF1493 // RGB( 255, 20, 147 ) #define HEX_MEDIUMVIOLETRED #C71585 // RGB( 199, 21, 133 ) #define HEX_PALEVIOLETRED #DB7093 // RGB( 219, 112, 147 ) #define HEX_LIGHTSALMON #FFA07A // RGB( 255, 160, 122 ) #define HEX_CORAL #FF7F50 // RGB( 255, 127, 80 ) #define HEX_TOMATO #FF6347 // RGB( 255, 99, 71 ) #define HEX_ORANGERED #FF4500 // RGB( 255, 69, 0 ) #define HEX_DARKORANGE #FF8C00 // RGB( 255, 140, 0 ) #define HEX_ORANGE #FFA500 // RGB( 255, 165, 0 ) #define HEX_GOLD #FFD700 // RGB( 255, 215, 0 ) #define HEX_YELLOW #FFFF00 // RGB( 255, 255, 0 ) #define HEX_LIGHTYELLOW #FFFFE0 // RGB( 255, 255, 224 ) #define HEX_LEMONCHIFFON #FFFACD // RGB( 255, 250, 205 ) #define HEX_LIGHTGOLDENRODYELLOW #FAFAD2 // RGB( 250, 250, 210 ) #define HEX_PAPAYAWHIP #FFEFD5 // RGB( 255, 239, 213 ) #define HEX_MOCCASIN #FFE4B5 // RGB( 255, 228, 181 ) #define HEX_PEACHPUFF #FFDAB9 // RGB( 255, 218, 185 ) #define HEX_PALEGOLDENROD #EEE8AA // RGB( 238, 232, 170 ) #define HEX_KHAKI #F0E68C // RGB( 240, 230, 140 ) #define HEX_DARKKHAKI #BDB76B // RGB( 189, 183, 107 ) #define HEX_LAVENDER #E6E6FA // RGB( 230, 230, 250 ) #define HEX_THISTLE #D8BFD8 // RGB( 216, 191, 216 ) #define HEX_PLUM #DDA0DD // RGB( 221, 160, 221 ) #define HEX_VIOLET #EE82EE // RGB( 238, 130, 238 ) #define HEX_ORCHID #DA70D6 // RGB( 218, 112, 214 ) #define HEX_FUCHSIA #FF00FF // RGB( 255, 0, 255 ) #define HEX_MAGENTA #FF00FF // RGB( 255, 0, 255 ) #define HEX_MEDIUMORCHID #BA55D3 // RGB( 186, 85, 211 ) #define HEX_MEDIUMPURPLE #9370DB // RGB( 147, 112, 219 ) #define HEX_BLUEVIOLET #8A2BE2 // RGB( 138, 43, 226 ) #define HEX_DARKVIOLET #9400D3 // RGB( 148, 0, 211 ) #define HEX_DARKORCHID #9932CC // RGB( 153, 50, 204 ) #define HEX_DARKMAGENTA #8B008B // RGB( 139, 0, 139 ) #define HEX_PURPLE #800080 // RGB( 128, 0, 128 ) #define HEX_INDIGO #4B0082 // RGB( 75, 0, 130 ) #define HEX_SLATEBLUE #6A5ACD // RGB( 106, 90, 205 ) #define HEX_DARKSLATEBLUE #483D8B // RGB( 72, 61, 139 ) #define HEX_CORNSILK #FFF8DC // RGB( 255, 248, 220 ) #define HEX_BLANCHEDALMOND #FFEBCD // RGB( 255, 235, 205 ) #define HEX_BISQUE #FFE4C4 // RGB( 255, 228, 196 ) #define HEX_NAVAJOWHITE #FFDEAD // RGB( 255, 222, 173 ) #define HEX_WHEAT #F5DEB3 // RGB( 245, 222, 179 ) #define HEX_BURLYWOOD #DEB887 // RGB( 222, 184, 135 ) #define HEX_TAN #D2B48C // RGB( 210, 180, 140 ) #define HEX_ROSYBROWN #BC8F8F // RGB( 188, 143, 143 ) #define HEX_SANDYBROWN #F4A460 // RGB( 244, 164, 96 ) #define HEX_GOLDENROD #DAA520 // RGB( 218, 165, 32 ) #define HEX_DARKGOLDENROD #B8860B // RGB( 184, 134, 11 ) #define HEX_PERU #CD853F // RGB( 205, 133, 63 ) #define HEX_CHOCOLATE #D2691E // RGB( 210, 105, 30 ) #define HEX_SADDLEBROWN #8B4513 // RGB( 139, 69, 19 ) #define HEX_SIENNA #A0522D // RGB( 160, 82, 45 ) #define HEX_BROWN #A52A2A // RGB( 165, 42, 42 ) #define HEX_MAROON #800000 // RGB( 128, 0, 0 ) #define HEX_BLACK #000000 // RGB( 0, 0, 0 ) #define HEX_GRAY #808080 // RGB( 128, 128, 128 ) #define HEX_SILVER #C0C0C0 // RGB( 192, 192, 192 ) #define HEX_WHITE #FFFFFF // RGB( 255, 255, 255 ) #define HEX_FUCHSIA #FF00FF // RGB( 255, 0, 255 ) #define HEX_PURPLE #800080 // RGB( 128, 0, 128 ) #define HEX_RED #FF0000 // RGB( 255, 0, 0 ) #define HEX_MAROON #800000 // RGB( 128, 0, 0 ) #define HEX_YELLOW #FFFF00 // RGB( 205, 92, 92 ) #define HEX_OLIVE #808000 // RGB( 240, 128, 128 ) #define HEX_LIME #00FF00 // RGB( 250, 128, 114 ) #define HEX_GREEN #008000 // RGB( 233, 150, 122 ) #define HEX_AQUA #00FFFF // RGB( 205, 92, 92 ) #define HEX_TEAL #008080 // RGB( 240, 128, 128 ) #define HEX_BLUE #0000FF // RGB( 250, 128, 114 ) #define HEX_NAVY #000080 // RGB( 233, 150, 122 ) #define HEX_GREENYELLOW #ADFF2F // RGB( 173, 255, 47 ) #define HEX_CHARTREUSE #7FFF00 // RGB( 127, 255, 0 ) #define HEX_LAWNGREEN #7CFC00 // RGB( 124, 252, 0 ) #define HEX_LIME #00FF00 // RGB( 0, 255, 0 ) #define HEX_LIMEGREEN #32CD32 // RGB( 50, 205, 50 ) #define HEX_PALEGREEN #98FB98 // RGB( 152, 251, 152 ) #define HEX_LIGHTGREEN #90EE90 // RGB( 144, 238, 144 ) #define HEX_MEDIUMSPRINGGREEN #00FA9A // RGB( 0, 250, 154 ) #define HEX_SPRINGGREEN #00FF7F // RGB( 0, 255, 127 ) #define HEX_MEDIUMSEAGREEN #3CB371 // RGB( 60, 179, 113 ) #define HEX_SEAGREEN #2E8B57 // RGB( 46, 139, 87 ) #define HEX_FORESTGREEN #228B22 // RGB( 34, 139, 34 ) #define HEX_GREEN #008000 // RGB( 0, 128, 0 ) #define HEX_DARKGREEN #006400 // RGB( 0, 100, 0 ) #define HEX_YELLOWGREEN #9ACD32 // RGB( 154, 205, 50 ) #define HEX_OLIVEDRAB #6B8E23 // RGB( 107, 142, 35 ) #define HEX_OLIVE #808000 // RGB( 128, 128, 0 ) #define HEX_DARKOLIVEGREEN #556B2F // RGB( 85, 107, 47 ) #define HEX_MEDIUMAQUAMARINE #66CDAA // RGB( 102, 205, 170 ) #define HEX_DARKSEAGREEN #8FBC8F // RGB( 143, 188, 143 ) #define HEX_LIGHTSEAGREEN #20B2AA // RGB( 32, 178, 170 ) #define HEX_DARKCYAN #008B8B // RGB( 0, 139, 139 ) #define HEX_TEAL #008080 // RGB( 0, 128, 128 ) #define HEX_AQUA #00FFFF // RGB( 0, 255, 255 ) #define HEX_CYAN #00FFFF // RGB( 0, 255, 255 ) #define HEX_LIGHTCYAN #E0FFFF // RGB( 224, 255, 255 ) #define HEX_PALETURQUOISE #AFEEEE // RGB( 175, 238, 238 ) #define HEX_AQUAMARINE #7FFFD4 // RGB( 127, 255, 212 ) #define HEX_TURQUOISE #40E0D0 // RGB( 64, 224, 208 ) #define HEX_MEDIUMTURQUOISE #48D1CC // RGB( 72, 209, 204 ) #define HEX_DARKTURQUOISE #00CED1 // RGB( 0, 206, 209 ) #define HEX_CADETBLUE #5F9EA0 // RGB( 95, 158, 160 ) #define HEX_STEELBLUE #4682B4 // RGB( 70, 130, 180 ) #define HEX_LIGHTSTEELBLUE #B0C4DE // RGB( 176, 196, 222 ) #define HEX_POWDERBLUE #B0E0E6 // RGB( 176, 224, 230 ) #define HEX_LIGHTBLUE #ADD8E6 // RGB( 173, 216, 230 ) #define HEX_SKYBLUE #87CEEB // RGB( 135, 206, 235 ) #define HEX_LIGHTSKYBLUE #87CEFA // RGB( 135, 206, 250 ) #define HEX_DEEPSKYBLUE #00BFFF // RGB( 0, 191, 255 ) #define HEX_DODGERBLUE #1E90FF // RGB( 30, 144, 255 ) #define HEX_CORNFLOWERBLUE #6495ED // RGB( 100, 149, 237 ) #define HEX_MEDIUMSLATEBLUE #7B68EE // RGB( 123, 104, 238 ) #define HEX_ROYALBLUE #4169E1 // RGB( 65, 105, 225 ) #define HEX_BLUE #0000FF // RGB( 0, 0, 255 ) #define HEX_MEDIUMBLUE #0000CD // RGB( 0, 0, 205 ) #define HEX_DARKBLUE #00008B // RGB( 0, 0, 139 ) #define HEX_NAVY #000080 // RGB( 0, 0, 128 ) #define HEX_MIDNIGHTBLUE #191970 // RGB( 25, 25, 112 ) #define HEX_WHITE #FFFFFF // RGB( 255, 255, 255 ) #define HEX_SNOW #FFFAFA // RGB( 255, 250, 250 ) #define HEX_HONEYDEW #F0FFF0 // RGB( 240, 255, 240 ) #define HEX_MINTCREAM #F5FFFA // RGB( 245, 255, 250 ) #define HEX_AZURE #F0FFFF // RGB( 240, 255, 255 ) #define HEX_ALICEBLUE #F0F8FF // RGB( 240, 248, 255 ) #define HEX_GHOSTWHITE #F8F8FF // RGB( 248, 248, 255 ) #define HEX_WHITESMOKE #F5F5F5 // RGB( 245, 245, 245 ) #define HEX_SEASHELL #FFF5EE // RGB( 255, 245, 238 ) #define HEX_BEIGE #F5F5DC // RGB( 245, 245, 220 ) #define HEX_OLDLACE #FDF5E6 // RGB( 253, 245, 230 ) #define HEX_FLORALWHITE #FFFAF0 // RGB( 255, 250, 240 ) #define HEX_IVORY #FFFFF0 // RGB( 255, 255, 240 ) #define HEX_ANTIQUEWHITE #FAEBD7 // RGB( 250, 235, 215 ) #define HEX_LINEN #FAF0E6 // RGB( 250, 240, 230 ) #define HEX_LAVENDERBLUSH #FFF0F5 // RGB( 255, 240, 245 ) #define HEX_MISTYROSE #FFE4E1 // RGB( 255, 228, 225 ) #define HEX_GAINSBORO #DCDCDC // RGB( 220, 220, 220 ) #define HEX_LIGHTGREY #D3D3D3 // RGB( 211, 211, 211 ) #define HEX_LIGHTGRAY #D3D3D3 // RGB( 211, 211, 211 ) #define HEX_SILVER #C0C0C0 // RGB( 192, 192, 192 ) #define HEX_DARKGRAY #A9A9A9 // RGB( 169, 169, 169 ) #define HEX_DARKGREY #A9A9A9 // RGB( 169, 169, 169 ) #define HEX_GRAY #808080 // RGB( 128, 128, 128 ) #define HEX_GREY #808080 // RGB( 128, 128, 128 ) #define HEX_DIMGRAY #696969 // RGB( 105, 105, 105 ) #define HEX_DIMGREY #696969 // RGB( 105, 105, 105 ) #define HEX_LIGHTSLATEGRAY #778899 // RGB( 119, 136, 153 ) #define HEX_LIGHTSLATEGREY #778899 // RGB( 119, 136, 153 ) #define HEX_SLATEGRAY #708090 // RGB( 112, 128, 144 ) #define HEX_SLATEGREY #708090 // RGB( 112, 128, 144 ) #define HEX_DARKSLATEGRAY #2F4F4F // RGB( 47, 79, 79 ) #define HEX_DARKSLATEGREY #2F4F4F // RGB( 47, 79, 79 ) #define HEX_BLACK #000000 // RGB( 0, 0, 0 ) [/pre2]

ММК: Andrey пишет: Вот я и не смог сделать свою dll-ку на МиниГуи вообще .... Не получается... А зачем? Что это дает?

Andrey: А зачем? Что это дает? 1) Чтобы уметь так же делать. 2) Разбить свой проект на части и неизменяемые программы держать в dll-ке. У некоторых юзеров слабый инет, качать приходиться много, ехе-ник весит 18 мб.

Andrey: 3) Для других проектов, где лазят шустрые ручки юзеров, лончер сделать через ехе-ник, а основную прогу через dll-ку.

Andrey: Вот сделал пробный проект - https://cloud.mail.ru/public/4X4S/v4CZmKyru dll-ка собирается (Григорий давно давал ключи сборки), а вызов из demo.exe не получается. Что не так делаю ?

SergKis: Andrey пишет У некоторых юзеров слабый инет, качать приходиться много, ехе-ник весит 18 мб. Dll также будет грузиться на клиента, быстрее не будет чем с exeшником. а с hrb скорее всего будет, т.к это внешний файл\ресурс, ты сам читаешь только тот кусок, который надо выполнить.

SergKis: PS А.КресинИ еще один интересный момент. Я уже отмечал, что hrb файлы очень похожи по функциональности на p-code dll. И действительно, функция hb_hrbLoad() загружает p-code в пространство вашего приложения так же, как функция hb_libLoad() подгружает динамическую библиотеку. А значит, функции из hrb файла можно вызывать таким же образом, т.е. напрямую, без всяких hb_hrbGetFunsym() и Do(). Для этого, как и в случае с использованием p-code dll, надо предварительно объявить эти функции в вашем приложении как DYNAMIC: ? 1 2 3 4 5 6 7 8 DYNAMIC HRBFUNC1 FUNCTION Main() Local x, handle := hb_hrbLoad( "my.hrb" ) x := hrbFunc1() // hrbFunc1 - функция из my.hrb hb_hrbUnload( handle ) Return Nil

PSP: + за hrb еще в том, что этот формат зависит только от компилятора harbour и больше ни от чего. Компилятор С не имеет значения.

Andrey: Dll также будет грузиться на клиента, быстрее не будет чем с exeшником Не буду грузить Dll-ку при обновлении, она будет постоянной. Один раз загружу и всё. Насчет hrb - согласен, интересное решение. Но до перехода к нему хотелось бы научиться делать свои dll-ки на МиниГуи.

ММК: Andrey пишет: А зачем? Что это дает? 1) Чтобы уметь так же делать. Похвально ... Andrey пишет: 2) Разбить свой проект на части и неизменяемые программы держать в dll-ке. У некоторых юзеров слабый инет, качать приходиться много, ехе-ник весит 18 мб. В такой ситуации удобнее держать в dll все то , что может отличаться для разных пользователей т.к не требует перестроения (пересылки) и может меняться прямо на месте ( картинки, экраны, формы... ) Andrey пишет: 3) Для других проектов, где лазят шустрые ручки юзеров, лончер сделать через ехе-ник, а основную прогу через dll-ку. удивлен Andrey пишет: dll-ка собирается (Григорий давно давал ключи сборки), а вызов из demo.exe не получается. Что не так делаю ? Вот Вам примерчик на FW , может поможет. Как dll собирается Вы еже знаете - пропустим. Вот эту пр-му "грузим" в Dll - #include "FiveWin.ch" static hDLL function Main() local hItem1 := ItemNew( "Hello world!" ) local hItem2 := ItemNew( "From a Harbour DLL" ) hDLL = LoadLibrary( "babudll.dll" ) MsgInfo( ExecuteAll() ) HbDllEntry( "TEST" ) HbDLLEntry2( "TEST2", hItem1, hItem2 ) ItemRelease( hItem1 ) ItemRelease( hItem2 ) MsgInfo( "back from EXE" ) FreeLibrary( hDLL ) return nil DLL FUNCTION HBDLLENTRY( cProc AS LPSTR ) AS LONG PASCAL LIB hDLL DLL FUNCTION HBDLLENTRY2( cProc AS LPSTR, pItem1 AS LONG, pItem2 AS LONG ) AS LONG PASCAL LIB hDLL DLL FUNCTION ExecuteAll() AS BOOL PASCAL LIB hDLL #pragma BEGINDUMP #include <hbapi.h> #include <hbapiitm.h> HB_FUNC( ITEMNEW ) { hb_retnl( ( unsigned long ) hb_itemNew( hb_param( 1, HB_IT_ANY ) ) ); } HB_FUNC( ITEMRELEASE ) { hb_retl( hb_itemRelease( ( PHB_ITEM ) hb_parnl( 1 ) ) ); } ******************************************* А вот та , которая работает с этой Dll ********************************************* function Test() MsgInfo( "Hello from inside the DLL!" ) return .T. function Test2( cMsg1, cMsg2 ) MsgInfo( cMsg1, cMsg2 ) return nil function CheckPassword() MsgInfo( "Inside CheckPassword()" ) return .T. #pragma BEGINDUMP #include <windows.h> #include <hbvm.h> #include <hbapiitm.h> BOOL WINAPI DllEntryPoint( HINSTANCE hinstDLL, DWORD fdwReason, LPVOID lpvReserved ) { HB_SYMBOL_UNUSED( hinstDLL ); HB_SYMBOL_UNUSED( fdwReason ); HB_SYMBOL_UNUSED( lpvReserved ); switch( fdwReason ) { case DLL_PROCESS_ATTACH: MessageBox( 0, "DLL properly loaded", "DLL entry", 0 ); hb_vmInit( FALSE ); break; case DLL_PROCESS_DETACH: MessageBox( 0, "DLL unloaded", "DLL exit", 0 ); break; } return TRUE; } void pascal __export HBDLLENTRY( char * cProcName ) { hb_itemDoC( cProcName, 0 ); } void pascal __export HBDLLENTRY2( char * cProcName, PHB_ITEM pParam1, PHB_ITEM pParam2 ) { hb_itemDoC( cProcName, 2, pParam1, pParam2 ); } BOOL __stdcall __export ExecuteAll( void ) { PHB_ITEM pResult = hb_itemDoC( "CHECKPASSWORD", 0 ); return pResult->item.asLogical.value; }

ММК: Прошу прощения. Первая Exe , вторая в Dll :) Жарко ....

Andrey: Привет всем ! Оказывается сейчас в МиниГуи нельзя собрать отдельную DLL-ку. Григорий мне ответил что: из-за изменений в ядре библиотеки, проведенных за последние 3 года, это не работает. Поскольку интереса к этой теме не было, замечаний от пользователей тоже не поступало. То есть я один такой желающий...

SergKis: gfilatov2002 Добавьте, пожалуйста, метод [pre2] CLASS TKeyData ... METHOD Del( Key ) INLINE ( iif( ::Len > 0, hb_HDel ( ::aKey, Key ), ), ::lKey := Len( ::aKey ) > 0 ) METHOD Pos( Key ) INLINE hb_HPos( ::aKey, Key ) ... [/pre2]

gfilatov2002: SergKis пишет: Добавьте, пожалуйста, метод Сделал. Кстати. Завершена подготовка финальной версии сборки 18.08, которая будет опубликована завтра.

gfilatov2002: Выпущена новая сборка 18.08 для BCC 5.51 и компиляторов Harbour и xHarbour Базовый дистрибутив-инсталлятор находится по адресу http://hmgextended.com/files/CONTRIB/hmg-18.08-setup.exe Рекомендуется к использованию Также имеются в наличии готовые сборки для: - MinGW 8.1.0 32-bit для Harbour 3.2.0dev; - MinGW 8.1.0 64-bit для Harbour 3.4.0dev; - MS VisualC 2017 32-bit для Harbour 3.2.0dev; - Borland/Embarcadero C++ 7.3 (32-bit) для Harbour 3.4.0dev. Они доступны для тех, кто поддержал материально сопровождение библиотеки Выпуск новых сборок в ближайшее время НЕ планируется...

SergKis: Может пригодится кому. Немного модифицировал пример Tsb_brw2Xml, добавил обработку цвета фонта в меню "Export to Excel (xml-files) 2" Пример тут (hmg 18.08) https://my-files.ru/o226gf

gfilatov2002: SergKis пишет: Немного модифицировал пример Tsb_brw2Xml Спасибо Очень качественная модификация P.S. Я сделал "тихое" обновление сборки 18.08, чтобы включить в нее Вашу модификацию и дополнения Aндрея для примера эспорта данных из TSBrowse

gfilatov2002: Выложил 1-й апдейт сборки 18.08 со следующим списком изменений: [pre2]2018/08/31: HMG Extended Edition version 18.08 (Update 1). * Fixed: A problem with defining of the columns in a TBROWSE control (introduced in the build 18.06). Bug was reported by Henry Herrera. Contributed by Grigory Filatov <gfilatov@inbox.ru> * Updated: 'TSBrowse Export data to a XLS/XML file' sample: - added a color's management in the class Tsb2Xml2Xls. Contributed by Sergej Kiselev (see Tsb4xml.prg in folder \samples\Advanced\Tsb_Brw2xml) * Updated: 'TSBrowse Export data to XLS/XML/DOC/DBF files' sample: - added an export of a logo picture and subtitle of a table for XLS and DOC formats. Contributed by Verchenko Andrey <verchenkoag@gmail.com> (see in folder \samples\Advanced\Tsb_Export) [/pre2] Так что тихого обновления не вышло...

Haz: gfilatov2002 пишет: Выпущена новая сборка 18.08 для BCC 5.51 и компиляторов Harbour и xHarbour Не собрался текущий проект ругается на библиотеки SSL ( не находит половину вызовов ) Если libeay32.lib и ssleay32.lib взять с предыдущей версии , то все собирается PS к Минигуи проблема скорее не относится, это скорее к харбору , НО в поставке МиниГуи вот пример ( собирается с библиотеками из прошлой поставки и не собирается с новой ) TEST.PRG [pre2] #require "hbssl" #require "hbtip" REQUEST __HBEXTERN__HBSSL__ #include "simpleio.ch" PROCEDURE Main( cFrom, cPassword, cTo ) IF ! tip_SSL() ? "Error: Requires SSL support" wait RETURN ENDIF hb_default( @cFrom , "test@yandex.ru" ) hb_default( @cPassword, "parol" ) hb_default( @cTo , "mail@mail.ru" ) ? hb_SendMail( ; "smtp.yandex.ru", ; 465, ; cFrom, ; cTo, ; NIL /* CC */, ; {} /* BCC */, ; "It is a test message", ; "It is a test subject", ; NIL /* attachment */, ; cFrom, ; cPassword, ; "", ; NIL /* nPriority */, ; NIL /* lRead */, ; .T. /* lTrace */, ; .F., ; NIL /* lNoAuth */, ; NIL /* nTimeOut */, ; NIL /* cReplyTo */, ; .T. ) wait RETURN [/pre2] BUILD.BAT [pre2] echo off if not defined MG_ROOT set MG_ROOT=C:\MiniGui if not defined MG_BCC set MG_BCC=c:\borland\bcc55 set PATH=%MG_BCC%\bin;%MG_ROOT%\harbour\bin;%PATH% C:\MiniGui\Harbour\bin\hbmk2 -lhbtip -lhbssl -llibeay32 -lssleay32 test.prg [/pre2]

gfilatov2002: Haz пишет: Если libeay32.lib и ssleay32.lib взять с предыдущей версии , то все собирается Благодарю за сообщение Забыл обновить эти библиотеки вручную - доверился сборке Харбора Завтра поправлю эту бяку в архиве на сайте минигуи...

gfilatov2002: gfilatov2002 пишет: Завтра поправлю эту бяку Поправил установщик и архив на сайте

Haz: gfilatov2002 пишет: Поправил установщик и архив на сайте Спасибо, все нормально собирается

Andrey: Привет ! Что то сломалось в новой версии. Вот код перестал работать:[pre2] hWnd := GetFormHandle('Win_2') ON KEY PRIOR ACTION SendMessage( hWnd, WM_VSCROLL, SB_PAGEUP, 0 ) ON KEY NEXT ACTION SendMessage( hWnd, WM_VSCROLL, SB_PAGEDOWN, 0 ) ON KEY UP ACTION SendMessage( hWnd, WM_VSCROLL, SB_LINEUP, 0 ) ON KEY DOWN ACTION SendMessage( hWnd, WM_VSCROLL, SB_LINEDOWN, 0 )[/pre2] Т.е. по мышке движения есть, а по клавишам нет.

gfilatov2002: Andrey пишет: код перестал работать Заменил в примере строку hWnd := GetFormHandle(cForm) на hWnd := GetFormHandle(ThisWindow.Name) и стрелки заработали

Andrey: gfilatov2002 пишет: Заменил в примере строку Блин, точно забыл где правильное окно. Наверху окно MAIN а стрелки вызываются в MODAL. Спасибо !

SergKis: gfilatov2002 Поправил HbXlsXml[pre2] xmlxls_s.prg ... METHOD ExcelWriterXML_Sheet:writeNumber( row, column, xData, style ) ... IF HB_ISNUMERIC( xData ) ::writeData( "Number", row, column, hb_ntos( xData ), style ) // ::writeData( "Number", row, column, AllTrim( Str( xData, 18, 6 ) ), style ) ELSE ... [/pre2] Так же пример Tsb_Brw2xm: https://my-files.ru/ntptz7 Убрал неточности copy+paste, почистил и чуть добавил (до title, picture в numeric, ...)

gfilatov2002: SergKis пишет: Поправил Спасибо за исправления

SergKis: gfilatov2002 В методе :DeleteRow( lAll ) у себя обнаружил (может будет полезным)[pre2] METHOD DeleteRow( lAll ) CLASS TSBrowse ... If !( "SQL" $ ::cDriver ) If ! ( cAlias )->( RLock() ) MsgStop( ::aMsg[ 40 ] , ::aMsg[ 28 ] ) Return .f. EndIf EndIf If ::bDelBefore != Nil lEval := Eval( ::bDelBefore, nRecNo, Self ) If ValType( lEval ) == "L" .and. ! lEval if !("SQL" $ ::cDriver) ( cAlias )->( DbUnlock() ) EndIf Return .f. EndIf EndIf If ! ( cAlias )->( Deleted() ) ( cAlias )->( DbDelete() ) If ::bDelAfter != Nil Eval( ::bDelAfter, nRecNo, Self ) EndIf if !("SQL" $ ::cDriver) ( cAlias )->( DbUnlock() ) endif ... CLASS TSBrowse FROM TControl ... DATA bDelete // evaluated after user deletes a row with lCanDelete mode DATA bDelBefore // evaluated before user deletes. if RLock mode DATA bDelAfter // evaluated after user deletes. if RLock mode DATA bEvents // custom function for events processing ... [/pre2] действия до удаления и после при удачном блокировании записи

Haz: SergKis пишет: DATA bDelBefore // evaluated before user deletes. if RLock mode DATA bDelAfter Сергей, может и bAddBefore и After? Для заполнения ключей при добавлении в подчиненную базу. Сейчас пользуюсь самописной db_Append( cAlias ) и db_Delete( cAlias ). В них по имени алиаса' условно заполняются ключи при добавлении или при удалении записи в мастер таблице, удаляю соответствующие в подчиненных

SergKis: Haz пишет может и bAddBefore и After? Для заполнения ключей при добавлении в подчиненную базу Согласен, это лучше чем самопалис. По текстам только надо полазить

SergKis: PS есть одно но, не пользовался никогда "родным" встроенным dbAppend(). Это вроде по стрелке вниз при выходе на EOF ? Или еще что то есть ?

Haz: SergKis пишет: Или еще что то есть Вроде есть какой то блочек. Я дома без компа. Завтра с работы поищу. Я тоже не пользуюсь стрелкой вниз за eof(). Значит раз есть ::deleterow() то логично и ::appendrow()

SergKis: Haz пишет Значит раз есть ::deleterow() то логично и ::appendrow() Нет этого. Только есть[pre2] METHOD PostEdit( uTemp, nCol, bValid ) CLASS TSBrowse ... bAddRec := If( ! Empty( ::bAddRec ), ::bAddRec, {|| ( cAlias )->( dbAppend() ), ! NetErr() } ) ... If ::lIsDbf If Eval( If( ! ::lAppendMode, bRecLock, bAddRec ), uTemp ) ::bDataEval( ::aColumns[ nCol ], uTemp, nCol ) SysRefresh() If lAppend If ! Empty( ::aDefault ) ASize( ::aDefault, Len( ::aColumns ) ) AEval( ::aDefault, { | e, n | If( e != Nil .and. n != nCol, If( Valtype( e ) == "B", ; ::bDataEval( ::aColumns[ n ], Eval( e, Self ), n ), ; ::bDataEval( ::aColumns[ n ], e, n ) ), Nil ) } ) ::DrawLine() EndIf ... [/pre2] :AppendRow() похоже строгать надо

Haz: SergKis пишет: AppendRow() похоже строгать надо Сегодня днем напишу

SergKis: Haz пишет Сегодня днем напишу Ok

Haz: SergKis пишет: :AppendRow() похоже строгать надо [pre2] DATA bAddBefore // evaluated before append DATA bAddAfter METHOD AppendRow() CLASS TSBrowse Local cAlias, bAddRec, lAdd If ::lIsDbf cAlias := ::cAlias EndIf if hb_isBlock( bAddBefore ) Eval( bAddBefore, Self ) end Do case case ::lIsDbf bAddRec := If( !Empty( ::bAddRec ), ::bAddRec, {|| ( cAlias )->( dbAppend() ), ! NetErr() } ) if Eval( bAddRec ) SysRefresh() ::nLen := ( cAlias )->( Eval( ::bLogicLen ) ) ::Upstable() ::Refresh(.T., .T.) lAdd := .T. end case ::lIsArr bAddRec := If( !Empty( ::bAddRec ), ::bAddRec, {|| aadd(::aArray, AClone( ::aDefValue ) ), .T. } ) if Eval( bAddRec ) SysRefresh() ::nLen := Len( ::aArray ) ::nAt := ::nLen ::nRowPos := ::nRowCount() ::Refresh(.T., .T.) lAdd := .T. EndIf end ::SetFocus() if lAdd if hb_isBlock( bAddAfter ) Eval( bAddAfter, Self ) end end Return nil [/pre2]-

SergKis: Haz немного поправил [pre2] METHOD AppendRow() CLASS TSBrowse LOCAL cAlias, bAddRec, xRet, lAdd := .F. If HB_ISBLOCK( ::bAddBefore ) xRet := Eval( ::bAddBefore, Self ) If HB_ISLOGICAL(xRet) .and. ! xRet RETURN lAdd EndIf EndIf Do case case ::lIsDbf cAlias := ::cAlias bAddRec := If( !Empty( ::bAddRec ), ::bAddRec, {|| ( cAlias )->( dbAppend() ), ! NetErr() } ) If Eval( bAddRec, Self ) SysRefresh() ::nLen := ( cAlias )->( Eval( ::bLogicLen ) ) ::Upstable() ::Refresh(.T., .T.) lAdd := .T. EndIf case ::lIsArr bAddRec := If( !Empty( ::bAddRec ), ::bAddRec, {|| aAdd(::aArray, AClone( ::aDefValue ) ), .T. } ) If Eval( bAddRec, Self ) SysRefresh() ::nLen := Len( ::aArray ) ::nAt := ::nLen ::nRowPos := ::nRowCount() ::Refresh(.T., .T.) lAdd := .T. EndIf end ::SetFocus() If HB_ISBLOCK( ::bAddAfter ) Eval( ::bAddAfter, Self, lAdd ) EndIf RETURN lAdd [/pre2]

Haz: SergKis пишет: немного поправил Да, так лучше

gfilatov2002: SergKis пишет: немного поправил Новый метод добавлен в класс TSBrowse. Благодарю за помощь

SergKis: Попробовал исп. :AppendRow(). Получилась странная штука. Тест. пример https://my-files.ru/sk8waj demo2.exe - соответствует demo.prg с комментариями в функ. RecnoInsert(oBrw) demo.exe - соответствует demo.prg со снятыми комментариями в функ. RecnoInsert(oBrw) Суть примера demo2.exe: из удаленных (если есть) запись восстанавливается в :bAddBefore, новая запись dbAppend() в :AppendRow() с перерисовкой. Суть примера demo.exe: из удаленных (если есть) запись восстанавливается в :bAddBefore, новая запись dbAppend() там же, :AppendRow() не используется, выход после блока :bAddBefore Делаем в примерах одно и то же, удаляем 5ую запись (-) и сразу добавляем запись (+) В demo2.exe вставка, перерисовка занимает до 10 сек. (внутр. upstable()) В demo.exe все оч. быстро Это только у меня так ? Или что то упущено ?

Haz: SergKis пишет: Тест. приме Рассмешило Author: Igor Nazarov + Verchenko Andrey <verchenkoag@gmail.com> #define COPYRIGHT "(c) Copyright by Andrey Verchenko. Dmitrov, 2018." Серега , тебя забыли что ты тут вообще делаешь ? Или всеже не Author а Publisher Если по примеру, то бровс рассинхронизирован после рекола, сейчас гляну как починитть или так в методе [pre2] If HB_ISLOGICAL(xRet) .and. ! xRet SysRefresh() ::nLen := ( cAlias )->( Eval( ::bLogicLen ) ) ::Upstable() ::SetFocus() ::Refresh(.T., .T.) RETURN lAdd EndIf [/pre2] или озаботиться этим в bAddBefore PS и кстати , по поводу проверки запусков программы. Мне больше нравится WMI - стандартный инструмент менеджмента винды. Незаслуженно неиспользуемый , но дающий куда больше информации. Да, он не супер быстрый , но если это разовый вызов то время приемлемо. К примеру консолька ( написанная прямо тут без теста ) в параметре указать часть Caption процесса и она покажет все [pre2] #include 'common.ch' FUNC Main( cCaption ) Local oObj, oWmi, oItem, x If cCaption == nil ? 'USAGE: ' ? 'demo.exe caption' return nil end oObj := Win_OleCreateObject( "wbemScripting.SwbemLocator" ) oWmi := oObj:ConnectServer('127.0.0.1','root\CIMV2',,) if Valtype( oWmi ) == "O" for each oItem IN oWmi:ExecQuery( "SELECT * FROM Win32_Process" ) if Upper(cCaption) $ Upper(oItem:Caption) ? ? 'Caption' ,oItem:Caption ? 'ExecutablePath' ,oItem:ExecutablePath ? 'ProcessID' , hb_ntoc(oItem:ProcessID) ? 'CSName' , oItem:CSName ? 'GetOwner' , VAltype(oItem:GetOwner(1)) ? end next end RETURN NIL [/pre2] например demo host выдаст все процессы со словом host

Haz: Haz пишет: If HB_ISLOGICAL(xRet) .and. ! xRet SysRefresh() ::nLen := ( cAlias )->( Eval( ::bLogicLen ) ) ::Upstable() ::SetFocus() ::Refresh(.T., .T.) RETURN lAdd EndIf Поправочка - это для ::isDbf не хватает этого условия

SergKis: Haz пишет Или всеже не Author а Publisher Меня это давно как то совсем не трогает. сейчас гляну как починитть Что то со сранья сам не сообразил. Возможно надо 1. перенести перепоказ после :bAddAfter 2. параметр надо добавить lUnLock и перед return делать unlock

Haz: SergKis пишет: Меня это давно как то совсем не трогает. Трогает трогает Половина кода в примерах твоя

gfilatov2002: Всем кому это интересно Подготовил второй релиз-кандидат для новой сборки библиотеки со следующим списком изменений [pre2] * Fixed: Wrong row position of a WHOLEDROPDOWN menu of a ToolButton which was placed into a Vertical PagerBox control. Bug was reported by Natali Almeida. Contributed by Grigory Filatov <gfilatov@inbox.ru> (see demo in folder \samples\Basic\CONTAINERS\PAGERBOX) * Fixed: Revised a bitmap cleaning at the exit from a Preview window in a graph printing module at using of the recent xHarbour compiler. Contributed by Grigory Filatov <gfilatov@inbox.ru> (see demo at folder \samples\Basic\MAINDEMO_(SYNTAX_I)) * Updated: Synchronized Extended HMG for compatibility with Official HMG: Added the set/get 'Enabled' property for the forms: - ThisWindow|<FormName>.Enabled [ := | --> ] lBoolean There are the following add-ons for a TREE control: - added a new command to support a sorting: TREESORT ControlName OF ParentName [ ITEM nItem ] ; [ RECURSIVE lRecursive ] [ CASESENSITIVE lCaseSensitive ] ; [ ASCENDINGORDER lAscendingOrder ] [ NODEPOSITION nNodePosition ] (see demo in folder \samples\Advanced\DirTree_2) - enhanced Expand/Collapse methods: include recursive clause. Sample code: Form_1.Tree_1.Collapse (Form_1.Tree_1.Value, .T.) // Collapse All Form_1.Tree_1.Expand (Form_1.Tree_1.Value, .T.) // Expand All (see demo in folder \samples\Basic\TreeMenu_2) - added the useful functions (and appropriate properties) below: - TreeItemIsTrueNode(); - TreeItemGetNodeFlag(); - TreeItemIsExpand(); - TreeItemGetRootValue(); - TreeItemGetFirstItemValue(). Based upon a contribution of Claudio Soto <srvet@adinet.com.uy>. Adapted for Minigui Extended by Grigory Filatov <gfilatov@inbox.ru> * Updated: Adaptation FiveWin Class TSBrowse 9.0 in HMG: - added the new method AppendRow() in TSBrowse class. Contributed by Sergej Kiselev and Igor Nazarov (see demo.prg in folder \samples\Advanced\Tsb_Basic) * Updated: HbSQLite3 library: - update for using SQLITE3 version 3.25.1 (from 3.25.0dev). Contributed by Grigory Filatov <gfilatov@inbox.ru> * Updated: Harbour Compiler 3.2.0dev (SVN 2018-09-14 15:36): * Updated: OpenSSL wrapper for using of the version 1.0.2p. Contributed by Grigory Filatov <gfilatov@inbox.ru> (look at ReadMe.txt in folder \harbour) * New: 'How to create a child form with a modal behavior' sample. Requested by Anand Gupta on HMG forum. Based upon a contribution of HMG user Edward (see in folder \samples\Basic\ChildAsModal) * New: 'Display of different fonts depending on the screen resolution' sample. Contributed by Verchenko Andrey <verchenkoag@gmail.com> (see in folder \samples\Basic\ScreenMode) * New: 'Tree Menu' sample by Andres Gonzalez Lopez. Adapted for Minigui Extended by Grigory Filatov <gfilatov@inbox.ru> (see in folder \samples\Basic\TreeMenu_2) * New: 'Tree Sort Directory' sample by Claudio Soto. Adapted for Minigui Extended by Grigory Filatov <gfilatov@inbox.ru> (see in folder \samples\Advanced\DirTree_2) * New: 'TSBrowse: network opening of the database' samples. Contributed by Igor Nazarov and Verchenko Andrey (see in folder \samples\Advanced\Tsb_Basic) * Updated: 'Tree with the images' sample. Contributed by Grigory Filatov <gfilatov@inbox.ru> (see ImageTree.prg in folder \samples\Basic\IMAGETREE_2) * Updated: 'Directory Tree' sample by Vladimir Chumachenko. Contributed by Grigory Filatov <gfilatov@inbox.ru> (see in folder \samples\Basic\IMAGETREE_3) * Updated: 'Progress bar using for showing of DBF's processing' sample. Contributed by Grigory Filatov <gfilatov@inbox.ru> (see in folder \samples\Basic\PROGRESSBAR_3) * Updated: 'Memory File System usage' sample: - added copying of a memory table to a disk file. Contributed by Grigory Filatov <gfilatov@inbox.ru> (see demo in folder \samples\Advanced\MEMORY_TABLES). * Updated: 'TSBrowse Export data to a XLS/XML file' sample: - fixed class Tsb2Xml2Xls for export of data to XML file. Contributed by Sergej Kiselev (see Tsb4xml.prg in folder \samples\Advanced\Tsb_Brw2xml) [/pre2] Вероятно, это будет последняя сборка для компилятора BCC 5.51, поскольку поддержка Win 98 уже никому не интересна Сейчас выбираю другой компилятор из - бесплатного Embarcadero C++ 10.1 (32-bit) - платного Embarcadero C++ 7.3 (32-bit) - всем известного MinGW 8.1.0 и склоняюсь ко второму варианту Ваше мнение

SergKis: Вот поправил вариант :AppendRow() [pre2] METHOD AppendRow( lUnlock ) CLASS TSBrowse LOCAL cAlias, bAddRec, xRet, lAdd := .F., lUps := .F. If HB_ISBLOCK( ::bAddBefore ) xRet := Eval( ::bAddBefore, Self ) If HB_ISLOGICAL(xRet) .and. ! xRet lUps := .T. // RETURN lAdd EndIf EndIf Do case case lUps case ::lIsDbf cAlias := ::cAlias bAddRec := If( !Empty( ::bAddRec ), ::bAddRec, {|| ( cAlias )->( dbAppend() ), ! NetErr() } ) If Eval( bAddRec, Self ) // SysRefresh() // ::nLen := ( cAlias )->( Eval( ::bLogicLen ) ) // ::Upstable() // ::Refresh(.T., .T.) lUps := lAdd := .T. EndIf case ::lIsArr bAddRec := If( !Empty( ::bAddRec ), ::bAddRec, {|| aAdd(::aArray, AClone( ::aDefValue ) ), .T. } ) If Eval( bAddRec, Self ) // SysRefresh() // ::nLen := Len( ::aArray ) // ::nAt := ::nLen // ::nRowPos := ::nRowCount() // ::Refresh(.T., .T.) lUps := lAdd := .T. EndIf end If HB_ISBLOCK( ::bAddAfter ) Eval( ::bAddAfter, Self, lAdd ) EndIf If lAdd .and. ::lIsDbf .and. ! empty(lUnlock) ( cAlias )->( dbUnlock() ) EndIf If lUps If ::lIsDbf SysRefresh() ::nLen := ( cAlias )->( Eval( ::bLogicLen ) ) ::Upstable() ::Refresh(.T., .T.) ElseIf ::lIsArr SysRefresh() ::nLen := Len( ::aArray ) ::nAt := ::nLen ::nRowPos := ::nRowCount() ::Refresh(.T., .T.) EndIf EndIf ::SetFocus() RETURN lAdd [/pre2]

SergKis: PS правка[pre2] If HB_ISBLOCK( ::bAddBefore ) xRet := Eval( ::bAddBefore, Self ) If HB_ISLOGICAL(xRet) .and. ! xRet If ::lIsDbf cAlias := ::cAlias EndIf lUps := .T. // RETURN lAdd EndIf EndIf [/pre2]

Haz: SergKis пишет: If lUps If ::lIsDbf SysRefresh() ::nLen := ( cAlias )->( Eval( ::bLogicLen ) ) ::Upstable() ::Refresh(.T., .T.) ElseIf ::lIsArr SysRefresh() ::nLen := Len( ::aArray ) ::nAt := ::nLen ::nRowPos := ::nRowCount() ::Refresh(.T., .T.) EndIf EndIf Тогда так [pre2] If lUps SysRefresh() If ::lIsDbf ::nLen := ( cAlias )->( Eval( ::bLogicLen ) ) ::Upstable() ElseIf ::lIsArr ::nLen := Len( ::aArray ) ::nAt := ::nLen ::nRowPos := ::nRowCount() EndIf ::Refresh(.T., .T.) End [/pre2] Но это уже так - перестановка слагаемых ...

SergKis: PPS Как бы работает, но при :nLen < :nRowCount() перепоказ передергивает курсор через 1ый :nRowPos Моргание наблюдается

SergKis: Haz пишет перестановка слагаемых ... Оптимизация всегда приветствуется

Haz: SergKis пишет: Как бы работает, но при :nLen < :nRowCount() перепоказ передергивает курсор через 1ый :nRowPos Моргание наблюдается Это Upstable() .... можно с цветами поиграть

SergKis: Haz пишет Это рефреш .... можно с цверами поиграть Это понятно, откуда ноги растут. Играть получается надо для фокуса и не в фокусе, оба возможны. Сохранять, ставить CLR_PANE для них, потом восстанавливать ... Словом еще побороться надо. Я пока отваливаюсь, у клиента бяка вылезла - разбираться надо.

Haz: SergKis пишет: Это понятно, откуда ноги растут. Закоменти UPstable() ВРОДЕ ОН ЛИШНИЙ

SergKis: Игорь Пробнул, без него (+) 11 строка становится 5 дальше пол экрана тсб пусто Все убежал. нет времени

Haz: STATIC FUNCTION RecnoRefresh(oBrw) Полная шляпа , при удалении записи в одной из запущеных копий - начинаются чудеса в других на вскидку предлагаю так [pre2] STATIC FUNCTION RecnoRefresh(oBrw) LOCAL nRecno, nRowPos LOCAL lEdit := .F. LOCAL nSkip := 0 AEVAL( oBrw:aColumns, { |o| if( !Empty(o:oEdit), lEdit := .T., NIL ) }) If !lEdit .and. oBrw:nLen <> Eval(oBrw:bLogicLen) nRowPos := oBrw:nRowPos nRecno := (oBrw:cAlias)->(RecNo()) oBrw:SetFocus() oBrw:Reset() (oBrw:cAlias)->(dbGoTo(nRecNo)) nSkip := 1-nRowPos oBrw:Skip(nSkip) oBrw:Refresh(.t., .t.) oBrw:nRowPos := nRowPos DO EVENTS EndIf RETURN Nil [/pre2] и таймер установить на секунду DEFINE TIMER Timer_1 INTERVAL 1000 ACTION RecnoRefresh(oBr)

Andrey: Haz пишет: и таймер установить на секунду Это круто на секунду. Каждую секунду проверят ? Хотябы 15 секунд и то хоть легче компу и сети.

SergKis: SergKis пишет Сохранять, ставить CLR_PANE для них, потом восстанавливать ... Сделал вариант с цветами, вроде не мелькает [pre2] METHOD AppendRow( lUnlock ) CLASS TSBrowse LOCAL cAlias, bAddRec, xRet, lAdd := .F., lUps := .F. LOCAL oClr1 := oKeyData() LOCAL oClr2 := oKeyData() LOCAL lNoGray := ::lNoGrayBar If ::lIsDbf cAlias := ::cAlias EndIf If HB_ISBLOCK( ::bAddBefore ) xRet := Eval( ::bAddBefore, Self ) If HB_ISLOGICAL(xRet) .and. ! xRet lUps := .T. EndIf EndIf Do case case lUps case ::lIsDbf bAddRec := If( !Empty( ::bAddRec ), ::bAddRec, {|| ( cAlias )->( dbAppend() ), ! NetErr() } ) If Eval( bAddRec, Self ) lUps := lAdd := .T. EndIf case ::lIsArr bAddRec := If( !Empty( ::bAddRec ), ::bAddRec, {|| aAdd(::aArray, AClone( ::aDefValue ) ), .T. } ) If Eval( bAddRec, Self ) lUps := lAdd := .T. EndIf end If HB_ISBLOCK( ::bAddAfter ) Eval( ::bAddAfter, Self, lAdd ) EndIf If lAdd .and. ::lIsDbf .and. ! empty(lUnlock) ( cAlias )->( dbUnlock() ) EndIf If lUps If ::lIsDbf SysRefresh() AEval(::aColumns, {|oc,nc| oClr1:Set(nc, { oc:nClrFocuBack, oc:nClrFocuFore }), ; oClr2:Set(nc, { oc:nClrSeleBack, oc:nClrSeleFore }), ; oc:nClrFocuBack := oc:nClrFore, ; oc:nClrFocuFore := oc:nClrBack, ; oc:nClrSeleBack := oc:nClrFore, ; oc:nClrSeleFore := oc:nClrBack }) ::lNoGrayBar := .T. ::nLen := ( cAlias )->( Eval( ::bLogicLen ) ) ::Upstable() AEval(::aColumns, {|oc,nc,ac1,ac2| ac1 := oClr1:Get(nc), ac2 := oClr2:Get(nc), ; oc:nClrFocuBack := ac1[1], ; oc:nClrFocuFore := ac1[2], ; oc:nClrSeleBack := ac2[1], ; oc:nClrSeleFore := ac2[2] }) ::lNoGrayBar := lNoGray ::Refresh(.T., .T.) ElseIf ::lIsArr SysRefresh() ::nLen := Len( ::aArray ) ::nAt := ::nLen ::nRowPos := ::nRowCount() ::Refresh(.T., .T.) EndIf EndIf ::SetFocus() RETURN lAdd [/pre2] Пример на этом варианте https://my-files.ru/u2zy55 Haz пишет STATIC FUNCTION RecnoRefresh(oBrw) Полная шляпа Андрей хотел его временно, на время отладки, потом убрать. В примере заменил, на вскидку по быстрому.

Haz: Andrey пишет: Это круто на секунду. Каждую секунду проверят ? Исходник глянь. Как там сделано

SergKis: SergKis пишет Сделал вариант с цветами, вроде не мелькает Попробовал в :AppendRow() оставить только строки для :lNoGray - оказалось этого достаточно убрать мелькание. Так что строки сохранения\восстановления цветов убрал

SergKis: gfilatov2002 пишет и склоняюсь ко второму варианту Ваше мнение Думаю это конец hmg, за плату лучше FW. У нас: - печать своя - работа с excel своя - почта своя - pdf свое - letodb - hmg 2.07 от 2012 unicode все на vc8 Тек. версию исп. для информации и предложений (проба, отладка) из своей версии иногда из тек. в свою. В основном это тсб, т.к. у себя еще 90% работа на переделанном browse. Новое делается с исп. тсб, т.к. уверенность в тсб стабильной работе появилась не так давно. Использование "платного Embarcadero C++ 7.3 (32-bit)" не интересно. MinGw то же под вопросом.

Haz: SergKis пишет: Использование "платного Embarcadero C++ 7.3 (32-bit)" не интересно. MinGw то же под вопросом. Тоже склоняюсь к тому ,что переход на платный компилятор не убъет но убавит интерес к hmg, тем более что кардинальных преимуществ с переходом с 5 на 7 нет. Среди коммерческих продуктов тогда уж точно выбор перетянет FW или менее известный Xailer

gfilatov2002: Haz пишет: переход на платный компилятор не убъет но убавит интерес к hmg Благодарю за Ваши комментарии. SergKis пишет: Использование "платного Embarcadero C++ 7.3 (32-bit)" не интересно. Я забыл уточнить, что речь идет об усеченной версии для командной строки, которая сейчас активно используется пользователями FW. Она доступна для всех по адресу: http://xharbour.org/index.asp?page=download/windows/required_win SergKis пишет: MinGw то же под вопросом. Если возможно, просветите, какие вопросы есть к MinGW, ведь он достаточно стабилен и постоянно развивается SergKis пишет: все на vc8 У меня готово решение для бесплатного Microsoft Visual C++ 2017 Community Edition, но никак не удается подружить его с библиотекой BosTaurus. Возможно, Вы сможете помочь в этом? Тогда можно будет рассмотреть вариант перехода на VC Благодарю за Ваше внимание и последние доработки метода AppendRow()

SergKis: gfilatov2002 пишет просветите, какие вопросы есть к MinGW Да только один, не сталкивался с ним по жизни, т.е. продукт с 0. Т.е. если надо на него идти, то должна быть веская причина, к примеру, hmg unicod. речь идет об усеченной версии для командной строки, которая сейчас активно используется пользователями FW Делает это ее и продукты из нее free в использовании. А то что работают пользователи FW ..., но у нас не FW. Если бы FW был unicode ... но никак не удается подружить его с библиотекой BosTaurus Помочь не смогу, т.к. не использую и смотрел чисто поверхностно для понимания "для чего", если что. Hmg подходит из за небольшого числа gui контролов для работы в unicod. Переход на тек. версии затруднителен, т.к. больше контролов и нет mdi и нет времени и сил на новый "поход" в unicod. А того, что есть в hmg 2.07 (gui контролов) вполне достаточно для работы с табличной базой. "От добра добра не ищут"

Andrey: Пропустил и не читал. Haz пишет: Серега , тебя забыли что ты тут вообще делаешь ? Я добавлял его копирайт, только он почему то старый пример выложил. Исправьте теперь сами, у меня уже пример устаревший. Haz пишет: Трогает трогает Половина кода в примерах твоя Да, без помощи Сергея я бы вообще в МиниГуи не продвинулся ! Большое спасибо тебе !

ММК: SergKis пишет: но у нас не FW. Если бы FW был unicode ... При желании можно попробовать вот так - FW_SetUnicode(.T.)

Haz: Andrey пишет: Я добавлял его копирайт, только он почему то старый пример выложил. Андрей, мне и похоже Сергею тоже просто фиолетово на все эти копирайты. Это скорее информирование разбирающегося с примером , кому задавать вопросу напрямую ( об ошибках доработках и пр.) Григорий при размещении примеров обычно указывает авторов и этого более чем достаточно. Использование @ означает "охраняемое авторское право" , этот знак был принят на Женевской конвенции ( и без всяких CopyRight by).

Andrey: Да мне тоже особо без разницы этот копирайт. Мне главное чтобы пример работал. И ориентироваться на него, как правильно писать код. Так какой последний вариант получился ? Где его скачать можно ?

Haz: Andrey пишет: Так какой последний вариант получился ? Где его скачать можно ? В последнем посте Сергея по теме , вроде Григорий его включил в сборку. ЗЫ и попробуй мой вариант RefreshRecord() с 1 секундой при нескольких запущенных копиях. потом оригинальный с 30 секундами. суть в том что удаляя записи в одном окне , рушится навигация в других. PS Dima Можешь это и другой флуд в "для флейма " перекинуть

Dima: Haz пишет: Можешь это и другой флуд в "для флейма " перекинуть Облом ковырять 10 страниц Пусть тут живет.

SergKis: ММК пишет При желании можно попробовать вот так - FW_SetUnicode(.T.) Все хорошо в свое время. Это надо было в 2005-6 годах, тогда товарищ перевел V0 на уникод. В 2009 вышел hb 2.0 с unicod, тогда и двинулись, сначала vwt, потом hwgui, завершилось hmg.

SergKis: Игорь, вспомнил про твой пример Tsb_filter, может по аналогии c :AppendRow, :DeleteRow сделать :FilterRow [pre2] METHOD FilterRow( cFilter, bFor, lFocus ) CLASS TSBrowse LOCAL nLen := 0, cAlias := ::cAlias IF ! Empty(cFilter) ( cAlias )->( DbSetFilter( &("{||" + cFilter + "}"), cFilter ) ) ELSE ( cAlias )->( DbClearFilter() ) END ( cAlias )->( DbEval({ || nLen++ }, bFor ) ) ( cAlias )->( DbGotop() ) ::bLogicLen := {|| nLen } ::Reset() If ! empty(lFocus) ::SetFocus() EndIf RETURN Nil В твоем примере поправить STATIC FUNCTION ScanSoft(cDbf) ... FOR EACH oItem IN oWmi:ExecQuery( "SELECT * FROM Win32_Product" ) ... If HB_ISCHAR(cSW_Version) (cAlias)->F3 := cSW_Version EndIf NEXT ... и заменить STATIC FUNCTION RefreshBrowse() LOCAL cSeek := Alltrim( Form_0.Text_1.Value ) LOCAL cExp := "'" + UPPER(cSeek) + "' $ UPPER(B1->F2)" LOCAL nLen := 0, bFor := { || !Deleted() } IF !Empty(cSeek) oBrw_1:FilterRow(cExp, bFor) ELSE oBrw_1:FilterRow( Nil, bFor) END RETURN Nil [/pre2]

SergKis: PS nLen := 0 убрать

Haz: SergKis пишет: FilterRow не помешает скорее не FilterRow a SetFilter тк относится не к одной строке. Но вроде такое есть, надо вспомнить почему я это не использую)) . В твоём коде не нравится наличие dbeval, в сети и при работе с ads по интернету будет жутко Тормозить при больших фильтра ( но это частности) А вот CloneRow напрямую востребован. Также просят CopyRowи и PasteRow но уже через клипборд. Из идей ещё - так это отключаемый кеш бровса, у себя сделал для справочных полей с автообновлением. Пока с закосом под ads и sql. Скорость в сети выроса в несколько раз. Но сама реализация сырая, не все ясно с логикой кеша. По дизайну есть идея - текст внутри ячейки с выделением участков заданным цветом. Уже рыл исходники но мыслей пока ноль.

SergKis: Haz пишет Но вроде такое есть, надо вспомнить почему я это не использую)) вариант фильтра по видимым, строковым полям тсб, может пойдет [pre2] METHOD FilterFTS( cFind, lUpper, lFocus ) CLASS TSBrowse LOCAL nLen := 0, cAlias := ::cAlias, ob := Self DEFAULT lUpper := .T. If lUpper .and. HB_ISCHAR( cFind ) cFind := Upper( cFind ) EndIf IF ! Empty( cFind ) ( cAlias )->( DbSetFilter( {|| ob:FilterFTS_Line( cFind, lUpper, ob) }, ; "ob:FilterFTS_Line( cFind, lUpper, ob)" ) ) ELSE ( cAlias )->( DbClearFilter() ) END ( cAlias )->( DbGotop() ) DO WHILE ( cAlias )->( !EOF() ) DO EVENTS nLen++ ( cAlias )->( DbSkip(1) ) ENDDO ( cAlias )->( DbGotop() ) DO EVENTS ::bLogicLen := {|| nLen } ::Reset() If ! empty(lFocus) ::SetFocus() EndIf RETURN Nil METHOD FilterFTS_Line( cFind, lUpper ) CLASS TSBrowse LOCAL nCol, oCol, xVal, lRet := .F. DEFAULT lUpper := .T. FOR nCol := 1 TO Len( ::aColumns ) oCol := ::aColumns[ nCol ] If nCol == 1 .and. ::lSelector; LOOP ElseIf ! oCol:lVisible ; LOOP ElseIf oCol:lBitMap ; LOOP EndIf xVal := ::bDataEval(oCol, , nCol) If HB_ISCHAR( xVal ) If lUpper lRet := cFind $ Upper( xVal ) Else lRet := cFind $ xVal EndIf If lRet EXIT EndIf EndIf NEXT RETURN lRet и в примере STATIC FUNCTION RefreshBrowse() LOCAL cSeek := Alltrim( Form_0.Text_1.Value ) IF ! Empty(cSeek) oBrw_1:FilterFTS(cSeek, .T.) ELSE oBrw_1:FilterFTS( Nil ) END RETURN Nil [/pre2]

SergKis: Haz пишет А вот CloneRow напрямую востребован. Также просят CopyRowи и PasteRow но уже через клипборд Тут надо указывать какие поля\колонки исп. в прцессе, т.к. ключевые и расчетные не участвуют

SergKis: PS CloneRow может захотеть иметь поля базы в большем объеме чем наличие колонок в тсб + данные проходят через :bData, т.е. исказиться относительно значения в поле. Copy\PasteRow - строка через chr(9), но опять значение из поля в строку или через :bData. Универсальной ситуевины не просматривается - все по месту Мне так видится

SergKis: Haz пишет скорее не FilterRow a SetFilter тк относится не к одной строке. Но вроде такое есть Метод :SetFilter есть, но что то там наворочено ... Не использую тоже исп. :FilterRow можно и со scope и небольшой вроде

Haz: SergKis пишет: Универсальной ситуевины не просматривается - все по месту Мне так видится Как правило Clone идёт в ту же таблицу, а коррекцию ключей можно предусмотреть в bPostClone например. Единственный затык это поля типа авто инкрементал. Фильтр FTS использую встроенный в ADS, он быстрее тк строит FTS индекс и позволяет искать по любым полям опционально, делая это на сервере

SergKis: Haz пишет Как правило Clone идёт в ту же таблицу Я исп. функции [pre2] *----------------------------------------------------------------------------* FUNC RecGet() *----------------------------------------------------------------------------* LOCAL oRec := oKeyData() AEval( Array( FCount() ), {|v,n| oRec:Set( FieldName( n ), FieldGet( n ) ) } ) RETURN oRec *----------------------------------------------------------------------------* FUNC RecPut( oRec ) *----------------------------------------------------------------------------* nCnt := 0 AEval( oRec:GetAll(.F.), {|a,n| n := FieldPos(a[1]), nCnt += n, ; iif( n > 0, FieldPut( n, a[2] ), ) } ) RETURN nCnt > 0 [/pre2] т.е. читаю в oRec := (cAlias)->( GetRec() ) заменяю значения в нужных полях на новые oRec:Set('FieldName5', 'abcde') ... (cAlias)->( dbAppend() ) (cAlias)->( RecPut(oRec) ) С :AppendRow ставим :bAddAfter := {|obr,ladd| iif( ladd, (ob:cAlias)->( PutRec(oRec) ) }

SergKis: PS AutoIncrement поле и др., просто удаляем из oRec oRec:Del('FieldName1') ...

SergKis: Haz пишет Как правило Clone идёт в ту же таблицу, а коррекцию ключей можно предусмотреть в bPostClone например. Единственный затык это поля типа авто инкрементал. На методе :AppendRow() не сложно получается в итоге [pre2] STATIC FUNCTION RecnoClone(oBrw) LOCAL oRec If empty(oBrw:bAddBefore) oBrw:bAddBefore := {|ob| oRec := (ob:cAlias)->( RecGet() ), ; oRec:Del('FieldName1'), ; oRec:Del('FieldName2'), ; oRec:Set('FieldName5', 'abcde'), ; oRec:Set('FieldName7', 12345) } oBrw:bAddAfter := {|ob,ladd| iif( ladd, (ob:cAlias)->( RecPut(oRec), ) } EndIf oBrw:AppendRow(.T.) (oBrw:cAlias)->(DbCommit()) RETURN Nil [/pre2]

Haz: SergKis пишет: На методе :AppendRow() не сложно Кстати да

Haz: SergKis пишет: oBrw:cAlias)->(DbCommit()) В сети вместо этого использую dbskip(0) Это гарантированно сбрасывает буфер записи. Commit у меня работал четез раз, может что то и поменялось но это многолетняя привычка эще с клиппера

SergKis: Haz Haz пишет Кстати да Та же схема и для Clipboard oRec := GetRec() System.Clipboard := hb_valtoexp(oRec:GetAll(.F.)) aRec := &( System.Clipboard ) // перед возможна проверка на формат { } oRec := oKeyData() AEval(aRec, {|a| oRec:Set(a[1], a[2]) })

SergKis: Haz пишет В сети вместо этого использую dbskip(0) Это уже нюансы, в letodb skip(0) не работает, надо dbGoto(RecNo()) или leto_commit() или dbcommit()

SergKis: SergKis пишет Та же схема и для Clipboard Можно использовать ф-ии AtoC и CtoA System.Clipboard := AtoC(oRec:GetAll(.F.)) aRec := CtoA(System.Clipboard)

Haz: SergKis пишет: System.Clipboard Возможно лучше и не клипбоард, а внутреннюю переменную. Тк вставка возможна в эту или такую же таблицу, но не в Word Excel paint и пр. И это даст возможность держать в клипбоард какую-то другую нужную информацию

SergKis: Haz пишет Возможно лучше и не клипбоард, а внутреннюю переменную. Я, думал, у тебя между разными своими приложениями передача. Главное в начало строки идентификатор лепить (к примеру id. таблицы) для проверки правильности переносимости, т.е. запись таблицы T123 можно перенести в T123,T105, ... что бы не сломать данные пересекающихся структур

Haz: SergKis пишет: между разными своими приложениями передача. Нет. Все в рамках одной системы, но как правило одна строка таблицы имеет несколько подчинённых таблиц. Можно использовать bAddAfter чтоб сохранить структуру подчиненности. Тут я рассуждал в общем что метод Clone может пригодиться. Ты его компактно нарисовал на основе AppendRow. Копирование в буфер и вставка из него, тоже... К примеру. Есть данные прогноза чего либо на текущий период, потом делается копия для следующего периода и актуализируется. Таким образом в системе живут временные среза по периодами, которые описывают что хотели, как все менялось и тд. Это я все о планах продаж. Иногда нужно руками перенести данные из прошлого в актуальный период. Во тут копи-пасте и годится. Системный клипбоард можно использовать. Но мне кажется внутренний буфер надёжнее, а может это параноя

SergKis: Haz пишет Иногда нужно руками перенести данные из прошлого в актуальный период Такое проделывал, давая отметить все или выборочно (строки тсб) в переменной (по кнопке\space,dblclick,...) Схема по памяти[pre2] oMetka := oKeyData() ... :UserKeys ( VK_SPACE, {|ob| (ob:cAlias)->( oMetka:Set( RecNo(), RecGet() ) ) }) :bLDblClick := {|p1,p2,p3,ob| ob:PostMsg( WM_KEYDOWN, VK_SPACE, 0 ) } oCol := :GetColumn('METKA') oCol:lCheckBox := .T. oCol:cAlias := :cAlias oCol:bData := {|| RecNo() } oCol:bDecode := {|nr| ! Empty(oMetka:Get(nr)) } [/pre2] Таким образом в oMetka накопятся на ключ recno объект записи. Для вставки в др. место (alias) делаем (alias)->( AEval(oMetka:GetAll(.T.)/*только объекты записи*/, {|or| dbAppend(), PutRec(or) } ) ) Сейчас с :AppendRow() можно ее проделывать в AEval (др. тсб) вместо dbAppend(), PutRec(or), но еще не пробовал.

Haz: SergKis пишет: Сейчас с :AppendRow() можно ее проделывать в AEval (др. тсб) вместо dbAppend(), PutRec(or), но еще не пробовал. Пока никто не пробовал Я раньше это через sql делал т. к. это было проще. Сейчас простые перебросы можно на новом методе опробовать. Сложные все же на sql оставлю, там скорость в разы выше за счёт 100% выполнения на серваке

SergKis: PS память подвела[pre2] :UserKeys ( VK_SPACE, {|ob,nr,lr| nr := (ob:cAlias)->( RecNo() ), lr := Empty(oMetka:Get(nr)), ; iif( lr,(ob:cAlias)->( oMetka:Set( nr, RecGet() ) ), oMetka:Del(nr) ) } [/pre2]

SergKis: Haz пишет Сложные все же на sql оставлю Здесь тоже можно убыстрить, в oMetka:Set( RecNo(), RecNo() ), а потом или через BM Filter выборку делать или передать массив записей на сервер и там сделать выборку из одной и вставку в др. таблицу. С :AppendRow() будет с прорисовкой, для небольших объемов скорость не так критична

Haz: SergKis пишет: Здесь тоже можно убыстрить Да, можно. В лето очень не хватает sql движка. Получился бы уникальный продукт. Все что ниже НЕ РЕКЛАМА Много из того что приходится делать для оптимизации уже есть в sql. Именно поэтому я уже давно перескочил на ads. Особенно удобно делать выборку для отчёта, таблицы можно клеить между собой вдоль и поперёк. В качестве примера который давно приводил Диме: Есть таблица с платежами -дата -контрагент (ID) -сумма выплаты -сумма поступлений -статья бюджета(ID) Так вот, за произвольный период от и до по дате это разворачивается в график движения денег с произвольный шагом от дня до квартала или полугодия итд ( это колонки) с подстановкой значения из справочников вместо ID и с группировкой по контрику или статье за миллисекунды. Остаётся только плюнуть этим в Excel. Что касается простых выборов данных, то делаю их на клиенте и тут чем больше возможностей tsb тем проще и понятнее делать. AppendRow уже использую, но пока как пользовательский метод. Появится в сборке - переключусь на него. В пятницу написал аналог метода GotoRec() только с сохранением RowPos на которой стояли. Помню пользователи жаловались что оригинальный прыгает на начало таблицы. Так что tsb становится все функциональнеё и стабильнее.

SergKis: Haz пишет Именно поэтому я уже давно перескочил на ads. Осмелюсь спросить, лицензионный. Лучше не говори, можешь только подмигнуть. :) В пятницу написал аналог метода GotoRec() только с сохранением RowPos на которой стояли Перепрыг на 1ую тоже происходит, но иногда. понять причину не удалось, но сама нужная запись держится. Если твой new аналог фурычит, делись пожалуйста. "Моя твоя осень, осень плагодарна будет"

Haz: SergKis пишет: можешь только подмигнуть. :) Ну подмигнуть не вопрос Если твой new аналог фурычит, делись пожалуйста. В понедельник скину в виде функции. Пока думаю надо ли оно и методом не оформил

Haz: Haz пишет: В понедельник скину в виде функции. Примерно так [pre2] STATIC FUNCTION GoRec(oBrw, nRec) LOCAL nRecno, nRowPos LOCAL nSkip := 0 LOCAL lMore := .T. LOCAL lSkip :=.F. if oBrw:lIsDbf oBrw:SetFocus() oBrw:nLastPos := (oBrw:cAlias)->(RecNo()) nRowPos := oBrw:nRowPos (oBrw:cAlias)->(dbGoto(nRec)) oBrw:nRowPos := 1 //подсчет числа скипов чтобы остаться на той же строке ( если возможно ) while lMore (oBrw:cAlias)->(dbSkip(-1)) nSkip ++ lMore := !(oBrw:cAlias)->(bof()) .and. nSkip < (nRowPos) lSkip := !(oBrw:cAlias)->(bof()) end oBrw:Refresh(.t., .t.) if lSkip oBrw:Skip(nSkip) end oBrw:nRowPos := nSkip oBrw:nAt := oBrw:nLogicPos() oBrw:ResetVScroll() If oBrw:bChange != Nil Eval( oBrw:bChange, oBrw, 0 ) EndIf oBrw:lHitTop := oBrw:lHitBottom := .F. do events end RETURN Nil [/pre2]

SergKis: Игорь, спасибо. Покручу, заменив :GotoRec()

Haz: SergKis пишет: Покручу, заменив :GotoRec() можно допилить и вторым параметром передавать желаемый RowPos, а по умолчанию пытаемся сохранить текущий. Так можно задавать первый, последний и вообще любой. У меня работает без замечаний. Ещё потестирую и вклею в проект.

SergKis: Haz пишет У меня работает без замечаний. У меня рабочая версия hmg 2.07, tsb по коду местами отличается (исторически) и приходится "привязываться к местности". :GotoRec мой сильно отличается от кода в hmg тек. версии. Так что, покрутить придется. Параметры и new возможности - это хорошо

Haz: SergKis пишет: Параметры и new возможности - это хорошо Тем более когда это не просто, а очень просто [pre2] STATIC FUNCTION GoRec(oBrw, nRec, nRowPos ) LOCAL nRecno, nRowPos LOCAL nSkip := 0 LOCAL lMore := .T. LOCAL lSkip :=.F. if oBrw:lIsDbf oBrw:SetFocus() oBrw:nLastPos := (oBrw:cAlias)->(RecNo()) nRowPos := oBrw:nRowPos hb_default( @nRowPos, oBrw:nRowPos ) (oBrw:cAlias)->(dbGoto(nRec)) oBrw:nRowPos := 1 ... [/pre2]

Haz: SergKis Примерчик как работает GoRec. там два бровса по одной DBF . При движении по MASTER отрабатывает SLAVE при этом строки через GoRec() тута

SergKis: Haz пишет Примерчик как работает GoRec Примерчик работает и в моей версии Заменил у себя метод :GotoRec на предложенный, погонял на реальной задаче - полет нормальный. Получился такой метод [pre2] METHOD GotoRec( nRec, nRowPos ) CLASS TSBrowse LOCAL nRecno, cAlias LOCAL nSkip := 0 LOCAL lMore := .T. LOCAL lSkip := .F. LOCAL lRet := .F. If ::lIsDbf lRet := .T. cAlias := ::cAlias ::SetFocus() ::nLastPos := (cAlias)->( RecNo() ) hb_default( @nRowPos, ::nRowPos ) (cAlias)->( dbGoto(nRec) ) ::nRowPos := 1 DO WHILE lMore (cAlias)->( dbSkip(-1) ) nSkip ++ lMore := !(cAlias)->(BOF()) .and. nSkip < (nRowPos) lSkip := !(cAlias)->(BOF()) ENDDO ::Refresh(.F., .F.) If lSkip ::Skip(nSkip) EndIf ::nRowPos := nSkip ::nAt := ::nLogicPos() ::ResetVScroll() If ::bChange != Nil Eval( ::bChange, Self, 0 ) EndIf ::lHitTop := ::lHitBottom := .F. EndIf RETURN lRet [/pre2]

SergKis: Игорь, перенес метод в тек. версию и собрал твой пример - получилось не как в твоем примере. Двигаемся вниз курсором, не выходя за 1ый экран идем назад к 1ой записи slave передергивает записи. Глянул и у себя это место, поведение похоже. На родном примере такого нет. Что я потерял ? Пример с методом https://my-files.ru/21e5ya

SergKis: PS Отбой, потерял DO EVENTS, пока думал как записать в метод командой или функцией.

SergKis: PPS[pre2] ::lHitTop := ::lHitBottom := .F. DO EVENTS EndIf RETURN lRet[/pre2] все исправило во всех версиях и примерах

gfilatov2002: SergKis пишет: все исправило во всех версиях и примерах Это означает, что Вы рекомендуете использовать новую редакцию этого метода в следующей сборке Я правильно понял Кстати, уже добавил новый метод FilterFTS() в текущую сборку. Благодарю за помощь

SergKis: gfilatov2002 пишет Это означает, что Вы рекомендуете использовать новую редакцию этого метода в следующей сборке В своей версии метод заменил, собрал только один проект. В нем все поиски\подводы по запросам работают как надо, т.е. одинаково с предыдущим вариантом. При случае передам новую версию в работу клиенту и понаблюдаю. Если Игорь применит у себя метод в проекте, будет больше информации. Впечатление у меня положительное.

gfilatov2002: SergKis пишет: будет больше информации Тогда откладываем эти изменения для будущих сборок. Я тестировал новую редакцию этого метода на примере Tsb_seek_2 и при перемещении на начало таблицы, а затем добавлении записи по клавише F2 на экране появляется "мусор" после последней строки в базе. У текущего метода этой проблемы нет, хотя он и не сохраняет точное значение :nRowPos, как указывал Игорь.

Haz: gfilatov2002 пишет: Это означает, что Вы рекомендуете использовать новую редакцию этого метода в следующей сборке По коду эта редакция должна быть пошустрее предыдущей плюс управляемая позиция RowPos. У себя заменил в проекте но не методом а функцией. Пока никто не жалился.

Haz: gfilatov2002 пишет: при перемещении на начало таблицы, а затем добавлении записи по клавише F2 на экране появляется "мусор" Дома только с телефона читаю. Скорее связано с тем что после добавления бровс разбалансирован. т. е. ::nLen не пересчитан. Хотя могу и ошибаться. Завтра на работе посмотрю.

SergKis: Haz пишет т. е. ::nLen не пересчитан. Это тоже присутствует, но не главное: :nRowPos -> 1 :nRow факт -> от 1 до 14 и 14 + 1 -> EOF() :nRowCount() -> 25 вот мусор и остался 25 - 14 = 11 строк

SergKis: PS :nLen -> 502

Haz: SergKis пишет: вот мусор и остался 25 - 14 = 11 строк Значит вопрос в двух параметрах Refresh( p1, p2) Возможно следует добавить проверку сколько сколько строк после RowPos и сколько записей после nRec. Или просто заменить на Refresh(.T.,.T.) но это даст моргание.

SergKis: Haz пишет но это даст моргание В данной ситуации 14 стр. должна стать 25 и :nRowPos -> 12, т.е перепрыг курсора неизбежен Пост. моргания не хотелось бы

Haz: SergKis пишет: Пост. моргания не хотелось бы Сегодня добавлю проверку и пререрисовку только когда последняя запись не на RowCount()

SergKis: gfilatov2002 пишет Кстати, уже добавил новый метод FilterFTS() в текущую сборку По мне, в сборку надо вкл. и упрощенный фильтр :FilterRow(), т.к. это др. алгоритм, нежели в :SetFilter(...) с автоматическими scope внутри. У себя я включил такой вариант (scope вполне ставится до такого фильтра)[pre2] METHOD FilterRow( cFilter, lFocus ) CLASS TSBrowse LOCAL nLen := 0, cAlias := ::cAlias IF ! Empty(cFilter) ( cAlias )->( DbSetFilter( &("{||" + cFilter + "}"), cFilter ) ) ELSE ( cAlias )->( DbClearFilter() ) END ( cAlias )->( DbGotop() ) DO WHILE ( cAlias )->( !EOF() ) DO EVENTS nLen++ ( cAlias )->( DbSkip(1) ) ENDDO ( cAlias )->( DbGotop() ) DO EVENTS ::bLogicLen := {|| nLen } ::Reset() If ! empty(lFocus) ::SetFocus() EndIf RETURN Nil [/pre2]

gfilatov2002: SergKis пишет: в сборку надо вкл. и упрощенный фильтр Буду рассматривать Ваше предложение для будущих сборок, поскольку подготовка новой сборки уже завершена. Возник вопрос: почему Вы не используете для подсчета количества строк в фильтре функцию DbEval() с условием For вместо устаревшего перебора по всем строкам [pre2]... ( cAlias )->( DbGotop() ) DO WHILE ( cAlias )->( !EOF() ) DO EVENTS nLen++ ( cAlias )->( DbSkip(1) ) ENDDO ( cAlias )->( DbGotop() ) DO EVENTS [/pre2]

SergKis: gfilatov2002 пишет почему Вы не используете для подсчета количества строк в фильтре функцию DbEval() с условием For вместо устаревшего перебора по всем строкам 1. Для небольших баз "по быстрому" иногда использую, но в блок кода принудительно вставляю DoEvents(). 2. В localhost база (реальная) ~70 000 записей DbEval работает на 2-5 сек дольше, зависит еще от ширины базы

SergKis: PS Перебор можно оптимизировать, к примеру имея массив блоков кода, вместо длинного, сложного выражения фильтра:[pre2] DO WHILE ... FOR EACH b IN aBlock If Eval(b) EXIT EndIf NEXT SKIP ENDDO [/pre2]

Haz: Haz пишет: Сегодня добавлю проверку и перерерисовку только когда последняя запись не на RowCount() Добавил проверку на полную перерисовку [pre2] METHOD GotoRec( nRec, nRowPos ) CLASS TSBrowse LOCAL cAlias LOCAL nSkip := 0 LOCAL lMore := .T. LOCAL lSkip := .F. LOCAL lRet := .F. LOCAL lReCount := .F. If ::lIsDbf lRet := .T. cAlias := ::cAlias ::SetFocus() ::nLastPos := (cAlias)->( RecNo() ) hb_default( @nRowPos, ::nRowPos ) (cAlias)->( dbGoto(nRec) ) while !(cAlias)->(eof()) .and. nSkip < ( ::nRowCount() - nRowPos ) (cAlias)->( dbSkip(1) ) nSkip ++ end if (cAlias)->(Eof()) lReCount := .T. end (cAlias)->( dbGoto(nRec) ) nSkip := 0 ::nRowPos := 1 DO WHILE lMore (cAlias)->( dbSkip(-1) ) nSkip ++ lMore := !(cAlias)->(BOF()) .and. nSkip < nRowPos lSkip := !(cAlias)->(BOF()) ENDDO ::Refresh(lReCount, lReCount ) If lSkip ::Skip(nSkip) EndIf ::nRowPos := nSkip ::nAt := ::nLogicPos() ::ResetVScroll() If ::bChange != Nil Eval( ::bChange, Self, 0 ) EndIf ::lHitTop := ::lHitBottom := .F. do events EndIf RETURN lRet [/pre2]

SergKis: Игорь, в целом работает, но есть отличия, в твоем варианте удерживается :nRowPos и нижняя часть тсб остается пустой. Это видно если в примере tsb_seek__2 сделать (oBrw:cAlias)->( FieldPut( 1, 'Y_'+ProcName()+": "+strzero(nRec, 7) ) ) :nRowPos -> 1 + F2 ==> :nRowPos -> 1 и чисто после введенной строки. У меня в проекте подвод на последнем экране (там найдена позиция) происх. тоже самое. Это будет смущать и в первую очередь не меня. С последним экраном, режим передергивания должен был бы быть разрешенным, т.е. полное заполнение тсб

Haz: SergKis пишет: Это будет смущать и в первую очередь не меня. С последним экраном, режим передергивания должен был бы быть разрешенным, т.е. полное заполнение тсб Давай какой нить флажок добавим для этого ?

Haz: Haz пишет: Давай какой нить флажок добавим для этого ? сделать то легко , нужно оговорить логику . Где-то удобнее сохранять RowPos , где-то нужно перескочить на RowCount()

SergKis: Haz пишет: Давай какой нить флажок добавим для этого ? Трудно сказать. От ввода\корректировки на самом тсб практически отказался (полей много и осталось в некоторых справочниках и по мелочи) в основном с диалог. окна, тсб в качестве индикатора перерисовывает (с окна вводим много строк сразу не выходя, да прямой GetBox побогаче с рюшечками). Даже для удаления исп. тоже окно но с readonly GetBox-ами, показывая значения их. сделать то легко , нужно оговорить логику По идее, по умолчанию, работать как раньше со сменой позиции, где нельзя удержать nRowPos, но полное заполнение тсб. При жестком удержании :nRowPos - иметь флаг. Или просто иметь два метода :GotoRow и :GoRow, если трудности с выше сказанным

Haz: SergKis пишет: По идее, по умолчанию, работать как раньше со сменой позиции, где нельзя удержать nRowPos, но полное заполнение тсб. При жестком удержании :nRowPos - иметь флаг. Надо осмыслить. Иногда записи в силу индекса или сортировки добавляются сверху тогда нужно перескакивать на первую строку. Это вроде реализуемо вторым параметром метода. Полное заполнение последней страницы сделаю сегодня чуть позже.

Haz: Haz пишет: Полное заполнение последней страницы сделаю сегодня чуть позже. уже if (cAlias)->(Eof()) lReCount := .T. nRowPos := ::nRowCount() end

SergKis: Haz пишет Иногда записи в силу индекса или сортировки добавляются сверху тогда нужно перескакивать на первую строку. Tsb_sek__2 имеет индекс и поведение нового метода по жесткому удержанию nRowPos вполне хорошее, кроме последнего экрана, на позицию выше он может перескакивать только на 1ом экране и не возможности удержать nRowPos

Haz: в итоге 2 варианта по последней странице первый [pre2] if (cAlias)->(Eof()) lReCount := .T. nRowPos := ::nRowCount() end [/pre2] второй [pre2] if (cAlias)->(Eof()) lReCount := .T. nRowPos := ::nRowCount() -nSkip + 1 end [/pre2]

SergKis: Haz пишет уже не то. nRowPos становится просто последней, а должно было бытьВ данной ситуации 14 стр. должна стать 25 и :nRowPos -> 12, т.е перепрыг курсора неизбежен т.е. последняя строка -> :nRowCount(), :nRowPos та что нашлась\ввелась выше последней

SergKis: Haz пишет второй if (cAlias)->(Eof()) lReCount := .T. nRowPos := ::nRowCount() - nSkip + 1 end Этот вариант работает, жестко держит запись и последний лист. Немного не привычно по первому листу или вставке выше - подтягивает инф. к курсору (но так и хотелось). Гонял пример tsb_seek__2 с разными вариантами вставки F2 (oBrw:cAlias)->( FieldPut( 1, ProcName()+": "+strzero(nRec, 7) ) ) (oBrw:cAlias)->( FieldPut( 1, 'AL_'+ProcName()+": "+strzero(nRec, 7) ) ) (oBrw:cAlias)->( FieldPut( 1, 'W_'+ProcName()+": "+strzero(nRec, 7) ) ) (oBrw:cAlias)->( FieldPut( 1, 'Y_'+ProcName()+": "+strzero(nRec, 7) ) ) ... все ok На всякий случай, что вышло по методу [pre2] METHOD GotoRec( nRec, nRowPos ) CLASS TSBrowse LOCAL cAlias LOCAL nSkip := 0 LOCAL lMore := .T. LOCAL lSkip := .F. LOCAL lRet := .F. LOCAL lReCount := .F. If ::lIsDbf lRet := .T. cAlias := ::cAlias ::SetFocus() ::nLastPos := (cAlias)->( RecNo() ) hb_default( @nRowPos, ::nRowPos ) (cAlias)->( dbGoto(nRec) ) DO WHILE (cAlias)->( !EOF() ) .and. nSkip < ( ::nRowCount() - nRowPos ) (cAlias)->( dbSkip(1) ) nSkip ++ ENDDO If (cAlias)->( EOF() ) lReCount := .T. nRowPos := ::nRowCount() - nSkip + 1 EndIf (cAlias)->( dbGoto(nRec) ) nSkip := 0 ::nRowPos := 1 DO WHILE lMore (cAlias)->( dbSkip(-1) ) nSkip ++ lMore := !(cAlias)->(BOF()) .and. nSkip < (nRowPos) lSkip := !(cAlias)->(BOF()) ENDDO ::Refresh(lReCount, lReCount) If lSkip ::Skip(nSkip) EndIf ::nRowPos := nSkip ::nAt := ::nLogicPos() ::ResetVScroll() If ::bChange != Nil Eval( ::bChange, Self, 0 ) EndIf ::lHitTop := ::lHitBottom := .F. DO EVENTS EndIf RETURN lRet [/pre2]

SergKis: PS Пересобрал свой проект - все аналогично работает

gfilatov2002: SergKis пишет: Этот вариант работает Да, у меня 2-й вариант тоже отработал нормально Думаю, что в следующей сборке он заменит старый метод GotoRec()

gfilatov2002: Выпущена новая сборка 18.09 для BCC 5.51 и компиляторов Harbour и xHarbour Базовый дистрибутив-инсталлятор находится по адресу http://hmgextended.com/files/CONTRIB/hmg-18.09-setup.exe Рекомендуется к использованию Также имеются следующие сборки для Си-компиляторов: - MinGW 8.1.0 32-bit для Harbour 3.2.0dev; (есть в наличии) - MinGW 8.1.0 64-bit для Harbour 3.4.0dev; (есть в наличии) - MS VisualC 2017 32-bit для Harbour 3.2.0dev; (под заказ) - Borland/Embarcadero C++ 7.3 (32-bit) для Harbour 3.4.0dev. (под заказ)

SergKis: SergKis пишет Такое проделывал, давая отметить все или выборочно (строки тсб) в переменной (по кнопке\space,dblclick,...) Схема по памяти Порихтовал пример Tsb_Basic (demo.prg -> demo3.prg) на предмет RecnoClone с учетом установленных меток, что бы была не схема, а пример. Пример тут https://my-files.ru/u10mq0

gfilatov2002: SergKis пишет: Порихтовал пример Tsb_Basic Благодарю за помощь Уже добавил этот пример в новую бету для следующей сборки.

SergKis: gfilatov2002 пишет Уже добавил этот пример Может имеет смысл такая правка в пример (цветом выделены строки для генерации ошибки) [pre2] STATIC FUNCTION RecnoClone(oBrw, lMsg) LOCAL oRec, nRec, aRec, nCnt := 0 LOCAL aClone, lClone := .F., nClone := 0 LOCAL cAls := oBrw:cAlias LOCAL oMetka := This.Button_Clone.Cargo LOCAL cMsg := "Clone line (^) and insert record in a database ?" If Empty( aClone := oMetka:GetAll(.F.) ) aClone := {{ (cAls)->( RecNo() ), (cAls)->( RecGet() ) }} EndIf If !Empty(lMsg) cMsg := StrTran( cMsg, '^', hb_ntos(Len(aClone)) ) lClone := MsgYesNo( cMsg, "Сonfirmation", .f. ) EndIf If ! lClone oBrw:SetFocus() RETURN .F. EndIf // oBrw:bAddBefore := {|ob| oRec := (ob:cAlias)->( RecGet() ) } // все поля oBrw:bAddAfter := {|ob,ladd| iif( ladd, (ob:cAlias)->( RecPut(oRec) ), ) } // все поля FOR EACH aRec IN aClone nCnt ++ If nCnt == 2; LOOP EndIf nRec := aRec[1] oRec := aRec[2] // можно удалить поля (не нужные при clone) или заполнить new значениями // oRec:Del('F1') // oRec:Del('F4') // oRec:Set('F4', .T.) // oRec:Set('F1', Date()) If oBrw:AppendRow(.T.) nClone++ oMetka:Del(nRec) // убираем метку ? "Clone=", nRec, "==>" , (cAls)->( RecNo() ) EndIf NEXT (cAls)->(DbCommit()) oBrw:bAddBefore := Nil oBrw:bAddAfter := Nil oBrw:nCell := 3 If nClone != Len(aClone) MsgStop('Selected line (' + hb_ntos(Len(aClone)) + ').' + CRLF + ; 'Insert record in a database (' + hb_ntos(nClone) + ')', 'ERROR') EndIf oBrw:SetFocus() RETURN .T. [/pre2]

gfilatov2002: SergKis пишет: такая правка в пример Принято с благодарностью

SergKis: gfilatov2002 пишет Принято Код, выделенный цветом, наверно, не надо в пример, он показывает, что метки и :AppendRow() работают и при сбое, отработав возврат из метода

gfilatov2002: SergKis пишет: Код, выделенный цветом, наверно, не надо в пример OK

SergKis: gfilatov2002 Небольшая правка [pre2] METHOD LDblClick( nRowPix, nColPix, nKeyFlags ) CLASS TSBrowse ... ::nColSpecHd := 0 If ValType( ::bDataEval( ::aColumns[ nCol ] ) ) == "L" .and. ; ::aColumns[ nCol ]:lCheckBox .and. ! ::lNoKeyChar // virtual checkbox ::PostMsg( WM_CHAR, VK_SPACE, 0 ) ... [/pre2]

gfilatov2002: SergKis пишет: Небольшая правка Добавил Благодарю за внимание

gfilatov2002: Подготовил перед отпуском уже 5-ю бету для новой сборки библиотеки Ключевые изменения в этой сборке следующие [pre2] * Fixed: Wrong row position of a WHOLEDROPDOWN menu of a ToolButton which was placed into a HORIZONTAL SplitBox control. Bug was reported by Natali Almeida. Contributed by Grigory Filatov <gfilatov@inbox.ru> * Fixed: Missed a TabPage's hotkeys management in the functions _AddTabPage() and _DeleteTabPage() in a TAB control. It exists in the official version too. Contributed by Grigory Filatov <gfilatov@inbox.ru> (see demo.prg in folder \samples\Basic\Tab) * Fixed: Problem with a ToolButton's hotkey assigning after a changing of the ToolButton 'Caption' property at runtime. It exists in the official version too. Contributed by Grigory Filatov <gfilatov@inbox.ru> (see demo1.prg in folder \samples\Basic\CONTAINERS\TOOLBAR) * Enhanced: Added the set/get 'Visible' property for the forms: - ThisWindow|<FormName>.Visible [ := | --> ] lBoolean Contributed by Grigory Filatov <gfilatov@inbox.ru> (see demo in folder \samples\Basic\NOTIFYICON) * Modified: The new Harbour function __mvGetDef() was used instead of the combination of the __mvExist()/__mvGet() in the MiniGUI core. Note: It is required a latest Harbour version for a correct work. The compatibility with xHarbour compiler and Harbour version 3.4 is provided. Contributed by Grigory Filatov <gfilatov@inbox.ru> * Modified: The function WaitWindow() was improved for masking of a hidden border on form's top at Windows 10. Problem was reported by Pierpaolo Martinello. Contributed by Grigory Filatov <gfilatov@inbox.ru> (see demo.prg in folder \samples\Basic\WAIT_WINDOW) * Updated: Synchronized Extended HMG for compatibility with Official HMG: - New: Draw GRAPH in Bitmap is based upon the BosTaurus library. Added the new command GRAPH BITMAP for PIE|BARS|LINES|POINTS graph. An algorithm of 'Graph Bitmap' was updated for compatibility with a graphic module in the MiniGUI core. Note: It is highly recommended to use Graph Bitmap instead of Graph Command because the painting is much more efficient and does not produce a flicker. Based upon a contribution of S. Rathinagiri <srgiri/at/dataone.in>. Adapted for Minigui Extended by Grigory Filatov <gfilatov@inbox.ru> (see demo in folder \samples\Advanced\BTGraph) - New: Added an alternative syntax for the following controls: - SplitBox; - Tab; - Tree. (see into the appropriate header's files) * Updated: Adaptation FiveWin Class TSBrowse 9.0 in HMG: - added the new method FilterData( cFilter, lFocus ) in the TSBrowse class. Contributed by Sergej Kiselev (see demo in folder \samples\Advanced\Tsb_ListBox) - modified the method GotoRec( nRec [, nRowPos ] ) in the TSBrowse class. Contributed by Igor Nazarov (see demo in folder \samples\Advanced\Tsb_GotoRec) [/pre2] Для этой сборки оставил компилятор BCC 5.51 с учетом мнения заинтересованных лиц Для последующих сборок выбираю бесплатный компилятор из - Embarcadero C++ 10.1 (32-bit) - MS Visual C++ 2017 compiler (32-bit и 64-bit) но все же склоняюсь к первому варианту Что посоветуете - есть ли смысл в изменении компилятора или "старое болото" лучше

Dima: gfilatov2002 пишет: Что посоветуете - есть ли смысл в изменении компилятора Какие плюсы/минусы от смены ?

gfilatov2002: Dima пишет: Какие плюсы/минусы от смены ? Благодарю за отклик Плюсы: - нормальная поддержка новых фич, которые появились, начиная с Висты (это классы MARQUE, CUEBANNER и новые элементы управления CLBUTTON, SPLITBUTTON и др.) - скорость работы компилированного кода выше, чем у BCC 5.5 за счет использования новых возможностей LLVM компилятора - полная совместимость со старым кодом Минусы: - поддержка операционок, начиная с Висты (XP остается за бортом) - незначительное увеличение размера кода приложений (порядка 200 кБайт)

Andrey: gfilatov2002 пишет: Что посоветуете - есть ли смысл в изменении компилятора Нужен лучше - MS Visual C++ 2017 compiler (32-bit и 64-bit) Под него поддержка лучше, и доки больше ! Я под него собираюсь переходить. При использовании других библиотек (а я использую другие - HASP) библиотеки ТОЛЬКО под BCC и MSVC. ХР можно оставлять за бортом. Пускай юзера на 7-ку переходят. Я со следующего года всех ХР-ников "обрежу".

Dima: gfilatov2002 пишет: Минусы: - поддержка операционок, начиная с Висты (XP остается за бортом) А вот это плохо....(но не смертельно)

SergKis: gfilatov2002 пишет:Что посоветуете - есть ли смысл в изменении компилятора Vc 2017 ближе. Сами потихоньку подготавливаемся к переползанию.

Haz: gfilatov2002 пишет: XP остается за бортом) так вроде уже давно там. я и не помню уже когда видел в последний раз

ММК: Dima пишет: А вот это плохо....(но не смертельно) Здравствуй ,Дима :)) Действительно не смертельно. Разработчик винды прекращает поддержку ХР и т.д. ( или прекратил) , но ХР как работала , так и будет работать. Задачи собранные на ВСС работали на ХР и работают на 10 - ке. На наш "трудовой век" хватит... Андрей , как не писал на си, так и не будет писать... На самом деле вопрос в том будет ли работать минигуи ( и на чем ) :) Интерес есть для тех , кто пишет на конкретном компиляторе, поэтому лучше использовать несколько. К примеру ВСС делает файлики меньше, сам удобен для флэшки. Кто-то хочет работать только дома и с соответствующей оболочкой. Например Visual Studio. Скорость работы? В теории наверное- Да, на практике не существенно ( мне так кажется). Поэтому наверное удобнее собирать и выкладывать библиотеки на разных компиляторах. Вот так комплектуются библиотеки для FW который под Харбор FWH - FiveWin for Harbour * Borland BCC 7.0 version: fiveh.lib, fivehc.lib * Microsoft Visual C++ version: fivehm.lib, fivehcm.lib * Libraries FiveH32.lib and FiveHC32.lib are to be used with Microsoft Visual Studio Community 2015. FiveHCM.lib and FiveHMX.lib are to be used with xHarbour commercial * MinGW gcc: fivehg.lib, fivehgc.lib FWHX - FiveWin for xHarbour * Borland BCC 5.82 version: fivehx.lib, fivehc.lib * Microsoft Visual C++ version: fivehmx.lib, fivehcm.lib FWH64 - FiveWin 64 for Harbour/xHarbour 64 bits * Harbour and Microsoft C 64 version: fiveh64.lib, fivehc64.lib * Harbour and Borland 7.1 64 bits: five64.a, fivec64.a XHB - Fivewin for xHarbour commercial * xfw.lib

Dima: ММК Привет ! Я не к этому вел. Просто есть еще старое оборудование: кассы , некоторые модели весов и тд и тп которое пашет только на XP , выше не работают , поэтому и ось там менять ни кто не хочет.

gfilatov2002: ММК пишет: На самом деле вопрос в том будет ли работать минигуи Согласен ММК пишет: Скорость работы? В теории наверное- Да, на практике не существенно Снова согласен ММК пишет: удобнее собирать и выкладывать библиотеки на разных компиляторах Я, собственно, так и делаю (для разных Си-компиляторов собираю готовую рабочую среду - Си-компилятор+Харбор+Минигуи). Но, кроме 64-бит MinGW сборки, интереса к таким решениям не наблюдается P.S. Однако уже два голоса за Visual C

gfilatov2002: Dima пишет: которое пашет только на XP Да, есть такая проблема, поэтому BCC 5.5 до сих пор жив (18 лет ему стукнуло, как и Харбору)

SkyNET: gfilatov2002 пишет: Для последующих сборок выбираю бесплатный компилятор из - Embarcadero C++ 10.1 (32-bit) - MS Visual C++ 2017 compiler (32-bit и 64-bit) но все же склоняюсь к первому варианту А что мешает пойти по пути ядра Harbour и оставить выбор компилятора за программистом? С конфликтами компиляции под него пускай борются те, кто в нём разбираются. Кстати, а в Embarcadero C++ Compiler доступна ли Clang версия компилятора (BCC32C)? Если нет, то это крайне существенный недостаток. Я недавно игрался с Embarcadero C++ Builder Community Edition, так там по умолчанию (с BCC32 компилятором) даже поддержка C++ стандарта 2011 года хромает. Например, полностью отсутствует nullptr, что очень странно для 2018 года. ММК пишет: Задачи собранные на ВСС работали на ХР и работают на 10 - ке. На наш "трудовой век" хватит... У меня собранные приложения в Visual Studio 2017 прекрасно работают и на XP. Достаточно одной галочки в проекте: С компиляцией из консоли для XP правда скорее всего придётся немного помучаться.

gfilatov2002: SkyNET пишет: что мешает пойти по пути ядра Harbour и оставить выбор компилятора за программистом? С конфликтами компиляции под него пускай борются те, кто в нём разбираются. Мешает лень прикладных программистов, которые не хотят разбираться с этими проблемами, оставляя их решение "системщикам" SkyNET пишет: в Embarcadero C++ Compiler доступна ли Clang версия компилятора (BCC32C)? Да, Embarcadero’s free C++ compiler использует именно bcc32c.exe При этом Харбор определяет этот компилятор как LLVM/Clang C 3.3.1 (35832.6139226.5cda94d) (32-bit) x86 Благодарю за Ваше внимание

Andrey: SkyNET пишет: У меня собранные приложения в Visual Studio 2017 прекрасно работают и на XP. Тогда это отличная новость ! Т.е. ХР можно будет и дальше сопровождать. Я обеими руками за MSVC !

TimTim: Только недавно стал пробовать писать используя MiniGUI. Да, "старое болото" оно привычней и на наш век хватит. Но двигаться вперед тоже надо, оправдывать приставку Extended. Согласен с ММК: наверное удобнее собирать и выкладывать библиотеки на разных компиляторах. Работы непосредственно с компилятором С у меня нет. На С не пишу. Пока со сторонними библиотеками на С не сталкивался. Поэтому выбор компилятора не совсем моя тема. Тем более, что все тонкости работы с компиляторами взял на себя Григорий. Конечно, MSVC привлекателен тем, что действительно для него много доки, и Windows-ы написаны в той же компании, что и этот компилятор. Мое мнение очень субъективно. Я бы попробовал месяц поработать с библиотеками MiniGui собранными на одном компиляторе, а потом месяц на другом. Возможно, тогда выбор будет более осознанным.

gfilatov2002: TimTim пишет: Конечно, MSVC привлекателен Благодарю за отклик TimTim пишет: Я бы попробовал месяц поработать с библиотеками MiniGui собранными на одном компиляторе, а потом месяц на другом. Вы можете это сделать прямо сейчас. Попробуйте скачать сборку для бесплатного Embarcadero’s C++ компилятора версии 10.1 с сайта Минигуи, и пробуйте

gfilatov2002: Собрался и выполнил адаптацию ядра библиотеки для работы с компилятором Microsoft Visual C++ 19.10.25017 (64-bit) Для этого пришлось поправить кастинг в 35 сишных модулях Теперь протокол компиляции библиотеки чистый, без предупреждений от компилятора hbmk2: Compiling Harbour sources... hbmk2: Compiling... ErrorSys.c h_activex.c h_alert.c h_animate.c h_browse.c h_btntextbox.c h_button.c h_checkbox.c h_chklabel.c h_chklistbox.c h_clbutton.c h_combo.c h_controlmisc.c h_crypt.c h_datepicker.c h_dialog.c h_dialogs.c h_draw.c h_edit.c h_edit_ex.c Generating Code... Compiling... h_editbox.c h_error.c h_events.c h_folder.c h_font.c h_frame.c h_getbox.c h_Gif89.c h_gradient.c h_graph.c h_GraphBitmap.c h_grid.c h_help.c h_hotkey.c h_hotkeybox.c h_hyperlink.c h_image.c h_imagelist.c h_ini.c h_init.c Generating Code... Compiling... h_ipaddress.c h_label.c h_listbox.c h_media.c h_menu.c h_misc.c h_monthcal.c h_mru.c h_msgbox.c h_objects.c h_objmisc.c h_pager.c h_progressbar.c h_radio.c h_registry.c h_report.c h_richeditbox.c h_rptgen.c h_scrsaver.c h_slider.c Generating Code... Compiling... h_socket.c h_spinner.c h_splitbutton.c h_status.c h_tab.c h_taskdlg.c h_textbox.c h_timer.c h_toolbar.c h_tree.c h_wbrush.c h_webcam.c h_winapimisc.c h_windows.c h_windowsMDI.c h_winprop.c c_bitmap.c c_browse.c c_btntextbox.c c_button.c Generating Code... Compiling... c_checkbox.c c_chklabel.c c_chklistbox.c c_combo.c c_controlmisc.c c_cuebanner.c c_cursor.c c_datepicker.c c_dialog.c c_dialogs.c c_draw.c c_error.c c_editbox.c c_folder.c c_font.c c_frame.c c_getbox.c c_graph.c c_grid.c c_help.c Generating Code... Compiling... c_hmgapp.c c_hotkey.c c_hotkeybox.c c_icon.c c_image.c c_imagelist.c c_ini.c c_ipaddress.c c_label.c c_listbox.c c_media.c c_menu.c c_monitors.c c_monthcal.c c_msgbox.c c_pager.c c_progressbar.c c_radio.c c_registry.c c_resource.c Generating Code... Compiling... c_richeditbox.c c_scrsaver.c c_slider.c c_spinner.c c_status.c c_tab.c c_taskdlgs.c c_textbox.c c_timer.c c_toolbar.c c_tooltip.c c_tree.c c_winapimisc.c c_windows.c c_windowsAPI.c c_windowsCLS.c c_windowsMDI.c c_winprop.c c_winxp.c hbgdiplus.c Generating Code... hbmk2: Creating static library... ..\lib\minigui.lib Тесты Харбора показывают, что бесплатный MSVC 64 работает вдвое быстрее свежего, но платного BCC 7.30 (32-bit). Благодарю за Ваше внимание

Alw Spencer: gfilatov2002 Вопросик Если всё будет собираться скажем с Microsoft Visual C++ 19.10.25017 (32-bit) и с опцией для XP, то инсталлировать дополнительные Runtime C++ библиотеки на стороне клиента нужно или всё же EXE получается автономный (как в случае с BCC 5)?

gfilatov2002: Alw Spencer пишет: инсталлировать дополнительные Runtime C++ библиотеки на стороне клиента нужно Увы, НУЖНО устанавливать эти DLL-ки даже на Семерке

SergKis: gfilatov2002 пишет * Updated: Adaptation FiveWin Class TSBrowse 9.0 in HMG: ... - modified the method GotoRec( nRec [, nRowPos ] ) in the TSBrowse ... В методе GotoRec(...) надо убрать строку[pre2] If ::lIsDbf lRet := .T. cAlias := ::cAlias // ::SetFocus() ::nLastPos := (cAlias)->( RecNo() ) [/pre2] сломает фокус на др. контролах, при работе в событии CHANGE ... У себяубрал, т.к. сломались подводы на getbox-ах, с них фокус улетал на тсб

SergKis: PS Может тут слегка поправить ?[pre2] FUNCTION HMG_Alert( cMsg, aOptions, cTitle, nType ) ... LOCAL lFont := .F. ... IF ! _IsControlDefined( "DlgFont", "Main" ) lFont := .T. DEFINE FONT DlgFont FONTNAME "MS Shell Dlg" SIZE 9 ENDIF ... If lFont RELEASE FONT DlgFont EndIf RETURN iif( lEmpty, 0, _HMG_ModalDialogReturn ) ... [/pre2]

Haz: SergKis пишет: ломает фокус на др. контролах, при работе в событии CHANGE ... У себяубрал, т.к. сломались подводы на getbox-ах, с них фокус улетал на тсб Да, сразу не обратил внимания. В остальном без фокуса есть замечания ?

SergKis: Haz пишет В остальном без фокуса есть замечания ? Собрал реальный проект сегодня, отдал в работу. Будем посмотреть Фокус вылез на однотипных подводах, поправил, у меня ok!, остальное подождем ...

SergKis: gfilatov2002 Что то сломалось в применении This для Domethod(...)[pre2] // ошибка везде лезет (пример C:\MiniGui\SAMPLES\BASIC\BUTTON_1>call ..\..\..\batch\compile.bat demo) This.Button_4.SetFocus() demo.prg(154) Error E0030 Syntax error "syntax error at '.'" ставлю сюда (но не важно в др. событиях так же) This.Button_4.SetFocus() END WINDOW ... This.Button_4.Height This.Button_4.Index работают [/pre2]

gfilatov2002: SergKis пишет: Может тут слегка поправить ? Принято Благодарю за помощь

gfilatov2002: SergKis пишет: В методе GotoRec(...) надо убрать строку Пока вернулся к старой редакции этого метода, которая работает медленнее, но стабильнее

gfilatov2002: SergKis пишет: сломалось в применении This для Domethod(...) Уже поправил - это был мой "косяк" Благодарю за подсказку

SergKis: gfilatov2002 пишет Пока вернулся к старой редакции этого метода Может новый метод назвать :GoRec( nRecNo, nRowPos), потом можно совместить, если что. По мне он и сейчас хорош и требует небольшой доводки. Как метод, наверно, только у меня крутится. Если будет у большего числа пользователей, быстрее отладится

SergKis: gfilatov2002 Игорь поправил :GotoRec(...). Пример для проверки (функ. myGotoRow(...) с галочками работает функция) https://my-files.ru/gwnw6t Текст метода [pre2] METHOD GotoRec( nRec, nRowPos ) CLASS TSBrowse LOCAL cAlias LOCAL nSkip := 0 LOCAL n := 0 LOCAL nRecSave := 0 LOCAL lMore := .T. LOCAL lSkip := .F. LOCAL lRet := .F. LOCAL lReCount := .F. If ::lIsDbf lRet := .T. cAlias := ::cAlias ::nLastPos := (cAlias)->( RecNo() ) hb_default( @nRowPos, ::nRowPos ) (cAlias)->( dbGoto(nRec) ) n := 0 DO WHILE (cAlias)->( !BOF() ) .and. n < nRowPos - 1 (cAlias)->( dbSkip(-1) ) If !(cAlias)->( BOF() ) n ++ EndIf ENDDO nSkip := n (cAlias)->( dbGoto(nRec) ) (cAlias)->( dbSkip( -nSkip ) ) nRecSave := (cAlias)->( Recno() ) nRowPos := Min( nSkip + 1, nRowPos ) (cAlias)->( dbGoto(nRec) ) n := 0 DO WHILE (cAlias)->( !EOF() ) .and. n < ( ::nRowCount() - nRowPos ) (cAlias)->( dbSkip(1) ) If !(cAlias)->( EOF() ) n ++ EndIf ENDDO If n < ( ::nRowCount() - nRowPos ) lReCount := .T. EndIf (cAlias)->( dbGoto(nRecSave) ) ::nRowPos := nRowPos ::Refresh( lReCount, lReCount ) ::Skip( nSkip ) ::ResetVscroll() If ::bChange != Nil Eval( ::bChange, Self, 0 ) EndIf ::lHitTop := ::lHitBottom := .F. DO EVENTS EndIf RETURN lRet [/pre2] Пример для проверки работы метода https://my-files.ru/e0jvqq

Andrey: SergKis пишет: Пример для проверки работы метода Что-то на Down давишь и запись никуда не двигается... Или это только у меня так ?

SergKis: Andrey подробнее, на какой строке жмешь, если на последней, то куда ниже двигать ? так же на первой Up ?

gfilatov2002: SergKis пишет: Игорь поправил :GotoRec(...) Супер! Метод работает отлично Благодарю за реальную помощь в развитии этой библиотеки

Haz: SergKis пишет: Пример для проверки работы метода Подумалось, может в методе в качестве nRec реализовать возможность принимать не только номер записи, но и блок кода? Этот блок должен вернуть номер записи, тогда туда можно закинуть и dbLocate() и dbSeek () и тд! И устанавливать запись на результат выполнения блока.

Andrey: SergKis пишет: подробнее, на какой строке жмешь, если на последней, то куда ниже двигать ? так же на первой Up ? Маркер стоит посередине таблицы. Нажимаем Down - менюшка, а потом маркер на месте, а запись поменялась с нижней. Если нажимаем Up, менюшка и маркер двигает запись вверх на одну. Т.е. я предполагал, что при движении вниз и маркер должен скакать сам вниз вместе с записью.

SergKis: Andrey пишет Т.е. я предполагал, что при движении вниз и маркер должен скакать сам вниз вместе с записью. :GotoRec(nRec, nRowPos) теперь имеет 2а параметра. если второй пар-р не задан - удерживается текущий :nRowPos тот алгоритм, что предполагал, проделывай сам. см. работу Insert -> там 2ой параметр используется

SergKis: PS сам маркер никому ничего должен скорее ты ему ... алгоритмом

TimTim: Отличная идея, классный алгоритм. Буду изучать. Andrey пишет: Т.е. я предполагал, что при движении вниз и маркер должен скакать сам вниз вместе с записью. Кстати, при движении вверх происходит как раз так, как Андрей и хотел, а вниз - нет. Маркер не "слушается", ведет себя как хочет?

SergKis: TimTim пишет Маркер не "слушается", ведет себя как хочет? В этом вы правы - лечится так (цель была проверить работу new :GotoRec):[pre2] EndIf // nRec := nRec1 Else (cAls)->( dbSkip(-1) ) nRec2 := (cAls)->( RecNo() ) // nRec := nRec2 EndIf [/pre2] Алгоритм с перемещением маркера такой, на вскидку (могут быть шероховатости)[pre2] STATIC FUNCTION RecMove(oBrw, nSkip) LOCAL nRec1, oRec1, nKey1, nRec2, oRec2, nKey2 LOCAL cAls := oBrw:cAlias, lRet := .F. LOCAL nRow := oBrw:nRowPos, nPos LOCAL nMax := oBrw:nRowCount() LOCAL nRec := (cAls)->( RecNo() ) IF ! MsgYesNo( "You want to "+iif( nSkip > 0, "Down", "Up" )+; " record in the table ?", "Сonfirmation", .f. ) oBrw:SetFocus() RETURN lRet ENDIF nRec1 := nRec nRec2 := nRec1 oRec1 := (cAls)->( RecGet() ) nKey1 := oRec1:Get('F0') nPos := 0 If (cAls)->( FLock() ) If nSkip > 0 (cAls)->( dbSkip(1) ) If (cAls)->( !EOF() ) nRec2 := (cAls)->( RecNo() ) EndIf nRec := nRec2 nPos := 1 Else (cAls)->( dbSkip(-1) ) nRec2 := (cAls)->( RecNo() ) nRec := nRec2 EndIf If nRec1 != nRec2 oRec2 := (cAls)->( RecGet() ) nKey2 := oRec2:Get('F0') oRec2:Set('F0', nKey1) oRec1:Set('F0', nKey2) (cAls)->( RecPut(oRec1) ) (cAls)->( dbGoto(nRec1) ) (cAls)->( RecPut(oRec2) ) lRet := .T. EndIf (cAls)->( dbUnLock() ) Endif // MsgDebug( nRec, nRow ) (cAls)->( dbGoto(nRec) ) If lRet nPos := iif( nRow < nMax, nPos, 0 ) oBrw:GotoRec(nRec, nRow + nPos) DO EVENTS EndIf oBrw:SetFocus() RETURN lRet [/pre2]

SergKis: pS Забыл, что либы еще нет. Пример https://my-files.ru/y720va

TimTim: , но ... SergKis пишет: могут быть шероховатости Их есть. Делаем так. В программе изначально ставим создать БД не с 15 записями, а скажем с 20 (можно просто вставить в конец 3 или больше строк). Главное вся БД не помещается в окошко. Передвигаемся в конец базы. Поднимаем последнюю строку на 1 вверх, затем опускаем вниз, типа ошиблись. У меня 20-я запись идет после 16. А у вас?

Haz: TimTim пишет: У меня 20-я запись идет после 16. А у вас? У меня все нормально



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