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

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

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

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 Григорий, можно добавить в TSColumn парамметер cName в Method New(..., cName) Default cName := "" и в соответствующие #command для колонок задание cName

gfilatov2002: SergKis пишет: можно добавить в TSColumn парамметер cName Ваша идея понятна Присылайте готовую реализацию для проверки и включения в следующую сборку

SergKis: gfilatov2002 пишет:Присылайте готовую реализацию [pre2] TSColumn.prg ~~~~~~~~~~~~ ... 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 ... Default cHeading := "" , ; bData := {|| Nil } , ; cData := "{|| Nil }" , ; ... lTotal := .F. , ; //V90 cName := "" ::cName := cName If ValType( cHeading ) == "O" ::uBmpHead := cHeading ... i_tsbrowse.ch ~~~~~~~~~~~~~ ... #command DEFINE COLUMN <oCol> ; [ <dat: DATA, SHOWBLOCK> <uData> ] ; ... [ <total: TOTAL, TOTALIZE> ] ; [ NAME <name> ] ; => ; <oCol> := TSColumn():New( ; ... [<cMsg>], [ <cToolTip> ], [ <.total.> ], [ <"name"> ]) ... #command ADD [ COLUMN ] TO [ TBROWSE ] <oBrw> ; [ <dat: DATA, SHOWBLOCK> <uData> ] ; ... [ <total: TOTAL, TOTALIZE> ] ; [ NAME <name> ] ; => ; <oBrw>:AddColumn( TSColumn():New( ; ... [<(bPostBlock)>], [<cMsg>], [ <cToolTip> ], [ <.total.> ], [ <"name"> ] ) ) ... #command ADD [ COLUMN ] TO [ TBROWSE ] <oBrw> [ DATA ] ARRAY ; [ <el: ELM, ELEMENT> <elm> ] ; ... [ <total: TOTAL, TOTALIZE> ] ; [ NAME <name> ] ; => ; <oBrw>:AddColumn( TSColumn():New( ; ... [<cMsg>], [ <cToolTip> ], [ <.total.> ], [ <"name"> ]) ) ... #command ADD [ COLUMN ] TO [ TBROWSE ] <oBrw> [ DATA ] ; <fi: oDBF, FIELD> [FIELD] <field> ; ... [ <total: TOTAL, TOTALIZE> ] ; [ NAME <name> ] ; => ; <oBrw>:AddColumn( TSColumn():New( ; ... [ <(bPrevBlock)> ], [<(bPostBlock)>], [<cMsg>], [ <cToolTip> ], [ <.total.> ], [ <"name"> ])) ... [/pre2]

gfilatov2002: SergKis Благодарю за помощь Принято с поправкой, что между [ <.total.> ] и [ <"name"> ] расположены еще 8 переменных

