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

Форум » 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 Метод тут [pre2] METHOD InsColNumber( nWidth, nColumn, cName ) CLASS TSBrowse LOCAL oCol nWidth := hb_defaultValue( nWidth , 80 ) nColumn := hb_defaultValue( nColumn, 1 ) cName := hb_defaultValue( cName, iif( ::lIsDbf, "ORDKEYNO", "ARRAYNO" ) ) IF ::lIsDbf DEFINE COLUMN oCol DATA 'hb_ntos(iif( IndexOrd() > 0, ORDKEYNO(), RecNo() ))' ; HEADER '#' ; FOOTER ' ' ; ALIGN 1, 1, 1 ; WIDTH nWidth ; PICTURE '9999999' ; MOVE 0 ; DBLCURSOR ; NAME &(cName) oCol:lEdit := .F. oCol:cAlias := ::cAlias oCol:cFooting := {| nc, ob | nc := ob:nLen, iif( Empty( nc ), '', hb_ntos( nc ) ) } #ifndef __XHARBOUR__ oCol:cData := 'hb_macroblock("' + oCol:cField + '")' oCol:bData := hb_macroBlock( oCol:cField ) #else oCol:cData := '{|| ' + oCol:cField + '}' oCol:bData := &( '{|| ' + oCol:cField + '}' ) #endif ELSEIF ::lIsArr DEFINE COLUMN oCol DATA {|| NIL } ; HEADER '#' ; FOOTER ' ' ; ALIGN 1, 1, 1 ; WIDTH nWidth ; PICTURE '9999999' ; MOVE 0 ; DBLCURSOR ; NAME &(cName) oCol:cFooting := {| nc, ob | nc := ob:nLen, iif( Empty( nc ), '', hb_ntos( nc ) ) } oCol:bValue := {| xx, ob | xx := ob, hb_ntos( ob:nAt ) } ENDIF oCol:lEmptyValToChar := .T. oCol:cFieldTyp := 'N' oCol:nFieldLen := 10 oCol:nFieldDec := 0 IF nColumn > 0 .and. nColumn <= Len( ::aColumns ) ::InsColumn( nColumn, oCol ) ENDIF RETURN oCol [/pre2] В ф-ии так выходит [pre2] FUNCTION _DefineTBrowse( ControlName, ParentFormName, nCol, nRow, nWidth, nHeight, ; ... LOCAL cFontHead, cFontFoot, oCol, nW ... IF HB_ISNUMERIC( nColNumber ) nColNumber := iif( nColNumber > 0 .AND. nColNumber <= n, nColNumber, 1 ) oBrw:InsColNumber( 80, nColNumber ) oBrw:nCell := nColNumber + 1 oBrw:nFreeze := nColNumber oBrw:lLockFreeze := .T. IF HB_ISNUMERIC( nW ) .AND. nW > 0 oBrw:GetColumn( nColNumber ):nWidth := nW ENDIF ENDIF ... [/pre2] Пример на изменении пошел нормально

gfilatov2002: SergKis пишет: Метод тут Большое спасибо Это - реальная помощь

SergKis: gfilatov2002 Попробовал добавить параметр в SBrowse(... , lNumber) и строки[pre2] IF lRec :lNoHScroll := .T. ELSEIF !Empty( lNumber ) :lFooting := .T. :lDrawFooters := .T. :nHeightFoot := :nHeightHead AEval( :aColumns, {| o | o:cFooting := "" } ) :InsColNumber() :GetColumn("ORDKEYNO"):cFooting := hb_ntos( :nLen ) :nFreeze := :nColumn("ORDKEYNO") :nCell := :nFreeze + 1 :lLockFreeze := .T. ENDIF [/pre2] в примере lNumber параметр сделал .T. результат, в целом, получился с замечаниями: 1 - колонка SELECTOR стала 3D (кроме header) 2 - у колонки ORDKEYNO header стал 3D и цвет у строки фокуса, как у ячейки в фокусе 3 - у колонки ORDKEYNO цвет у строки фокуса, как у ячейки в фокусе Excel отрабатывает. На карточке появляется поле #, как бы почти все ok! В целом замечания не мешают Разобрался, 1 и 2 это градиент откуда то взялся, а не 3D. В примерах с _TBrowse(...) и колонкой Number все ok!, такого нет. Сделал так [pre2] LOCAL uParam, bRecord, nClr ... IF lEdit AEval( :aColumns, {| o | o:lEdit := ! o:cFieldTyp $ "+=^" } ) ENDIF nClr := :GetColumn(1):nClrHeadBack IF lRec :lNoHScroll := .T. ELSEIF !Empty( lNumber ) :lFooting := .T. :lDrawFooters := .T. :nHeightFoot := :nHeightHead :InsColNumber() :GetColumn("ORDKEYNO"):cFooting := hb_ntos( :nLen ) :nFreeze := :nColumn("ORDKEYNO") :nCell := :nFreeze + 1 :lLockFreeze := .T. ENDIF END WITH END TBROWSE IF !Empty( lNumber ) oBrw:GetColumn("SELECTOR"):nClrBack := nClr oBrw:GetColumn("ORDKEYNO"):nClrHeadBack := nClr ENDIF nY := This.ClientHeight - nGh - oApp:H1 ... [/pre2] Может, конечно, lNumber не надо (но с ним неплохо) ?

