Форум » GUI » Новая версия Расширенного релиза библиотеки MiniGUI (часть VI ) (продолжение) » Ответить
Новая версия Расширенного релиза библиотеки MiniGUI (часть VI ) (продолжение)
gfilatov: Начало темы находится здесь, а теперь АНОНС * АНОНС * АНОНС * АНОНС * АНОНС Готовится к опубликованию новая сборка №48, которая выйдет в конце недели. Если у Вас есть интересные наработки для включения в новый релиз, то сейчас самое удобное время для их отправки мне Кратко, что нового: - исправление обнаруженных ошибок и неточностей кода; - новый класс HEADERIMAGE для Grid и Browse; - свойство Address в Hyperlink может теперь открывать папку или файл на диске; - добавлен NOTABSTOP класс для Browse; - поддержка пользовательских компонентов (заимствована из оффициального релиза); - расширения и исправления в библиотеках TsBrowse и PropGrid; - обновлены сборки Харбор и HMGS-IDE; - новые и обновленные старые примеры (как обычно ).
gfilatov2002: SergKis пишет: Ситуация возникает Благодарю за рахъяснение Принято
SergKis: gfilatov2002 пишет Принято, кроме установки данных в upper Вы правы , совсем из головы выпало, что данные контролов сохраняются в Public переменной, т.е. :oNameUpper не нужен, достаточно в некоторых мечтах сделать upper(xName)
gfilatov2002: Выпущена новая сборка 18.05 для BCC 5.51 для компиляторов Harbour и xHarbour Базовый дистрибутив-инсталлятор находится по адресу http://hmgextended.com/files/CONTRIB/hmg-18.05-setup.exe Рекомендуется к использованию Благодарю за Ваше внимание и поддержку P.S. Также у нас появилось зеркало домашней страницы по адресу http://hmgextended.org Также имеются в наличии готовые сборки для следующих пар (Си-компилятор+Харбор): - 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.
SergKis: gfilatov2002 Поправьте[pre2] CLASS TWndData ... METHOD GetObj( xName ) INLINE iif( HB_ISCHAR( xName ), ::oName:Get( upper(xName) ), ; ::oHand:Get( xName ) ) ... METHOD GetObj4Name( cName ) CLASS TWndData ... FOR EACH cName IN hb_ATokens( upper(cName), ::cChr ) ... METHOD ControlAssign( xValue ) CLASS TWndData LOCAL cMessage, uRet, lError, o cMessage := __GetMessage() lError := .T. If PCOUNT() == 0 o := ::GetObj( cMessage ) If HB_ISOBJECT( o ) uRet := _GetValue( , , o:nIndex ) lError := .F. EndIf ElseIf PCOUNT() == 1 o := ::GetObj( SubStr( cMessage, 2 ) ) If HB_ISOBJECT( o ) _SetValue( , , xValue, o:nIndex ) uRet := _GetValue( , , o:nIndex ) lError := .F. EndIf EndIf ... CLASS TCnlData INHERIT TWndData ... METHOD Set() INLINE ( iif( HB_ISOBJECT( ::oWin:oName ), ::oWin:oName:Set( upper(::cName) , Self ), ), ; iif( HB_ISOBJECT( ::oWin:oHand ), ::oWin:oHand:Set( ::nHandle, Self ), ) ) METHOD Del() INLINE ( iif( HB_ISOBJECT( ::oWin:oName ), ::oWin:oName:Del( upper(::cName) ), ), ; iif( HB_ISOBJECT( ::oWin:oHand ), ::oWin:oHand:Del( ::nHandle ), ) ) METHOD Get( xName ) INLINE iif( HB_ISCHAR( xName ), ::oWin:oName:Get( upper(xName) ), ; ::oWin:oHand:Get( xName ) ) ... [/pre2] Тогда пример http://my-files.ru/e8rrl4 для проверки, собран на hmg 18.05
gfilatov2002: SergKis пишет: Поправьте Поправил код и выложил исправленный инсталлятор на сервер. SergKis пишет: для проверки, собран на hmg 18.05 Ваш пример работает... Благодарю за помощь
Alex_Cher: gfilatov2002 пишет: Выпущена новая сборка 18.05 для BCC 5.51 для компиляторов Harbour и xHarbour Уважаемый Григорий, замечания - функция определения наличие в системе ( установлена Win 7) MS Office не находит программу, хотя MS Office установлен ... На сборке 18.04 проблем не было. Ole2TxtError() != 'S_OK'
gfilatov2002: Alex_Cher пишет: замечания - функция определения наличие в системе ( установлена Win 7) MS Office Ожидал подобное замечание, поскольку произошел отказ от устаревшей библиотеки HbOLE Alex_Cher пишет: Ole2TxtError() != 'S_OK' Используйте теперь взамен такую конструкцию: [pre2] IF ( oExcel := CreateObject( "Excel.Application" ) ) == NIL MsgStop('Excel не установлен','Ошибка') RETURN Nil ENDIF[/pre2] Именно по этой причине так долго не мог отказаться от использования библиотеки HbOLE
Alex_Cher: gfilatov2002 пишет: Используйте теперь взамен такую конструкцию Уважаемый Григорий, снова проблемы с 18.05. При создание файла Excel вылетают ошибки на следующих функциях - oWorkBook:Columns( 1):Set( 'NumberFormat', '@' ) Error WINOLE/1007 Неверный аргумент: SET (DOS Error -2147352562) Called from TOLEAUTO:SET(0) Called from OBRABOTKA_ZCH(1052) in module: zatrat.prg oWorkBook:Cells( 3, 5):Set( "HorizontalAlignment", 7) Error WINOLE/1007 Неверный аргумент: SET (DOS Error -2147352562) Called from TOLEAUTO:SET(0) Called from XLS_OT_3(944) in module: zatrat.prg
gfilatov2002: Alex_Cher пишет: При создание файла Excel вылетают ошибки на следующих функциях Это устаревшие конструкции, которые использовались в HbOle. Pasha пишет: аналогично вызов (в 2-х местах) oSheet:Range( cRange ):Set( "HorizontalAlignment", xlHAlignCenterAcrossSelection ) заменить на oSheet:Range( cRange ):HorizontalAlignment := xlHAlignCenterAcrossSelection Рекомендую посмотреть исправленные примеры связи с Excel из поставки 18.05 Но, как я писал ранее, никто ведь не смотрит примеры и даже не читает список изменений
SergKis: gfilatov2002 Предложение по TsColumns[pre2] i_tsbrowse.ch #command DEFINE COLUMN <oCol> ; ... => ; <oCol> := TSColumn():New( ; [ If(<.oem.>, OemToAnsi(<cHead>), <cHead>) ], ; [ If( ValType(<uData>) $ "BC", <uData>, <{uData}> ) ], ; [ <cPicture> ], [ \{<aColors>\} ], [ \{<aAlign>\} ], ; ... CLASS TSColumn ... DATA cName INIT "" // An optional column name DATA cField INIT "" // FieldName column ... METHOD New( cHeading, bData, cPicture, aColors, aAlign, nWidth, ; lBitMap, lEdit, bValid, lNoLite, cOrder, cFooting, ; bPrevEdit, bPostEdit, nEditMove, lFixLite, a3DLook, ; bWhen, oBrw, cData, cWhen, cValid, cPrevEdit, cPostEdit, cMsg, cToolTip, lTotal, ; lSpinner, bUp, bDown, bMin, bMax, cError, cSpcHeading,; cDefData, cName ) CLASS TSColumn Local nEle, uAlign, xVar, aList, aClr, ; ... If HB_ISCHAR(bData) ::cField := bData bData := Nil EndIf If aColors != Nil If HB_ISARRAY( aColors ) .and. Len( aColors ) > 0 .and. HB_ISARRAY( aColors[1] ) FOR EACH aClr IN aColors If HB_ISNUMERIC( aClr[1] ) .and. aClr[1] > 0 .and. aClr[1] <= Len( aTmpColor ) aTmpColor[ aClr[1] ] := aClr[2] EndIf NEXT Else ASize( aColors, 20 ) Aeval( aColors, { |bColor,n| aTmpColor[ n ] := bColor } ) EndIf Endif ... [/pre2] 1. :cField - для создания колонок с неизвестным Alias, когда станет известен, получим :bData 2. Цвета задавать не все 20 штук, а по номерам\define[pre2] // aColors items number #define CLR_TEXT 1 // text #define CLR_PANE 2 // back #define CLR_HEADF 3 // header text #define CLR_HEADB 4 // header back #define CLR_FOCUSF 5 // focused text #define CLR_FOCUSB 6 // focused back ...[/pre2]
SergKis: PS В догонку[pre2] CLASS TSColumn ... METHOD SaveProperty( aExcept ) INLINE __objGetValueList( Self, aExcept ) METHOD RestProperty( aProp ) INLINE __objSetValueList( Self, aProp ) ENDCLASS ... Использовать a := oBrw:aColumns[1]:SaveProperty() _logfile(.T., o, o:ClassName, a) AEval(a, {|av,nv| _logfile(.T., nv, av[1], valtype(av[2]), av[2]) }) ... oBrw:aColumns[1]:RestProperty(a) ... Использовав, aExcept (массив исключаемых свойств\переменных) можно, к примеру, сохранять\восстанавливать колонки в файлах [/pre2]
gfilatov2002: SergKis пишет: Предложение по TsColumns Все изменения приняты с благодарностью
SergKis: Пояснение использования[pre2] DEFINE COLUMN oC1 DATA 'R_1' NAME 'KOD' DEFINE COLUMN oC2 DATA 'R_2' NAME 'NAM' DEFINE COLUMN oC3 DATA FieldBlock( "Field1" ) NAME 'KEY' FOR EACH o IN {oC1, oC2, oC3} a := o:SaveProperty() _logfile(.T., o, o:ClassName, a, '------------') AEval(a, {|av,nv| _logfile(.T., nv, av[1], valtype(av[2]), av[2]) }) NEXT [/pre2]
SergKis: gfilatov2002 В продолжении по TsColumn. В колонке есть :cAlias, используемый в методах LoadRelated и PostEdit. LoadRelated вызываем руками специально (заполняет на колонку :cAlias) PostEdit при :lEdit == .T. может записать по :cAlias колонки. Других мест не увидел. Предложение исп. :cAlias колонки для получения uData из другой области, отличной от oBrw:cAlias. [pre2] METHOD DrawLine( xRow ) CLASS TSBrowse ... Local aBitMaps, lCheckVal := .F., cColAls ... hFont := If( hFont == Nil, 0, hFont ) cColAls := oColumn:cAlias ... If ::lIsArr .and. ( ::lAppendMode .or. ::nAt > Len( ::aArray ) ) uData := "" // append mode for arrays ElseIf cColAls != Nil uData := ( cColAls )->( Eval( oColumn:bData ) ) Else uData := Eval( oColumn:bData ) EndIf ... METHOD DrawSelect( xRow ) CLASS TSBrowse ... Local aBitMaps, lCheckVal := .F., cColAls ... lMulti := .F. cColAls := oColumn:cAlias If nJ == 1 .and. ! Empty( ::hBmpCursor ) ... Else If ::lIsArr .and. ( ::lAppendMode .or. ::nAt > Len( ::aArray ) ) uData := "" // append mode for arrays ElseIf cColAls != Nil uData := ( cColAls )->( Eval( oColumn:bData ) ) Else uData := Eval( oColumn:bData ) EndIf ... Правки не сломают PostEdit и позволят делать так DEFINE COLUMN oC3 DATA FieldBlock( "Field1" ) NAME 'KEY' или ADD COLUMN ... oC3:cAlias := 'KLIENT' Для удобства можно сделать CLASS TSColumn ... METHOD New( cHeading, bData, cPicture, aColors, aAlign, nWidth, ; ... lSpinner, bUp, bDown, bMin, bMax, cError, cSpcHeading,; cDefData, cName, cAlias ) CLASS TSColumn ... lCheck := .F. ::cAlias := cAlias If HB_ISCHAR(bData) ... i_tsbrowse.ch #command DEFINE COLUMN <oCol> ; ... [ NAME <name> ] ; [ ALIAS <alias> ] ; => ; <oCol> := TSColumn():New( ; ... [<cMsg>], [ <cToolTip> ], [ <.total.> ],,,,,,,,, [ <"name"> ], [ <"alias"> ] ) ... и в других #command ADD [ COLUMN ] ... тоже [/pre2]
SergKis: PS Что бы избежать влияния LoadRelated, добавим в него[pre2] METHOD LoadRelated( cAlias, lEditable, aNames, aHeaders ) CLASS TSBrowse ... ATail( ::aColumns ):cAlias := cAlias ATail( ::aColumns ):cData := cAlias + "->" + FieldName( nE ) ATail( ::aColumns ):cField := cAlias + "->" + FieldName( nE ) Next ... Поправим cColAls в методах DrawLine и DrawSelect на cColAls := If( '->' $ oColumn:cField, Nil, oColumn:cAlias ) ... [/pre2]
SergKis: PS Возможно лучше тогда в методе LoadRelated заменить использование FieldWBlock на FieldBlock[pre2] cBlock := 'FieldWBlock( "' + ( cAlias )->( Field( nE ) ) + '", Select( "' + ; cAlias + '" ) )' ::AddColumn( TSColumn():New( cHeading, FieldWBlock( ( cAlias )->( Field( nE ) ), nArea ),, ; [/pre2]
Andrey: Новая версия 18.05, METHOD ExcelOle() Нашёл такой код: [pre2] Try oExcel := CreateObject( "Excel.Application" ) Catch MsgStop( "Excel is not available. [" + Ole2TxtError() + "]", "Error" ) Return Nil End Try[/pre2] А он точно правильный ? Может надо win_oleErrorText() поставить ?
gfilatov2002: Andrey пишет: он точно правильный ? Правильный Функция Ole2TxtError() берется эдесь из библиотеки xHb
SergKis: gfilatov2002 Ошибка закралась CLASS TSBROWSE[pre2] METHOD GetValue( xCol ) INLINE ( xCol := hb_defaultValue(xCol, ::nCell), ; EVal( ::GetColumn(xCol):bData ) ) METHOD SetValue( xCol, xVal ) INLINE ( xCol := hb_defaultValue(xCol, ::nCell), ; EVal( ::SGetColumn(xCol):bData, xVal ) ) у себя сделал (больше нравится) // METHOD GetValue( xCol ) INLINE ( xCol := hb_defaultValue(xCol, ::nCell), ; // EVal( ::GetColumn(xCol):bData ) ) // METHOD SetValue( xCol, xVal ) INLINE ( xCol := hb_defaultValue(xCol, ::nCell), ; // EVal( ::GetColumn(xCol):bData, xVal ) ) METHOD Value( xCol, xVal ) METHOD SetValue( xCol, xVal ) INLINE ::Value( xCol, xVal ) METHOD GetValue( xCol ) INLINE ::Value( xCol ) ... METHOD Value( xCol, xVal ) CLASS TSBrowse LOCAL xRet, oCol, cAls xCol := hb_defaultValue(xCol, ::nCell) oCol := ::GetColumn(xCol) cAls := oCol:cAlias // !!! If empty(cAls) .or. '->' $ oCol:cField // !!! If PCOUNT() > 1 EVal( oCol:bData, xVal ) Else xRet := EVal( oCol:bData ) EndIf Else If PCOUNT() > 1 (cAls)->( EVal( oCol:bData, xVal ) ) Else xRet := (cAls)->( EVal( oCol:bData ) ) EndIf EndIf RETURN xRet ... // !!! - это добавка по предложениям выше ... *-----------------------------------------------------------------------------* FUNCTION _SetValue ( ControlName, ParentForm, Value, index ) *-----------------------------------------------------------------------------* ... CASE T == "TBROWSE" oGet := _HMG_aControlIds [ix] IF oGet:lInitGoTop IF ISNUMBER( Value ) .AND. Value > 0 oGet:GoPos( Value ) Eval( oGet:bGoToPos, Value ) oGet:Refresh( .T. ) ENDIF ELSE // Eval( oGet:GetColumn( oGet:nCell ):bData, Value ) oGet:SetValue( oGet:nCell, Value ) ENDIF ... *-----------------------------------------------------------------------------* FUNCTION _GetValue ( ControlName, ParentForm, Index ) *-----------------------------------------------------------------------------* ... CASE T == "TBROWSE" oGet := _HMG_aControlIds [ix] retval := oGet:GetValue( oGet:nCell ) // retval := Eval( oGet:GetColumn( oGet:nCell ):bData ) [/pre2]
SergKis: gfilatov2002 пишет Все изменения приняты Поправьте метод [pre2] 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 ) ) If cType == "L" ... [/pre2]
полная версия страницы