Отправлено: 29.01.08 13:59. Заголовок: Новая версия Расширенного релиза библиотеки MiniGUI (часть VI ) (продолжение)

Начало темы находится здесь, а теперь

АНОНС * АНОНС * АНОНС * АНОНС * АНОНС

Готовится к опубликованию новая сборка №48, которая выйдет в конце недели.
Если у Вас есть интересные наработки для включения в новый релиз, то сейчас самое удобное время для их отправки мне

Кратко, что нового:

- исправление обнаруженных ошибок и неточностей кода;
- новый класс HEADERIMAGE для Grid и Browse;
- свойство Address в Hyperlink может теперь открывать папку или файл на диске;
- добавлен NOTABSTOP класс для Browse;
- поддержка пользовательских компонентов (заимствована из оффициального релиза);
- расширения и исправления в библиотеках TsBrowse и PropGrid;
- обновлены сборки Харбор и HMGS-IDE;
- новые и обновленные старые примеры (как обычно ).

 Отправлено: 04.06.18 11:04. Заголовок: SergKis пишет: Ситу..

SergKis пишет:

цитата:

Ситуация возникает

Благодарю за рахъяснение
Принято

 Отправлено: 04.06.18 12:24. Заголовок: gfilatov2002 пишет П..

gfilatov2002 пишет

цитата:

Принято, кроме установки данных в upper

Вы правы , совсем из головы выпало, что данные контролов сохраняются в Public переменной, т.е. :oNameUpper не нужен, достаточно в некоторых мечтах сделать upper(xName)

 Отправлено: 06.06.18 10:07. Заголовок: Выпущена новая сборк..

Выпущена новая сборка 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.

 Отправлено: 06.06.18 12:04. Заголовок: gfilatov2002 Поправ..

gfilatov2002
Поправьте

 
 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 ) ) 
 ... 
 

Тогда пример http://my-files.ru/e8rrl4
для проверки, собран на hmg 18.05

 Отправлено: 06.06.18 14:10. Заголовок: SergKis пишет: Попр..

SergKis пишет:

цитата:

Поправьте

Поправил код и выложил исправленный инсталлятор на сервер.

SergKis пишет:

цитата:

для проверки, собран на hmg 18.05

Ваш пример работает...
Благодарю за помощь

 Отправлено: 07.06.18 10:01. Заголовок: gfilatov2002 пишет: ..

gfilatov2002 пишет:

цитата:

Выпущена новая сборка 18.05 для BCC 5.51 для компиляторов Harbour и xHarbour

Уважаемый Григорий, замечания - функция определения наличие в системе ( установлена Win 7) MS Office
не находит программу, хотя MS Office установлен ... На сборке 18.04 проблем не было.

Ole2TxtError() != 'S_OK'

 Отправлено: 07.06.18 10:38. Заголовок: Alex_Cher пишет: за..

Alex_Cher пишет:

цитата:

замечания - функция определения наличие в системе ( установлена Win 7) MS Office

Ожидал подобное замечание, поскольку произошел отказ от устаревшей библиотеки HbOLE

Alex_Cher пишет:

цитата:

Ole2TxtError() != 'S_OK'

Используйте теперь взамен такую конструкцию:

цитата:

IF ( oExcel := CreateObject( "Excel.Application" ) ) == NIL MsgStop('Excel не установлен','Ошибка') RETURN Nil ENDIF

Именно по этой причине так долго не мог отказаться от использования библиотеки HbOLE

 Отправлено: 07.06.18 13:47. Заголовок: gfilatov2002 пишет: ..

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

 Отправлено: 07.06.18 13:55. Заголовок: Alex_Cher пишет: Пр..

Alex_Cher пишет:

цитата:

При создание файла Excel вылетают ошибки на следующих функциях

Это устаревшие конструкции, которые использовались в HbOle.

Pasha пишет:

цитата:

аналогично вызов (в 2-х местах) oSheet:Range( cRange ):Set( "HorizontalAlignment", xlHAlignCenterAcrossSelection ) заменить на oSheet:Range( cRange ):HorizontalAlignment := xlHAlignCenterAcrossSelection

Рекомендую посмотреть исправленные примеры связи с Excel из поставки 18.05
Но, как я писал ранее, никто ведь не смотрит примеры и даже не читает список изменений

 Отправлено: 07.06.18 22:50. Заголовок: gfilatov2002 Предло..

gfilatov2002
Предложение по TsColumns

 
 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 
 ... 
 

1.
:cField - для создания колонок с неизвестным Alias, когда станет известен, получим :bData
2.
Цвета задавать не все 20 штук, а по номерам\define

 
 // 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 
 ...

 Отправлено: 08.06.18 11:44. Заголовок: PS В догонку CLASS T..

PS
В догонку

 
 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 (массив исключаемых свойств\переменных) можно, к примеру, сохранять\восстанавливать колонки в файлах 
 

 Отправлено: 08.06.18 12:08. Заголовок: SergKis пишет: Пред..

SergKis пишет:

цитата:

Предложение по TsColumns

Все изменения приняты с благодарностью

 Отправлено: 08.06.18 12:15. Заголовок: Пояснение использова..

Пояснение использования

 
    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 
 

 Отправлено: 08.06.18 13:52. Заголовок: gfilatov2002 В прод..

gfilatov2002
В продолжении по TsColumn.
В колонке есть :cAlias, используемый в методах LoadRelated и PostEdit.
LoadRelated вызываем руками специально (заполняет на колонку :cAlias)
PostEdit при :lEdit == .T. может записать по :cAlias колонки.
Других мест не увидел. Предложение исп. :cAlias колонки для получения uData из другой области, отличной от oBrw:cAlias.

 
 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 ] ... тоже 
 

 Отправлено: 08.06.18 14:10. Заголовок: PS Что бы избежать в..

PS
Что бы избежать влияния LoadRelated, добавим в него

 
 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 ) 
 ... 
 

 Отправлено: 08.06.18 14:18. Заголовок: PS Возможно лучше то..

PS
Возможно лучше тогда в методе LoadRelated заменить использование FieldWBlock на FieldBlock

 
       cBlock := 'FieldWBlock( "' + ( cAlias )->( Field( nE ) ) + '", Select( "' + ; 
                 cAlias + '" ) )' 
       ::AddColumn( TSColumn():New( cHeading, FieldWBlock( ( cAlias )->( Field( nE ) ), nArea ),, ; 
 

 Отправлено: 08.06.18 14:23. Заголовок: Новая версия 18.05, ..

Новая версия 18.05, METHOD ExcelOle()

Нашёл такой код:

   Try 
       oExcel := CreateObject( "Excel.Application" ) 
    Catch 
       MsgStop( "Excel is not available. [" + Ole2TxtError() + "]", "Error" ) 
       Return Nil 
    End Try

А он точно правильный ? Может надо win_oleErrorText() поставить ?

 Отправлено: 08.06.18 14:35. Заголовок: Andrey пишет: он то..

Andrey пишет:

цитата:

он точно правильный ?

Правильный
Функция Ole2TxtError() берется эдесь из библиотеки xHb

 Отправлено: 08.06.18 16:43. Заголовок: gfilatov2002 Ошибка..

gfilatov2002
Ошибка закралась CLASS TSBROWSE

 
    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 ) 
  
 

 Отправлено: 08.06.18 20:00. Заголовок: gfilatov2002 пишет В..

gfilatov2002 пишет

цитата:

Все изменения приняты

Поправьте метод

 
 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" 
 ...