gfilatov2002: SergKis пишет: Попробовал добавить параметр в SBrowse(... , lNumber) Думаю, что такой параметр не помешает Благодарю за ваши усилия по доведению этой функции "до ума"

SergKis: gfilatov2002 Тут еще с методом [pre2] METHOD ExcelOle( cXlsFile, lActivate, hProgress, cTitle, hFont, lSave, bExtern, aColSel, bPrintRow ) CLASS TSBrowse ... uData := iif( ValType( ::aColumns[ nCol ]:cFooting ) == "B", Eval( ::aColumns[ nCol ]:cFooting, nCol, Self ), ; ::aColumns[ nCol ]:cFooting ) ... Если эту правку сделать, то можно убрать строку, но может не надо убирать эту строку, т.к. не знаю что делает на тему :cFooting метод oBrw:Report() :InsColNumber() :GetColumn("ORDKEYNO"):cFooting := hb_ntos( :nLen ) :nFreeze := :nColumn("ORDKEYNO") [/pre2]

gfilatov2002: SergKis пишет: uData := iif( ValType( ::aColumns[ nCol ]:cFooting ) == "B", Eval( ::aColumns[ nCol ]:cFooting, nCol, Self ), ; ::aColumns[ nCol ]:cFooting ) Благодарю за поправку Я добавил также строку, чтобы не было разрыва курсора при движении по ячейкам IF ! Empty( lNumber ) oBrw:GetColumn( "SELECTOR" ):nClrBack := nClr oBrw:GetColumn( "ORDKEYNO" ):nClrHeadBack := nClr oBrw:GetColumn( "ORDKEYNO" ):nClrFocuBack := oBrw:nClrPane ENDIF

SergKis: gfilatov2002 Добавьте метод в CLASS TDlu2Pix [pre2] METHOD TextWidth( cText, nSize, cFont, lBold, cChar ) CLASS TDlu2Pix LOCAL hFont, nWidth cChar := hb_defaultValue(cChar, 'A') cText := hb_defaultValue(cText, Replicate(cChar, 2)) lBold := hb_defaultValue(lBold, .F. ) cFont := hb_defaultValue(cFont, _HMG_DefaultFontName) nSize := hb_defaultValue(nSize, _HMG_DefaultFontSize) IF ValType(cText) == 'N' ; cText := Replicate(cChar, cText) ENDIF hFont := InitFont(cFont, nSize, lBold) nWidth := GetTextWidth(Nil, cText, hFont) DeleteObject(hFont) RETURN nWidth что бы можно было width контрола получить от dlu, напрмер, кратное :W(0.5) w := 0 o := oDlu4Font(nSize) // nSize: from 8 to 26 t := o:TextWidth('Bla bla ... bla', nSize) a := array(20) aFill(a, o:W(0.5)) FOR EACH n IN a w += n IF w > t ; EXIT ENDIF NEXT ? t, w, o:H1 вместо этих команд в моем варианте есть метод METHOD Breadth( w, k ) CLASS TDlu2Pix LOCAL nWidth := 0 WHILE w > ( nWidth += ::W( hb_defaultValue(k, 0.5) ) ) END RETURN nWidth т.е. делаю w := o:Breadth( o:TextWidth('Bla bla ... bla', nSize), 0.5 ) [/pre2]

gfilatov2002: SergKis пишет: Добавьте метод Ok