SergKis: gfilatov2002 пишет: между [ <.total.> ] и [ <"name"> ] расположены еще 8 переменных пока выделял <"name"> bold-ом забыл про запятые. Еще ошибочка при SpecHd, если нет Footer все хорошо, с Footer криво [pre2] METHOD DrawHeaders( lFooters ) CLASS TSBrowse ... IF ::lDrawSpecHd ... TSDrawCell( hWnd, ; // 1 hDC, ; // 2 0, ; // 3 nStartCol, ; // 4 aColSizes[nJ], ; // 5 cHeading, ; // 6 nAlign, ; // 7 nClrFore, ; // 8 nClrBackS, ; // 9 hFont, ; // 10 hBitMap, ; // 11 nHeightFoot, ; // 12 надо 0 вместо nHeightFoot l3DLook, ; // 13 1, ; // 14 nLineStyle nClrLine, ; // 15 4, ; // 16 1=Header 2=Footer 3=Super 4=Special nHeightHead, ; // 17 nHeightFoot, ; // 18 nHeightSuper, ; // 19 nHeightSpecHd, ; // 20 lAdjBmp, ; // 21 .f., ; // 22 nVAlign, ; // 23 0, ; // 24 nVertText nClrToS, ; // 25 lOpaque, ; // 26 If( lBrush, ; nClrBackS:hBrush, 0 ), ; // 27 l3DText, ; // 28 3D text nClr3dL, ; // 29 3D text light color nClr3dS ) // 30 3D text shadow color [/pre2] элемент // 12 надо 0 вместо nHeightFoot, тогда с прорисовкой SpecHd все Ok с Footer и без

gfilatov2002: SergKis пишет: элемент // 12 надо 0 вместо nHeightFoot Благодарю, уже поправил для новой сборки

SergKis: gfilatov2002 А можно еще немного изменений ? [pre2] TSColumn.prg ~~~~~~~~~~~~ ... CLASS TSColumn ... DATA lOnGotFocusSelect AS LOGICAL INIT .F. // .T. - SendMessage( GetBoxHandle, EM_SETSEL, 0, -1 ) ... ENDCLASS h_tbrowse.prg ~~~~~~~~~~~~~ ... #define EM_SETSEL 177 ... Function LoadFields( ControlName, ParentForm, lEdit, aFieldNames) Local ix, oBrw Default lEdit := .f. ix := GetControlIndex (ControlName,ParentForm) oBrw := _HMG_aControlIds [ix] if ISARRAY(aFieldNames) oBrw:aColSel := aFieldNames endif oBrw:LoadFields(lEdit) Return oBrw // было Nil Function SetArray( ControlName, ParentForm, Arr, lAutoCols, aHead, aSizes ) Local ix, oBrw ix := GetControlIndex (ControlName,ParentForm) oBrw:= _HMG_aControlIds [ix] oBrw:SetArray(Arr, lAutoCols, aHead, aSizes) Return oBrw // было Nil ... METHOD Edit( uVar, nCell, nKey, nKeyFlags, cPicture, bValid, nClrFore, ; ... DO CASE CASE "TBTNBOX" $ Upper( oCol:oEdit:ClassName() ) oCol:oEdit:bLostFocus := Nil CASE "TGETBOX" $ Upper( oCol:oEdit:ClassName() ) ix := GetControlIndex ( ::cChildControl, ::cParentWnd ) _HMG_InteractiveCloseStarted := .T. if ix > 0 If oCol:lOnGotFocusSelect If ValType(uValue) == "C" _HMG_aControlGotFocusProcedure [ix] := {|| SendMessage( _HMG_aControlHandles [ix], EM_SETSEL, 0, If(empty(uValue), -1, Len(Trim(uValue))) ) } ElseIf ValType(uValue) $ "ND" _HMG_aControlGotFocusProcedure [ix] := {|| SendMessage( _HMG_aControlHandles [ix], EM_SETSEL, 0, -1 ) } EndIf EndIf _HMG_aControlLostFocusProcedure [ix] := { | nKey | ::EditExit( nCell, nKey, uValue, bValid, .F. ) } endif if Empty( ::bLostFocus ) ::bLostFocus := { || iif( _HMG_InteractiveCloseStarted, _HMG_InteractiveCloseStarted := .F., ) } endif ENDCASE ... [/pre2] выделенным изменения

gfilatov2002: SergKis пишет: еще немного изменений Добавлено с благодарностью

gfilatov2002: Просто к сведению. Выпустил сегодня предварительный релиз для следующей сборки 2.5.1. Финальный релиз запланирован на следующей неделе [pre2] * Enhanced: Added a third parameter nFlags (defined in the header file i_misc.ch) and fourth parameter lNewFolderButton to the function GetFolder() and the 3rd and 4th parameters cTitle, cInitPath to the function BrowseForFolder(). These parameters are an optional. If an initial path or BIF flag were not specified then a new UI with an editbox and validation will be used by default in the above functions. Syntax: GetFolder( [ Title ], [ InitPath ], [ BIF Flag ], ; [ New Folder Button ] ) -> Folder Name BrowseForFolder( [Folder Type], [ BIF Flag ], [ Title ], ; [ InitPath ] ) -> Folder Name Contributed by Grigory Filatov <gfilatov@inbox.ru> (see demo in folder \samples\Basic\GetFolder) * Enhanced: Tuning of a back color of the Slider, transparent CheckBox and RadioGroup controls at an owner-draw colored TAB. If the back color of above controls was not specified then it will be defined automatically as Tab's back color. Contributed by Grigory Filatov <gfilatov@inbox.ru> * Changed: Removed a silent assigning of 'Transparent' property to the Label and CheckBox controls when a such control was placed into a Tab control (introduced in the build 18). Contributed by Grigory Filatov <gfilatov@inbox.ru> * Updated: DO REPORT command: cleanup of using of the private variables. Contributed by Grigory Filatov <gfilatov@inbox.ru> (see demo in folder \samples\Basic\DO_REPORT) * Updated: The header file i_winuser.ch used to resolve WinAPI constants. Contributed by Grigory Filatov <gfilatov@inbox.ru> (see i_winuser.ch in folder \include) * Updated: Adaptation FiveWin Class TSBrowse 9.0 in HMG: - New: added handling of the var cName in TSColumn class; - New: added handling of a new Column var lOnGotFocusSelect; - Updated: minor correction in the function cValToChar(). Contributed by SergKis. * Updated: HbSQLite3 library: - update for using SQLITE3 version 3.8.11.1 (from 3.8.11). Contributed by Grigory Filatov <gfilatov@inbox.ru> * Updated: Harbour Compiler 3.2.0dev (SVN 2015-08-01 13:14): - added a new code for the function ASort(). Contributed by Przemyslaw Czerpak. Contributed by Grigory Filatov <gfilatov@inbox.ru> (look at ReadMe.txt in folder \harbour) * Updated: 'WAIT WINDOW with an expectation in a thread' sample. Contributed by Verchenko Andrey <verchenkoag@gmail.com>. (see demo2.prg in folder \samples\Basic\WAIT_WINDOW_2) * Updated: 'Paths' sample (demo functions for show system paths). Contributed by Grigory Filatov <gfilatov@inbox.ru> (see in folder \samples\Basic\Paths) * Updated: 'Process Information' sample is based on the ProcInfo library: - added a hung detection for the applications (based upon the undocumented WinAPI function IsHungAppWindow()); - added a test hunging application. Contributed by Grigory Filatov <gfilatov@inbox.ru> (see in folder \samples\Advanced\ProcInfo) [/pre2]

SergKis: gfilatov2002 Еще предложение для TSBrowse Method SetArray2(...) [pre2] h_tbrowse.prg ~~~~~~~~~~~~~ ... Function SetArray2( ControlName, ParentForm, Arr, uFontHF, aHead, aSizes, uFooter, aPicture, aAlign, aName ) Local ix, oBrw ix := GetControlIndex (ControlName,ParentForm) oBrw:= _HMG_aControlIds [ix] oBrw:SetArray2(Arr, uFontHF, aHead, aSizes, uFooter, aPicture, aAlign, aName) Return oBrw ... CLASS TSBrowse FROM TControl ... METHOD SetArray( aArray, lAutoCols, aHead, aSizes ) //V90 METHOD SetArray2( aArray, uFontHF , aHead, aSize, uFooter, aPicture, aAlign, cName ) ENDCLASS ... METHOD SetArray2( aArray, uFontHF, aHead, aSizes, uFooter, aPicture, aAlign, aName ) CLASS TSBrowse Local nColumns, nI, cType, nMax, bData, cHead Local nN, cData, aDefMaxVal, aDefMaxLen, aDefType, aDefAlign, aDefFooter, oCol, ; nAlign, aAligns, lFooter := .F., cFooter, nFooter, cTemp, cPict, ; hFont := If( ::hFont != Nil, ::hFont, 0 ), aFont, lSelected, ; lFont := hFont != 0, hFontHead := hFont, hFontFoot := hFont If empty(aArray) .or. ValType(aArray) != "A" nN := 1000 aArray := Array(nN) For nI := 1 To nN aArray[ nI ] := { nI, PadR("Line - "+StrZero(nI, 5), 20), ; Date()+(nI-1), ; Round(nN / nI, 3), ; nI % 2 == 0 } Next EndIf Default aHead := AClone(::aHeaders), ; aSizes := AClone(::aColSizes), ; aPicture := AClone(::aFormatPic), ; aAlign := If( ISARRAY(::aJustify), AClone(::aJustify), {} ), ; aName := {} If empty(uFontHF) uFontHF := { hFontHead, hFontFoot } ElseIf ValType(uFontHF) == "N" .and. uFontHF != 0 uFontHF := { uFontHF, uFontHF } ElseIf ValType(uFontHF) == "A" If Len(uFontHF) < 2 ASize(uFontHF, 2) EndIf If ValType(uFontHF[1]) != "N" .or. empty(uFontHF[1]) uFontHF[1] := hFontHead EndIf If ValType(uFontHF[2]) != "N" .or. empty(uFontHF[2]) uFontHF[2] := hFontFoot EndIf Else uFontHF := { hFontHead, hFontFoot } EndIf hFontHead := uFontHF[1] hFontFoot := uFontHF[2] ::aArray := aArray ::lPickerMode := .F. nColumns := If( ! Empty( aHead ), Len( aHead ), If( ! Empty( ::aArray ), Len( ::aArray[ 1 ] ), 0 ) ) //V90 ::aDefValue := Array( Len( aArray[ 1 ] ) ) //V90 aDefMaxVal := Array(nColumns) aDefType := Array(nColumns) aDefAlign := Array(nColumns) aDefMaxLen := Array(nColumns) If Len(aPicture) != nColumns ASize(aPicture, nColumns) EndIf If Len(aAlign) != nColumns ASize(aAlign, nColumns) EndIf If Len(aName) != nColumns ASize(aName, nColumns) EndIf For nI := 1 To nColumns cType := ValType( ::aArray[ 1, nI ] ) aDefType[ nI ] := cType If cType $ "CM" ::aDefValue[ nI ] := Space( Len( ::aArray[ 1, nI ] ) ) aDefMaxVal [ nI ] := ::aArray[ 1, nI ] aDefMaxLen [ nI ] := Len( aDefMaxVal [ nI ] ) aDefAlign [ nI ] := DT_LEFT ElseIf cType == "N" ::aDefValue[ nI ] := 0 aDefMaxVal [ nI ] := cValToChar( ::aArray[ 1, nI ] ) aDefMaxLen [ nI ] := Len( aDefMaxVal [ nI ] ) aDefAlign [ nI ] := DT_RIGHT ElseIf cType == "D" ::aDefValue[ nI ] := CToD( "" ) aDefMaxVal [ nI ] := cValToChar( ::aArray[ 1, nI ] ) aDefMaxLen [ nI ] := Len( aDefMaxVal [ nI ] ) aDefAlign [ nI ] := DT_CENTER ElseIf cType == "T" #ifdef __XHARBOUR__ ::aDefValue[ nI ] := CToT( "" ) #else ::aDefValue[ nI ] := HB_CTOT("") #endif aDefMaxVal [ nI ] := cValToChar( ::aArray[ 1, nI ] ) aDefMaxLen [ nI ] := Len( aDefMaxVal [ nI ] ) aDefAlign [ nI ] := DT_LEFT ElseIf cType == "L" ::aDefValue[ nI ] := .F. aDefMaxVal [ nI ] := cValToChar( ::aArray[ 1, nI ] ) aDefMaxLen [ nI ] := Len( aDefMaxVal [ nI ] ) aDefAlign [ nI ] := DT_CENTER Else // arrays, objects and codeblocks not allowed ::aDefValue[ nI ] := "???" // not user editable data type aDefMaxVal [ nI ] := "???" aDefMaxLen [ nI ] := 0 aDefAlign [ nI ] := DT_LEFT EndIf Next ::nAt := 1 ::bKeyNo := { |n| If( n == Nil, ::nAt, ::nAt := n ) } //V90 ::cAlias := "ARRAY" // don't change name, used in method Default() ::lIsArr := .T. ::lIsDbf := .F. //JP V90 ::nLen := Eval( ::bLogicLen := { || Len( ::aArray ) + If( ::lAppendMode, 1, 0 ) } ) ::lIsArr := .T. ::bGoTop := { || ::nAt := 1 } ::bGoBottom := { || ::nAt := Eval( ::bLogicLen ) } ::bSkip := { |nSkip, nOld| nOld := ::nAt, ::nAt += nSkip, ::nAt := Min( Max( ::nAt, 1 ), ::nLen ), ::nAt - nOld } //V90 ::bGoToPos := { |n| Eval( ::bKeyNo, n ) } //V90 ::bBof := { || ::nAt < 1 } //V90 ::bEof := { || ::nAt > Len( ::aArray ) } //V90 ::lHitTop := .F. ::lHitBottom := .F. ::nRowPos := 1 ::nColPos := 1 ::nCell := 1 ::HiliteCell( 1 ) aDefFooter := Array(nColumns) aFill(aDefFooter, "") If ValType(uFooter) == "L" lFooter := uFooter ElseIf ValType(uFooter) == "A" lFooter := .T. For nI := 1 To Min( nColumns, Len(uFooter) ) aDefFooter[ nI ] := cValToChar(uFooter[ nI ]) Next EndIf If Empty( aHead ) aHead := AutoHeaders( Len( ::aArray[ 1 ] ) ) EndIf If aSizes != Nil .and. ValType( aSizes ) != "A" aSizes := AFill( Array( Len( ::aArray[ 1 ] ) ), nValToNum( aSizes ) ) ElseIf ValType( aSizes ) == "A" .and. ! Empty( aSizes ) If Len( aSizes ) < nColumns nI := Len( aSizes ) + 1 ASize( aSizes, nColumns ) AFill( aSizes, aSizes[ 1 ], nI ) EndIf Else aSizes := Nil EndIf For nI := 1 To Len(::aArray) For nN := 1 To nColumns cData := cValToChar( ::aArray[ nI, nN ] ) If len(cData) > len(aDefMaxVal[ nN ]) aDefMaxVal[ nN ] := cData aDefMaxLen[ nN ] := Max( aDefMaxLen[ nN ], Len(cData) ) EndIf Next Next ::aHeaders := Array(nColumns) ::aColSizes := Array(nColumns) ::aFormatPic := Array(nColumns) ::aJustify := Array(nColumns) For nI := 1 To nColumns bData := ArrayWBlock( Self, nI ) cHead := cValToChar( aHead[ nI ] ) nAlign := aDefAlign[ nI ] cPict := Nil lSelected := .F. If aDefType[ nI ] == "C" lSelected := .T. If ValType(aPicture[ nI ]) == "C" cPict := aPicture[ nI ] cTemp := If( left(cPict, 2) == "@K", subs(cPict, 4), cPict) Else cPict := repl("X", aDefMaxLen[ nI ]) cTemp := cPict EndIf If Len(cTemp) > Len(::aDefValue[ nI ]) ::aDefValue[ nI ] := Space( Len( cTemp ) ) EndIf ElseIf aDefType[ nI ] == "N" lSelected := .T. If ValType(aPicture[ nI ]) == "C" cPict := aPicture[ nI ] Else cPict := repl("9", aDefMaxLen[ nI ]) If ( nN := At(".", aDefMaxVal[ nI ]) ) > 0 cTemp := subs(aDefMaxVal[ nI ], nN) cPict := left(cPict, Len(cPict) - Len(cTemp))+"."+repl("9", Len(cTemp)-1) EndIf EndIf ElseIf aDefType[ nI ] == "D" lSelected := .T. EndIf If ValType(aAlign[ nI ]) == "N" .and. ( aAlign[ nI ] == DT_LEFT .or. ; aAlign[ nI ] == DT_CENTER .or. ; aAlign[ nI ] == DT_RIGHT ) nAlign := aAlign[ nI ] EndIf If lFooter aAligns := { nAlign, DT_CENTER, nAlign } cFooter := aDefFooter[ nI ] If CRLF $ cFooter cTemp := "" AEval(hb_aTokens(cFooter, CRLF), {|x| cTemp := If( Len(x) > Len(cTemp), x, cTemp )}) Else cTemp := cFooter EndIf nFooter := GetTextWidth( 0, cTemp, hFontFoot ) Else aAligns := { nAlign, DT_CENTER } cFooter := Nil nFooter := 0 EndIf If CRLF $ cHead cTemp := "" AEval(hb_aTokens(cHead, CRLF), {|x| cTemp := If( Len(x) > Len(cTemp), x, cTemp )}) Else cTemp := cHead EndIf nMax := Max( GetTextWidth( 0, aDefMaxVal[ nI ]+'B', hFont ), GetTextWidth( 0, cTemp, hFontHead ) ) nMax := Max( nMax, 60 ) nMax := Max( nMax, nFooter ) If ! Empty( aSizes ) If valtype(aSizes[ nI ]) == 'N' .and. aSizes[ nI ] > 0 nMax := aSizes[ nI ] ElseIf valtype(aSizes[ nI ]) == 'C' nMax := GetTextWidth( 0, aSizes[ nI ], hFont ) EndIf EndIf ::aHeaders [ nI ] := cHead ::aColSizes [ nI ] := nMax ::aFormatPic[ nI ] := cPict ::aJustify [ nI ] := aAligns oCol := TSColumn():New( cHead, bData, cPict,, aAligns, nMax,, ::lEditable,,,,cFooter,,,,,,, ; Self, "ArrayWBlock(::oBrw," + LTrim( Str( nI ) ) + ")" ) If lFont oCol:hFontHead := hFontHead If lFooter oCol:hFontFoot := hFontFoot EndIf EndIf If ! empty(aName[ nI ]) .and. ValType(aName[ nI ]) == "C" oCol:cName := aName[ nI ] EndIf oCol:lOnGotFocusSelect := lSelected ::AddColumn( oCol ) Next ::lNoPaint := .F. ::ResetVScroll( .T. ) //V90 //V90 If ::lPainted ::GoTop() ::Refresh() EndIf //end Return Self [/pre2] Пример. Demo.prg [pre2] Demo.prg ~~~~~~~~ #include "minigui.ch" #include "common.ch" #include "TSBrowse.ch" //REQUEST HB_CODEPAGE_RU1251, HB_CODEPAGE_RU866, HB_LANG_RUWIN //REQUEST HB_LANG_RUWIN //REQUEST HB_LANG_RU866 //SET CODEPAGE TO RUSSIAN //HB_LANGSELECT( "RU" ) Proc MAIN Local oBrw, aDatos, aArray, aHead, aSize, aFoot, aPict, aAlign, aName, aFontHF Local hFontHead, hFontFoot Local cFontName := _HMG_DefaultFontName Local nFontSize := 10 Public aFont := {} SET DECIMALS TO 4 SET DATE TO GERMAN SET EPOCH TO 2000 SET CENTURY ON SET EXACT ON DEFINE FONT Font_1 FONTNAME cFontName SIZE nFontSize DEFINE FONT Font_2 FONTNAME cFontName SIZE nFontSize BOLD AADD( aFont, GetFontHandle( "Font_1" ) ) AADD( aFont, GetFontHandle( "Font_2" ) ) DEFINE WINDOW MAGAZIN AT 0, 0 ; TITLE "TEST" ; MAIN NOMAXIMIZE NOSIZE DEFINE STATUSBAR OF MAGAZIN STATUSITEM "0" // WIDTH 0 FONTCOLOR BLACK STATUSITEM "1" WIDTH 230 // FONTCOLOR BLACK STATUSITEM "2" WIDTH 230 // FONTCOLOR BLACK STATUSITEM "3" WIDTH 230 // FONTCOLOR BLACK END STATUSBAR DEFINE TBROWSE oBrw AT 0, 0 ; WIDTH MAGAZIN.WIDTH - 2 * GetBorderWidth() ; HEIGHT MAGAZIN.HEIGHT - GetTitleHeight() - GetTitleHeight() - ; GetProperty( "MAGAZIN", "StatusBar", "Height" ) - ; 2 * GetBorderHeight() ; ENUMERATOR ; FONT cFontName SIZE nFontSize ; GRID EDIT aDatos := CreateDatos() aArray := aDatos[1] aHead := aDatos[2] aSize := aDatos[3] aFoot := aDatos[4] aPict := aDatos[5] aAlign := aDatos[6] aName := aDatos[7] // hFontHead := aFont[1] // normal Header // hFontFoot := aFont[2] // bold Footer // aFontHF := { hFontHead, hFontFoot } // aFontHF := aFont[1] // normal Header, Footer aFontHF := aFont[2] // bold Header, Footer oBrw := SetArray2("oBrw", "MAGAZIN", aArray, aFontHF, aHead, aSize, aFoot, aPict, aAlign, aName) // oBrw := SetArray2("oBrw", "MAGAZIN") // Demo array oBrw:nWheelLines := 1 oBrw:nClrLine := COLOR_GRID oBrw:nHeightCell += 2 oBrw:nHeightHead += 4 If ! empty(aFoot) oBrw:nHeightFoot += 4 EndIf If oBrw:lEnum oBrw:nHeightSpecHd := oBrw:nHeightCell EndIf END TBROWSE END WINDOW DoMethod("MAGAZIN","Activate") return ************************ STATIC FUNCTION CreateDatos() Local i, k := 1000, aDatos := {}, aHead, aSize, aFoot, aPict, aAlign, aName aDatos := Array(k) for i := 1 to k aDatos[ i ] := {" ", ; // 1 i, ; // 2 ntoc(i) + "_123", ; // 3 date()+i, ; // 4 PadR("Test line - " + ntoc(i), 20), ; // 5 round((10000-i) * i/3, 2), ; // 6 100.00 * i, ; // 7 0.12, ; // 8 round(100.00 * i * 0.12, 2), ; // 9 Round(1234567.00 / i, 3), ; // 10 PadR("Line "+StrZero(i, 5), 20), ; // 11 date(), ; // 12 time(), ; // 13 i % 2 == 0 } // 14 next aHead := aClone(aDatos[1]) // AEval(aHead, {|x,n| aHead[ n ] := "Head_" + hb_ntos(n) }) AEval(aHead, {|x,n| aHead[ n ] := "Head_" + hb_ntos(n) + ; iif(n % 2 == 0, CRLF + "My_"+hb_ntos(n), "") }) aFoot := array(len(aDatos[1])) AEval(aFoot, {|x,n| aFoot[ n ] := n }) // aFoot := .T. // подножие есть с пустыми значениями aPict := array(len(aDatos[1])) // можно не задавать, формируются aPict[10] := "99999999999.999" // автоматом для C,N по мах значению aSize := array(len(aDatos[1])) // можно не задавать, формируются aSize[10] := aPict[10] // автоматом по мах значению в колонке aAlign := array(len(aDatos[1])) // тип поля C - DT_LEFT aAlign[2] := DT_CENTER // D,L - DT_CENTER // N - DT_RIGHT aName := array(len(aDatos[1])) AEval(aName, {|x,n| aName[ n ] := "MyName_"+hb_ntos(n) }) RETURN { aDatos, aHead, aSize, aFoot, aPict, aAlign, aName } [/pre2]

gfilatov2002: SergKis пишет: Еще предложение для TSBrowse В эту сборку уже не попадет Уверен, что предложенные изменения - полезные, по два подобных метода в одном классе - это не перебор

SergKis: gfilatov пишет:два подобных метода в одном классе - это не перебор Можно было наследовать TSBrowse и менять, но тогда DEFINE разваливаются, SetArray внутри в методах встречается, его оставлять надо. Я сначала попытался удержаться в рамках SetArray, но не получилось (и он задействован в программах). У меня складывается впечатление, возможностей у TSBrowse много (но на низком уровне) и надо все строить, в каждом проекте, практически сначала или таскать код из проекта в проект - нет практически готовых решений- metodов (мне показалось для массива). Для работы с полями базы есть LoadField(...)+aColSel в DEFINE (еще не щупал), вот я и попытался для отчетов (по запросу) в массив, кирпичек побольше соорудить (в первую очередь ориентировался на себя, но улучшить желающие могут найтись, я надеюсь). Мое мнение, чем больше готовых, укрупненых решений - тем проще делать алгоритмы задачи, а то, что много методов (и даже похожих) - это такая мелочь (в сравнение с кодом VO тем более) - этим можно пренебречь.

gfilatov2002: SergKis пишет: Можно было наследовать TSBrowse и менять, но тогда DEFINE разваливаются Да, я тоже сначала подумал о субклассинге, но Вы убедили, что это создает другие проблемы... SergKis пишет: я и попытался для отчетов (по запросу) в массив Тогда, может, стоит хотя бы переименовать метод в SetArrayForRep[ort]

SergKis: gfilatov2002 пишет: переименовать метод в SetArrayForRep[ort] Да, вполне передает сущность

SergKis: gfilatov2002 Подправленный вариант Method SetArray2(...) [pre2] METHOD SetArray2( aArray, uFontHF, aHead, aSizes, uFooter, aPicture, aAlign, aName ) CLASS TSBrowse Local nColumns, nI, cType, nMax, bData, cHead Local nN, cData, aDefMaxVal, aDefMaxLen, aDefType, aDefAlign, aDefFooter, oCol, ; nAlign, aAligns, lFooter := .F., cFooter, nFooter, cTemp, cPict, ; hFont := If( ::hFont != Nil, ::hFont, 0 ), ; lFont := hFont != 0, hFontHead := hFont, hFontFoot := hFont If empty(aArray) .or. ValType(aArray) != "A" nN := 1000 aArray := Array(nN) For nI := 1 To nN aArray[ nI ] := { nI, PadR("Line - "+StrZero(nI, 5), 20), ; Date()+(nI-1), Round(nN / nI, 3), nI % 2 == 0 } Next EndIf Default aHead := AClone(::aHeaders), ; aSizes := AClone(::aColSizes), ; aPicture := AClone(::aFormatPic), ; aAlign := If( ISARRAY(::aJustify), AClone(::aJustify), {} ), ; aName := {} If ValType(uFontHF) == 'N' .and. uFontHF != 0 hFontHead := uFontHF hFontFoot := uFontHF ElseIf ValType(uFontHF) == 'A' .and. Len(uFontHF) >= 2 If ValType(uFontHF[1]) == 'N' .and. uFontHF[1] != 0 hFontHead := uFontHF[1] EndIf If ValType(uFontHF[2]) == 'N' .and. uFontHF[2] != 0 hFontFoot := uFontHF[2] EndIf EndIf ::aArray := aArray ::lPickerMode := .F. nColumns := If( ! Empty( aHead ), Len( aHead ), If( ! Empty( ::aArray ), Len( ::aArray[ 1 ] ), 0 ) ) //V90 ::aDefValue := Array( Len( aArray[ 1 ] ) ) //V90 aDefMaxVal := Array(nColumns) aDefType := Array(nColumns) aDefAlign := Array(nColumns) aDefMaxLen := Array(nColumns) aFill(aDefMaxLen, 0) If Len(aPicture) != nColumns ASize(aPicture, nColumns) EndIf If Len(aAlign) != nColumns ASize(aAlign, nColumns) EndIf If Len(aName) != nColumns ASize(aName, nColumns) EndIf For nI := 1 To nColumns cType := ValType( ::aArray[ 1, nI ] ) aDefType[ nI ] := cType If cType $ "CM" ::aDefValue[ nI ] := Space( Len( ::aArray[ 1, nI ] ) ) aDefMaxVal [ nI ] := Trim( ::aArray[ 1, nI ] ) aDefMaxLen [ nI ] := Len( aDefMaxVal [ nI ] ) aDefAlign [ nI ] := DT_LEFT ElseIf cType == "N" ::aDefValue[ nI ] := 0 aDefMaxVal [ nI ] := cValToChar( ::aArray[ 1, nI ] ) aDefMaxLen [ nI ] := Len( aDefMaxVal [ nI ] ) aDefAlign [ nI ] := DT_RIGHT ElseIf cType == "D" ::aDefValue[ nI ] := CToD( "" ) aDefMaxVal [ nI ] := cValToChar( ::aArray[ 1, nI ] ) aDefMaxLen [ nI ] := Len( aDefMaxVal [ nI ] ) aDefAlign [ nI ] := DT_CENTER ElseIf cType == "T" #ifdef __XHARBOUR__ ::aDefValue[ nI ] := CToT( "" ) #else ::aDefValue[ nI ] := HB_CTOT("") #endif aDefMaxVal [ nI ] := cValToChar( ::aArray[ 1, nI ] ) aDefMaxLen [ nI ] := Len( aDefMaxVal [ nI ] ) aDefAlign [ nI ] := DT_LEFT ElseIf cType == "L" ::aDefValue[ nI ] := .F. aDefMaxVal [ nI ] := cValToChar( ::aArray[ 1, nI ] ) aDefMaxLen [ nI ] := Len( aDefMaxVal [ nI ] ) aDefAlign [ nI ] := DT_CENTER Else // arrays, objects and codeblocks not allowed ::aDefValue[ nI ] := "???" // not user editable data type aDefMaxVal [ nI ] := "???" aDefMaxLen [ nI ] := 0 aDefAlign [ nI ] := DT_LEFT EndIf Next ::nAt := 1 ::bKeyNo := { |n| If( n == Nil, ::nAt, ::nAt := n ) } //V90 ::cAlias := "ARRAY" // don't change name, used in method Default() ::lIsArr := .T. ::lIsDbf := .F. //JP V90 ::nLen := Eval( ::bLogicLen := { || Len( ::aArray ) + If( ::lAppendMode, 1, 0 ) } ) ::lIsArr := .T. ::bGoTop := { || ::nAt := 1 } ::bGoBottom := { || ::nAt := Eval( ::bLogicLen ) } ::bSkip := { |nSkip, nOld| nOld := ::nAt, ::nAt += nSkip, ::nAt := Min( Max( ::nAt, 1 ), ::nLen ), ::nAt - nOld } //V90 ::bGoToPos := { |n| Eval( ::bKeyNo, n ) } //V90 ::bBof := { || ::nAt < 1 } //V90 ::bEof := { || ::nAt > Len( ::aArray ) } //V90 ::lHitTop := .F. ::lHitBottom := .F. ::nRowPos := 1 ::nColPos := 1 ::nCell := 1 ::HiliteCell( 1 ) aDefFooter := Array(nColumns) aFill(aDefFooter, "") If ValType(uFooter) == "L" lFooter := uFooter ElseIf ValType(uFooter) == "A" lFooter := .T. For nI := 1 To Min( nColumns, Len(uFooter) ) aDefFooter[ nI ] := cValToChar(uFooter[ nI ]) Next EndIf If Empty( aHead ) aHead := AutoHeaders( Len( ::aArray[ 1 ] ) ) EndIf If aSizes != Nil .and. ValType( aSizes ) != "A" aSizes := AFill( Array( Len( ::aArray[ 1 ] ) ), nValToNum( aSizes ) ) ElseIf ValType( aSizes ) == "A" .and. ! Empty( aSizes ) If Len( aSizes ) < nColumns nI := Len( aSizes ) + 1 ASize( aSizes, nColumns ) AFill( aSizes, aSizes[ 1 ], nI ) EndIf Else aSizes := Nil EndIf For nI := 1 To Len(::aArray) For nN := 1 To nColumns cData := cValToChar( ::aArray[ nI, nN ] ) If len(cData) > len(aDefMaxVal[ nN ]) If aDefType[ nN ] == "C" aDefMaxVal[ nN ] := Trim(cData) aDefMaxLen[ nN ] := Max( aDefMaxLen[ nN ], Len(aDefMaxVal[ nN ]) ) Else aDefMaxVal[ nN ] := cData aDefMaxLen[ nN ] := Max( aDefMaxLen[ nN ], Len(cData) ) EndIf EndIf Next Next ::aHeaders := Array(nColumns) ::aColSizes := Array(nColumns) ::aFormatPic := Array(nColumns) ::aJustify := Array(nColumns) For nI := 1 To nColumns bData := ArrayWBlock( Self, nI ) cHead := cValToChar( aHead[ nI ] ) nAlign := aDefAlign[ nI ] cPict := Nil If aDefType[ nI ] == "C" If ValType(aPicture[ nI ]) == "C" .and. Len(aPicture[ nI ]) > 0 cTemp := If( left(aPicture[ nI ], 2) == "@K", subs(aPicture[ nI ], 4), aPicture[ nI ]) Else cTemp := repl("X", aDefMaxLen[ nI ]) EndIf If Len(cTemp) > Len(::aDefValue[ nI ]) ::aDefValue[ nI ] := Space( Len( cTemp ) ) EndIf cPict := repl("X", Len(::aDefValue[ nI ])) ElseIf aDefType[ nI ] == "N" If ValType(aPicture[ nI ]) == "C" cPict := aPicture[ nI ] Else cPict := repl("9", aDefMaxLen[ nI ]) If ( nN := At(".", aDefMaxVal[ nI ]) ) > 0 cTemp := subs(aDefMaxVal[ nI ], nN) cPict := left(cPict, Len(cPict) - Len(cTemp))+"."+repl("9", Len(cTemp)-1) EndIf EndIf EndIf If ValType(aAlign[ nI ]) == "N" .and. ( aAlign[ nI ] == DT_LEFT .or. ; aAlign[ nI ] == DT_CENTER .or. ; aAlign[ nI ] == DT_RIGHT ) nAlign := aAlign[ nI ] EndIf If lFooter aAligns := { nAlign, DT_CENTER, nAlign } cFooter := aDefFooter[ nI ] If CRLF $ cFooter cTemp := "" AEval(hb_aTokens(cFooter, CRLF), {|x| cTemp := If( Len(x) > Len(cTemp), x, cTemp )}) Else cTemp := cFooter EndIf nFooter := GetTextWidth( 0, cTemp, hFontFoot ) Else aAligns := { nAlign, DT_CENTER } cFooter := Nil nFooter := 0 EndIf If CRLF $ cHead cTemp := "" AEval(hb_aTokens(cHead, CRLF), {|x| cTemp := If( Len(x) > Len(cTemp), x, cTemp )}) Else cTemp := cHead EndIf nMax := Max( GetTextWidth( 0, aDefMaxVal[ nI ]+'W', hFont ), GetTextWidth( 0, cTemp, hFontHead ) ) nMax := Max( nMax, 32 ) nMax := Max( nMax, nFooter ) If ! Empty( aSizes ) If valtype(aSizes[ nI ]) == 'N' .and. aSizes[ nI ] > 0 nMax := aSizes[ nI ] ElseIf valtype(aSizes[ nI ]) == 'C' nMax := GetTextWidth( 0, aSizes[ nI ], hFont ) EndIf EndIf ::aHeaders [ nI ] := cHead ::aColSizes [ nI ] := nMax ::aFormatPic[ nI ] := cPict ::aJustify [ nI ] := aAligns oCol := TSColumn():New( cHead, bData, cPict,, aAligns, nMax,, ::lEditable,,,,cFooter,,,,,,, ; Self, "ArrayWBlock(::oBrw," + LTrim( Str( nI ) ) + ")" ) If lFont oCol:hFontHead := hFontHead If lFooter oCol:hFontFoot := hFontFoot EndIf EndIf If aDefType[ nI ] == "L" oCol:lCheckBox := .T. EndIf If ! empty(aName[ nI ]) .and. ValType(aName[ nI ]) == "C" oCol:cName := aName[ nI ] EndIf ::AddColumn( oCol ) Next ::lNoPaint := .F. ::ResetVScroll( .T. ) //V90 //V90 If ::lPainted ::GoTop() ::Refresh() EndIf //end Return Self [/pre2] И назвать его можно SetArrayTo(...), на нем и корректировку делать можно, не только отчет

gfilatov2002: SergKis пишет: Подправленный вариант Method SetArray2(...) Благодарю

gfilatov2002: Выпустил очередной релиз библиотеки с последними исправлениями и дополнениями Сборка для компилятора BCC лежит на официальном сайте библиотеки по адресу: http://hmgextended.com/files/CONTRIB/hmg-2.5.1-setup.zip Также доступна сборка для компилятора MinGW по адресу: http://hmgextended.com/files/CONTRIB/hmg251-mingw.exe и компактный архив для свежей версии компилятора xHarbour http://hmgextended.com/files/CONTRIB/xhmg251_xhb10130.zip Благодарю за внимание

Andrey: Собрал под новой версией свои проги. Полёт нормальный !

Softlog86: Подскажите - это так и должно быть или лечится ?: 1) Есть форма с контролом TAB . и организовано несколько страниц PAGE . На первой странице - несколько строчек : LABEL и кнопок BUTTONEX . При первоначальном выводе формы - некоторые контролы и LABELы не отображаются пока мышкой не проведешь там где они должны быть нарисованы ....

gfilatov2002: Softlog86 пишет: это так и должно быть или лечится ? Нет, это не нормально Лечится с помощью включения следующей строки в процедуру ON INIT: InvalidateRect( Application.Handle, 0 )

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