Новая версия Расширенного релиза библиотеки 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

Andrey: gfilatov2002 пишет: Андрею должно понравится такое изменение: Мне понравилось ! Спасибо ! SergKis пишет: что бы не делать доп. переменных, а использовать :cargo колонки, например (от Андрея): Да, это очень удобно получается. Загружаешь в массив короткий справочник типа: [pre2]{1, "В офисе "} {2, "отданы лично в руки "} {3, "отданы Посыльному "}[/pre2] А потом бровс сам показывает вместо кодов нужные наименования через функцию: [pre2]FUNCTION Select2Array(xVal,aDim) LOCAL nI, cRet := "none Dim" FOR nI := 1 TO LEN(aDim) IF xVal == aDim[nI,1] cRet := aDim[nI,2] ENDIF NEXT RETURN cRet[/pre2] Ну а в oCol:bPrevEdit - показ выбора из этого массива SelectWho(ob, oc:Cargo) и потом запись в базу WriteColum4(ob). Что-то форум потерял предыдущую тему. Не понятно будет о чем речь идёт...

SergKis: Andrey пишет Ну а в oCol:bPrevEdit - показ выбора из этого массива SelectWho(ob, oc:Cargo) Можно упростить[pre2] oCol := oBrw:GetColumn("Name_4") oCol:Cargo := oKeyData() // Get2DimCol4() // получить массив для колонки 4 oCol:bDecode := {|val,ob,nc,oc| nc:=ob, oc:Cargo:Get(val, val) } // если для кода нет наименования, будет сам код oCol:nAlign := DT_CENTER oCol:cPicture := REPL("x",25) oCol:lEdit := .T. oCol:bPrevEdit := {|val,ob,nc,oc| SelectWho(ob, oc:Cargo), WriteColum4(ob), ob:Setfocus(), FALSE } // заполним из dbf коды и названия для колонки USE ... ALIAS SPR NEW SHARED dbEval({|| oCol:Cargo:Set(FIELD->KOD, FIELD->NAME) }) USE dbSelectArea(oBrw:cAlias) ... [/pre2]

SergKis: PS массив получить так oCol:CargoGetAll(.T.) // массив наименований для combobox например oCol:CargoGetAll(.F.) // массив {{kod, name},..., {kodN, nameN}} т.е. oCol:bPrevEdit := {|val,ob,nc,oc| SelectWho(ob, oc:Cargo:GetAll(.F.)), WriteColum4(ob), ob:Setfocus(), FALSE }

gfilatov2002: Снова обновил сборку 20.01 (Update 7) с учетом последних наработок Базовый дистрибутив для BCC 5.8.2 находится по адресу http://hmgextended.com/files/CONTRIB/hmg-20.01-setup.exe Обновил также архив для бесплатного Embarcadero C++ 10.1 Berlin compiler по адресу http://hmgextended.com/files/CONTRIB/hmg2001_bcc101.exe Благодарю за ваше внимание

kkg: Из замеченного, если в версии bcc101 подменить библиотеки hblang.lib hbcpage.lib от BCC 5.8.2 то установка русского языка отрабатывает нормально, включая обработку ошибок. На некоторых версиях ОС проявляется ошибка ilink32, "лечение" описано тут click here может кому то пригодится.

gfilatov2002: Завершена подготовка новой сборки 20.03, которая будет опубликована на следующей неделе. Кратко, что нового: [pre2] * New: Added the new useful C-function dbInsert( [nRecNo] [, nCount] ). Added the new commands for managing of the above function: - INSERT BEFORE; - INSERT BLANK. * Splitboxed TOOLBAR control supports the changing of a 'Caption' property at runtime. * Added a support of the 'Variant' fields type in a Browse control. * The Getbox control may manage a 'ValidMessage' property at runtime. * Synchronized Extended HMG for compatibility with Official HMG: - New: Added the following read/write properties for a Grid control: - ColumnJUSTIFY( nColIndex ), - ColumnONHEADCLICK( nColIndex ), - ColumnCONTROL( nColIndex ), - ColumnDYNAMICBACKCOLOR( nColIndex ), - ColumnDYNAMICFORECOLOR( nColIndex ), - ColumnVALID( nColIndex ), - ColumnWHEN( nColIndex ), - ColumnVALIDMESSAGE( nColIndex ). * Updated Harbour Compiler 3.2.0dev to a recent Git-version. * Updated HMGS-IDE v.1.4.4.0 and Sqlite3 library. * Updated the some Basic, Advanced and Applications samples. [/pre2]Благодарю за ваше внимание

Andrey: gfilatov2002 пишет: которая будет опубликована на следующей неделе. Ждем с нетерпением !

gfilatov2002: Andrey пишет: Ждем с нетерпением Завтра буду готовить финальную версию инсталлятора для этой сборки

gfilatov2002: Опубликована новая сборка 20.03 для BCC 5.8.2 и компиляторов Harbour и xHarbour. Базовый дистрибутив находится по адресу http://hmgextended.com/files/CONTRIB/hmg-20.03-setup.exe Добавил также архив для бесплатного Embarcadero C++ 10.1 Berlin compiler http://hmgextended.com/files/CONTRIB/hmg2003_bcc101.exe В марте этого года исполнилось ровно 15 лет с момента начала разработки этой версии библиотеки Выпуск последующих обновлений будет зависеть от активности и поддержки со стороны пользователей ее разработки. Отдельная благодарность - Андрею Верченко, Диме (админу этого форума) и Саше Савову из Болгарии за их материальную поддержку

gfilatov2002: Сделал "тихое" обновление сборки 20.03 после повторного исправления следующего изменения: * Enhanced: Splitboxed TOOLBAR control supports the changing of a 'Caption' property at runtime. Проблема была указана на английском форуме библиотеки. Если вы не используете данную возможность в своей программе, то это обновление является необязательным.

gfilatov2002: Подготовил 1-й релиз-кандидат для новой сборки 20.04 со следующим списком изменений (кратко): [pre2] * Fixed problem with assigning of the BKBRUSH clause at a form definition (introduced in the build 19.12). * A correction in the function _SetValue() for a conflict between the Timer and AniGif controls handling. * The Label, HyperLink, CheckBox and RadioGroup controls support changing the 'Transparent' property at runtime. * The EDIT controls family (TEXTBOX & EDITBOX) support changing the 'CaseConvert' property at runtime. It was a postponed user's request. * The MONTHCAL control supports the BackColor, FontColor and others color clauses in the THEMED Operating Systems. It was a postponed user's request. * Improved user type of control in INPLACE EDIT of GRID control. DYNAMIC type is defined as { cControlType, bCodeBlock [, bChange] } where cControlType = 'DYNAMIC' (Required) bCodeBlock = CodeBlock that return array with normal type control (Required) bChange = CodeBlock with ON CHANGE action (Optional) to above CodeBlock is passed one param - a current control value. Added a new control type 'CODEBLOCK' for using with 'DYNAMIC' type. * The ANIMATEBOX control supports now an optional INVISIBLE clause. * The FONT clause in the POPUP and MENUITEM commands supports a font name for the fonts which were defined by the command DEFINE FONT <font> FONTNAME <name>. * Limited the height of the dialog box in the function HMG_Alert() to be able to output more than 20 strings in the EditBox control. * The HMG Debugger resources were moved from the sample DBG_TEST to the application resources. * Updated TSBrowse and Sqlite3 libraries. * Updated the some Basic and Advanced samples. [/pre2] Благодарю за ваше внимание

SergKis: gfilatov2002 Предложение: TsBrowse.ch [pre2] #xcommand @ <row>,<col> TBROWSE <name> ; ... [ <cur: DBLCURSOR, DOUBLE CURSOR, FIXED> ] ; [ <emptyval: COLEMPTY,COLSEMPTY,EMPTYVALUE> ] ; =>; ... [ <number> ], [ <aBrush> ], [ <aEdit> ], [ <Adjust> ], [ <.ladjust.> ], ; [ <.emptyval.> ] ) #xcommand DEFINE TBROWSE <name> ; ... [ <emptyval: COLEMPTY,COLSEMPTY,EMPTYVALUE> ] ; =>; ... [ <number> ], [ <aBrush> ], [ <aEdit> ], [ <Adjust> ], [ <.ladjust.> ], ; [ <.emptyval.> ] ) ;; with object <name> ... #xcommand DEFINE TBROWSE <name> OBJ <obrw> ; ... [ <cur: DBLCURSOR, DOUBLE CURSOR, FIXED> ] ; [ <emptyval: COLEMPTY,COLSEMPTY,EMPTYVALUE> ] ; =>; ... [ <number> ], [ <aBrush> ], [ <aEdit> ], [ <Adjust> ], [ <.ladjust.> ], ; [ <.emptyval.> ] ) ;; with object <obrw> ... [/pre2] TsBrowse.prg [pre2] FUNCTION _DefineTBrowse ( ControlName, ParentFormName, nCol, nRow, nWidth, nHeight, ; ... lLoad, lDblCursor, aNames, aFooters, nColNumber, aBrush, aEdit, Adjust, ; lAdjust, lEmptyValToChar ) ... ELSE // BK IF HB_ISARRAY( uAlias ) aArray := uAlias uAlias := NIL ENDIF IF HB_ISLOGICAL(aEdit) ... // BK IF HB_ISARRAY(aArray) oBrw:SetArrayTo( aArray, {hFontHead, hFontFoot} , aHeaders, aWidths, aFooters, aPicture, aJust, aNames ) ELSE If ! empty(hFontHead) ; oBrw:hFontHead := hFontHead EndIf If ! empty(hFontFoot) ; oBrw:hFontFoot := hFontFoot EndIf ENDIF IF HB_ISARRAY(aBrush) .and. Len(aBrush) > 2 ... IF ( nColums := Len( oBrw:aColumns ) ) > 0 /* BK 18.05.2015 */ ... // BK n := nColums IF ! HB_ISARRAY( aArray ) IF HB_ISARRAY(aNames) j := Min(Len(aNames), n) FOR t := 1 TO j IF ! Empty(aNames[ t ]) .and. HB_ISCHAR(aNames[ t ]) oBrw:aColumns[ t ]:cName := aNames[ t ] ENDIF NEXT ENDIF IF HB_ISLOGICAL(aFooters) .and. aFooters aFooters := Array( n ) aFill( aFooters, " " ) ENDIF IF HB_ISARRAY(aFooters) j := Min( Len(aFooters), n ) FOR t := 1 TO j IF aFooters[ t ] != NIL If HB_ISCHAR( aFooters[ t ] ) .and. ";" $ aFooters[ t ] aFooters[ t ] := StrTran( aFooters[ t ], ";", Chr(13) ) EndIf oBrw:aColumns[ t ]:cFooting := aFooters[ t ] ENDIF NEXT oBrw:lDrawFooters := .T. oBrw:lFooting := .T. oBrw:nHeightFoot := oBrw:nHeightCell ENDIF ENDIF IF HB_ISARRAY(aEdit) ... IF ! Empty(lDblCursor) AEval( oBrw:aColumns, {|oCol| oCol:lFixLite := .T. } ) ENDIF IF ! empty(lEmptyValToChar) AEval( oBrw:aColumns, {| oCol| oCol:lEmptyValToChar := .T. } ) ENDIF nW := 0 IF nColNumber != NIL IF HB_ISLOGICAL(nColNumber) nColNumber := iif( nColNumber, 1, NIL ) ELSEIF HB_ISARRAY(nColNumber) IF Len(nColNumber) > 1 nW := nColNumber[2] nColNumber := nColNumber[1] ELSE nColNumber := 1 ENDIF ENDIF ENDIF IF HB_ISNUMERIC(nColNumber) nColNumber := iif( nColNumber > 0 .and. nColNumber <= n, nColNumber, 1 ) IF oBrw:lIsDbf DEFINE COLUMN oCol DATA 'hb_ntos(iif( IndexOrd() > 0, ORDKEYNO(), RecNo() ))' ; HEADER '#' ; FOOTER ' ' ; ALIGN 1, 1, 1 ; WIDTH 80 ; PICTURE '9999999' ; MOVE 0 ; DBLCURSOR ; NAME ORDKEYNO oCol:lEdit := .F. oCol:cAlias := oBrw: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 oBrw:lIsArr DEFINE COLUMN oCol DATA {|| NIL } ; HEADER '#' ; FOOTER ' ' ; ALIGN 1, 1, 1 ; WIDTH 80 ; PICTURE '99999' ; MOVE 0 ; DBLCURSOR ; NAME ARRAYNO 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 oBrw:InsColumn( nColNumber, oCol ) oBrw:nCell := nColNumber + 1 oBrw:nFreeze := nColNumber oBrw:lLockFreeze := .T. IF HB_ISNUMERIC(nW) .and. nW > 0 ... [/pre2] Пример ADVANCED\Tsb_Array_2\demo3.prg [pre2] #include "minigui.ch" #include "TSBrowse.ch" PROCEDURE MAIN LOCAL oBrw, aDatos, aArray, aHead, aSize, aFoot, aPict, aAlign, aName LOCAL nY, nX, nW, nH SET DECIMALS TO 4 SET DATE TO GERMAN SET EPOCH TO 2000 SET CENTURY ON SET EXACT ON SET FONT TO 'Arial', 11 DEFINE FONT Norm FONTNAME _HMG_DefaultFontName SIZE _HMG_DefaultFontSize DEFINE FONT Bold FONTNAME _HMG_DefaultFontName SIZE _HMG_DefaultFontSize BOLD DEFINE WINDOW test ; TITLE "SetArray For Report Demo" ; MAIN ; NOMAXIMIZE NOSIZE DEFINE STATUSBAR STATUSITEM "0" // WIDTH 0 FONTCOLOR BLACK STATUSITEM "Item 1" WIDTH 230 // FONTCOLOR BLACK STATUSITEM "Item 2" WIDTH 230 // FONTCOLOR BLACK STATUSITEM "Item 3" WIDTH 230 // FONTCOLOR BLACK END STATUSBAR nY := 1 + iif( IsVistaOrLater(), GetBorderWidth ()/2, 0 ) nX := 1 + iif( IsVistaOrLater(), GetBorderHeight()/2, 0 ) nW := test.WIDTH - 2 * GetBorderWidth() nH := test.HEIGHT - 2 * GetBorderHeight() - ; GetTitleHeight() - test.StatusBar.Height aDatos := CreateDatos() aArray := aDatos[ 1 ] aHead := aDatos[ 2 ] aSize := aDatos[ 3 ] aFoot := aDatos[ 4 ] aPict := aDatos[ 5 ] aAlign := aDatos[ 6 ] aName := aDatos[ 7 ] DEFINE TBROWSE oBrw ; AT nY, nX ALIAS aArray WIDTH nW HEIGHT nH CELL ; FONT { "Norm", "Bold", "Bold" } ; BRUSH { 255, 255, 240 } ; HEADERS aHead ; COLSIZES aSize ; PICTURE aPict ; JUSTIFY aAlign ; COLNAMES aName ; COLNUMBER { 1, 40 } ; FOOTERS aFoot ; FIXED ADJUST COLEMPTY ; ENUMERATOR mySetTsb( oBrw ) myColorTsb( oBrw ) END TBROWSE oBrw:SetNoHoles() END WINDOW DoMethod( "test", "Activate" ) RETURN FUNCTION mySetTsb( oBrw ) WITH OBJECT oBrw :nColOrder := 0 :lNoChangeOrd := .T. :nWheelLines := 1 :lNoGrayBar := .F. :lNoLiteBar := .F. :lNoResetPos := .F. :lNoHScroll := .T. :lNoPopUp := .T. END WITH RETURN Nil FUNCTION myColorTsb( oBrw ) WITH OBJECT oBrw :nClrLine := RGB(180,180,180) // COLOR_GRID :SetColor( { 11 }, { { || RGB(0,0,0) } } ) :SetColor( { 2 }, { { || RGB(255,255,240) } } ) :SetColor( { 5 }, { { || RGB(0,0,0) } } ) :SetColor( { 6 }, { { |a,b,c| iif( c:nCell == b, -CLR_HRED , -RGB(128,225,225) ) } } ) :SetColor( { 12 }, { { |a,b,c| iif( c:nCell == b, -RGB(128,225,225), -RGB(128,225,225) ) } } ) END WITH RETURN Nil * ====================================================================== 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 + "SubHead" + 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]

SergKis: PS Для колонки нумерации ARRAYNO надо поправить PICTURE '9999999' как у ORDKEYNO, забыл это сделать.

SergKis: PS Возможно, колонки нумерации надо назвать одинаково ? Названия колонок оставил, как использую сам.

SergKis: PS2 Еще можно добавить TsBrowse.ch (в определения команд выше добавить) [pre2] [ <emptyval: COLEMPTY,COLSEMPTY,EMPTYVALUE> ] ; [ <gotfocusel: GOTFOCUSSELECT,GOTFOCUSELECT> ] ; ... [ <.emptyval.> ], [ <.gotfocusel.> ] ) ... ... [/pre2] TsBrowse.prg [pre2] FUNCTION _DefineTBrowse ( ControlName, ParentFormName, nCol, nRow, nWidth, nHeight, ; ... lAdjust, lEmptyValToChar, lOnGotFocusSelect ) ... IF ! empty(lEmptyValToChar) AEval( oBrw:aColumns, {| oCol| oCol:lEmptyValToChar := .T. } ) ENDIF IF ! empty(lOnGotFocusSelect) AEval( oBrw:aColumns, {| oCol| oCol:lOnGotFocusSelect := .T. } ) ENDIF nW := 0 ... [/pre2] И в примере [pre2] DEFINE TBROWSE oBrw ; AT nY, nX ALIAS aArray WIDTH nW HEIGHT nH CELL ; FONT { "Norm", "Bold", "Bold" } ; BRUSH { 255, 255, 240 } ; HEADERS aHead ; COLSIZES aSize ; PICTURE aPict ; JUSTIFY aAlign ; COLNAMES aName ; COLNUMBER { 1, 40 } ; FOOTERS aFoot ; FIXED ADJUST COLEMPTY ; ENUMERATOR EDIT ; GOTFOCUSSELECT [/pre2]

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

gfilatov2002: Подготовил 2-й релиз-кандидат для новой сборки 20.04. Что нового: [pre2] * Fixed: A correction for the font attributes handling in SplitButton control. Contributed by Ivanil Marcelino <ivanil/at/linkbr.com.br> (see demo in folder \samples\Advanced\SplitButton) ... * Modified: PLAYER: the helpful functions were moved from the samples to MiniGUI core: - aSize := GetAviFileSize( <cFileName> ) ; - aSize := GetAviResSize( <cResName> ). Contributed by Grigory Filatov <gfilatov@inbox.ru> (see demos in the folders \samples\Basic\PLAYER_1 and \samples\Basic\ANIMATEDEMO_2) ... * Updated: Adaptation FiveWin Class TSBrowse 9.0 in HMG: ... Added the following optional clauses to DEFINE TBROWSE command: - New: COLSEMPTY clause means to assign oCol:lEmptyValToChar := .T. for all columns of a TBROWSE control. - New: GOTFOCUSSELECT clause means to assign oCol:lOnGotFocusSelect := .T. for all edited columns of a TBROWSE control. - Enhanced: LOADFIELDS clause allows to load an array with using of the method SetArrayTo() at startup of a TBROWSE control. Contributed by Sergej Kiselev. (see demo3.prg in folder \samples\Advanced\Tsb_Array_2) * Updated: Harbour Compiler 3.2.0dev (SVN 2020-04-19 16:32). Contributed by Grigory Filatov <gfilatov@inbox.ru> (look at ReadMe.txt in folder \harbour) ... * Updated: 'Cas_dbf' sample: added an enhanced demo with Tsbrowse search. Contributed by Pierpaolo Martinello <pier.martinello[at]alice.it> (see in folder \samples\Basic\Database) [/pre2]Благодарю за ваше внимание

alex_II: В TBrowse использую событие ON CHANGE, в котором некая функция выводит в STATUSBAR дополнительную информацию из текущей строки: ... DEFINE TBROWSE Br_omes AT h_tlbar,0 ALIAS (al) WIDTH w_br HEIGHT h_br ; BOLD CELLED ; ON CHANGE Form_oMes.StatusBar.Item(1) := f_corr(1,al) ... Если движение по строкам осуществляется клавиатурой, то все работает нормально, в STATUSBAR'е идет корректное отображение данных функцией f_corr(). Если перемещение производить мышью, указывая строку в TBrowse или использовать колесо прокрутки, то после отработки события ON CHANGE, данные в STATUSBAR'е исчезают, т.е поле очищается. В Browse в аналогичной ситуации все отрабатывает нормально.

Dima: alex_II Глянь пример C:\MiniGUI\SAMPLES\Advanced\Tsb_config\ и функцию FUNCTION MyChangeBrowse Вроде все работает и с мышкой

SergKis: gfilatov2002 Можно чуть поправить ? h_objmisc.prg [pre2] FUNCTION _wPost( nEvent, nIndex, xParam ) ... ENDIF ELSEIF HB_ISCHAR( nIndex ) oWnd := _WindowObj( nIndex ) nIndex := NIL ELSE oWnd := _WindowObj( _HMG_THISFORMNAME ) ENDIF ... FUNCTION _wSend( nEvent, nIndex, xParam ) ... ENDIF ELSEIF HB_ISCHAR( nIndex ) oWnd := _WindowObj( nIndex ) nIndex := NIL ELSE oWnd := _WindowObj( _HMG_THISFORMNAME ) ENDIF ... [/pre2]

gfilatov2002: SergKis пишет: чуть поправить ? h_objmisc.prg OK

SergKis: gfilatov2002 Может есть смысл добавить, что то такое ? [pre2] *-----------------------------------------------------------------------------* FUNCTION _SetWindowThis ( i ) *-----------------------------------------------------------------------------* IF Empty( i ) _PushEventInfo() ELSE IF HB_ISCHAR( i ) i := GetFormIndex( i ) ELSEIF HB_ISOBJECT( i ) i := iif( i:ClassName == 'TSBROWSE', GetFormIndex( i:cParentWnd ), i:Index ) ENDIF _PushEventInfo() _HMG_ThisFormIndex := i _HMG_ThisEventType := '' _HMG_ThisType := 'W' _HMG_ThisIndex := i _HMG_ThisFormName := _HMG_aFormNames [ _HMG_ThisFormIndex ] _HMG_ThisControlName := "" ENDIF RETURN NIL Использовать например так ... IF !IsWindowActive( Form_Client ) DEFINE WINDOW Form_Client ; ... ELSE // !!! так сейчас пишем Form_Client.WIDTH := nWinWidth Form_Client.HEIGHT := nWinHeight Form_Client.Label_0.Value := cVal CENTER WINDOW Form_Client // !!! можем так делать ( это маленький кусочек ) _SetWindowThis( "Form_Client" ) This.WIDTH := nWinWidth This.HEIGHT := nWinHeight This.Label_0.Value := cVal This.CENTER _SetWindowThis() ENDIF [/pre2] Можно DEFINE сделать на ф-ю или команды аналогично IsWindowActive( Form_Client )

gfilatov2002: SergKis пишет: Может есть смысл добавить Благодарю за предложение Это уже идея для новой сборки... А подготовка апрельской сборки уже завершена, и она будет опубликована завтра

SergKis: PS Ошибся. Надо[pre2] IF Empty( i ) _PopEventInfo() ELSE [/pre2]

SergKis: gfilatov2002 пишет Это уже идея для новой сборки... Есть ф-я _SetThisFormInfo (у меня давно исправлена) можно ее использовать [pre2] FUNCTION _SetThisFormInfo ( i ) // стек значений переменных _HMG_This... LOCAL l := .T. // BK 18.05.2015 IF empty( i ) _PopEventInfo() ELSE IF HB_ISCHAR( i ) i := GetFormIndex( i ) l := .F. ELSEIF HB_ISOBJECT( i ) i := iif( i:ClassName == 'TSBROWSE', GetFormIndex( i:cParentWnd ), i:Index ) l := .F. ENDIF _PushEventInfo() _HMG_ThisEventType := iif( l, 'DEFINE_WINDOW', '' ) _HMG_ThisFormIndex := i _HMG_ThisType := _HMG_aFormType [ i ] _HMG_ThisIndex := i _HMG_ThisFormName := _HMG_aFormNames [ i ] _HMG_ThisControlName := "" ENDIF RETURN NIL [/pre2]