SergKis: gfilatov2002 пишет Ok Тогда еще немного правок для nFontSize [pre2] FUNCTION oDlu4Font( nFontSize, lDlu2Pix ) ... IF lDlu2Pix RETURN TDlu2Pix():New( nPrcW, nPrcH, nFontSize ) ENDIF ... FUNCTION oDlu2Pixel( nPrcW, nPrcH, nFontSize ) ... IF o_AppDlu2Pixel == NIL nFontSize := hb_defaultValue( nFontSize, _HMG_DefaultFontSize ) o_AppDlu2Pixel := TDlu2Pix():New( nPrcW, nPrcH, nFontSize ) ... CLASS TDlu2Pix ... VAR nB INIT 0 VAR nSize INIT 0 METHOD New( nPrcW, nPrcH, nSize ) INLINE ( ::nScaleWidth := hb_defaultValue( nPrcW, 100 ), ; ::nScaleHeight := hb_defaultValue( nPrcH, 100 ), ::nSize := hb_defaultValue( nSize, ::nSize ), ; ::UnitsToPixels(), Self ) CONSTRUCTOR ... METHOD TextWidth( cText, nSize, cFont, lBold, cChar ) CLASS TDlu2Pix ... nSize := hb_defaultValue(nSize, iif( Empty(::nSize), _HMG_DefaultFontSize, ::nSize ) ) ... METHOD Breadth( nW, k ) CLASS TDlu2Pix LOCAL nWidth := 0 IF HB_ISCHAR(nW) ; nW := ::TextWidth(nW) ENDIF WHILE nW > ( nWidth += ::W( hb_defaultValue(k, 0.5) ) ) END RETURN nWidth ... [/pre2]

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

gfilatov2002: Выложил 2-й апдейт сборки 21.11 с учетом всех последних изменений Обновил также Unicode архив. Благодарю за огромную помощь Сергея Киселева Желаю всем счастья и хорошего самочувствия в наступающем году

