Форум » GUI » Новая версия Расширенного релиза библиотеки MiniGUI (часть VI ) (продолжение) » Ответить
Новая версия Расширенного релиза библиотеки MiniGUI (часть VI ) (продолжение)
gfilatov: Начало темы находится здесь, а теперь АНОНС * АНОНС * АНОНС * АНОНС * АНОНС Готовится к опубликованию новая сборка №48, которая выйдет в конце недели. Если у Вас есть интересные наработки для включения в новый релиз, то сейчас самое удобное время для их отправки мне Кратко, что нового: - исправление обнаруженных ошибок и неточностей кода; - новый класс HEADERIMAGE для Grid и Browse; - свойство Address в Hyperlink может теперь открывать папку или файл на диске; - добавлен NOTABSTOP класс для Browse; - поддержка пользовательских компонентов (заимствована из оффициального релиза); - расширения и исправления в библиотеках TsBrowse и PropGrid; - обновлены сборки Харбор и HMGS-IDE; - новые и обновленные старые примеры (как обычно ).
Andrey: SergKis - лучше напиши демонстрашку маленькую, тогда понятней будет для чего всё это затевается ! Только с комментариями на русском !
SergKis: Andrey пишет лучше напиши демонстрашку маленькую, тогда понятней будет для чего всё это затевается Вроде для чего и примеры, разъяснения все время даю. Выйдет версия посмотри примеры и перечитай написанное для начала. Затевается для работы с окнами\контролами через посылку сообщений, как дополнение к тому что есть в hmg.
gfilatov2002: SergKis пишет: CLASS TStbData INHERIT TCnlData Добавил предложенный класс в ядро библиотеки (с исправлением обнаруженных опечаток) и проверил его работу на простом примере: [pre2]#include "minigui.ch" MEMVAR oWnd Function Main LOCAL nY, nH SET OOP ON DEFINE WINDOW Form_1 ; AT 0,0 ; WIDTH 800 HEIGHT 600 ; TITLE 'MiniGUI SplitBox Demo' ; MAIN ; FONT 'Arial' SIZE 10 PUBLIC oWnd := ThisWindow.Object DEFINE MAIN MENU POPUP '&File' ITEM 'Exit' ACTION Form_1.Release END POPUP POPUP '&Help' ITEM 'About' ACTION MsgInfo (MiniGUIVersion(), "MiniGUI Demo") END POPUP END MENU DEFINE SPLITBOX DEFINE TOOLBAR ToolBar_1 BUTTONSIZE 85,85 FLAT BUTTON Button_1 CAPTION '&More ToolBars...' PICTURE 'button1.bmp' ACTION MsgInfo('Click! 1') TOOLTIP 'ONE' BUTTON Button_2 CAPTION '&Button 2' PICTURE 'button2.bmp' ACTION MsgInfo('Click! 2') TOOLTIP 'TWO' BUTTON Button_3 CAPTION 'Button &3' PICTURE 'button3.bmp' ACTION MsgInfo('Click! 3') TOOLTIP 'THREE' END TOOLBAR END SPLITBOX DEFINE STATUSBAR STATUSITEM 'HMG Power Ready' STATUSITEM '' END STATUSBAR WITH OBJECT oWnd:Stb :Icon("test.ico") :Say(MiniGUIVersion(), 2) :Width(2, 300) :Action(2, {|| MsgInfo('Status Item Click!')}) END WITH nY := GetWindowHeight( _HMG_aFormReBarHandle [ oWnd:Index ] ) nH := This.ClientHeight - GetWindowHeight( oWnd:Stb:Handle ) - nY @nY + 5, 10 LABEL lblClient VALUE "Client Height = " + hb_ntos( nH ) + " pixels" AUTOSIZE END WINDOW CENTER WINDOW Form_1 ACTIVATE WINDOW Form_1 Return Nil [/pre2] Этот пример отработал нормально. Благодарю за помощь P.S. Еще, по-видимому, надо добавить обработчик ошибок в родительский класс TWndData: ERROR HANDLER OnError( uParam1 )
SergKis: gfilatov2002 пишет nY := GetWindowHeight( _HMG_aFormReBarHandle [ oWnd:Index ] ) Это возможный вариант, но красивее тогда как было DEFINE SPLITBOX HANDLE hSplit ... nY := GetWindowHeight(hSplit) По поводу ERROR HANDLE ... пока не задумывался, но, наверно, надо.
SergKis: gfilatov2002 пишет nH := This.ClientHeight - GetWindowHeight( oWnd:Stb:Handle ) - nY Можно так nH := This.ClientHeight - oWnd:Stb:Height - nY
gfilatov2002: SergKis пишет: красивее тогда как было SergKis пишет: Можно так Благодарю за помощь! Поправил, конечно...
SergKis: gfilatov2002 пишет PUBLIC oWnd := ThisWindow.Object Пожелания (названия переменных условны) - для Main окна делать PUBLiC oMain := ThisWindow.Object - для окна узел (имеет подчиненные окна) PUBLIC oForm := ThisWindow.Object - для текущего окна PRIVATE oWnd := ThisWindow.Object Тогда, все с текущего окна хорошо переносится на др. окна и в некоторых случаях, подменив на время ссылку на объект в oWnd, можно выполнить что то общее с др. окна, при наличии нескольких окон одновременно, легко окнам общаться сообщениями, oMain всегда доступно, т.е. для примера PUBL oMain := ThisWindow.Object PRIV oWnd := oMain
SergKis: PS PUBLIC oForm := ThisWindow.Object можно делать и PRIVATE ..., к примеру PRIV oDokum := ThisWindow.Object PRIV oKlient := ThisWindow.Object ...
gfilatov2002: SergKis пишет: для примера PUBL oMain := ThisWindow.Object PRIV oWnd := oMain Благодарю за пояснение! Поправил пример с учетом этой логики
SergKis: gfilatov2002 Предложение по GetBox, добавить события LDblClick и WM_KEYDOWN VK_F... Изменения [pre2] c_getbox.c LRESULT CALLBACK OwnGetProc( HWND hwnd, UINT Msg, WPARAM wParam, LPARAM lParam ) ... line 424 return CallWindowProc( OldWndProc, hwnd, Msg, wParam, lParam ); case WM_LBUTTONDBLCLK : case WM_KEYDOWN: case WM_KEYUP: if( ! pSymbol ) ... h_getbox.prg FUNCTION OGETEVENTS( hWnd, nMsg, wParam, lParam ) ... ENDCASE CASE nMsg == WM_LBUTTONDBLCLK IF wParam == MK_LBUTTON RETURN oGet:DoKeyEvent( nMsg ) ENDIF CASE nMsg == WM_KEYDOWN ... // у себя объединил раздельные IF ... ENDIF IF ... ENDIF ... в одну конструкцию IF .. ELSEIF ... ENDIF , т.е. ... lShift := CheckBit( GetKeyState( VK_SHIFT ) , 32768 ) lCtrl := CheckBit( GetKeyState( VK_CONTROL ) , 32768 ) IF lCtrl .AND. wParam == VK_INSERT CopyToClipboard( oGet:Buffer ) RETURN( 0 ) ELSEIF lShift .AND. wParam == VK_INSERT SendMessage( hWnd , WM_PASTE , 0 , 0 ) RETURN( 0 ) ELSEIF wParam == VK_DOWN IF !lCtrl .AND. !lShift SendMessage( hWnd , EM_SETSEL , nEnd , nEnd ) IF ValType( oGet:cargo ) == "D" .AND. oGet:BadDate RETURN( 0 ) ELSE _GetBoxSetNextFocus( .F. ) RETURN( 0 ) ENDIF ELSE IF lCtrl .AND. lAllowEdit IF oGet:type == "D" .OR. oGet:type == "N" oGet:VarPut( oGet:VarGet() - 1 ) oGet:UpdateBuffer() _DispGetBoxText( hWnd, oGet:Buffer ) oGet:changed := .T. ENDIF IF oGet:type == "L" oGet:VarPut( !oGet:VarGet() ) oGet:UpdateBuffer() _DispGetBoxText( hWnd, oGet:Buffer ) oGet:changed := .T. ENDIF ENDIF ENDIF RETURN( 0 ) ELSEIF wParam == VK_UP IF !lCtrl .AND. !lShift SendMessage( hWnd , EM_SETSEL , nEnd , nEnd ) IF ValType( oGet:cargo ) == "D" .AND. oGet:BadDate RETURN( 0 ) ELSE _GetBoxSetNextFocus( .T. ) RETURN( 0 ) ENDIF ELSE IF lCtrl .AND. lAllowEdit IF oGet:type == "D" .OR. oGet:type == "N" oGet:VarPut( oGet:VarGet() + 1 ) oGet:UpdateBuffer() _DispGetBoxText( hWnd, oGet:Buffer ) oGet:changed := .T. ENDIF IF oGet:type == "L" oGet:VarPut( ! oGet:VarGet() ) oGet:UpdateBuffer() _DispGetBoxText( hWnd, oGet:Buffer ) oGet:changed := .T. ENDIF ENDIF ENDIF RETURN( 0 ) ELSEIF wParam == VK_LEFT SendMessage( hWnd , EM_SETSEL , nEnd - 1 , nEnd - 1 ) _HMG_aControlMiscData1 [ i ][1] := 0 oGet:pos := HiWord( SendMessage( hWnd, EM_GETSEL, 0, 0 ) ) + 1 ELSEIF wParam == VK_RIGHT SendMessage( hWnd , EM_SETSEL , nStart + 1 , nStart + 1 ) _HMG_aControlMiscData1 [ i ][1] := 0 oGet:pos := HiWord( SendMessage( hWnd, EM_GETSEL, 0, 0 ) ) + 1 ELSEIF wParam == VK_HOME SendMessage( hWnd , EM_SETSEL , 0 , 0 ) oGet:pos := HiWord( SendMessage( hWnd, EM_GETSEL, 0, 0 ) ) + 1 ELSEIF wParam == VK_END // Patch By Pier July 2008 // Add By Pier patch for the incorrect end position START IF HiWord( SendMessage( hWnd , EM_GETSEL , 0 , 0 ) ) < Len( Trim( oGet:Buffer ) ) SendMessage( hWnd , EM_SETSEL , Len( Trim( oGet:Buffer ) ) , Len( Trim( oGet:Buffer ) ) ) ELSE SendMessage( hWnd , EM_SETSEL , Len( oGet:Buffer ) , Len( oGet:Buffer ) ) ENDIF // Add By Pier patch for the incorrect end position STOP oGet:pos := HiWord( SendMessage( hWnd, EM_GETSEL, 0, 0 ) ) + 1 ELSEIF wParam == VK_INSERT lInsert := ! lInsert _SetGetBoxCaret( hWnd ) ELSEIF wParam == VK_DELETE IF readonly .OR. ! lAllowEdit .OR. oGet:type == "L" RETURN( 0 ) ENDIF nStart := LoWord( SendMessage( hWnd, EM_GETSEL, 0, 0 ) ) + 1 nEnd := HiWord( SendMessage( hWnd, EM_GETSEL, 0, 0 ) ) + 1 oGet:pos := nEnd IF nStart # nEnd IF nEnd > Len( oGet:buffer ) oGet:Delete() ENDIF FOR ipp := nStart TO nEnd IF oGet:pos > nStart IF oGet:type == "N" .AND. SubStr( oGet:buffer, oGet:pos, 1 ) $ "(-" oGet:minus := .F. ENDIF oGet:BackSpace() ELSE EXIT ENDIF NEXT ELSE IF _IsEditable( oGet:pos , i ) IF oGet:type == "N" .AND. SubStr( oGet:buffer, oGet:pos, 1 ) $ "(-" oGet:minus := .F. ENDIF oGet:Delete() ENDIF ENDIF oGet:Assign() _DispGetBoxText( hWnd, oGet:buffer ) SendMessage( hWnd, EM_SETSEL, oGet:pos - 1, oGet:pos - 1 ) RETURN( 0 ) ELSE oGet:DoKeyEvent( wParam ) ENDIF CASE nMsg == WM_PASTE ... tget.prg ... #include "hblang.ch" #include "i_winuser.ch" #include "i_keybd.ch" /* TODO: :posInBuffer( <nRow>, <nCol> ) --> nPos ... CLASS Get EXPORTED: ... DATA aKeyEvent INIT {} ... METHOD OverStrike( cChar ) METHOD SetKeyEvent( nKey, bKey, lCtrl, lShift, lAlt ) METHOD DoKeyEvent ( nKey ) PROTECTED: ... METHOD SetKeyEvent( nKey, bKey, lCtrl, lShift, lAlt ) CLASS Get LOCAL n, cKey cKey := hb_ntos( iif( HB_ISNUMERIC(nKey), nKey, WM_LBUTTONDBLCLK ) ) cKey += iif( empty(lCtrl ), '', '#' ) cKey += iif( empty(lShift), '', '^' ) cKey += iif( empty(lAlt ), '', '@' ) If ( n := AScan( ::aKeyEvent, {|a| a[1] == cKey } ) ) > 0 ::aKeyEvent[ n ] := bKey Else AAdd( ::aKeyEvent, { cKey, bKey } ) EndIf RETURN Nil METHOD DoKeyEvent( nKey ) CLASS Get LOCAL n, r := 0, cKey := hb_ntos( nKey ) If len( ::aKeyEvent ) > 0 cKey += iif( _GetKeyState( VK_CONTROL ), '#', '' ) cKey += iif( _GetKeyState( VK_SHIFT ), '^', '' ) cKey += iif( _GetKeyState( VK_MENU ), '@', '' ) If ( n := AScan( ::aKeyEvent, {|a| a[1] == cKey } ) ) > 0 If HB_ISBLoCK( ::aKeyEvent[ n ][2] ) EVal( ::aKeyEvent[ n ][2], Self ) r := 1 EndIf EndIf EndIf RETURN r ... SAMPLES\BASIC\GetBox demo.prg ... *----------------------------- Function MAIN() *----------------------------- LOCAL oGet SET CENTURY ON ... DEFINE WINDOW Form_1 ; ... DEFINE GETBOX Text_1 // Alternate Syntax ROW 10 COL 10 HEIGHT 20 VALUE DATE() PICTURE '@K' TOOLTIP "Date Value: Must be greater or equal to "+DTOC(DATE()) VALID {|| Compare(this.value)} VALIDMESSAGE "Must be greater or equal to "+DTOC(DATE()) MESSAGE "Date Value" BACKCOLOR {{255,255,255},{255,255,200},{200,255,255}} FONTCOLOR {{0,0,0},{255,255,200},{0,0,255}} END GETBOX oGet := _HMG_aControlHeadClick [ This.Text_1.Index ] oGet:SetKeyEvent( VK_F5, {|o| MsgBox( 'VK_F5 : ' + cValToChar(o:VarGet()), This.Name ) }) @ 40,10 GETBOX Text_2 ; HEIGHT 20; VALUE 57639 ; ACTION MsgInfo( "Button Action"); TOOLTIP {"Numeric input. RANGE -100,200000 PICTURE @Z 99,999.99","Button ToolTip"}; PICTURE '@Z 99,999.99'; RANGE -100,200000; BOLD; MESSAGE "Numeric input"; VALIDMESSAGE "Value between -100 and 200000 " ; BACKCOLOR {{255,255,255},{255,255,200},{200,255,255}} ; FONTCOLOR {{0,0,0},{255,255,200},{0,0,255}} oGet := _HMG_aControlHeadClick [ This.Text_2.Index ] oGet:SetKeyEvent( , {|o| MsgBox( 'LDblClick : ' + cValToChar(o:VarGet()), This.Name ) }) ... [/pre2]
SergKis: PS пока переносил потерял[pre2] METHOD DoKeyEvent( nKey ) CLASS Get ... If ( n := AScan( ::aKeyEvent, {|a| a[1] == cKey } ) ) > 0 If HB_ISBLoCK( ::aKeyEvent[ n ][2] ) EVal( ::aKeyEvent[ n ][2], Self, nKey, cKey ) r := 1 EndIf EndIf [/pre2]
SergKis: PS нашел у себя старую ошибку (замену не делал, потому и не натыкался) [pre2] METHOD SetKeyEvent( nKey, bKey, lCtrl, lShift, lAlt ) CLASS Get ... If ( n := AScan( ::aKeyEvent, {|a| a[1] == cKey } ) ) > 0 ::aKeyEvent[ n ] := { cKey, bKey } Else AAdd( ::aKeyEvent, { cKey, bKey } ) EndIf[/pre2]
Andrey: SergKis пишет: цитата: Это надо при работе с ячейками и lEdit := .T. gfilatov2002 пишет: Понятно, я уже добавил этот переключатель Т.е. можно делать так при настройке тсб : [pre2]oBrw:lNoKeyChar := .T. // отключить edit от нажатия клавиш цифр\букв [/pre2] В какой версии этот переключатель есть ?
gfilatov2002: Andrey пишет: В какой версии этот переключатель В новой, которая выйдет на следующей неделе
gfilatov2002: SergKis пишет: Предложение по GetBox Благодарю за Ваше предложение - все работает Также интересует добавить выделение текста GetBox при нажатии и удержании клавиши Shift вместе со стрелками влево/вправо
SergKis: gfilatov2002 пишет Также интересует добавить выделение текста GetBox при нажатии и удержании клавиши Shift вместе со стрелками влево/вправо Еще интересует LDblClick на GetBox в состоянии ReadOnly, но я пока плохо знаю систему get в hb3.2, надо изучать (в hb2.0 иначе) все работает Надо иметь ввиду, что в блоке кода (в предложении) НЕ создается среда _HMG_This... контрола, т.к. в классе GET нет переменной Index, связывать с _DoControlEventProcedure ( bBlock, i, ... ) я не стал, т.к. сам использую блоки кода для сообщений.
Andrey: Перешёл на версию 17.06 (Update 2) Выдаёт теперь ошибку: Error: Unresolved external '_HB_FUN__SETGETUSERDATA' referenced from W:\HB_PROJECT\4PRJ\ Error: Unresolved external '_HB_FUN__SETCONTROLACTION' referenced from W:\HB_PROJECT\4PRJ\ Как исправить ?
gfilatov2002: Andrey пишет: Как исправить ? _SetGetUserData (cObject, cForm, cObject) // Cargo эквивалентно SetProperty (cForm, cObject, 'Cargo', cObject)
Andrey: А эту функцию - _SETCONTROLACTION как исправить ? _SetControlAction(cObj, cForm, bBlock , 'ONLOSTFOCUS' ) И вот это как исправить _SetGetUserData(cObjDop, cForm, .F. ) ? Правильно или нет - SetProperty (cForm, cObjDop, 'Cargo', .F.) ?
SergKis: gfilatov2002 Добавка к классам [pre2] /////////////////////////////////////////////////////////////////////////////// CLASS TGetData INHERIT TCnlData /////////////////////////////////////////////////////////////////////////////// PROTECTED: VAR oGetBox AS OBJECT EXPORTED: METHOD New( oWnd, oGet ) INLINE ( ::Super:New( oWnd ), ::oGetBox := oGet, Self ) CONSTRUCTOR METHOD Def( nIndex, cName, nHandle, nParent, cType, cVar ) INLINE ( ; ::Super:Def( nIndex, cName, nHandle, nParent, cType, cVar ), ; ::Set(), hmg_SetWindowObject( ::nHandle, Self ), ; Self ) ACCESS Caption INLINE ::oWin:cName + "." + ::cName ACCESS Get INLINE ::oGetBox METHOD Destroy() INLINE ::oGetBox := ::Super:Destroy() ENDCLASS FUNCTION oCnlData( nIndex, cName, nHandle, nParent, cType, cVar, oWin ) ... IF cType == 'TBROWSE' ob := _HMG_aControlIds[ nIndex ] o := TTsbData():New( oWin, ob ):Def( nIndex, cName, nHandle, nParent, cType, cVar ) ELSEIF cType == 'GETBOX' ob := _HMG_aControlHeadClick[ nIndex ] o := TGetData():New( oWin, ob ):Def( nIndex, cName, nHandle, nParent, cType, cVar ) ELSEIF cType == 'MESSAGEBAR' o := TStbData():New( oWin ):Def( nIndex, cName, nHandle, nParent, cType, cVar ) ELSE o := TCnlData():New( oWin ):Def( nIndex, cName, nHandle, nParent, cType, cVar ) ENDIF ... [/pre2] Использование oGet := (This.Get_1.Object):Get (This.Get_1.Object):Get:SetKeyEvent(VK_F5, {|og| ... }) (This.Get_1.Object):Get:SetKeyEvent('LDblClick', {|og| ... }) в ACTION (This.Object):Get:VarGet() (This.Object):Get:VarPut(...) ...
полная версия страницы