gfilatov2002: SergKis пишет: Есть ф-я _SetThisFormInfo (у меня давно исправлена) можно ее использовать Да, использовать/доработать уже существующую функцию, конечно, предпочтительнее. Выполнил предложенные изменения в текущей сборке, контрольный пример отработал правильно. [pre2]_SetThisFormInfo(Form_1.Index) This.Browse_1.ColumnsAutoFitH() This.CENTER This.ACTIVATE _SetThisFormInfo() [/pre2] Благодарю за помощь

gfilatov2002: Опубликована новая сборка 20.04 для BCC 5.8.2 и компиляторов Harbour и xHarbour. Базовый дистрибутив находится по адресу http://hmgextended.com/files/CONTRIB/hmg-20.04-setup.exe Добавил также архив для бесплатного Embarcadero C++ 10.2 'Tokyo' compiler http://hmgextended.com/files/CONTRIB/hmg2004_bcc102.exe Для частного использования подготовлены еще два дистрибутива: Harbour MiniGUI Extended Edition 20.04 (Release) Harbour 3.2.0dev (r2004201301) Harbour Make (hbmk2) 3.2.0dev (r2020-04-20 13:01) gcc (MinGW-W64 i686-posix-sjlj, built by Brecht Sanders) 9.3.0 и Harbour MiniGUI Extended Edition 20.04 (Release) (64-bit) Harbour 3.4.0dev (64-bit) (2017-12-20 13:40) Harbour Make (hbmk2) 3.4.0dev (64-bit) (2017-12-20 13:40) gcc (GCC) 9.2.0 (64-bit) доступ к которым открыт для всех, кто поддержал выпуск этой сборки материально.

Dima: gfilatov2002 пишет: доступ к которым открыт для всех, кто поддержал выпуск этой сборки материально. Там Forbidden.......подождем пока отвалится ЗЫ Социнжиниринг помог добраться куда надо :)

Andrey: Отличная новость ! А Микрософтный компилятор где ? Я уже с ним вожусь потихоньку. Мигрировать на него собираюсь.

SergKis: gfilatov2002 пишет Выполнил предложенные изменения в текущей сборке, Вариант _SetThisFormInfo() остался старый в последней сборке

gfilatov2002: SergKis пишет: остался старый в последней сборке Да, решил, что это подождет до следующего релиза Добавил также новую команду: #xtranslate SET WINDOW THIS TO [<w>] => _SetThisFormInfo( [<w>] ) Еще раз благодарю за Ваши идеи

SergKis: gfilatov2002 пишет Да, решил, что это подождет до следующего релиза Добавил также новую команду: Сделал эти изменения в MiniGuiBcc58, MiniGuiBcc102. Проверил сборку lib. Все либы собрались. Примеры Tsb_array_2 все отработали в обоих bcc. Пример с командой то же [pre2] ... LOCAL oThis, cForm := "Form_Client" ... IF !_IsWindowActive( cForm ) DEFINE WINDOW &cForm ; ... ELSE SET WINDOW THIS TO cForm oThis := This.Object This.WIDTH := nWinWidth This.HEIGHT := nWinHeight This.Label_0.Value := cVal This.CENTER SET WINDOW THIS TO ENDIF ... [/pre2] Спасибо все работает

gfilatov2002: SergKis пишет: все работает Благодарю за подтверждение

gfilatov2002: Andrey пишет: Микрософтный компилятор где ? Свежий архив для этого компилятора положил в папку PRIVATE на сайте библиотеки (имя архива не изменял). Harbour Build Info --------------------------- Version: Harbour 3.2.0dev (r2002101434) Compiler: Microsoft Visual C++ 19.24.28319 (32-bit) Platform: Windows 10 10.0 PCode version: 0.3 ChangeLog last entry: 2020-02-10 15:34 UTC+0100 Aleksander Czajczynski (hb fki.pl) ChangeLog ID: 123475ab11ba031e8b9c88138f2f0b24e4327e54 Built on: Mar 12 2020 10:55:14 Extra Harbour compiler options: -gc0 Extra C compiler options: -DHB_GC_AUTO -DHB_GUI -DHB_NO_TRACE Build options: (C++ mode) (Clipper 5.3b) (Clipper 5.x undoc)

Andrey: gfilatov2002 пишет: Свежий архив для этого компилятора положил в папку PRIVATE на сайте библиотеки (имя архива не изменял). Спасибо БОЛЬШОЕ, но не могу найти где брать. Предыдущие ссылки не работают. Если не трудно, прошу отправить ссылки мне на почту.

gfilatov2002: Andrey пишет: прошу отправить ссылки мне на почту Отправил ссылку по почте

Andrey: gfilatov2002 пишет: Отправил ссылку по почте Спасибо БОЛЬШОЕ !

SergKis: gfilatov2002 Правка (в первой колонке oCol:nWidth всегда NIL получается) [pre2] METHOD LoadFields( lEditable, aColSel, cAlsSel, aNameSel, aHeadSel ) CLASS TSBrowse ... cBlock := 'FieldWBlock("' + aStru[ nE, 1 ] + '",Select("' + cAlias + '"))' ::AddColumn( TSColumn():New( cHeading, FieldWBlock( aStru[ nE, 1 ], Select( cAlias ) ),cPicture, ; { ::nClrText, ::nClrPane }, { nAlign, DT_CENTER }, nSize,, lEditable,,, cOrder,,,, ; 5,,,, Self, cBlock ) ) IF ATail( ::aColSizes ) == NIL ::aColSizes[ Len( ::aColSizes ) ] := nSize ENDIF cName := ( cAlias )->( FieldName( nE ) ) ... [/pre2]

SergKis: PS Изменение лучше сделать тут [pre2] METHOD AddColumn( oColumn ) CLASS TSBrowse ... If Len( ::aColSizes ) < Len( ::aColumns ) AAdd( ::aColSizes, oColumn:nWidth ) EndIf If ATail( ::aColSizes ) == NIL ::aColSizes[ Len( ::aColSizes ) ] := oColumn:nWidth ENDIF If ::aPostList != Nil // from ComboWBlock function ... [/pre2]

gfilatov2002: SergKis пишет: лучше сделать тут Добавил, конечно. Благодарю за помощь

Andrey: И вот эту ошибку тоже бы убрать: Error BASE/2017 Argument error: AEVAL Args: [1] = U [2] = B {|| ... } --------------------------------- Stack Trace --------------------------------- Called from AEVAL(0) Called from MAIN(53) in module: demo5.prg Делаю так: [pre2]aHead := NIL ?v aHead[/pre2] Пускай NIL возвращает, а то прога валится.

SergKis: Можно так поправить i_ini.ch[pre2] #command ?a [<arr>] => If( <arr> == NIL, , aEval( <arr>, { |xv, ne| _LogFile( (ne==1), ne, xv ), _LogFile() } ) ) #command ?v [<arr>] => If( <arr> == NIL, , aEval( <arr>, { |xv, ne| _LogFile( (ne==1), ne, iif( Valtype(xv) == "A", hb_valtoexp(xv), xv ) ), _LogFile() } ) ) [/pre2]

Andrey: SergKis пишет: Можно так поправить i_ini.ch Поправил, теперь ошибки нет и результата в _MsgLog.txt нет. Будешь гадать почему нет [pre2] ?v aHead[/pre2]

SergKis: Andrey пишет теперь ошибки нет и результата в _MsgLog.txt нет. Так применяй правильно ? "aSize =", aSize ?v aSize Ошибки нет и занятого места тоже в лог файле aSize = NIL

Andrey: SergKis пишет: Так применяй правильно Понял !

SergKis: gfilatov2002 Может чуток подправим ? [pre2] METHOD LoadFields( lEditable, aColSel, cAlsSel, aNameSel, aHeadSel ) CLASS TSBrowse ... Local cTmp, cHead, hFontH ... hFont := iif( ::hFont != Nil, ::hFont, 0 ) hFontH := iif( ::hFontHead != Nil, ::hFontHead, ::hFont ) If cType == "C" ... nSize := Max( GetTextWidth( 0, Replicate( "B", Len( cHeading )+1 ), hFontH ), nSize ) nSize += iif( ! Empty( cOrder ), 14, 0 ) ElseIf ValType( ::aColSizes ) == "A" .and. ! Empty( ::aColSizes ) .and. n <= Len( ::aColSizes ) ... [/pre2]

gfilatov2002: SergKis пишет: чуток подправим Поправил, конечно. Благодарю за помощь

SergKis: gfilatov2002 Предложение по ENUMERATOR для нумерации только видимых колонок. :lEnum := .F. меняет цвет, align. Словом не подошел. Простое решение при :lEnum := .T. [pre2] METHOD DrawHeaders( lFooters ) CLASS TSBrowse ... Local nDeltaLen, uTmp ... IF ::lDrawSpecHd ... if ::lEnum cHeading := hb_ntos( nJ - iif( ::lSelector, 1, 0 ) ) IF ! empty( oColumn:cSpcHeading ) uTmp := iif( Valtype( oColumn:cSpcHeading ) == "B", Eval( oColumn:cSpcHeading, nJ, Self ), oColumn:cSpcHeading ) IF HB_ISNUMERIC ( uTmp ) ; cHeading := hb_ntos( uTmp ) ELSEIF HB_ISCHAR( uTmp ) ; cHeading := uTmp ENDIF ENDIF if nI == nBegin .and. ::lSelector .or. nI == nLastCol cHeading := "" endif else ... Применение ... mySetTsb( oBrw ) myColorTsb( oBrw ) // цвета на таблицу myColorTsbElect( oBrw ) // цвета избранные myDbfDelColTsb( oBrw ) myEnumTsb( oBrw ) mySet2Tsb( oBrw ) :bOnEscape := {|ob| DoMethod(ob:cParentWnd, "Release") } // выход по ESC END TBROWSE ON END {|ob| ob:SetNoHoles(), ob:SetFocus() } ... STATIC FUNCTION myEnumTsb( oBrw ) LOCAL oCol, nCnt := 0 FOR EACH oCol IN oBrw:aColumns oCol:cSpcHeading := NIL IF oCol:lVisible oCol:cSpcHeading := hb_ntos( ++nCnt ) ENDIF NEXT RETURN NIL ... [/pre2] Т.е. если убрать myDbfDelColTsb( oBrw ) // myEnumTsb( oBrw ) mySet2Tsb( oBrw ) будет первоначальный алгоритм При отработке ф-ии будет нумерация только видимых колонок У Андрея есть пример, если что ...

gfilatov2002: SergKis пишет: Предложение по ENUMERATOR для нумерации только видимых колонок. Принято, конечно.

SergKis: gfilatov2002 Сделал изменения в TsBrowse (изменения в прилагаемом файле h_tbrowse.prg) [pre2] CLASS TSColumn DATA oCell // TSBcell object ... это только места обозначены CLASS TSBcell ... CLASS TSBrowse FROM TControl DATA lDrawLine AS LOGICAL INIT .T. // flag for cells row drawing ... METHOD DrawLine( xRow, lDrawCell ) CLASS TSBrowse ... If ::bOnDrawLine != Nil Eval( ::bOnDrawLine, Self ) EndIf IF ! ::lDrawLine nBegin := 1 nLastCol := ::nColCount() ENDIF For nI := nBegin To nLastCol If nStartCol >= nMaxWidth .and. ::lDrawLine Exit EndIf ... IF ::lDrawLine oColumn:oCell := NIL TSDrawCell( hWnd, ; // 1 ... ELSE oColumn:oCell := TSBcell():New() ... ENDIF ... METHOD DrawSelect( xRow, lDrawCell ) CLASS TSBrowse ... nBegin := Min( iif( ::nColPos <= ::nFreeze, ( ::nColPos := ::nFreeze + 1, ::nColPos - ::nFreeze ), ; ::nColPos - ::nFreeze ), nLastCol ) IF ! ::lDrawLine nBegin := 1 nLastCol := ::nColCount() ENDIF For nI := nBegin To nLastCol If nStartCol >= nMaxWidth .and. ::lDrawLine Exit EndIf ... If lDrawCell .and. ::lDrawLine lDraw := TSDrawCell( hWnd, ; // 1 ... Else lDraw := .T. IF ! ::lDrawLine oColumn:oCell := TSBcell():New() ... ENDIF ... [/pre2] Суть изменений получить все данные, которые получаются в :DrawLine() и :DrawSelect() для передачи в ф-ю TSDrawCell(...) рисования строки. Не стал сокращать список параметров для класса TSBcell оставил все параметры. Применение (в примерах прилагаются, нажатие кнопки F8 формирует _MsgLog.txt) такое [pre2] STATIC FUNCTION my0( oBrw ) LOCAL nAt, nCol, oCol, oCel WITH OBJECT oBrw :GoTop() :DrawSelect() ? "-", :lDrawLine, :nRowPos, :aColumns[2]:oCell, :aDrawCols :lDrawLine := .F. :GoTop() :DrawSelect() ? "#", :lDrawLine, :nRowPos, :aColumns[2]:oCell, :aDrawCols :DrawLine() FOR nAt := 1 TO :nLen ? nAt, :aColumns[2]:oCell FOR nCol := 1 TO :nColCount() oCol := :aColumns[ nCol ] oCel := oCol:oCell ? ".", oCol:lVisible, nCol, oCel:nStartCol, oCol:cName, oCel:nAlign, oCel:nClrFore, oCel:nClrBack, oCel:uData NEXT :GoDown() NEXT ? :lDrawLine := .T. :Reset() END WITH RETURN Nil Запуск demo5.exe // работа с массивом demo5.exe * // работа с emploee.dbf demo7.exe // работа с AbonItogo.dbf (файл и раскраска от Андрея) [/pre2] Должно облегчить работу с Excel, наверное PS В h_tbrowse.prg есть изменения связанные с отступами слева, справа, которые мы обсуждали с Игорем в теме "Курсы ЦБ на дату" это prg моей версии. В примере demo5 есть установка :nCellMarginLR := 1 Примеры и h_tbrowse.prg тут https://TransFiles.ru/eicsv

Haz: Эти изменения отключают или включают прорисовку?

SergKis: Отключают, т.е. при :lDrawLine == .F. нет вывода на экран

SergKis: PS :aDrawCols - это массив номеров колонок, которые на рисовались окне, формируется массив в :DrawLine()

SergKis: PSформируется массив в :DrawLine() Пальцы на автомате, набрали, надо не :DrawLine(), а DrawSelect()

Haz: Если практическое использование - пробежаться по бровсу не тратя время на экранный вывод, то в случае с dbf можно проще [pre2] nRec := (oBrw:cAlias)->(RecNo()) while !(oBrw:cAlias)->( Eof()) for n := 1 To Len( oBrw:aColumns ) Eval( oBrw:aColumns[n]:bData) end (oBrw:cAlias)->(dbSkip(1)) end (oBrw:cAlias)->(dbGoTo(nRec)) [/pre2] пробежимся по всем строкам и столбцам и прописовки не будет

SergKis: Haz пишет пробежимся по всем строкам и столбцам и прописовки не будет В таком варианте 1. Eval( oBrw:aColumns[n]:bData) не учитывает oBrw:aColumns[n]:bValue и особенно :bDecode, использую широко, т.е. надо Brw:GetValue( n ) или oBrw:bDataEval(oCol ,[xVal], nCol) 2. нет цветов фона и текста в такой реализации (получаются из блоков кода от значения данных в cell), для Excel это может быть важно 3. для массива и dbf надо писать разный код Можно, конечно писать, повторив часть кода из метода :DrawLine(), как сейчас и делали. В моем предложении все данные на ячейку в TSBcell объкте по адресу oBrw:aColumns[ n ]:oCell, т.е. надо используем, нет то как раньше

Haz: SergKis пишет: В моем предложении все данные на ячейку в TSBcell объкте по адресу oBrw:aColumns[ n ]:oCell, т.е. надо используем, нет то как раньше Сергей , да я не против твоей доработки. В простых задачах она пригодиться. Я же в проектах не смогу ее использовать по следующим причинам. 1. Редко когда использую простой бровс, как правило есть несколько подчиненных обновляемых по bChange (есть и bOnDraw ) и тупить прогон по бровсу будет не из-за прорисовки Можно отключать bChange при прогоне, а потом включать , но зачем ( см п 3 ) 2. Выгрузку в Excel через OLE не делаю совсем т.к. много отчетов объемных более 1000 строк и 50 и более колонок и через олю на отчеты тратится неприемлемое время Все отчеты только через XMLXLS . по скорости 20 минут это оля и 15 секунд xml Цвета и текст задаю заранее для xml 3. Как уже писал ранее ,при помощи Андрею в его TSB_экспортах - считаю такие экспорты (средствами бровса) красивыми, но бесперспективными с точки зрения временных затрат Бровс умеет работать только с текущей записью , зачем мне тормозной перебор если я могу взять весь массив данных сразу и делать с ним что хочу (aEval, dbEval, SQLExecute() и пр) . В целом , для демонстрашки экспорта доработка хорошая, практически не знаю зачем

gfilatov2002: SergKis пишет: Сделал изменения в TsBrowse (изменения в прилагаемом файле h_tbrowse.prg) Обязательно проанализирую и включу эти изменения в новую сборку (с учетом Вашего мнения и мнения Игоря, как главных разработчиков дополнений к TSBrowse). Благодарю за Вашу помощь

SergKis: Haz пишет практически не знаю зачем Согласен, много случаев, особенно старых кодов, где это не применить, да и не нужно. А вывести в Excel таблицу (широкую, но простую), с цветными колонками, для которой печати нет (морока организации листов в разрезе горизонтали) есть передача в Excel и если захотят, будут распечатки делать из него. Условие сохранение цветности. С применением hbxmlxls.lib чтобы передать цветность это тоже пригодится. Бровс умеет работать только с текущей записью , зачем мне тормозной перебор Можно не перебирать, а выполнить :DrawLine( , .F. ) и для тек. записи будет в колонках oCol:oCell заполнен

Haz: SergKis пишет: Можно не перебирать, а выполнить :DrawLine( , .F. ) и для тек. записи будет в колонках oCol:oCell заполнен Как дальнейшее развитие oCell имеет смысл