SergKis: gfilatov2002 Немного поправил SBrowse [pre2] DEFINE TBROWSE oBrw AT nY, nX Alias ( uAlias ) WIDTH nWidth HEIGHT nHeight HEADER aCols ; AUTOCOLS SELECTOR 20 ; ON INIT {|ob| ob:nColOrder := 0 , ; ob:lNoGrayBar := .F., ; ob:lNoLiteBar := .F., ; ob:lNoResetPos := .F., ; ob:nStatusItem := 0 , ; ob:lNoKeyChar := .T., ; ob:nWheelLines := 1 , ; ob:nCellMarginLR := 1 , ; ob:nLineStyle := LINES_ALL , ; ob:nClrLine := COLOR_GRID, ; ob:lCheckBoxAllReturn := .T. } oBrw:Cargo := uParam lEdit := Eval( bSetUp, oBrw ) lEdit := iif( ValType( lEdit ) == "L", lEdit, .F. ) WITH OBJECT oBrw :lEditable := lEdit :lCellBrw := ( lEdit .OR. lCellBrw ) //:nClrLine := COLOR_GRID //:nClrHeadBack := { CLR_WHITE, COLOR_GRID } :lUpdate := .T. //:Cargo := uParam :bRClicked := {|| _SetThisFormInfo( oBrw:cParentWnd ), SBrowse_Record( oBrw, , bRecord ), _SetThisFormInfo() } :lRecLockArea := .T. ... [/pre2] Пример на базе Tsb_sbrowse [pre2] #define _HMG_OUTLOG #include "minigui.ch" #include "tsbrowse.ch" #include "dbinfo.ch" *----------------------------------- Function Main() *----------------------------------- Local cTitle := "Test Browse: Right Click For Record View", ; bSetup := { |oBrw,lAft| SetMyBrowser( oBrw, lAft ) }, ; cFont := "Tahoma", nSize := 10 CreateTable() USE Test NEW SET AUTOADJUST ON NOBUTTONS SET FONT TO cFont, nSize DEFINE FONT Normal FONTNAME cFont SIZE nSize DEFINE FONT Bold FONTNAME cFont SIZE nSize BOLD SET DEFAULT ICON TO GetStartupFolder() + "\demo.ico" DEFINE WINDOW sample AT 0,0 WIDTH 740 HEIGHT 580 ; TITLE "Open Table via SBrowse" ; MAIN NOSHOW ; ON INIT ( SBrowse( "Test", cTitle, bSetup,,,,,, .T. ), This.t_1.Enabled := .T. ) ; ON RELEASE ( dbCloseArea( "Test" ), hb_dbDrop( "Test" ) ) DEFINE TIMER t_1 INTERVAL 1000 ACTION iif( Empty(CountChildWindows()), ThisWindow.Release(), ) This.t_1.Enabled := .F. END WINDOW sample.Center() sample.Activate() Return Nil *----------------------------------- Function CreateTable *----------------------------------- DBCREATE("Test", {{"CODE", "C", 3, 0},{"NAME", "C", 50, 0},{"RESIDENTS", "N", 11, 0},{"NOTES", "M", 10, 0}},,.T.) DBAPPEND() REPLACE CODE WITH 'LTU', NAME WITH 'Lithuania', RESIDENTS WITH 3369600 DBAPPEND() REPLACE CODE WITH 'USA', NAME WITH 'United States of America', RESIDENTS WITH 305397000 DBAPPEND() REPLACE CODE WITH 'POR', NAME WITH 'Portugal', RESIDENTS WITH 10617600 DBAPPEND() REPLACE CODE WITH 'POL', NAME WITH 'Poland', RESIDENTS WITH 38115967 DBAPPEND() REPLACE CODE WITH 'AUS', NAME WITH 'Australia', RESIDENTS WITH 21446187 DBAPPEND() REPLACE CODE WITH 'FRA', NAME WITH 'France', RESIDENTS WITH 64473140 DBAPPEND() REPLACE CODE WITH 'RUS', NAME WITH 'Russia', RESIDENTS WITH 141900000 DBAPPEND() REPLACE CODE WITH 'LAT', NAME WITH 'Latvja', RESIDENTS WITH 7654321 DBAPPEND() REPLACE CODE WITH 'DEM', NAME WITH 'Germanija', RESIDENTS WITH 1234567 USE Return Nil *----------------------------------- Function SetMyBrowser( oBrw, lAft ) *----------------------------------- Local cFormName := oBrw:cParentWnd, cTitle, oCol, hFont If Empty(lAft) SetProperty( cFormName, "MinWidth", 920 ) SetProperty( cFormName, "MinHeight", 480 ) oBrw:nHeightCell += 5 oBrw:nHeightHead += 12 oBrw:nClrFocuFore := CLR_BLACK oBrw:nClrFocuBack := COLOR_GRID hFont := GetFontHandle( "Bold" ) oBrw:hFontSupHd := hFont oBrw:nHeightSuper := oBrw:nHeightHead cTitle := " [" + oBrw:cAlias + "] " + DBINFO( DBI_FULLPATH ) ADD SUPER HEADER TO oBrw FROM 1 TO 2 TITLE " "+RddName() ADD SUPER HEADER TO oBrw FROM 3 TO oBrw:nColCount() TITLE cTitle FOR EACH oCol IN oBrw:aColumns oCol:hFontHead := hFont oCol:hFontFoot := hFont NEXT Else oCol := ATail(oBrw:aColumns) ATail(oBrw:aSuperHead)[ 2] := oBrw:nColumn(oCol:cName) IF oBrw:nLen > oBrw:nRowCount() oBrw:ResetVScroll( .T. ) ENDIF oBrw:SetNoHoles() oBrw:SetFocus() EndIf Return .T. // editable browse (return .F. is readonly) *----------------------------------- Function CountChildWindows *----------------------------------- Local i, nFormCount := Len (_HMG_aFormHandles), nCnt := 0 FOR i := 1 TO nFormCount IF _HMG_aFormType [ i ] <> "A" IF _IsWindowDefined ( _HMG_aFormNames [ i ] ) nCnt++ ENDIF ENDIF NEXT Return nCnt [/pre2] Есть проблемка с Super Header и OLE, т.е. вывод таблицы в excel снимается. Я не специалист ole excel, не работаю с ним. Потому только сообщаю

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

SergKis: gfilatov2002 Поправил [pre2] METHOD LoadFields( lEditable, aColSel, cAlsSel, aNameSel, aHeadSel ) CLASS TSBrowse ... ELSEIF cType $ "=@T" cPicture := Nil nSize := GetTextWidth( 0, Replicate( "9", 24 ), hFont ) ELSEIF cType $ "^+" ... IF ValType( ::aFormatPic ) == "A" .AND. ! Empty( ::aFormatPic ) .AND. n <= Len( ::aFormatPic ) .and. ! cType $ "=@T" cPicture := ::aFormatPic[ n ] ENDIF ... [/pre2] У этих полей Picture оказался равным '9999999999'

gfilatov2002: SergKis пишет: Поправил Ok

gfilatov2002: SergKis пишет: Если возможно, включите в сборку последнюю версию LetoDbf, клиента и сервер Сделал, будет доступно в следующей сборке Благодарю за напоминание

SergKis: gfilatov2002 Показалось интересным, правка записи в SBrowse() [pre2] FUNCTION SBrowse( uAlias, cTitle, bSetUp, aCols, nWidth, nHeight, lSql, lModal, lNumber ) ... LOCAL uParam, bRecord, nClr, oCol ... ON KEY ESCAPE ACTION {|| iif( oBrw:IsEdit, oBrw:SetFocus(), ThisWindow.RELEASE ) } IF lRec nY := Len( oBrw:aColumns ) oBrw:aColumns[ nY - 1 ]:nWidth += 50 oBrw:aColumns[ nY - 1 ]:cName := "KEY" oBrw:aColumns[ nY ]:lEdit := .F. oBrw:aColumns[ nY ]:cName := "VALUE" FOR EACH oCol IN oBrw:aColumns oCol:cPicture := NIL oCol:nAlign := DT_LEFT NEXT oBrw:AdjColumns( nY ) IF HB_ISOBJECT( oBrw:Cargo ) .and. oBrw:ClassName == "TSBROWSE" .and. oBrw:Cargo:lIsDbf oBrw:Cargo:lRecLockArea := .T. oCol := oBrw:aColumns[3] oCol:lEdit := .T. oCol:bPrevEdit := {|uv,obr| Local lRet := .T., nn, cn, oc, ob nn := obr:nAt cn := obr:GetValue(2) obr:aColumns[ obr:nCell ]:Cargo := NIL ob := obr:Cargo IF !HB_ISOBJECT( ob ) .or. !ob:lIsDbf RETURN .F. ENDIF nn := obr:nAt oc := ob:GetColumn( cn ) IF Empty( oc:cFieldTyp ) .or. oc:cName == "SELECTOR" .or. oc:cName == "ORDKEYNO" lRet := .F. ELSEIF oc:cFieldTyp $ "T=@+^" lRet := .F. ENDIF IF lRet obr:aColumns[ obr:nCell ]:Cargo := uv ENDIF Return lRet } oCol:bPostEdit := {|uv,obr| Local nn, cn, oc, ob, uo, nm nn := obr:nAt cn := obr:GetValue(2) uo := obr:aColumns[ obr:nCell ]:Cargo IF uo != NIL .and. uo == uv RETURN Nil ENDIF ob := obr:Cargo IF !HB_ISOBJECT( ob ) .or. !ob:lIsDbf RETURN Nil ENDIF nn := obr:nAt oc := ob:GetColumn( cn ) nm := oc:nEditMove oc:nEditMove := 0 ob:PostEdit(uv, ob:nColumn(oc:cName)) oc:nEditMove := nm Return Nil } ENDIF ENDIF IF ! lbSetUp .or. lRec oBrw:SetNoHoles() oBrw:SetFocus() IF lRec oBrw:GoRight() ENDIF ENDIF IF HB_ISBLOCK( bAfter ) ; EVal( bAfter, oBrw, .T. ) ELSE ; Eval( bSetUp, oBrw, .T. ) ENDIF ... [/pre2] Пример тут https://TransFiles.ru/fvyp6

gfilatov2002: SergKis пишет: правка записи в SBrowse() Большое спасибо Это - то, что нужно...

SergKis: gfilatov2002 пишет Это - то, что нужно... Пример с логическим полем в структуре и вариантом bSetUp для SBrowse() тут https://TransFiles.ru/4zp9j

SergKis: gfilatov2002 Почистил, поправил SBrowse(), добавил задать размеры через nWidth, nHeight для SBrowse_Record() Пример и h_controlmisc2.prg тут https://TransFiles.ru/3i6zg Еще правка [pre2] METHOD D( nKfc ) CLASS TDlu2Pix LOCAL nVal := ::nPixWidthDT IF HB_ISNUMERIC( nKfc ) .AND. nKfc > 0 IF nKfc == 1 ; nVal := ::nPixWidthDT ELSEIF nKfc == 2 ; nVal := ::nPixWidthDT1 ELSEIF nKfc == 3 ; nVal := ::nPixWidthDT2 ELSE ; nVal := Int( nKfc * nVal ) ENDIF ENDIF RETURN nVal [/pre2]

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