SergKis: SergKis пишет Можно не перебирать, а выполнить :DrawLine( , .F. ) Игорь, хорошо, что спросил. Начал еще раз проверять, параметр ввел, а исправить перенос из :DrawSelect() на эту переменную забыл gfilatov2002 Правочка небольшая с выше сказанным на мой текст [pre2] METHOD DrawLine( xRow, lDrawCell ) CLASS TSBrowse ... Default xRow := iif( ::lDrawHeaders, Max( 1, nRowPos ), nRowPos ), lDrawCell := ::lDrawLine ... If ::bOnDrawLine != Nil Eval( ::bOnDrawLine, Self ) EndIf IF ! lDrawCell nBegin := 1 nLastCol := ::nColCount() ENDIF For nI := nBegin To nLastCol If nStartCol >= nMaxWidth .and. lDrawCell Exit EndIf ... IF nAlign != DT_CENTER .and. ::nCellMarginLR != NIL uData := ::CellMarginLeftRight( nJ, uData, oColumn, nAlign, lMultiLine, 0 ) ENDIF IF lDrawCell oColumn:oCell := NIL TSDrawCell( hWnd, ; // 1 ... [/pre2]

gfilatov2002: gfilatov2002 пишет: включу эти изменения в новую сборку Выполнил все предложенные изменения кода, пересобрал пример demo5 - экспорт по клавише F8 работает аналогично готовому экзешнику

SergKis: gfilatov2002 Если брали целиком мой файл h_tsbrowse.prg в нем надо убрать строки (была проба и не убрал)[pre2] FUNCTION _DefineTBrowse( ControlName, ParentFormName, nCol, nRow, nWidth, nHeight, ; ... oBrw:InsColumn( nColNumber, oCol ) IF oBrw:lDrawFooters oBrw:aColumns[ nColNumber ]:cFooting := "" ENDIF oBrw:nCell := nColNumber + 1 oBrw:nFreeze := nColNumber oBrw:lLockFreeze := .T. ... [/pre2]

gfilatov2002: SergKis пишет: надо убрать строки Убрал, конечно

Andrey: Haz пишет: 3. Как уже писал ранее ,при помощи Андрею в его TSB_экспортах - считаю такие экспорты (средствами бровса) красивыми, но бесперспективными с точки зрения временных затрат Бровс умеет работать только с текущей записью , зачем мне тормозной перебор если я могу взять весь массив данных сразу и делать с ним что хочу (aEval, dbEval, SQLExecute() и пр) . В целом , для демонстрашки экспорта доработка хорошая, практически не знаю зачем Если бы такие красивые отчеты нужны были каждый день, то согласен, делал бы НЕ через ОЛЮ. А так раз в месяц, а то и три нужен красивый отчёт начальству. Не буду я тратить время на это, пускай 20 минут ждут, хотя у меня быстрей проходит. Есть готовая фишка в МиниГуи - красивый экспорт, пускай работает.

gfilatov2002: Подготовил 2-ю бету для новой сборки 20.05. Что нового [pre2] * New: Added a new command for managing of the 'This' property at runtime: SET WINDOW THIS TO [<w>] where <w> may be a Form Name or a Form Index. Sample code: DEFINE WINDOW Form_1 ... @ 10,10 BROWSE Browse_1 ... END WINDOW ... Set Window This To "Form_1" // set a new 'This' property This.Browse_1.ColumnsAutoFit() This.Center() This.Activate() Set Window This To // restore a previous 'This' property Suggested and contributed by Sergej Kiselev. * Enhanced: Added support of the PICTURE option to format the columns in the Browse control. Contributed by Jan Szczepanik <jan-szczepanik/at/wp.pl> (see demo in folder \samples\Basic\BROWSE_PICTURE) * Enhanced: The SplitButton control may be placed now in the TAB container. Requested by Ivanil Marcelino <ivanil/at/linkbr.com.br>. Contributed by Grigory Filatov <gfilatov@inbox.ru> * Updated: PropGrid library v.2.0 (see source in folder \source\PropGrid): - Fixed: Bug in a Masked Float (double) item handling. Reported by Ivanil Marcelino <ivanil/at/linkbr.com.br>. Contributed by Grigory Filatov <gfilatov@inbox.ru> (see demo3.prg in folder \samples\Advanced\PropGrid) * Updated: Adaptation FiveWin Class TSBrowse 9.0 in HMG: - a minor correction in the method :AddColumn(); - added ENUMERATOR correction for numbering of the visible columns only. Usage: nCnt := 1 FOR EACH oCol IN oBrw:aColumns oCol:cSpcHeading := NIL IF oCol:lVisible oCol:cSpcHeading := hb_ntos( nCnt++ ) ENDIF NEXT - added the new variable :lDrawLine in the TSBrowse class and the new variable :oCell in the TSColumn class; - enhanced auxiliary class TSBcell for a quick export of a data; - added the new variable :nCellMarginLR and the new method CellMarginLeftRight() in the TSBrowse class. Contributed by Sergej Kiselev (see demo5.prg in folder \samples\Advanced\Tsb_Array_2) * Updated: HbSQLite3 library: - update for using SQLITE3 latest version 3.32.0dev. Contributed by Grigory Filatov <gfilatov@inbox.ru>. * Updated: '7-Zip interaction' sample by Vladimir Chumachenko: - the russian comments were replaced with an english translation. Contributed by Anand K Gupta (see in folder \samples\Advanced\7-Zip) [/pre2]Если заметили неточности в этом описании - пишите, исправлю...

Andrey: А нельзя в новой версии сделать правильное отображение символьных полей при задании центровки DT_CENTER ? Не работает центровка сейчас ! Чтобы заработало, нужно шаманство делать, благо без бубна...

SergKis: Andrey пишет А нельзя в новой версии сделать правильное отображение символьных полей при задании центровки DT_CENTER ? Не работает центровка сейчас ! Центровка работает, но мешает центровать, как ты хочешь правые пробелы. Если их убирать ( trim() или alltrim ? ), то "сломается" отображение старого алгоритма, т.е. значение "1 " в колонке 120 шириной отобразится по другому. Так же сломаться может отображение строк с CRLF. Сейчас решаю задавая oCol:bDecode := {|cval| Alltrim(cval) }

Andrey: SergKis пишет: Сейчас решаю задавая oCol:bDecode := {|cval| Alltrim(cval) } Это я понял. Спасибо ! Не работает цвет в суперхидере. Делаю цвет в таблице:[pre2] :Setcolor( { 3}, { CLR_WHITE } ) // 3 , текста шапки таблицы :SetColor( { 4}, { { || { CLR_BLACK, CLR_GRAY } } } ) // 4 , фона шапка таблицы :SetColor( {16}, { { || { CLR_BLACK, CLR_GRAY } } } ) // 16, фона спецхидер :SetColor( {17}, { { || CLR_YELLOW } } ) // 17, текста спецхидер[/pre2] Вот результат:

SergKis: Andrey Как он может работать, если цвета ставишь на него, раньше, чем создаешь SuperHeader [pre2] mySetTsb( oBrw ) // настройки таблицы myColorTsb( oBrw ) // цвета на таблицу myColorTsbElect( oBrw ) // цвета избранные mySumTsb ( oBrw ) // суммирование колонок таблицы myDbfDelColTsb( oBrw ) // убрать колонки из отображения mySupHdTsb( oBrw, aSupHd ) // SuperHeader myEnumTsb( oBrw ) // ENUMERATOR по порядку mySet2Tsb( oBrw ) // настройки таблицы [/pre2]

Andrey: SergKis пишет: Как он может работать, если цвета ставишь на него, раньше, чем создаешь SuperHeader Ну вот так и бывает...

Haz: Andrey пишет: Не буду я тратить время на это Каждому своё. Я лучше один раз потрачу тк мне неприемлемо когда отчёта нужно ожидать больше нескольких секунд. Что касается "пусть будет", то я и не говорил что эти доработки нужно убрать. Я говорил только о том, что для серьёзных объёмов есть другой инструмент, который в отличии от кривого Ole экспорта работает всегда и позволяет любые цвета и шрифт.

SergKis: gfilatov2002 Предложение по hmg_alert(), AlertInfo() и др. - hmg_alert() значение nIcoSize сделать равным 0, тогда на окне нет DRAW ICO ... - в AlertInfo(), AlertExclamation(), AlertStop() добавить параметр lNoPlay, для отключения звук. сигнала Alert.prg [pre2] ... *-----------------------------------------------------------------------------* FUNCTION AlertExclamation ( Message, Title, Icon, nSize, aColors, lTopMost, bInit, lNoPlay ) *-----------------------------------------------------------------------------* LOCAL nWaitSec IF ISNUMERIC( Title ) nWaitSec := Title ENDIF IF Empty( lNoPlay ) ; PlayExclamation() ENDIF RETURN _Alert( Message, nWaitSec, hb_defaultValue( Title, _HMG_MESSAGE [10] ), , , Icon, nSize, aColors, lTopMost, bInit ) *-----------------------------------------------------------------------------* FUNCTION AlertInfo ( Message, Title, Icon, nSize, aColors, lTopMost, bInit, lNoPlay ) *-----------------------------------------------------------------------------* LOCAL nWaitSec IF ISNUMERIC( Title ) nWaitSec := Title ENDIF IF Empty( lNoPlay ) ; PlayAsterisk() ENDIF RETURN _Alert( Message, nWaitSec, hb_defaultValue( Title, _HMG_MESSAGE [11] ), ICON_INFORMATION, , Icon, nSize, aColors, lTopMost, bInit ) *-----------------------------------------------------------------------------* FUNCTION AlertStop ( Message, Title, Icon, nSize, aColors, lTopMost, bInit, lNoPlay ) *-----------------------------------------------------------------------------* LOCAL nWaitSec IF ISNUMERIC( Title ) nWaitSec := Title ENDIF IF Empty( lNoPlay ) ; PlayHand() ENDIF RETURN _Alert( Message, nWaitSec, hb_defaultValue( Title, _HMG_MESSAGE [12] ), ICON_STOP, , Icon, nSize, aColors, lTopMost, bInit ) ... [/pre2] По поводу - added the new variable :lDrawLine in the TSBrowse class Добавил "быстрого" доступа к элементам тсб, SuperHeader, Header, SpecHd, DrawLine и Footer. В TsColumn.prg добавил переменные [pre2] DATA oCellHead // TSBcell object Header DATA oCellEnum // TSBcell object Enumerator DATA oCellFoot // TSBcell object Footer DATA oCell // TSBcell object [/pre2] В h_tbrowse.prg правил METHOD DrawSuper( lDrawCell ) CLASS TSBrowse METHOD DrawHeaders( lFooters, lDrawCell ) CLASS TSBrowse METHOD DrawLine( xRow, lDrawCell ) CLASS TSBrowse METHOD DrawSelect( xRow, lDrawCell ) CLASS TSBrowse CLASS TSBcell Исходники и пример по использованию тут https://TransFiles.ru/vpnu8 в demo7 работают клавиши F8 - общий способ доступа для массива и dbf, использован "родной" вариант AlertInfo() F9 - только доступ для dbf, использован вариант AlertInfo() с nIcoSize := 0 и lNoPlay := .T.

gfilatov2002: SergKis пишет: Предложение по hmg_alert(), AlertInfo() и др. ... Добавил "быстрого" доступа к элементам тсб, SuperHeader, Header, SpecHd, DrawLine и Footer. Все правки приняты - хорошая работа. Благодарю за помощь

SergKis: gfilatov2002 Еще такая правка[pre2] CLASS TSBrowse FROM TControl ... ACCESS IsEdit INLINE ! Empty( ::aColumns[ ::nCell ]:oEdit ) // SergKis addition ACCESS Tsb INLINE ::oWnd ... FUNCTION GetProperty ( Arg1 , Arg2 , Arg3 , Arg4 , Arg5 , Arg6 , Arg7 ) ... #ifdef _OBJECT_ CASE Arg3 == "OBJECT" IF _HMG_lOOPEnabled RetVal := _ControlObj ( Arg2 , Arg1 ) IF HB_ISOBJECT( RetVal ) .and. _HMG_aControlType[ RetVal:Index ] == "TBROWSE" RetVal := _HMG_aControlIds[ RetVal:Index ] ENDIF ELSEIF ( ix := GetControlIndex ( Arg2 , Arg1 ) ) > 0 IF _HMG_aControlType[ ix ] == "TBROWSE" RetVal := _HMG_aControlIds[ ix ] ENDIF ENDIF #endif ... Синим цветом, наверно, надо убрать Это даст возможность получать объект TSBROWSE, как SET OOP ON, так и SET OOP OFF ? (This.oBrw.Object):ClassName // SET OOP OFF ? (This.oBrw.Object):Tsb:ClassName // SET OOP ON\OFF [/pre2]

gfilatov2002: SergKis пишет: наверно, надо убрать Предлагаю не убирать, но - передвинуть SergKis пишет: CASE Arg3 == "OBJECT" IF _HMG_lOOPEnabled #ifdef _OBJECT_ RetVal := _ControlObj ( Arg2 , Arg1 ) IF HB_ISOBJECT( RetVal ) .and. _HMG_aControlType[ RetVal:Index ] == "TBROWSE" RetVal := _HMG_aControlIds[ RetVal:Index ] ENDIF #endif ELSEIF ( ix := GetControlIndex ( Arg2 , Arg1 ) ) > 0 IF _HMG_aControlType[ ix ] == "TBROWSE" RetVal := _HMG_aControlIds[ ix ] ENDIF ENDIF

SergKis: gfilatov2002 Добавить в i_this.ch[pre2] ... #xtranslate This . <c> . <p:Names> => HMG_GetFormControls ( _HMG_THISFORMNAME , <(c)> ) #xtranslate This . <c> . <p:ClientWidth> => _GetClientRect ( GetControlHandle ( <(c)> , _HMG_THISFORMNAME ) ) \[3] [/pre2] Использовать aAll := This.All.Names ? "All controls name =", aAll ?v aAll ? aTsb := This.TBrowse.Names ? "TBrowse =", aTsb ?v aTsb ? aBtn := This.Button.Names ? "Button =", aBtn ?v aBtn ? aBtn := This.ButtonEx.Names ? "ButtonEx =", aBtn ?v aBtn ? В функциях примера demo7 можно заменить переменную ao на ac[pre2] AlertInfo( hb_memoread(_SetGetLogFile()), "INFO", , 0, , , ; {||ac,cn| // {|ao,cn| an := This.EditBox.Names // ao := (This.Object):GetObj4Type("EDITBOX") If HB_ISARRAY(an) .and. Len(an) == 1 // If HB_ISARRAY(ao) .and. Len(ao) == 1 cn := an[1] // ao[1]:Name This.Width := test.ClientWidth * 0.95 This.(cn).Row := 10 This.(cn).Col := 10 This.(cn).Width := This.ClientWidth - 10 * 2 This.(cn).Height := This.(cn).Height + 10 * 2 + 10 This.Center EndIf Return Nil } , .T. ) // .T. - lNoPlay [/pre2]

SergKis: PS Добавить еще[pre2] #xtranslate ThisWindow . <p:Names,Controls> => HMG_GetFormControls ( _HMG_THISFORMNAME , "ALL" ) ... #xtranslate This . <p:Names,Controls> => HMG_GetFormControls ( _HMG_THISFORMNAME , "ALL" ) ... [/pre2]

SergKis: gfilatov2002 Правка [pre2] METHOD AddColumn( oColumn ) CLASS TSBrowse ... If ATail( ::aColSizes ) == NIL .and. Len( ::aColSizes ) > 0 ::aColSizes[ Len( ::aColSizes ) ] := oColumn:nWidth ENDIF If ::aPostList != Nil // from ComboWBlock function ... [/pre2]

gfilatov2002: SergKis пишет: Правка OK

SergKis: gfilatov2002 По HMG_ALert(...), добавить static переменную для кол-сток, сейчас стоит константа 20 [pre2] STATIC aBackColor, aFontColor STATIC s_nMaxLineas := 20 *-----------------------------------------------------------------------------* FUNCTION HMG_Alert_MaxLineas( nMaxLineas ) *-----------------------------------------------------------------------------* IF HB_ISNUMERIC(nMaxLineas ) .and. nMaxLineas > 0 s_nMaxLineas := nMaxLineas ENDIF RETURN s_nMaxLineas ... STATIC FUNCTION FillDlg( cMsg, aOptions, nLineas, cIcoFile, nIcoSize, aBtnColors, bBlock, lClosable, cFont ) ... LOCAL lExt LOCAL nMaxLineas := HMG_Alert_MaxLineas() ... nWidthDlg := nWidthCli + GetBorderWidth() + iif( nLineas > nMaxLineas, MARGIN * 1.5, 0 ) nHeightCli := ( ( Min( nMaxLineas, nLineas ) + iif( nLineas == 1, 4, 3 ) ) * nChrHeight ) + nVMARGIN_BUTTON + nHeightBtn + GetBorderHeight() ... IF nLineas > 1 IF nLineas > nMaxLineas n := 1 cLblName := "Say_" + StrZero( n, 2 ) @ nChrHeight + GetBorderHeight(), nCol ; EDITBOX (cLblName) VALUE AllTrim( cMsg ) OF (cForm) ; FONT cFont WIDTH nWidthCli - nCol + iif( nLineas < 25, 0.9, 1 ) * MARGIN ; HEIGHT nChrHeight * nMaxLineas + GetBorderHeight() ; FONTCOLOR aFontColor BACKCOLOR aBackColor READONLY NOHSCROLL ELSE ... FOR n := nLenaOp TO 1 STEP -1 This.( aBut[ n ] ).Row := nHeightCli + SEP_BUTTON + GetBorderHeight() / iif( lIsWin10, 2.5, .9 ) - nChrHeight - nHeightBtn This.( aBut[ n ] ).Col := nWidthCli + iif( nLineas > nMaxLineas, MARGIN * 1.5, 0 ) + iif( lIsWin10, 0, GetBorderWidth() / 2 ) - ( nMaxBoton + SEP_BUTTON ) * nOpc++ NEXT n ... [/pre2] Что бы управлять высотой окна

gfilatov2002: SergKis пишет: добавить static переменную... Что бы управлять высотой окна Добавил, конечно. Но переименовал функцию в HMG_Alert_MaxLines() Благодарю за помощь

SergKis: gfilatov2002 Немного подкрутил h_alert.prg для контроля выхода за пределы экрана по width. Вот, что получилось. Пример и исходник тут https://TransFiles.ru/mowhr Можно поиграть размером фонта DEFINE FONT DlgFont FONTNAME "Courier New" SIZE _HMG_DefaultFontSize + 1 DEFINE FONT DlgFont FONTNAME "Courier New" SIZE _HMG_DefaultFontSize DEFINE FONT DlgFont FONTNAME "Courier New" SIZE _HMG_DefaultFontSize - 1 DEFINE FONT DlgFont FONTNAME "Courier New" SIZE _HMG_DefaultFontSize - 2

gfilatov2002: SergKis пишет: подкрутил h_alert.prg для контроля выхода за пределы экрана Эти изменения не приняты по причине увеличения ширины окон Alert* в примере из папки samples\Basic\WALERT_2 Изменения в файле h_alert.prg не должны приводить к изменению вида обычных окон (совместимость снизу вверх)

SergKis: gfilatov2002 пишет изменения не приняты по причине увеличения ширины окон Alert* Очень не хочется писать лишний блок кода bInit. Может такие поправки помогут[pre2] STATIC s_nMaxLineas := 20 STATIC s_lMaxWidth := .F. *-----------------------------------------------------------------------------* FUNCTION HMG_Alert_MaxLines( nMaxLineas, lMaxWidth ) *-----------------------------------------------------------------------------* IF HB_ISNUMERIC(nMaxLineas ) .and. nMaxLineas > 0 s_nMaxLineas := nMaxLineas ENDIF IF HB_ISLOGICAL( lMaxWidth ) s_lMaxWidth := lMaxWidth ENDIF RETURN s_nMaxLineas ... STATIC FUNCTION FillDlg( cMsg, aOptions, nLineas, cIcoFile, nIcoSize, aBtnColors, bBlock, lClosable, cFont, nMaxLen ) ... LOCAL nMaxLineas := HMG_Alert_MaxLines() LOCAL lMaxWidth := s_lMaxWidth LOCAL nMaxWidth := 0 ... nChrHeight := GetTextHeight( hDC, aOptions[ 1 ], hDlgFont ) + nVMARGIN_BUTTON / 2 // calculate the maximum width of the lines IF lMaxWidth nMaxWidth := GetFontWidth ( cFont, nMaxLen ) ENDIF FOR n := 1 TO nLineas ... [/pre2]

SergKis: PS В примере demo7.prg ставим HMG_Alert_MaxLines(23, .T.)

gfilatov2002: SergKis пишет: такие поправки помогут Да, с этими изменениями примеры не отличаются

SergKis: gfilatov2002 пишет Да, с этими изменениями примеры не отличаются В примере BASIC\WALERT_2 надо, наверно, учесть вылезание списка ошибок за пределы descktop при фонте 16 на 14" мониторе (кнопку почти не видно), т.е. надо ставить ограничение по высоте [pre2] DEFINE FONT DlgFont FONTNAME "DejaVu Sans Mono" SIZE 16 SET MSGALERT FONTCOLOR TO BLACK SET MSGALERT BACKCOLOR TO {248,209,211} cMsg := "" aButton := { "&Continue" } cTitle := "Multiline Error Message" cIcoRes := "Stop64.ico" nIcoSize := 64 aBtnColor := { {235,117,121} } FOR nI := 1 TO 99 cMsg += "Error: " + HB_NtoS( nI ) + " simple error message.;" NEXT HMG_Alert_MaxLines( 15 ) HMG_Alert( cMsg, aButton, cTitle, Nil, cIcoRes, nIcoSize, aBtnColor ) RELEASE FONT DlgFont [/pre2]

SergKis: PS Возможно есть смысл добавить[pre2] STATIC FUNCTION FillDlg( cMsg, aOptions, nLineas, cIcoFile, nIcoSize, aBtnColors, bBlock, lClosable, cFont, nMaxLen ) ... // calculate the maximum width of the lines IF lMaxWidth nMaxWidth := GetFontWidth ( cFont, nMaxLen ) IF GetTextWidth( hDC, space(10), hDlgFont ) != GetTextWidth( hDC, replicate("B", 10), hDlgFont ) nMaxWidth *= 0.7 ENDIF ENDIF ... [/pre2]

gfilatov2002: SergKis пишет: есть смысл добавить Спасибо Да, я тоже вышел на этот коэффициент 0,7

SergKis: gfilatov2002 пишет я тоже вышел на этот коэффициент 0,7 Ширины может не хватить, если исп. много заглавных букв типа W,B Можно игнорировать ситуацию или ввести static переменную для коэф. 0.7 или установленного в переменную

gfilatov2002: Убрал статик-переменную s_lMaxWidth, т.к. теперь в ней нет необходимости

SergKis: gfilatov2002 Сделал контроль выхода за пределы экрана по height [pre2] STATIC FUNCTION FillDlg( cMsg, aOptions, nLineas, cIcoFile, nIcoSize, aBtnColors, bBlock, lClosable, cFont, nMaxLen ) ... LOCAL nMaxLineas := HMG_Alert_MaxLines() LOCAL nMaxWidth, nMaxHeight ... IF MSC_VER() > 0 .AND. _HMG_IsThemed nWidthDlg += 10 nHeightDlg += 10 ENDIF IF nHeightDlg > System.ClientHeight n := 0 WHILE ( nHeightDlg - ( nChrHeight * ( ++n ) ) ) > System.ClientHeight END nMaxHeight := nChrHeight * n nMaxLineas -= n nHeightDlg -= nMaxHeight nHeightCli -= nMaxHeight ENDIF This.Width := nWidthDlg ... [/pre2]

SergKis: PS В примере BASIC\WALERT_2 окно со списком не выходит за пределы окна при фонте SIZE 16 и больше В примере demo7 установка большего фонта или HMG_Alert_MaxLines(35) - все в пределах окна

gfilatov2002: SergKis пишет: контроль выхода за пределы экрана по height Добавил, контрольный пример отработал нормально. Благодарю за помощь

rvu: gfilatov2002 пишет: Harbour MiniGUI Extended Edition 20.04 (Release) (64-bit) А какие возможности эта версия дает по сравнению с 32-битными? Если не пользоваться большими числами в расчетах. Хотел ради интереса посмотреть примеры. Как я понимаю последняя общедоступная версия была 16.10? Скачал ее, но при сборке примеров почему-то вылезает ошибка с файлом minigui.ch, хотя все есть, вроде. Если кто помнит, там все файлы есть или надо еще что-то скачивать? Или просто пути там не так прописаны? Хочется вообще посмотреть на это, как на демо, понять нужность или не ненужность для себя. А с поддержкой увы, ранее хотел говорить с директором о развитии, а тут с этим вирусом самим бы выжить.

gfilatov2002: rvu пишет: какие возможности эта версия дает по сравнению с 32-битными? Благодарю за вопрос! Если коротко, то это - относительно высокая скорость выполнения и возможность адресовать больший объем памяти, поскольку приложение становится нативным для 64-битной среды. Подробнее можно почитать статьи в Интернете. Приведу для справки список поддерживаемых Си-компиляторов: - MinGW GNU C 10.1 - самый свежий и самый быстрый из всех - BCC 64, основанный на LLVM/Clang C 3.3.1; - Visual C++ 19.24.28314; - PellesC 9.0.

SergKis: gfilatov2002 Правки небольшие [pre2] CLASS TSBrowse FROM TControl ... METHOD DrawFooters( lDrawCell ) INLINE ::DrawHeaders( .T., lDrawCell ) ... METHOD DrawHeaders( lFooters, lDrawCell ) CLASS TSBrowse ... oColumn:oCellEnum:nClrBack := nClrBackS // 9 ... oColumn:oCellEnum:nClrTo := nClrToS // 25 ... oColumn:oCellFoot:nVAlign := nVAlign // 23 oColumn:oCellFoot:nVertText := 0 // 24 ... METHOD DrawLine( xRow, lDrawCell ) CLASS TSBrowse ... oColumn:oCell:nRow := xRow // ... oColumn:oCell:xRow := xRow // 3 ... oColumn:oCell:l3DLook := oColumn:l3DLook // 13 ... METHOD DrawSelect( xRow, lDrawCell ) CLASS TSBrowse ... IF ! ::lDrawLine IF empty( oColumn:oCell ) oColumn:oCell := TSBcell():New() ENDIF ... [/pre2]

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

SergKis: gfilatov2002 Добавьте ф-ю для получения hmg имени фонта от handle[pre2] FUNCTION HMG_FontName( FontHandle ) LOCAL FontName, i IF ( i := AScan( _HMG_aControlHandles, FontHandle ) ) > 0 IF _HMG_aControlType [ i ] == "FONT" FontName := _HMG_aControlNames [ i ] ENDIF ENDIF RETURN FontName Использование ... cFntH := HMG_FontName( oHead:hFont ) cFntC := HMG_FontName( oCell:hFont ) cFntF := HMG_FontName( oFoot:hFont ) ... cN := cName+'_Head' @ nY, nX LABEL &cN VALUE cValH WIDTH oCell:nSize HEIGHT oHead:nHeightCell FONT cFntH ; BACKCOLOR aClrToH FONTCOLOR aForeH BORDER ON INIT {|| nY += This.Height + nGaps } cN := cName+'_Cell' @ nY, nX LABEL &cN VALUE cValC WIDTH oCell:nSize HEIGHT oCell:nHeightCell FONT cFntC ; BACKCOLOR aBackC FONTCOLOR aForeC BORDER ON INIT {|| nY += This.Height + nGaps } cN := cName+'_Foot' @ nY, nX LABEL &cN VALUE cValF WIDTH oCell:nSize HEIGHT oFoot:nHeightCell FONT cFntF ; BACKCOLOR aBackF FONTCOLOR aForeF BORDER ON INIT {|| nY += This.Height + nGaps } [/pre2]

gfilatov2002: SergKis пишет: Добавьте ф-ю для получения hmg имени фонта от handle Отдельная функция не нужна, поскольку уже есть более общая функция GetFontParam() Например, можно записать так #xtranslate HMG_FontName( <hFont> ) ; => ; GetFontParam( <hFont> )\[ 1 ]

SergKis: gfilatov2002 пишет Отдельная функция не нужна, поскольку уже есть более общая функция GetFontParam() К сожалению, в _HMG_aControlFontName [k] := fName это имя фонта в системе, к примеру "Arial", а надо имя фонта регистрации, т.е. из _HMG_aControlNames [k] := FontName, например "Norm", "Bold", "Itog", т.к. контрол на входе не понимает handle фонта, надо имя регистрации.

SergKis: PS или добавить в возврат GetFontParam( FontHandle ) имя регистрации и тогда можно сделать #xtranslate HMG_FontName( <hFont> )...

gfilatov2002: SergKis пишет: добавить в возврат GetFontParam( FontHandle ) имя регистрации Именно это хотел предложить (добавить 10-й параметр). #xtranslate HMG_FontName( <hFont> ) ; => ; GetFontParam( <hFont> )\[ 10 ]

SergKis: gfilatov2002 По аналогии [pre2] METHOD LButtonDown( nRowPix, nColPix, nKeyFlags ) CLASS TSBrowse ... nAtCol := Max( ::nAtColActual( nColPix ), 1 ) // JP 1.31 ... поменял (не срабатывал вызов) METHOD RButtonDown( nRowPix, nColPix, nFlags ) CLASS TSBrowse ... nRow := ::GetTxtRow( nRowPix ) nCol := ::nAtColActual( nColPix ) ... возможно, надо поменять и в METHOD LDblClick( nRowPix, nColPix, nKeyFlags ) CLASS TSBrowse Local nClickRow := ::GetTxtRow( nRowPix ), ; nCol := ::nAtColActual( nColPix ) ; /*( nColPix, ::lSelector ), ;*/ uPar1 := nRowPix, ; uPar2 := nColPix ... [/pre2]

SergKis: PS Надо менять тоже. Вот что получаю[pre2] :bLDblClick := {|uPar1, uPar2, nFlags, oBr| myLDblClicked( oBr, uPar1, uPar2, nFlags ) } ... STATIC FUNCTION myLDblClicked( oBrw, nRowPix, nColPix, nFlags ) Local nRow := oBrw:GetTxtRow( nRowPix ) Local nOld := oBrw:nAtCol( nColPix, oBrw:lSelector ) Local nCol := oBrw:nAtColActual( nColPix ) ? procname(), oBrw, nRowPix, nColPix, nFlags, nRow, nCol, nOld RETURN Nil результат LDblClicked на колонке 4 на разных nRowPos как будто кликаю на 6-ой колонке MYLDBLCLICKED 'O' 121 302 1 1 4 6 MYLDBLCLICKED 'O' 146 302 1 2 4 6 MYLDBLCLICKED 'O' 187 302 1 4 4 6 ... [/pre2]

SergKis: PS2 Почему то нет обработки двойного клика на Footers, думаю надо добавить[pre2] METHOD LDblClick( nRowPix, nColPix, nKeyFlags ) CLASS TSBrowse ... ElseIf nClickRow == -1 .and. ! empty( ::lDrawFooters ) If ::bLDblClick != Nil Eval( ::bLDblClick, uPar1, uPar2, nKeyFlags, Self ) EndIf ElseIf nClickRow == -2 .and. ::lDrawSpecHd .and. ::aColumns[ nCol ]:lEditSpec ... [/pre2]

gfilatov2002: SergKis пишет: Надо менять Добавил все предложенные правки. Благодарю за помощь

SergKis: gfilatov2002 пишет Добавил все предложенные правки. Выяснил, наверно, почему не было Footers в METHOD LDblClick( nRowPix, nColPix, nKeyFlags ) CLASS TSBrowse Если одновременно использовать с :LDblClick() :LButtonClick() или :RButtonClick(), то при нажатии LDblClick делая левый или правый клик "ложно" срабатывает после них LDblClick Это надо отметить для себя, что можно использовать или :LDblClick() или :LButtonClick(), :RButtonClick().

gfilatov2002: SergKis пишет: Это надо отметить для себя.. почему не было Footers Да, это известная проблема, подобное поведение происходит и при двойном клике по иконке приложения в трее Убрал предложенную правку для METHOD LDblClick

SergKis: gfilatov2002 Поправить надо, а то там NIL, вместо цифры[pre2] METHOD LoadFields( lEditable, aColSel, cAlsSel, aNameSel, aHeadSel ) CLASS TSBrowse ... nSize := ::aColSizes[ n ] EndIf If empty( ::aColSizes[ n ] ) ::aColSizes[ n ] := nSize EndIf If ValType( ::aFormatPic ) == "A" .and. ! Empty( ::aFormatPic ) .and. n <= Len( ::aFormatPic ) [/pre2]

gfilatov2002: SergKis пишет: Поправить надо Поправил, конечно [pre2]... If ValType( ::aColSizes ) == "A" .and. n <= Len( ::aColSizes ) .and. Empty( ::aColSizes[ n ] ) ::aColSizes[ n ] := nSize EndIf [/pre2]

SergKis: gfilatov2002 Еще[pre2] METHOD LoadFields( lEditable, aColSel, cAlsSel, aNameSel, aHeadSel ) CLASS TSBrowse ... ElseIf cType == "M" nSize := iif( ::nMemoWV == Nil, 200, ::nMemoWV ) ElseIf cType $ "=@T" nSize := GetTextWidth( 0, Replicate("9", 20), hFont ) Else cData := cValToChar( cData ) [/pre2]

gfilatov2002: SergKis пишет: Еще OK

gfilatov2002: Завершена подготовка новой сборки 20.05, которая будет опубликована на следующей неделе, со следующим списком изменений (кратко): [pre2] * Added a command for managing of the 'This' property at runtime: SET WINDOW THIS TO [<w>] where <w> may be a Form Name or a Form Index. * Added support of the PICTURE option to format the columns value in the Browse control. * The 'Command Link' button and 'Split Button' may be placed now in the TAB container. * Added the lNoSound parameter to the new Alert* family functions to block an any sound effect at startup of the above functions. * Added the auxiliary function HMG_Alert_MaxLines() for managing of the height of the EditBox control in the function HMG_Alert(). The width and height of an Alert window cannot exceed now a visible desktop area. * Updated header file i_hmgcompat.ch for compatibility with Official HMG. * Updated HMGS-IDE v.1.4.4.1, HBPrinter, PropGrid, TSBrowse and Sqlite3 libraries. * Added the new interesting samples and updated the some Basic and Advanced samples. [/pre2] Также выполнена адаптация текущей сборки для свежих версий Си-компиляторов: - MinGW GNU C 10.1 32-bit и 64-bit; - Microsoft Visual C++ 19.25.28614 32-bit и 64-bit; - BCC64, основанный на LLVM/Clang C 3.3.1 (35759.1709ea1.58602a0) (64-bit). Благодарю за ваше внимание

Andrey: А можно в HMG_Alert() при выводе даже помещаемых данных, сразу выводить их в EDITBOX ? Удобно вывести данные, посмотреть и если нужно, то скопировать ЧАСТЬ или ЦЕЛИКОМ в буфер обмена. В EDITBOX это удобно делать.

SergKis: Andrey А добавить пустых строк AlertInfo(cMsg+repl(" ;", 20), "INFO")

gfilatov2002: Andrey пишет: сразу выводить их в EDITBOX ? Да, это будет возможно в сборке 20.05, если перед вызовом функции HMG_Alert() написать HMG_Alert_MaxLines( 1 ) тогда будет вывод всех строк в EDITBOX , а на экране будет показана только одна строка.

SergKis: gfilatov2002 Будут ли изменения по фонтам из темы http://clipper.borda.ru/?1-1-0-00000554-000-80-0-1590177610

gfilatov2002: SergKis пишет: Будут ли изменения по фонтам Да, конечно

Andrey: SergKis пишет: А добавить пустых строк AlertInfo(cMsg+repl(" ;", 20), "INFO") Да не хотелось бы. gfilatov2002 пишет: Да, это будет возможно в сборке 20.05, если перед вызовом функции HMG_Alert() написать HMG_Alert_MaxLines( 1 ) тогда будет вывод всех строк в EDITBOX , а на экране будет показана только одна строка. Спасибо ! Эта настройка глобальная или только для одного вызова HMG_Alert() ?

SergKis: gfilatov2002 Может чуть поправить HMG_Alert[pre2] STATIC FUNCTION FillDlg( cMsg, aOptions, nLineas, cIcoFile, nIcoSize, aBtnColors, bBlock, lClosable, cFont, nMaxLen ) ... IF nLineas > 1 IF nLineas >= nMaxLineas ... Тогда проще делать, что хочет Андрей nOld := HMG_Alert_MaxLines() IF nOld > hb_TokenCount(cMsg, ";") HMG_Alert_MaxLines(hb_TokenCount(cMsg, ";")) AlertInfo(cMsg, ...) HMG_Alert_MaxLines( nOld ) ENDIF [/pre2] и весь текст войдет в EditBox

SergKis: PS Возможно, лучше и проще так [pre2] STATIC s_nMaxLineas := 20 STATIC s_lEditBox := .F. *-----------------------------------------------------------------------------* FUNCTION HMG_Alert_MaxLines( nMaxLineas, ) *-----------------------------------------------------------------------------* IF HB_ISLOGICAL(nMaxLineas ) s_lEditBox := nMaxLineas ELSEIF HB_ISNUMERIC(nMaxLineas ) .and. nMaxLineas > 0 s_nMaxLineas := nMaxLineas ENDIF RETURN s_nMaxLineas STATIC FUNCTION FillDlg( cMsg, aOptions, nLineas, cIcoFile, nIcoSize, aBtnColors, bBlock, lClosable, cFont, nMaxLen ) ... IF nLineas > 1 IF nLineas > nMaxLineas .or. s_lEditBox ... [/pre2]

gfilatov2002: Andrey пишет: Эта настройка глобальная или только для одного вызова Глобальная

Andrey: gfilatov2002 пишет: Глобальная Не очень удобно будет кодить. Нужно для разового вызова. Лучше бы сделать как Сергей предлагает.

gfilatov2002: Andrey пишет: Нужно для разового вызова. Тогда можно использовать таким образом: nI := HMG_Alert_MaxLines() HMG_Alert_MaxLines( 1 ) HMG_Alert( cMsg, aButton, cTitle, Nil, cIcoRes, nIcoSize, aBtnColor ) HMG_Alert_MaxLines( nI )

SergKis: gfilatov2002 FUNCTION HMG_Alert( cMsg, aOptions, cTitle, nType, cIcoFile, nIcoSize, aBtnColors, bInit, lClosable, cFontName ) ... cMsg := cValToChar( cMsg ) cMsg := StrTran( cMsg, ";", CRLF ) nLineas := MLCount( cMsg ) _logfile(.t.,procname(), hb_TokenCount(cMsg, CRLF), MLCount( cMsg )) получаем HMG_ALERT 12 11 по разному считают, правильно посчитала hb_TokenCount(cMsg, CRLF) Надо подменить, наверно, иначе код работает не верно[pre2] ITEM '_MsgLog.lst' ACTION {|cs,nn,no| cs := StrTran(hb_memoread("_MsgLog.lst"), CRLF, ';') nn := hb_TokenCount(cs, ';') no := HMG_Alert_MaxLines(nn-1) AlertInfo( cs, "INFO") HMG_Alert_MaxLines(no) Return Nil } [/pre2]

SergKis: PS В таком виде отработал код правильно, все строки видны в EditBox[pre2] ITEM '_MsgLog.txt' ACTION {|cs,nn,no| cs := hb_memoread("_MsgLog.lst") nn := MLCount(cs) no := HMG_Alert_MaxLines(nn) AlertInfo( cs+CRLF, "INFO") HMG_Alert_MaxLines(no) Return Nil } [/pre2]

Andrey: gfilatov2002 пишет: Тогда можно использовать таким образом: Хорошо ! Спасибо ! Только если я в коде промахнулся и строчек больше одной - то нужно показывать ВСЕ строчки ! Т.е. задал 1 строчку, значение вывожу 5 строчек, то должны показываться все 5 строчек.

SergKis: Andrey пишет Т.е. задал 1 строчку, значение вывожу 5 строчек, то должны показываться все 5 строчек. Посмотри предыдущий пост, такой код сделает как ты хочешь, т.е. от кол-ва строк в тексте, т.е. у меня _MsgLog.lst 12 строк, что бы их всех сразу увидеть и написан код выше

Andrey: SergKis пишет: Посмотри предыдущий пост, такой код сделает как ты хочешь Да не успел прочитать. Понял сейчас !

gfilatov2002: Опубликована новая сборка 20.05 для BCC 5.8.2 и компиляторов Harbour и xHarbour. Базовый дистрибутив находится по адресу http://hmgextended.com/files/CONTRIB/hmg-20.05-setup.exe Добавил также архив для бесплатного Embarcadero C++ 10.2 'Tokyo' compiler http://hmgextended.com/files/CONTRIB/hmg2005_bcc102.exe Огромная благодарность Сергею Киселеву за помощь при подготовке этой сборки Для частного использования подготовлены еще два дистрибутива: [pre2]------------------------------------------------------------- Minigui Ex Package (build date: 25.05.2020) Download links: http://hmgextended.com/files/PRIVATE ------------------------------------------------------------- Components versions: -------------------- Harbour MiniGUI Extended Edition 20.05 (Release) Harbour 3.2.0dev (r2004201301) Harbour Make (hbmk2) 3.2.0dev (r2020-04-20 13:01) gcc (MinGW-W64 i686-posix-dwarf, built by Brecht Sanders) 10.1.0 [/pre2] [pre2]------------------------------------------------------------- Minigui Ex 64-bit Package (build date: 25.05.2020) Download links: http://hmgextended.com/files/PRIVATE ------------------------------------------------------------- Components versions: -------------------- Harbour MiniGUI Extended Edition 20.05 (Release) Harbour 3.4.0dev () (2017-12-20 13:40) Harbour Make (hbmk2) 3.4.0dev () (2017-12-20 13:40) gcc (MinGW-W64 x86_64-posix-seh, built by Brecht Sanders) 10.1.0 [/pre2]

SergKis: gfilatov2002 ChangeLog.txt[pre2] - enhanced auxiliary class TSBcell for a quick export of a data. Usage: WITH OBJECT oBrw :lDrawLine := .F. :GoTop() FOR nAt := 1 TO :nLen :DrawLine() FOR nCol := 1 TO :nColCount() oCol := :aColumns[ nCol ] ? "..", nCol, oCol:cName, Valtype(oCol:oCell:uValue), oCol:oCell:uValue, oCol:oCell:cValue NEXT :GoDown() NEXT :lDrawLine := .T. :Reset() END WITH [/pre2] Перенести :DrawLine(), т.к. в предыдущем варианте срабатывала последней :DrawSelect(), это другое заполнение oCol:oCell Что бы не делать лишний вызов, наверно, надо поправить[pre2] *-----------------------------------------------------------------------------* FUNCTION HMG_Alert_MaxLines( nMaxLines ) *-----------------------------------------------------------------------------* LOCAL nLines := s_nMaxLines IF HB_ISNUMERIC( nMaxLines ) .AND. nMaxLines > 0 s_nMaxLines := nMaxLines ENDIF RETURN nLines [/pre2]

SergKis: PS Сборка файлом MakeAllMiniguiLibs.bat не проходит. Протокол [pre2] MiniGui.lib h_activex.prg(326) Error E0020 Incomplete statement or unbalanced delimiters h_activex.prg(328) Error E0030 Syntax error "syntax error at 'OERROR'" h_activex.prg(330) Error E0010 ENDIF does not match IF h_graph.prg(426) Warning W0032 Variable 'CNAMEOBJ' is assigned but not used in function 'GRAPHSHOW(190)' h_graph.prg(426) Warning W0032 Variable 'CNAMEOBJ' is assigned but not used in function 'GRAPHSHOW(323)' ... [/pre2]

SergKis: PS2 Может можно добавить таблицу процентов scale от размера фонта. h_objects.prg[pre2] *-----------------------------------------------------------------------------* FUNCTION oDlu4Font( nFontSize, lDlu2Pix ) *-----------------------------------------------------------------------------* LOCAL nPrcW, nPrcH, aDim LOCAL aScale := { { 8, 75, 75}, ; { 9, 85, 85}, ; { 10, 90, 90}, ; { 11, 100, 100}, ; { 12, 110, 100}, ; { 13, 115, 100}, ; { 14, 120, 110}, ; { 15, 130, 110}, ; { 16, 140, 120}, ; { 17, 145, 120}, ; { 18, 150, 130}, ; { 19, 160, 130}, ; { 20, 170, 140}, ; { 21, 175, 140}, ; { 22, 180, 150}, ; { 23, 190, 150}, ; { 24, 200, 160}, ; { 25, 205, 170}, ; { 26, 210, 170} ; } Default lDlu2Pix := .T., nFontSize := 11, nPrcW := 100, nPrcH := 100 IF nFontSize < aScale[1][1] ; nFontSize := aScale[1][1] ELSEIF nFontSize > ATail(aScale)[1] ; nFontSize := ATail(aScale)[1] ENDIF FOR EACH aDim IN aScale IF nFontSize == aDim[1] nPrcW := aDim[2] nPrcH := aDim[3] EXIT ENDIF NEXT IF lDlu2Pix ; RETURN := TDlu2Pix():New( nPrcW, nPrcH ) ENDIF RETURN { nPrcW, nPrcH } *-----------------------------------------------------------------------------* FUNCTION oDlu2Pixel( nPrcW, nPrcH, nFontSize ) *-----------------------------------------------------------------------------* LOCAL aPrcWH IF HB_ISNUMERIC( nFontSize ) aPrcWH := oDlu4Font( nFontSize, .F. ) nPrcW := aPrcWH[1] nPrcH := aPrcWH[2] ENDIF IF PCount() > 0 ... [/pre2]

gfilatov2002: SergKis пишет: ChangeLog.txt - enhanced auxiliary class TSBcell for a quick export of a data. Usage: WITH OBJECT oBrw :lDrawLine := .F. :GoTop() FOR nAt := 1 TO :nLen :DrawLine() FOR nCol := 1 TO :nColCount() oCol := :aColumns[ nCol ] ? "..", nCol, oCol:cName, Valtype(oCol:oCell:uValue), oCol:oCell:uValue, oCol:oCell:cValue NEXT :GoDown() NEXT :lDrawLine := .T. :Reset() END WITH Перенести :DrawLine(), т.к. в предыдущем варианте срабатывала последней :DrawSelect(), это другое заполнение oCol:oCell Что бы не делать лишний вызов, наверно, надо поправить *-----------------------------------------------------------------------------* FUNCTION HMG_Alert_MaxLines( nMaxLines ) Уже поправил в "тихом" обновлении этой сборки. SergKis пишет: можно добавить таблицу процентов scale от размера фонта Да, это интересное предложение, но уже для следующей сборки. Благодарю за оперативную помощь

gfilatov2002: SergKis пишет: Сборка файлом MakeAllMiniguiLibs.bat не проходит Уже поправил в первом update для сборки 20.05, который выйдет завтра SergKis пишет: можно добавить таблицу процентов scale от размера фонта. Добавил

gfilatov2002: Выложил первое обновление для сборки 20.05 (Update 1) с учетом последних наработок Базовый дистрибутив для BCC 5.8.2 находится по адресу http://hmgextended.com/files/CONTRIB/hmg-20.05-setup.exe Обновил также архив для бесплатного Embarcadero C++ 10.2 'Tokyo' compiler по адресу http://hmgextended.com/files/CONTRIB/hmg2005_bcc102.exe Благодарю за ваше внимание P.S. Благодарю Сашу Савова за поддержку проекта

Andrey: SergKis пишет: - enhanced auxiliary class TSBcell for a quick export of a data. А можно для суперхидера получить начало и конец объединенных ячеек ? Это нужно для экселя. [pre2] aSup := oBrw:DrawSuper( .F. ) FOR EACH oCel IN aSup hFnt := oCel:hFont aFore := oCel:nClrFore aBack := oCel:nClrBack xVal := oCel:cValue AADD( aRet, { aFore, aBack, hFnt, xVal } ) NEXT[/pre2] Или это можно уже сейчас получать в этом классе ?

SergKis: Andrey пишет А можно для суперхидера получить начало и конец объединенных ячеек ? Это нужно для экселя. Можно получать сейчас так[pre2] aSup := oBrw:DrawSuper( .F. ) FOR EACH oCel IN aSup nFrom := oBrw:aSuperHead[ hb_enumindex( oCel ) ][1] nTo := oBrw:aSuperHead[ hb_enumindex( oCel ) ][2] hFnt := oCel:hFont aFore := oCel:nClrFore aBack := oCel:nClrBack xVal := oCel:cValue AADD( aRet, { aFore, aBack, hFnt, xVal } ) NEXT [/pre2] Если поправить класс TSBcell и метод, то можно проще получать данные[pre2] CLASS TSBcell ... VAR nHeight AS NUMERIC INIT 0 VAR nFromCol AS NUMERIC INIT 0 VAR nToCol AS NUMERIC INIT 0 VAR nCell ... METHOD DrawSuper( lDrawCell ) CLASS TSBrowse ... oSupHd := TSBcell():New() ... oSupHd:lDrawLine := .F. // DrawLine() oSupHd:nFromCol := aSuperHead[ nI, 1 ] oSupHd:nToCol := aSuperHead[ nI, 2 ] ... тогда можно так делать aSup := oBrw:DrawSuper( .F. ) FOR EACH oCel IN aSup nFrom := oCel:nFromCol nTo := oCel:nToCol hFnt := oCel:hFont aFore := oCel:nClrFore aBack := oCel:nClrBack xVal := oCel:cValue AADD( aRet, { aFore, aBack, hFnt, xVal } ) NEXT [/pre2]

Andrey: SergKis пишет: Можно получать сейчас так aSup := oBrw:DrawSuper( .F. ) FOR EACH oCel IN aSup nFrom := oBrw:aSuperHead[ hb_enumindex( oCel ) ][1] // строка 250 nTo := oBrw:aSuperHead[ hb_enumindex( oCel ) ][2] Выдаёт ошибку: Error BASE/1132 Bound error: array access Args: [1] = A { ... } length: 7 [2] = N 8 --------------------------------- Stack Trace --------------------------------- Called from MYGETTSBSUPH(250) in module: MenuExcel7.prg Called from MYGETTSBCONTENT(166) in module: MenuExcel7.prg

SergKis: Andrey пишет Выдаёт ошибку: А на подумать можно о сообщении ?[pre2] aSup := :DrawSuper( .F. ) FOR EACH oCel IN aSup nCol := hb_enumindex(oCel) nFrom := -1 nTo := -1 IF nCol <= Len(:aSuperHead) nFrom := :aSuperHead[ nCol ][1] nTo := :aSuperHead[ nCol ][2] ENDIF hFnt := oCel:hFont результат (цифры перед текстом) ==== решение только для dbf =========================== F9 "быстрый" доступ к данным тсб через объекты класса TSBcell oCol:oCellHead, oCol:oCellEnum, oCol:oCell, oCol:oCellFoot :lDrawLine = .T. Log file = _MsgLog.txt ~ DrawSuper ~ 1 3 0 50 1 {128, 0, 0} {192, 192, 192} {128, 128, 128} 1 1 '' ~ 2 3 50 585.0 1 {128, 0, 0} {192, 192, 192} {128, 128, 128} 2 6 Adres ~ 3 3 635.0 629.0 1 {128, 0, 0} {192, 192, 192} {128, 128, 128} 7 10 01.01.14 - 31.03.20 ~ 4 3 1264.0 0 1 {128, 0, 0} {192, 192, 192} {128, 128, 128} 11 16 Январь 2020 ~ 5 3 1264.0 0 1 {128, 0, 0} {192, 192, 192} {128, 128, 128} 17 22 Март 2020 ~ 6 3 1264.0 0 1 {128, 0, 0} {192, 192, 192} {128, 128, 128} 23 23 21-15 ~ 7 3 1264.0 0 1 {128, 0, 0} {192, 192, 192} {128, 128, 128} 24 24 -o- ~ 8 3 1264.0 -1 1 {128, 0, 0} {192, 192, 192} {128, 128, 128} -1 -1 '' [/pre2]

Andrey: SergKis пишет: А на подумать можно о сообщении ? Всю думалку заказчик сломал. Мозги совсем не работают... СПАСИБО !

Andrey: Ещё один вопрос возник по классу TSBcell Можно получить формат колонки для вывода в Эксель, т.е. PICTURE колонки ? [pre2] FOR nAt := 1 TO :nLen :DrawLine() aLine := {} FOR nCol := 1 TO :nColCount() oCol := :aColumns[ nCol ] oCel := oCol:oCell hFnt := oCel:hFont aFore := oCel:nClrFore aBack := oCel:nClrBack xVal := oCel:cValue cType := Valtype(oCel:uValue) cPict := ???? AADD( aLine, { aFore, aBack, hFnt, xVal, cType, cPict } ) NEXT AADD( aRet, aLine ) // строка таблицы :GoDown() NEXT[/pre2]

SergKis: Andrey пишет Можно получить формат колонки для вывода в Эксель, т.е. PICTURE колонки ? cPict := oCol:cPicture

Andrey: СПАСИБО !

SergKis: gfilatov2002 Небольшая правка scale фонтов [pre2] FUNCTION oDlu4Font( nFontSize, lDlu2Pix ) LOCAL nPrcW, nPrcH, aDim LOCAL aScale := { { 8, 85, 75}, ; { 9, 90, 85}, ; { 10, 95, 85}, ; { 11, 100, 90}, ; { 12, 110, 95}, ; { 13, 115, 100}, ; { 14, 120, 110}, ; { 15, 130, 110}, ; { 16, 140, 120}, ; { 17, 145, 120}, ; { 18, 150, 130}, ; { 19, 160, 130}, ; { 20, 170, 145}, ; { 21, 175, 145}, ; { 22, 180, 150}, ; { 23, 190, 155}, ; { 24, 200, 160}, ; { 25, 205, 170}, ; { 26, 210, 180} ; } ... METHOD UnitsToPixels( nPrcW, nPrcH ) CLASS TDlu2Pix DEFAULT nPrcW := hb_defaultValue( nPrcW, ::nScaleWidth ), ; nPrcH := hb_defaultValue( nPrcH, ::nScaleHeight ) ::nScaleWidth := nPrcW ::nScaleHeight := nPrcH ::nPixWidth := ::DLU2PixW( ::nUnitWidth, nPrcW ) ... Предложение добавить i_font.ch #command SET FONT TO <fontname> , <fontsize>; => ; _HMG_DefaultFontName := <fontname> ; _HMG_DefaultFontSize := <fontsize> ; oDlu2Pixel( , , <fontsize> ) [/pre2] Пример применения BASIC\GetBox_3 тут https://TransFiles.ru/i36zt

gfilatov2002: SergKis пишет: Предложение добавить OK, добавлю во 2-е обновление сборки 20.05 Благодарю за помощь

gfilatov2002: Выложил обновление для сборки 20.05 (Update 2) с учетом последних наработок Базовый дистрибутив для BCC 5.8.2 находится по адресу http://hmgextended.com/files/CONTRIB/hmg-20.05-setup.exe Благодарю за ваше внимание

SergKis: gfilatov2002 Тут неточность[pre2] METHOD AddSuperHead( nFromCol, nToCol, uHead, nHeight, aColors, l3dLook, uFont, uBitMap, lAdjust, lTransp, ; ... uFont := iif( uFont != Nil, iif( ValType( uFont ) == "O", uFont:hFont, uFont /* ? */ ), hFont ) ... было hFont := If( uFont != Nil, uFont, hFont ) и переменная DATA hFontSupHd // super header font больше подходит, чем DATA hFontSupHd AS NUMERIC // super header font [/pre2]

SergKis: PS Или такой вариант, что бы 0 не проскочил [pre2] uFont := iif( ! Empty(uFont), iif( ValType( uFont ) == "O", uFont:hFont, uFont ), hFont ) [/pre2]

SergKis: PS2 И логичнее сразу сделать [pre2] hFont := iif( ! Empty(uFont), iif( ValType( uFont ) == "O", uFont:hFont, uFont ), hFont ) и убрать If ! Empty( ::aColumns ) hFont := iif( ValType( ::aColumns[ nFromCol]:hFontHead ) == "O", ::aColumns[ nFromCol]:hFontHead, ; iif( ::aColumns[ nFromCol]:hFontHead != Nil, ::aColumns[ nFromCol]:hFontHead, hFont ) ) endif // hFont := iif( uFont != Nil, uFont, hFont ) [/pre2]

SergKis: gfilatov2002 Правка закраски фантомной колонки[pre2] METHOD DrawHeaders( lFooters, lDrawCell ) CLASS TSBrowse ... If ::oPhant == Nil ... Self ) ::oPhant:cName := "oPhant" Else ... METHOD DrawLine( xRow, lDrawCell ) CLASS TSBrowse ... If ::oPhant == Nil ... Self ) ::oPhant:cName := "oPhant" Else ... METHOD DrawSelect( xRow, lDrawCell ) CLASS TSBrowse ... If ::oPhant == Nil ... Self ) ::oPhant:cName := "oPhant" Else ... If lNoLite nClrFore := ::GetValProp( oColumn:nClrFocuFore, nClrText, nJ, ::nAt ) nClrBack := ::GetValProp( oColumn:nClrFocuBack, nClrPane, nJ, ::nAt ) nCursor := 0 If ! empty(oColumn:cName) .and. oColumn:cName == "oPhant" nClrBack := nClrPane ElseIf ValType( nClrBack ) == "N" .and. nClrBack < 0 nClrBack := -nClrBack EndIf Else ... [/pre2]

gfilatov2002: SergKis пишет: логичнее сразу сделать ... Правка закраски фантомной колонки Все правки приняты. Благодарю за помощь

SergKis: gfilatov2002 В HMG_DrawIcon() сделана веточка [pre2] ... ELSEIF ISSTRING( icon ) DrawIconEx( FormHandle, Col, Row, LoadIconByName( icon, w, h ), w, h, rgb, .T. ) AAdd( _HMG_aFormGraphTasks [ i ] , {|| DrawIconEx( FormHandle, Col, Row, LoadIconByName( icon, w, h ), w, h, rgb, .T. ) } ) ENDIF [/pre2] Это же утечка памяти на LoadIconByName(). У себя сделал [pre2] h_window.prg FUNCTION _DefineWindow ( FormName, Caption, x, y, w, h, nominimize, nomaximize, ; ... _HMG_aFormMiscData1 [ k ] := {hnotifyicon, cursor, {}} ... AAdd ( _HMG_aFormMiscData1, {hnotifyicon, cursor, {}} ) ... FUNCTION _DefineModalWindow ( FormName, Caption, x, y, w, h, Parent, nosize, nosysmenu, nocaption, aMin, aMax, ; ... _HMG_aFormMiscData1 [ k ] := {NIL, cursor, {}} ... AAdd ( _HMG_aFormMiscData1, {NIL, cursor, {}} ) ... FUNCTION _DefineSplitChildWindow ( FormName, w, h, break, grippertext, nocaption, title, fontname, fontsize, gotfocus, lostfocus, ; ... _HMG_aFormMiscData1 [ k ] := {NIL, cursor, {}} ... AAdd ( _HMG_aFormMiscData1, {NIL, cursor, {}} ) ... h_windowMDI.prg FUNCTION _DefineChildMDIWindow ( FormName, x, y, w, h, nominimize, nomaximize, ; ... _HMG_aFormMiscData1 [k] := {NIL, cursor, {}} ... AAdd ( _HMG_aFormMiscData1 , {NIL, cursor, {}} ) ... h_events.prg ... CASE WM_DESTROY ... NEXT // Delete handle hmg_drawicon(...) IF ISARRAY( _HMG_aFormMiscData1[ i ] ) .and. Len( _HMG_aFormMiscData1[ i ] ) > 2 IF ISARRAY( _HMG_aFormMiscData1[ i, 3 ] ) .and. Len( _HMG_aFormMiscData1[ i, 3 ] ) > 0 FOR EACH x IN _HMG_aFormMiscData1[ i, 3 ] DeleteObject( x ) NEXT ENDIF ENDIF // Delete Brush DeleteObject ( _HMG_aFormBrushHandle [ i ] ) ... h_draw.prg ... FUNCTION HMG_DrawIcon( window, icon, row, col, w, h, rgb, transparent ) LOCAL FormHandle LOCAL backcolor LOCAL i, name ... hb_default( @rgb, GetSysColor( COLOR_BTNFACE ) ) IF ISSTRING( icon ) name := icon icon := LoadIconByName( icon, w, h ) ENDIF IF ISNUMERIC( icon ) DrawIconEx( FormHandle, Col, Row, icon, w, h, rgb, .F. ) AAdd( _HMG_aFormGraphTasks [ i ] , {|| DrawIconEx( FormHandle, Col, Row, icon, w, h, rgb, .F. ) } ) IF ! Empty(name) AAdd( _HMG_aFormMiscData1[ i, 3 ], icon ) ENDIF /* ELSEIF ISSTRING( icon ) DrawIconEx( FormHandle, Col, Row, LoadIconByName( icon, w, h ), w, h, rgb, .T. ) AAdd( _HMG_aFormGraphTasks [ i ] , {|| DrawIconEx( FormHandle, Col, Row, LoadIconByName( icon, w, h ), w, h, rgb, .T. ) } ) */ ENDIF ... [/pre2]

Andrey: Привет всем. Григорий ! Удаление записи в методе :SetDeleteMode( .T., .T. ) - запрос идет через MsgYesNo() Поменять на AlertYesNo() - можно ? Или переключатель сделать какой то ? А то при удалении/вставки разные окна. Как то не то.

SergKis: Andrey Почему не смотришь исходники, примеры, когда что то применяешь и есть не ясность или вопросы. Сканируй примеры Advanced Far -> Alt_F7 -> *.prg "SetDeleteMode" и просмотри найденное. Открой h_tbrowse.prg, найди метод SetDeleteMode() и смотри параметры Если в твоем редакторе сложно, открывай hbedit от А.Кресина Alt+L и весь список ф-й, методов с поиском перед глазами

Andrey: Посмотрел. Нет такого - поменять MsgYesNo() на AlertYesNo() ! Это нужно сделать в [pre2]METHOD DeleteRow( lAll ) CLASS TSBrowse ..... If ::lConfirm .and. !lAll .and.; ! MsgYesNo( iif( ::lIsDbf, ::aMsg[ 37 ], ::aMsg[ 38 ] ), ::aMsg[ 39 ] ) [/pre2]

Dima: Andrey пишет: Посмотрел Не там смотрел а по вопросу можно хоть чёрта лысого туда сунуть

SergKis: Andrey пишет Посмотрел. Нет такого - поменять MsgYesNo() на AlertYesNo() ! "В огороде бузина, а в Киеве — дядька" Говорили о :SetDeleteMode(), а унесло куда то ... в сторону. Смотри :SetDeleteMode(...)

Andrey: Вспомнил, как делал раньше. Только запрос не делал, из-за этого и непонятно было как делать.[pre2] bDelete := { | nAt, oBrw | ItogoNN(oBrw) } oBrw1:SetDeleteMode( .T., .F., bDelete ) // здесь включаем клавишу DEL !!![/pre2]

gfilatov2002: SergKis пишет: DrawIconEx( FormHandle, Col, Row, LoadIconByName( icon, w, h ), w, h, rgb, .T. ) Восьмой параметр этой функции, выделенный цветом, управляет удалением иконки, которая была загружена функцией LoadIconByName()

SergKis: gfilatov2002 Спасибо, упустил.

SergKis: gfilatov2002 Предлагаю поправить [pre2] METHOD DeleteRow( lAll, lUpStable ) CLASS TSBrowse Local lRecall, nAt, nRowPos, nRecNo, lRefresh, cAlias, lEval, uTemp ... lRecall := !Set( _SET_DELETED ) DEFAULT lUpStable := !lRecall If !::lIsTxt ... If !( "SQL" $ ::cDriver ) ( cAlias )->( DbUnlock() ) EndIf /* ::nLen := ( cAlias )->( Eval( ::bLogicLen ) ) If lUpStable ( cAlias )->( DbSkip() ) lRefresh := ( cAlias )->( EOF() ) ( cAlias )->( DbSkip( -1 ) ) ::nRowPos -= iif( lRefresh .and. ; ! ( cAlias )->( BoF() ), 1, 0 ) ::Refresh( .T. ) EndIf */ ElseIf lRecall ( cAlias )->( DbRecall() ) ( cAlias )->( DbUnlock() ) EndIf ::nLen := ( cAlias )->( Eval( ::bLogicLen ) ) If lUpStable ( cAlias )->( DbSkip() ) lRefresh := ( cAlias )->( EOF() ) ( cAlias )->( DbSkip( -1 ) ) ::nRowPos -= iif( lRefresh .and. ; ! ( cAlias )->( BoF() ), 1, 0 ) ::Refresh( .T. ) EndIf If ::lCanAppend .and. ::nLen == 0 ... [/pre2] Использовать, например, на индексе с FOR в котором есть Deleted() : :SetDeleteMode( .T., .F., {|| AlertYesNo(iif((oBrw:cAlias)->(OrdSetFocus()) == "DEL", ; "Восстановить", "Удалить")+" запись в таблице ?", "Подтверждение") } )

gfilatov2002: SergKis пишет: Предлагаю поправить /* ::nLen := ( cAlias )->( Eval( ::bLogicLen ) ) If lUpStable ( cAlias )->( DbSkip() ) lRefresh := ( cAlias )->( EOF() ) ( cAlias )->( DbSkip( -1 ) ) ::nRowPos -= iif( lRefresh .and. ; ! ( cAlias )->( BoF() ), 1, 0 ) ::Refresh( .T. ) EndIf */ т.е. перенести этот код ниже, чтобы учитывать восстановление записи также. Сделал, конечно. Благодарю за помощь

gfilatov2002: Подготовил 5-ю бету для новой сборки 20.06 со следующим списком изменений: [pre2] * Fixed: The back color of a TAB control was not changed at runtime. Problem was reported by Ivanil Marcelino <ivanil/at/linkbr.com.br>. Contributed by Grigory Filatov <gfilatov@inbox.ru> (see demo.prg in folder \samples\Basic\TAB) * Fixed: Pacified the C-warning "cast-function-type" in the MiniGUI core (was passed MinGW GNU C 10.1): - added the auxiliary C-function wapi_GetProcAddress(). It was a postponed modification. Contributed by Grigory Filatov <gfilatov@inbox.ru> * New: Added the useful function HMG_SetMenuTheme( [ nType ][, cFormName ] ) for setting of the predefined menu themes, where the 1st parameter nType may have the following values: - MNUCLR_THEME_DEFAULT; - MNUCLR_THEME_XP; - MNUCLR_THEME_2000; - MNUCLR_THEME_DARK. Requested by Verchenko Andrey <verchenkoag/at/gmail.com>. Contributed by Grigory Filatov <gfilatov@inbox.ru> (see demo in folder \samples\Advanced\MenuEx) * Updated: Synchronized Extended HMG for compatibility with Official HMG: - New: function GetFormNameByHandle( hWnd, @cFormName, ; @cFormParentName ) --> Return nFormIndex; - New: function GetControlNameByHandle ( hWnd, @cControlName, ; @cFormParentName ) --> Return nControlIndex. Based upon a contribution of Claudio Soto <srvet/at/adinet.com.uy>. Adapted for Minigui Extended by Grigory Filatov <gfilatov@inbox.ru> (see demo in folder \samples\Basic\MoveResizeControl) * New: 'HbCrypto' library contains (see source in folder \Source\HbCrypto): - Harbour interface to bcrypt password hashing; - BLAKE2s function wrapper (fast secure hash); - ED25519 wrappers; - Harbour interface to PBKDF2 password hashing; - Harbour interface to scrypt password hashing; - SHA3 function wrappers (secure hash). Based upon a contribution of Viktor Szakats (borrowed from 3.4 fork). Adapted for Minigui Extended by Grigory Filatov <gfilatov@inbox.ru> * Updated: 'Bos Taurus' Graphics Library (see source in folder \Source\BosTaurus): - fixed the MinGW C-warning "cast-function-type". Contributed by Grigory Filatov <gfilatov@inbox.ru> * Updated: 'HMG Debugger' library: - adapted to the recent Minigui core changes. Contributed by Grigory Filatov <gfilatov@inbox.ru> (see source in folder \Source\Debugger) * Updated: Adaptation FiveWin Class TSBrowse 9.0 in HMG: - minor correction of a font handling in the method AddSuperHead(); - minor correction of a refreshing in the method DeleteRow(); - minor correction of a phantom column's painting in the method DrawSelect(). Contributed by Sergej Kiselev. * Updated: HbSQLite3 library: - update for using SQLITE3 latest version 3.32.2. Contributed by Grigory Filatov <gfilatov@inbox.ru>. * Updated: 'Print Pie Graph' sample: updated the data for May 2020. Contributed by Grigory Filatov <gfilatov@inbox.ru> (see demo.prg in folder \samples\Basic\GraphPrint) * Updated: The following samples were revised for compatibility with the recent Minigui modification: - menudemo2.prg in folder \samples\Basic\Menu; - \samples\Advanced\MenuEx; - \samples\Advanced\SetThemes; - \samples\Advanced\TransparentIcons. Contributed by Grigory Filatov <gfilatov@inbox.ru> * Updated: 'Quick Browse Generator' utility: - adapted to the recent Minigui core changes. Contributed by Grigory Filatov <gfilatov@inbox.ru> (see in folder \Utils\QBGen) [/pre2] Благодарю за ваше внимание

gfilatov2002: P S По просьбе Андрея расширил возможности новой функции HMG_SetMenuTheme() по определению пользовательской темы меню. Синтаксис: HMG_SetMenuTheme( [ nType ][, cFormName ][, aUserDefined ] ) Пример определения массива aUserDefined: FUNCTION GetWin7Theme() LOCAL aUserDefined := Array( 24 ) aUserDefined[ MNUCLR_MENUBARBACKGROUND1 ] := GetSysColor( 15 ) aUserDefined[ MNUCLR_MENUBARBACKGROUND2 ] := RGB( 211, 218, 237 ) aUserDefined[ MNUCLR_MENUBARTEXT ] := RGB( 0, 0, 0 ) aUserDefined[ MNUCLR_MENUBARSELECTEDTEXT ] := RGB( 0, 0, 0 ) aUserDefined[ MNUCLR_MENUBARGRAYEDTEXT ] := GetSysColor( 17 ) aUserDefined[ MNUCLR_MENUBARSELECTEDITEM1 ] := RGB( 174, 206, 246 ) aUserDefined[ MNUCLR_MENUBARSELECTEDITEM2 ] := RGB( 174, 206, 246 ) aUserDefined[ MNUCLR_MENUITEMTEXT ] := GetSysColor( 7 ) aUserDefined[ MNUCLR_MENUITEMSELECTEDTEXT ] := GetSysColor( 7 ) aUserDefined[ MNUCLR_MENUITEMGRAYEDTEXT ] := GetSysColor( 17 ) aUserDefined[ MNUCLR_MENUITEMBACKGROUND1 ] := RGB( 240, 240, 240 ) aUserDefined[ MNUCLR_MENUITEMBACKGROUND2 ] := RGB( 240, 240, 240 ) aUserDefined[ MNUCLR_MENUITEMSELECTEDBACKGROUND1 ] := RGB( 232, 238, 246 ) aUserDefined[ MNUCLR_MENUITEMSELECTEDBACKGROUND2 ] := RGB( 232, 238, 246 ) aUserDefined[ MNUCLR_MENUITEMGRAYEDBACKGROUND1 ] := RGB( 240, 240, 240 ) aUserDefined[ MNUCLR_MENUITEMGRAYEDBACKGROUND2 ] := RGB( 240, 240, 240 ) aUserDefined[ MNUCLR_IMAGEBACKGROUND1 ] := RGB( 241, 241, 241 ) aUserDefined[ MNUCLR_IMAGEBACKGROUND2 ] := RGB( 241, 241, 241 ) aUserDefined[ MNUCLR_SEPARATOR1 ] := RGB( 224, 224, 224 ) aUserDefined[ MNUCLR_SEPARATOR2 ] := RGB( 255, 255, 255 ) aUserDefined[ MNUCLR_SELECTEDITEMBORDER1 ] := RGB( 174, 206, 246 ) aUserDefined[ MNUCLR_SELECTEDITEMBORDER2 ] := RGB( 174, 206, 246 ) aUserDefined[ MNUCLR_SELECTEDITEMBORDER3 ] := RGB( 174, 206, 246 ) aUserDefined[ MNUCLR_SELECTEDITEMBORDER4 ] := RGB( 174, 206, 246 ) RETURN aUserDefined Использование: HMG_SetMenuTheme( MNUCLR_THEME_USER_DEFINED, , GetWin7Theme() ) Благодарю за ваше внимание

SergKis: gfilatov2002 пишет - MNUCLR_THEME_DEFAULT; - MNUCLR_THEME_XP; - MNUCLR_THEME_2000; - MNUCLR_THEME_DARK. - MNUCLR_THEME_USER_DEFINED Как то сложновато запоминать, может упростить чуток ?[pre2] HMG_SetMenuTheme( "DEFAULT" ) HMG_SetMenuTheme( "XP" ) HMG_SetMenuTheme( "2000" ) HMG_SetMenuTheme( "DARK" ) HMG_SetMenuTheme( "USER", ... ) [/pre2]

gfilatov2002: SergKis пишет: Как то сложновато запоминать Это просто числовые константы: MNUCLR_THEME_DEFAULT = 0; MNUCLR_THEME_XP = 1 ; MNUCLR_THEME_2000 = 2; MNUCLR_THEME_DARK = 3. MNUCLR_THEME_USER_DEFINED = 99 так что можно использовать числа вместо имен

SergKis: gfilatov2002 Можно в сервер примера LetoDbf внести небольшие изменения, для проверки наличия\запуска сервера в памяти на localhost из клиента ? Или обходится своей сборкой ?[pre2] STATIC s_cIniName := "letodb.ini" STATIC s_hMutex := 0 THREAD STATIC s_hWASet PROCEDURE Main( cCommand, cData ) LOCAL oApp LOCAL cMutex := upper( hb_ProgName() ), lMutex IF Empty( cCommand ) AEval({".","\",":","/"," "}, {|cs| cMutex := StrTran(cMutex, cs, "_") }) s_hMutex := wapi_CreateMutex( NIL, NIL, cMutex ) lMutex := ( ! Empty( s_hMutex ) .AND. wapi_GetLastError() == 0 ) IF ! lMutex WrLog( "LetoDBF Server is running. Error "+hb_ntos(wapi_GetLastError())+" mutex "+cMutex ) RETURN ENDIF ENDIF s_cDirBase := hb_DirBase() leto_setDirBase( s_cDirBase ) ... IF cCommand != NIL .AND. Lower( cCommand ) == "stop" IF ! EMPTY( cData ) ... WrLog( "Can't STOP the server at port " + ALLTRIM( STR( oApp:nPort ) ) + " ( not started ? )" ) ENDIF IF ! empty( s_hMutex ) wapi_ReleaseMutex( s_hMutex ) ; s_hMutex := 0 ENDIF ELSEIF cCommand != NIL .AND. Left( Lower( cCommand ), 6 ) == "reload" ... [/pre2]

gfilatov2002: SergKis пишет: Можно в сервер примера LetoDbf внести небольшие изменения Пересобрал сервер с этими изменениями, все работает нормально. Благодарю за помощь

gfilatov2002: Опубликована новая сборка 20.06 для BCC 5.8.2 и компиляторов Harbour и xHarbour. Базовый дистрибутив находится по адресу http://hmgextended.com/files/CONTRIB/hmg-20.06-setup.exe Добавил также архив для бесплатного Embarcadero C++ 10.2 'Tokyo' compiler http://hmgextended.com/files/CONTRIB/hmg2003_bcc102.exe Огромная благодарность Сергею Киселеву за помощь при подготовке этой сборки Для частного использования подготовлены также два дистрибутива, основанные на компиляторе MinGW GNU C версии 10.1.1. Благодарю за ваше внимание

gfilatov2002: Выложил обновление для сборки 20.06 (Update 1) с учетом последних исправлений Базовый дистрибутив для BCC 5.8.2 находится по адресу http://hmgextended.com/files/CONTRIB/hmg-20.06-setup.exe Благодарю за ваше внимание

Andrey: gfilatov2002 пишет: Выложил обновление для сборки 20.06 (Update 1) с учетом последних исправлений Пере собрал свои проги ! Полёт нормальный ! Можно команду SET MULTIPLE OFF WARNING сделать через AlertStop() ?

Haz: Andrey пишет: Можно команду SET MULTIPLE OFF WARNING сделать через AlertStop() ? не надо. Или стандарт или с выбором куда выводить. Дизайн AlertStop() не к любому интерфейсу по фейсу Ps.. Кому нужно будет, могут команду переопределить

Andrey: Haz пишет: Кому нужно будет, могут команду переопределить А как ? Писать свою функцию не хочется. Можно переключатель сделать в стандартной библиотеке ?

Haz: Andrey пишет: А как ? Писать свою функцию не хочется. зачем писать свою. Посмотри как в ch команда транслируется и замени для себя msgstop() на что хочешь.

Andrey: Haz пишет: Посмотри как в ch команда транслируется и замени для себя msgstop() на что хочешь. Не, это не то... Ладно, проехали... Не особо существенно это. Другая проблема достаёт. Под Win 8.1 нет у меня сообщения из функции WaitWindow( cMessage, lNoWait ). Под ХР, 7, 10 всё есть. Нашёл эту функцию в h_windows.prg Сделал отладку и увидел почему так: [pre2] @ iif( IsVistaOrLater(), 4, 7 ), 12 LABEL Message ; WIDTH GetProperty( cFormName, "Width" ) - 24 - GetBorderWidth() ; HEIGHT 18 VALUE cMessage SIZE 10 CENTERALIGN TRANSPARENT END WINDOW ? "hb_osIsWin8()=",hb_osIsWin8() ? "nWidth := GetTextWidth( , '"+cMessage+"')" ? "nWidth := ", nWidth ? GetProperty( cFormName, "Width" ), "<", 2 * nWidth ? GetProperty( cFormName, "Width" ) < 2 * nWidth IF GetProperty( cFormName, "Width" ) < 2 * nWidth SetProperty( cFormName, "Message", "Value", "" ) _DefineTimer( "Timer", cFormName, 100, {|| EfeitoLabel( cMessage ) } ) ENDIF[/pre2] В отладке вот так: [pre2]My test program (2): Запуск второй копии программы / Starting a second copy of the program hb_osIsWin8()= .T. nWidth := GetTextWidth( , 'My test program (2): Запуск второй копии программы / Starting a second copy of the program' ) nWidth := 611 800 < 1222 .T. [/pre2] Исправить в коде это можно ?

Haz: Andrey пишет: Исправить в коде это можно ? Андрей, конечно можно исправить. Напиши Григорию обоснованное исправление и он точно скажет тебе спасибо. Из твоей отладки я вижу, что по условию выдаст пустую строку. Кто и зачем это условие поставил я не задумывался. В принципе исходник простой, разобраться не сложно.

Andrey: А кто нибудь пользовался примером MiniGUI\SAMPLES\Advanced\Decompiler ? А то у меня Decompiler.exe вылетает с ошибкой: [pre2]Application: W:\HB_Project\PROJECT\ТЕСТ\Decompiler.exe Time from start: 0 days 0 hours 0 mins 15 secs Error BASE/1132 Bound error: array access Args: [1] = A { ... } length: 1 [2] = N 2 --------------------------------- Stack Trace --------------------------------- Called from DCP_F80(739) in module: Decompiler.prg Called from DCP_F25(674) in module: Decompiler.prg Called from DCP_SPLIT_CODE(337) in module: Decompiler.prg Called from DECODE_C2PRG(38) in module: Decompiler.prg Called from E2CHD(167) in module: Decompiler.prg Called from (b)MAIN(27) in module: Decompiler.prg Called from _DOCONTROLEVENTPROCEDURE(1901) in module: h_windows.prg Called from EVENTS(1757) in module: h_events.prg Called from DOMESSAGELOOP(0) Called from _ACTIVATEWINDOW(1514) in module: h_windows.prg Called from MAIN(23) in module: Decompiler.prg [/pre2]

Vlad04: Тест идет, а реальная то же вываливается с ошибкой Error BASE/1132 Bound error: array access, но в других местах. Я её и раньше проверял - никогда она нормально не работала.

Andrey: Печально...

rvu: gfilatov2002 пишет: Добавил также архив для бесплатного Embarcadero C++ 10.2 'Tokyo' compiler http://hmgextended.com/files/CONTRIB/hmg2003_bcc102.exe Видимо, ссылка неправильная. Скорее всего должно быть http://hmgextended.com/files/CONTRIB/hmg2006_bcc102.exe

gfilatov2002: Выложил обновление для сборки 20.06 (Update 2) с учетом последних наработок Базовый дистрибутив для BCC 5.8.2 находится по адресу http://hmgextended.com/files/CONTRIB/hmg-20.06-setup.exe Благодарю за ваше внимание

SergKis: gfilatov2002 Правка небольшая[pre2] METHOD Enabled( lEnab ) CLASS TSBrowse ... If ::lDrawSuperHd AEval( ::aSuperHead, {|as| AAdd( ::aOldEnabled[4], { as[4], as[5], as[11] } ) } ) EndIf If !Empty(::oPhant) ::oPhant:SaveColor() ::oPhant:nClrHeadBack := ::nCLR_HGRAY ::oPhant:nClrFootBack := ::nCLR_HGRAY EndIf ENDIF ... ELSE IF ! ::lEnabled For nI := 1 TO Len( ::aColumns ) ::aColumns[ nI ]:RestColor() SetColor( , ::aColumns[ nI ]:aColors, nI ) Next If !Empty(::oPhant) ::oPhant:RestColor() EndIf ... [/pre2]

gfilatov2002: SergKis пишет: Правка небольшая OK

Andrey: SergKis пишет: Правка небольшая METHOD Enabled( lEnab ) CLASS TSBrowse А курсор активный серым цветом можно сразу сделать в этом методе ? Было бы удобней так.

Haz: Andrey пишет: А курсор активный серым цветом можно сразу сделать в этом методе ? Было бы удобней так. курсор разный бывает. Я использую только рамочный, чтоб не терять подсветку ячеек ( обязательные поля и пр). И переключение с рамки на серый лайтбар будет не эстетично 😎

SergKis: Haz пишет Я использую только рамочный, чтоб не терять подсветку ячеек ( обязательные поля и пр). И переключение с рамки на серый лайтбар будет не эстетично Не только не эстетично, но главное теряется фокус, с какой строкой тсб идет манипуляция (заблокировав тсб), что визуально важно. А сменить цвет для выбранной строки, поставь нужный всем колонкам (старый ты знаешь или сохрани), сделай :DrawSelect() :Enabled(.F.) потом :Enabled(.T.) Старый цвет restore :DrawSelect()

Haz: SergKis пишет: Не только не эстетично, Сергей, я о том же. В остальном привык все установки делать руками, включая управление цветом. Иметь базовое стандартное решение это хорошо, но только до тех пор, пока свое писать дольше чем исправлять базу. Мне пока проще вместо :enabled() использовать :lEnable и свои игры с цветом.

SergKis: Haz пишет я о том же ... Мне пока проще вместо :enabled() Полностью с тобой согласен, а :Enabled() совсем не использую, окно модал, не закрывая тсб с вертушкой\градусником достаточно в районе StatusBar. Часто надо что бы тсб "шевелилось" в это время, а :Enabled() отрубает некоторые методы.

Haz: SergKis пишет: а :Enabled() совсем не использую Сергей, подумал есть вариант быстро затенять весь бровс , не заботясь о сохранении изначального цвета. Суть в следующем: Весь объект рисуется через TSDrawCell(), цвета передаются параметрами. Можно задать флаг lGreyScale в переменных бровса , а цвета переопределять в зависимости от флага. к примеру nClrBack завернуть как if( ::lGrayScale, RgbToGray(nClrBack), nClrBack ) и так везде. Сама RgbToGray() - простое преобразование цвета в градации серого [pre2] Static function RgbToGray(RGBColor) local nGray nGray := Round((0.30*GetRgb(RGBColor)[1])+(0.59*GetRgb(RGBColor)[2])+(0.11*GetRgb(RGBColor)[3]),0) Return RGB(nGray, nGray, nGray) Static Function GetRGB(nColor) LOCAL nR := 0 LOCAL nG := 0 LOCAL nB := 0 LOCAL cColor := NTOC(nColor, 16) nR := CTON(SUBSTR( cColor, 5, 2 ), 16) nG := CTON(SUBSTR( cColor, 3, 2 ), 16) nB := CTON(SUBSTR( cColor, 1, 2 ), 16) RETURN {nR, nG, nB } [/pre2] В теории должно работать , вырубил флаг и бровс опять цветной. PS возможны нюансы с отрицательным знечением цвета, но уверен легко устранимые . Зато нет нужды сохранять и восстанавливать , а для скорости и простоты все делать через обертку для TSDrawCell() , которая и заменяет цвет перед подачей в оригинальную TSDrawCell() ЗЗЫ проверил - криво работает преобразование в грей, нужен алгоритм другой

Haz: Haz пишет: ЗЗЫ проверил - криво работает преобразование в грей, нужен алгоритм другой Все работает , цвета в серый преобразовываются поменял в базовом примере ColorsTable функцию GetColumnBackColor() на это [pre2] Function GetColumnBackColor( n ) Local cColor Local nGray cColor := aColors [ n ] [ 2 ] nGray := Round(0.3*Val( Token( cColor, " ", 1 ) ) + 0.59*Val( Token( cColor, " ", 2 ) ) + 0.11*Val( Token( cColor, " ", 3 ) ),0 ) Return { nGray, nGray, nGray } [/pre2] и получил все серенькое , значит идея жива

SergKis: Haz пишет есть вариант быстро затенять весь бровс , не заботясь о сохранении изначального цвета. Может не врубаюсь, вариантов покрасить тсб много, от ф-й в блоках кода на колонку, "Enabled(.T.\.F.) и то что предлагаешь, а еще можно переменные иметь (вдруг не серый свет надо, а зеленый и .т.д.) и от них плясать. В чем смысл и цель ? То что есть, хватает, а усложнять ... и так приходится, то в кусок кода лезть, то в сам h_tbrowse.prg, что бы вспомнить детали. Есть еще oCol:Cargo, доп. к oBrw:Cargo можно для каждой колонки определить все что хочешь и отрабатывать. На мой взгляд, то что есть достаточно, а красить в серый, зеленый, синий, ... это уже как кому хочется, варианты есть. Все работает , цвета в серый преобразовываются поменял в базовом примере ColorsTable функцию GetColumnBackColor() на это Что то не нашел такую ф-ю в примерах. О каком примере речь ?

Haz: SergKis пишет: На мой взгляд, то что есть достаточно, а красить в серый, зеленый, синий, ... это уже как кому хочется, варианты есть. Просто интересно стало можно ли цветной бровс показать в градациях серого без переопределения всех цветов. Попробовал функцию конвертации цвета в серый- работает. Тренировался тут MiniGUI\SAMPLES\BASIC\ColorsTable\demo.prg GetColumnBackColor() живет там.

SergKis: Haz пишет Просто интересно стало можно ли цветной бровс показать в градациях серого без переопределения всех цветов. Большой разницы не вижу, делать как в :Enabled() с сохранением и восстановлением или через переменную предложенную, т.к. это надо проделывать в :DrawSuper(), :DrawHeader() (внутри нее :lDarawSpcHd, :lDrawFooter), :DrawLine(), DrawSelect() и учесть в последнем отрицательные цвета Просто интересно стало можно ли цветной бровс показать в градациях серого без переопределения всех цветов. Попробовал функцию конвертации цвета в серый- работает. Ф-я работает А пример искал в Advanced

Andrey: Haz пишет: Сергей, подумал есть вариант быстро затенять весь бровс , не заботясь о сохранении изначального цвета. Я уже давно использую свою функцию ОТДЕЛЬНУЮ для этого. Выкладывал уже исходник. Эта функция интересна ещё тем, что блокирует автоматом все дальнейшие нажатия на форме. И картинки на форме четко затеняет. Т.е. из Си вызывается окно с размерами формы и затеняет своё окно заданным цветом. После того как нужно убрать затенение вызываем другую функцию. Параметр - хендл затеняющего окна. Вот примерно так: [pre2] :aColumns[nI]:bPrevEdit := {|| Darken2Open(hWin) ,; // Затенение на форме myColorEditTsb(oBrw) ,; Darken2Close(hWin) ,; // Убрать затенение на форме oBrw:Setfocus(), FALSE }[/pre2]

Haz: Andrey пишет: давно использую свою функцию ОТДЕЛЬНУЮ для этого. Речь не об этом. Андрей , то что ты предлагаешь, это поверх окна бровса открывать полупрозрачное в размер, как делают скринлокеры. Несколько лет назад с Димой попробовали это делать. Я делал тень окна, открывал полупрозрачное под окном и со смещением. Минусов больше чем плюсов. Во первых не на всех операционках корректно работало ( на каком-то вин сервере не сработала). Во вторых , по кнопкам альт-тав и пр идёт переключение . Или твой пример не об этом этом?

SergKis: Andrey пишет Выкладывал уже исходник. Может выложишь, т.к. в примерах hmg ее нет. Будет понятнее. Haz пишет Просто интересно стало можно ли цветной бровс показать в градациях серого без переопределения всех цветов. Если вынести вызов TSDrawCell() в метод :TSDrawCell(), заменив локальные переменные на переменные объекта TSBcell и вызывать метод после заполнения объекта oColumn:oCell во всех местах, заменив вызов ф-ии, то можно проделывать разное в блоке кода :bTSDrawCell, примерно так new method[pre2] METHOD TSDrawCell( oColumn, nColumn ) LOCAL lDraw := .F. LOCAL oCell := oColumn:oCell IF ISBLOCK( ::bTSDrawCell ) IF ! empty( EVal( ::bTSDrawCell, nColumn, oColumn, Self ) ) RETURN lDraw ENDIF ENDIF lDraw := TSDrawCell( oCell:hWnd, ; // 1 oCell:hDC, ; // 2 oCell:nRowPos, ; // 3 oCell:nStartCol, ; // 4 ... RETURN lDraw [/pre2] Вопрос надо ли ?

Andrey: SergKis пишет: Может выложишь, т.к. в примерах hmg ее нет. Будет понятнее. Вот - https://cloud.mail.ru/public/2PS7/4oMjm4KTR

Andrey: Григорий ! Задание фонтов для ТСБ не работает. [pre2] aFont := { "Cell", "Head", "Foot", "SpecH", "SuperH", "Edit" } DEFINE TBROWSE oBrw AT nY, nX ; .... FONT aTsbFont ;[/pre2] Сергей дал свой h_tbrowse.prg, с ним заработало !

SergKis: Andrey пишет Сергей дал свой h_tbrowse.prg, с ним заработало ! Я добавил только[pre2] Method AddSuperHead( nFromCol, nToCol, uHead, nHeight, aColors, l3dLook, uFont, uBitMap, lAdjust, lTransp, ; ... hFont := iif( ! Empty(uFont), iif( ValType( uFont ) == "O", uFont:hFont, uFont ), hFont ) If ! Empty( ::aColumns ) .and. empty( hFont ) hFont := iif( ValType( ::aColumns[ nFromCol]:hFontHead ) == "O", ::aColumns[ nFromCol]:hFontHead, ; iif( ::aColumns[ nFromCol]:hFontHead != Nil, ::aColumns[ nFromCol]:hFontHead, hFont ) ) EndIf [/pre2]

gfilatov2002: SergKis пишет: If ! Empty( ::aColumns ) .and. empty( hFont ) Ok Благодарю за помощь

Haz: SergKis пишет: Вопрос надо ли ? не надо. 😎 это была так скажем идея интересующимся. Не стоит перегружать объект редко используемым функционалом. Tsb и так скоро будет перегружен тем, что используется редко. Главная беда tsb это не отсутствие функционала, его можно дописать. Главная беда это тормозной вывод на экран, отсутствие буферизации и пр. Если вверх/вниз еще можно скролл окна использовать, вправо/влево все в прорисовке по ячейкам. Раз сто смотрел код , из мыслей как сделать оптимальнее только скролл окна и прорисовка появившейся колонки . но пока или руки не дошли или текучка так давит, что уже не до рук

gfilatov2002: Выложил обновление для сборки 20.06 (Update 3) с учетом последних исправлений Базовый дистрибутив для BCC 5.8.2 находится по адресу http://hmgextended.com/files/CONTRIB/hmg-20.06-setup.exe Благодарю за ваше внимание

gfilatov2002: Выложил обновление для сборки 20.06 (Update 4) с учетом последних исправлений Базовый дистрибутив для BCC 5.8.2 находится по адресу http://hmgextended.com/files/CONTRIB/hmg-20.06-setup.exe Важно: в этом обновлении переработана поддержка графических файлов в форматах BMP, GIF, TIF, JPG и PNG для всех элементов управления (в т.ч. Tab Pages)

Andrey: gfilatov2002 пишет: в этом обновлении переработана поддержка графических файлов А в чём это заключается ?

Dima: Andrey пишет: А в чём это заключается ? ChangeLog.txt

gfilatov2002: Andrey пишет: в чём это заключается ? Для пользователей библиотеки добавлена возможность использовать популярный формат PNG практически для всех элементов управления, при этом Си-код ядра был упрощен и стал универсальным (я только адаптировал наработки Клаудио Сото для HMG, которые он сделал еще в 2014 году).

Andrey: Что то PNG в ТСБ очень фигово выглядит !!! Если ставишь PNG в суперхидер и шапку (подвал наверное тоже), то картинка фиговая становиться... Цвета заливки берутся из цвета и вся красота накрывается. Может я и неправильно что то делаю.

gfilatov2002: Andrey пишет: PNG в ТСБ очень фигово выглядит Функция LOADIMAGE(), которая используется в TBROWSE для загрузки картинок, имеет всего 2 параметра и заточена для загрузки BMP файлов в целях совместимости. Если добавить в нее дополнительные параметры, то можно попробовать подстроить ее для формата PNG. Или можно использовать для загрузки картинок другую (уже готовую) функцию C_SETPICTURE(), которая имеет все эти дополнительные параметры

Andrey: gfilatov2002 пишет: Или можно использовать для загрузки картинок другую (уже готовую) функцию C_SETPICTURE(), которая имеет все эти дополнительные параметры Хотелось бы это иметь в ТСБ. Вот ещё пример:

SergKis: gfilatov2002 Может немного поправить Row в h_alert.prg (как то с одной строкой кривовато отображает)[pre2] STATIC FUNCTION FillDlg( cMsg, aOptions, nLineas, cIcoFile, nIcoSize, aBtnColors, bBlock, lClosable, cFont, nMaxLen ) ... ELSE //@ nChrHeight * 1.5 + GetBorderHeight(), nCol ; @ nChrHeight + GetBorderHeight(), nCol ; LABEL Say_01 VALUE AllTrim( cMsg ) OF ( cForm ) ; FONT cFont WIDTH nWidthCli - nCol - GetBorderWidth() - MARGIN / 4 HEIGHT Max( nChrHeight, nIcoSize ) ; FONTCOLOR aFontColor BACKCOLOR aBackColor VCENTERALIGN ENDIF IF nIcoSize > 0 DRAW ICON IN WINDOW ( cForm ) ; AT nChrHeight + GetBorderHeight(), MARGIN / iif( nIcoSize == 32, 1.4, iif( nIcoSize == 48, 1.7, 2 ) ) ; PICTURE cIcoFile WIDTH nIcoSize HEIGHT nIcoSize TRANSPARENT ENDIF ... [/pre2]

gfilatov2002: SergKis пишет: поправить Row в h_alert.prg Сергей, Текст этой одной строки выводится примерно посередине высоты иконки, как и в оригинальной функции MsgInfo(). Не вижу проблемы SergKis пишет: Max( nChrHeight, nIcoSize ) Ага, уже понял

gfilatov2002: Выложил "тихое" обновление для сборки 20.06 (Update 4) с учетом последних исправлений Что нового: - GRID не будет сваливаться, если 1000000 (один миллион) раз запросить значение ячейки грида. Тестовый пример для этой ошибки см. ниже [pre] #include "minigui.ch" Function Main() Local aRows [1000] [3] DEFINE WINDOW Form_1 ; AT 0,0 ; WIDTH 450 ; HEIGHT 400 ; TITLE 'Grid Demo' ; MAIN FOR i := 0 TO 99 aRows [ i * 10 + 1] := {'Simpson','Homer','555-5555'} aRows [ i * 10 + 2] := {'Mulder','Fox','324-6432'} aRows [ i * 10 + 3] := {'Smart','Max','432-5892'} aRows [ i * 10 + 4] := {'Grillo','Pepe','894-2332'} aRows [ i * 10 + 5] := {'Kirk','James','346-9873'} aRows [ i * 10 + 6] := {'Barriga','Carlos','394-9654'} aRows [ i * 10 + 7] := {'Flanders','Ned','435-3211'} aRows [ i * 10 + 8] := {'Smith','John','123-1234'} aRows [ i * 10 + 9] := {'Pedemonti','Flavio','000-0000'} aRows [ i * 10 + 10] := {'Gomez','Juan','583-4832'} NEXT i @ 10,10 GRID Grid_1 ; WIDTH 200 ; HEIGHT 330 ; HEADERS {'Last Name','First Name','Phone'} ; WIDTHS {140,140,140}; ITEMS aRows ; VALUE 1 ; TOOLTIP 'Editable Grid Control' ; EDIT ; JUSTIFY { BROWSE_JTFY_LEFT,BROWSE_JTFY_RIGHT, BROWSE_JTFY_RIGHT } @ 10, 250 BUTTON Button_1 CAPTION "Start" ACTION ( Test(), MsgInfo( "Ended" ) ) END WINDOW CENTER WINDOW Form_1 ACTIVATE WINDOW Form_1 RETURN NIL FUNCTION Test FOR i := 1 TO 1000 FOR j := 1 TO 1000 t := GetProperty( 'Form_1', 'Grid_1', 'Cell', i, 3 ) NEXT j do events NEXT i RETURN NIL [/pre]

SergKis: gfilatov2002 Маленькая правка, что бы имена колонок не дублировались[pre2] METHOD Paint() CLASS TSBrowse ... If ::lSelector Default ::nSelWidth := Max( nBmpWidth( ::hBmpCursor ), Min( ::nHeightHead, 25 ) ) oCol := ColClone( ::aColumns[ 1 ], Self ) oCol:bData := {||""} oCol:cHeading := "" oCol:nWidth := ::nSelWidth oCol:lNoHilite := .T. oCol:lFixLite := Empty( ::hBmpCursor ) oCol:nClrBack := oCol:nClrHeadBack oCol:cName := "SELECTOR" ::InsColumn( 1, oCol ) ... [/pre2]

gfilatov2002: SergKis пишет: что бы имена колонок не дублировались Благодарю за помощь Если возможно, проверьте работу переработанной функции LoadImage() [pre2] HB_FUNC( LOADIMAGE ) { HWND hWnd = HB_ISNIL( 2 ) ? GetActiveWindow() : ( HWND ) HB_PARNL( 2 ); HBITMAP hBitmap = NULL; if( hb_parclen( 1 ) > 0 ) { hBitmap = HMG_LoadPicture ( hb_parc( 1 ), // Filename, resource or URL hb_parnidef( 3, -1 ), // Width hb_parnidef( 4, -1 ), // Height hWnd, // Handle of parent window hb_parnidef( 5, 1 ), // Scale factor hb_parnidef( 6, 1 ), // Transparent hb_parnldef( 7, -1 ), // BackColor hb_parnidef( 8, 0 ), // Adjust factor hb_parldef( 9, HB_FALSE ), // Bitmap with alpha channel hb_parnidef( 10, 255 ) ); } HB_RETNL( ( LONG_PTR ) hBitmap ); } [/pre2] Пример Tsb_BitMaps у меня отработал нормально

SergKis: gfilatov2002 пишет проверьте работу переработанной функции LoadImage() Старые варианты (картинок немного) с новой LoadImage() отработали нормально Картинок много у Андрея, с доп. параметрами LoadImage() надо у него проверять

Andrey: SergKis пишет: Картинок много у Андрея, с доп. параметрами LoadImage() надо у него проверять Вот сравнение до и после: Картинки могу выслать...

SergKis: Andrey пишет Картинки могу выслать... Ты ф-ю заменил, либу пересобрал и старые примеры с bmp получил ? И картинка по этой ситуации

Andrey: SergKis пишет: Ты ф-ю заменил, либу пересобрал и старые примеры с bmp получил ? Скачал новую версию. Поставил вместо bmp новые png в ресурсы. Пере собрал проект. А зачем либу пере собирать ? Старые примеры на bmp такие же. Я думал можно будет png использовать вместо bmp в ТСБ.

gfilatov2002: Выложил обновление для сборки 20.06 (Update 5) с учетом последних исправлений Базовый дистрибутив для BCC 5.8.2 находится по адресу http://hmgextended.com/files/CONTRIB/hmg-20.06-setup.exe Что нового: [pre2] * Fixed: Possible corruption after a memory allocation in the C-function ListViewGetItem() (introduced in the build 19.04). Reported and contributed by Fernando Yurisich. * Fixed: When loads a Grid control and 'ColumnControls' property is NIL then converts automatically any data type in a text type. Problem was reported by Fernando Yurisich. Contributed by Grigory Filatov <gfilatov@inbox.ru> * Updated: Adaptation FiveWin Class TSBrowse 9.0 in HMG: - minor correction at adding of a Selector in the method Paint(). Contributed by Sergej Kiselev. - the function LoadImage() supports the additional parameters. Syntax: LoadImage( cFilename [, hWnd ][, nWidth ][, nHeight ] ; [, nScale ][, nTransparent ][, nBackColor ][, Adjust ] ; [, lAlpha ][, nAlphaConstant ] ) Requested by Verchenko Andrey. Contributed by Grigory Filatov <gfilatov@inbox.ru> * Updated: HbSQLite3 library: - update for using SQLITE3 latest version 3.33.0dev. Contributed by Grigory Filatov <gfilatov@inbox.ru>. * Updated: 'Data-Bound Controls' sample: - updated function DrawRR() for the round rectangled edit controls. Syntax: DrawRR( nRow, nCol, nHeight, nWidth ; [, lFocus][, cWindowName][, nCurve] ) Requested by Paul Schlicher. Contributed by Grigory Filatov <gfilatov@inbox.ru> (see demo2.prg in folder \samples\Basic\DATA_BOUND) [/pre2]Желаю доброго дня

SergKis: gfilatov2002 пишет Syntax: DrawRR( nRow, nCol, nHeight, nWidth ; [, lFocus][, cWindowName][, nCurve] ) Лучше так, наверное[pre2] PROCEDURE DrawRR( focus, t, l, b, r, cWindowName, nCurve ) DEFAULT t := This.Row, l := This.Col, b := This.Height, r := This.Width DEFAULT focus := .F., cWindowName := ThisWindow.Name, nCurve := 10 DRAW ROUNDRECTANGLE IN WINDOW (cWindowName) ; AT t - 2, l - 2 TO t + b + 2, l + r + 2 ; ROUNDWIDTH nCurve ; ROUNDHEIGHT nCurve ; PENCOLOR iif( focus, { 0, 120, 215 }, { 100, 100, 100 } ) RETURN [/pre2] и может ее включить как HMG_DrawRR(...) в lib ?

SergKis: PS Применение[pre2] @ y,x LABEL Lbl_1 WIDTH w HEIGHT h FONT cFont ; VALUE 'Lbl Value 1' VCENTERALIGN x += This.Lbl_1.Width + oDlu:GapsWidth @ y,x GETBOX Get_1 WIDTH This.ClientWidth - x - oDlu:Left HEIGHT h ; VALUE "Get Value 1"+space(20) FONT cFont ; PICTURE "@K" ; ON GOTFOCUS DrawRR( .T. ) ; ON LOSTFOCUS DrawRR( .F. ) y += This.Lbl_1.Height + oDlu:GapsHeight x := oDlu:Left @ y,x LABEL Lbl_2 WIDTH w HEIGHT h FONT cFont ; VALUE 'Lbl Value 2' VCENTERALIGN x += This.Lbl_2.Width + oDlu:GapsWidth @ y,x GETBOX Get_2 WIDTH This.ClientWidth - x - oDlu:Left HEIGHT h ; VALUE "Get Value 2"+space(20) FONT cFont ; PICTURE "@K" ; ON GOTFOCUS DrawRR( .T. ) ; ON LOSTFOCUS DrawRR( .F. ) [/pre2]

gfilatov2002: SergKis пишет: Лучше так Да, так, конечно, лучше SergKis пишет: Применение Также следует добавить при определении GETBOX класс NOBORDER

SergKis: gfilatov2002 Так еще лучше будет[pre2] PROCEDURE DrawRR( focus, t, l, b, r, cWindowName, nCurve ) LOCAL aColor DEFAULT t := This.Row, l := This.Col, b := This.Height, r := This.Width DEFAULT focus := .F., cWindowName := ThisWindow.Name, nCurve := 10 IF ISARRAY( focus ) ; aColor := focus ELSE ; aColor := iif( focus, { 0, 120, 215 }, { 100, 100, 100 } ) ENDIF DRAW ROUNDRECTANGLE IN WINDOW (cWindowName) ; AT t - 2, l - 2 TO t + b + 2, l + r + 2 ; ROUNDWIDTH nCurve ; ROUNDHEIGHT nCurve ; PENCOLOR aColor // iif( focus, { 0, 120, 215 }, { 100, 100, 100 } ) RETURN [/pre2]

gfilatov2002: SergKis пишет: лучше будет OK

sashaBG: Привет Григорий ! В последних сборках под MINGW не отображаются картинки в меню. Можно проверить на примере MenuEX . Под Visual Studio работает. Все останльное ОК.

gfilatov2002: sashaBG Благодарю за сообщение Уже поправил обе MINGW сборки Кстати, под BCC такая ошибка не проявляется (старый инструмент )

Andrey: gfilatov2002 пишет: Кстати, под BCC такая ошибка не проявляется В последней сборке тоже такая фигня. На одном юзеровском компе это есть (у него Win10). До конца пока не разбирался.

gfilatov2002: Andrey пишет: В последней сборке тоже такая фигня. Я поправил эту проблему в ВСС сборке тоже, просто надо ее еще раз скачать и установить

Andrey: Понял. Спасибо ! Вопрос чисто теоритический ? Можно ли в ТСБ в подвал прикрутить автофильтр как в Экселе ? Юзерам нравиться такой подход по поиску данных.

SergKis: gfilatov2002 Отступ сверху до иконки Label Say_01 в HMG_Alert() большой и не управляемый. Может вынести в static переменную и добавить параметр в HMG_Alert_MaxLines() или новую ф-ю HMG_Alert_RowStart( nRow ) сделать установку и использовать ? Примеры (видно не пропорциональный отступ, меняя фонты и их размеры) Тут https://TransFiles.ru/aul7y

gfilatov2002: SergKis пишет: новую ф-ю HMG_Alert_RowStart( nRow ) Я - за новую функцию Присылайте предложение, как ее лучше использовать внутри HMG_Alert()

SergKis: gfilatov2002 пишет Присылайте предложение, как ее лучше использовать внутри HMG_Alert() Вот что получилось https://TransFiles.ru/4hb07

gfilatov2002: SergKis пишет: Вот что получилось Супер - все работает как надо Благодарю за помощь

SergKis: gfilatov2002 Можно заменить, добавить в h_objects.prg[pre2] CLASS TKeyData ... METHOD Set( Key, Block ) INLINE ( iif( HB_ISHASH( Key ), ::aKey := Key, hb_HSet ( ::aKey, Key, Block ) ), ; ::lKey := ::Len() > 0 ) ... METHOD ISBLOCK( Key ) INLINE HB_ISBLOCK( ::Get( Key ) ) METHOD Json( cJson ) INLINE iif( HB_ISCHAR(cJson), ( cJson := SubS( cJson, At ("{", cJson) ), ; cJson := Left( cJson, RAt("}", cJson) ), ; ::aKey := hb_jsonDecode( cJson ), Self ), ; hb_jsonEncode( ::aKey, !Empty(cJson) ) ) _METHOD GetAll( lAll ) ... [/pre2]

SergKis: PS по инерции набрал, надо[pre2] METHOD Set( Key, Block ) INLINE ( iif( HB_ISHASH( Key ), ::aKey := Key, hb_HSet ( ::aKey, Key, Block ) ), ; ::lKey := ::Len > 0 ) [/pre2]

SergKis: PS2 Применение[pre2] a:=hb_hash() a['dat'] := date() a['0'] := 222 a['TYP'] := "text" a['1'] := "text2" a['kod'] := 7777 o := oKeyData() o:Set(a) hb_MemoWrit( ".\_o_.json", o:Json(.F.)) результат {"dat":"20200801","0":222,"TYP":"text","1":"text2","kod":7777} обратно J := hb_memoread(".\_o_.json") a := oKeyData() ? "a = ", a:Json(J) ?v a:GetAll(.F.) получаем в лог a = 'O' 1 {"dat", "20200801"} 2 {"0", 222} 3 {"TYP", "text"} 4 {"1", "text2"} 5 {"kod", 7777} [/pre2]

gfilatov2002: SergKis пишет: Можно заменить, добавить в h_objects.prg Ok

SergKis: gfilatov2002 Маленькая бяка[pre2] #xcommand DEFINE TBROWSE <name> OBJ <obrw> ; ... [ <.lAutoCol.> ], [ \{<aColSel>\} ], [ <{bInit}> ], ; ... Добавить в FUNCTION _DefineTBrowse( ControlName, ParentFormName, nCol, nRow, nWidth, nHeight, ; ... IF HB_ISARRAY( aColors ) .and. Len( aColors ) > 0 .AND. ValType( aColors[ 1 ] ) == 'A' aColors := aColors[ 1 ] ENDIF IF ISCHAR( uAlias ) .and. !Empty( lLoad ) .and. Empty( aColSel ) aHeaders := {} aNames := {} aColSel := {} (uAlias)->( AEval( array(fCount()), {|cn,nn| cn := FieldName(nn), ; AAdd(aHeaders, cn), AAdd(aNames, cn), AAdd(aColSel, cn) } ) ) IF cell .and. Empty(aColors) aColors := {} AAdd(aColors, { 6, {|c,n,b| c := n, iif( b:nCell == n, -CLR_BLUE, -RGB(128,225,225) ) } } ) AAdd(aColors, {12, {|c,n,b| c := n, iif( b:nCell == n, -CLR_BLUE, -RGB(128,225,225) ) } } ) ENDIF ENDIF ... тогда проходит такой упрощенный вариант DEFINE TBROWSE &cBrw OBJ oBrw AT y,x WIDTH w HEIGHT h CELL ; ALIAS ALIAS() ; FONT {"Normal", "Bold", "Bold"} ; FOOTER .T. ; FIXED COLSEMPTY ; LOADFIELDS GOTFOCUSSELECT ; COLNUMBER { 1, 50 } ; ENUMERATOR ... [/pre2] Пример тут https://TransFiles.ru/eyn5b

gfilatov2002: SergKis пишет: Маленькая бяка Бяку поправил - благодарю за помощь А это не перебор - явно указывать цвета внутри исходника h_tbrowse.prg

SergKis: gfilatov2002 пишет А это не перебор - явно указывать цвета внутри исходника h_tbrowse.prg Можно не указывать, возможно, это перебор. Есть в DEFINE ... назначение. и там можно указать. У себя спрячу умолчания во внутрь, что бы меньше писать. Согласен, что это лишнее

SergKis: PS Можно так[pre2] Local aClr := {} ... AAdd(aClr, { 6, {|c,n,b| c := n, iif( b:nCell == n, -CLR_BLUE, -RGB(128,225,225) ) } } ) AAdd(aClr, {12, {|c,n,b| c := n, iif( b:nCell == n, -CLR_BLUE, -RGB(128,225,225) ) } } ) DEFINE TBROWSE &cBrw OBJ oBrw AT y,x WIDTH w HEIGHT h CELL ; ALIAS ALIAS() ; FONT {"Normal", "Bold", "Bold"} ; COLORS aClr ; FOOTER .T. ; FIXED COLSEMPTY ; LOADFIELDS GOTFOCUSSELECT ; COLNUMBER { 1, 50 } ; ENUMERATOR ... [/pre2] будет тоже самое

gfilatov2002: SergKis пишет: Согласен, что это лишнее OK SergKis пишет: Можно так ... будет тоже самое Спасибо

SergKis: gfilatov2002 Небольшая правка[pre2] FUNCTION _wPost( nEvent, nIndex, xParam ) ... IF nIndex:ClassName == 'TSBROWSE' oWnd := _WindowObj( nIndex:cParentWnd ) IF ! HB_ISOBJECT( oWnd ) ; RETURN NIL ENDIF nIndex := oWnd:GetObj( nIndex:cControlName ):Index ... FUNCTION _wSend( nEvent, nIndex, xParam ) ... IF nIndex:ClassName == 'TSBROWSE' oWnd := _WindowObj( nIndex:cParentWnd ) IF ! HB_ISOBJECT( oWnd ) ; RETURN NIL ENDIF nIndex := oWnd:GetObj( nIndex:cControlName ):Index ... [/pre2]

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

SergKis: gfilatov2002 Пример с исп. изменений https://TransFiles.ru/zc7jl

gfilatov2002: SergKis пишет: Пример с исп. изменений Благодарю за значительно расширенный пример

SergKis: gfilatov2002 пишет Благодарю за значительно расширенный пример Расширение на любителя , не исп. ранее в тсб on gotfocus, on lostfocus и получил ошибку _wSend(), _wPost(), по инерции добавил карточку, опять же, на AlertOkCancel(). Я не специально, так получилось

SergKis: gfilatov2002 Для пробы (с Игорем обсуждали такую схему) - добавил блок кода DATA bTSDrawCell // In ::TSDrawCell(...) execute - вынес вызов TSDrawCell() в метод :TSDrawCell(), заменив локальные переменные на переменные объекта TSBcel и поправил вызовы ф-ии на метод (кроме SuperHeader). Это позволило в карточке примера получить логическую переменную в виде image и по Enter менять значение, т.е. можно налету подменять данные для ф-ии TSDrawCell() Мне показалось это интересным. Пример и h_tbrowse.prg тут https://TransFiles.ru/me4mq

gfilatov2002: SergKis пишет: - вынес вызов TSDrawCell() в метод :TSDrawCell(), заменив локальные переменные на переменные объекта TSBcel и поправил вызовы ф-ии на метод (кроме SuperHeader). Это позволило в карточке примера получить логическую переменную в виде image и по Enter менять значение, т.е. можно налету подменять данные для ф-ии TSDrawCell() Мне показалось это интересным. Это интересно уже тем, что повторяющийся код вынесен в один метод. Проверил - пример отработал нормально. Благодарю за помощь

Haz: SergKis пишет: Мне показалось это интересным. Интересным и перспективным. Спасибо, отличная идея

SergKis: gfilatov2002 Кусочек текста для SuperHeader [pre2] METHOD DrawSuper( lDrawCell ) CLASS TSBrowse ... Else l3DText := nClr3dL := nClr3dS := Nil EndIf /* IF lDrawCell TSDrawCell( hWnd, ; // 1 hDC, ; // 2 0, ; // 3 nStartCol, ; // 4 nWidth, ; // 5 cHeading, ; // 6 nHAlign, ; // 7 nClrFore, ; // 8 nClrBack, ; // 9 hFont, ; // 10 hBitMap, ; // 11 nHeightHead, ; // 12 l3DLook, ; // 13 nLineStyle, ; // 14 nClrLine, ; // 15 3, ; // 16 1=Header 2=Footer 3=Super nHeightHead, ; // 17 nHeightFoot, ; // 18 nHeightSuper, ; // 19 nHeightSpecHd, ; // 20 lAdjBmp, ; // 21 lMulTi, ; // 22 Multiline text nVAlign, ; // 23 0, ; // 24 nVertLine nClrTo, ; // 25 lOpaque, ; // 26 iif( lBrush, nClrBack:hBrush, 0 ), ; // 27 l3DText, ; // 28 3D text nClr3dL, ; // 29 3D text light color nClr3dS ) // 30 3D text shadow color ELSE */ IF aSupHd == NIL aSupHd := {} ENDIF oSupHd := TSBcell():New() oSupHd:nRow := 0 oSupHd:nCol := nStartCol oSupHd:nWidth := nWidth oSupHd:nHeight := ::nHeightSuper oSupHd:nCell := nI oSupHd:uValue := cHeading oSupHd:lDrawLine := .F. // DrawLine() If nI <= Len( aSuperHead ) oSupHd:nFromCol := aSuperHead[ nI, 1 ] oSupHd:nToCol := aSuperHead[ nI, 2 ] EndIf oSupHd:hWnd := hWnd // 1 oSupHd:hDC := hDC // 2 oSupHd:xRow := 0 // 3 oSupHd:nStartCol := nStartCol // 4 oSupHd:nSize := nWidth // 5 oSupHd:uData := cHeading // 6 oSupHd:nAlign := nHAlign // 7 oSupHd:nClrFore := nClrFore // 8 oSupHd:nClrBack := nClrBack // 9 oSupHd:hFont := hFont // 10 oSupHd:hBitMap := hBitMap // 11 oSupHd:nHeightCell := nHeightHead // 12 oSupHd:l3DLook := l3DLook // 13 oColumn:l3DLook oSupHd:nLineStyle := nLineStyle // 14 oSupHd:nClrLine := nClrLine // 15 oSupHd:nDrawType := 3 // 16 0-line/1-header/2-footer/3-super oSupHd:nHeightHead := nHeightHead // 17 oSupHd:nHeightFoot := nHeightFoot // 18 oSupHd:nHeightSuper := nHeightSuper // 19 oSupHd:nHeightSpecHd := nHeightSpecHd // 20 oSupHd:lAdjBmp := lAdjBmp // 21 oSupHd:lMultiline := lMulti // 22 Multiline text oSupHd:nVAlign := nVAlign // 23 oSupHd:nVertText := 0 // 24 nVertLine oSupHd:nClrTo := nClrTo // 25 oSupHd:lOpaque := lOpaque // 26 oSupHd:hBrush := iif( lBrush, nClrBack:hBrush, 0 ) // 27 iif( lBrush, nClrBack:hBrush, 0 ) oSupHd:l3DText := l3DText // 28 3D text oSupHd:nClr3dL := nClr3dL // 29 3D text light color oSupHd:nClr3dS := nClr3dS // 30 3D text shadow color oSupHd:nCursor := 0 // 31 Rect cursor oSupHd:lInvertColor := .F. // 32 Invert color AAdd( aSupHd, oSupHd ) IF lDrawCell ::TSDrawCell( oSupHd ) ENDIF nStartCol += nWidth ... [/pre2]

SergKis: PS В примере пропустил [pre2] oCol:bPostEdit := {|cv,ob,nc,oc,xv,ct,nl,nd| nc := ob:nCell oc := ob:aColumns[nc] xv := ob:aArray[ob:nAt][3] ct := ob:aArray[ob:nAt][4] nl := ob:aArray[ob:nAt][5] nd := ob:aArray[ob:nAt][6] If ct == "N" cv := alltrim(cv) If len(cv) > nl ; cv := right(cv, nl) EndIf cv := Ltrim(Str(Val(cv), nl+3, nd)) xv := val(cv) ob:aArray[ob:nAt][3] := xv ob:SetValue(oc, cv) ElseIf ct == "D" xv := CtoD(cv) cv := cValToChar(xv) ob:aArray[ob:nAt][3] := xv ob:SetValue(oc, cv) ElseIf ct == "C" ob:aArray[ob:nAt][3] := cv EndIf ob:Refresh(.F.) ; DO EVENTS ob:Cargo:oCar:nMod += 1 _wSend(3, ob) Return Nil } [/pre2]

gfilatov2002: SergKis пишет: для SuperHeader Спасибо, сделал SergKis пишет: В примере добавил

SergKis: gfilatov2002 Поправил пример, при работе с карточкой данные в колонке "Value" не меняют тип (ранее был "C") и режим Edit учитывает это в блоках кода :bPrevEdt, :bPostEdit. Тут https://TransFiles.ru/ppqsg

gfilatov2002: SergKis пишет: Поправил пример Спасибо, обновил пример также (с форматированием).

SergKis: gfilatov2002 Сборка mgDBU Compile.bat (с build.bat ok!) выдает DBUVIEW.prg(66) Error E0030 Syntax error "syntax error at 'BEFORE'"

SergKis: Разобрался. Забываю, что в этом Compile.bat есть строка @if "%MG_ROOT%"=="" set MG_ROOT=c:\minigui которую надо править каждый раз на @if "%MG_ROOT%"=="" set MG_ROOT=c:\miniguiBcc58 в др. Compile.bat берется из minigui.cfg. там правлю всегда [pre2] # Basic configuration for Compile.bat MG_CMP=harbour MG_BCC=c:\borland\bcc58 MG_ROOT=c:\miniguiBcc58 [/pre2]

SergKis: PS Сделал Compile.bat [pre2] rem @if "%MG_ROOT%"=="" set MG_ROOT=c:\minigui call ..\..\batch\compile.bat MGDBU /nl %1 %2 %3 %4 %5 %6 %7 %8 %9 call ..\..\batch\compile.bat DBUEDIT /nl %1 %2 %3 %4 %5 %6 %7 %8 %9 call ..\..\batch\compile.bat DBUVIEW /nl %1 %2 %3 %4 %5 %6 %7 %8 %9 call ..\..\batch\compile.bat MGDBU /lo /b DBUEDIT /b DBUVIEW /r MGDBU_ %1 %2 %3 %4 %5 %6 %7 %8 %9 call ..\..\batch\compile.bat MGDBU /do %1 %2 %3 %4 %5 %6 %7 %8 %9 call ..\..\batch\compile.bat DBUEDIT /do %1 %2 %3 %4 %5 %6 %7 %8 %9 call ..\..\batch\compile.bat DBUVIEW /do %1 %2 %3 %4 %5 %6 %7 %8 %9 [/pre2] mgDBU.exe собрался

Haz: SergKis пишет: Сборка mgDBU Сергей, ностальгируешь? Решил про DBU вспомнить ?

SergKis: Haz пишет Решил про DBU вспомнить ? На vwt и hb 2.0 своя утилита уже устарела (тексты еще с clipper брались без больших изменений), вроде надо новую собрать, руки никак не дойдут, но иногда поглядываю в эту сторону. Мне нужна unicode версия (hmg такая есть) для LV866. Изменения с тек. версией hmg и своей согласовал, проверил. Думаю, почему бы не глянуть mgDbu ?

SergKis: gfilatov2002 При работе с HOTKEY не логично получается ситуация, когда задаем[pre2] ON KEY F2 OF This.Name ACTION MsgBox("Press F2 Info MdiChild ! "+ThisWindow.Name+" <"+This.Name+">", Procname()) и при нажатии получаем Called from MSGMINIGUIERROR(100) in module: h_error.prg Called from VERIFYCONTROLDEFINED(5997) in module: h_controlmisc.prg Called from GETPROPERTY(4815) in module: h_controlmisc.prg Called from (b)MDICHILDOPEN(296) in module: demo.prg Called from _DOCONTROLEVENTPROCEDURE(1901) in module: h_windows.prg Called from EVENTS(695) in module: h_events.prg Called from MDIEVENTS(291) in module: h_windowsmdi.prg Called from DOMESSAGELOOP(0) Called from _ACTIVATEWINDOW(1514) in module: h_windows.prg Called from DOMETHOD(5451) in module: h_controlmisc.prg Called from MAIN(182) in module: demo.prg т.е. в h_events.prg контрол нашелся, что соответствует запуску блока для контрола IF _HMG_BeginWindowMDIActive IF _HMG_aControlParentHandles [ i ] == GetActiveMdiHandle() .OR. _HMG_InplaceParentHandle <> 0 IF _DoControlEventProcedure ( _HMG_aControlProcedures [ i ] , i ) RETURN 0 ENDIF ... и валится в GETPROPERTY(4815) на проверке *-----------------------------------------------------------------------------* STATIC PROCEDURE VerifyControlDefined ( cParentName , cControlName ) *-----------------------------------------------------------------------------* IF _IsControlDefined ( cControlName , cParentName ) == .F. MsgMiniGuiError ( "Control: " + cControlName + " Of " + cParentName + " Not defined." ) ENDIF RETURN ... Для типа HOTKEY не должна валится проверка, т.к. контрол есть но с пустым именем _HMG_aControlType [k] := "HOTKEY" _HMG_aControlNames [k] := '' _HMG_aControlHandles [k] := 0 ... [/pre2] Возможно, надо не делать VerifyControlDefined() для HOTKEY ?

gfilatov2002: SergKis пишет: Для типа HOTKEY не должна валится проверка Сделал, конечно

gfilatov2002: Подготовил 2-ю бету для новой сборки 20.08. Что нового [pre2] * Fixed: Program crash at editing of a first column with the defined IMAGE clause in the Grid control. Bug was reported by Pete D. <pete_westg/at/yahoo.gr>. Contributed by Grigory Filatov <gfilatov@inbox.ru> (see demo in folder \samples\Basic\Grid_ImageIndex) * Fixed: Small correction in the internal function VerifyControlDefined() for protection of the HOTKEY controls which have not an internal name. Problem was reported by Sergej Kiselev. Contributed by Grigory Filatov <gfilatov@inbox.ru>. * Enhanced: Added the auxiliary function HMG_Alert_RowStart() for managing of a start row of a first line in the function HMG_Alert(). Suggested and contributed by Sergej Kiselev (see demo8.prg in folder \samples\Advanced\Tsb_Basic_3) * Enhanced: The internal OOP class TKeyData was improved for Json support: - added the new method Json( cJson ). Usage: a := hb_hash() // create a hash a['dat'] := date() ; a['0'] := 222 ; a['TYP'] := "text" a['1'] := "text2" ; a['kod'] := 7777 o := oKeyData() // create object o:Set( a ) hb_MemoWrit( ".\_o_.json", o:Json( .F. ) ) ... J := hb_MemoRead( ".\_o_.json" ) a := oKeyData() ? "a = ", a:Json( J ) // a = 'O' ?v a:GetAll( .F. ) Suggested and contributed by Sergej Kiselev. * Modified: The default <versioninfo> section may be removed from the application resources with a specify of __VERSION_INFO constant and launch the batch file \Resources\CompileRes.bat. Contributed by Grigory Filatov <gfilatov@inbox.ru> (see minigui.rc in folder \Resources) * Modified: The batch file buildapp.bat from Mingw-based distribution supports the projects with many RC files similar to BCC compiler. You can define the __VERSION_INFO constant in your local RC file for using an user-defined <versioninfo> section. Contributed by Grigory Filatov <gfilatov@inbox.ru> (see Modest.rc in folder \Samples\Modest) * Updated: Adaptation FiveWin Class TSBrowse 9.0 in HMG: - added the new variable :bTSDrawCell and method TSDrawCell(); - improved usage of LOADFIELDS clause for a database. Sample code: DEFINE TBROWSE &cBrw OBJ oBrw AT y,x WIDTH w HEIGHT h CELL ; ALIAS Alias() ; FONT {"Normal", "Bold", "Bold"} ; FOOTER .T. ; FIXED COLSEMPTY ; LOADFIELDS GOTFOCUSSELECT ; COLNUMBER { 1, 50 } ; ENUMERATOR Contributed by Sergej Kiselev (see demo9.prg in folder \samples\Advanced\Tsb_Basic_3) * Updated: HbSQLite3 library: - update for using SQLITE3 latest version 3.33.0dev. Contributed by Grigory Filatov <gfilatov@inbox.ru>. * New: 'RichText Class Test' sample. Related Commands are: - DEFINE RTF / CLOSE RTF - DEFINE PAGESETUP - BEGIN HEADER / END HEADER - BEGIN FOOTER / END FOOTER - WRITE TEXT - NEW PARAGRAPH - DEFINE TABLE / CLOSE TABLE - BEGIN ROW / END ROW - WRITE CELL - NEW SECTION - INSERT PAGENUMBER Based upon a contribution of Tom Marchione for FiveWin library. Adapted for Minigui Extended by Grigory Filatov <gfilatov@inbox.ru> (see in folder \samples\Advanced\RichText) * New: 'TBrowse control placed into Alert messagebox' sample. Contributed by Sergej Kiselev (see demo9.prg in folder \samples\Advanced\Tsb_Basic_3) * New: 'Source Code Formatter' utility. Based upon a code borrowed from OOHG. Adapted for Minigui Extended by Grigory Filatov <gfilatov@inbox.ru> (see in folder \Utils\ofmt) * Updated: 'Data-Bound Controls' sample: - updated function DrawRR() for the round rectangled edit controls. Syntax: DrawRR( [ lFocus ][, nRow ][, nCol ][, nHeight ][, nWidth ] ; [, cWindowName ][, nCurve ] ) Suggested and contributed by Sergej Kiselev (see demo2.prg in folder \samples\Basic\DATA_BOUND) [/pre2] Огромная благодарность Сергею Киселеву за помощь в подготовке этой сборки

SergKis: gfilatov2002 пишет Syntax: DrawRR( [ lFocus ][, nRow ][, nCol ][, nHeight ][, nWidth ] ; [, cWindowName ][, nCurve ] ) Наверно, лучше DrawRR() иметь в таком виде [pre2] *----------------------------------------------------------------------------* FUNCTION DrawRR( focus, nPen, t, l, b, r, cWindowName, nCurve ) *----------------------------------------------------------------------------* LOCAL aColor DEFAULT t := This.Row, l := This.Col, b := This.Height, r := This.Width DEFAULT focus := .F., cWindowName := ThisWindow.Name, nCurve := 5 DEFAULT nPen := 3 IF ISARRAY( focus ) ; aColor := focus ELSE ; aColor := iif( focus, { 0, 120, 215 }, { 100, 100, 100 } ) ENDIF DRAW ROUNDRECTANGLE IN WINDOW (cWindowName) ; AT t - 2, l - 2 TO t + b + 2, l + r + 2 ; ROUNDWIDTH nCurve ROUNDHEIGHT nCurve ; PENCOLOR aColor PENWIDTH nPen RETURN NIL [/pre2] т.к. толщина линии - важный элемент

gfilatov2002: SergKis пишет: лучше DrawRR() иметь в таком виде Да, эта функция присутствует в таком виде в примере demo9, а для примера из папки DATA_BOUND она не требует введения этого дополнительного параметра.

SergKis: gfilatov2002 Может надо добавить в тексты сообщений тсб[pre2] Function LoadMsg() ... aMsg := { "Yes", ; // ::aMsg[ 1 ] ... "Restore Record ?", ; // ::aMsg[ 46 ] (future possible usage) ... и т.д. тогда заменить в METHOD DeleteRow( lAll, lUpStable ) CLASS TSBrowse Local lRecall, nAt, nRowPos, nRecNo, lRefresh, cAlias, lEval, uTemp, cMsg ... If ! ::lIsTxt If ::lConfirm .and. !lAll cMsg := ::aMsg[ 38 ] If ::lIsDbf cMsg := ::aMsg[ 37 ] If lRecall .and. ( cAlias )->( Deleted() ) cMsg := ::aMsg[46] EndIf EndIf If ! MsgYesNo( cMsg, ::aMsg[ 39 ] ) Return .f. EndIf EndIf вместо этого //If ::lConfirm .and. !lAll .and.; // ! MsgYesNo( iif( ::lIsDbf, ::aMsg[ 37 ], ::aMsg[ 38 ] ), ::aMsg[ 39 ] ) // Return .f. //EndIf ... чтобы не делать все время блок кода :SetDeleteMode( .T., .F., {|rec,obr,txt,del| del := (obr:cAlias)->( Deleted() ) txt := iif( del, "Restore", "Delete" )+" "+"record ?" Return MsgYesNo(txt, "Confirmation") }, {|obr| obr:Cargo:nRecnoDraw := 0, obr:DrawSelect() } ) и писать проще :SetDeleteMode( .T., .F., , {|obr| obr:Cargo:nRecnoDraw := 0, obr:DrawSelect() } ) [/pre2] gfilatov2002 пишетSyntax: DrawRR( [ lFocus ][, nRow ][, nCol ][, nHeight ][, nWidth ] ; [, cWindowName ][, nCurve ] ) Подумал речь идет о ф-ии в hmg lib HMG_DrawRR(...) Если только о примерах, тогда OK.

SergKis: PS Поправить забыл[pre2] :SetDeleteMode( .T., .T., , {|obr| obr:Cargo:nRecnoDraw := 0, obr:DrawSelect() } )[/pre2]

gfilatov2002: SergKis пишет: надо добавить Добавил, конечно Благодарю за помощь

SergKis: gfilatov2002 Поправьте [pre2] METHOD GetDeltaLen( nCol, nStartCol, nMaxWidth, aColSizes ) CLASS TSBrowse Local nDeltaLen := 0 If ::lAdjColumn .and. nCol < Len( ::aColumns ) IF aColSizes[ nCol ] == NIL ; aColSizes[ nCol ] := 0 ENDIF IF aColSizes[ nCol+1 ] == NIL ; aColSizes[ nCol+1 ] := 0 ENDIF If ( nStartCol + aColSizes[ nCol ] + aColSizes[ nCol + 1 ] ) > nMaxWidth nDeltaLen := nMaxWidth - ( nStartCol + aColSizes[ nCol ] ) EndIf EndIf RETURN nDeltaLen [/pre2]

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

Andrey: gfilatov2002 А можно ещё поправить показ типов полей "=@T" ? Приходиться таскать функцию всегда при использовании таких полей, иначе обрезает эти поля. [pre2]STATIC FUNCTION myPartWidthTsb( oBrw ) // поправить ширину колонок LOCAL oCol, hFont := oBrw:hFont // 1-cells font WITH OBJECT oBrw FOR EACH oCol IN :aColumns IF oCol:cFieldTyp $ "=@T" oCol:nWidth := GetTextWidth( Nil, REPL("9",24), hFont ) // 24 знака ENDIF NEXT END WITH RETURN Nil[/pre2]

SergKis: Andrey пишет Подтверждаю, что так лучше, особенно, если исп. :nCellMarginLR := 1[pre2] METHOD LoadFields( lEditable, aColSel, cAlsSel, aNameSel, aHeadSel ) CLASS TSBrowse ... ElseIf cType $ "=@T" nSize := GetTextWidth( 0, Replicate( "9", 24 ), hFont ) Else [/pre2]

SergKis: PS И добавить туда обработку полей +, ^ [pre2] ... If cType == "C" cPicture := "@K " + Replicate( 'X', aStru[ nE, 3 ] ) ElseIf cType == "N" cPicture := Replicate( '9', aStru[ nE, 3 ] ) If aStru[ nE, 4 ] > 0 cPicture := SubStr( cPicture, 1, aStru[ nE, 3 ]-aStru[ nE, 4 ] - 1 ) + '.' + Replicate( '9', aStru[ nE, 4 ] ) EndIf cPicture := "@K " + cPicture ElseIf cType $ "^+" cPicture := Replicate( '9', 10 ) EndIf ... ElseIf cType $ "=@T" nSize := GetTextWidth( 0, Replicate( "9", 24 ), hFont ) ElseIf cType $ "^+" nSize := GetTextWidth( 0, Replicate( "9", 10 ), hFont ) Else ... [/pre2] вопрос только в том хватит 10 знаков (особенно для версии) или сделать больше ?

Andrey: А для "D" нужно 11 знаков, если формат такой 99.99.9999 и 9 знаков для 99.99.99 Если поле N или D имеет короткое название ( типа NN , DC), то значения в колонках обрезаются. Нужно бы условие поставить.

SergKis: Andrey пишет Если поле N или D имеет короткое название ( типа NN , DC), то значения в колонках обрезаются. Для типа "D" можно поправить (METHOD LoadFields())[pre2] ... nAlign := iif( ::aJustify != Nil .and. Len( ::aJustify ) >= nE, ::aJustify[ nE ], ; iif( ( cAlias )->( ValType( FieldGet( nE ) ) ) == "N", 2, ; iif( ( cAlias )->( ValType( FieldGet( nE ) ) ) $ "DL", 1, 0 ) ) ) ... ElseIf cType == "D" cData := cValToChar( iif( Empty( cData ), Date(), cData ) ) nSize := Int( GetTextWidth( 0, cData +"BB", hFont ) ) + iif( lEditable, 30, 0 ) ElseIf cType == "M" ... [/pre2]

gfilatov2002: SergKis пишет: можно поправить (METHOD LoadFields()) Добавил эти изменения

SergKis: gfilatov2002 Добавить бы[pre2] METHOD LoadFields( lEditable, aColSel, cAlsSel, aNameSel, aHeadSel ) CLASS TSBrowse ... ATail( ::aColumns ):nFieldDec := aStru[ nE, 4 ] // 18.07.2018 ATail( ::aColumns ):oCellHead := TSBcell():New() ATail( ::aColumns ):oCellEnum := TSBcell():New() ATail( ::aColumns ):oCellFoot := TSBcell():New() ATail( ::aColumns ):oCell := TSBcell():New() ... METHOD AddColumn( oColumn ) CLASS TSBrowse ... AAdd( ::aColumns, oColumn ) ATail( ::aColumns ):oCellHead := TSBcell():New() ATail( ::aColumns ):oCellEnum := TSBcell():New() ATail( ::aColumns ):oCellFoot := TSBcell():New() ATail( ::aColumns ):oCell := TSBcell():New() If Len( ::aColSizes ) < Len( ::aColumns ) ... METHOD InsColumn( nPos, oColumn ) CLASS TSBrowse ... If oColumn:lDefineColumn oColumn:DefColor( Self, oColumn:aColors ) oColumn:DefFont ( Self ) EndIf oColumn:oCellHead := TSBcell():New() oColumn:oCellEnum := TSBcell():New() oColumn:oCellFoot := TSBcell():New() oColumn:oCell := TSBcell():New() Default nPos := 1 ... [/pre2]

SergKis: PS лучше[pre2] METHOD New( cHeading, bData, cPicture, aColors, aAlign, nWidth, ; ... CLASS TSColumn ... ::lTotal := lTotal //V90 ::cName := cName ::oCellHead := TSBcell():New() ::oCellEnum := TSBcell():New() ::oCellFoot := TSBcell():New() ::oCell := TSBcell():New() ... [/pre2]

gfilatov2002: SergKis пишет: CLASS TSColumn Добавил

Andrey: Если поле "N" или "C" имеет короткое название ( типа N1 , C12 ), то значения в колонках обрезаются. Вот как на картинке: У себя приходиться делать всегда так: [pre2]STATIC FUNCTION myPartWidthTsb( oBrw ) // поправить ширину колонок LOCAL oCol, cType, hFont := oBrw:hFont // 1-cells font WITH OBJECT oBrw FOR EACH oCol IN :aColumns cType := oCol:cFieldTyp IF cType $ "=@T" oCol:nWidth := GetTextWidth( Nil, REPL("9",24), hFont ) // 24 знака ELSEIF cType == "D" oCol:nWidth := GetTextWidth( Nil, REPL("9",11), hFont ) ELSEIF cType == "N" .OR. cType == "C" // увеличим ширину колонки для коротких названий полей IF LEN(oCol:cName) < 5 oCol:nWidth := GetTextWidth( Nil, REPL("H", oCol:nFieldLen), hFont ) * 0.8 ENDIF ENDIF NEXT END WITH RETURN Nil[/pre2] Можно добавить это в класс Tsbrowse ? Или ещё как то по другому. И куда это добавить, я не знаю.

SergKis: Andrey Попробуй у себя поправить [pre2] METHOD LoadFields( lEditable, aColSel, cAlsSel, aNameSel, aHeadSel ) CLASS TSBrowse ... If nSize == Nil ... If cType == "C" cData := PadR( Trim( cData ), nSize+1 /* или 2 */, "B" ) nSize := GetTextWidth( 0, cData, hFont ) ElseIf cType == "N" ... У себя, к примеру я для "C" правку делаю, не разбираясь, если поле длина > 50 беру 50, т.е. писать все равно приходится IF o:cFieldTyp == "D" o:cPicture := "@D" ELSEIF o:cFieldTyp == "N" .and. o:nFieldLen < 10 o:nWidth += GetFontWidth("Normal", 2) ELSEIF o:cFieldTyp == "C" IF o:nFieldLen > 50 ; o:nWidth := o:ToWidth( 50 ) ELSE ; o:nWidth += GetFontWidth("Normal", 1) ENDIF ENDIF ... [/pre2]

Andrey: SergKis пишет: Попробуй у себя поправить Да у себя я сам добавлю к ширине колонок нужное ко-во. Хотелось бы что-бы ТСБ это умел делать автоматом.

SergKis: Andrey Так поправь, что написал (это же тсб текст), если поможет, можно править на постоянно. Пример то у тебя, на нем и проверь

Andrey: SergKis пишет: Так поправь, что написал (это же тсб текст), если поможет, можно править на постоянно. Не фига не работает... Попробовал исправить. Колонка в середине S9 (текстовая) - нормальная, а самый последний столбец в таблице F2 (текстовая) - срезается. Пример отправил тебе.

SergKis: Andrey пишет Пример отправил тебе. Убрал виртуальные колонки и все колонки нормальные в размерах С вирт. колонками надо самому ставить размеры, как и было у тебя !

Andrey: SergKis пишет: Убрал виртуальные колонки и все колонки нормальные в размерах Я тоже убрал. Но у меня режутся колонки с "=@T" и последняя текстовая колонка тоже режется. Числовые колонки нормально стали показываться. Может у меня старый h_tbrowse.prg ? Вот картинка: Колонки 23 и 25 (зеленые стрелочки) с типом [+] [^] может расширить до 6-8 знаков ?

SergKis: Andrey пишет Может у меня старый h_tbrowse.prg ? Делал с твоим и сейчас положил в пример свой -> результат одинаковый, колонки не режутся. Твой пример тут https://TransFiles.ru/al858

SergKis: PS h_tbrowse.prg немного отличается от того, который у Григория (method LoadFields с изменениями ранее), наверно, т.к. у меня добавлены еще к "N" "+" и "^". Но большого значения это не имеет

Andrey: SergKis пишет: Делал с твоим и сейчас положил в пример свой -> результат одинаковый, колонки не режутся. Твой пример тут Запускаю этот пример и колонки 24,26,27,28 - съедены ! Как такое может быть, у тебя нормально, а у меня нет ?

SergKis: Andrey Сделай изменения[pre2] STATIC FUNCTION myBrw1( nY, nX, nW, nH, aDatos, aFont, nBrw ) ... mySupHdTsb( oBrw1, aSupHd ) // SuperHeader //myEnumTsb( oBrw1 , 6+1 ) // ENUMERATOR по порядку :GetColumn("ID"):nWidth := (App.Object):W1 :GetColumn("VM"):nWidth := (App.Object):W1 :GetColumn("F1"):nWidth := (App.Object):W2 :GetColumn("F2"):nWidth := (App.Object):W2 :GetColumn("TS"):nWidth := Gjavascript:pst3('','','','[pre2]','[/pre2]');etFontWidth(aFont[1], 20) :GetColumn("IM"):nWidth := GetFontWidth(aFont[1], 20) :GetColumn("DT"):nWidth := GetFontWidth(aFont[1], 20) :GetColumn("TT"):nWidth := GetFontWidth(aFont[1], 20) mySet2Tsb( oBrw1 ) // настройки таблицы дополнительные ... STATIC FUNCTION myBrw2( nY, nX, nW, nH, aDatos, aFont, nBrw ) ... mySupHdTsb( oBrw2, aSupHd ) // SuperHeader //myEnumTsb( oBrw2 , 6+1) // ENUMERATOR по порядку :GetColumn("ID"):nWidth := (App.Object):W1 :GetColumn("VM"):nWidth := (App.Object):W1 :GetColumn("F1"):nWidth := (App.Object):W2 :GetColumn("F2"):nWidth := (App.Object):W2 :GetColumn("TS"):nWidth := GetFontWidth(aFont[1], 20) :GetColumn("IM"):nWidth := GetFontWidth(aFont[1], 20) :GetColumn("DT"):nWidth := GetFontWidth(aFont[1], 20) :GetColumn("TT"):nWidth := GetFontWidth(aFont[1], 20) mySet2Tsb( oBrw2 ) // настройки таблицы дополнительные ... [/pre2] Для Timestamp колонок это как в h_tbrowse.prg, можешь подобрать длину в символах не 20, а сколько надо у тебя Для ID,VM,F1,F2 ширина колонки от dlu задана для фонта SET FONT TO ...

SergKis: Упс, сломалось что то для myBrw1. Исправить просто строки красным из myBrw2 перенести в myBrw1 они одинаковые

gfilatov2002: Завершена подготовка новой сборки 20.08, которая будет опубликована на следующей неделе. Рассматриваю ее как финальную по причинам материального характера (что не удивительно в наше время ). Огромная благодарность Сергею Киселеву за все предложения и идеи по развитию библиотеки Благодарю за ваше внимание

SergKis: Возможно, будет интересно. Пример MDI интерфейса. В целом работает. Не пошел контрол TEXTBOX, возможно еще какие контролы, надо смотреть. Но работая ТОЛЬКО в окнах ChildMdi, без модальных можно многое делать. Пример тут https://TransFiles.ru/cnyt8 Собран с последними изменениями h_tbrowse.prg

gfilatov2002: Опубликована новая сборка 20.08 для BCC 5.8.2 и компиляторов Harbour и xHarbour. Базовый дистрибутив находится по адресу http://hmgextended.com/files/CONTRIB/hmg-20.08-setup.exe Огромная благодарность Сергею Киселеву за помощь при подготовке этой сборки

gfilatov2002: Сделал "тихое" обновление сборки 20.08 Что нового: - заработала печать в примере \samples\Basic\RichEditBox

gfilatov2002: Выпустил 1-е обновление сборки 20.08 Что нового (на языке оригинала): * Updated: Synchronized Extended HMG for compatibility with Official HMG: - New: added commands FINDTEXTDIALOG and REPLACETEXTDIALOG; - New: added in-line feature to the miniprint commands; - New: added RegistryRead() and RegistryWrite() pseudo-functions. Based upon a contribution of Claudio Soto <srvet/at/adinet.com.uy>. Adapted for Minigui Extended by Grigory Filatov <gfilatov@inbox.ru> (see demo in folder \samples\Applications\WordWriter) * New: 'Word Writer' sample. Borrowed from Official HMG distribution. Adapted for Minigui Extended by Grigory Filatov <gfilatov@inbox.ru> (see in folder \samples\Applications\WordWriter) * Updated: 'RichEditBox' sample: - adapted RTF print feature. Contributed by Grigory Filatov <gfilatov@inbox.ru> (see in folder \samples\Basic\RichEditBox) Благодарю всех, кто поддерживал и поддерживает этот проект "на плаву"

Andrey: В новой версии для ТСБ пропадает суперхидер, т.е. пустой суперхидер.

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