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

Автор

Сообщение

gfilatov
модератор
Пост N: 699 Зарегистрирован: 25.05.05

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

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

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

Готовится к опубликованию новая сборка №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 [только новые]

gfilatov2002
moderator
Пост N: 1776 Зарегистрирован: 11.02.10

Отправлено: 02.09.20 21:20. Заголовок: Andrey пишет: для Т..

Andrey пишет:

цитата:

для ТСБ пропадает суперхидер

Благодарю за сообщение

Я уже поправил эту недоработку

Просто еще раз скачайте установщик версии 20.08 с исправлением

SergKis
постоянный участник
Пост N: 3353 Зарегистрирован: 17.02.12

Отправлено: 04.09.20 14:42. Заголовок: gfilatov2002 Показа..

gfilatov2002
Показалось интересным добавить все типы поле в FilterFTS()

 
 	METHOD FilterFTS( cFind, lUpper, lBottom, lFocus, lAll ) 
 	METHOD FilterFTS_Line( cFind, lUpper, lAll ) 
 ... 
 METHOD FilterFTS( cFind, lUpper, lBottom, lFocus, lAll ) CLASS TSBrowse 
 ... 
 	DEFAULT lUpper := .T., lAll := .F. 
 ... 
    If ! Empty( cFind ) 
       ( cAlias )->( DbSetFilter( {|| ob:FilterFTS_Line( cFind, lUpper, lAll, ob ) }, ; 
                                     "ob:FilterFTS_Line( cFind, lUpper, lAll, ob )" ) ) 
    Else 
 ... 
 METHOD FilterFTS_Line( cFind, lUpper, lAll ) CLASS TSBrowse 
 ... 
    DEFAULT lUpper := .T., lAll := .F. 
 ... 
        xVal := ::bDataEval( oCol, , nCol ) 
        IF lAll .and. ! HB_ISCHAR( xVal ) 
           xVal := cValToChar( xVal ) 
        ENDIF 
        If HB_ISCHAR( xVal ) 
 ...

gfilatov2002
moderator
Пост N: 1777 Зарегистрирован: 11.02.10

Отправлено: 04.09.20 15:34. Заголовок: SergKis пишет: доба..

SergKis пишет:

цитата:

добавить все типы

Добавил, конечно

Благодарю за помощь

SergKis
постоянный участник
Пост N: 3354 Зарегистрирован: 17.02.12

Отправлено: 06.09.20 11:18. Заголовок: gfilatov2002 Наверн..

gfilatov2002
Наверно, надо добавить для ToolTip тсб

 
  
 CLASS TSBrowse FROM TControl 
 ... 
 	DATA	nToolTipRow	AS NUMERIC INIT 0 
 	DATA	nToolTipLen	AS NUMERIC INIT 512			 // 
 	DATA	nToolTipTime										 // in seconds 
 ... 
 METHOD New( cControlName, nRow, nCol, nWidth, nHeight, bLine, aHeaders, aColSizes, cParentWnd, ; 
 ... 
 	SetToolTip( ::hWnd, cToolTip, hToolTip ) 
 	TTM_SetMaxTipWidth( hToolTip, ::nToolTipLen ) 
 	IF ISNUMERIC( ::nToolTipTime ) .and. ::nToolTipTime > 0 
 	   TTM_SetDelayTime( hToolTip, TTDT_AUTOPOP, ::nToolTipTime * 1000 ) 
 	ENDIF 
  
 	if nValue > 0 .and. nValue <= ::nLen 
 ...

SergKis
постоянный участник
Пост N: 3355 Зарегистрирован: 17.02.12

Отправлено: 06.09.20 12:48. Заголовок: PS Еще такое предлож..

PS
Еще такое предложение для тсб (запоминать позицию строк на экране в некоторых случаях облегчает работу)

 
 CLASS TSBrowse FROM TControl 
 ... 
 	DATA	aRowPosAtRec										  
 	DATA	lRowPosAtRec  AS LOGICAL INIT .F.			  
 ... 
 METHOD DrawLine( xRow, lDrawCell ) CLASS TSBrowse 
 ... 
 	l3DLook  := iif( ::nPhantom == -1, ATail( ::aColumns ):l3DLook, .F. ) 
  
 	IF ::lRowPosAtRec 
 		 IF Empty( ::aRowPosAtRec ) .or. Len( ::aRowPosAtRec ) != ::nRowCount() 
 			 ::aRowPosAtRec := Array( ::nRowCount() ) 
 			 AFILL( ::aRowPosAtRec, 0 ) 
 		 ENDIF 
 		 IF	  ::nLen == 0 
 		 ELSEIF ::lIsDbf ; ::aRowPosAtRec[ xRow ] := (::cAlias)->( RecNo() ) 
 		 ELSEIF ::lIsArr ; ::aRowPosAtRec[ xRow ] := ::nAt 
 		 ENDIF 
 	ENDIF 
  
 	If ::nLen > 0 
 ... 
 METHOD DrawSelect( xRow, lDrawCell ) CLASS TSBrowse 
 ... 
 		nBegin	:= Min( iif( ::nColPos <= ::nFreeze, ( ::nColPos := ::nFreeze + 1, ::nColPos - ::nFreeze ), ; 
 							  ::nColPos - ::nFreeze ), nLastCol ) 
  
 		IF ::lRowPosAtRec 
 			IF Empty( ::aRowPosAtRec ) .or. Len( ::aRowPosAtRec ) != ::nRowCount() 
 				::aRowPosAtRec := Array( ::nRowCount() ) 
 				AFILL( ::aRowPosAtRec, 0 ) 
 			ENDIF 
 			IF	  ::lIsDbf ; ::aRowPosAtRec[ xRow ] := (::cAlias)->( RecNo() ) 
 			ELSEIF ::lIsArr ; ::aRowPosAtRec[ xRow ] := ::nAt 
 			ENDIF 
 		ENDIF 
  
 		If ! ::lDrawLine 
 ... 
  
 тогда можно с ToolTip так делать 
                 :cToolTip := {|ob,x,y|                     // x -> Column, y -> Row 
                                Local cRet := "" 
                                Local cVal := "", nRec, nNew 
                                If ISNUMERIC(y) .and. ISNUMERIC(x) 
                                   If y > 0                  // .and. x == ob:nCell 
                                      cRet :=" Row ="+str(y,3)+" Col ="+str(x,3)+" " 
                                      nRec := (ob:cAlias)->( RecNo() ) 
                                      nNew := ob:aRowPosAtRec[ y ] 
                                      If nRec > 0 
                                         (ob:cAlias)->( dbGoto( nNew ) ) 
                                         cVal := Trim(cValToChar(ob:GetValue( x ))) 
                                         (ob:cAlias)->( dbGoto( nRec ) ) 
                                      EndIf 
                                      If ! empty(cVal) ; cRet += CRLF+cVal 
                                      EndIf 
                                   EndIf 
                                EndIf 
                                Return cRet 
                              } 
 ... 
 Memo поля неплохо отображаются (ловятся CRLF)

SergKis
постоянный участник
Пост N: 3356 Зарегистрирован: 17.02.12

Отправлено: 06.09.20 12:53. Заголовок: PS2. Чуток ошибся н..

PS2. Чуток ошибся не If nRec > 0 , а If nNew > 0 надо в блоке кода

SergKis
постоянный участник
Пост N: 3357 Зарегистрирован: 17.02.12

Отправлено: 06.09.20 13:18. Заголовок: SergKis пишет METHO..

SergKis пишет

цитата:

METHOD New( cControlName, nRow, nCol, nWidth, nHeight, bLine, aHeaders, aColSizes, cParentWnd, ;
...
SetToolTip( ::hWnd, cToolTip, hToolTip )
TTM_SetMaxTipWidth( hToolTip, ::nToolTipLen )

IF ISNUMERIC( ::nToolTipTime ) .and. ::nToolTipTime > 0
TTM_SetDelayTime( hToolTip, TTDT_AUTOPOP, ::nToolTipTime * 1000 )
ENDIF

if nValue > 0 .and. nValue <= ::nLen

Правильнее так сделать (зачеркнутое убрать и добавить метод)

 
 METHOD ToolTipSet( nToolTipTime, nToolTipLen ) CLASS TSBrowse 
  
 	IF ISNUMERIC( nToolTipLen ) .and. nToolTipLen > 0 
 		::nToolTipLen := nToolTipLen 
 		TTM_SetMaxTipWidth( hToolTip, ::nToolTipLen ) 
 	ENDIF 
  
 	IF ISNUMERIC( nToolTipTime ) .and. nToolTipTime > 0 
 		::nToolTipTime := nToolTipTime 
 		TTM_SetDelayTime( hToolTip, TTDT_AUTOPOP, ::nToolTipTime * 1000 ) 
 	ENDIF 
  
 RETURN Nil

gfilatov2002
moderator
Пост N: 1778 Зарегистрирован: 11.02.10

Отправлено: 06.09.20 18:50. Заголовок: SergKis пишет: Прав..

SergKis пишет:

цитата:

Правильнее так сделать

Добавил все эти исправления и дополнения

Благодарю за помощь

SergKis
постоянный участник
Пост N: 3358 Зарегистрирован: 17.02.12

Отправлено: 08.09.20 10:43. Заголовок: gfilatov2002 Неболь..

gfilatov2002
Небольшая правка к предыдущему (при первой прорисовке :nRowCount() еще может не определился правильно)

 
 METHOD DrawLine( xRow, lDrawCell ) CLASS TSBrowse 
 ... 
 	IF ::lRowPosAtRec 
 		 IF Empty( ::aRowPosAtRec ) .or. Len( ::aRowPosAtRec ) != ::nRowCount() 
 			 ::aRowPosAtRec := Array( ::nRowCount() ) 
 			 AFILL( ::aRowPosAtRec, 0 ) 
 		 ENDIF 
 		 IF	  ::nLen == 0 .or. xRow == 0 .or. xRow > Len( ::aRowPosAtRec ) 
 		 ELSEIF ::lIsDbf ; ::aRowPosAtRec[ xRow ] := (::cAlias)->( RecNo() ) 
 		 ELSEIF ::lIsArr ; ::aRowPosAtRec[ xRow ] := ::nAt 
 		 ENDIF 
 	ENDIF 
 ... 
 METHOD DrawSelect( xRow, lDrawCell ) CLASS TSBrowse 
 ... 
 		IF ::lRowPosAtRec 
 			IF Empty( ::aRowPosAtRec ) .or. Len( ::aRowPosAtRec ) != ::nRowCount() 
 				::aRowPosAtRec := Array( ::nRowCount() ) 
 				AFILL( ::aRowPosAtRec, 0 ) 
 			ENDIF 
 			IF	  xRow == 0 .or. xRow > Len( ::aRowPosAtRec ) 
 			ELSEIF ::lIsDbf ; ::aRowPosAtRec[ xRow ] := (::cAlias)->( RecNo() ) 
 			ELSEIF ::lIsArr ; ::aRowPosAtRec[ xRow ] := ::nAt 
 			ENDIF 
 		ENDIF 
 ...

gfilatov2002
moderator
Пост N: 1779 Зарегистрирован: 11.02.10

Отправлено: 08.09.20 11:02. Заголовок: SergKis пишет: Небо..

SergKis пишет:

цитата:

Небольшая правка к предыдущему

Принято

SergKis
постоянный участник
Пост N: 3359 Зарегистрирован: 17.02.12

Отправлено: 08.09.20 15:08. Заголовок: gfilatov2002 пишет П..

gfilatov2002 пишет

цитата:

Принято

Использовать можно

 
       DEFINE TBROWSE oBrw AT y,x WIDTH w HEIGHT h CELL ; 
 ... 
 - для массива 
                 :lRowPosAtRec := .T. 
                 :ToolTipSet(10, 1024)                            // 10 sek., 1024 buffer 
                 :cToolTip := {|ob,x,y| 
                                Local cRet := "", xVal, nOld, nNew 
                                If ! ISNUMERIC(y) .or. ! ISNUMERIC(x) ; Return cRet 
                                EndIf 
                                If y > 0           // .and. x == ob:nCell .and. y == ob:nRowPos 
                                   nNew := ob:aRowPosAtRec[ y ] 
                                   If nNew > 0 
                                      nOld   := ob:nAt 
                                      ob:nAt := nNew 
                                      xVal   := ob:GetValue( x ) 
                                      ob:nAt := nOld 
                                      If ISCHAR(xVal) 
                                         cRet := Trim(xVal) 
                                         If Len(cRet) < 50 
                                            cRet := "" 
                                         EndIf 
                                      EndIf 
                                   EndIf 
                                EndIf 
                                Return cRet 
                              } 
 ... 
 - для dbf 
                    :lRowPosAtRec := .T. 
                    :ToolTipSet(7, 1024)                             // 7 sek., 1024 buffer 
                    :cToolTip := {|ob,x,y| 
                                   Local cRet := "", xVal, nRec, nNew 
                                   If ! ISNUMERIC(y) .or. ! ISNUMERIC(x) ; Return cRet 
                                   EndIf 
                                   If y > 0             //.and. x == ob:nCell 
                                      nNew := ob:aRowPosAtRec[ y ] 
                                      If nNew > 0 
                                         nRec := (ob:cAlias)->( RecNo() ) 
                                         (ob:cAlias)->( dbGoto( nNew ) ) 
                                         xVal := ob:GetValue( x ) 
                                         (ob:cAlias)->( dbGoto( nRec ) ) 
                                         If ISCHAR(xVal) 
                                            cRet := Trim(xVal) 
                                            If Len(cRet) < 50 
                                               cRet := "" 
                                            EndIf 
                                         EndIf 
                                      EndIf 
                                   EndIf 
                                   Return cRet 
                                 } 
 ...

Andrey
постоянный участник
Пост N: 6811 Зарегистрирован: 12.09.06

Отправлено: 08.09.20 15:27. Заголовок: SergKis пишет: Испо..

SergKis пишет:

цитата:

Использовать можно

А можно ли организовать таким же образом свой виртуальный массив допустим для цвета ячеек (фона/текст) ?

Чтобы потом в ТСБ задавать раскраску каждой ячейки по этому массиву ?

SergKis
постоянный участник
Пост N: 3360 Зарегистрирован: 17.02.12

Отправлено: 08.09.20 15:42. Заголовок: Andrey пишет А можно..

Andrey пишет

цитата:

А можно ли организовать таким же образом свой виртуальный массив допустим для цвета ячеек (фона/текст) ?
Чтобы потом в ТСБ задавать раскраску каждой ячейки по этому массиву ?

Так все в твоих руках

 
 FOR EACH oCol IN :aColumns 
     oCol:nClrBack := { |nr,nc,ob| 
                         Local nClr := CLR_WHITE 
                         ... 
                         Return nClr 
                      } 
     oCol:nClrFore := { |nr,nc,ob| 
                         Local nClr := CLR_BLACK 
                         ... 
                         Return nClr 
                      } 
 NEXT

В примере с виртуальными колонками ты и делал массивы по строкам с цветами или 0, при 0 вкл. др. алгоритм опр. цвета

SergKis
постоянный участник
Пост N: 3361 Зарегистрирован: 17.02.12

Отправлено: 09.09.20 16:53. Заголовок: gfilatov2002 Предло..

gfilatov2002
Предложение по работе с memo полем

 
 CLASS TControl 
 ... 
 	DATA	oBrw 
 	DATA	oCol 
 	DATA	nCol 
 ... 
 	METHOD Save()					  VIRTUAL 
 ... 
 CLASS TSMulti FROM TControl 
 ... 
 	METHOD Save() 
 ... 
 METHOD Save() CLASS TSMulti 
  
 	Local cText 
  
 	If ::bSetGet != Nil 
 		cText := ::GetText() 
 		If Right( cText, 2 ) == CRLF 
 		   cText := SubStr( cText, 1, Len( cText ) - 2 ) 
 		EndIf 
 		Eval( ::bSetGet, cText ) 
 		If Empty( ::oCol:bEditEnd ) 
 		   ::oBrw:PostEdit( cText, ::nCol ) 
 		 EndIf 
 	EndIf 
  
 RETURN Nil 
  
 METHOD KeyDown( nKey, nFlags ) CLASS TSMulti 
  
 	//Local cText 
  
 	If _GetKeyState( VK_CONTROL ) 
 		nKey := If( Upper( Chr( nKey ) ) == "W" .or. nKey == VK_RETURN, VK_TAB, nKey ) 
 	EndIf 
  
 	::nLastKey := nKey 
  
 	If nKey == VK_TAB .or. nKey == VK_ESCAPE 
  
 		If ::lValid() 
  
 			If nKey != VK_ESCAPE 
 				::Save() 
 				/* 
 				If ::bSetGet != Nil 
 					cText := ::GetText() 
 					If Right( cText, 2 ) == CRLF 
 						cText := SubStr( cText, 1, Len( cText ) - 2 ) 
 					EndIf 
 					Eval( ::bSetGet, cText ) 
 				EndIf 
 				*/ 
 			EndIf 
  
 			::bLostFocus := Nil 
 			Eval( ::bKeyDown, nKey, nFlags, .T. ) 
  
 		EndIf 
  
 	Endif 
  
 RETURN 0 
 ... 
 METHOD Edit( uVar, nCell, nKey, nKeyFlags, cPicture, bValid, nClrFore, nClrBack ) CLASS TSBrowse 
 ... 
 	If oCol:oEdit != Nil 
  
 		oCol:oEdit:oBrw := Self 
 		oCol:oEdit:oCol := oCol 
 		oCol:oEdit:nCol := nCell 
  
 		oCol:oEdit:bLostFocus := { | nKey | ::EditExit( nCell, nKey, uValue, bValid, .F. ) } 
 ...

Тогда по Ctrl+W сохраняем в memo, в остальных случаях нет.
Если на окне Ctrl+W задействована, то делаем так

 
       ON KEY CONTROL+W ACTION {|| 
                                Local oBrw := This.oBrw.Object 
                                If oBrw:IsEdit                  // tsb field edit 
                                   oBrw:aColumns[ oBrw:nCell ]:oEdit:Save() 
                                   oBrw:SetFocus() 
                                Else                            // Window selected 
                                   _wPost(7, oMain) 
                                EndIf 
                                Return Nil 
                               }

Вопрос у меня возникает с If Empty( ::oCol:bEditEnd ) (в методе Save() выделен зеленым цветом), т.к. я не исп. memo поля.
Сейчас заданием этого блока производим запись в dbf нового значения, я правильно понимаю ?
Если да, то указанная в методе ветка, наверно, нужна.
Если нет, то можно If Empty( ::oCol:bEditEnd ) опустить и делать сразу ::oBrw:PostEdit( cText, ::nCol )

SergKis
постоянный участник
Пост N: 3362 Зарегистрирован: 17.02.12

Отправлено: 09.09.20 18:58. Заголовок: PS Тут пример https:..

PS
Тут пример https://TransFiles.ru/z8sx0
правда это Mdi интерфейс, но др. у меня нет для работы с memo полями

gfilatov2002
moderator
Пост N: 1780 Зарегистрирован: 11.02.10

Отправлено: 09.09.20 20:46. Заголовок: SergKis пишет: Пред..

SergKis пишет:

цитата:

Предложение по работе с memo полем

Принято с благодарностью

SergKis пишет:

цитата:

Тут пример

Пример отработал нормально после внесения предложенных изменений

Завтра планирую подготовить следующий апдейт со всеми наработками...

gfilatov2002
moderator
Пост N: 1781 Зарегистрирован: 11.02.10

Отправлено: 10.09.20 10:02. Заголовок: Всем кому это интересно

Как и обещал, выложил 2-й апдейт для сборки 20.08.

Благодарю за ваше внимание

Andrey
постоянный участник
Пост N: 6814 Зарегистрирован: 12.09.06

Отправлено: 10.09.20 17:59. Заголовок: gfilatov2002 пишет: ..

gfilatov2002 пишет:

цитата:

Как и обещал, выложил 2-й апдейт для сборки 20.08.

* New: 'DBF to HTML Wizard' sample.
Contributed by Grigory Filatov <gfilatov@inbox.ru>
Неточность при выводе данных.
ДБФ такой структуры:

{"ID", "+", 4, 0},; 
  {"DT_MODIFY", "=", 8, 0},; 
  {"DT_NEW", "@", 8, 0},; 
  {"DT_DEL", "@", 8, 0},; 
  {"DT_REST", "@", 8, 0},; 
  {"EVENTS", "@", 8, 0},; 
  {"DEVENTS", "D", 8, 0},; 
  {"TEVENTS", "C", 8, 0},;

А вывод в html такой :

А так пример просто супер !

А другой пример на таком же файле вылетает:

Application: C:\MiniGUI\SAMPLES\Applications\DBF2XML\Dbf2Xml.exe 
 Error BASE/1132 Bound error: array access Args: [1] = A { ... } length: 5 [2] = N 0 
 --------------------------------- Stack Trace --------------------------------- 
 Called from GENXML(518) in module: Dbf2Xml.prg 
 Called from (b)MAIN(313) in module: Dbf2Xml.prg 
 Called from _DOCONTROLEVENTPROCEDURE(1901) in module: h_windows.prg 
 Called from EVENTS(1839) in module: h_events.prg 
 Called from DOMESSAGELOOP(0) 
 Called from _ACTIVATEWINDOW(1514) in module: h_windows.prg 
 Called from _ACTIVATEALLWINDOWS(1576) in module: h_windows.prg 
 Called from MAIN(404) in module: Dbf2Xml.prg

SergKis
постоянный участник
Пост N: 3363 Зарегистрирован: 17.02.12

Отправлено: 11.09.20 12:52. Заголовок: gfilatov2002 Можете..

gfilatov2002
Можете объяснить код в тсб, я не понимаю смысла его

 
 METHOD Edit( uVar, nCell, nKey, nKeyFlags, cPicture, bValid, nClrFore, nClrBack ) CLASS TSBrowse 
 ... 
 	If oCol:bPrevEdit != Nil 
 		If ::lIsArr .and. ( ::lAppendMode .or. ::nAt > Len( ::aArray ) ) // append mode for arrays 
 		ElseIf nKey != VK_RETURN // GF 15-10-2015 
 			uVar := Eval( oCol:bPrevEdit, uValue, Self, nCell, oCol ) 
 			If ValType( uVar ) == "L" .and. ! uVar 
 				nKey := VK_RETURN 
 			EndIf 
 		EndIf 
 	EndIf 
 ... 
 METHOD KeyDown( nKey, nFlags ) CLASS TSBrowse 
 ... 
 		Case lEditable .and. ( nKey == VK_RETURN .or. nKey == nFireKey ) 
 ... 
 			If ::lCellBrw .and. ::aColumns[ nCol ]:lEdit				// JP v.1.1 
 				::Edit( uTemp, nCol, nKey, nFlags ) 
 			EndIf 
 ... 
 Пример Advanced\Tsb_array_2\demo.prg добавляем 
 ... 
    DEFINE TBROWSE oBrw ; 
 ... 
       IF oBrw:lEnum 
          oBrw:nHeightSpecHd := oBrw:nHeightCell 
       ENDIF 
  
       :lNoKeyChar := .T. 
  
       FOR EACH oCol IN :aColumns 
           oCol:lEdit := .T. 
           oCol:bPrevEdit := {|xv,ob,nc,oc| 
                               ? "PrevEdit", nc, oc:cName, xv 
                               Return .T. 
                             } 
           oCol:bPostEdit := {|xv,ob| 
                               Local nc := ob:nCell 
                               Local oc := ob:GetColumn(nc) 
                               ? "PostEdit", nc, oc:cName, xv 
                               Return Nil 
                             } 
       NEXT 
 ...

По Enter lEdit срабатывает, можем править, но уст. блоки кода игнорируются, т.к. стоит в :Edit() выделенное красным и в :KeyDown() срабатывает показанная ветка

gfilatov2002
moderator
Пост N: 1782 Зарегистрирован: 11.02.10

Отправлено: 11.09.20 13:21. Заголовок: SergKis пишет: Може..

SergKis пишет:

цитата:

Можете объяснить код в тсб

Если я правильно припоминаю, эта правка блокировала изменение полей типа CheckBox при движении по строке путем нажатия клавиши Enter.
В противном случае эти поля легко изменялись невнимательным пользователем, который многократно нажимал Enter.

Но, конечно, если у Вас есть другое предложение, как это исправить, то я его с удовольствием использую...

SergKis
постоянный участник
Пост N: 3364 Зарегистрирован: 17.02.12

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

gfilatov2002 пишет

цитата:

если у Вас есть другое предложение, как это исправить, то я его с удовольствием использую...

Пока не разобрался. В массивах не исп. oCol:bPrevEdit и :bPostEdit до сих пор. Но добавил такое

 
 CLASS TSColumn 
 ... 
    DATA lEditBox          AS LOGICAL INIT .F.    // Edit with editbox  
 ... 
 METHOD Edit( uVar, nCell, nKey, nKeyFlags, cPicture, bValid, nClrFore, nClrBack ) CLASS TSBrowse 
 ... 
 	ElseIf ( cType == "C" .and. Chr( 13 ) $ uValue ) .or. cType == "M" .or. oCol:lEditBox 
  
 		IF oCol:lEditBox .and. ! Chr( 13 ) $ uValue 
 			uValue := trim( uValue ) 
 		ENDIF 
  
 		Default uValue := ""  // ЭТО ЛИШНЕЕ т.к. делали Chr( 13 ) $ uValue 
  
 		If ::nMemoHE == Nil 
 ... 
 на dbf отработало нормально Ctlr+W и Esc, а с массивом только в таком варианте (тот же пример) 
 ... 
       IF oBrw:lEnum 
          oBrw:nHeightSpecHd := oBrw:nHeightCell 
       ENDIF 
  
       :lNoKeyChar := .T. 
  
       FOR EACH oCol IN :aColumns 
           oCol:lEdit := .T. 
           oCol:bPrevEdit := {|xv,ob,nc,oc| 
                               ? "PrevEdit", nc, oc:cName, xv 
                               Return .T. 
                             } 
           oCol:bPostEdit := {|xv,ob| 
                               Local nc := ob:nCell 
                               Local oc := ob:GetColumn(nc) 
                               ? "PostEdit", nc, oc:cName, xv 
                               Return Nil 
                             } 
       NEXT 
  
       oCol := :GetColumn(5) 
       oCol:lEditBox := .T. 
  
       ON KEY CONTROL+W ACTION {|| 
                                Local oBrw := This.oBrw.Object 
                                If oBrw:IsEdit                  // tsb field edit 
                                   oBrw:aColumns[ oBrw:nCell ]:oEdit:Save() 
                                EndIf 
                                oBrw:SetFocus() 
                                Return Nil 
                               } 
       ON KEY ESCAPE    ACTION {|| 
                                Local oBrw := This.oBrw.Object 
                                If oBrw:IsEdit                  // tsb field edit 
                                   oBrw:SetFocus() 
                                Else 
                                   ThisWindow.Release 
                                EndIf 
                                Return Nil 
                               } 
 ...

Хотел в bPrevEdit и в bPostEdit добавить обработку строки для кол. 5, но блоки не вызвались и первое что увидел блокировка вызова bPrevEdit

gfilatov2002
moderator
Пост N: 1783 Зарегистрирован: 11.02.10

Отправлено: 11.09.20 14:11. Заголовок: SergKis пишет: блок..

SergKis пишет:

цитата:

блоки не вызвались и первое что увидел блокировка вызова bPrevEdit

Проверил еще раз без этой правки

цитата:

ElseIf nKey != VK_RETURN // GF 15-10-2015

блок bPrevEdit вызывается ДВАЖДЫ

SergKis
постоянный участник
Пост N: 3365 Зарегистрирован: 17.02.12

Отправлено: 11.09.20 15:05. Заголовок: gfilatov2002 пишет б..

gfilatov2002 пишет

цитата:

блок bPrevEdit вызывается ДВАЖДЫ

Виноват, не поставил команду в самом начале
#define _HMG_OUTLOG
потому вывода из блока кода по ? ... и не было
блоки кода сработали нормально

SergKis
постоянный участник
Пост N: 3366 Зарегистрирован: 17.02.12

Отправлено: 14.09.20 13:57. Заголовок: gfilatov2002 Предла..

gfilatov2002
Предлагаю такую работу с memo полями и полями "C" но длинными, не полностью входящие в показ колонки, т.е. поле длинной 200, а показ в 50 символов. Изменения

 
 CLASS TSColumn 
 ... 
 	DATA cEditBoxSep		 AS STRING  INIT ""	  // editing EditBox line separator 
 	DATA nEditBoxWrap		 AS NUMERIC INIT 0	  // editing EditBox line len wrap 
 	DATA lEditBoxROnly	         AS LOGICAL INIT .F.	  // no editing EditBox - ReadOnly 
 	DATA lEditBox			 AS LOGICAL INIT .F.	  // editing with editbox 
 ... 
 METHOD Save() CLASS TSMulti 
  
 	LOCAL cText 
  
 	IF ::bSetGet != NIL 
 		cText := ::GetText() 
 		IF Right( cText, 2 ) == CRLF 
 			cText := SubStr( cText, 1, Len( cText ) - 2 ) 
 		ENDIF 
  
 		IF ::oCol:lEditBox .and. ! Empty( cText ) .and. CRLF $ cText 
 			IF Len( ::oCol:cEditBoxSep ) > 0 
 				cText := StrTran( cText, CRLF, ::oCol:cEditBoxSep ) 
 			ELSEIF ::oCol:nEditBoxWrap > 0 
 				cText := StrTran( cText, CRLF, " " ) 
 			ENDIF 
 		ENDIF 
  
 		Eval( ::bSetGet, cText ) 
 		IF Empty( ::oCol:bEditEnd ) 
 			::oBrw:PostEdit( cText, ::nCol ) 
 		ENDIF 
 	ENDIF 
  
 RETURN NIL 
 ... 
 METHOD Edit( uVar, nCell, nKey, nKeyFlags, cPicture, bValid, nClrFore, nClrBack ) CLASS TSBrowse 
 ... 
 	ElseIf ( cType == "C" .and. Chr( 13 ) $ uValue ) .or. cType == "M" .or. oCol:lEditBox 
  
 		IF oCol:lEditBox .and. ! Empty( uValue := trim( uValue ) ) 
 			IF Len( oCol:cEditBoxSep ) > 0 .and. oCol:cEditBoxSep != CRLF  ; 
 													 .and. oCol:cEditBoxSep $ uValue 
 				uValue := StrTran( uValue, oCol:cEditBoxSep, CRLF ) 
 			ENDIF 
 			IF oCol:nEditBoxWrap > 0 
 				cTmp := uValue 
 				nK := MLCOUNT( cTmp, oCol:nEditBoxWrap, , .T. ) 
 				uValue := "" 
 				FOR nI := 1 TO nK 
 					 uValue += Trim( MEMOLINE( cTmp, oCol:nEditBoxWrap, nI, , .T. ) ) 
 					 IF nI != nK ; uValue += CRLF 
 					 ENDIF 
 				NEXT 
 			ENDIF 
 		ENDIF 
  
 		If ::nMemoHE == Nil 
 ... 
 		oCol:oEdit := TSMulti():New( nRow, nCol, bSETGET( uValue ), Self, nWidth, nHeight, ; 
 											  hFont, nClrFore, nClrBack, ::cChildControl, cWnd ) 
 		oCol:oEdit:bGotFocus := { || oCol:oEdit:HideSel(), oCol:oEdit:SetPos( 0 ) } 
 		lMulti := .T. 
 		IF oCol:lEditBoxROnly 
 			oCol:oEdit:SendMsg( EM_SETREADONLY, 1, 0 ) 
 		ENDIF 
 		oCol:oEdit:Hide() 
 ...

Пример тут https://TransFiles.ru/vw1pc
Открываем файл userlog.dbf в режимах Edit - Yes или No,
Смотрим последнюю запись в файле и две последних колонки при нажатии Enter

SergKis
постоянный участник
Пост N: 3367 Зарегистрирован: 17.02.12

Отправлено: 14.09.20 14:00. Заголовок: PS В h_tbrowse.prg д..

PS
В h_tbrowse.prg добавить
#define EM_SETREADONLY 207

SergKis
постоянный участник
Пост N: 3368 Зарегистрирован: 17.02.12

Отправлено: 14.09.20 14:08. Заголовок: PS2 в примере это ст..

PS2
в примере это строки Скрытый текст

 
 STATIC FUNCTION MdiChildOpen() 
 ... 
          DEFINE TBROWSE oBrw AT y,x WIDTH w HEIGHT h CELL          ; 
 ... 
                 :Cargo:nMaxMemoCnt := 0              // Max count field memo 
                 :Cargo:nMaxCharCol := 50             // Max len char column 
                 :Cargo:nMaxLineMem := 10             // Max line for memo edit 
                 :Cargo:lEdit  := oMain:Cargo:lEdit 
 ... 
                        ELSEIF o:cFieldTyp $ "CM" 
                           IF o:cFieldTyp == "M" .or. o:nFieldLen > :Cargo:nMaxCharCol 
                              o:lEditBox := .T. 
                              IF o:cFieldTyp == "M" 
                                 :nMemoHE := :Cargo:nMaxLineMem 
                                 :Cargo:nMaxMemoCnt += 1 
                              ELSE 
                                 o:nEditBoxWrap := :Cargo:nMaxCharCol 
                              ENDIF 
                              o:nWidth := o:ToWidth( :Cargo:nMaxCharCol ) 
                              :Cargo:lToolTipCol := .T. 
                              IF ! :Cargo:lEdit 
                                 o:lEditBoxROnly := .T. 
                                 o:lEdit := .T. 
                              ENDIF 
                           ELSE 
                              o:nWidth += GetFontWidth("Normal", 1) 
                           ENDIF 
                        ENDIF 
 ...

gfilatov2002
moderator
Пост N: 1784 Зарегистрирован: 11.02.10

Отправлено: 14.09.20 15:04. Заголовок: SergKis пишет: Пред..

SergKis пишет:

цитата:

Предлагаю такую работу с memo полями

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

SergKis пишет:

цитата:

Открываем файл userlog.dbf в режимах Edit - Yes или No,
Смотрим последнюю запись в файле и две последних колонки при нажатии Enter

Пример проверил, работает.

Благодарю за помощь

Andrey
постоянный участник
Пост N: 6815 Зарегистрирован: 12.09.06

Отправлено: 14.09.20 17:15. Заголовок: SergKis пишет: Откр..

SergKis пишет:

цитата:

А в карточке редактировать тоже нужно !

SergKis
постоянный участник
Пост N: 3369 Зарегистрирован: 17.02.12

Отправлено: 14.09.20 19:49. Заголовок: Andrey пишет А в кар..

Andrey пишет

цитата:

А в карточке редактировать тоже нужно !

К тсб, редактирование в карточке полей memo и "длинных" полей "C", не имеет отношения.
Надо сделать отдельное MdiChild окно для редактирования с контролом EDITBOX.
Изменения выше относятся именно к работе на тсб таблице

gfilatov2002
moderator
Пост N: 1785 Зарегистрирован: 11.02.10

Отправлено: 17.09.20 10:25. Заголовок: Всем кому это интересно

Выпустил 3-е обновление сборки 20.08

Что нового (на языке оригинала):
Скрытый текст

  * Fixed: The initial display of the window with a TAB control is not correct 
            if you place a WINDOW PANEL on the second page of the TAB control. 
            That's exists in the official version too. 
            Bug was reported by Hans Marc. 
            Contributed by Grigory Filatov <gfilatov@inbox.ru> 
            (see demo2.prg in folder \samples\Basic\CONTAINERS\Panel) 
   * New: Added the useful function HMG_DbfStruct(). 
            Syntax: 
              HMG_DbfStruct( cDbfName ) --> aStruct 
            where aStruct is a multidimensional array with database fields 
              structure, which is similar to the output from dbStruct(), but 
              without the need to use the USE command. 
            (see demo in folder \samples\Advanced\Tsb_MoreFields) 
   * Updated: Minor modifications in the MiniGUI core for compatibility with 
            the new Pelles C 10.0 (64-bit) and Harbour 3.2.0dev. 
            Contributed by Grigory Filatov <gfilatov@inbox.ru> 
   * Updated: Adaptation FiveWin Class TSBrowse 9.0 in HMG: 
            - added the new variables :cEditBoxSep, :nEditBoxWrap, 
              :lEditBoxROnly and :lEditBox in the TSColumn class. 
            Contributed by Sergej Kiselev 
            (see demo in folder \samples\Advanced\Tsb_DemoMDI) 
   * New: 'Charts SQLITE3' sample is based on using of the SQLite ODBC Driver 
            from http://www.ch-werner.de/sqliteodbc/. 
            Contributed by Grigory Filatov <gfilatov@inbox.ru> 
            (see in folder \samples\Basic\Charts_4) 
   * New: 'Test Directory List with System Icons' sample. 
            Based upon a contribution of HMG user Jimmy. 
            Adapted for Minigui Extended by Grigory Filatov <gfilatov@inbox.ru> 
            (see in folder \samples\Advanced\FILEICON) 
   * New: 'TBrowse speed test with multiple fields' samples. 
            Contributed by Grigory Filatov <gfilatov@inbox.ru> 
            (see in folder \samples\Advanced\Tsb_MoreFields) 
   * Updated: 'DBF to HTML Wizard' sample: 
            - added using of Bootstrap and jQuery frameworks. 
            Contributed by Marcos Jarrin Pita 
            (see in folder \samples\Applications\Dbf2Html)

Благодарю всех, кто поддерживал и поддерживает этот проект "на плаву"

Andrey
постоянный участник
Пост N: 6823 Зарегистрирован: 12.09.06

Отправлено: 21.09.20 23:05. Заголовок: gfilatov2002 пишет: ..

gfilatov2002 пишет:

цитата:

Выпустил 3-е обновление сборки 20.08

Что то пример SAMPLES\Advanced\FILEICON не собирается...

Harbour 3.2.0dev (r2008190002) 
 Copyright (c) 1999-2020, https://harbour.github.io/ 
 C:\Users\Andrey\AppData\Local\Temp\hbmk_vzy17f.dir\FILEICON.c: 
 C:\Users\Andrey\AppData\Local\Temp\hbmk_vzy17f.dir\HB_FUNC.c: 
 Error E2209 HB_FUNC.PRG 4: Unable to open include file 'ShObjIdl.h' 
 Error E2451 HB_FUNC.PRG 11: Undefined symbol 'SHFILEINFO' in function HB_FUN_GETICOINDEX 
 Error E2379 HB_FUNC.PRG 11: Statement missing ; in function HB_FUN_GETICOINDEX 
 Error E2451 HB_FUNC.PRG 13: Undefined symbol 'sfi' in function HB_FUN_GETICOINDEX 
 Error E2109 HB_FUNC.PRG 13: Not an allowed type in function HB_FUN_GETICOINDEX 
 Error E2451 HB_FUNC.PRG 13: Undefined symbol 'SHGFI_ICON' in function HB_FUN_GETICOINDEX 
 Warning W8065 HB_FUNC.PRG 13: Call to function 'SHGetFileInfo' with no prototype in function HB_FUN_GETICOINDEX 
 Warning W8004 HB_FUNC.PRG 16: 'nSize' is assigned a value that is never used in function HB_FUN_GETICOINDEX 
 Error E2147 HB_FUNC.PRG 56: 'HIMAGELIST' cannot start a parameter declaration 
 Error E2303 HB_FUNC.PRG 56: Type name expected 
 *** 8 errors in Compile *** 
 C:\Users\Andrey\AppData\Local\Temp\hbmk_ir7be9.c: 
 hbmk2[FILEICON]: Error: Running C/C++ compiler. 1

Может из за того что сижу на BCC 5.5.1 ?

gfilatov2002
moderator
Пост N: 1786 Зарегистрирован: 11.02.10

Отправлено: 24.09.20 09:57. Заголовок: Выпустил 4-е обновле..

Выпустил 4-е обновление сборки 20.08

Что нового (на языке оригинала):
Скрытый текст

  * Fixed: The default backcolor of Label, CheckBox and RadioGroup controls 
            is not correct if you place a WINDOW PANEL into the TAB control. 
            Contributed by Grigory Filatov <gfilatov@inbox.ru> 
            (see demo2.prg in folder \samples\Basic\CONTAINERS\Panel) 
   * Fixed: Wrong GETBOX update behavior when user entered an invalid date 
            value (there is no way to correct it via program action). 
            Bug was reported by Pierpaolo Martinello. 
            Contributed by Grigory Filatov <gfilatov@inbox.ru> 
   * Enhanced: The DATEPICKER supports the colors definition for a dropdown 
            MonthCalendar in the THEMED Operating Systems. 
            It was a postponed user's request. 
            Based upon a contribution of HMG user Jimmy. 
            Adapted for Minigui Extended by Grigory Filatov <gfilatov@inbox.ru> 
            (see demo.prg in folder \samples\Basic\DatePicker) 
   * Enhanced: The MONTHCAL control allows the display of days in BOLD. 
            There are three auxiliary functions for above feature handling: 
            - AddMonthCalBoldDay( ControlName, ParentName, dDate ); 
            - DelMonthCalBoldDay( ControlName, ParentName, dDate ); 
            - IsMonthCalBoldDay( ControlName, ParentName, dDate ). 
            Based upon a code borrowed from OOHG. 
            Adapted for Minigui Extended by Grigory Filatov <gfilatov@inbox.ru> 
            (see month.prg in folder \samples\Basic\MONTHCAL) 
   * New: 'Testing columns in Tsbrowse for DBF file' sample. 
            Contributed by Sergej Kiselev and Verchenko Andrey 
            (see in folder \samples\Advanced\Tsb_2tables) 
   * New: 'Virtual columns in Tsbrowse for DBF file' sample. 
            Contributed by Sergej Kiselev and Verchenko Andrey 
            (see in folder \samples\Advanced\Tsb_VirtualColumn) 
   * Updated: 'Month calendar control test' sample. 
            Contributed by Grigory Filatov <gfilatov@inbox.ru> 
            (see demo.prg in folder \samples\Basic\MONTHCAL) 
  
 There is a "last-minute" improvement also: 
  
   * Enhanced: The MONTHCAL control will be adjusted correctly by width and 
            height after assigning a FontName and/or FontSize at runtime. 
            Contributed by Grigory Filatov <gfilatov@inbox.ru> 
            (see month.prg in folder \samples\Basic\MONTHCAL)

Haz
администратор
Пост N: 1600 Зарегистрирован: 20.02.11

Отправлено: 25.09.20 14:25. Заголовок: gfilatov2002 пишет: ..

gfilatov2002 пишет:

цитата:

Выпустил 4-е обновление сборки 20.08
Что нового (на языке оригинала):

На языке оригинала язык не поворачивается сказать

Давно не обновлял, в начале недели обновил на одну из последних сборок и началось ....

Проблема в слетевших ::cPicture по умолчанию , все строковые колонки во всех TSB были обрезаны и если пользователь их начал редактировать - резались данные.
Для начала в спешке прописал ::cPicture по всему коду, где не указано явно. Затем выдохнул и принялся изучать причину, а она простая:
у меня базы в ADT формате (ADS), этот формат проходит проверку IsDbf(), но типы символьных полей вариативны ( не тупо равно "C").
В новых сборках пикча назначается в ::LoadFields() как

 
    ... 
    aStru     := ( cAlias )->( DbStruct() )  
    ... 
    
    cType := aStru[ nE, 2 ] 
    If cType == "C" 
          cPicture := "@K " + Replicate( 'X', aStru[ nE, 3 ] ) 
    ElseIf cType == "N" 
    ...

и поскольку в качестве типа символьного поля я использую "CICHARACTER" , а типа "C" в ADS просто нет, то поимел танцы.
почему бы при формировании пикчи вместо cType := aStru[ nE, 2 ] не использовать значение из поля а не из структуры примерно так cType := ValType( (cAlias)->&(aStru[ nE, 1 ])) или cType := ValType( (cAlias)->(FieldGet(nE)) ?

SergKis
постоянный участник
Пост N: 3382 Зарегистрирован: 17.02.12

Отправлено: 25.09.20 14:49. Заголовок: Haz пишет В новых сб..

Haz пишет

цитата:

В новых сборках пикча назначается в ::LoadFields() как

...
aStru := ( cAlias )->( DbStruct() )
...

cType := aStru[ nE, 2 ]
If cType == "C"
cPicture := "@K " + Replicate( 'X', aStru[ nE, 3 ] )
ElseIf cType == "N"
...

смотрю версию 2.07 от 2012 года там в LoadFields
aStru := ( cAlias )->( DbStruct() )
и
cType := aStru[ nE, 2 ]

If cType == "C"
cPicture := "@K "+Replicate('X', aStru[ nE, 3 ] )
ElseIf cType == "N"
...
т.е. это историческая данность, а valtype не везде даст то что надо с новыми типами полей, наверно, надо усложнять проверку, но инициатива от тебя, т.к. я не работаю с ADS

gfilatov2002
moderator
Пост N: 1787 Зарегистрирован: 11.02.10

Отправлено: 25.09.20 14:52. Заголовок: Haz пишет: почему б..

Haz пишет:

цитата:

почему бы при формировании пикчи вместо cType := aStru[ nE, 2 ] не использовать значение из поля а не из структуры примерно так cType := ValType( (cAlias)->&(aStru[ nE, 1 ])) или cType := ValType( (cAlias)->(FieldGet(nE)) ?

Благодарю за предложение

Поправил, конечно

Обидно, что именно так сделано в методе :LoadRelated(), а в методе :LoadFields() тип берется из массива aStru у оригинального автора библиотеки

Haz
администратор
Пост N: 1601 Зарегистрирован: 20.02.11

Отправлено: 25.09.20 15:27. Заголовок: gfilatov2002 пишет: ..

gfilatov2002 пишет:

цитата:

Поправил, конечно

Там ниже на пару строк в исходнике тоже из структуры, может и там поправить ?
Странно что до последних обновлений все работало корректно, если это от автора изменения .

Haz
администратор
Пост N: 1602 Зарегистрирован: 20.02.11

Отправлено: 25.09.20 15:27. Заголовок: gfilatov2002 пишет: ..

gfilatov2002 пишет:

цитата:

Поправил, конечно

gfilatov2002
moderator
Пост N: 1788 Зарегистрирован: 11.02.10

Отправлено: 25.09.20 16:50. Заголовок: Haz пишет: может и ..

Haz пишет:

цитата:

может и там поправить ?

Привожу полный текст исправленного метода для проверки:

* ============================================================================ 
 * METHOD TSBrowse:LoadFields() Version 9.0 Nov/30/2009 // modified by SergKis 
 * ============================================================================ 
  
 METHOD LoadFields( lEditable, aColSel, cAlsSel, aNameSel, aHeadSel ) CLASS TSBrowse 
  
    Local n, nE, cHeading, nAlign, nSize, cData, cType, nDec, hFont, cPicture, ; 
          cBlock, nCols, aNames, cKey, ; 
          aColSizes := ::aColSizes, ; 
          cOrder, nEle, ; 
          cAlias, cName, aStru, ; 
          aAlign := { "LEFT", "CENTER", "RIGHT", "VERT" } 
    Local cTmp, cHead, hFontH 
  
    Default lEditable := ::lEditable, ; 
            aColSizes := {} 
  
    cAlias    := iif( HB_ISCHAR( cAlsSel ), cAlsSel, ::cAlias )  
    aStru     := ( cAlias )->( DbStruct() )  
    aNames    := iif( HB_ISARRAY( aColSel ), aColSel, ::aColSel )  
    nCols     := iif( aNames == Nil, ( cAlias )->( FCount() ), Len( aNames ) )  
    aColSizes := iif( Len( ::aColumns ) == Len( aColSizes ), Nil, aColSizes )  
  
    For n := 1 To nCols 
  
       nE := iif( aNames == Nil, n, ( cAlias )->( FieldPos( aNames[ n ] ) ) ) 
  
       If ValType( ::aHeaders ) == "A" .and. ! Empty( ::aHeaders ) .and. n <= Len( ::aHeaders ) 
          cHeading := ::aHeaders[ n ] 
          cHead    := cHeading 
       Else 
          cHeading := ::Proper( ( cAlias )->( Field( nE ) ) ) 
       EndIf 
  
       If HB_ISARRAY( aHeadSel ) .and. Len( aHeadSel ) > 0 .and. n <= Len( aHeadSel ) .and. aHeadSel[ n ] != Nil 
          cHeading := aHeadSel[ n ] 
          cHead    := cHeading 
       EndIf 
  
       If CRLF $ cHeading 
          cData := "" 
          FOR EACH cTmp IN hb_ATokens( cHeading, CRLF ) 
             IF Len( cTmp ) > Len( cData ) 
                cData := cTmp 
             EndIf 
          NEXT 
          cHeading := cData 
          cData    := NIL 
       EndIf 
  
       If ( nEle := AScan( ::aTags, {|e| Upper( cHeading ) $ Upper( e[ 2 ] ) } ) ) > 0 
          cOrder := ::aTags[ nEle, 1 ] 
          cKey   := ( cAlias )->( OrdKey() ) 
  
          If Upper( cHeading ) $ Upper( cKey ) 
             ::nColOrder := iif( Empty( ::nColOrder ), Len( ::aColumns ) + 1, ::nColOrder ) 
          EndIf 
       Else 
          cOrder := "" 
       EndIf 
  
       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 ) ) ) 
  
       nAlign := iif( ValType( nAlign ) == "L", iif( nAlign, 2, 0 ), ; 
                 iif( ValType( nAlign ) == "C", AScan( aAlign, nAlign ) - 1, nAlign ) ) 
  
       nSize := iif( ! aColSizes == Nil .and. Len( aColsizes ) >= nE, aColSizes[ nE ], Nil ) 
  
       cData := ( cAlias )->( FieldGet( nE ) ) 
       cType := ValType( cData ) 
  
       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 
  
       If nSize == Nil 
          nSize  := aStru[ nE, 3 ] 
          nDec   := aStru[ nE, 4 ] 
          hFont  := iif( ::hFont != Nil, ::hFont, 0 ) 
          hFontH := iif( ::hFontHead != Nil, ::hFontHead, ::hFont ) 
  
          If cType == "C" 
             cData := PadR( Trim( cData ), nSize, "B" ) 
             nSize := GetTextWidth( 0, cData, hFont ) 
          ElseIf cType == "N" 
             cData := StrZero( cData, nSize, nDec ) 
             nSize := GetTextWidth( 0, cData, hFont ) 
          ElseIf cType == "D" 
             cData := cValToChar( iif( Empty( cData ), Date(), cData ) ) 
             nSize := Int( GetTextWidth( 0, cData + "BB", hFont ) ) + iif( lEditable, 30, 0 ) 
          ElseIf cType == "M" 
             nSize := iif( ::nMemoWV == Nil, 200, ::nMemoWV ) 
          ElseIf cType $ "=@T" 
             nSize := GetTextWidth( 0, Replicate( "9", 24 ), hFont ) 
          ElseIf cType $ "^+" 
             nSize := GetTextWidth( 0, Replicate( "9", 10 ), hFont ) 
          Else 
             cData := cValToChar( cData ) 
             nSize := GetTextWidth( 0, cData, hFont ) 
          EndIf 
  
          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 ) 
          nSize := ::aColSizes[ n ] 
       EndIf 
  
       If ValType( ::aColSizes ) == "A" .and. n <= Len( ::aColSizes ) .and. Empty( ::aColSizes[ n ] ) 
          ::aColSizes[ n ] := nSize 
       EndIf 
  
       If ValType( ::aFormatPic ) == "A" .and. ! Empty( ::aFormatPic ) .and. n <= Len( ::aFormatPic ) 
          cPicture := ::aFormatPic[ n ] 
       EndIf 
  
       If HB_ISCHAR( cHead ) 
          cHeading := cHead 
       EndIf 
  
       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 ) ) 
  
       cName := ( cAlias )->( FieldName( nE ) ) 
  
       ATail( ::aColumns ):cData     :=   cAlias + "->" + FieldName( nE ) 
       ATail( ::aColumns ):cArea     :=   cAlias  // 06.08.2019 
       ATail( ::aColumns ):cField    := ( cAlias )->( FieldName( nE ) )  // 08.06.2018 
       ATail( ::aColumns ):cFieldTyp := aStru[ nE, 2 ]  // 18.07.2018 
       ATail( ::aColumns ):nFieldLen := aStru[ nE, 3 ]  // 18.07.2018 
       ATail( ::aColumns ):nFieldDec := aStru[ nE, 4 ]  // 18.07.2018 
  
       If HB_ISARRAY( aNameSel ) .and. Len( aNameSel ) > 0 .and. n <= Len( aNameSel ) 
          If HB_ISCHAR( aNameSel[ n ] ) .and. ! Empty( aNameSel[ n ] ) 
             cName := aNameSel[ n ] 
          EndIf 
       EndIf 
  
       ATail( ::aColumns ):cName := cName 
  
       If cType == "L" 
          ATail( ::aColumns ):lCheckBox := .T. 
       EndIf 
  
       If ! Empty( cOrder ) 
          ATail( ::aColumns ):lIndexCol := .T. 
       EndIf 
  
    Next 
  
    If ::nLen == 0 
       cAlias := ::cAlias 
       ::nLen := iif( ::bLogicLen == Nil, Eval( ::bLogicLen := {||( cAlias )->( LastRec() ) } ), Eval( ::bLogicLen ) ) 
    EndIf 
  
 Return Self

Haz
администратор
Пост N: 1603 Зарегистрирован: 20.02.11

Отправлено: 25.09.20 17:58. Заголовок: gfilatov2002 пишет: ..

gfilatov2002 пишет:

цитата:

Привожу полный текст исправленного метода для проверки:

Все отлично

единственное под сомнением это [ ATail( ::aColumns ):cFieldTyp := aStru[ nE, 2 ]

SergKis
постоянный участник
Пост N: 3386 Зарегистрирован: 17.02.12

Отправлено: 25.09.20 21:33. Заголовок: Haz пишет единственн..

Haz пишет

цитата:

единственное под сомнением это [ ATail( ::aColumns ):cFieldTyp := aStru[ nE, 2 ]

Это не должно вызывать сомнения, т.к. это для customer использования, т.е. привязка к реальному типу поля
Сомнения вызывают Valtype(от полей ^+) они дадут "N" ((возможно еще есть какие варианты, не помню) и это надо учитывать тут

 
        If cType == "C"  
           cPicture := "@K " + Replicate( 'X', aStru[ nE, 3 ] )  
        ElseIf cType == "N" .and. aStru[ nE, 2 ] $ "^+"  
           cPicture := Replicate( '9', 10 )  
        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  
        EndIf

gfilatov2002
moderator
Пост N: 1789 Зарегистрирован: 11.02.10

Отправлено: 25.09.20 21:54. Заголовок: SergKis пишет: это ..

SergKis пишет:

цитата:

это надо учитывать

Поправил этот код.

Благодарю за помощь

SergKis
постоянный участник
Пост N: 3387 Зарегистрирован: 17.02.12

Отправлено: 25.09.20 21:56. Заголовок: PS Для поля "M&#..

PS
Для поля "M" получим valtype() -> "C" и не попадем на веточку

 
           ElseIf cType == "M"  
              nSize := iif( ::nMemoWV == Nil, 200, ::nMemoWV )

, для "=@" получим "T", но это, наверно, нормально веточка сработает

 
           ElseIf cType $ "=@T"  
              nSize := GetTextWidth( 0, Replicate( "9", 24 ), hFont )  
 а 
           ElseIf cType $ "^+"  
              nSize := GetTextWidth( 0, Replicate( "9", 10 ), hFont )  
 не сработает

т.е. в целом нужна большая переработка, но можно пойти др. путем
Игорь, какой тип получаем в структуре aStru[ nE, 2 ] для поля "CICHARACTER" U или пусто ?
Может Valtype делать для таких полей (с неопределенной структурой) и для них делать Valtype() и результат заносить в aStru[ nE, 2 ], тогда метод не меняется практически

SergKis
постоянный участник
Пост N: 3388 Зарегистрирован: 17.02.12

Отправлено: 25.09.20 22:08. Заголовок: PS тогда, наверно, п..

PS
тогда, наверно, придется определять и aStru[ nE, 3 ] и aStru[ nE, 4 ], но в методе дальше ничего не меняется

SergKis
постоянный участник
Пост N: 3390 Зарегистрирован: 17.02.12

Отправлено: 25.09.20 22:39. Заголовок: PS2 Как то так получ..

PS2
Как то так получится

 
       cType := aStru[ nE, 2 ] 
       IF Empty(cType) .or. cType == "U" 
          cData := ( cAlias )->( FieldGet( nE ) ) 
          aStru[ nE, 2 ] := Valtype( cData ) 
          cType := aStru[ nE, 2 ] 
          IF cType == "C" 
             aStru[ nE, 3 ] := Len( cData ) 
             aStru[ nE, 4 ] := 0 
          ELSE 
 // тут смотреть твои (ADS) варианты и добавить 
          ENDIF 
       ENDIF

Haz
администратор
Пост N: 1604 Зарегистрирован: 20.02.11

Отправлено: 26.09.20 08:09. Заголовок: SergKis пишет: како..

SergKis пишет:

цитата:

какой тип получаем в структуре aStru[ nE, 2 ] для поля "CICHARACTER"

Dbstruct() возвратит именно CICHARACTER , valtype() вернет С.
В ADS есть и другие символьные поля это просто CHAR и VARCHAR! но valtype() справедливо вернет С. Тоже касается поля с автоинкрементом в ADS это AUTUINC , valtype вернет N, есть поле дата время TIMESTAMP , valtype его вернет как T (тут надо проверить )

Могу прописать по аналогии с dbf кусок кода для ADS с особенностями его типов полей. Вроде это пока единственный rdd выбивающийся из структуры классического dbf. Но с другой стороны логичнее все же привязываться к типам данных которые знает харбур , а не дергать их из структуры. То есть, valtype будет универсальнее чем dbsruct()

SergKis
постоянный участник
Пост N: 3391 Зарегистрирован: 17.02.12

Отправлено: 26.09.20 09:04. Заголовок: Haz пишет Могу пропи..

Haz пишет

цитата:

Могу прописать по аналогии с dbf кусок кода для ADS с особенностями его типов полей. Вроде это пока единственный rdd выбивающийся из структуры классического dbf. Но с другой стороны логичнее все же привязываться к типам данных которые знает харбур , а не дергать их из структуры. То есть, valtype будет универсальнее чем dbsruct()

Думаю, надо прописать (или определять весь список полей dbf), будет правильнее, т.к. лучше понимать ситуацию. Можно даже завести переменную hash в классе для такого списка с "правильной" перекодировкой. Ведь надо еще правильно формировать aStru[ nE, 3\4 ]. От полученного значения (cAlias)->(FieldGet(nE)) может возникать вариантность этих значений.
ADS все таки RDD и сделать такую штуку, включив в тсб - нормальное решение

SergKis
постоянный участник
Пост N: 3392 Зарегистрирован: 17.02.12

Отправлено: 26.09.20 09:12. Заголовок: Haz пишет То есть, v..

Haz пишет

цитата:

То есть, valtype будет универсальнее чем dbsruct()

Так и будем прыгать сначала от valtype, но для определения cType и nLen, nDec для работы метода.
Если dbStruct() дает правильные типы в aStru, то их можно оставлять для :cFieldTyp, :cFieldLen, :cFieldDec для правильной привязки к полю.

Haz
администратор
Пост N: 1605 Зарегистрирован: 20.02.11

Отправлено: 26.09.20 09:30. Заголовок: SergKis пишет: надо..

SergKis пишет:

цитата:

надо прописать (или определять весь список полей dbf), будет правильнее

в понедельник с работы пропишу

Haz
администратор
Пост N: 1606 Зарегистрирован: 20.02.11

Отправлено: 26.09.20 09:43. Заголовок: SergKis пишет: смот..

SergKis пишет:

цитата:

смотрю версию 2.07 от 2012 года там в LoadFields
aStru := ( cAlias )->( DbStruct() )
и

Тогда не пойму в чем дело. Последний раз обновлял сборку примерно полгода-год назад. Все строковые данные отображались корректно по колонкам где пикчи не было.
Пару дней назад перешёл на последнюю сборку, записал проект в работу и посыпались жалобы. По коду только на loadfilds похоже, что еще может быть не пойму. В проекте после примерно 50 правок явного указания пикчи устал и просто в функцию создающую tsb после определения бровса добавил код который указал выше для символьных полей. Все заработало.
Но вот если это тянется с 2012 года, я реально не понимаю что случилось

gfilatov2002
moderator
Пост N: 1790 Зарегистрирован: 11.02.10

Отправлено: 26.09.20 12:03. Заголовок: SergKis пишет: Так ..

SergKis пишет:

цитата:

Так и будем прыгать сначала от valtype, но для определения cType и nLen, nDec для работы метода.

Для того, чтобы сделать этот код универсальным, записал в методе так:

 
       cData := ( cAlias )->( FieldGet( nE ) ) 
       cType := ValType( cData ) 
  
       If cType == "C" 
          cPicture := "@K " + Replicate( 'X', aStru[ nE, 3 ] ) 
       ElseIf cType == "N" .and. aStru[ nE, 2 ] $ "^+" 
          cPicture := Replicate( '9', 10 ) 
       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 
       EndIf 
  
       If nSize == Nil 
          cType  := aStru[ nE, 2 ] 
          nSize  := aStru[ nE, 3 ] 
          nDec   := aStru[ nE, 4 ] 
          hFont  := iif( ::hFont != Nil, ::hFont, 0 ) 
          hFontH := iif( ::hFontHead != Nil, ::hFontHead, ::hFont ) 
  
          If cType == "C" 
             cData := PadR( Trim( cData ), nSize, "B" ) 
             nSize := GetTextWidth( 0, cData, hFont ) 
          ElseIf cType == "N" 
             cData := StrZero( cData, nSize, nDec ) 
             nSize := GetTextWidth( 0, cData, hFont ) 
          ElseIf cType == "D" 
             cData := cValToChar( iif( Empty( cData ), Date(), cData ) ) 
             nSize := Int( GetTextWidth( 0, cData + "BB", hFont ) ) + iif( lEditable, 30, 0 ) 
          ElseIf cType == "M" 
             nSize := iif( ::nMemoWV == Nil, 200, ::nMemoWV ) 
          ElseIf cType $ "=@T" 
             nSize := GetTextWidth( 0, Replicate( "9", 24 ), hFont ) 
          ElseIf cType $ "^+" 
             nSize := GetTextWidth( 0, Replicate( "9", 10 ), hFont ) 
          Else 
             cData := cValToChar( cData ) 
             nSize := GetTextWidth( 0, cData, hFont ) 
          EndIf 
 ...

Haz
администратор
Пост N: 1607 Зарегистрирован: 20.02.11

Отправлено: 26.09.20 13:46. Заголовок: Григорий, видимо для..

Григорий, видимо для универсальности нужно будет явно прописать типы ads. Их там гораздо больше чем в dbf. http://devzone.advantagedatabase.com/dz/webhelp/advantage7.1/server1/adt_field_types_and_specifications.htm
В понедельник пришлю правку подних (дома нет компа ). За основу возьму код последним выложенный здесь .
Заодно попрошу обновить библиотеку ads, в поставке она устарела . последняя версия ads v12 . именно на ней sap похоронил этот продукт после покупки. Библиотеку под 12 для bcc тоже вышлю

SergKis
постоянный участник
Пост N: 3393 Зарегистрирован: 17.02.12

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

gfilatov2002 пишет

 
        cData := ( cAlias )->( FieldGet( nE ) )  
        cType := ValType( cData )  
    
        If cType == "C"  
           cPicture := "@K " + Replicate( 'X', aStru[ nE, 3 ] )  
        ElseIf cType == "N" .and. aStru[ nE, 2 ] $ "^+"  
           cPicture := Replicate( '9', 10 )  
        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  
        EndIf  
    
        If nSize == Nil  
           cType  := aStru[ nE, 2 ]  
           nSize  := aStru[ nE, 3 ]  
           nDec   := aStru[ nE, 4 ]  
           hFont  := iif( ::hFont != Nil, ::hFont, 0 )  
           hFontH := iif( ::hFontHead != Nil, ::hFontHead, ::hFont )  
    
           If cType == "C"  
              cData := PadR( Trim( cData ), nSize, "B" )  
              nSize := GetTextWidth( 0, cData, hFont )  
           ElseIf cType == "N"  
 ...

1. Предлагаю убрать выделенное синим цветом, т.к. если задан массив размеров, то из него не правильно берется размер, для всех колонок и тогда всегда надо делать переустановку. Если убрать, то формируются данные из структуры dbf и это более точно получается, но поправить потом можно. У себя убрал это давно
2. Предложенное не подойдет, т.к. CICHARACTER в cType := aStru[ nE, 2 ] после If nSize == Nil не сработает If cType == "C"
На мой взгляд надо, сто то такое

 
 cType := aStru[ nE, 2 ] 
 If Len(cType) > 1 
    If cType == ""AUTOINC 
       cType := "^" 
    Else 
       cType := Valtype( (cAlias)->(FieldGet(nE)) ) 
    EndIf 
 // может еще варианты, Игорь должен подсказать 
 EndIf

Тогда в aStru[ nE, 2 ] будет реальный тип и попадет в :cFieldTyp, а логика отработает в методе нормально.
Надо посмотреть на Len и Dec в aStru, если они нормальные, то они отработают ок

SergKis
постоянный участник
Пост N: 3394 Зарегистрирован: 17.02.12

Отправлено: 26.09.20 14:01. Заголовок: Haz пишет За основу ..

Haz пишет

цитата:

За основу возьму код последним выложенный здесь

Надо брать код из либы последней, выложенный на основе valtype будет работать неверно

Haz
администратор
Пост N: 1608 Зарегистрирован: 20.02.11

Отправлено: 26.09.20 14:04. Заголовок: SergKis пишет: Надо..

SergKis пишет:

цитата:

Надо брать код из либы последней,

Договорились.

Haz
администратор
Пост N: 1610 Зарегистрирован: 20.02.11

Отправлено: 28.09.20 14:13. Заголовок: SergKis пишет: Надо..

SergKis пишет:

цитата:

Надо брать код из либы последней, выложенный на основе valtype будет работать неверно

Примерно так получилось, можно было на хеш массиве сделать , но выигрыша в скорости на таком коротком не будет
Далее по коду ищется в массиве aType значение из dbstruct, а возвращается соответствующее valtype

 
      local aType := {} 
  
       aType := {} 
       aAdd( aType, {"CICHARACTER", "C"} ) // CiCharacter 
       aAdd( aType, {"C",           "C"} ) // Character 
       aAdd( aType, {"C:U",         "C"} ) // nChar 
       aAdd( aType, {"C:B",         "C"} ) // Raw 
       aAdd( aType, {"Q",           "C"} ) // VarCharFox 
       aAdd( aType, {"Q:U",         "C"} ) // nVarChar 
       aAdd( aType, {"Q:B",         "C"} ) // VarBinaryFox 
                   
       aAdd( aType, {"D",           "D"} ) // Date 
  
       aAdd( aType, {"T",           "T"} ) // Time 
       aAdd( aType, {"@",           "T"} ) // TimeStamp 
       aAdd( aType, {"=",           "T"} ) // ModTime 
  
       aAdd( aType, {"I",           "N"} ) // Integer, ShortInt, LongInt 
       aAdd( aType, {"B",           "N"} ) // Double 
       aAdd( aType, {"+",           "N"} ) // Autoinc 
       aAdd( aType, {"N",           "N"} ) // Numeric 
       aAdd( aType, {"Y",           "N"} ) // Money 
       aAdd( aType, {"Z",           "N"} ) // Curdouble 
       aAdd( aType, {"^",           "N"} ) // RowVersion 
  
       aAdd( aType, {"M",           "M"} ) // Memo 
       aAdd( aType, {"M:U",         "M"} ) // nMemo 
       aAdd( aType, {"W",           "M"} ) // Binary 
       aAdd( aType, {"P",           "M"} ) // Image 
  
       aAdd( aType, {"L",           "L"} ) //  
  
       If aType[Ascan( aType, {|e| e[1] == cType })][2] == "C" 
          cPicture := "@K " + Replicate( 'X', aStru[ nE, 3 ] ) 
       ElseIf aType[Ascan( aType, {|e| e[1] == cType })][2] == "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 
  
  
  
  
       If nSize == Nil 
          cData  := ( cAlias )->( FieldGet( nE ) ) 
          cType  := aStru[ nE, 2 ] 
          nSize  := aStru[ nE, 3 ] 
          nDec   := aStru[ nE, 4 ] 
          hFont  := iif( ::hFont != Nil, ::hFont, 0 ) 
          hFontH := iif( ::hFontHead != Nil, ::hFontHead, ::hFont ) 
  
          If aType[Ascan( aType, {|e| e[1] == cType })][2] ==  "C" 
             cData := PadR( Trim( cData ), nSize, "B" ) 
             nSize := GetTextWidth( 0, cData, hFont ) 
          ElseIf aType[Ascan( aType, {|e| e[1] == cType })][2] ==  "N" 
             cData := StrZero( cData, nSize, nDec ) 
             nSize := GetTextWidth( 0, cData, hFont ) 
          ElseIf aType[Ascan( aType, {|e| e[1] == cType })][2] ==  "D" 
             cData := cValToChar( iif( Empty( cData ), Date(), cData ) ) 
             nSize := Int( GetTextWidth( 0, cData + "BB", hFont ) ) + iif( lEditable, 30, 0 ) 
          ElseIf aType[Ascan( aType, {|e| e[1] == cType })][2] ==  "M" 
             nSize := iif( ::nMemoWV == Nil, 200, ::nMemoWV ) 
          ElseIf aType[Ascan( aType, {|e| e[1] == cType })][2] == "T" 
             nSize := GetTextWidth( 0, Replicate( "9", 24 ), hFont ) 
          ElseIf cType $ "^+" 
             nSize := GetTextWidth( 0, Replicate( "9", 10 ), hFont ) 
          Else 
             cData := cValToChar( cData ) 
             nSize := GetTextWidth( 0, cData, hFont ) 
          EndIf 
  
          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 ) 
          nSize := ::aColSizes[ n ] 
       EndIf

Haz
администратор
Пост N: 1611 Зарегистрирован: 20.02.11

Отправлено: 28.09.20 14:22. Заголовок: Haz пишет: aType ==..

Haz пишет:

цитата:

aType[Ascan( aType, {|e| e[1] == cType })][2]

Думаю этот код нужно выполнить до сравнения один раз с проверкой на возврат нуля, иначе будет вылет если dbstruct вернет не прописанный в массиве тип

gfilatov2002
moderator
Пост N: 1791 Зарегистрирован: 11.02.10

Отправлено: 28.09.20 14:50. Заголовок: Haz пишет: Примерно..

Haz пишет:

цитата:

Примерно так получилось

Вынес поиск в массиве в статическую функцию GetDbfFieldType()
и записал этот фрагмент таким образом:

      cType := aStru[ nE, 2 ] 
       If GetDbfFieldType( cType ) == "C" 
          cPicture := "@K " + Replicate( 'X', aStru[ nE, 3 ] ) 
       ElseIf cType $ "^+" 
          cPicture := Replicate( '9', 10 ) 
       ElseIf GetDbfFieldType( 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 
       EndIf 
  
       If nSize == Nil 
          cData  := ( cAlias )->( FieldGet( nE ) ) 
          cType  := GetDbfFieldType( aStru[ nE, 2 ] ) 
          nSize  := aStru[ nE, 3 ] 
          nDec   := aStru[ nE, 4 ] 
          hFont  := iif( ::hFont != Nil, ::hFont, 0 ) 
          hFontH := iif( ::hFontHead != Nil, ::hFontHead, ::hFont ) 
  
          If cType == "C" 
             cData := PadR( Trim( cData ), nSize, "B" ) 
             nSize := GetTextWidth( 0, cData, hFont ) 
          ElseIf aStru[ nE, 2 ] $ "^+" 
             nSize := GetTextWidth( 0, Replicate( "9", 10 ), hFont ) 
          ElseIf cType == "N" 
             cData := StrZero( cData, nSize, nDec ) 
             nSize := GetTextWidth( 0, cData, hFont ) 
          ElseIf cType == "D" 
             cData := cValToChar( iif( Empty( cData ), Date(), cData ) ) 
             nSize := Int( GetTextWidth( 0, cData + "BB", hFont ) ) + iif( lEditable, 30, 0 ) 
          ElseIf cType == "M" 
             nSize := iif( ::nMemoWV == Nil, 200, ::nMemoWV ) 
          ElseIf cType == "T" 
             nSize := GetTextWidth( 0, Replicate( "9", 24 ), hFont ) 
          Else 
             cData := cValToChar( cData ) 
             nSize := GetTextWidth( 0, cData, hFont ) 
          EndIf 
  
          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 ) 
          nSize := ::aColSizes[ n ] 
       EndIf

Благодарю за помощь

SergKis
постоянный участник
Пост N: 3395 Зарегистрирован: 17.02.12

Отправлено: 28.09.20 15:01. Заголовок: Haz пишет код нужно ..

Haz пишет

цитата:

код нужно выполнить до сравнения один раз с проверкой на возврат нуля, иначе будет вылет если dbstruct вернет не прописанный в массиве тип

Предлагаю так (можно будет расширять список, если что)

 
      DATA aFieldTypes AS ARRAY INIT { ; 
                                      {"CICHARACTER", "C"}, ; // CiCharacter  
                                      {"C",           "C"}, ; // Character  
                                      {"C:U",         "C"}, ; // nChar  
                                      {"C:B",         "C"}, ; // Raw  
                                      {"Q",           "C"}, ; // VarCharFox  
                                      {"Q:U",         "C"}, ; // nVarChar  
                                      {"Q:B",         "C"}, ; // VarBinaryFox  
                                      {"D",           "D"}, ; // Date  
                                      {"T",           "T"}, ; // Time  
                                      {"@",           "T"}, ; // TimeStamp  
                                      {"=",           "T"}, ; // ModTime  
                                      {"I",           "N"}, ; // Integer, ShortInt, LongInt  
                                      {"B",           "N"}, ; // Double  
                                      {"+",           "N"}, ; // Autoinc  
                                      {"N",           "N"}, ; // Numeric  
                                      {"Y",           "N"}, ; // Money  
                                      {"Z",           "N"}, ; // Curdouble  
                                      {"^",           "N"}, ; // RowVersion  
                                      {"M",           "M"}, ; // Memo  
                                      {"M:U",         "M"}, ; // nMemo  
                                      {"W",           "M"}, ; // Binary  
                                      {"P",           "M"}, ; // Image  
                                      {"L",           "L"}  ; //   
                                     } 
       
      Local aType := ::aFieldTypes, nType 
      ... 
      cType := aStru[ nE, 2 ] 
  
      IF ( nType := Ascan( aType, {|e| e[1] == cType }) ) > 0 
         cType := aType[nType ][2] 
      ENDIF 
      ... 
 Далее по тексту метода, как был

Haz
администратор
Пост N: 1612 Зарегистрирован: 20.02.11

Отправлено: 28.09.20 15:48. Заголовок: SergKis пишет: Пред..

SergKis пишет:

цитата:

Предлагаю так (можно будет расширять список, если что)

Согласен, погоняю еще позже отпишусь . Сейчас занят очень

gfilatov2002
moderator
Пост N: 1792 Зарегистрирован: 11.02.10

Отправлено: 28.09.20 15:57. Заголовок: SergKis пишет: Пред..

SergKis пишет:

цитата:

Предлагаю так

Принято, тестовый пример отработал нормально

Благодарю за помощь

Haz
администратор
Пост N: 1613 Зарегистрирован: 20.02.11

Отправлено: 28.09.20 16:05. Заголовок: SergKis пишет: IF..

SergKis пишет:

цитата:

IF ( nType := Ascan( aType, {|e| e[1] == cType }) ) > 0
cType := aType[nType ][2]
ENDIF

Сергей, тогда потеряется это

 
       ElseIf cType $ "^+" 
          cPicture := Replicate( '9', 10 ) 
       EndIf

SergKis
постоянный участник
Пост N: 3396 Зарегистрирован: 17.02.12

Отправлено: 28.09.20 18:37. Заголовок: Haz пишет тогда поте..

Haz пишет

цитата:

тогда потеряется это

По правильному, надо выкинуть из массива стандартные значения, т.е.
{"C", "C"}, ; // Character
{"D", "D"}, ; // Date
{"T", "T"}, ; // Time
{"@", "T"}, ; // TimeStamp
{"=", "T"}, ; // ModTime
{"+", "N"}, ; // Autoinc
{"^", "N"}, ; // RowVersion
{"M", "M"}, ; // Memo
{"L", "L"} ; //
т.к. они будут браться из aStru[ nE, 2 ], не дали дописать, отвлекли

Haz
администратор
Пост N: 1614 Зарегистрирован: 20.02.11

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

SergKis пишет:

цитата:

надо выкинуть из массива стандартные значения

Сергей я бы оставил. Так как в этом массиве? Будет ещё и тип valtype. Может пригодиться

SergKis
постоянный участник
Пост N: 3397 Зарегистрирован: 17.02.12

Отправлено: 28.09.20 19:20. Заголовок: Haz пишет Сергей я б..

Haz пишет

цитата:

Сергей я бы оставил. Так как в этом массиве? Будет ещё и тип valtype. Может пригодиться

Мне кажется это лишнее оставлять. Если убрать, то не теряются += и т.д., но если самому поставить свое значение, то оно сработает перекодировкой вместо стандартного. Т.е. мы ничего не теляем
В каком виде будет valtype ? Если в виде массива (второй элемент), то тогда наверно надо идти путем бока кода второй элемент и анализ возврата, если это массив, то возвращается Type и Valtype ..., хотя не знаю надо ли ?

SergKis
постоянный участник
Пост N: 3398 Зарегистрирован: 17.02.12

Отправлено: 28.09.20 20:14. Заголовок: PS С Valtype можно п..

PS
С Valtype можно попробовать следующее

 
       If nSize == Nil 
          cData  := ( cAlias )->( FieldGet( nE ) ) 
          // убрать совсем cType  := aStru[ nE, 2 ] 
          IF cType != Valtype( cData ) .and. nType > 0 
              cType := Valtype( cData ) 
          ENDIF 
          nSize  := aStru[ nE, 3 ] 
          nDec   := aStru[ nE, 4 ] 
 ...

Haz
администратор
Пост N: 1615 Зарегистрирован: 20.02.11

Отправлено: 28.09.20 20:31. Заголовок: SergKis пишет: В ка..

SergKis пишет:

цитата:

В каком виде будет valtype

пока тоже не уверен как можно использовать. Просто в одном массиве соответствие всех типов для dbstruct и valtype

gfilatov2002
moderator
Пост N: 1793 Зарегистрирован: 11.02.10

Отправлено: 28.09.20 20:31. Заголовок: SergKis пишет: ..

SergKis пишет:

цитата:

// убрать совсем cType := aStru[ nE, 2 ]
IF cType != Valtype( cData ) .and. nType > 0
cType := Valtype( cData )
ENDIF

Ok, так и сделал

Haz
администратор
Пост N: 1616 Зарегистрирован: 20.02.11

Отправлено: 29.09.20 17:59. Заголовок: Григорий, Можно в с..

Григорий,
Можно в сборке обновить rddads.lib до версии 12
Собрано под bcc82
https://drive.google.com/file/d/1TKuIGuCBsMjVe1b57IOipY8IJs9m1SYX/view?usp=sharing

gfilatov2002
moderator
Пост N: 1794 Зарегистрирован: 11.02.10

Отправлено: 29.09.20 20:31. Заголовок: Haz пишет: обновить..

Haz пишет:

цитата:

обновить rddads.lib до версии 12

Сделаю, конечно

Благодарю за помощь

gfilatov2002
moderator
Пост N: 1795 Зарегистрирован: 11.02.10

Отправлено: 30.09.20 10:03. Заголовок: Всем кому это интересно

Выпустил 5-е обновление сборки 20.08 со всеми последними наработками

Haz
администратор
Пост N: 1617 Зарегистрирован: 20.02.11

Отправлено: 30.09.20 17:51. Заголовок: Предлагаю еще одну п..

Предлагаю еще одну проблемку обсудить.
Суть в том то TSBrowse прорисовывается 2 раза
Первый раз тут

 
 FUNCTION _EndTBrowse( bEnd ) 
 *-----------------------------------------------------------------------------* 
    LOCAL i, oBrw 
    LOCAL oc := NIL, ow := NIL 
 #ifdef _OBJECT_ 
    ow := oDlu2Pixel() 
 #endif 
  
    IF _HMG_BeginTBrowseActive 
       i := AScan( _HMG_aControlHandles, _HMG_ActiveTBrowseHandle ) 
       IF i > 0 
          oBrw := _HMG_aControlIds[ i ] 
          oBrw:lRePaint := .T. 
          oBrw:Display() 
          _HMG_ActiveTBrowseName   := "" 
          _HMG_ActiveTBrowseHandle := 0 
          _HMG_BeginTBrowseActive  := .F. 
 #ifdef _OBJECT_ 
          IF _HMG_lOOPEnabled 
             ow := _WindowObj(  _HMG_aControlParenthandles[ i ] ) 
             oc := _ControlObj( _HMG_aControlHandles      [ i ] ) 
          ENDIF 
 #endif 
          Do_ControlEventProcedure( bEnd, i, oBrw, ow, oc ) 
       ENDIF 
    ENDIF 
  
 RETURN NIL

Второй раз из hantleevent по событию UPDATEWINDOW

чтобы это увидеть достаточно добавить в TSBrowse:DrawLine()

 
    Default xRow := iif( ::lDrawHeaders, Max( 1, nRowPos ), nRowPos ), lDrawCell := ::lDrawLine 
  
    StrFile( hb_ntoc(++ nCount) + Chr(9) + hb_ntoc(xRow) + chr(9) + Procname(0) + hb_ntoc(ProcLine(0)) + chr(9) + Procname(1) + hb_ntoc(ProcLine(1)) + chr(9) + Procname(2) + hb_ntoc(ProcLine(2))  + chr(9) + Procname(3) + hb_ntoc(ProcLine(3))  + chr(9) + Procname(4) + hb_ntoc(ProcLine(4))  + chr(9) + Procname(5) + hb_ntoc(ProcLine(5)) + chr(9) + hb_eol(), "_DrawLine", .t. )

и посмотреть лог

Если на экране не один бровс и выборка данных для него не быстрая - начинает напрягать.

Собственно вопрос насколько нужна прорисовка в _EndTBrowse (где первый раз) , если через евенты по любому нарисуем снова.
Тупое комментирование выделенных строк в _EndTBrowse на результат не повлияло, но прорисовка выполнилась один раз

SergKis
постоянный участник
Пост N: 3399 Зарегистрирован: 17.02.12

Отправлено: 30.09.20 18:31. Заголовок: Haz пишет Тупое комм..

Haz пишет

цитата:

Тупое комментирование выделенных строк в _EndTBrowse на результат не повлияло, но прорисовка выполнилась один раз

Не все так просто с этим. Тоже смотре на это место, бывает даже с двойной прорисовкой получается ерунда в отображении, т.е. сетка строк сбита
(внизу дыра чуть ли не 2-3 строки, курсорная строка прорисована в 2х местах), добавляю в END TBROWSE ON END {|obr| ..., obr:Refresh() } и только
тогда получается правильная прорисовка всей сетки тсб. Если использовать :aRowPosAtRec[ xRow ], то приходится проверять соответствие тек. строки
массива ( RecNo() ) и тек. RecNo() базы, сталкивался не только с несовпадением, но и со значением Nil, т.е. ощущение что :DrawLine() перепрыгнула
запись в файле.
Но пробовать можно ускорять, добавив переменную типа DATA lSpeedDraw AS LOGICAL INIT .T. и проверять в END TBROWSE

SergKis
постоянный участник
Пост N: 3400 Зарегистрирован: 17.02.12

Отправлено: 30.09.20 18:37. Заголовок: PS :DrawLine() еще п..

PS
:DrawLine() еще присутствует во всех :Go...() методах, т.е. одного END TBROWSE "маловато будет"

Haz
администратор
Пост N: 1618 Зарегистрирован: 20.02.11

Отправлено: 01.10.20 09:04. Заголовок: SergKis пишет: т.е...

SergKis пишет:

цитата:

т.е. одного END TBROWSE "маловато будет

да, заметил такое. Не дошел вчера. Иногда в проекте у себя вижу по 4 раза рисует.

::lSpedDraw действительно можно завести, чтобы тестировать оптимизацию прорисовки

SergKis
постоянный участник
Пост N: 3401 Зарегистрирован: 17.02.12

Отправлено: 01.10.20 09:56. Заголовок: Haz пишет ::lSpedDra..

Haz пишет

цитата:

::lSpedDraw действительно можно завести, чтобы тестировать оптимизацию прорисовки

Сейчас прорисовка осуществляется примерно так, от текущей записи (если курсор в середине окна тсб лучше видно)
к началу и потом от текущей к концу списка рисуемых строк. На мой взгляд это надо бы поменять, рисуя от первой
строки и до конца списка рисуемых строк (:nRowCount()). Тогда управлять проще, для этого и отладки вводил массив
:aRowPosAtRec, Tooltip на нем это побочное явление, но пока остановился на этом (упростить не получается), слишком
много прорисовки вызовов разбросано по тексту

Haz
администратор
Пост N: 1619 Зарегистрирован: 20.02.11

Отправлено: 01.10.20 13:14. Заголовок: SergKis пишет: Сейч..

SergKis пишет:

цитата:

Сейчас прорисовка осуществляется примерно так, от текущей записи (если курсор в середине окна тсб лучше видно)
к началу и потом от текущей к концу списка рисуемых строк

Это точно? не нашел в коде такого алгоритма

Зато нашел лишнее

 
 METHOD GoRight() CLASS TSBrowse 
  
 7884:   Local nTxtWid, nWidth, nCell, nSkip, lRefresh := .F.  добавить инициализацию .F. 
  
 7949:      lRefresh := ( ::lCanAppend .or. ::lIsArr ) Лишняя строка , вызывает лишнюю прорисовку при работе метода 
  
  
 METHOD TSBrowse:PostEdit() 
 11552: SysRefresh() - тоже вроде как для подстраховки и вызывает прорисовку потестил без него - разницу не унюхал

SergKis
постоянный участник
Пост N: 3402 Зарегистрирован: 17.02.12

Отправлено: 01.10.20 15:18. Заголовок: Haz пишет Это точно?..

Haz пишет

цитата:

Это точно? не нашел в коде такого алгоритма

Ты прав, нет такого, визуально показалось, т.к. сначала перепоказ идет текущей строки, потом переход на первую на экране и рисование до нижней,
тек. уже нарисована и не меняется.

цитата:

11552: SysRefresh() - тоже вроде как для подстраховки и вызывает прорисовку потестил без него - разницу не унюхал

Это скорее перепоказ изменившихся др. строк в общем доступе

Поправил в методе DrawLine

 
 METHOD DrawLine( xRow, lDrawCell ) CLASS TSBrowse 
 ... 
 		If ::bOnDrawLine != Nil 
 			Eval( ::bOnDrawLine, Self, xRow ) 
 		EndIf 
 ...

Взял пример Tsb_MoreFields\demo.prg и добавил

 
 #define _HMG_OUTLOG 
  
 #include "hmg.ch" 
 #include "TSBrowse.ch" 
 REQUEST DBFCDX 
  
 FUNCTION Main() 
  
 ... 
          ON INIT {| ob | TsbCreate( ob, .T. ) } 
  
          :Cargo := oKeyData() 
  
          :lRowPosAtRec := .T. 
          :bTSDrawCell := {|ob,oc| 
                            If oc:nDrawType == 0 
  ? procname(1),procline(1),procname(2),procline(2),procname(3),procline(3),procname(4),procline(4),procname(5),procline(5) 
                               ?? " Col =",oc:nCell 
                            EndIf 
                            Return Nil 
                          } 
          :bOnDrawLine := {|ob,xrow| 
                            Local nRow := ob:nRowPos 
                            Local nPos := ob:nCell 
                            Local nLen := Len(ob:aRowPosAtRec) 
 // ? procname(1),procline(1),procname(2),procline(2),procname(3),procline(3),procname(4),procline(4),procname(5),procline(5) 
                            ? "xRow =",xrow,"nRowCount =",nLen,"nCell =",nPos,"nTek =",nRow,"RecNo =" 
                            If nRow > 0 .and. nRow <= nLen 
                               ?? ob:aRowPosAtRec[ nRow ] 
                            Else 
                               ?? "Error", nRow 
                            EndIf 
                            Return Nil 
                          } 
  
       END TBROWSE ON END {| ob | TsbCreate( ob, .F. ) } 
 ...

смотрю лог и в целом выглядит логично по отображению

Haz
администратор
Пост N: 1620 Зарегистрирован: 20.02.11

Отправлено: 01.10.20 21:49. Заголовок: SergKis пишет: смот..

SergKis пишет:

цитата:

смотрю лог и в целом выглядит логично по отображению

завтра погоняю твой пример

SergKis
постоянный участник
Пост N: 3403 Зарегистрирован: 17.02.12

Отправлено: 02.10.20 12:14. Заголовок: Haz пишет погоняю тв..

Haz пишет

цитата:

погоняю твой пример

Поправь еще в методе :DrawSelect()

 
 METHOD DrawSelect( xRow, lDrawCell ) CLASS TSBrowse 
 ... 
 		ENDIF 
  
 		If ::bOnDrawLine != Nil 
 			Eval( ::bOnDrawLine, Self, xRow ) 
 		EndIf 
  
 		If ! ::lDrawLine 
 			nBegin := 1 
 			nLastCol := ::nColCount() 
 		EndIf 
 ... 
  
 В примере добавь 
 STATIC FUNC myProc( n ) 
 RETURN StrTran(Procname(n), "TSBROWSE:", ":") 
 и 
          :bTSDrawCell := {|ob,oc,ok| 
                            If oc:nDrawType == 0 
  ? myproc(1),procline(1),myproc(2),procline(2),myproc(3),procline(3),myproc(4),procline(4),myproc(5),procline(5) 
                               ?? oc:lDrawLine,"Col =",oc:nCell, ok:cName 
                            EndIf 
                            Return Nil 
                          } 
 удобней смотреть будет

SergKis
постоянный участник
Пост N: 3404 Зарегистрирован: 17.02.12

Отправлено: 02.10.20 12:16. Заголовок: PS :bOnDraw..

 
          :bOnDrawLine := {|ob,xrow| 
                            Local nRow := ob:nRowPos 
                            Local nPos := ob:nCell 
                            Local nLen := Len(ob:aRowPosAtRec) 
 // ? procname(1),procline(1),procname(2),procline(2),procname(3),procline(3),procname(4),procline(4),procname(5),procline(5) 
                            ? "xRow =",xrow,"nRowCount =",nLen,"nCell =",nPos,"nTek =",nRow,"RecNo =" 
                            If nRow > 0 .and. nRow <= nLen 
                               ?? ob:aRowPosAtRec[ nRow ] 
                            Else 
                               ?? "Error nRow", nRow 
                            EndIf 
                            If xrow > 0 .and. xrow <= nLen 
                               ?? ob:aRowPosAtRec[ xrow ] 
                            Else 
                               ?? "Error xrow", xrow 
                            EndIf 
                            Return Nil 
                          }

SergKis
постоянный участник
Пост N: 3405 Зарегистрирован: 17.02.12

Отправлено: 02.10.20 12:29. Заголовок: Игорь Мне думается, ..

Игорь
Мне думается, что дело не в скорости прорисовки строк тсб, а в скорости выполнения перемещений по базе и заполнения
буферов записи rdd, т.е. много dbSkip() подводов вперед-назад. Если прочитать записи отображения 1 раз в буфер-массив и
потом отображаить\рисовать их, то скорость работы тсб увеличится, даже при 4х кратной прорисовке окна тсб

kkg

Пост N: 22 Зарегистрирован: 29.11.19

Отправлено: 02.10.20 12:31. Заголовок: коллеги, лишние прор..

коллеги, лишние прорисовки видны:
при движении курсора в видимой области влево вправо когда прорисовывается вся строка вместо 2 ячеек
аналогично лишняя прорисовка зоны nFreeze при прокрутке страницы
но мне кажется максимальный эффект можно получить если не прорисовывать весь грид, а скопировать видимую неизменяемую часть экрана
а потом стандартно прорисовать только одну стоку или столбец которых не хватает.

SergKis
постоянный участник
Пост N: 3406 Зарегистрирован: 17.02.12

Отправлено: 02.10.20 12:39. Заголовок: kkg Вы почти правы,..

kkg
Вы почти правы, если отбросить 20 элементов обработки цветов в колонках.
Если повторите мои исправления в тсб и пример, то увидите, что придраться к отработке событий прорисовки в логе
почти не к чему. Основной тормоз это перемещения по файлу, осуществляемое при каждой прорисовке, сначала от
текущей записи к первой потом от нее к последней, потом опять на текущую, с учетом событий got\lost focus как записи
так и колонки

kkg

Пост N: 23 Зарегистрирован: 29.11.19

Отправлено: 02.10.20 12:55. Заголовок: SergKis я бы согла..

SergKis
я бы согласился, но тормоза присутствуют и на массивах (кстати файлы тоже кешированны)

SergKis
постоянный участник
Пост N: 3407 Зарегистрирован: 17.02.12

Отправлено: 02.10.20 13:07. Заголовок: kkg пишет я бы согла..

kkg пишет

цитата:

я бы согласился, но тормоза присутствуют и на массивах (кстати файлы тоже кешированны)

Работа блоков кода на колонках по преобразованию данных (цветов ...) не убирается, создайте массив строковый сразу - будет чуть лучше. А создайте массив сразу с объектами oTScell будет совсем хорошо.

kkg

Пост N: 24 Зарегистрирован: 29.11.19

Отправлено: 02.10.20 13:36. Заголовок: SergKis Вы не понял..

SergKis
Вы не поняли, я и предложил не создавать каждый раз, а использовать цвет пикселей экрана (прямоугольник) который уже просчитан и на экране,
просто эту область переместить на нужные координаты и дорисовать строку или колонку которой не хватает

SergKis
постоянный участник
Пост N: 3408 Зарегистрирован: 17.02.12

Отправлено: 02.10.20 13:51. Заголовок: kkg пишет просто эту..

kkg пишет

цитата:

просто эту область переместить на нужные координаты и дорисовать строку или колонку которой не хватает

Я все понял. Сейчас тсб переотображая страницу покажет и изменившиеся значения в др. колонках при общем доступе с учетом цветов bmp и т.д. Ваш этого не учтет. В некоторых вариантах это необходимо, конечно. Но ...
Вы предлагайте конкретно по тексту, берем тут, правим так или так.
Игорь, как раз и смотрит, где можно что отсечь, к примеру с помощью доп. переменной.
Меня лично скорость тсб устраивает, т.к. нет у меня MoreFields, практически все колонки помещаю на один экран (методика в примере Tsb_MoreFields\demo.prg) + выборки из базы (letodb) короткие только нужные колонки (для связи на letodb и доп. тек. индексов) и т.д.

gfilatov2002
moderator
Пост N: 1796 Зарегистрирован: 11.02.10

Отправлено: 02.10.20 16:50. Заголовок: Всем кому это интересно

SergKis пишет:

цитата:

Игорь, как раз и смотрит, где можно что отсечь, к примеру с помощью доп. переменной.

Для этих целей добавил в класс TSBrowse переменную lFastDraw

цитата:

DATA lFastDraw AS LOGICAL INIT .F.

Пример использования в методе GoRight():

 
       If ! ::lFastDraw 
          lRefresh := ( ::lCanAppend .or. ::lIsArr ) 
       EndIf

Haz
администратор
Пост N: 1621 Зарегистрирован: 20.02.11

Отправлено: 02.10.20 20:28. Заголовок: gfilatov2002 пишет: ..

gfilatov2002 пишет:

цитата:

Пример использования в методе GoRight():

Григорий, тут эта строка лишняя на все 100. В goleft(), к примеру, нет подобного.
К сожалению сегодня не удалось дальше поразбираться, но продолжу. О результатах буду писать здесь.
Переменная нужна, она позволит оценить разницу в прорисовке не затрагивая стабильность работы.

Haz
администратор
Пост N: 1622 Зарегистрирован: 20.02.11

Отправлено: 02.10.20 20:35. Заголовок: SergKis пишет: Мне ..

SergKis пишет:

цитата:

Мне думается, что дело не в скорости прорисовки строк тсб, а в скорости выполнения перемещений по базе и заполнения

безусловно, но тормоза в прорисовке тоже большие. У меня в тестовом проекте значения для показа в ячейке берутся из справочника по ID, после первого показа уже из hash. Скорость возрастает в разы! Словно режим турбо включили, но когда на экране более 5 связных бровсов , тот тут только прорисовка и даже видно как все происходит. Сначала один бровс, потом остальные. Вот и хочу понять где.

Haz
администратор
Пост N: 1623 Зарегистрирован: 20.02.11

Отправлено: 02.10.20 20:42. Заголовок: SergKis пишет: Меня..

SergKis пишет:

цитата:

Меня лично скорость тсб устраивает, т.к. нет у меня MoreFields,

в понедельник постараюсь накидать пример из нескольких бровсов. Уверен проблема обозначиться яснее.
Суть в подчиненности таблиц, в зависимости от стройки в первой имеем выборку во второй ... и так далее. Прорисовка на экране идет волной более чем заметной. Возможно это тормозит метод :reset(). Вобщем постараюсь... накидать если по работе без форс мажора будет

Haz
администратор
Пост N: 1624 Зарегистрирован: 20.02.11

Отправлено: 02.10.20 20:49. Заголовок: kkg пишет: мне каже..

kkg пишет:

цитата:

мне кажется максимальный эффект можно получить если не прорисовывать весь грид, а скопировать видимую неизменяемую часть экрана
а потом стандартно прорисовать только одну стоку или столбец которых не хватает.

Нужно переделывать сдвиги в сторону на скролл окна, как при движении вверх или вниз. Текущий алгоритм унаследован со времен клиппер. Скорость прорисовки возрастет кратно, но не отобразит на скроллируемом куске изменения данных другими пользователями ( так и есть при вверх вниз) и думаю это нормально. Сергей реализовал класс cell, на основe которого можно сделать :refreshscreen() который будет перерисовывать изменившиеся ячейки видимой части бровсв.

SergKis
постоянный участник
Пост N: 3409 Зарегистрирован: 17.02.12

Отправлено: 02.10.20 22:17. Заголовок: Haz пишет класс cell..

Haz пишет

цитата:

класс cell, на основe которого можно сделать :refreshscreen() который будет перерисовывать изменившиеся ячейки видимой части бровсв.

Это будет давать эффект, если иметь массив таких TSBcell объектов для всех строк экрана\окна тсб, для одной, как сейчас ничего не решит. Т.е. рисуем запоминаем объекты TSBcell, потом используем при повторных прорисовках

SergKis
постоянный участник
Пост N: 3410 Зарегистрирован: 17.02.12

Отправлено: 02.10.20 22:37. Заголовок: Haz пишет но когда н..

Haz пишет

цитата:

но когда на экране более 5 связных бровсов , тот тут только прорисовка и даже видно как все происходит. Сначала один бровс, потом остальные. Вот и хочу понять где.

Посмотрев лог примера выше, скажу так, если тсб на окне несколько, то на каждом срабатывает прорисовка от обычного режима +2, т.е. добавляются прорисовки GotFocus, LostFocus. Вот пример лога вход тсб + 2 раза pgdn и переключение на Far и обратно и выход
Скрытый текст

 
 xRow =   1  nRowCount = 18 nCell =  2  nTek =   1  RecNo =  1  1   
 (b)MAIN  4291  :TSDRAWCELL 4758  :DRAWSELECT 10903 :PAINT   3421  :DISPLAY 654   .F.   Col = 1  SELECTOR 0.00   
 (b)MAIN  4291  :TSDRAWCELL 4758  :DRAWSELECT 10903 :PAINT   3421  :DISPLAY 654   .F.   Col = 2  ID 0.01   
 (b)MAIN  4291  :TSDRAWCELL 4758  :DRAWSELECT 10903 :PAINT   3421  :DISPLAY 654   .F.   Col = 3  FIRST 0.01   
 (b)MAIN  4291  :TSDRAWCELL 4758  :DRAWSELECT 10903 :PAINT   3421  :DISPLAY 654   .F.   Col = 4  LAST  0.01   
 (b)MAIN  4291  :TSDRAWCELL 4758  :DRAWSELECT 10903 :PAINT   3421  :DISPLAY 654   .F.   Col = 5  STREET   0.01   
 (b)MAIN  4291  :TSDRAWCELL 4758  :DRAWSELECT 10903 :PAINT   3421  :DISPLAY 654   .F.   Col = 6  CITY  0.01   
 (b)MAIN  4291  :TSDRAWCELL 4758  :DRAWSELECT 10903 :PAINT   3421  :DISPLAY 654   .F.   Col = 7  STATE 0.02   
 (b)MAIN  4291  :TSDRAWCELL 4758  :DRAWSELECT 10903 :PAINT   3421  :DISPLAY 654   .F.   Col = 8  ZIP   0.02   
 (b)MAIN  4291  :TSDRAWCELL 4758  :DRAWSELECT 10903 :PAINT   3421  :DISPLAY 654   .F.   Col = 9  HIREDATE 0.02   
 xRow =   2  nRowCount = 18 nCell =  2  nTek =   1  RecNo =  1  2   
 (b)MAIN  4291  :TSDRAWCELL 4272  :DRAWLINE   10905 :PAINT   3421  :DISPLAY 654   .T.   Col = 1  SELECTOR 0.00   
 ... 
 xRow =   1  nRowCount = 18 nCell =  2  nTek =   1  RecNo =  1  1   
 (b)MAIN  4291  :TSDRAWCELL 4758  :DRAWSELECT 10800 :PAINT   3421  :DISPLAY 13994 .F.   Col = 1  SELECTOR 0.00   
 (b)MAIN  4291  :TSDRAWCELL 4758  :DRAWSELECT 10800 :PAINT   3421  :DISPLAY 13994 .F.   Col = 2  ID 0.00   
 (b)MAIN  4291  :TSDRAWCELL 4758  :DRAWSELECT 10800 :PAINT   3421  :DISPLAY 13994 .F.   Col = 3  FIRST 0.01   
 (b)MAIN  4291  :TSDRAWCELL 4758  :DRAWSELECT 10800 :PAINT   3421  :DISPLAY 13994 .F.   Col = 4  LAST  0.01   
 (b)MAIN  4291  :TSDRAWCELL 4758  :DRAWSELECT 10800 :PAINT   3421  :DISPLAY 13994 .F.   Col = 5  STREET   0.01   
 (b)MAIN  4291  :TSDRAWCELL 4758  :DRAWSELECT 10800 :PAINT   3421  :DISPLAY 13994 .F.   Col = 6  CITY  0.01   
 (b)MAIN  4291  :TSDRAWCELL 4758  :DRAWSELECT 10800 :PAINT   3421  :DISPLAY 13994 .F.   Col = 7  STATE 0.01   
 (b)MAIN  4291  :TSDRAWCELL 4758  :DRAWSELECT 10800 :PAINT   3421  :DISPLAY 13994 .F.   Col = 8  ZIP   0.01   
 (b)MAIN  4291  :TSDRAWCELL 4758  :DRAWSELECT 10800 :PAINT   3421  :DISPLAY 13994 .F.   Col = 9  HIREDATE 0.02   
 xRow =   1  nRowCount = 18 nCell =  2  nTek =   1  RecNo =  1  1   
 (b)MAIN  4291  :TSDRAWCELL 4758  :DRAWSELECT 8034  :GOTFOCUS   915   TCONTROL:HANDLEEVENT 9446  .F.   Col = 1  SELECTOR 0.00   
 (b)MAIN  4291  :TSDRAWCELL 4758  :DRAWSELECT 8034  :GOTFOCUS   915   TCONTROL:HANDLEEVENT 9446  .F.   Col = 2  ID 0.01   
 (b)MAIN  4291  :TSDRAWCELL 4758  :DRAWSELECT 8034  :GOTFOCUS   915   TCONTROL:HANDLEEVENT 9446  .F.   Col = 3  FIRST 0.01   
 (b)MAIN  4291  :TSDRAWCELL 4758  :DRAWSELECT 8034  :GOTFOCUS   915   TCONTROL:HANDLEEVENT 9446  .F.   Col = 4  LAST  0.01   
 (b)MAIN  4291  :TSDRAWCELL 4758  :DRAWSELECT 8034  :GOTFOCUS   915   TCONTROL:HANDLEEVENT 9446  .F.   Col = 5  STREET   0.01   
 (b)MAIN  4291  :TSDRAWCELL 4758  :DRAWSELECT 8034  :GOTFOCUS   915   TCONTROL:HANDLEEVENT 9446  .F.   Col = 6  CITY  0.01   
 (b)MAIN  4291  :TSDRAWCELL 4758  :DRAWSELECT 8034  :GOTFOCUS   915   TCONTROL:HANDLEEVENT 9446  .F.   Col = 7  STATE 0.02   
 (b)MAIN  4291  :TSDRAWCELL 4758  :DRAWSELECT 8034  :GOTFOCUS   915   TCONTROL:HANDLEEVENT 9446  .F.   Col = 8  ZIP   0.02   
 (b)MAIN  4291  :TSDRAWCELL 4758  :DRAWSELECT 8034  :GOTFOCUS   915   TCONTROL:HANDLEEVENT 9446  .F.   Col = 9  HIREDATE 0.02   
 xRow =   1  nRowCount = 18 nCell =  2  nTek =   1  RecNo =  1  1   
 (b)MAIN  4291  :TSDRAWCELL 4758  :DRAWSELECT 10903 :PAINT   870   TCONTROL:HANDLEEVENT 9446  .F.   Col = 1  SELECTOR 0.00   
 ... 
 xRow =   18 nRowCount = 18 nCell =  2  nTek =   1  RecNo =  1  18  
 (b)MAIN  4291  :TSDRAWCELL 4272  :DRAWLINE   10905 :PAINT   870   TCONTROL:HANDLEEVENT 9446  .T.   Col = 1  SELECTOR 0.00   
 (b)MAIN  4291  :TSDRAWCELL 4272  :DRAWLINE   10905 :PAINT   870   TCONTROL:HANDLEEVENT 9446  .T.   Col = 2  ID 0.01   
 (b)MAIN  4291  :TSDRAWCELL 4272  :DRAWLINE   10905 :PAINT   870   TCONTROL:HANDLEEVENT 9446  .T.   Col = 3  FIRST 0.01   
 (b)MAIN  4291  :TSDRAWCELL 4272  :DRAWLINE   10905 :PAINT   870   TCONTROL:HANDLEEVENT 9446  .T.   Col = 4  LAST  0.01   
 (b)MAIN  4291  :TSDRAWCELL 4272  :DRAWLINE   10905 :PAINT   870   TCONTROL:HANDLEEVENT 9446  .T.   Col = 5  STREET   0.01   
 (b)MAIN  4291  :TSDRAWCELL 4272  :DRAWLINE   10905 :PAINT   870   TCONTROL:HANDLEEVENT 9446  .T.   Col = 6  CITY  0.01   
 (b)MAIN  4291  :TSDRAWCELL 4272  :DRAWLINE   10905 :PAINT   870   TCONTROL:HANDLEEVENT 9446  .T.   Col = 7  STATE 0.01   
 (b)MAIN  4291  :TSDRAWCELL 4272  :DRAWLINE   10905 :PAINT   870   TCONTROL:HANDLEEVENT 9446  .T.   Col = 8  ZIP   0.02   
 (b)MAIN  4291  :TSDRAWCELL 4272  :DRAWLINE   10905 :PAINT   870   TCONTROL:HANDLEEVENT 9446  .T.   Col = 9  HIREDATE 0.02   
 xRow =   1  nRowCount = 18 nCell =  2  nTek =   1  RecNo =  19 19  
 (b)MAIN  4291  :TSDRAWCELL 4758  :DRAWSELECT 10621 :PAGEDOWN   8536  :KEYDOWN 9406  .F.   Col = 1  SELECTOR 0.02   
 (b)MAIN  4291  :TSDRAWCELL 4758  :DRAWSELECT 10621 :PAGEDOWN   8536  :KEYDOWN 9406  .F.   Col = 2  ID 0.03   
 (b)MAIN  4291  :TSDRAWCELL 4758  :DRAWSELECT 10621 :PAGEDOWN   8536  :KEYDOWN 9406  .F.   Col = 3  FIRST 0.03   
 (b)MAIN  4291  :TSDRAWCELL 4758  :DRAWSELECT 10621 :PAGEDOWN   8536  :KEYDOWN 9406  .F.   Col = 4  LAST  0.04   
 (b)MAIN  4291  :TSDRAWCELL 4758  :DRAWSELECT 10621 :PAGEDOWN   8536  :KEYDOWN 9406  .F.   Col = 5  STREET   0.04   
 (b)MAIN  4291  :TSDRAWCELL 4758  :DRAWSELECT 10621 :PAGEDOWN   8536  :KEYDOWN 9406  .F.   Col = 6  CITY  0.04   
 (b)MAIN  4291  :TSDRAWCELL 4758  :DRAWSELECT 10621 :PAGEDOWN   8536  :KEYDOWN 9406  .F.   Col = 7  STATE 0.05   
 (b)MAIN  4291  :TSDRAWCELL 4758  :DRAWSELECT 10621 :PAGEDOWN   8536  :KEYDOWN 9406  .F.   Col = 8  ZIP   0.05   
 (b)MAIN  4291  :TSDRAWCELL 4758  :DRAWSELECT 10621 :PAGEDOWN   8536  :KEYDOWN 9406  .F.   Col = 9  HIREDATE 0.05   
 xRow =   1  nRowCount = 18 nCell =  2  nTek =   1  RecNo =  19 19  
 ... 
 xRow =   1  nRowCount = 18 nCell =  2  nTek =   1  RecNo =  1  1   
 (b)MAIN  4291  :TSDRAWCELL 4758  :DRAWSELECT 8034  :GOTFOCUS   915   TCONTROL:HANDLEEVENT 9446  .F.   Col = 1  SELECTOR 0.00   
 (b)MAIN  4291  :TSDRAWCELL 4758  :DRAWSELECT 8034  :GOTFOCUS   915   TCONTROL:HANDLEEVENT 9446  .F.   Col = 2  ID 0.01   
 (b)MAIN  4291  :TSDRAWCELL 4758  :DRAWSELECT 8034  :GOTFOCUS   915   TCONTROL:HANDLEEVENT 9446  .F.   Col = 3  FIRST 0.01   
 (b)MAIN  4291  :TSDRAWCELL 4758  :DRAWSELECT 8034  :GOTFOCUS   915   TCONTROL:HANDLEEVENT 9446  .F.   Col = 4  LAST  0.01   
 (b)MAIN  4291  :TSDRAWCELL 4758  :DRAWSELECT 8034  :GOTFOCUS   915   TCONTROL:HANDLEEVENT 9446  .F.   Col = 5  STREET   0.01   
 (b)MAIN  4291  :TSDRAWCELL 4758  :DRAWSELECT 8034  :GOTFOCUS   915   TCONTROL:HANDLEEVENT 9446  .F.   Col = 6  CITY  0.01   
 (b)MAIN  4291  :TSDRAWCELL 4758  :DRAWSELECT 8034  :GOTFOCUS   915   TCONTROL:HANDLEEVENT 9446  .F.   Col = 7  STATE 0.02   
 (b)MAIN  4291  :TSDRAWCELL 4758  :DRAWSELECT 8034  :GOTFOCUS   915   TCONTROL:HANDLEEVENT 9446  .F.   Col = 8  ZIP   0.02   
 (b)MAIN  4291  :TSDRAWCELL 4758  :DRAWSELECT 8034  :GOTFOCUS   915   TCONTROL:HANDLEEVENT 9446  .F.   Col = 9  HIREDATE 0.02   
 ... 
 xRow =   1  nRowCount = 18 nCell =  2  nTek =   1  RecNo =  19 19  
 (b)MAIN  4291  :TSDRAWCELL 4758  :DRAWSELECT 10228 :LOSTFOCUS  896   TCONTROL:HANDLEEVENT 9446  .F.   Col = 1  SELECTOR 0.02   
 (b)MAIN  4291  :TSDRAWCELL 4758  :DRAWSELECT 10228 :LOSTFOCUS  896   TCONTROL:HANDLEEVENT 9446  .F.   Col = 2  ID 0.03   
 (b)MAIN  4291  :TSDRAWCELL 4758  :DRAWSELECT 10228 :LOSTFOCUS  896   TCONTROL:HANDLEEVENT 9446  .F.   Col = 3  FIRST 0.03   
 (b)MAIN  4291  :TSDRAWCELL 4758  :DRAWSELECT 10228 :LOSTFOCUS  896   TCONTROL:HANDLEEVENT 9446  .F.   Col = 4  LAST  0.03   
 (b)MAIN  4291  :TSDRAWCELL 4758  :DRAWSELECT 10228 :LOSTFOCUS  896   TCONTROL:HANDLEEVENT 9446  .F.   Col = 5  STREET   0.04   
 (b)MAIN  4291  :TSDRAWCELL 4758  :DRAWSELECT 10228 :LOSTFOCUS  896   TCONTROL:HANDLEEVENT 9446  .F.   Col = 6  CITY  0.04   
 (b)MAIN  4291  :TSDRAWCELL 4758  :DRAWSELECT 10228 :LOSTFOCUS  896   TCONTROL:HANDLEEVENT 9446  .F.   Col = 7  STATE 0.04   
 (b)MAIN  4291  :TSDRAWCELL 4758  :DRAWSELECT 10228 :LOSTFOCUS  896   TCONTROL:HANDLEEVENT 9446  .F.   Col = 8  ZIP   0.04   
 (b)MAIN  4291  :TSDRAWCELL 4758  :DRAWSELECT 10228 :LOSTFOCUS  896   TCONTROL:HANDLEEVENT 9446  .F.   Col = 9  HIREDATE 0.05   
 xRow =   1  nRowCount = 18 nCell =  2  nTek =   1  RecNo =  19 19  
 (b)MAIN  4291  :TSDRAWCELL 4758  :DRAWSELECT 8034  :GOTFOCUS   915   TCONTROL:HANDLEEVENT 9446  .F.   Col = 1  SELECTOR 0.01   
 (b)MAIN  4291  :TSDRAWCELL 4758  :DRAWSELECT 8034  :GOTFOCUS   915   TCONTROL:HANDLEEVENT 9446  .F.   Col = 2  ID 0.01   
 (b)MAIN  4291  :TSDRAWCELL 4758  :DRAWSELECT 8034  :GOTFOCUS   915   TCONTROL:HANDLEEVENT 9446  .F.   Col = 3  FIRST 0.02   
 (b)MAIN  4291  :TSDRAWCELL 4758  :DRAWSELECT 8034  :GOTFOCUS   915   TCONTROL:HANDLEEVENT 9446  .F.   Col = 4  LAST  0.02   
 (b)MAIN  4291  :TSDRAWCELL 4758  :DRAWSELECT 8034  :GOTFOCUS   915   TCONTROL:HANDLEEVENT 9446  .F.   Col = 5  STREET   0.02   
 (b)MAIN  4291  :TSDRAWCELL 4758  :DRAWSELECT 8034  :GOTFOCUS   915   TCONTROL:HANDLEEVENT 9446  .F.   Col = 6  CITY  0.02   
 (b)MAIN  4291  :TSDRAWCELL 4758  :DRAWSELECT 8034  :GOTFOCUS   915   TCONTROL:HANDLEEVENT 9446  .F.   Col = 7  STATE 0.03   
 (b)MAIN  4291  :TSDRAWCELL 4758  :DRAWSELECT 8034  :GOTFOCUS   915   TCONTROL:HANDLEEVENT 9446  .F.   Col = 8  ZIP   0.03   
 (b)MAIN  4291  :TSDRAWCELL 4758  :DRAWSELECT 8034  :GOTFOCUS   915   TCONTROL:HANDLEEVENT 9446  .F.   Col = 9  HIREDATE 0.03

добавил еще время прорисовки с учетом вывода в лог, т.е.

 
          :Cargo:nSeconds := Seconds() 
          :bOnDrawLine := {|ob,xrow| 
                            Local nRow := ob:nRowPos 
                            Local nPos := ob:nCell 
                            Local nLen := Len(ob:aRowPosAtRec) 
                            ob:Cargo:nSeconds := Seconds() 
 ... 
          :bTSDrawCell := {|ob,oc,ok| 
                            If oc:nDrawType == 0 
  ? myproc(1),procline(1),myproc(2),procline(2),myproc(3),procline(3),myproc(4),procline(4),myproc(5),procline(5) 
                               ?? oc:lDrawLine,"Col =",oc:nCell, ok:cName, Seconds() - ob:Cargo:nSeconds 
                            EndIf 
                            Return Nil 
                          } 
 ...

kkg

Пост N: 25 Зарегистрирован: 29.11.19

Отправлено: 03.10.20 22:31. Заголовок: SergKis Вы предлага..

SergKis

цитата:

Вы предлагайте конкретно по тексту, берем тут, правим так или так.

"поигрался" на реальных данных из "тяжёлых" отчётов,
на удивление мерцание текста вызывает не DrawLine, а DrawSelect
путём "кастрации" в метод DrawCell и его использования в GoRight GoLeft
мерцание текста потушил, но у меня не совсем стандартное использование,
попробуйте у себя
Скрытый текст

 
 * ============================================================================ 
 * METHOD TSBrowse:GoRight() Version 9.0 Nov/30/2009 
 * ============================================================================ 
  
 ... 
       lRefresh := ( ::lCanAppend /*.or. ::lIsArr*/ )  // Игорь прав уже год делаю такую правку 
  
       While ! ::IsColVisible( ::nCell ) .and. ::nColPos < ::nCell 
          ::nColPos ++ 
          lRefresh := .T. 
       EndDo 
  
       ::HiliteCell( ::nCell ) 
  
       If ::aColumns[ ::nCell ]:bGotFocus != Nil .and. ::nOldCell != ::nCell 
          Eval( ::aColumns[ ::nCell ]:bGotFocus, ::nOldCell, ::nCell, Self ) 
       EndIf 
  
       If ::aColumns[ ::nOldCell ]:bLostFocus != Nil .and. ::nOldCell != ::nCell 
          Eval( ::aColumns[ ::nOldCell ]:bLostFocus, ::nCell, ::nOldCell, Self ) 
       EndIf 
  
       If lRefresh 
          ::lNoPaint := .F. 
          ::Refresh( .F. ) 
       ElseIf ! ::lEditing 
           ::DrawCell( ::nAt, ::nOldCell) 
           ::DrawCell( ::nAt, ::nCell) 
 //        ::DrawSelect() 
  
       EndIf 
 ... 
  
  
 * ============================================================================ 
 * METHOD TSBrowse:GoLeft() Version 9.0 Nov/30/2009 
 * ============================================================================ 
 ... 
       If ::aColumns[ ::nOldCell ]:bLostFocus != Nil .and. ::nOldCell != ::nCell 
          Eval( ::aColumns[ ::nOldCell ]:bLostFocus, ::nCell, ::nOldCell, Self ) 
       EndIf 
  
       iif( ::oHScroll != Nil, ::oHScroll:SetPos( ::nCell ), Nil ) 
       ::HiliteCell( ::nCell ) // 
       If ::nOldCell > ::nColPos .or. ::nCell <= ::nFreeze  
          ::DrawCell( ::nAt, ::nOldCell) 
          ::DrawCell( ::nAt, ::nCell) 
        Else 
          ::DrawSelect() 
       endif 
       ::nOldCell := ::nCell // 
       If ::aColumns[ ::nCell ]:lVisible == .F. 
          If ::nCell == 1 
             ::GoRight() 
          Else 
             ::GoLeft() 
          Endif 
       endif 
 ... 
  
  
 * ============================================================================ 
 * METHOD TSBrowse:DrawCell()  возможно правильнее DrawCellSelect() 
 * ============================================================================ 
  
 METHOD DrawCell( nRow,nCol ) CLASS TSBrowse 
  
 Local oColumn, nStartCol, hBitMap, hFont, nAlign, cPicture, nClrFore, nClrBack, ;  //, nBegin  , nLastCol 
 lNoLite, uData, l3DLook, lMulti, nClrTo, lOpaque, lBrush, nCursor, lCheck, uBmpCell, cMsg, lAdjBmp, ; 
    lSelected,  lDrawCell, ; 
    nVertText := 0, ; 
    nMaxWidth := ::nWidth(), ;                       // use local copies for speed 
    nRowPos   := ::nRowPos, ; 
    aColSizes := AClone( ::aColSizes ), ; 
    hWnd      := ::hWnd, ; 
    hDC       := ::hDc, ; 
    lFocused  := ::lFocused := ( GetFocus() == ::hWnd ), ; 
    nVAlign   := 1 
  
 Local l3DText, nClr3dL, nClr3dS 
 Local aBitMaps, lCheckVal := .F., cColAls 
 Local lDraw := .F., xData                           //nDeltaLen, 
  
 Local nClrText     := ::nClrText, ; 
    nClrPane     := ::nClrPane, ; 
    nClrFocuFore := ::nClrFocuFore, ; 
    nClrFocuBack := ::nClrFocuBack, ; 
    nClrLine     := ::nClrLine, ; 
    nLineStyle /*:= ::nLineStyle*/, ; 
    nClrSeleBack := ::nClrSeleBack, ; 
    nClrSeleFore := ::nClrSeleFore, ; 
    nHeightCell  := ::nHeightCell //, ; 
 //   nHeightHead  := iif( ::lDrawHeaders, ::nHeightHead, 0 ), ; 
 //   nHeightFoot  := iif( ::lDrawFooters != nil .and. ::lDrawFooters, ::nHeightFoot, 0 ), ; 
 //   nHeightSuper := iif( ::lDrawHeaders, ::nHeightSuper, 0 ),; 
 //   nHeightSpecHd:= iif( ::lDrawSpecHd, ::nHeightSpecHd, 0 ) 
  
 Default nRow := nRowPos, lDrawCell := .T. 
  
 ::nPaintRow := nRow 
 ::aDrawCols := {} 
  
 If Empty( ::aColumns ) 
    Return Self 
 EndIf 
  
 If nCol < 1 .or. nCol > len(::aColumns) 
    Return Self 
 EndIf 
  
  
 If _HMG_MainClientMDIHandle != 0 .and. ! lFocused .and. ::hWndParent == GetActiveMdiHandle() 
    lFocused := .T. 
 EndIf 
  
 ::lDrawSelect := .T. 
 lSelected := ::lCanSelect .and. ( AScan( ::aSelected, iif( ::lIsDbf, ( ::cAlias )->( RecNo() ), ::nAt ) ) > 0 ) 
  
 nClrBack := iif( ::nPhantom = -1 .and. ! Empty( ::aColumns ), ATail( ::aColumns ):nClrBack, nClrPane ) 
 nClrBack := iif( ValType( nClrBack ) == "B", Eval( nClrBack, ::nAt, Len( ::aColumns ), Self ), nClrBack ) 
 l3DLook  := iif( ::nPhantom = -1 .and. ! Empty( ::aColumns ), ATail( ::aColumns ):l3DLook, .F. ) 
  
  
 IF ::lRowPosAtRec 
    IF Empty( ::aRowPosAtRec ) .or. Len( ::aRowPosAtRec ) != ::nRowCount() 
       ::aRowPosAtRec := Array( ::nRowCount() ) 
       AFill( ::aRowPosAtRec, 0 ) 
    ENDIF 
    IF nRow == 0 .or. nRow > Len( ::aRowPosAtRec ) 
    ELSEIF ::lIsDbf 
       ::aRowPosAtRec[ nRow ] := ( ::cAlias )->( RecNo() ) 
    ELSEIF ::lIsArr 
       ::aRowPosAtRec[ nRow ] := ::nAt 
    ENDIF 
 ENDIF 
  
 oColumn :=  ::aColumns[ nCol ] 
  
 If ! ValType( oColumn ) == "O" .or. ! ValType(oColumn:oCell ) == "O" 
    Return Self 
 EndIf 
  
 nLineStyle := ::nLineStyle 
 nStartCol := oColumn:oCell:nStartCol 
  
 If nStartCol == nil 
    Return Self 
 EndIf 
  
 If HB_ISNUMERIC( oColumn:nLineStyle ) 
    nLineStyle := oColumn:nLineStyle 
 EndIf 
  
 hFont    := ::hFontGet( oColumn, nCol ) 
 lAdjBmp  := oColumn:lAdjBmp 
 nAlign   := oColumn:nAlign 
 lOpaque  := .T. 
 lMulti   := .F. 
 cColAls  := iif( '->' $ oColumn:cField, nil, oColumn:cAlias ) 
  
 If nCol == 1 .and. ! Empty( ::hBmpCursor ) 
  
    uBmpCell := ::hBmpCursor 
    uData    := "" 
    xData    := "" 
    nAlign   := nMakeLong( oColumn:nAlign, oColumn:nAlign ) 
    lNoLite  := .T. 
    lAdjBmp  := .F. 
    lCheck   := .F. 
  
 Else 
  
    If ::lIsArr .and. ( ::lAppendMode .or. ::nAt > Len( ::aArray ) ) 
       uData := "" 
    ElseIf cColAls != nil 
       If Valtype( oColumn:bSeek ) == 'B' 
          ( cColAls )->( Eval( oColumn:bSeek, Self, nCol ) ) 
       EndIf 
       uData := ::bDataEval( oColumn, , nCol ) 
    Else 
       If Valtype( oColumn:bSeek ) == 'B' 
          Eval( oColumn:bSeek, Self, nCol ) 
       EndIf 
       uData := ::bDataEval( oColumn, , nCol ) 
    EndIf 
  
  
    xData     := uData 
    lMulti    := Valtype( uData ) == "C" .and. At( Chr( 13 ), uData ) > 0 
    cPicture  := ::cPictureGet( oColumn, nCol ) 
    lCheck    := ( oColumn:lCheckBox .and. ValType( uData ) == "L" .and. oColumn:lVisible ) 
    lNoLite   := oColumn:lNoLite 
    nVertText := 0 
  
    If lCheck 
       cPicture := "" 
       nVertText := iif( uData, 3, 4 ) 
       lCheckVal := uData 
    EndIf 
  
    uBmpCell := oColumn:uBmpCell 
  
    If nCol == ::nColSel .and. ::uBmpSel != nil .and. lSelected 
       uBmpCell := ::uBmpSel 
       nAlign   := nMakeLong( LoWord( nAlign ), ::nAligBmp ) 
    ElseIf oColumn:lBitMap .and. Valtype( uData ) == "N" 
       aBitMaps := iif( Valtype( oColumn:aBitMaps ) == "A", oColumn:aBitMaps, ::aBitMaps ) 
       If ! Empty( aBitMaps ) .and. uData > 0 .and. uData <= Len( aBitMaps ) 
          uBmpCell := aBitMaps[ uData ] 
       EndIf 
       nAlign := nMakeLong( LoWord( nAlign ), nAlign ) 
       uData  := "" 
    ElseIf ! lCheck .and. oColumn:lEmptyValToChar .and. Empty( uData ) 
       uData := "" 
    ElseIf Empty( cPicture ) .or. lMulti 
       uData := iif( Valtype( uData ) != "C", cValToChar( uData ), uData ) 
    Else 
       uData := iif( uData == nil, "", Transform( uData, cPicture ) ) 
    EndIf 
 EndIf 
  
 nAlign := ::nAlignGet( oColumn:nAlign, nCol, DT_LEFT ) 
  
 If lNoLite 
    If ::lLiteBar 
       nClrFore := ::GetValProp( oColumn:nClrFocuFore, nClrText, nCol, ::nAt ) 
       nClrBack := ::GetValProp( oColumn:nClrFocuBack, nClrPane, nCol, ::nAt ) 
       If ! Empty(oColumn:cName) .and. oColumn:cName == "oPhant" 
          nClrBack := nClrPane 
       ElseIf ValType( nClrBack ) == "N" .and. nClrBack < 0 
          nClrBack *= -1 
       EndIf 
    Else 
       nClrFore := ::GetValProp( oColumn:nClrFore, nClrText, nCol, ::nAt ) 
       nClrBack := ::GetValProp( oColumn:nClrBack, nClrPane, nCol, ::nAt ) 
    EndIf 
  
    nCursor := 0 
 Else 
    If ( nClrFore := iif( lFocused, oColumn:nClrFocuFore, oColumn:nClrSeleFore ) ) == Nil 
       nClrFore := iif( lFocused, nClrFocuFore, nClrSeleFore ) 
    EndIf 
  
    nClrFore := ::GetValProp( nClrFore, nClrFore, nCol, ::nAt ) 
  
    If ( nClrBack := iif( lFocused, oColumn:nClrFocuBack, oColumn:nClrSeleBack ) ) == Nil 
       nClrBack := iif( lFocused, nClrFocuBack, nClrSeleBack ) 
    EndIf 
  
    nClrBack := ::GetValProp( nClrBack, nClrBack, nCol, ::nAt ) 
  
    If ValType( nClrBack ) == "N" .and. nClrBack < 0 
       nCursor := Abs( nClrBack ) 
       nClrBack := ::GetValProp( oColumn:nClrBack, nClrPane, nCol, ::nAt ) 
    Else 
       nCursor := 0 
    EndIf 
 EndIf 
  
 If ValType( nClrBack ) == "A" 
    nClrBack := ::nClrBackArr( nClrBack, nCol, ::nAt ) 
    nClrTo   := nClrBack[2] 
    nClrBack := nClrBack[1] 
 Else 
    nClrTo   := nClrBack 
 EndIf 
  
 lBrush  := Valtype( nClrBack ) == "O" 
 l3DLook := oColumn:l3DLook 
  
 hBitMap := iif( ValType( uBmpCell ) == "B" .and. ! ::lPhantArrRow, Eval( uBmpCell, nCol, Self ), uBmpCell ) 
 hBitMap := iif( ValType( hBitMap ) == "O" .and. ! ::lPhantArrRow, Eval( ::bBitMapH, hBitMap ), hBitMap ) 
  
 Default hBitMap := 0 
  
 If lCheck 
    Default ::aCheck := { StockBmp( 6 ), StockBmp( 7 ) } 
    If Valtype(oColumn:aCheck) == "A" 
       hBitMap := oColumn:aCheck[ iif( lCheckVal, 1, 2 ) ] 
    Else 
       hBitMap := ::aCheck[ iif( lCheckVal, 1, 2 ) ] 
    EndIf 
    nAlign := nMakeLong( DT_CENTER, DT_CENTER ) 
    uData  := "" 
 EndIf 
  
 If oColumn:l3DTextCell != nil 
    l3DText := oColumn:l3DTextCell 
    nClr3dL := oColumn:nClr3DLCell 
    nClr3dS := oColumn:nClr3DSCell 
    nClr3dL := iif( ValType( nClr3dL ) == "B", Eval( nClr3dL, ::nAt, nCol, Self ), nClr3dL ) 
    nClr3dS := iif( ValType( nClr3dS ) == "B", Eval( nClr3dS, ::nAt, nCol, Self ), nClr3dS ) 
 Else 
    l3DText := nClr3dL := nClr3dS := nil 
 EndIf 
  
 If nAlign != DT_CENTER .and. ::nCellMarginLR != nil 
    uData := ::CellMarginLeftRight( nCol, uData, oColumn, nAlign, lMulti, 0 ) 
 EndIf 
  
 oColumn:oCell:nRow	 := nRowPos 
 oColumn:oCell:nCol	 := nStartCol 
 //		oColumn:oCell:nWidth	 := aColSizes[ nCol ] + nDeltaLen 
 oColumn:oCell:nHeight	 := ::nHeightCell 
 oColumn:oCell:nCell	 := nCol 
 oColumn:oCell:uValue	 := xData 
 oColumn:oCell:lDrawLine	 := .F.					// DrawSelect() 
  
 oColumn:oCell:hWnd	 := hWnd				// 1 
 oColumn:oCell:hDC	 := hDC					// 2 
 oColumn:oCell:xRow	 := nRowPos				// 3 
 oColumn:oCell:nStartCol	 := nStartCol				// 4 
 //		oColumn:oCell:nSize	 := aColSizes[ nCol ] + nDeltaLen		// 5 aColSizes[ nCol ] + nDeltaLen 
 oColumn:oCell:uData	 := uData				// 6 
 oColumn:oCell:nAlign	 := nAlign				// 7 
 oColumn:oCell:nClrFore	 := nClrFore				// 8 
 oColumn:oCell:nClrBack	 := nClrBack				// 9 
 oColumn:oCell:hFont	 := hFont				// 10 
 oColumn:oCell:hBitMap	 := hBitMap				// 11 
 oColumn:oCell:nHeightCell:= nHeightCell				// 12 
 oColumn:oCell:l3DLook	 := l3DLook				// 13 oColumn:l3DLook 
 oColumn:oCell:nLineStyle := nLineStyle				// 14 
 oColumn:oCell:nClrLine	 := nClrLine				// 15 
 oColumn:oCell:nDrawType	 := 0					// 16 line/header/footer/super 
 //		oColumn:oCell:nHeightHead:= nHeightHead				// 17 
 //		oColumn:oCell:nHeightFoot:= nHeightFoot				// 18 
 //		oColumn:oCell:nHeightSuper  := nHeightSuper			// 19 
 //		oColumn:oCell:nHeightSpecHd := nHeightSpecHd			// 20 
 oColumn:oCell:lAdjBmp	 := lAdjBmp				// 21 
 oColumn:oCell:lMultiline := lMulti				// 22 
 oColumn:oCell:nVAlign	 := nVAlign				// 23 
 oColumn:oCell:nVertText	 := nVertText				// 24 
 oColumn:oCell:nClrTo	 := nClrTo				// 25 
 oColumn:oCell:lOpaque	 := lOpaque				// 26 
 oColumn:oCell:hBrush	 := iif( lBrush, nClrBack:hBrush, 0 )	// 27 
 oColumn:oCell:l3DText	 := l3DText				// 28  3D text 
 oColumn:oCell:nClr3dL	 := nClr3dL				// 29  3D text light color 
 oColumn:oCell:nClr3dS	 := nClr3dS				// 30  3D text shadow color 
 oColumn:oCell:nCursor	 := nCursor				// 31  Rect cursor 
 oColumn:oCell:lInvertColor := !(::lCellBrw .and. nCol != ::nCell)  // 32  Invert color 
  
 If lDrawCell 
    lDraw := ::TSDrawCell( oColumn:oCell, oColumn ) 
 Else 
    lDraw := .T. 
 EndIf 
  
  
 If lDraw 
    AAdd( ::aDrawCols, nCol ) 
 EndIf 
  
  
 If ::bOnDraw != Nil 
    Eval( ::bOnDraw, Self ) 
 EndIf 
  
 If ::lCellBrw 
    cMsg := iif( ! Empty( ::AColumns[ ::nCell ]:cMsg ), ::AColumns[ ::nCell ]:cMsg, ::cMsg ) 
    cMsg := iif( ValType( cMsg ) == "B", Eval( cMsg, Self, ::nCell ), cMsg ) 
  
    If ! Empty( cMsg ) 
       ::SetMsg( cMsg ) 
    EndIf 
 EndIf 
  
 ::lDrawSelect := .F. 
  
 Return Self

SergKis
постоянный участник
Пост N: 3411 Зарегистрирован: 17.02.12

Отправлено: 04.10.20 09:53. Заголовок: kkg пишет попробуйте..

kkg пишет

цитата:

попробуйте у себя

Попробовал, поправил только
::DrawCell( /*::nAt*/, ::nOldCell)
::DrawCell( /*::nAt*/, ::nCell)
т.к. :nAt это номер текущей строки отображения, т.е. для массива номер элемента, для dbf номер записи
Разницы в работе не увидел (мониторы 14",15")
Тут примеры https://TransFiles.ru/po4kc
DemoMdi0.exe - это родной вариант
DemoMdi.exe - это ваш

SergKis
постоянный участник
Пост N: 3412 Зарегистрирован: 17.02.12

Отправлено: 04.10.20 09:59. Заголовок: PS Разве что в приме..

PS
Разве что в примере Tsb_Array_2 немного подрагивания меньше при горизонтальном движении вправо, но поставил ваше
lRefresh := ( ::lCanAppend /*.or. ::lIsArr*/ )
и оно пропало

Haz
администратор
Пост N: 1625 Зарегистрирован: 20.02.11

Отправлено: 04.10.20 11:58. Заголовок: SergKis пишет: lCan..

SergKis пишет:

цитата:

lCanAppend

писал выше, нужно убрать всю строку целиком, не забыв проинициализировать переменную в . f. в начале метода. Просто не врубаюсь как связаны lCanAppend и goRight.
С понедельника по не многу продолжу

SergKis
постоянный участник
Пост N: 3413 Зарегистрирован: 17.02.12

Отправлено: 04.10.20 12:05. Заголовок: Haz пишет нужно убра..

Haz пишет

цитата:

нужно убрать всю строку целиком, не забыв проинициализировать переменную в . f. в начале метода. Просто не врубаюсь как связаны lCanAppend и goRight.

У меня lCanAppend всегда .F., потому без разницы где инициализировать. А вдруг, кто то врубается

, а мы сломаем

Haz
администратор
Пост N: 1626 Зарегистрирован: 20.02.11

Отправлено: 04.10.20 13:04. Заголовок: SergKis пишет: А вд..

SergKis пишет:

цитата:

А вдруг, кто то врубается , а мы сломаем

CanAppend разрешает skip ниже последней строки и делает Append . как это должно влиять на goright не пойму. В goLeft такого нет. Так что не сломаем, а если сломаем то починим.

kkg

Пост N: 26 Зарегистрирован: 29.11.19

Отправлено: 04.10.20 23:51. Заголовок: Haz а если сломаем ..

Haz

цитата:

а если сломаем то починим.

не нужно ломать, я по ходу нащупал проблему,
откатите назад в оригинал и попробуйте
Скрытый текст

 
 * ============================================================================ 
 * METHOD TSBrowse:GoRight() Version 9.0 Nov/30/2009 
 * ============================================================================ 
  
 METHOD GoRight() CLASS TSBrowse 
  
    Local nTxtWid, nWidth, nCell, nSkip, lRefresh 
    Local i,j 
 ... 
  
       lRefresh := ( ::lCanAppend /*.or. ::lIsArr*/ ) 
  
       While ! ::IsColVisible( ::nCell ) .and. ::nColPos < ::nCell 
          ::nColPos ++ 
          lRefresh := .T. 
       EndDo 
  
       ::HiliteCell( ::nCell ) 
  
       If ::aColumns[ ::nCell ]:bGotFocus != Nil .and. ::nOldCell != ::nCell 
          Eval( ::aColumns[ ::nCell ]:bGotFocus, ::nOldCell, ::nCell, Self ) 
       EndIf 
  
       If ::aColumns[ ::nOldCell ]:bLostFocus != Nil .and. ::nOldCell != ::nCell 
          Eval( ::aColumns[ ::nOldCell ]:bLostFocus, ::nCell, ::nOldCell, Self ) 
       EndIf 
  
       If lRefresh 
          ::lNoPaint := .F. 
  
          j :=::nAt 
          i := -1 * ::nRowPos() - 1  
          if i !=0; ::skip(i) 
          endif 
          for i = 1 to ::nRowCount() 
          	::skip(1) 
          next 
          ::GoPos( j, ::nCell ) 
  
 //       ::Refresh( .F. )  
       ElseIf ! ::lEditing 
          ::DrawSelect() 
       EndIf 
 ...

для GoLeft аналогично
нужно проверить :lMoreFields := .T. может он и ненужен будет

PS. наверно нужно прокомментировать.
это место где при выходе за пределы экрана прорисовывается весь экран (что бы проверить достаточно заремить)
меня как и Сержа не волнует скорость, раздражает мерцание текста (двойная прорисовка)
чтоб убрать мерцание в зоне Freeze хотел DrawCell расширить до прорисовки таблицы и заодно рисовать не построчно,
а по колонкам (по идее один раз открывая объект колонки и меняя только изменяемые значения для строк можно было бы ускорится)
по факту все попытки получить массив строк и колонок вызывают DraweLine (что делает бессмысленным саму прорисовку)
как и нет смысла рисовать строку курсора DrawSelect всё равно вызовется 2 раза до и после по GotLostFocus.
если подскажете как в этом месте получить массив строк,колонок без прорисовки, попробую допилить DrawCell

kkg

Пост N: 27 Зарегистрирован: 29.11.19

Отправлено: 05.10.20 11:48. Заголовок: Haz писал выше, нуж..

Haz

цитата:

не нужно, при движении вправо по последней строке и достижения конца, должна произойти вставка строки и для её отображения нужен refresh
для движения влево не нужно

SergKis
постоянный участник
Пост N: 3414 Зарегистрирован: 17.02.12

Отправлено: 05.10.20 16:40. Заголовок: kkg пишет по факту в..

kkg пишет

цитата:

по факту все попытки получить массив строк и колонок вызывают DraweLine (что делает бессмысленным саму прорисовку) как и нет смысла рисовать строку курсора DrawSelect всё равно вызовется 2 раза до и после по GotLostFocus.

Не все так грустно.

Можно делать таким образом для начала, схема очень упрощенная
- имеем hash с ключом <Recno\Element>+<имя колонки>+<тип вывода (line\select)> в значении {oCol, oCell}
- в блоке кода :bOnDrawLine если ключ есть, то выводим :TSDrawCell( oCell, oCol ) из массива и возвращаем .T.
- в блоке кода :bTSDrawCell если ключ есть, то вывод уже был, возвращаем .F. иначе на ключ запоминаем массив {oCol, oCell} и возврат .T.
- для ключа <Recno\Element> значение берем из

 
                            If xrow > 0 .and. xrow <= Len(ob:aRowPosAtRec) 
                               ?? ob:aRowPosAtRec[ xrow ] 
                            EndIf

- не очень ясно в какой момент очищать hash от ключей уже не используемых, т.е. за пределами данных массива ob:aRowPosAtRec

По тексту

 
 METHOD DrawLine( xRow, lDrawCell ) CLASS TSBrowse 
 ... 
  
                 If ::bOnDrawLine != Nil         // свой блок кода для рисования 
                    IF ! Empty( Eval( ::bOnDrawLine, Self, xRow ) ) ; RETURN Self 
                    ENDIF 
                 EndIf 
 ... 
 METHOD DrawSelect( xRow, lDrawCell ) CLASS TSBrowse 
 ... 
                 If ::bOnDrawLine != Nil         // свой блок кода для рисования 
                    IF ! Empty( Eval( ::bOnDrawLine, Self, xRow ) ) ; RETURN Self 
                    ENDIF 
                 EndIf 
  
                 If ! ::lDrawLine 
 ... 
 В программе ставим 
          :lRowPosAtRec := .T. 
          :bTSDrawCell := {|ob,ocel,ocol| 
                            If oc:nDrawType == 0 
                               IF oc:lDrawLine        // DrawLine 
 // рисуем, если ключ есть 
                               ELSE                   // DrawSelect 
 //  рисуем, если ключ есть 
                               ENDIF 
                            EndIf 
                            Return Nil 
                          } 
          :bOnDrawLine := {|ob,xrow| 
 // свой вывод или стандартный 
                            Return Nil 
                          }

Haz
администратор
Пост N: 1627 Зарегистрирован: 20.02.11

Отправлено: 05.10.20 17:22. Заголовок: kkg пишет: при движ..

kkg пишет:

цитата:

при движении вправо по последней строке и достижения конца, должна произойти вставка строки

в исходниках не нашел такой фичи

, ткните пальцем

Haz
администратор
Пост N: 1628 Зарегистрирован: 20.02.11

Отправлено: 05.10.20 17:25. Заголовок: kkg пишет: меня как..

kkg пишет:

цитата:

меня как и Сержа не волнует скорость, раздражает мерцание текста (двойная прорисовка)

со скоростью соглашусь , на локальном примере без сети и простым дбф - не удалость получить эффект тормоза. Видимо Сергей прав - все дело в скорости выборки данных

SergKis
постоянный участник
Пост N: 3415 Зарегистрирован: 17.02.12

Отправлено: 05.10.20 18:16. Заголовок: Haz пишет все дело в..

Haz пишет

цитата:

все дело в скорости выборки данных

Весь текст h_tbrowse.prg пропитан такими строками

 
 	nSkip := nNewRow - nOldRow 
  
 	If ( ::nRowPos + nSkip ) <= nTotRow .and. ( ::nRowPos + nSkip ) >= 1 
  
 		::Skip( nSkip ) 
 		::nRowPos += nSkip 
  
 	ElseIf ! ::lIsDbf 
 		::nAt := nNewRow 
 	ElseIf Empty( ::nLogicPos() ) 
  
 		While ::nAt != nNewRow 
  
 			If ::nAt < nNewRow 
 				::Skip( 1 ) 
 			Else 
 				::Skip( -1 ) 
 			EndIf 
  
 		EndDo 
  
 	ElseIf ! Empty( ::nLogicPos() ) 
  
 		( cAlias )->( DbSkip( nSkip ) ) 
 		::nAt := ::nLogicPos() 
  
 	Else 
 		( cAlias )->( Eval( ::bGoToPos, nNewRow ) ) 
 		::nAt := ::nLogicPos() 
 	EndIf 
  
 	If nNewRow != nOldRow .and. ::nLen > nTotRow .and. nNewRow > nTotRow 
  
 		If ::lIsDbf 
  
 			nRecNo := ( cAlias )->( RecNo() ) 
  
 			( cAlias )->( DbSkip( nTotRow - ::nRowPos ) ) 
  
 			If ( cAlias )->( EoF() ) 
  
 				Eval( ::bGoBottom ) 
 				::nRowPos := nTotRow 
  
 				While ::nRowPos > 1 .and. ( cAlias )->( RecNo() ) != nRecNo 
 					::Skip( -1 ) 
 					::nRowPos -- 
 				EndDo 
  
 			Else 
 				( cAlias )->( DbGoTo( nRecNo ) ) 
 			EndIf

т.е. постоянно переходим к первой потом от нее к текущей и еще это может происходить не 1 раз, откуда скорость возьмется ?
Запоминать только первую строку (позицию) и переходить от нее к тек. не очень проходит, в промежутке может появиться новая строка и все развалится. Можно пробовать танцевать от массива :aRowPosAtRec по содержимому элементов, т.е. сразу переход на первый и потом до тек. xRow и до конца отображать, в принциме аналогичным массивом\hash можно организовать одинарную прорисовку строк, но как то хлопотно по мне

kkg

Пост N: 28 Зарегистрирован: 29.11.19

Отправлено: 05.10.20 19:10. Заголовок: Haz в исходниках не..

Haz

цитата:

в исходниках не нашел такой фичи , ткните пальцем

в исходниках этого не найти, это жизнь.
когда пользователь вводит данные и нажимает Enter уходит вправо,
на последней строке и последней колонке рождается новая строка (в ней весь заложенный смысл)
хотя согласен, для арабов должно работать и при движении влево, видать не юзают Harbour
PS был не прав, то что для нас вправо вниз, а влево ввех, для арабов наоборот, лучше этот вариант вообще не рассматривать, а то запутаемся

kkg

Пост N: 29 Зарегистрирован: 29.11.19

Отправлено: 05.10.20 19:22. Заголовок: SergKis Можно делат..

SergKis

цитата:

Можно делать таким образом для начала, схема очень упрощенная

в обед нарыл попроще

 
 m := ::lFirstPaint 
 ::lFirstPaint := nil 
 n := ::lDrawLine 
 ::lDrawLine := .F. 
          j :=::nAt 
          i := -1 * ::nRowPos() - 1  
          if i !=0; ::skip(i) 
          endif 
          for i = 1 to ::nRowCount() 
          	::skip(1) 
          next 
          ::GoPos( j, ::nCell ) 
 ::lDrawLine := n 
 ::lFirstPaint := m

, но к сожалению на несколько дней загрузили работой.
если есть интерес могу скинуть промежеточный код DrawCell в DrawRect но он очень "сырой"

SergKis
постоянный участник
Пост N: 3416 Зарегистрирован: 17.02.12

Отправлено: 05.10.20 19:42. Заголовок: kkg пишет если есть ..

kkg пишет

цитата:

если есть интерес могу скинуть

Нет, не надо, в целом, меня устраивает и то как сейчас работает.
Все решается выборкой на local pc или процедурой на сервере (массив recno) и тсб на этот файл с выборкой
Скорости хватает, не спорткар, но и не трактор

kkg

Пост N: 30 Зарегистрирован: 29.11.19

Отправлено: 05.10.20 20:44. Заголовок: SergKis не спорткар,..

SergKis

цитата:

не спорткар, но и не трактор

абсолютно согласен, лично у меня ERP системы приучили пользователя,
что нажав кнопку получить отчёт, а через 25 мин он получает TimeOut
и при этом пользователя обвиняют что он был не прав взяв большой период,
то мы пока всё таки спорткар :) (пока данные и отчёты берут от нас)

Haz
администратор
Пост N: 1629 Зарегистрирован: 20.02.11

Отправлено: 05.10.20 22:29. Заголовок: SergKis пишет: Весь..

SergKis пишет:

цитата:

Весь текст h_tbrowse.prg пропитан такими строками

От этих skip никуда не деться. Можно попробовать оптимизировать уменьшив число переходов. Но полностью от цикла не уйти.
Сегодня попробовал вариант goLeft goRight делать скролом окна бровса и прорисовывать только появляющуюся колонку. В исходнике кстати есть намек на такой вариант, но автор его бросил ( или не доделал). Из рисков такой логики это наткнуться на ситуацию когда скроллируемое окно не соответствует по записям новой колонке ( удалил или добавил кто то в совместном доступе ). Как обойти не придумал. Получается нужно в объекте держать массив номеров recno текущего отображения бровса..... А если так то и до массива всех записей в окне бровса недалеко. Тогда придется работать страницами. В текущем окне все будет летать , но появятся задержки при формировании новой страницы значениями для показа. Плюс не ясно как ловить изменения по сети. В общем пока только одни мысли, до решения далеко

SergKis
постоянный участник
Пост N: 3417 Зарегистрирован: 17.02.12

Отправлено: 05.10.20 22:59. Заголовок: Haz пишет Получается..

Haz пишет

цитата:

Получается нужно в объекте держать массив номеров recno текущего отображения бровса..... А если так то и до массива всех записей в окне бровса недалеко.

Мы с тобой об одном и том же, выше описал на базе ob:aRowPosAtRec именно такую схему, а все записи бровса (страница, можно, конечно и весь) храним по ключу в hash в виде практически готовых объектов oCl, oCell, при выводе только координаты поправляются, т.к. goleft и goright по разному список колонок, помещающихся показывают. От skipov сильно не избавишься, но данные блоков кода, выполненые раз хранятся в oCell

SergKis
постоянный участник
Пост N: 3418 Зарегистрирован: 17.02.12

Отправлено: 05.10.20 23:19. Заголовок: Haz пишет Плюс не яс..

Haz пишет

цитата:

Плюс не ясно как ловить изменения по сети.

Как обычно pgUp, pgDn и явный Refresh по кнопке или F5, как в IE и т.д.

цитата:

Из рисков такой логики это наткнуться на ситуацию когда скроллируемое окно не соответствует по записям новой колонке ( удалил или добавил кто то в совместном доступе ).

Не очень понял, в совместном доступе у нас dbf или результат выборки (структура определена), как то не с руки в такой ситуевине менять структуру - это уже, как бы др. запрос, др. результат\ файл\массив

Haz
администратор
Пост N: 1630 Зарегистрирован: 20.02.11

Отправлено: 06.10.20 12:03. Заголовок: Из рисков такой логи..

цитата:

Сергей я о другом механизме ::GoLeft() и ::GoRight() в КРАЙНИХ позициях
Сейчас реализовано через полную перерисовку и передачу фокуса на появившуюся колонку. В методах ::GoUp() и ::GoDown() по другому - там сразу скролл всего окна бровса и ::DrawLine() на "освободившейся" строке.

Если ::GoLeft() и ::GoRight() в КРАЙНИХ позициях перевести на эту логику , то скролл окна вправо или влево и ::DrawCol() - которого пока нет ))
Функция TSBrwHScroll() в С модуле есть, метод ::TSBrwHScroll прописать не сложно как METHOD TSBrwHScroll( nDir ) INLINE TSBrwHScroll( ::hWnd, nDir, 0, 0) - проверил работает
Сложнее сделать новые ::GoLeft2() и ::GoRight2() на основе скрола и тут может возникнуть ситуация когда новый ::DrawCol() нарисует колонку с другим набором записей чем на скроллируемой картинке.
Думаю этот вопрос и заставил автора библиотеки бросить эту тему и пойти по пути перерисовки всего бровса

SergKis
постоянный участник
Пост N: 3419 Зарегистрирован: 17.02.12

Отправлено: 06.10.20 13:05. Заголовок: Haz пишет тут может ..

Haz пишет

цитата:

тут может возникнуть ситуация когда новый ::DrawCol() нарисует колонку с другим набором записей чем на скроллируемой картинке.
Думаю этот вопрос и заставил автора библиотеки бросить эту тему и пойти по пути перерисовки всего бровса

Согласен с тобой и автором. Ускорить прорисовку (не ясно насколько) можно попробовать сохраняя oCell в hash для каждой нарисованной записи и ячейки DrawLine, DrawSelect при первом проходе, потом использовать данные hash для повторных рисований. oCol можно исп. из :aColumns, но если активно исп. Cargo колонки, то и oCol желательно сохранять для каждой ячейки вместе с oCell

SergKis
постоянный участник
Пост N: 3420 Зарегистрирован: 17.02.12

Отправлено: 06.10.20 13:41. Заголовок: PS новый ::DrawCol()..

цитата:

новый ::DrawCol() нарисует колонку

новый :DrawCol() может опираться на массив записей, заполненный в DrawLine, DrawSelect, т.е. к примеру :aRowPosAtRec
тогда рассогласования по списку записей не будет

SergKis
постоянный участник
Пост N: 3421 Зарегистрирован: 17.02.12

Отправлено: 07.10.20 11:44. Заголовок: gfilatov2002 Поправ..

gfilatov2002
Поправить немного надо, Игорь подсказал, где сбивалось содержимое ::aRowPosAtRec

 
 METHOD GoDown() CLASS TSBrowse 
 ... 
                If lTranspar 
                   ::Paint() 
                Else 
                   ::nRowPos := nLines 
                   ::TSBrwScroll( 1 ) 
                   ::Skip( -1 ) 
                   ::DrawLine( ::nRowPos - 1 ) // added 10.07.2015 
                   ::Skip( 1 ) 
                   IF ::lRowPosAtRec .and. Len( ::aRowPosAtRec ) > 0 
                      hb_ADel( ::aRowPosAtRec, 1, .T. ) 
                      AAdd( ::aRowPosAtRec, ::nAt ) 
                   ENDIF 
                EndIf 
 ... 
 METHOD GoUp() CLASS TSBrowse 
 ... 
                If ! lTranspar 
                   ::lRePaint := .F. 
                   ::TSBrwScroll( -1 ) 
                   ::Skip( 1 ) 
                   ::DrawLine( 2 ) 
                   ::Skip( -1 ) 
                   IF ::lRowPosAtRec .and. Len( ::aRowPosAtRec ) > 0 
                      ASize( ::aRowPosAtRec, Len( ::aRowPosAtRec ) - 1 ) 
                      hb_AIns( ::aRowPosAtRec, 1, ::nAt, .T. ) 
                   ENDIF 
                Else 
                   ::Paint() 
                EndIf 
 ...

Haz
администратор
Пост N: 1631 Зарегистрирован: 20.02.11

Отправлено: 07.10.20 12:15. Заголовок: SergKis пишет: Уск..

SergKis пишет:

цитата:

Ускорить прорисовку (не ясно насколько) можно попробовать сохраняя oCell в hash для каждой нарисованной записи и ячейки DrawLine,

это хорошая мысль.

В принципе логика получается простая, 2 хеша содержат
1 хеш содержит { номер записи => хеш значений записи }
2 хеш значений содержит { имя колонки => значение для показа ( или oCell целиком )}
или как вариант хеши держать в каждой ::aColumns, тогда 1 хаш в каждой колонке { RecNo() => значение для показа ( или oCell целиком )}

Прирост в скорости будет в разы по сети , год назад тестировал хеширование справочников используемых в ::bData в результате по сети получил прирост раза в 4 ( визуально )

::Refresh() обнуляет хеш(и), а ::DrawLine() и ::DrawSelect() заполняют если ключа нет или берут из хеша если ключ есть

SergKis
постоянный участник
Пост N: 3422 Зарегистрирован: 17.02.12

Отправлено: 07.10.20 12:52. Заголовок: Haz пишет 2 хеша сод..

Haz пишет

цитата:

2 хеша содержат

А почему не один ?
{ Ключ := <:nAt>+<oCol:cName> => <копия oCell> }
Если смотреть на DrawLine и DrawSelect, то они отличаются раскраской и вопрос хранить ли DrawSelect или рисовать его всегда.
Если хранить то в этом же hash
{ Ключ := <:nAt>+<oCol:cName>+<oCel:lDrawLine> => <копия oCell> }

Haz
администратор
Пост N: 1633 Зарегистрирован: 20.02.11

Отправлено: 07.10.20 12:54. Заголовок: SergKis пишет: А по..

SergKis пишет:

цитата:

А почему не один ?
{ Ключ := <:nAt>+<oCol:cName> => <копия oCell> }

Согласен

SergKis пишет:

цитата:

хранить ли DrawSelect или рисовать его всегда.

на него можно забить и не хранить

gfilatov2002
moderator
Пост N: 1797 Зарегистрирован: 11.02.10

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

SergKis пишет:

цитата:

Поправить немного надо

Благодарю за исправление

Кстати, подготовил 3-ю бету для новой сборки со следующим списком изменений:

Скрытый текст

 
   * New: Added the new functions for Windows GDI objects memory release. 
            It will activate the GDI objects recording and call CheckRes() 
            to generate the checkres.txt log file on the application quit. 
            The above logfile will report the following unreleased objects: 
            - BITMAP handles; 
            - BRUSH handles; 
            - CURSOR handles; 
            - FONT handles; 
            - ICON handles; 
            - IMAGELIST handles; 
            - REGION handles. 
            Note: This feature will work after setting of debugging mode 
            via the Harbour command Set( _SET_DEBUG, .T. ) or AltD( 1 ). 
            Contributed by Grigory Filatov <gfilatov@inbox.ru> 
            (see demo2.prg in folder \samples\Basic\Grid_5) 
   * Fixed: Detected resource leakage of GDI objects at the release of the 
            Main form with usage of the new MiniGUI Resources control system. 
            Contributed by Grigory Filatov <gfilatov@inbox.ru> 
   * Fixed: TREE: There is a blurring of the picture in some cases. 
            Bug was reported by Eladio Bravo <eladibravo/at/gmail.com>. 
            Contributed by Grigory Filatov <gfilatov@inbox.ru> 
            (see demo in folder \samples\Advanced\DirTree_2) 
   * Updated: Revised a hot mouse tracking in the ButtonEx control. 
            Problem was reported by Gilbert Vaillancourt. 
            Contributed by Grigory Filatov <gfilatov@inbox.ru> 
            (see menulist_2.prg in folder \samples\Advanced\MenuList) 
   * Updated: Synchronized Extended HMG for compatibility with Official HMG: 
            - New: COMBOBOXEX supports the optional clause NOTRANSPARENT; 
            - New: IMAGE CHECKBUTTON supports the optional clause NOTRANSPARENT; 
            - New: TAB control supports the optional clause NOTRANSPARENT; 
            - New: TREE control supports the optional clause NOTRANSPARENT. 
            Based upon a contribution of Claudio Soto <srvet/at/adinet.com.uy>. 
            Adapted for Minigui Extended by Grigory Filatov <gfilatov@inbox.ru> 
   * Updated: Adaptation FiveWin Class TSBrowse 9.0 in HMG: 
            - added the new variable :lFastDraw in the TSBrowse class; 
            - correction of a filling of :aRowPosAtRec auxiliary array 
              in the methods GoUp() and GoDown(). 
            Suggested and contributed by Sergej Kiselev. 
            - updated class TCursor has been used for creating of the STOP 
              cursor in the method MouseMove(). 
            Contributed by Grigory Filatov <gfilatov@inbox.ru> 
   * Updated: HbSQLite3 library: 
            - update for using SQLITE3 version 3.34.0dev (from 3.33.0). 
            Contributed by Grigory Filatov <gfilatov@inbox.ru> 
   * Updated: 'How to add a skin for a Grid control' sample: 
            - fixed a resource leakage with usage of the Minigui Resources 
              control system. 
            Contributed by Grigory Filatov <gfilatov@inbox.ru> 
            (see demo2.prg in folder \samples\Basic\Grid_5) 
   * Updated: 'TBrowse in the MDI environment' sample: 
            - added a memo field editing in the Card edit mode. 
            Contributed by Sergej Kiselev 
            (see in folder \samples\Advanced\Tsb_DemoMDI)

Haz
администратор
Пост N: 1634 Зарегистрирован: 20.02.11

Отправлено: 07.10.20 12:57. Заголовок: Haz пишет: { Ключ :..

Haz пишет:

цитата:

{ Ключ := <:nAt>

только не :nAt а RecNo() при работе с ADS ( при использовании SQL ) :nAt содержит непонятно что

SergKis
постоянный участник
Пост N: 3423 Зарегистрирован: 17.02.12

Отправлено: 07.10.20 13:00. Заголовок: Haz пишет Согласен В..

Haz пишет

цитата:

Согласен

Возникает вариант не задан oCol:cName, берем номер колонки и возникают риски перестановки колонки в списке.
Если после перестановки сработает Refresh, то все должно быть хорошо, если нет то плохо

Haz
администратор
Пост N: 1635 Зарегистрирован: 20.02.11

Отправлено: 07.10.20 13:08. Заголовок: SergKis пишет: не з..

SergKis пишет:

цитата:

не задан oCol:cName

Можно уйти на отдельные хеши в колонках и проблем не будет

SergKis
постоянный участник
Пост N: 3424 Зарегистрирован: 17.02.12

Отправлено: 07.10.20 13:13. Заголовок: Haz пишет только не ..

Haz пишет

цитата:

только не :nAt

Сейчас это основа. Для :lIsArr и :lIsDbf работает нормально вроде (смотрел при отладке :aRowPosAtRec)
Может надо и для ADS SQL поправить, по тексту мест много с проверками :lIsArr, :lIsDbf ?

SergKis
постоянный участник
Пост N: 3425 Зарегистрирован: 17.02.12

Отправлено: 07.10.20 13:18. Заголовок: Haz пишет Можно уйти..

Haz пишет

цитата:

Можно уйти на отдельные хеши в колонках

Или присвоить колонкам имена внутренние типа _Dummy_Col_<номер колонки>

Haz
администратор
Пост N: 1636 Зарегистрирован: 20.02.11

Отправлено: 07.10.20 13:25. Заголовок: SergKis пишет: Или ..

SergKis пишет:

цитата:

Или присвоить колонкам имена внутренние типа _Dummy_Col_<номер колонки>

или генерить уникальный ID колонки при создании , тогда вопрос отпадет совсем

Haz
администратор
Пост N: 1637 Зарегистрирован: 20.02.11

Отправлено: 07.10.20 13:27. Заголовок: SergKis пишет: Сейч..

SergKis пишет:

цитата:

Сейчас это основа. Для :lIsArr и :lIsDbf работает нормально вроде

ту все нормально для DBF идет Recno()

 
       ELSEIF ::lIsDbf 
          ::aRowPosAtRec[ xRow ] := ( ::cAlias )->( RecNo() ) 
       ELSEIF ::lIsArr 
          ::aRowPosAtRec[ xRow ] := ::nAt 
       ENDIF

SergKis
постоянный участник
Пост N: 3426 Зарегистрирован: 17.02.12

Отправлено: 07.10.20 13:48. Заголовок: gfilatov2002 Поправ..

gfilatov2002
Поправьте немного еще

 
 METHOD DrawLine( xRow, lDrawCell ) CLASS TSBrowse 
 ... 
 		If ::bOnDrawLine != Nil 
 			IF !Empty( Eval( ::bOnDrawLine, Self, xRow ) ) 
 				RETURN Self 
 			ENDIF 
 		EndIf 
 ... 
 METHOD DrawSelect( xRow, lDrawCell ) CLASS TSBrowse 
 ... 
 		If ::bOnDrawLine != Nil 
 			IF !Empty( Eval( ::bOnDrawLine, Self, xRow ) ) 
 				RETURN Self 
 			ENDIF 
 		EndIf 
  
 		If ! ::lDrawLine 
 			nBegin := 1 
 			nLastCol := ::nColCount() 
 		EndIf 
 ...

SergKis
постоянный участник
Пост N: 3427 Зарегистрирован: 17.02.12

Отправлено: 07.10.20 13:56. Заголовок: Haz пишет ту все нор..

Haz пишет

цитата:

ту все нормально для DBF идет Recno()

Т.е. при ADS SQL :lIsDbf == .T. ?
Тогда :nAt, по идее, везде должна быть нормальной, т.к. определяется в :nLogicPos() в ней только для ADO возврат

 
 		If ::cAlias == "ADO_" 
 			Return Eval( ::bKeyNo ) 
 		EndIf 
  
 		Return ::nAt

Haz
администратор
Пост N: 1638 Зарегистрирован: 20.02.11

Отправлено: 07.10.20 14:19. Заголовок: SergKis пишет: Тогд..

SergKis пишет:

цитата:

Тогда :nAt, по идее, везде должна быть нормальной, т.к. определяется в :nLogicPos() в ней только для ADO возврат

:nAt только для массива же ?
При ADS SQL :lIsDbf будет == .T. и Recno() как уникальный номер записи возмется с таблицы по которой построили запрос ( тоже все нормально )
Принцип работы ADS SQL простой -> DoSql( cAlias, cSql ) и получим рабочую новую область согласно запросу, фактически как USE cBase NEW ALIAS (cAlias)
а вот LogicPos вернет что угодно только не позицию в логическом порядке записей. Из-за этого при запросе slect ... from ... order by ... вертикальный скроллбар прыгает хаотично.
и это косяк именно ADS

в исходниках подцепиться не к чему, если только создать виртуальное поле - нумератор и скроллбар настроить на него.

SergKis
постоянный участник
Пост N: 3428 Зарегистрирован: 17.02.12

Отправлено: 07.10.20 14:30. Заголовок: Haz пишет :nAt для ..

Haz пишет [quote]`
:nAt для массива и dbf работает нормально, исп. без анализа в своих блоках кода и ф-ях
Может тут, что то править надо Скрытый текст

 
 METHOD SetDbf( cAlias ) CLASS TSBrowse 
 	Local cAdsKeyNo, cAdsKeyCount, nTags, nEle 
  
 	Default ::cAlias := cAlias 
 	Default ::cAlias := Alias() 
  
 	If Empty( ::cAlias ) 
 		Return Nil 
 	EndIf 
  
 	cAlias := ::cAlias 
 	::cDriver := ( ::cAlias )->( RddName() ) 
  
 	Default ::bGoTop	 := {|| ( cAlias )->( DbGoTop() ) }, ; 
 			  ::bGoBottom := {|| ( cAlias )->( DbGoBottom() ) }, ; 
 			  ::bSkip	  := {| n | iif( n == Nil, n := 1, Nil ), ::DbSkipper( n ) }, ; 
 			  ::bBof		:= {|| ( cAlias )->( Bof() ) }, ; 
 			  ::bEof		:= {|| ( cAlias )->( Eof() ) } 
  
 	If "ADS" $ ::cDriver 
 		cAdsKeyNo := "{| n, oBrw | iif( n == Nil, Round( " + cAlias + "->( ADSGetRelKeyPos() ) * oBrw:nLen, 0 ), " + ; 
 								 cAlias + "->( ADSSetRelKeyPos( n / oBrw:nLen ) ) ) }" 
  
 		cAdsKeyCount := "{|cTag| " + cAlias + "->( ADSKeyCount(cTag,, 1 ) ) }" 
  
 		Default ::bKeyNo	 := &cAdsKeyNo , ; 
 				  ::bKeyCount := &cAdsKeyCount, ; 
 				  ::bLogicLen := &cAdsKeyCount, ; 
 				  ::bTagOrder := {|uTag| ( cAlias )->( OrdSetFocus( uTag ) ) }, ; 
 				  ::bGoToPos  := {|n| Eval( ::bKeyNo, n, Self ) } 
 	Else 
 		Default ::bKeyNo	 := {| n | ( cAlias )->( iif( n == Nil, iif( IndexOrd() > 0, OrdKeyNo(), RecNo() ), ; 
 										iif( IndexOrd() > 0, OrdKeyGoto( n ), DbGoTo( n ) ) ) ) }, ; 
 				  ::bKeyCount := {|| ( cAlias )->( iif( IndexOrd() > 0, OrdKeyCount(), LastRec() ) ) }, ; 
 				  ::bLogicLen := {|| ( cAlias )->( iif(  IndexOrd() == 0, LastRec(), OrdKeyCount() ) ) }, ; 
 				  ::bTagOrder := {|uTag| ( cAlias )->( OrdSetFocus( uTag ) ) }, ; 
 				  ::bGoToPos  := {|n| Eval( ::bKeyNo, n ) } 
 	EndIf 
  
 	nTags := ( cAlias )->( OrdCount() ) 
 	::aTags := {} 
  
 	For nEle := 1 To nTags 
 		AAdd( ::aTags, { ( cAlias )->( OrdName( nEle ) ), ( cAlias )->( OrdKey( nEle ) ) } ) 
 	Next 
 	if "SQL" $ ::cDriver 
 		Eval( ::bGoToPos, 100 ) 
 		::bGoBottom := {|| CursorWait(), ( cAlias )->( DbGoBottom() ), CursorArrow() } 
 		::bRecLock  := {|| .t. } 
 	endif 
  
 	::nLen := Eval( ::bLogicLen ) 
 	::ResetVScroll( .T. ) 
  
 Return Self

gfilatov2002
moderator
Пост N: 1798 Зарегистрирован: 11.02.10

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

SergKis пишет:

цитата:

Поправьте немного еще

Haz
администратор
Пост N: 1639 Зарегистрирован: 20.02.11

Отправлено: 07.10.20 14:57. Заголовок: SergKis пишет: Може..

SergKis пишет:

цитата:

Может тут, что то править надо

Сергей , бесполезно

Уже не раз смотрел и правил. Просто если в SQL запросе присутствует ORDER BY ( т.е. сортировка ) логика в ADS примерно такая
1) Выполняется основной запрос и ADSGetRelKeyPos будет правильным для несортированной таблицы.
2) Потом выполняется ORDER BY из запроса и вместо ADSGetRelKeyPos на выходе получаем компот.

В исходниках ADSRDD нет ничего , что позволило бы получить правильную логическую позицию, единственный вариант - это создание временной таблицы в памяти сервера

 
  DOSQL(, "SELECT ... INTO #T1 FROM ... ORDER BY ...") 
  а потом  
  DOSQL("T2", "SELECT * FROM #T1" ) 
  ... 
  и после всего этого 
  T2->(dbCloseArea()) 
  DOSQL(, "DROP TABLE #T1")

Предлагаю даже не заморачиваться с этим, запросы без ORDER BY идут в логике обычного DBF, если нужна сортировка , то делаю индекс в таблице и он подхватывается в результат прямого запроса

SergKis
постоянный участник
Пост N: 3429 Зарегистрирован: 17.02.12

Отправлено: 07.10.20 15:02. Заголовок: Haz пишет Предлагаю ..

Haz пишет

цитата:

Предлагаю даже не заморачиваться с этим

OK !
Спасибо за разъяснения

SergKis
постоянный участник
Пост N: 3430 Зарегистрирован: 17.02.12

Отправлено: 07.10.20 15:11. Заголовок: gfilatov2002 С учет..

gfilatov2002
С учетом разъяснений Игоря, поправьте

 
   
  METHOD GoDown() CLASS TSBrowse  
  ...  
                 If lTranspar  
                    ::Paint()  
                 Else  
                    ::nRowPos := nLines  
                    ::TSBrwScroll( 1 )  
                    ::Skip( -1 )  
                    ::DrawLine( ::nRowPos - 1 ) // added 10.07.2015  
                    ::Skip( 1 )  
                    IF ::lRowPosAtRec .and. Len( ::aRowPosAtRec ) > 0  
                       hb_ADel( ::aRowPosAtRec, 1, .T. )  
                       AAdd( ::aRowPosAtRec, iif( ::lIsDbf, (::cAlias)->(RecNo()), ::nAt ) )  
                    ENDIF  
                 EndIf  
  ...  
  METHOD GoUp() CLASS TSBrowse  
  ...  
                 If ! lTranspar  
                    ::lRePaint := .F.  
                    ::TSBrwScroll( -1 )  
                    ::Skip( 1 )  
                    ::DrawLine( 2 )  
                    ::Skip( -1 )  
                    IF ::lRowPosAtRec .and. Len( ::aRowPosAtRec ) > 0  
                       ASize( ::aRowPosAtRec, Len( ::aRowPosAtRec ) - 1 )  
                       hb_AIns( ::aRowPosAtRec, 1, iif( ::lIsDbf, (::cAlias)->(RecNo()), ::nAt ), .T. )  
                    ENDIF  
                 Else  
                    ::Paint()  
                 EndIf  
  ...

Andrey
постоянный участник
Пост N: 6832 Зарегистрирован: 12.09.06

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

SergKis пишет:

цитата:

Скорости хватает, не спорткар, но и не трактор

Вообще то МиниГуи ТСБ будет получше чем у других.
Вот для примера стандартный C# грид - https://cloud.mail.ru/public/2wYs/pJMfZSrtD
Кол-во столбцов и строк можно самому настраивать в настройке этой проги.

Haz
администратор
Пост N: 1640 Зарегистрирован: 20.02.11

Отправлено: 07.10.20 15:22. Заголовок: SergKis пишет: Или ..

SergKis пишет:

цитата:

Или присвоить колонкам имена внутренние типа _Dummy_Col_<номер колонки>

Может действительно в TSCOLUMN добавить DATA nID INIT 0 , а в METHOD TSColumn:New() в описание переменных static nLastID := 0 и сразу далее ::nId := ++nLastId
Тогда ключ для любой колонки всегда будет уникальным , как бы ее не перемещали ???

SergKis
постоянный участник
Пост N: 3431 Зарегистрирован: 17.02.12

Отправлено: 07.10.20 15:26. Заголовок: Haz пишет Тогда ключ..

Haz пишет

цитата:

Тогда ключ для любой колонки всегда будет уникальным , как бы ее не перемещали ???

Для внутреннего использования даже оч. нормально (может и еще где сгодится "славянский шкаф")

gfilatov2002
moderator
Пост N: 1799 Зарегистрирован: 11.02.10

Отправлено: 07.10.20 15:31. Заголовок: SergKis пишет: С уч..

SergKis пишет:

цитата:

С учетом разъяснений Игоря, поправьте

Поправил, конечно

SergKis
постоянный участник
Пост N: 3432 Зарегистрирован: 17.02.12

Отправлено: 07.10.20 15:35. Заголовок: PS Но тогда в класс ..

PS
Но тогда в класс TSBrowse добавить переменную надо
DATA nLastIdColumn AS NUMERIC INIT 0
и в метод AddColumn и InsColumn добавить ведение этого счетчика, т.е.

 
 METHOD InsColumn( nPos, oColumn ) CLASS TSBrowse 
  
 	Local nI, nCell := ::nCell 
  
         oColumn:nId := ++ ::nLastIdColumn 
  
 	If oColumn == Nil									  // if no Column object supplied 
 		Return Nil											// return nil instead of reference to object 
 	EndIf 
 ... 
 METHOD AddColumn( oColumn ) CLASS TSBrowse 
  
 	Local nHeight, nAt, cHeading, cRest, nOcurs, ; 
 			hFont := iif( ::hFont != Nil, ::hFont, 0 ) 
  
 	Default ::aColSizes := {} 
  
         oColumn:nId := ++ ::nLastIdColumn 
  
 ...

Haz
администратор
Пост N: 1641 Зарегистрирован: 20.02.11

Отправлено: 07.10.20 16:03. Заголовок: SergKis пишет: Но т..

SergKis пишет:

цитата:

Но тогда в класс TSBrowse добавить переменную надо

если это единственный счетчик, который из TSColumn переезжает в TSBrowse как
DATA nLastIdColumn AS NUMERIC INIT 0
то да здесь правильнее, но из TSColumn:New() придется убрать ::nId := ... иначе будут переназначения

SergKis
постоянный участник
Пост N: 3433 Зарегистрирован: 17.02.12

Отправлено: 07.10.20 16:44. Заголовок: Игорь Не вижу в TsCo..

Игорь
Не вижу в TsColumn ::nId := ..., совсем не находится nId, ::nId есть в TControl, но от него TsBrowse (ID TsBrowse понимаю), т.е.
можем спокойно для колонок в класс TsColumn добавить
DATA nId AS NUMERIC INIT 0 // ID column
а в TsBrowse ведение счетчика колонок, можно короче назвать
DATA nIdColumn AS NUMERIC INIT 0
и при добавлении\вставке колонок счетчик увеличиваем, не вижу что бы с чем то перекрывались
А фантомной колонке надо присвоить nId, наверно взять :nId := -1

 
 		If ::oPhant == Nil 
 			// "Phantom" column; :nPhantom hidden IVar 
 			::oPhant := TSColumn():New(	"", ; // cHeading 
 											{|| "" }, ; // bdata 
 												  nil, ; // cPicture 
 						 { nClrText, nClrBack }, ; // aColors 
 												  nil, ; // aAlign 
 										 ::nPhantom, ; // nWidth 
 												  nil, ; // lBitMap 
 												  nil, ; // lEdit 
 												  nil, ; // bValid 
 												  .T., ; // lNoLite 
 												  nil, ; // cOrder 
 												  nil, ; // cFooting 
 												  nil, ; // bPrevEdit 
 												  nil, ; // bPostEdit 
 												  nil, ; // nEditMove 
 												  nil, ; // lFixLite 
 										  {l3DLook}, ; 
 												  nil, ; 
 												 Self ) 
 			::oPhant:cName := "oPhant" 
 			::oPhant:nId := -1 
 		Else

т.к. для колонки SELECTOR тогда может быть :nId := 0

gfilatov2002
moderator
Пост N: 1800 Зарегистрирован: 11.02.10

Отправлено: 07.10.20 17:09. Заголовок: SergKis пишет: в кл..

SergKis пишет:

цитата:

в класс TsColumn добавить
DATA nId AS NUMERIC INIT 0 // ID column
а в TsBrowse ведение счетчика колонок, можно короче назвать
DATA nIdColumn AS NUMERIC INIT 0

Добавил эти изменения также

Haz
администратор
Пост N: 1642 Зарегистрирован: 20.02.11

Отправлено: 07.10.20 17:15. Заголовок: SergKis пишет: и пр..

SergKis пишет:

цитата:

и при добавлении\вставке колонок счетчик увеличиваем, не вижу что бы с чем то перекрывались
А фантомной колонке надо присвоить nId, наверно взять :nId := -1

тоже не увидел проблем

SergKis
постоянный участник
Пост N: 3434 Зарегистрирован: 17.02.12

Отправлено: 07.10.20 17:37. Заголовок: gfilatov2002 В дого..

gfilatov2002
В догонку добавления

 
 METHOD AddColumn( oColumn ) CLASS TSBrowse 
 ... 
 	Default ::aColSizes := {} 
  
 	oColumn:nId := ++ ::nIdColumn 
  
 	If oColumn:lDefineColumn 
 ... 
 METHOD InsColumn( nPos, oColumn ) CLASS TSBrowse 
 ... 
  
 	oColumn:nId := ++ ::nIdColumn 
  
 	If oColumn:lDefineColumn 
 		oColumn:DefColor( Self, oColumn:aColors ) 
 		oColumn:DefFont ( Self ) 
 	EndIf 
 ... 
 METHOD DrawHeaders( lFooters, lDrawCell ) CLASS TSBrowse 
 ... 
 		::oPhant:cName := "oPhant" 
 		::oPhant:nId := -1 
 ... 
 METHOD DrawLine( xRow, lDrawCell ) CLASS TSBrowse 
 ... 
 			::oPhant:cName := "oPhant" 
 			::oPhant:nId := -1 
 ... 
 METHOD DrawSelect( xRow, lDrawCell ) CLASS TSBrowse 
 ... 
 			::oPhant:cName := "oPhant" 
 			::oPhant:nId := -1 
 ...

SergKis
постоянный участник
Пост N: 3435 Зарегистрирован: 17.02.12

Отправлено: 07.10.20 18:02. Заголовок: PS Запустил с измене..

PS
Запустил с изменениями (выше) Tsb_MoreFields\demo.prg, получил лог Скрытый текст

 
 1  ID  
 2  FIRST  
 3  LAST   
 4  STREET    
 5  CITY   
 6  STATE  
 7  ZIP    
 8  HIREDATE  
 9  MARRIED   
 10 AGE    
 11 SALARY    
 12 FIRST2    
 13 LAST2  
 14 STREET2   
 15 CITY2  
 16 STATE2    
 17 ZIP2   
 18 HIREDATE2    
 19 MARRIED2  
 20 AGE2   
 21 SALARY2   
 22 FIRST3    
 23 LAST3  
 24 STREET3   
 25 CITY3  
 26 STATE3    
 27 ZIP3   
 28 HIREDATE3    
 29 MARRIED3  
 30 AGE3   
 31 SALARY3   
 32 FIRST4    
 33 LAST4  
 34 STREET4   
 35 CITY4  
 36 STATE4    
 37 ZIP4   
 38 HIREDATE4    
 39 MARRIED4  
 40 AGE4   
 41 SALARY4   
 42 FIRST5    
 43 LAST5  
 44 STREET5   
 45 CITY5  
 46 STATE5    
 47 ZIP5   
 48 HIREDATE5    
 49 MARRIED5  
 50 AGE5   
 51 SALARY5   
 52 FIRST6    
 53 LAST6  
 54 STREET6   
 55 CITY6  
 56 STATE6    
 57 ZIP6   
 58 HIREDATE6    
 59 MARRIED6  
 60 AGE6   
 61 SALARY6   
 62 FIRST7    
 63 LAST7  
 64 STREET7   
 65 CITY7  
 66 STATE7    
 67 ZIP7   
 68 HIREDATE7    
 69 MARRIED7  
 70 AGE7   
 71 SALARY7   
 72 FIRST8    
 73 LAST8  
 74 STREET8   
 75 CITY8  
 76 STATE8    
 77 ZIP8   
 78 HIREDATE8    
 79 MARRIED8  
 80 AGE8   
 81 SALARY8   
  
 .F.   Col = 1  82 SELECTOR 0.06   
 .F.   Col = 2  1  ID 0.08   
 .F.   Col = 3  2  FIRST 0.08   
 .F.   Col = 4  3  LAST  0.08   
 .F.   Col = 5  4  STREET   0.08   
 .F.   Col = 6  5  CITY  0.08   
 .F.   Col = 7  6  STATE 0.08   
 .F.   Col = 8  7  ZIP   0.08   
 .F.   Col = 9  8  HIREDATE 0.08   
 .T.   Col = 1  82 SELECTOR 0.08   
 .T.   Col = 2  1  ID 0.08   
 .T.   Col = 3  2  FIRST 0.08   
 .T.   Col = 4  3  LAST  0.08   
 .T.   Col = 5  4  STREET   0.08   
 .T.   Col = 6  5  CITY  0.08   
 .T.   Col = 7  6  STATE 0.08   
 .T.   Col = 8  7  ZIP   0.08   
 .T.   Col = 9  8  HIREDATE 0.09   
 .T.   Col = 1  82 SELECTOR 0.09

В нем колонка SELECTOR нумеруется через счетчик, так что фантомную колонку можно -1 не делать, оставить 0
Какие мысли по этому варианту ?

SergKis
постоянный участник
Пост N: 3436 Зарегистрирован: 17.02.12

Отправлено: 07.10.20 18:04. Заголовок: PS2 .F. Col = 1 ..

PS2
.F. Col = 1 82 SELECTOR 0.06
выделенное цветом это nId колонки SELECTOR

SergKis
постоянный участник
Пост N: 3437 Зарегистрирован: 17.02.12

Отправлено: 07.10.20 18:20. Заголовок: PS3 Наверно с nId :=..

PS3
Наверно с nId := 0 для колонки SELECTOR лучше, лог выглядит так

 
 .F.   Col = 1  0  SELECTOR 0.06   
 .F.   Col = 2  1  ID 0.06   
 .F.   Col = 3  2  FIRST 0.06   
 .F.   Col = 4  3  LAST  0.06   
 ...

цветом :nId выделен. Если так лучше, то такая правка требуется

 
 METHOD InsColumn( nPos, oColumn ) CLASS TSBrowse 
  
 	Local nI, nCell := ::nCell 
  
 	If oColumn == Nil									  // if no Column object supplied 
 		Return Nil											// return nil instead of reference to object 
 	EndIf 
  
 	IF ! ( !Empty( oColumn:cName ) .and. oColumn:cName == "SELECTOR" ) 
 		oColumn:nId := ++ ::nIdColumn 
 	ENDIF 
 ...

gfilatov2002
moderator
Пост N: 1801 Зарегистрирован: 11.02.10

Отправлено: 07.10.20 19:35. Заголовок: SergKis пишет: така..

SergKis пишет:

цитата:

такая правка требуется

METHOD InsColumn( nPos, oColumn ) CLASS TSBrowse

Записал в этом методе таким образом:

METHOD InsColumn( nPos, oColumn ) CLASS TSBrowse 
 ... 
    If nPos == 1 .and. Len( ::aColumns ) > 1 .and. ::lSelector 
       oColumn:nId := 0 
       Return Nil 
    EndIf 
  
    oColumn:nId := ++ ::nIdColumn 
 ...

SergKis
постоянный участник
Пост N: 3438 Зарегистрирован: 17.02.12

Отправлено: 07.10.20 19:47. Заголовок: gfilatov2002 METHOD ..

gfilatov2002

 
 METHOD InsColumn( nPos, oColumn ) CLASS TSBrowse  
  ...  
     If nPos == 1 .and. Len( ::aColumns ) > 1 .and. ::lSelector  
        oColumn:nId := 0  
        Return Nil  
     EndIf  
     Else 
        oColumn:nId := ++ ::nIdColumn  
     EndIf 
  ...

Haz
администратор
Пост N: 1643 Зарегистрирован: 20.02.11

Отправлено: 07.10.20 20:02. Заголовок: SergKis пишет: Если..

SergKis пишет:

цитата:

Если так лучше, то такая правка требуется

Думаю все равно в каком порядке нумерация будет , главное больше 0. Тогда на отрицательные значения со временем можно дополнительный смысл возложить скажем -6 значит колонка с ID = 6 требует обновление hash. Или вообще не задумываться , просто ID > 0 и все. 😏

SergKis
постоянный участник
Пост N: 3439 Зарегистрирован: 17.02.12

Отправлено: 07.10.20 20:23. Заголовок: Haz пишет Думаю все ..

Haz пишет

цитата:

Думаю все равно в каком порядке нумерация будет , главное больше 0

nId == 0 это SELECTOR, так проще, если работать по nId, а проверять совсем не надо.
Колонки :nId == 0 и :nId == -1 надо в hash сохранять как все др. колонки, т.к. блоки кода в них тоже работают и проходят через метод :TSDrawCell(), а порядок это, действительно, все равно

SergKis
постоянный участник
Пост N: 3440 Зарегистрирован: 17.02.12

Отправлено: 07.10.20 20:28. Заголовок: Haz пишет скажем -6 ..

Haz пишет

цитата:

скажем -6 значит колонка с ID = 6 требует обновление hash.

Для обновления надо метод написать, т.е. очищает или заполняет по имеющимся ключам hash, хотя последнее
сделает DrawLine при прорисовке и отсутствию ключа в hash

Haz
администратор
Пост N: 1644 Зарегистрирован: 20.02.11

Отправлено: 07.10.20 22:37. Заголовок: SergKis пишет: Для ..

SergKis пишет:

цитата:

Для обновления надо метод написать

hash будет жить в объекте Tsbrowse ? Как его назовем и какова структура ?

SergKis
постоянный участник
Пост N: 3441 Зарегистрирован: 17.02.12

Отправлено: 08.10.20 07:19. Заголовок: Haz пишет hash будет..

Haz пишет

цитата:

hash будет жить в объекте Tsbrowse ? Как его назовем и какова структура ?

Мне пока такое лезет в голову

 
 DATA lFastDrawCell AS LOGICAL INIT .F.     
 DATA aFastDrawCell            INIT hb_Hash() 
 ... 
 METHOD DrawLine( xRow, lDrawCell ) CLASS TSBrowse 
 ... 
 	Local nDeltaLen, xData, nAt, oCell, cCell 
 ... 
 	IF ::lRowPosAtRec 
 		IF Empty( ::aRowPosAtRec ) .or. Len( ::aRowPosAtRec ) != ::nRowCount() 
 			::aRowPosAtRec := Array( ::nRowCount() ) 
 			AFill( ::aRowPosAtRec, 0 ) 
 		ENDIF 
 		IF ::nLen == 0 .or. xRow == 0 .or. xRow > Len( ::aRowPosAtRec ) 
 		ELSEIF ::lIsDbf 
 			::aRowPosAtRec[ xRow ] := ( nAt := ( ::cAlias )->( RecNo() ) ) 
 		ELSEIF ::lIsArr 
 			::aRowPosAtRec[ xRow ] := ( nAt := ::nAt ) 
 		ENDIF 
 	ENDIF 
  
 	If ::nLen > 0 
  
 		 IF nAt == NIL 
 			 nAt := iif( ::lIsDbf, ( ::cAlias )->( RecNo() ), ::nAt ) 
 		 ENDIF 
 ... 
 			nJ := iif( nI < ::nColPos, nJ + 1, nI ) 
  
 			lSelected  := iif( nJ == nLastCol, .F., lSelected ) 
 			oColumn	 := iif( nJ > Len( ::aColumns ), ::oPhant, ::aColumns[ nJ ] ) 
 			nDeltaLen  := ::GetDeltaLen( nJ, nStartCol, nMaxWidth, aColSizes ) 
  
 			cCell := hb_ntos(nAt)+"."+hb_ntos(oColumn:nId) 
  
 			IF ::lFastDrawCell 
 				oCell := hb_HGetDef( ::aFastDrawCell, cCell, NIL ) 
 				IF ISOBJECT(oCell) 
 					oCell:nRow	 := xRow 
 					oCell:nCol	 := nStartCol 
 					oCell:nWidth  := aColSizes[ nJ ] + nDeltaLen 
 					oCell:nHeight := ::nHeightCell 
 					oCell:nCell	:= nJ 
 					IF lDrawCell 
 					  ::TSDrawCell( oCell, oColumn ) 
 					ENDIF 
 					nStartCol += aColSizes[ nJ ] + nDeltaLen 
 					LOOP 
 				ENDIF 
 			ENDIF 
  
 			//If HB_ISNUMERIC( oColumn:nLineStyle ) 
 			//	nLineStyle := oColumn:nLineStyle 
 			//EndIf 
 			nLineStyle := iif( HB_ISNUMERIC( oColumn:nLineStyle ), oColumn:nLineStyle, ::nLineStyle ) 
 			cPicture := ::cPictureGet( oColumn, nJ ) 
 ... 
 			IF lDrawCell 
 				::TSDrawCell( oColumn:oCell, oColumn ) 
 				IF ::lFastDrawCell 
 					hb_HSet( ::aFastDrawCell, cCell, __objClone( oColumn:oCell ) ) 
 				ENDIF 
 			ENDIF 
  
 			nStartCol += aColSizes[ nJ ] + nDeltaLen 
 ...

Метод для очистки ::aFastDrawCell
METOD FastDrawCell() INLINE ::aFastDrawCell := hb_Hash()
Вызовы, как ты писал, в Refresh() поставить

SergKis
постоянный участник
Пост N: 3442 Зарегистрирован: 17.02.12

Отправлено: 08.10.20 07:23. Заголовок: PS А может и не в Re..

PS
А может и не в Refresh(), т.к. по :GoLeft(), :GoRight() очистки не должно быть.
Тогда где ?

SergKis
постоянный участник
Пост N: 3443 Зарегистрирован: 17.02.12

Отправлено: 08.10.20 08:02. Заголовок: PS2 Попробовал по бы..

PS2
Попробовал по быстрому набрать, как писал выше, но такая правка

 
 			IF ::lFastDrawCell 
 				oCell := hb_HGetDef( ::aFastDrawCell, cCell, NIL ) 
 				IF ISOBJECT(oCell) 
 					oCell:nRow	 := xRow 
 					oCell:nCol	 := nStartCol 
 					oCell:nWidth  := aColSizes[ nJ ] + nDeltaLen 
 					oCell:nHeight := ::nHeightCell 
 					oCell:nCell	:= nJ 
 					oCell:hWnd	 := hWnd 
 					oCell:hDC	  := hDC 
 					oCell:xRow	 := xRow 
 					oCell:nStartCol := nStartCol 
 					oCell:nSize	:= aColSizes[ nJ ] + nDeltaLen 
 					oColumn:oCell := oCell 
 					IF lDrawCell 
 					  ::TSDrawCell( oColumn:oCell, oColumn ) 
 					ENDIF 
 					nStartCol += aColSizes[ nJ ] + nDeltaLen 
 					LOOP 
 				ENDIF 
 			ENDIF

попробовал пример Tsb_MoreFields\demo.prg, поставив :lFastDrawCell := .T.
Что то отобразилось, но с искажениями после перемещений курсора.
Я отключаюсь на несколько дней от темы.

Haz
администратор
Пост N: 1645 Зарегистрирован: 20.02.11

Отправлено: 08.10.20 09:21. Заголовок: SergKis пишет: А мо..

SergKis пишет:

цитата:

А может и не в Refresh(), т.к. по :GoLeft(), :GoRight() очистки не должно быть.
Тогда где ?

 
 METHOD Refresh( lPaint, lRecount, lClearHash ) CLASS TSBrowse 
  
    Default lPaint   := .T., ; 
            lRecount := .F.  ; 
            lClearHash := .T. 
  
    if lClearHsh 
      ::aFastDrawCell:= hb_hash() 
    end 
    If ::lFirstPaint == Nil .or. ::lFirstPaint 
       Return 0 
    EndIf 
  
    If lRecount .or. Empty( ::nLen ) 
       ::nLen := iif( ::lIsDbf, ( ::cAlias )->( Eval( ::bLogicLen ) ), Eval( ::bLogicLen ) ) 
    EndIf 
  
    ::lNoPaint := .F. 
  
 Return ::Super:Refresh( lPaint )

и в двух методах GoLeft / GoRight поправить вызов Refresh() с учетом 3-го параметра

Haz
администратор
Пост N: 1646 Зарегистрирован: 20.02.11

Отправлено: 08.10.20 09:24. Заголовок: SergKis пишет: Попр..

SergKis пишет:

цитата:

Попробовал по быстрому набрать, как писал выше, но такая правка

Выложи исходники h_browse.prg и TColumn.prg. Я пока посмотрю что получается

SergKis
постоянный участник
Пост N: 3444 Зарегистрирован: 17.02.12

Отправлено: 08.10.20 10:04. Заголовок: Haz Тут https://Tra..

Haz
Тут https://TransFiles.ru/tif7u
Немного поправил. В таком виде работает.
Возможно, ты прав, что в hash надо хранить структуру.
В тексте сохраняю объект, но наверно, надо массив с выборочными данными

SergKis
постоянный участник
Пост N: 3445 Зарегистрирован: 17.02.12

Отправлено: 08.10.20 10:22. Заголовок: Haz пишет и в двух м..

Haz пишет

цитата:

и в двух методах GoLeft / GoRight поправить вызов Refresh() с учетом 3-го параметра

В том то и дело, что тут они не нужны, т.к. по этим методам те cell, которые есть в hash отображаются из него,
а тех что нет отображаются пополняя hash, т.е. если не делаем ::aFastDrawCell:= hb_hash(), то съедаем весь
дбф в hash и все отображение идет из него. И когда делать ::aFastDrawCell:= hb_hash(), наверно надо решать самому.
Или при смене листа, т.е. PgDn, PgUp

SergKis
постоянный участник
Пост N: 3446 Зарегистрирован: 17.02.12

Отправлено: 08.10.20 10:30. Заголовок: PS И когда делать ::..

цитата:

И когда делать ::aFastDrawCell:= hb_hash(), наверно надо решать самому.

И в :Reset() обязятельно

Haz
администратор
Пост N: 1647 Зарегистрирован: 20.02.11

Отправлено: 08.10.20 10:37. Заголовок: SergKis пишет: В то..

SergKis пишет:

цитата:

В том то и дело, что тут они не нужны

я имел ввиду что по умолчанию refresh обнуляет hash, а третий параметр отключает это. В методах goLeft и goRight нужно заменить вызовы refresh с явным третьим параметром в FALSE чтоб не очищался hash

SergKis пишет:

цитата:

И в :Reset() обязятельно

не надо, там есть вызов ::Refresh( .T., .T. )

SergKis
постоянный участник
Пост N: 3447 Зарегистрирован: 17.02.12

Отправлено: 08.10.20 11:01. Заголовок: Haz пишет с явным т..

Haz пишет

цитата:

с явным третьим параметром в FALSE чтоб не очищался hash

Что то мне подсказывает, что нужна переменная, очищать или нет hash, т.к. работать можно только с hash на широких отчетах и hash сбрасывать не надо до конца работы тсб

SergKis
постоянный участник
Пост N: 3448 Зарегистрирован: 17.02.12

Отправлено: 08.10.20 12:51. Заголовок: Игорь Правку такую с..

Игорь
Правку такую сделай, так правильнее, по мне

 
 METHOD DrawLine( xRow, lDrawCell ) CLASS TSBrowse 
 ... 
 			IF lDrawCell 
 				::TSDrawCell( oColumn:oCell, oColumn ) 
 			ENDIF 
 			IF ::lFastDrawCell .and. ! lCell 
 				hb_HSet( ::aFastDrawCell, cCell, __objClone( oColumn:oCell ) ) 
 			ENDIF 
  
 			nStartCol += aColSizes[ nJ ] + nDeltaLen 
 ...

Haz
администратор
Пост N: 1648 Зарегистрирован: 20.02.11

Отправлено: 08.10.20 13:16. Заголовок: SergKis пишет: т.к...

SergKis пишет:

цитата:

т.к. работать можно только с hash на широких отчетах и hash сбрасывать не надо до конца работы тсб

Нужно подумать тк записи не только вширь бровса но и по количеству записей всего. Тут скорее нужен отдельный метод :tbrw2hash() -> aHash
то есть пробежаться по всей таблице без прорисовки и получить хаш всей таблицы

SergKis
постоянный участник
Пост N: 3449 Зарегистрирован: 17.02.12

Отправлено: 08.10.20 13:17. Заголовок: PS DrawSelect поправ..

PS
DrawSelect поправил на hashСкрытый текст

 
 METHOD DrawSelect( xRow, lDrawCell ) CLASS TSBrowse 
  
 	Local nI, nJ, nBegin, nStartCol, oColumn, nLastCol, hBitMap, hFont, nAlign, cPicture, nClrFore, nClrBack, ; 
 			lNoLite, uData, l3DLook, lMulti, nClrTo, lOpaque, lBrush, nCursor, lCheck, uBmpCell, cMsg, lAdjBmp, ; 
 			lSelected, ; 
 			nVertText := 0, ; 
 			nMaxWidth := ::nWidth(), ;	 // use local copies for speed 
 			nRowPos	:= ::nRowPos, ; 
 			aColSizes := AClone( ::aColSizes ), ; 
 			hWnd		:= ::hWnd, ; 
 			hDC		 := ::hDc, ; 
 			lFocused  := ::lFocused := ( GetFocus() == ::hWnd ), ; 
 			nVAlign	:= 1 
  
 	Local l3DText, nClr3dL, nClr3dS 
 	Local aBitMaps, lCheckVal := .F., cColAls 
 	Local nDeltaLen, lDraw := .F., xData 
 	Local nAt, oCell, cCell, lCell 
  
 	Local nClrText	  := ::nClrText, ; 
 			nClrPane	  := ::nClrPane, ; 
 			nClrFocuFore := ::nClrFocuFore, ; 
 			nClrFocuBack := ::nClrFocuBack, ; 
 			nClrLine	  := ::nClrLine, ; 
 			nLineStyle /*:= ::nLineStyle*/, ; 
 			nClrSeleBack := ::nClrSeleBack, ; 
 			nClrSeleFore := ::nClrSeleFore, ; 
 			nHeightCell  := ::nHeightCell, ; 
 			nHeightHead  := iif( ::lDrawHeaders, ::nHeightHead, 0 ), ; 
 			nHeightFoot  := iif( ::lDrawFooters != Nil .and. ::lDrawFooters, ::nHeightFoot, 0 ), ; 
 			nHeightSuper := iif( ::lDrawHeaders, ::nHeightSuper, 0 ),; 
 			nHeightSpecHd:= iif( ::lDrawSpecHd, ::nHeightSpecHd, 0 ) 
  
 	Default xRow := nRowPos, lDrawCell := .T. 
  
 	::nPaintRow := xRow 
 	::aDrawCols := {} 
  
 	If Empty( ::aColumns ) 
 		Return Self 
 	EndIf 
  
 	If _HMG_MainClientMDIHandle != 0 .and. ! lFocused .and. ::hWndParent == GetActiveMdiHandle() 
 		lFocused := .T. 
 	EndIf 
  
 	::lDrawSelect := .T. 
 	lSelected := ::lCanSelect .and. ( AScan( ::aSelected, iif( ::lIsDbf, ( ::cAlias )->( RecNo() ), ::nAt ) ) > 0 ) 
  
 	If ( ::lNoLiteBar .or. ( ::lNoGrayBar .and. ! lFocused ) ) .and. Empty( ::hBmpCursor ) 
 		::DrawLine()	// don't want hilited cursor bar of any color 
 	ElseIf ::nLen > 0 
  
 		nClrBack := iif( ::nPhantom = -1 .and. ! Empty( ::aColumns ), ATail( ::aColumns ):nClrBack, nClrPane ) 
 		nClrBack := iif( ValType( nClrBack ) == "B", Eval( nClrBack, ::nAt, Len( ::aColumns ), Self ), nClrBack ) 
 		l3DLook  := iif( ::nPhantom = -1 .and. ! Empty( ::aColumns ), ATail( ::aColumns ):l3DLook, .F. ) 
  
 		If ::oPhant == Nil 
 			// "Phantom" column; :nPhantom hidden IVar 
 			::oPhant := TSColumn():New(	"", ; // cHeading 
 											{|| "" }, ; // bdata 
 												  nil, ; // cPicture 
 						 { nClrText, nClrBack }, ; // aColors 
 												  nil, ; // aAlign 
 										 ::nPhantom, ; // nWidth 
 												  nil, ; // lBitMap 
 												  nil, ; // lEdit 
 												  nil, ; // bValid 
 												  .T., ; // lNoLite 
 												  nil, ; // cOrder 
 												  nil, ; // cFooting 
 												  nil, ; // bPrevEdit 
 												  nil, ; // bPostEdit 
 												  nil, ; // nEditMove 
 												  nil, ; // lFixLite 
 										  {l3DLook}, ; 
 												  nil, ; 
 												 Self ) 
 			::oPhant:cName := "oPhant" 
 			::oPhant:nId := -1 
 		Else 
 			::oPhant:nClrFore := nClrText 
 			::oPhant:nClrBack := nClrBack 
 			::oPhant:nWidth	:= ::nPhantom 
 			::oPhant:l3DLook  := l3DLook 
 		EndIf 
  
 		AAdd( aColSizes, ::nPhantom ) 
 		nJ := nStartCol := 0 
 		nLastCol := Len( ::aColumns ) + 1 
 		nBegin	:= Min( iif( ::nColPos <= ::nFreeze, ( ::nColPos := ::nFreeze + 1, ::nColPos - ::nFreeze ), ; 
 							  ::nColPos - ::nFreeze ), nLastCol ) 
  
 		IF ::lRowPosAtRec 
 			IF Empty( ::aRowPosAtRec ) .or. Len( ::aRowPosAtRec ) != ::nRowCount() 
 				::aRowPosAtRec := Array( ::nRowCount() ) 
 				AFill( ::aRowPosAtRec, 0 ) 
 			ENDIF 
 			IF xRow == 0 .or. xRow > Len( ::aRowPosAtRec ) 
 			ELSEIF ::lIsDbf 
 				::aRowPosAtRec[ xRow ] := ( nAt := ( ::cAlias )->( RecNo() ) ) 
 			ELSEIF ::lIsArr 
 				::aRowPosAtRec[ xRow ] := ( nAt := ::nAt ) 
 			ENDIF 
 		ENDIF 
  
 		If ::bOnDrawLine != Nil 
 			IF !Empty( Eval( ::bOnDrawLine, Self, xRow ) ) 
 				RETURN Self 
 			ENDIF 
 		EndIf 
  
 		If ! ::lDrawLine 
 			nBegin := 1 
 			nLastCol := ::nColCount() 
 		EndIf 
  
 		IF nAt == NIL 
 			nAt := iif( ::lIsDbf, ( ::cAlias )->( RecNo() ), ::nAt ) 
 		ENDIF 
  
 		For nI := nBegin To nLastCol 
  
 			If nStartCol >= nMaxWidth .and. ::lDrawLine 
 				Exit 
 			EndIf 
  
 			nJ := iif( nI < ::nColPos, nJ + 1, nI ) 
 			oColumn	 := iif( nJ > Len( ::aColumns ), ::oPhant, ::aColumns[ nJ ] ) 
 			nLineStyle := ::nLineStyle 
 			nDeltaLen  := ::GetDeltaLen( nJ, nStartCol, nMaxWidth, aColSizes ) 
  
 			cCell := hb_ntos(nAt)+"."+hb_ntos(oColumn:nId) 
 			lCell := .F. 
  
 			IF ::lFastDrawCell 
 				oCell := hb_HGetDef( ::aFastDrawCell, cCell, NIL ) 
 				lCell := ISOBJECT(oCell) 
 			ENDIF 
  
 			//If HB_ISNUMERIC( oColumn:nLineStyle ) 
 			//	nLineStyle := oColumn:nLineStyle 
 			//EndIf 
  
 			nLineStyle := iif( HB_ISNUMERIC( oColumn:nLineStyle ), oColumn:nLineStyle, ::nLineStyle ) 
 			hFont	 := ::hFontGet( oColumn, nJ ) 
 			lAdjBmp  := oColumn:lAdjBmp 
 			nAlign	:= oColumn:nAlign 
 			lOpaque  := .T. 
 			lMulti	:= .F. 
 			cColAls  := iif( '->' $ oColumn:cField, Nil, oColumn:cAlias ) 
  
 			If nJ == 1 .and. ! Empty( ::hBmpCursor ) 
  
 				uBmpCell := ::hBmpCursor 
 				uData	 := "" 
 				xData	 := "" 
 				nAlign	:= nMakeLong( oColumn:nAlign, oColumn:nAlign ) 
 				lNoLite  := .T. 
 				lAdjBmp  := .F. 
 				lCheck	:= .F. 
  
 			Else 
  
 				If Valtype( oColumn:bSeek ) == 'B' 
 					If cColAls != Nil 
 						( cColAls )->( Eval( oColumn:bSeek, Self, nJ ) ) 
 					Else 
 						Eval( oColumn:bSeek, Self, nJ ) 
 					EndIf 
 				EndIf 
  
 				If ::lIsArr .and. ( ::lAppendMode .or. ::nAt > Len( ::aArray ) ) 
 					uData := ""								 // append mode for arrays 
 				//ElseIf cColAls != Nil 
 				//	If Valtype( oColumn:bSeek ) == 'B' 
 				//		( cColAls )->( Eval( oColumn:bSeek, Self, nJ ) ) 
 				//	EndIf 
 				//	uData := ::bDataEval( oColumn, , nJ ) 
 				ElseIf lCell 
 					uData := oCell:uValue 
 				Else 
 					//If Valtype( oColumn:bSeek ) == 'B' 
 					//	Eval( oColumn:bSeek, Self, nJ ) 
 					//EndIf 
 					uData := ::bDataEval( oColumn, , nJ ) 
 				EndIf 
  
 				xData	  := uData 
 				lMulti	 := Valtype( uData ) == "C" .and. At( Chr( 13 ), uData ) > 0 
 				cPicture  := ::cPictureGet( oColumn, nJ ) 
 				lCheck	 := ( oColumn:lCheckBox .and. ValType( uData ) == "L" .and. oColumn:lVisible ) 
 				lNoLite	:= oColumn:lNoLite 
 				nVertText := 0 
  
 				If lCheck 
 					cPicture := "" 
 					nVertText := iif( uData, 3, 4 ) 
 					lCheckVal := uData 
 				EndIf 
  
 				uBmpCell := oColumn:uBmpCell 
  
 				If nJ == ::nColSel .and. ::uBmpSel != Nil .and. lSelected 
 					uBmpCell := ::uBmpSel 
 					nAlign	:= nMakeLong( LoWord( nAlign ), ::nAligBmp ) 
 				ElseIf oColumn:lBitMap .and. Valtype( uData ) == "N" 
 					aBitMaps := iif( Valtype( oColumn:aBitMaps ) == "A", oColumn:aBitMaps, ::aBitMaps ) 
 					If ! Empty( aBitMaps ) .and. uData > 0 .and. uData <= Len( aBitMaps ) 
 						uBmpCell := aBitMaps[ uData ] 
 					EndIf 
 					nAlign := nMakeLong( LoWord( nAlign ), nAlign ) 
 					uData  := "" 
 				ElseIf ! lCheck .and. oColumn:lEmptyValToChar .and. Empty( uData ) 
 					uData := "" 
 				ElseIf lCell 
 					uData := oCell:cValue 
 				ElseIf Empty( cPicture ) .or. lMulti 
 					uData := iif( Valtype( uData ) != "C", cValToChar( uData ), uData ) 
 				Else 
 					uData := iif( uData == NIL, "", Transform( uData, cPicture ) ) 
 				EndIf 
 			EndIf 
  
 			nAlign := ::nAlignGet( oColumn:nAlign, nJ, DT_LEFT ) 
  
 			If lNoLite 
 				If ::lLiteBar 
 					nClrFore := ::GetValProp( oColumn:nClrFocuFore, nClrText, nJ, ::nAt ) 
 					nClrBack := ::GetValProp( oColumn:nClrFocuBack, nClrPane, nJ, ::nAt ) 
 					If ! Empty(oColumn:cName) .and. oColumn:cName == "oPhant" 
 						nClrBack := nClrPane 
 					ElseIf ValType( nClrBack ) == "N" .and. nClrBack < 0 
 						nClrBack *= -1 
 					EndIf 
 				Else 
 					nClrFore := ::GetValProp( oColumn:nClrFore, nClrText, nJ, ::nAt ) 
 					nClrBack := ::GetValProp( oColumn:nClrBack, nClrPane, nJ, ::nAt ) 
 				EndIf 
  
 				nCursor := 0 
 			Else 
 				If ( nClrFore := iif( lFocused, oColumn:nClrFocuFore, oColumn:nClrSeleFore ) ) == Nil 
 					nClrFore := iif( lFocused, nClrFocuFore, nClrSeleFore ) 
 				EndIf 
  
 				nClrFore := ::GetValProp( nClrFore, nClrFore, nJ, ::nAt ) 
  
 				If ( nClrBack := iif( lFocused, oColumn:nClrFocuBack, oColumn:nClrSeleBack ) ) == Nil 
 					nClrBack := iif( lFocused, nClrFocuBack, nClrSeleBack ) 
 				EndIf 
  
 				nClrBack := ::GetValProp( nClrBack, nClrBack, nJ, ::nAt ) 
  
 				If ValType( nClrBack ) == "N" .and. nClrBack < 0 
 					nCursor := Abs( nClrBack ) 
 					nClrBack := ::GetValProp( oColumn:nClrBack, nClrPane, nJ, ::nAt ) 
 				Else 
 					nCursor := 0 
 				EndIf 
 			EndIf 
  
 			If ValType( nClrBack ) == "A" 
 				nClrBack := ::nClrBackArr( nClrBack, nJ, ::nAt ) 
 				nClrTo	:= nClrBack[2] 
 				nClrBack := nClrBack[1] 
 			Else 
 				nClrTo	:= nClrBack 
 			EndIf 
  
 			lBrush  := Valtype( nClrBack ) == "O" 
 			l3DLook := oColumn:l3DLook 
  
 			hBitMap := iif( ValType( uBmpCell ) == "B" .and. ! ::lPhantArrRow, Eval( uBmpCell, nJ, Self ), uBmpCell ) 
 			hBitMap := iif( ValType( hBitMap ) == "O" .and. ! ::lPhantArrRow, Eval( ::bBitMapH, hBitMap ), hBitMap ) 
  
 			Default hBitMap := 0 
  
 			If lCheck 
 				IF lCell 
 					hBitMap := oCell:hBitMap 
 					nAlign  := oCell:nAlign 
 				ELSE 
 				Default ::aCheck := { StockBmp( 6 ), StockBmp( 7 ) } 
 				If Valtype(oColumn:aCheck) == "A" 
 					hBitMap := oColumn:aCheck[ iif( lCheckVal, 1, 2 ) ] 
 				Else 
 					hBitMap := ::aCheck[ iif( lCheckVal, 1, 2 ) ] 
 				EndIf 
 				nAlign := nMakeLong( DT_CENTER, DT_CENTER ) 
 				ENDIF 
 				uData  := "" 
 			EndIf 
  
 			If oColumn:l3DTextCell != Nil 
 				l3DText := oColumn:l3DTextCell 
 				nClr3dL := oColumn:nClr3DLCell 
 				nClr3dS := oColumn:nClr3DSCell 
 				nClr3dL := iif( ValType( nClr3dL ) == "B", Eval( nClr3dL, ::nAt, nJ, Self ), nClr3dL ) 
 				nClr3dS := iif( ValType( nClr3dS ) == "B", Eval( nClr3dS, ::nAt, nJ, Self ), nClr3dS ) 
 			Else 
 				l3DText := nClr3dL := nClr3dS := Nil 
 			EndIf 
  
 			oColumn:nEditWidthDraw := 0 
  
 			If nDeltaLen > 0 
 				oColumn:nEditWidthDraw := aColSizes[ nJ ] + nDeltaLen 
 			EndIf 
  
 			IF ! lCell 
 			If nAlign != DT_CENTER .and. ::nCellMarginLR != NIL 
 				uData := ::CellMarginLeftRight( nJ, uData, oColumn, nAlign, lMulti, 0 ) 
 			EndIf 
 			ENDIF 
  
 		IF Empty( oColumn:oCell ) 
 			oColumn:oCell := TSBcell():New() 
 		ENDIF 
  
 		oColumn:oCell:nRow	 := nRowPos 
 		oColumn:oCell:nCol	 := nStartCol 
 		oColumn:oCell:nWidth	 := aColSizes[ nJ ] + nDeltaLen 
 		oColumn:oCell:nHeight	 := ::nHeightCell 
 		oColumn:oCell:nCell	 := nJ 
 		oColumn:oCell:uValue	 := xData 
 		oColumn:oCell:lDrawLine	 := .F.					// DrawSelect() 
  
 		oColumn:oCell:hWnd	 := hWnd				// 1 
 		oColumn:oCell:hDC	 := hDC					// 2 
 		oColumn:oCell:xRow	 := nRowPos				// 3 
 		oColumn:oCell:nStartCol	 := nStartCol				// 4 
 		oColumn:oCell:nSize	 := aColSizes[ nJ ] + nDeltaLen		// 5 aColSizes[ nJ ] + nDeltaLen 
 		oColumn:oCell:uData	 := uData				// 6 
 		oColumn:oCell:nAlign	 := nAlign				// 7 
 		oColumn:oCell:nClrFore	 := nClrFore				// 8 
 		oColumn:oCell:nClrBack	 := nClrBack				// 9 
 		oColumn:oCell:hFont	 := hFont				// 10 
 		oColumn:oCell:hBitMap	 := hBitMap				// 11 
 		oColumn:oCell:nHeightCell:= nHeightCell				// 12 
 		oColumn:oCell:l3DLook	 := l3DLook				// 13 oColumn:l3DLook 
 		oColumn:oCell:nLineStyle := nLineStyle				// 14 
 		oColumn:oCell:nClrLine	 := nClrLine				// 15 
 		oColumn:oCell:nDrawType	 := 0					// 16 line/header/footer/super 
 		oColumn:oCell:nHeightHead:= nHeightHead				// 17 
 		oColumn:oCell:nHeightFoot:= nHeightFoot				// 18 
 		oColumn:oCell:nHeightSuper  := nHeightSuper			// 19 
 		oColumn:oCell:nHeightSpecHd := nHeightSpecHd			// 20 
 		oColumn:oCell:lAdjBmp	 := lAdjBmp				// 21 
 		oColumn:oCell:lMultiline := lMulti				// 22 
 		oColumn:oCell:nVAlign	 := nVAlign				// 23 
 		oColumn:oCell:nVertText	 := nVertText				// 24 
 		oColumn:oCell:nClrTo	 := nClrTo				// 25 
 		oColumn:oCell:lOpaque	 := lOpaque				// 26 
 		oColumn:oCell:hBrush	 := iif( lBrush, nClrBack:hBrush, 0 )	// 27 
 		oColumn:oCell:l3DText	 := l3DText				// 28  3D text 
 		oColumn:oCell:nClr3dL	 := nClr3dL				// 29  3D text light color 
 		oColumn:oCell:nClr3dS	 := nClr3dS				// 30  3D text shadow color 
 		oColumn:oCell:nCursor	 := nCursor				// 31  Rect cursor 
 		oColumn:oCell:lInvertColor := !(::lCellBrw .and. nJ != ::nCell) // 32  Invert color 
  
 			If lDrawCell .and. ::lDrawLine 
 				lDraw := ::TSDrawCell( oColumn:oCell, oColumn ) 
 			Else 
 				lDraw := .T. 
 			EndIf 
  
 			nStartCol += aColSizes[ nJ ] + nDeltaLen 
  
 			If lDraw 
 				AAdd( ::aDrawCols, nJ ) 
 			EndIf 
  
 		Next 
  
 	EndIf 
  
 	If ::bOnDraw != Nil 
 		Eval( ::bOnDraw, Self ) 
 	EndIf 
  
 	If ::lCellBrw 
 		cMsg := iif( ! Empty( ::AColumns[ ::nCell ]:cMsg ), ::AColumns[ ::nCell ]:cMsg, ::cMsg ) 
 		cMsg := iif( ValType( cMsg ) == "B", Eval( cMsg, Self, ::nCell ), cMsg ) 
  
 		If ! Empty( cMsg ) 
 			::SetMsg( cMsg ) 
 		EndIf 
 	EndIf 
  
 	::lDrawSelect := .F. 
  
 Return Self

Haz
администратор
Пост N: 1649 Зарегистрирован: 20.02.11

Отправлено: 08.10.20 13:41. Заголовок: сделал все таки так ..

сделал все таки так

 
 METHOD Refresh( lPaint, lRecount, lClearHash ) CLASS TSBrowse  
  
 	Default lPaint	:= .T., ; 
   	        lRecount := .F.,; 
                 lClearHash := .T.  
  
         IF lClearHash 
            ::aFastDrawCell := hb_Hash() 
         EndIf 
  
 	If ::lFirstPaint == Nil .or. ::lFirstPaint 
 		Return 0 
 	EndIf 
  
  
 	If lRecount .or. Empty( ::nLen ) 
 		::nLen := iif( ::lIsDbf, ( ::cAlias )->( Eval( ::bLogicLen ) ), Eval( ::bLogicLen ) ) 
 	EndIf 
  
 	::lNoPaint := .F. 
  
 Return ::Super:Refresh( lPaint ) 
  
  
 METHOD GoLeft() CLASS TSBrowse 
  
 ... 
 		If lDraw 
 			::Refresh( .F.,, .F. )  
 		EndIf 
  
 ... 
  
 		If ::nCell > ( ::nFreeze + 1 ) 
  
 			::nColPos := ::nCell := ::nFreeze + 1 
 			::Refresh( .F.,, .F.)  
  
 			If ::oHScroll != Nil 
 				::oHScroll:GoTop() 
 			EndIf 
  
 		EndIf 
  
  
 METHOD GoRight() CLASS TSBrowse 
  
 		If lRefresh 
 			::lNoPaint := .F. 
 			::Refresh( .F.,,.F.  )  
 		ElseIf ! ::lEditing 
 			::DrawSelect() 
 		EndIf

SergKis
постоянный участник
Пост N: 3450 Зарегистрирован: 17.02.12

Отправлено: 08.10.20 13:59. Заголовок: Haz пишет то есть пр..

Haz пишет

цитата:

то есть пробежаться по всей таблице без прорисовки и получить хаш всей таблицы

Такой вариант есть, я потому и вынес (предложение выше)

 
  			IF ::lFastDrawCell .and. ! lCell  
  				hb_HSet( ::aFastDrawCell, cCell, __objClone( oColumn:oCell ) )  
  			ENDIF  
 за скобки. Делаем как в примерах Tsb_Export_2 
 oBrw:lDrawLine := .F. 
 dbGotop() 
 do while !EOF() 
    oBrw:DrawLine() 
    dbSkip() 
 enddo 
 oBrw:lDrawLine := .T.

hash колонок создан

Haz
администратор
Пост N: 1650 Зарегистрирован: 20.02.11

Отправлено: 08.10.20 14:07. Заголовок: SergKis пишет: Тако..

SergKis пишет:

цитата:

Такой вариант есть, я потому и вынес (предложение выше)

Согласен , можно так сделать через отдельный флаг . Но чуть позже когда общая логика выстроится.
Пока погонял с изменениями на рабочем проекте. Мне нравится тяжелые бровсы с подменными значениями в колонках ожили.

SergKis
постоянный участник
Пост N: 3451 Зарегистрирован: 17.02.12

Отправлено: 08.10.20 14:09. Заголовок: Haz пишет сделал все..

Haz пишет

цитата:

сделал все таки так

По мне, нужен отд. метод и переменная в классе, т.к. можно удалить из hash
- только одну колонку
- все колонки одной строки nAt
- все колонки
Переменную и метод назвать, к примеру
DATA lFastDrawClear AS LOGICAL INIT .T.
METHOD FastDrawClear( ... )
Для начала параметр .T.\.F. потом уточнятся

SergKis
постоянный участник
Пост N: 3452 Зарегистрирован: 17.02.12

Отправлено: 08.10.20 14:53. Заголовок: Haz пишет сделал все..

Haz пишет

цитата:

сделал все таки так

Поправил, попробовал. Работает шустрее тсб

Haz
администратор
Пост N: 1651 Зарегистрирован: 20.02.11

Отправлено: 08.10.20 15:06. Заголовок: SergKis пишет: По м..

SergKis пишет:

цитата:

По мне, нужен отд. метод и переменная в классе, т.к. можно удалить из hash

Выделим в метод, это уже детали , которые дают дополнительный сервис к новому функционалу.
базовую логику можно и так обыграть.

SergKis
постоянный участник
Пост N: 3453 Зарегистрирован: 17.02.12

Отправлено: 08.10.20 15:24. Заголовок: Haz пишет Выделим в ..

Haz пишет

цитата:

Выделим в метод, это уже детали

Но переменную надо уже сейчас добавить

 
    DATA lFastDrawClear AS LOGICAL INIT .T. 
 ... 
 METHOD Refresh( lPaint, lRecount, lClearHash ) CLASS TSBrowse 
  
    Default lPaint := .T., ; 
            lRecount := .F., ; 
            lClearHash := ::lFastDrawClear 
 ...

Haz
администратор
Пост N: 1652 Зарегистрирован: 20.02.11

Отправлено: 08.10.20 18:16. Заголовок: SergKis пишет: Но п..

SergKis пишет:

цитата:

Но переменную надо уже сейчас добавить

Будем считать что она есть

SergKis
постоянный участник
Пост N: 3454 Зарегистрирован: 17.02.12

Отправлено: 08.10.20 19:18. Заголовок: Игорь Ты еще что то ..

Игорь
Ты еще что то правил ?
Я в перерывах на кофе правил, то что писал.
Погонял на примерах, косяков не заметил.
У меня нет проектов на этой версии hmg, надо переносить изменения в свою.
Потому и спрашиваю. Если шевелится, то буду переносить и Григорию для версии положить.

gfilatov2002
moderator
Пост N: 1802 Зарегистрирован: 11.02.10

Отправлено: 08.10.20 19:22. Заголовок: SergKis пишет: Григ..

SergKis пишет:

цитата:

Григорию для версии положить

Заранее благодарен

Погонял текущий hash-вариант на тестовой локальной базе с миллионом записей - вроде, работает нормально

Haz
администратор
Пост N: 1653 Зарегистрирован: 20.02.11

Отправлено: 08.10.20 23:48. Заголовок: SergKis пишет: Ты е..

SergKis пишет:

цитата:

Ты еще что то правил

по мелочам вызовы refresh в методах. Не критично. У меня комп только на работе. Скину завтра номера строк.
Тоже погонял, на рабочем проекте. Пользователи не заметили. Первая бэтка вышла удачной

Haz
администратор
Пост N: 1654 Зарегистрирован: 20.02.11

Отправлено: 08.10.20 23:57. Заголовок: Сергей! Думаю нужны ..

Сергей! Думаю нужны три метода для этого хеша. Это check, refresh и clear возможно как ты предлагал все целиком или по колонкам. И вроде больше добавить нечего. Если только перерисовку ячейки в видимой части бровса при изменении в хеш без изменения фокуса бровса.

SergKis
постоянный участник
Пост N: 3455 Зарегистрирован: 17.02.12

Отправлено: 09.10.20 05:23. Заголовок: gfilatov2002 Сделал..

gfilatov2002
Сделал правки

 
 CLASS TSBrowse FROM TControl 
 ... 
    ACCESS Tsb               INLINE ::oWnd 
    ACCESS nAtPos            INLINE iif( ::lIsDbf, ( ::cAlias )->( RecNo() ), ::nAt ) 
 ... 
 METHOD FastDrawClear( cCell ) CLASS TSBrowse 
  
    LOCAL oCell, oCol 
  
    Default cCell := ::nAtPos 
  
    IF ISNUMERIC( cCell ) ; cCell := hb_ntos( cCell ) 
    ENDIF 
  
    IF ISLOGICAL( cCell ) .and. cCell 
       ::aFastDrawCell := hb_Hash() 
  
    ELSEIF ISCHAR( cCell ) 
       IF "." $ cCell 
          oCell := hb_HGetDef( ::aFastDrawCell, cCell, NIL ) 
          IF oCell != Nil 
             hb_HDel( ::aFastDrawCell, cCell ) 
          ENDIF 
       ELSE 
          FOR EACH oCol IN ::aColumns 
              oCell := hb_HGetDef( ::aFastDrawCell, cCell+"."+hb_ntos( oCol:nId ), NIL ) 
              IF oCell != Nil 
                 hb_HDel( ::aFastDrawCell, cCell+"."+hb_ntos( oCol:nId ) ) 
              ENDIF 
          NEXT 
       ENDIF 
  
    ENDIF 
  
 Return Self 
 ... 
 METHOD Edit( uVar, nCell, nKey, nKeyFlags, cPicture, bValid, nClrFore, nClrBack ) CLASS TSBrowse 
 ... 
    If oCol:bPrevEdit != Nil 
       If ::lIsArr .and. ( ::lAppendMode .or. ::nAt > Len( ::aArray ) ) // append mode for arrays 
       ElseIf nKey != VK_RETURN // GF 15-10-2015 
          uVar := Eval( oCol:bPrevEdit, uValue, Self, nCell, oCol ) 
          If ValType( uVar ) == "L" .and. ! uVar 
             nKey := VK_RETURN 
          EndIf 
       EndIf 
    EndIf 
  
    ::FastDrawClear( hb_ntos( ::nAtPos )+"."+hb_ntos( oCol:nId ) ) 
  
    cMsg := iif( ValType( cMsg ) == "B", Eval( cMsg, Self, nCell ), cMsg ) 
 ... 
 METHOD DrawLine( xRow, lDrawCell ) CLASS TSBrowse 
 ... 
    IF ::lRowPosAtRec 
       IF Empty( ::aRowPosAtRec ) .or. Len( ::aRowPosAtRec ) != ::nRowCount() 
          ::aRowPosAtRec := Array( ::nRowCount() ) 
          AFill( ::aRowPosAtRec, 0 ) 
       ENDIF 
       IF ::nLen == 0 .or. xRow == 0 .or. xRow > Len( ::aRowPosAtRec ) 
       ELSE 
          ::aRowPosAtRec[ xRow ] := ::nAtPos 
       //ELSEIF ::lIsDbf 
       //   ::aRowPosAtRec[ xRow ] := ( nAt := ( ::cAlias )->( RecNo() ) ) 
       //ELSEIF ::lIsArr 
       //   ::aRowPosAtRec[ xRow ] := ( nAt := ::nAt ) 
       ENDIF 
    ENDIF 
  
    If ::nLen > 0 
  
       IF nAt == Nil ; nAt := ::nAtPos // iif( ::lIsDbf, ( ::cAlias )->( RecNo() ), ::nAt ) 
       ENDIF 
 ... 
 METHOD DrawSelect( xRow, lDrawCell ) CLASS TSBrowse 
 ... 
       IF ::lRowPosAtRec 
          IF Empty( ::aRowPosAtRec ) .or. Len( ::aRowPosAtRec ) != ::nRowCount() 
             ::aRowPosAtRec := Array( ::nRowCount() ) 
             AFill( ::aRowPosAtRec, 0 ) 
          ENDIF 
          IF xRow == 0 .or. xRow > Len( ::aRowPosAtRec ) 
          ELSE 
             ::aRowPosAtRec[ xRow ] := ::nAtPos 
          //ELSEIF ::lIsDbf 
          //   ::aRowPosAtRec[ xRow ] := ( nAt := ( ::cAlias )->( RecNo() ) ) 
          //ELSEIF ::lIsArr 
          //   ::aRowPosAtRec[ xRow ] := ( nAt := ::nAt ) 
          ENDIF 
       ENDIF 
 ... 
       IF nAt == Nil ; nAt := ::nAtPos // iif( ::lIsDbf, ( ::cAlias )->( RecNo() ), ::nAt ) 
       ENDIF 
 ... 
          If lDrawCell .and. ::lDrawLine 
             lDraw := ::TSDrawCell( oColumn:oCell, oColumn ) 
          Else 
             lDraw := .T. 
          EndIf 
          IF ::lFastDrawCell .and. ! lCell 
             hb_HSet( ::aFastDrawCell, cCell, __objClone( oColumn:oCell ) ) 
          ENDIF 
  
          nStartCol += aColSizes[ nJ ] + nDeltaLen 
 ...

SergKis
постоянный участник
Пост N: 3456 Зарегистрирован: 17.02.12

Отправлено: 09.10.20 05:30. Заголовок: Haz пишет Думаю нужн..

Haz пишет

цитата:

Думаю нужны три метода для этого хеша. Это check, refresh и clear

Не очень понятны по смыслу check, refresh. Для одной колонки и даже для всей строки - проще удалить чем выяснять или я не учитываю что то.

SergKis
постоянный участник
Пост N: 3457 Зарегистрирован: 17.02.12

Отправлено: 09.10.20 05:48. Заголовок: gfilatov2002 Чуток ..

gfilatov2002
Чуток поправить

 
 METHOD FastDrawClear( cCell ) CLASS TSBrowse 
  
    LOCAL oCell, oCol 
  
    Default cCell := ::nAtPos 
  
    IF ISNUMERIC( cCell ) ; cCell := hb_ntos( cCell ) 
    ENDIF 
  
    IF ! ::lFastDrawCell 
  
    ELSEIF ISLOGICAL( cCell ) .and. cCell 
       ::aFastDrawCell := hb_Hash() 
 ...

kkg

Пост N: 31 Зарегистрирован: 29.11.19

Отправлено: 09.10.20 09:13. Заголовок: SergKis END..

SergKis

цитата:

 
        ENDIF  
  ...  
  METHOD DrawSelect( xRow, lDrawCell ) CLASS TSBrowse  
  ...  
        IF ::lRowPosAtRec .and. ::nRowCount() > 0 
           IF Empty( ::aRowPosAtRec ) .or. Len( ::aRowPosAtRec ) != ::nRowCount()  
              ::aRowPosAtRec := Array( ::nRowCount() )  
              AFill( ::aRowPosAtRec, 0 )  
           ENDIF  
           IF xRow == 0 .or. xRow > Len( ::aRowPosAtRec )  
           ELSE  
              ::aRowPosAtRec[ xRow ] := ::nAtPos  
           //ELSEIF ::lIsDbf  
           //   ::aRowPosAtRec[ xRow ] := ( nAt := ( ::cAlias )->( RecNo() ) )  
           //ELSEIF ::lIsArr  
           //   ::aRowPosAtRec[ xRow ] := ( nAt := ::nAt )  
           ENDIF  
        ENDIF  
  ...

Серж, я ещё такую правку делаю, иначе на пустых выборках слетает

gfilatov2002
moderator
Пост N: 1803 Зарегистрирован: 11.02.10

Отправлено: 09.10.20 09:42. Заголовок: SergKis пишет: Сдел..

SergKis пишет:

цитата:

Сделал правки

OK, принято

SergKis пишет:

цитата:

Чуток поправить

Благодарю за помощь

Haz
администратор
Пост N: 1655 Зарегистрирован: 20.02.11

Отправлено: 09.10.20 10:55. Заголовок: SergKis пишет: Не о..

SergKis пишет:

цитата:

Tsbrowse статичен , то есть это просто отрисованная картинка, а хеш содержит все нобходимые данные для проверки какие ячейки изменились.
С появлением хеша появилась возможность в realtime показывать изменения ячеек другими пользователями по сети без перерисовки всего бровса. Смысл не только в визуальном вау ээфекте, очень часто возникает диалог
- Поменяй !!!
- поменял
- не вижу
- обнови
- как ?
итд

SergKis
постоянный участник
Пост N: 3458 Зарегистрирован: 17.02.12

Отправлено: 09.10.20 10:58. Заголовок: kkg пишет такую прав..

kkg пишет

цитата:

такую правку делаю, иначе на пустых выборках слетает

Надо как в :DrawLine()

 
 METHOD DrawSelect( xRow, lDrawCell ) CLASS TSBrowse 
 ... 
       IF ::lRowPosAtRec 
          IF Empty( ::aRowPosAtRec ) .or. Len( ::aRowPosAtRec ) != ::nRowCount() 
             ::aRowPosAtRec := Array( ::nRowCount() ) 
             AFill( ::aRowPosAtRec, 0 ) 
          ENDIF 
          IF ::nLen == 0 .or. xRow == 0 .or. xRow > Len( ::aRowPosAtRec ) 
          ELSE 
             ::aRowPosAtRec[ xRow ] := ::nAtPos 
          ENDIF 
       ENDIF 
 ...

Haz
администратор
Пост N: 1656 Зарегистрирован: 20.02.11

Отправлено: 09.10.20 11:10. Заголовок: Тут добавил третий п..

Тут добавил третий параметр в ::Refresh()

 
  
 METHOD ChangeFont( hFont, nColumn, nLevel ) CLASS TSBrowse 
 ... 
 	If ::lPainted 
 		SetHeights( Self ) 
 		::Refresh( .F.,,.F. ) 
 	EndIf 
  
 METHOD DelColumn( nPos ) CLASS TSBrowse 
 ... 
 	::SetFocus() 
 	::Refresh( .F.,,.F. ) 
  
  
 METHOD PageDown( nLines ) CLASS TSBrowse 
 ... 
 		If nKeyPressed == Nil 
  
 			::Refresh( ::nLen < nTotLines,, .F. )  
  
 METHOD PageUp( nLines ) CLASS TSBrowse 
 ... 
 	If ::lPageMode .and. ::nRowPos > 1 
  
 		::DrawLine() 
 //		nSkipped := ::Skip( -( ::nRowPos - 1 ) )	 //V90 active 
 		::nRowPos := 1 
 		::Refresh( .F.,,.F. ) 
  
 METHOD PanEnd() CLASS TSBrowse 
 ... 
 	::Refresh( .F. ,, .F.)  
  
 	If ! ::lNoHScroll .and. ::oHScroll != Nil 
  
 METHOD PanLeft() CLASS TSBrowse 
 ... 
 	If ::nCell != ::nOldCell 
 		::Refresh( .F. ,, .F.)  
 	EndIf 
  
 METHOD PanRight() CLASS TSBrowse 
 ... 
 	If ::nCell != ::nOldCell 
 		::Refresh( .F.,, .F. )  
 	EndIf 
  
 METHOD PostEdit( uTemp, nCol, bValid ) CLASS TSBrowse 
 ... 
 		If lAppend .and. ::nLen <= ::nRowCount() 
 			::Refresh( .T. ,, .F.)  
 			::nRowPos := Min( ::nRowCount(), ::nLen ) 
 		EndIf 
  
 METHOD SetNoHoles( nDelta, lSet ) CLASS TSBrowse 
 ... 
 			::Paint() 
 			::lEnabled := .T. 
  
 			::Refresh( .F.,,.F. )

SergKis
постоянный участник
Пост N: 3459 Зарегистрирован: 17.02.12

Отправлено: 09.10.20 11:16. Заголовок: Haz пишет Tsbrowse с..

Haz пишет

цитата:

Tsbrowse статичен , то есть это просто отрисованная картинка, а хеш содержит все нобходимые данные для проверки какие ячейки изменились.

Т.е. пляшем от hash, а не колонок, что то типа такого

 
 Local oCols := oKeyData():aKey := oBrw:aFastDrawCell 
 Local aCols := oCols:GetAll(.F.), aCol, nCol, oCol, cCell 
 Local xData, uData 
 FOR EACH aCol IN aCols 
     cCell := aCol[1] 
     oCol  := aCol[2] 
     xData := oCol:oCell:uValue 
     uData := oBrw:GetValue(oCol:cName) 
     IF xData != uData 
     .... 
     ENDIF 
 NEXT

SergKis
постоянный участник
Пост N: 3460 Зарегистрирован: 17.02.12

Отправлено: 09.10.20 11:21. Заголовок: PS Пропустил переход..

PS
Пропустил переход по записям

 
     nRec := val(left(cCell, At(".", cCell)-1)) 
     (oBrw:cAlias)->( dbGoto(nRec) ) 
     // тут xData, uData

Haz
администратор
Пост N: 1657 Зарегистрирован: 20.02.11

Отправлено: 09.10.20 11:55. Заголовок: SergKis пишет: Т.е...

SergKis пишет:

цитата:

Т.е. пляшем от hash, а не колонок, что то типа такого

да , примерно так

пока не сложилось как понять что oCell принадлежит видимой части ( окну ) бровса

gfilatov2002
moderator
Пост N: 1804 Зарегистрирован: 11.02.10

Отправлено: 09.10.20 11:55. Заголовок: gfilatov2002 пишет: ..

gfilatov2002 пишет:

цитата:

OK, принято

Заметил некорректную работу при активном индексе в базе (зависает при сортировке - двойной клик по заголовку колонки).

Пример для проверки - в папке \SAMPLES\Advanced\Tsb_SpecHeader

Haz
администратор
Пост N: 1658 Зарегистрирован: 20.02.11

Отправлено: 09.10.20 12:51. Заголовок: gfilatov2002 пишет: ..

gfilatov2002 пишет:

цитата:

Заметил некорректную работу при активном индексе в базе (зависает при сортировке - двойной клик по заголовку колонки).

у меня отработало нормально. Может какие правки из последних не учел. Есть где взять со всеми последними изменениями ?
На рабочем проекте тоже переключает индексы нормально

gfilatov2002
moderator
Пост N: 1805 Зарегистрирован: 11.02.10

Отправлено: 09.10.20 13:21. Заголовок: Haz пишет: На рабоч..

Haz пишет:

цитата:

На рабочем проекте тоже переключает индексы нормально

Отлично, значит, мне показалось

Haz пишет:

цитата:

где взять со всеми последними изменениями ?

Выложил здесь
click here

SergKis
постоянный участник
Пост N: 3461 Зарегистрирован: 17.02.12

Отправлено: 09.10.20 13:48. Заголовок: Haz пишет На рабочем..

Haz пишет

цитата:

На рабочем проекте тоже переключает индексы нормально

Соглашусь с Григорием

цитата:

Установил последнюю версию в раб. каталоге (без последних изменений с FastDraw), пример \SAMPLES\Advanced\Tsb_SpecHeader работает странно (меню первое пункт SPECHEADER) не виснет, но сортировка туду-сюда нормально не работает.
В тексте есть

 
       Brw_1:aColumns[ 1 ]:cOrder := "FIRST" 
       Brw_1:aColumns[ 4 ]:cOrder := "CITY" 
       Brw_1:SetAppendMode( .T. ) 
       //Brw_1:SetIndexCols( 1, 2 ) 
  
       Brw_1:SetIndexCols( 1, 4 ) // поправил на 4-ю колонку индекс 
       //Brw_1:SetOrder( 1 ) 
 [pre2] 
 работает при 2 клике по колонкам, но странно. 
 Пример Tsb_addrecord_2 с такими же возможностями 2 клика -> сортировка работает нормально и в версии с FastDraw 
 Правка текста в нем для сортировки туда-обратно, так же работает OK, т.е.[pre2] 
 ... 
        oCol            := oBrw:GetColumn("ID") 
        oCol:cOrder     := "KOD" 
        //oCol:lNoDescend := .T. 
  
        oCol            := oBrw:GetColumn("INFO") 
        oCol:cOrder     := "NAM" 
        //oCol:lNoDescend := .T. 
 ... 
        oBrw:SetIndexCols( oBrw:nColumn("ID"),  ; 
                           oBrw:nColumn("INFO") ) 
        oBrw:SetOrder( oBrw:nColumn("ID") ) 
 ...

SergKis
постоянный участник
Пост N: 3462 Зарегистрирован: 17.02.12

Отправлено: 09.10.20 13:48. Заголовок: Haz пишет На рабочем..

Haz пишет

цитата:

На рабочем проекте тоже переключает индексы нормально

Соглашусь с Григорием

цитата:

 
       Brw_1:aColumns[ 1 ]:cOrder := "FIRST" 
       Brw_1:aColumns[ 4 ]:cOrder := "CITY" 
       Brw_1:SetAppendMode( .T. ) 
       //Brw_1:SetIndexCols( 1, 2 ) 
  
       Brw_1:SetIndexCols( 1, 4 ) // поправил на 4-ю колонку индекс 
       //Brw_1:SetOrder( 1 ) 
 [pre2] 
 работает при 2 клике по колонкам, но странно. 
 Пример Tsb_addrecord_2 с такими же возможностями 2 клика -> сортировка работает нормально и в версии с FastDraw 
 Правка текста в нем для сортировки туда-обратно, так же работает OK, т.е.[pre2] 
 ... 
        oCol            := oBrw:GetColumn("ID") 
        oCol:cOrder     := "KOD" 
        //oCol:lNoDescend := .T. 
  
        oCol            := oBrw:GetColumn("INFO") 
        oCol:cOrder     := "NAM" 
        //oCol:lNoDescend := .T. 
 ... 
        oBrw:SetIndexCols( oBrw:nColumn("ID"),  ; 
                           oBrw:nColumn("INFO") ) 
        oBrw:SetOrder( oBrw:nColumn("ID") ) 
 ...

SergKis
постоянный участник
Пост N: 3463 Зарегистрирован: 17.02.12

Отправлено: 09.10.20 13:52. Заголовок: PS :lFastDrawCell не..

PS
:lFastDrawCell не ставил в .T., т.е. отключена была для тестирования этих примеров

SergKis
постоянный участник
Пост N: 3464 Зарегистрирован: 17.02.12

Отправлено: 09.10.20 14:04. Заголовок: PS2 проверил с :lFas..

PS2
проверил с :lFastDrawCell := .T.
туда-сюда сортировка на колонках работает нормально, версия с изменениями FastDraw

SergKis
постоянный участник
Пост N: 3465 Зарегистрирован: 17.02.12

Отправлено: 09.10.20 14:05. Заголовок: это про пример Tsb_a..

это про пример Tsb_addrecord_2, не туда ткнул

gfilatov2002
moderator
Пост N: 1806 Зарегистрирован: 11.02.10

Отправлено: 09.10.20 14:43. Заголовок: SergKis пишет: прим..

SergKis пишет:

цитата:

пример \SAMPLES\Advanced\Tsb_SpecHeader работает странно

Разобрался и поправил этот пример для правильной работы с индексом NTX.

1) создание индексов д.б.

цитата:

USE Employee SHARED NEW
Index On Employee->First+Employee->Last To Name // NTX
Index On Employee->City To City // NTX
Set Index To Name, City // NTX

2) подключение индексов в зависимости от типа источника данных д.б.

      IF met > 1 
          Brw_1:aColumns[ 1 ]:cOrder := "FIRST" 
          Brw_1:aColumns[ 4 ]:cOrder := "CITY" 
       ELSE 
          Brw_1:aColumns[ 1 ]:cOrder := "Name" 
          Brw_1:aColumns[ 4 ]:cOrder := "City" 
       ENDIF

Теперь пример работает нормально

Haz
администратор
Пост N: 1659 Зарегистрирован: 20.02.11

Отправлено: 09.10.20 14:53. Заголовок: gfilatov2002 пишет: ..

gfilatov2002 пишет:

цитата:

Теперь пример работает нормально

попереключал сортировку в своем проекте с последними изменениям - все отлично работает. Видимо в примере действительно проблема была

SergKis
постоянный участник
Пост N: 3466 Зарегистрирован: 17.02.12

Отправлено: 09.10.20 19:39. Заголовок: Haz пишет пока не сл..

Haz пишет

цитата:

пока не сложилось как понять что oCell принадлежит видимой части ( окну ) бровса

Так в теории будет выглядеть функция (метод такой вряд ли нужен, слишком много вариантов, что можно делать)

 
 FUNC FastDrawCheck( oBrw ) 
  Local oCols := oKeyData():aKey := hb_HSort( oBrw:aFastDrawCell ) 
  Local aCols := oCols:GetAll(.F.) 
  Local cAls  := oBrw:cAlias 
  Local aCol, nCol, oCol, cCell 
  Local xData, uData, nRec 
  Local lVisi, lEque 
  
  FOR EACH aCol IN aCols  
      cCell := aCol[1]  
      oCol  := aCol[2]  
      nRec  := val( left(cCell, At(".", cCell)-1) )  
      lEque := .F. 
      lVisi := .F. 
      uData := Nil 
      xData := oCol:oCell:uValue  
      If nRec != (cAls)->( RecNo() )  
         (cAls)->( dbGoto(nRec) )  
      EndIf 
      If nRec == (cAls)->( RecNo() )  
         uData := oBrw:GetValue(oCol:cName)  
         lEque := xData == uData  
         lVisi := AScan( oBrw:aRowPosAtRec, nRec ) > 0  // видимость на екране 
         IF ! lEque 
            // ... 
         ENDIF  
         IF lVisi 
            // ... 
         ENDIF  
      EndIf 
      AAdd( aCol, lVisi ) 
      AAdd( aCol, lEque ) 
      AAdd( aCol, xData ) 
      AAdd( aCol, uData ) 
  NEXT  
  
 RETURN aCols

SergKis
постоянный участник
Пост N: 3467 Зарегистрирован: 17.02.12

Отправлено: 09.10.20 21:08. Заголовок: gfilatov2002 Посмот..

gfilatov2002
Посмотрел h_tbrowse.zip, небольшие правки

 
 METHOD DrawLine( xRow, lDrawCell ) CLASS TSBrowse 
 ... 
    IF ::lRowPosAtRec 
       IF Empty( ::aRowPosAtRec ) .OR. Len( ::aRowPosAtRec ) != ::nRowCount() 
          ::aRowPosAtRec := Array( ::nRowCount() ) 
          AFill( ::aRowPosAtRec, 0 ) 
       ENDIF 
       IF ::nLen == 0 .OR. xRow == 0 .OR. xRow > Len( ::aRowPosAtRec ) 
       ELSE 
          ::aRowPosAtRec[ xRow ] := ( nAt := ::nAtPos ) 
       ENDIF 
    ENDIF 
 ... 
 Не обязательно, но так лучше - убрать лишнее 
          IF Empty( oColumn:oCell ) 
             oColumn:oCell := TSBcell():New() 
          ENDIF 
  
          oCell := oColumn:oCell 
          oCell:nRow := xRow 
          oCell:nCol := nStartCol 
 ... 
          oCell:nCursor := 0 // 31  Rect cursor 
          oCell:lInvertColor := .F. // 32  Invert color 
 ... 
 METHOD DrawSelect( xRow, lDrawCell ) CLASS TSBrowse 
 ... 
       IF ::lRowPosAtRec .AND. Len( ::nRowCount() ) > 0 
          IF Empty( ::aRowPosAtRec ) .OR. Len( ::aRowPosAtRec ) != ::nRowCount() 
             ::aRowPosAtRec := Array( ::nRowCount() ) 
             AFill( ::aRowPosAtRec, 0 ) 
          ENDIF 
          IF ::nLen == 0 .or. xRow == 0 .OR. xRow > Len( ::aRowPosAtRec ) 
          ELSE 
             ::aRowPosAtRec[ xRow ] := ( nAt := ::nAtPos ) 
          ENDIF 
       ENDIF 
 ... 
          IF Empty( oColumn:oCell ) 
             oColumn:oCell := TSBcell():New() 
          ENDIF 
  
          oCell := oColumn:oCell 
          oCell:nRow := nRowPos 
          oCell:nCol := nStartCol 
 ... 
          oCell:nCursor := nCursor // 31  Rect cursor 
          oCell:lInvertColor := !( ::lCellBrw .AND. nJ != ::nCell ) // 32  Invert color

SergKis
постоянный участник
Пост N: 3468 Зарегистрирован: 17.02.12

Отправлено: 09.10.20 21:08. Заголовок: gfilatov2002 Посмот..

gfilatov2002
Посмотрел h_tbrowse.zip, небольшие правки

 
 METHOD DrawLine( xRow, lDrawCell ) CLASS TSBrowse 
 ... 
    IF ::lRowPosAtRec 
       IF Empty( ::aRowPosAtRec ) .OR. Len( ::aRowPosAtRec ) != ::nRowCount() 
          ::aRowPosAtRec := Array( ::nRowCount() ) 
          AFill( ::aRowPosAtRec, 0 ) 
       ENDIF 
       IF ::nLen == 0 .OR. xRow == 0 .OR. xRow > Len( ::aRowPosAtRec ) 
       ELSE 
          ::aRowPosAtRec[ xRow ] := ( nAt := ::nAtPos ) 
       ENDIF 
    ENDIF 
 ... 
 Не обязательно, но так лучше - убрать лишнее 
          IF Empty( oColumn:oCell ) 
             oColumn:oCell := TSBcell():New() 
          ENDIF 
  
          oCell := oColumn:oCell 
          oCell:nRow := xRow 
          oCell:nCol := nStartCol 
 ... 
          oCell:nCursor := 0 // 31  Rect cursor 
          oCell:lInvertColor := .F. // 32  Invert color 
 ... 
 METHOD DrawSelect( xRow, lDrawCell ) CLASS TSBrowse 
 ... 
       IF ::lRowPosAtRec .AND. Len( ::nRowCount() ) > 0 
          IF Empty( ::aRowPosAtRec ) .OR. Len( ::aRowPosAtRec ) != ::nRowCount() 
             ::aRowPosAtRec := Array( ::nRowCount() ) 
             AFill( ::aRowPosAtRec, 0 ) 
          ENDIF 
          IF ::nLen == 0 .or. xRow == 0 .OR. xRow > Len( ::aRowPosAtRec ) 
          ELSE 
             ::aRowPosAtRec[ xRow ] := ( nAt := ::nAtPos ) 
          ENDIF 
       ENDIF 
 ... 
          IF Empty( oColumn:oCell ) 
             oColumn:oCell := TSBcell():New() 
          ENDIF 
  
          oCell := oColumn:oCell 
          oCell:nRow := nRowPos 
          oCell:nCol := nStartCol 
 ... 
          oCell:nCursor := nCursor // 31  Rect cursor 
          oCell:lInvertColor := !( ::lCellBrw .AND. nJ != ::nCell ) // 32  Invert color

SergKis
постоянный участник
Пост N: 3469 Зарегистрирован: 17.02.12

Отправлено: 09.10.20 21:10. Заголовок: Опять 2а раза отправ..

Опять 2а раза отправилось

gfilatov2002
moderator
Пост N: 1807 Зарегистрирован: 11.02.10

Отправлено: 09.10.20 21:14. Заголовок: SergKis пишет: METH..

SergKis пишет:

цитата:

METHOD DrawSelect( xRow, lDrawCell ) CLASS TSBrowse
...
IF ::lRowPosAtRec .AND. Len( ::nRowCount() ) > 0
IF Empty( ::aRowPosAtRec ) .OR. Len( ::aRowPosAtRec ) != ::nRowCount()
::aRowPosAtRec := Array( ::nRowCount() )
AFill( ::aRowPosAtRec, 0 )
ENDIF
IF ::nLen == 0 .or. xRow == 0 .OR. xRow > Len( ::aRowPosAtRec )

Эта правка не нужна, поскольку выше по тексту уже идет проверка:

цитата:

ELSEIF ::nLen > 0

SergKis
постоянный участник
Пост N: 3470 Зарегистрирован: 17.02.12

Отправлено: 10.10.20 11:28. Заголовок: Игорь Уточнение по в..

Игорь
Уточнение по видимости колонки
lVisi := AScan( oBrw:aRowPosAtRec, nRec ) > 0 .and. AScan( oBrw:aDrawCols, oBrw:nColumn(oCol:cName) ) // видимость

kkg

Пост N: 32 Зарегистрирован: 29.11.19

Отправлено: 10.10.20 14:44. Заголовок: gfilatov2002 Григор..

gfilatov2002
Григорий, пересмотрел изменения которые я вношу, возможно данное примете в стандарт
если будет интересно сообществу
HbXlsXml
Скрытый текст

 
 CREATE CLASS ExcelWriterXML_Sheet 
  
    VAR    id 
    VAR    aAddSheet                               INIT {} 
    VAR    cells                                   INIT { => } 
    VAR    colWidth                                INIT { => } 
 ... 
  
 METHOD ExcelWriterXML_Sheet:getSheetXML( handle ) 
 ... 
    xml += "   </Table>" + hb_eol() 
  
    if valtype(::aAddSheet) == 'A' .and. len(::aAddSheet)>0 
      for ir = 1 to len(::aAddSheet) 
        xml +=  ::aAddSheet[ir] + hb_eol() 
      next 
    endif 
  
    xml += "</Worksheet>" + hb_eol() 
 ... 
  
 я  использую для передачи "заморозки" шапки, nFreeze и АвтоФильтра 
  
 aadd(oSh,'  <WorksheetOptions xmlns="urn:schemas-microsoft-com:office:excel">') 
 aadd(oSh,'   <Unsynced/>') 
 aadd(oSh,'   <FreezePanes/>') 
 aadd(oSh,'   <FrozenNoSplit/>') 
 aadd(oSh,'   <SplitHorizontal>+[номер строки]+</SplitHorizontal>') 
 aadd(oSh,'   <TopRowBottomPane>+[номер строки]+</TopRowBottomPane>') 
 aadd(oSh,'   <SplitVertical>'+[номер колонки]+'</SplitVertical>') 
 aadd(oSh,'   <LeftColumnRightPane>'+[номер колонки]+'</LeftColumnRightPane>') 
 aadd(oSh,'   <ActivePane>0</ActivePane>') 
 aadd(oSh,'   <Panes>') 
 aadd(oSh,'    <Pane>') 
 aadd(oSh,'     <Number>3</Number>') 
 aadd(oSh,'    </Pane>') 
 aadd(oSh,'    <Pane>') 
 aadd(oSh,'     <Number>1</Number>') 
 aadd(oSh,'     <ActiveCol>2</ActiveCol>') 
 aadd(oSh,'    </Pane>') 
 aadd(oSh,'    <Pane>') 
 aadd(oSh,'     <Number>2</Number>') 
 aadd(oSh,'    </Pane>') 
 aadd(oSh,'    <Pane>') 
 aadd(oSh,'     <Number>0</Number>') 
 aadd(oSh,'     <ActiveCol>0</ActiveCol>') 
 aadd(oSh,'    </Pane>') 
 aadd(oSh,'   </Panes>') 
 aadd(oSh,'   <ProtectObjects>False</ProtectObjects>') 
 aadd(oSh,'   <ProtectScenarios>False</ProtectScenarios>') 
 aadd(oSh,'  </WorksheetOptions>') 
  
 aadd(oSh,'  <AutoFilter x:Range="R+[строка]+C+[колонка]+:R+[строка]+C'+[колонка]+'" xmlns="urn:schemas-microsoft-com:office:excel">') 
 aadd(oSh,'  </AutoFilter>')

kkg

Пост N: 33 Зарегистрирован: 29.11.19

Отправлено: 10.10.20 22:43. Заголовок: gfilatov2002 пересо..

gfilatov2002
пересобрал с последними изменениями есть поправка

 
 METHOD DrawSelect( xRow, lDrawCell ) CLASS TSBrowse 
 ... 
 [4622]  IF ::lRowPosAtRec  .AND. ::nRowCount() > 0  // без len()

gfilatov2002
moderator
Пост N: 1808 Зарегистрирован: 11.02.10

Отправлено: 11.10.20 14:30. Заголовок: kkg пишет: есть поп..

kkg пишет:

цитата:

есть поправка

Принято

SergKis
постоянный участник
Пост N: 3476 Зарегистрирован: 17.02.12

Отправлено: 13.10.20 16:35. Заголовок: Haz пишет предлагаю ..

Haz пишет

цитата:

предлагаю добавить

Игорь, а чем не подошло
METHOD FastDrawClear( cCell ) CLASS TSBrowse
описанный выше
cCell := .T. - очищает hash
cCell := :nAtPos - удаляет колонки строки заданной
cCell := hb_ntos(:nAtPos)+"."+hb_ntos( oCol:nId ) - удаляет колонку

SergKis
постоянный участник
Пост N: 3477 Зарегистрирован: 17.02.12

Отправлено: 13.10.20 16:39. Заголовок: PS Например AEval(oB..

PS
Например
AEval(oBrw:aRowPosAtRec, {|nat| oBrw:FastDrawClear(nat) })
удалит все колонки для строк, участвующих в Refresh()

Haz
администратор
Пост N: 1661 Зарегистрирован: 20.02.11

Отправлено: 13.10.20 16:55. Заголовок: SergKis пишет: Игор..

SergKis пишет:

цитата:

Игорь, а чем не подошло

Видимо тем что отвлекался от этой темы ( работы много ) и не обновил у себя исходник. В своем ничего не нашел и быстренько написал.
Метод есть , все устраивает

Удалю пост чтоб не путать

gfilatov2002
moderator
Пост N: 1809 Зарегистрирован: 11.02.10

Отправлено: 15.10.20 13:12. Заголовок: Всем кому это интересно

Подготовил первый RC для новой сборки 20.10

Кратко, что нового:
Скрытый текст

  * Added the new functions for Windows GDI objects memory release. 
     It will activate the GDI objects recording and call CheckRes() 
     to generate the checkres.txt log file on the application quit. 
     Note: This feature will work after setting of debugging mode 
     via the Harbour command Set( _SET_DEBUG, .T. ) or AltD( 1 ). 
  
   * Fixed detected resource leakage of GDI objects at the release of 
     Main form with usage of the new MiniGUI Resources control system. 
  
   * TOOLBAR control: toolbuttons supports an optional ADJUST clause. 
  
   * Revised a hot mouse tracking in the ButtonEx control. 
  
   * Revised a releasing of the AniGif control. 
  
   * Synchronized Extended HMG for compatibility with Official HMG: 
     - COMBOBOXEX supports the optional clause NOTRANSPARENT; 
     - IMAGE CHECKBUTTON supports the optional clause NOTRANSPARENT; 
     - TAB control supports the optional clause NOTRANSPARENT; 
     - TREE control supports the optional clause NOTRANSPARENT. 
  
   * Added the optional color's constants to the header files 
     i_color.ch and i_wincolor.ch. 
  
   * Adaptation FiveWin Class TSBrowse 9.0 in HMG: 
     - added the new variables :lFastDrawCell, :aFastDrawCell and 
       :lFastDrawClear, method :FastDrawClear() for high-speed 
       HASH-based data refreshing in the TSBrowse class; 
       Note: you should set :lFastDrawCell to .T. for switch ON 
       the above mode. 
       Thanks a lot for this GREAT contribution to SergKis and Haz! 
  
   * Updated Sqlite3 library. 
  
   * Added the new interesting samples and updated some examples.

P.S. Желаю всем доброго здоровья и хорошего дня

gfilatov2002
moderator
Пост N: 1810 Зарегистрирован: 11.02.10

Отправлено: 21.10.20 09:16. Заголовок: Опубликована новая с..

Опубликована новая сборка 20.10 для BCC 5.8.2 и компиляторов Harbour и xHarbour.

Базовый дистрибутив находится по адресу

http://hmgextended.com/files/CONTRIB/hmg-20.10-setup.exe

Огромная благодарность Сергею Киселеву и Игорю Назарову за помощь при подготовке этой сборки

SergKis
постоянный участник
Пост N: 3481 Зарегистрирован: 17.02.12

Отправлено: 21.10.20 13:13. Заголовок: gfilatov2002 Поправ..

gfilatov2002
Поправьте, слетает Tsb_DemoMdi при Alt+F4, .т.к. в окнах _HMG_aFormMiscData1[ k ] := {} (может еще где)

 
 FUNCTION ReleaseAllWindows () 
 ... 
          IF Len( _HMG_aFormMiscData1[ i ] ) > 0 .and. _HMG_aFormMiscData1 [ i ] [ 1 ] != NIL 
             DestroyIcon ( _HMG_aFormMiscData1 [ i ] [ 1 ] ) 
          ENDIF 
  
          IF Len( _HMG_aFormMiscData1[ i ] ) > 2 .and. ! Empty ( _HMG_aFormMiscData1 [ i ] [ 3 ] ) 
             DeleteObject ( _HMG_aFormMiscData1 [ i ] [ 3 ] ) 
          ENDIF 
 ...

SergKis
постоянный участник
Пост N: 3482 Зарегистрирован: 17.02.12

Отправлено: 21.10.20 13:27. Заголовок: PS Наверно, надо вст..

PS
Наверно, надо вставить освобождение и в h_events.prg на CASE WM_DESTROY добавить

gfilatov2002
moderator
Пост N: 1811 Зарегистрирован: 11.02.10

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

SergKis пишет:

цитата:

Поправьте, слетает Tsb_DemoMdi при Alt+F4

Поправил, конечно

Благодарю за помощь

P.S. Сделал тихое обновление этой сборки с учетом найденных ошибок...

gfilatov2002
moderator
Пост N: 1812 Зарегистрирован: 11.02.10

Отправлено: 28.10.20 10:23. Заголовок: Выпустил 1-е обновле..

Выпустил 1-е обновление сборки 20.10

Что нового:

Скрытый текст

  * Fixed: Browse control without PICTURE option had a wrong formatting for 
            the fields with negative numbers (introduced in the build 20.05). 
            Bug was reported by Pablo Jalabert. 
            Contributed by Grigory Filatov <gfilatov@inbox.ru> 
            (see demo in folder \samples\Basic\Browse_4) 
   * Fixed: Correction in the Imagelist ADD IMAGE commands. 
            Syntax: 
              ADD IMAGE <image> [ MASK <mask> ] TO <control> OF <parent> 
              ADD MASKEDIMAGE <image> [ COLOR <aColor> ] TO <control> ; 
                OF <parent> 
            Contributed by Grigory Filatov <gfilatov@inbox.ru> 
            (see demo in folder \samples\Basic\TOOLBAR_3) 
   * Enhanced: TOOLBAR control: tool buttons respect the BALLOON style of 
            tooltips and the command SET TOOLTIP [ ACTIVATE ] <ON | OFF>. 
            Requested by Ivanil Marcelino <ivanil/at/linkbr.com.br>. 
            Contributed by Grigory Filatov <gfilatov@inbox.ru> 
            (see demo in folder \samples\Basic\TOOLBAR_2) 
   * Enhanced: ANIGIF control: added support of animated GIF from resources. 
            Requested by Ivanil Marcelino <ivanil/at/linkbr.com.br>. 
            Contributed by Grigory Filatov <gfilatov@inbox.ru> 
            (see demo in folder \samples\Advanced\AniGIF) 
   * Enhanced: BtnTextBox and GetBox controls support Controls Context menu. 
            Requested by Ivanil Marcelino <ivanil/at/linkbr.com.br>. 
            Contributed by Grigory Filatov <gfilatov@inbox.ru> 
   * Modified: Adding the new selected values to the multiple selection Grid 
            was significantly accelerated (noticeable for grids with more than 
            one hundred thousand items). 
            Suggested by HMG user Edward. 
            Contributed by Grigory Filatov <gfilatov@inbox.ru> 
   * New: 'Month Calendar control with the bold days and backcolor' sample. 
            Based upon a contribution of Kevin Carmody <i@kevincarmody.com>. 
            Adapted for Minigui Extended by Grigory Filatov <gfilatov@inbox.ru> 
            (see demo3.prg in folder \samples\Basic\MONTHCAL) 
   * New: 'MiniGUI ToolBar ImageList Demo' sample. 
            Contributed by Grigory Filatov <gfilatov@inbox.ru> 
            (see in folder \samples\Basic\TOOLBAR_3)

gfilatov2002
moderator
Пост N: 1813 Зарегистрирован: 11.02.10

Отправлено: 05.11.20 10:54. Заголовок: Выложил 2-е обновлен..

Выложил 2-е обновление сборки 20.10

В этом обновлении добавил новый элемент управления - PROGRESSWHEEL.

Для его усовершенствования требуется помощь сишника - Петр, сможете помочь

gfilatov2002
moderator
Пост N: 1814 Зарегистрирован: 11.02.10

Отправлено: 06.11.20 17:00. Заголовок: Выложил срочное 3-е ..

Выложил срочное 3-е обновление сборки 20.10

Причина: напутал в функции вычисления цвета градиента для PROGRESSWHEEL

(поправил без помощи Петра).

Также учтены пожелания Андрея для ButtonEx

Andrey
постоянный участник
Пост N: 6837 Зарегистрирован: 12.09.06

Отправлено: 08.11.20 09:26. Заголовок: gfilatov2002 пишет: ..

gfilatov2002 пишет:

цитата:

Также учтены пожелания Андрея для ButtonEx

Спасибо !

gfilatov2002
moderator
Пост N: 1815 Зарегистрирован: 11.02.10

Отправлено: 12.11.20 10:25. Заголовок: Всем кому это интересно :)

Выложил 4-е обновление сборки 20.10 с учетом последних исправлений

Надеюсь, что это последний апдейт для этой сборки

ЗЫ. Выпуск новых сборок больше не планируется...

gfilatov2002
moderator
Пост N: 1816 Зарегистрирован: 11.02.10

Отправлено: 20.11.20 14:22. Заголовок: Всем кому это интересно :)

gfilatov2002 пишет:

цитата:

Выпуск новых сборок больше не планируется...

Пересмотрел свои планы, и решил все же выпустить декабрьскую сборку.

Уже подготовил ее первую бета-версию, изюминкой которой должны стать оригинальные исходники HMG-IDE Роберто Лопеза, которые я адаптировал для Минигуи

Andrey
постоянный участник
Пост N: 6850 Зарегистрирован: 12.09.06

Отправлено: 20.11.20 17:05. Заголовок: gfilatov2002 пишет: ..

gfilatov2002 пишет:

цитата:

Пересмотрел свои планы, и решил все же выпустить декабрьскую сборку.

Отличная новость !

Haz
администратор
Пост N: 1673 Зарегистрирован: 20.02.11

Отправлено: 21.11.20 17:56. Заголовок: gfilatov2002 пишет: ..

gfilatov2002 пишет:

цитата:

Пересмотрел свои планы, и решил все же выпустить

Хорошая новость. Спасибо Григорий

sashaBG
постоянный участник
Пост N: 197 Зарегистрирован: 15.09.05

Отправлено: 25.11.20 15:14. Заголовок: Здравствуте!

У меня вопрос по TSBrowse в Select mode.
Есть необходимость выбрать все строки TSBrowse , нажатием клавишили .

Я думаю надо заполнить самому масив ::aSelected
а потом вызвать ::DrawSelect()

Подскажите пожалуйста, если есть другой способ!

Будьте здоровы!

Dima
администратор
Пост N: 7253 Зарегистрирован: 17.05.05

Отправлено: 25.11.20 17:33. Заголовок: sashaBG Заполняешь ..

sashaBG
Заполняешь некий массив номерами записей (у меня HASH) , после делаем Refresh
В описании бровса у меня
obrwloc:SetColor( { 1 ,2}, { CLR_BLACK ,{||if(!hb_hhaskey(hinsrec,(obrwloc:calias)->(recno())),rgb(255,255,206),rgb(255,179,255))} } )

SergKis
постоянный участник
Пост N: 3508 Зарегистрирован: 17.02.12

Отправлено: 25.11.20 17:43. Заголовок: sashaBG пишет потом ..

sashaBG пишет

цитата:

потом вызвать ::DrawSelect()

Потом надо вызвать :Refresh(), т.к. надо перепоказать все строки.
Другой способ используя hash или в режиме set oop on

 
    oCol := :GetColumn("ID") 
    oCol:Cargo:oSelect := oKeyData()  // hb_Hash() 
    oCol:nClrBack := {|at,nc,br,oc| oc := br:aColumns[nc], at := oc:Cargo:oSelect:Get(br:nAtPos, 0), ; 
       iif( at > 0, CLR_BLUE, CLR_WHITE  ) }   // меняем цвет в колонке от наличия номера записи в :Cargo:oSelect 
    // вместо цвета можно менять bmp в колонке, цвет взял для просто меньше писать 
    ... 
    :UserKeys( VK_SPACE, {|ob,nr,oc|    // Select\UnSelect  
        oc := ob:GetColumn("ID") 
        nr := oc:Cargo:oSelect:Get((ob:nAtPos, 0) 
        If nr > 0 
           oc:Cargo:oSelect:Del(ob:nAtPos) 
        Else 
           oc:Cargo:oSelect:Set(ob:nAtPos, ob:nAtPos) 
        EndIf 
        ob:DrawSelect() 
        do events 
        Return Nil 
       } 
    :UserKeys( VK_F2, {|ob|             // Select All 
        Local cAls := ob:cAlias, nRec 
        Local nOld := (cAls)->(RecNo()) 
        Local oc := ob:GetColumn("ID") 
        oc:Cargo:oSelect:oKeyData() 
        do while (cAls)->( !EOF() ) 
             nRec := (cAls)->(RecNo()) 
             oc:Cargo:oSelect:Set(nRec, nRec) 
             (cAls)->(dbSkip()) 
        enddo 
        (cAls)->(dbGoto(nOld)) 
        Return Nil 
       } 
    :UserKeys( VK_F3, {|ob|            // Get values all Selected line       
        Local oc := ob:GetColumn("ID") 
        ?  "aSelected =", oc:Cargo:oSelect:GetAll(.F.) 
        ?v oc:Cargo:oSelect:GetAll(.F.) 
        ? 
        Return Nil 
       }

Написанное применимо к любой колонке и не имеет значения находится TSBrowse в Select mode или нет
С hash похожие действия

SergKis
постоянный участник
Пост N: 3509 Зарегистрирован: 17.02.12

Отправлено: 25.11.20 20:28. Заголовок: PS добавить надо ..

PS
добавить надо

 
     :UserKeys( VK_F2, {|ob|             // Select All  
     ... 
         (cAls)->(dbGoto(nOld))  
         ob:Refresh() 
         do events 
         Return Nil  
        }

sashaBG
постоянный участник
Пост N: 198 Зарегистрирован: 15.09.05

Отправлено: 26.11.20 21:45. Заголовок: Спасибо!

Сапсибо Сергей, работает!

SergKis
постоянный участник
Пост N: 3510 Зарегистрирован: 17.02.12

Отправлено: 27.11.20 11:15. Заголовок: sashaBG пишет работа..

sashaBG пишет

цитата:

работает!

Добавка в пример Tsb_BitMaps для работы с bmp индикацией (клавиши: SPACE, F2, F3, F5)

 
 LOCAL oCol 
 SET OOP ON 
 ... 
        oBrw:GetColumn("FLD7"):lBitMap  := .T. 
        oBrw:aBitMaps := { LoadImage(".\RES\flag_bel.bmp"), ; 
                           LoadImage(".\RES\flag_en.bmp" ), ; 
                           LoadImage(".\RES\flag_kaz.bmp"), ; 
                           LoadImage(".\RES\flag_ru.bmp" ), ; 
                           LoadImage(".\RES\flag_ua.bmp" ), ; 
                           StockBmp( 7 )                  , ; 
                           StockBmp( 6 )                    ; 
                         } 
  
        oCol := :GetColumn("ID") 
        oCol:Cargo := oKeyData() 
        oCol:Cargo:oSelect := oKeyData() 
        oCol:uBmpCell := {|nc,ob| 
           Local oc := ob:aColumns[ nc ] 
           Local nr := oc:Cargo:oSelect:Get(ob:nAtPos, 0) 
           Return ob:aBitMaps[ 6+nr ] 
          } 
       :UserKeys( VK_SPACE, {|ob|                           // Select\unSelect 
           Local oc := ob:GetColumn("ID") 
           Local nr := ob:nAtPos, np 
           If ( np := oc:Cargo:oSelect:Get(nr, 0) ) > 0 
              oc:Cargo:oSelect:Del(nr) 
           Else 
              oc:Cargo:oSelect:Set(nr, 1) 
           EndIf 
           ob:DrawSelect() ; DO EVENTS 
           Return Nil 
          } ) 
       :UserKeys( VK_F2, {|ob|                              // Select all 
           Local cAls := ob:cAlias, nRec 
           Local nOld := (cAls)->(RecNo()) 
           Local oc := ob:GetColumn("ID") 
           oc:Cargo:oSelect:oKeyData() 
           (cAls)->(dbGotop()) 
           do while (cAls)->( !EOF() ) 
                nRec := (cAls)->(RecNo()) 
                oc:Cargo:oSelect:Set(nRec, 1) 
                (cAls)->(dbSkip()) 
           enddo 
           (cAls)->(dbGoto(nOld)) 
           ob:Refresh() ; DO EVENTS 
           Return Nil 
          } ) 
       :UserKeys( VK_F3, {|ob|                              // unSelect all 
           Local oc := ob:GetColumn("ID") 
           oc:Cargo:oSelect := oKeyData() 
           ob:Refresh() ; DO EVENTS 
           Return Nil 
          } ) 
     :UserKeys( VK_F5, {|ob|                               // Get values all Selected line 
         Local oc := ob:GetColumn("ID") 
         Local ar := oc:Cargo:oSelect:GetAll(.F.) 
         Local nk := Len(ar) 
         Local cs := "", ni 
         For ni := 1 To nk 
             cs += hb_ValToExp(ar[ ni ]) + iif( ni == nk, "", ";" ) 
         Next 
         AlertInfo( "Selected : "+iif( Empty(cs), "0", ";"+cs ) ) 
         Return Nil 
        } ) 
  
     ON KEY ESCAPE ACTION ThisWindow.Release 
 ...

gfilatov2002
moderator
Пост N: 1817 Зарегистрирован: 11.02.10

Отправлено: 27.11.20 12:11. Заголовок: SergKis пишет: Доба..

SergKis пишет:

цитата:

Добавка в пример Tsb_BitMaps

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

SergKis
постоянный участник
Пост N: 3511 Зарегистрирован: 17.02.12

Отправлено: 27.11.20 14:07. Заголовок: gfilatov2002 Малень..

gfilatov2002
Маленькая правка

 
       :UserKeys( VK_F2, {|ob|                              // Select all 
           ... 
           oc:Cargo:oSelect := oKeyData() 
           ...

gfilatov2002
moderator
Пост N: 1818 Зарегистрирован: 11.02.10

Отправлено: 27.11.20 15:02. Заголовок: SergKis пишет: Мале..

SergKis пишет:

цитата:

Маленькая правка

SergKis
постоянный участник
Пост N: 3522 Зарегистрирован: 17.02.12

Отправлено: 02.12.20 11:13. Заголовок: gfilatov2002 Добавь..

gfilatov2002
Добавьте в пример выше строки

 
        oCol := :GetColumn("ID") 
        oCol:Cargo := oKeyData() 
        oCol:Cargo:oSelect := oKeyData() 
        oCol:Cargo:nSeleBack := CLR_YELLOW 
        oCol:Cargo:aSeleBack := { RGB(220, 220, 220), RGB(220, 220, 220) } 
  
        oCol:uBmpCell := {|nc,ob| 
           Local oc := ob:aColumns[ nc ] 
           Local nr := oc:Cargo:oSelect:Get(ob:nAtPos, 0) 
           Return ob:aBitMaps[ 6+nr ] 
          } 
        oCol:nClrBack := {|na,nc,ob| 
           Local oc := ob:aColumns[ nc ] 
           na := oc:Cargo:oSelect:Get(ob:nAtPos, 0) 
           Return iif( na > 0, oc:Cargo:nSeleBack, ob:nClrPane ) 
          } 
        oCol:nClrFocuBack := {|na,nc,ob| 
           Local oc := ob:aColumns[ nc ] 
           na := oc:Cargo:oSelect:Get(ob:nAtPos, 0) 
           Return iif( na > 0, oc:Cargo:nSeleBack, oc:Cargo:aSeleBack ) 
          } 
  
        :nFreeze := 1 
        :lLockFreeze := .T. 
        :nCell := :nFreeze + 1 
  
       :UserKeys( VK_SPACE, {|ob|                           // Select\unSelect 
 ...

gfilatov2002
moderator
Пост N: 1819 Зарегистрирован: 11.02.10

Отправлено: 02.12.20 11:32. Заголовок: ОК :sm36: Благодарю..

ОК

Благодарю за помощь

gfilatov2002
moderator
Пост N: 1820 Зарегистрирован: 11.02.10

Отправлено: 02.12.20 12:12. Заголовок: Всем кому это интересно :)

Подготовил 2-й RC для новой сборки 20.12

Что нового (кратко):
Скрытый текст

  * Fixed: A support of use the Harbour pcode DLL was broken in the 
     MiniGUI core (introduced in the build 16.12). 
  
   * Fixed: Possible program crash at releasing of the standard 
     'Image Button' control with NOXPSTYLE clause (introduced in the 
     build 16.03). 
  
   * Synchronized Extended HMG for compatibility with Official HMG: 
     - misc updates for a correct compiling of the HMG-IDE tool. 
  
   * 'HMG IDE' sample: code was modified to original source of utility. 
     Based upon a contribution of HMG Founder Roberto Lopez. 
     Thanks a lot for this GREAT contribution! 
  
   * Updated HMGS-IDE v.1.4.4.3, BosTaurus and Sqlite3 libraries. 
  
   * Added the new interesting samples and updated some examples. 
  
   * Added the ProcInfo and Selector libraries source code. 
     Note: 
     It is available in the mingw64-based donationware distribution 
     only.

gfilatov2002
moderator
Пост N: 1821 Зарегистрирован: 11.02.10

Отправлено: 08.12.20 11:54. Заголовок: Всем кому это интересно 8-)

Завершена подготовка декабрьской сборки, которая будет опубликована послезавтра.

Рассматриваю эту сборку как финальную во всех отношениях...

gfilatov2002
moderator
Пост N: 1822 Зарегистрирован: 11.02.10

Отправлено: 10.12.20 11:48. Заголовок: Выложил декабрьскую ..

Выложил декабрьскую сборку по адресу:

http://hmgextended.com/files/CONTRIB/hmg-20.12-setup.exe

Желаю всем мира, добра и здоровья

Dima
администратор
Пост N: 7256 Зарегистрирован: 17.05.05

Отправлено: 10.12.20 19:16. Заголовок: gfilatov2002 пишет: ..

gfilatov2002 пишет:

цитата:

Выложил декабрьскую сборку по адресу:

Спасибо , я так понял это последняя....
Может и под MINGW выложите ?

gfilatov2002
moderator
Пост N: 1823 Зарегистрирован: 11.02.10

Отправлено: 10.12.20 19:37. Заголовок: Dima пишет: Может и..

Dima пишет:

цитата:

Может и под MINGW выложите ?

Посмотри в личке...

Andrey
постоянный участник
Пост N: 6855 Зарегистрирован: 12.09.06

Отправлено: 11.12.20 08:41. Заголовок: gfilatov2002 пишет: ..

gfilatov2002 пишет:

цитата:

Выложил декабрьскую сборку по адресу:

* New: 'Get Text Width Test' sample. 
            Based upon a contribution at official HMG forum. 
            Adapted for Minigui Extended by Grigory Filatov <gfilatov@inbox.ru> 
            (see in folder \samples\Basic\GetTextWidth)

Давно использую функции Сергея:

FUNCTION GetTxtWidth( cText, nFontSize, cFontName, lBold )  // получить Width текста 
    LOCAL hFont, nWidth 
    DEFAULT cText     := REPL('A', 2)        ,  ; 
            cFontName := _HMG_DefaultFontName,  ;   // из MiniGUI.Init() 
            nFontSize := _HMG_DefaultFontSize,  ;   // из MiniGUI.Init() 
            lBold     := .F. 
  
    IF Valtype(cText) == 'N' 
       cText := repl('A', cText) 
    ENDIF 
  
    hFont  := InitFont(cFontName, nFontSize, lBold) 
    nWidth := GetTextWidth(0, cText, hFont)         // ширина текста 
    DeleteObject (hFont) 
  
    RETURN nWidth 
  
 FUNCTION GetTxtHeight( cText, nFontSize, cFontName, lBold )  // получить Height текста 
    LOCAL hFont, nHeight 
    DEFAULT cText     := "B"                 ,  ; 
            cFontName := _HMG_DefaultFontName,  ;   // из MiniGUI.Init() 
            nFontSize := _HMG_DefaultFontSize,  ;   // из MiniGUI.Init() 
            lBold     := .F. 
  
    hFont := InitFont( cFontName, nFontSize, lBold ) 
    nHeight := GetTextHeight( 0, cText , hFont )    // высота шрифта 
    DeleteObject( hFont ) 
  
    RETURN nHeight

Григорий, можно сделать совместить функции Сергея и новых функции ?

Dima
администратор
Пост N: 7257 Зарегистрирован: 17.05.05

Отправлено: 11.12.20 10:55. Заголовок: Andrey пишет: Давно..

Andrey пишет:

цитата:

Давно использую функции Сергея

Юзай и дальше

Andrey пишет:

цитата:

Григорий, можно сделать совместить функции Сергея и новых функции ?

Новые функции не в ядре а в примерах , зачем совмещать что то ?

Andrey
постоянный участник
Пост N: 6856 Зарегистрирован: 12.09.06

Отправлено: 11.12.20 12:05. Заголовок: Хотелось бы иметь эт..

Хотелось бы иметь эти функции в ядре !

Замучился таскать их из проекта в проект.
Да и маленькие примеры если делаешь, то опять нужно тащить эту функцию в пример.

Dima пишет:

цитата:

Новые функции не в ядре а в примерах , зачем совмещать что то ?

Да в ядре уже - смотри C:\MiniGUI\SOURCE\c_controlmisc.c

SergKis
постоянный участник
Пост N: 3540 Зарегистрирован: 17.02.12

Отправлено: 11.12.20 12:54. Заголовок: Andrey пишет Замучил..

Andrey пишет

цитата:

Замучился таскать их из проекта в проект.

Используй, например, такой вариант. Сделай свой ch file в Include каталоге
i_MySets.ch
--------------

 
 /* my ch */ 
  
 #xtranslate IsFile( <f> )   =>  hb_FileExists( <f> ) 
  
 FUNCTION GetTxtWidth( cText, nFontSize, cFontName, lBold )  // получить Width текста  
    LOCAL hFont, nWidth  
    DEFAULT cText     := REPL('A', 2)        ,  ;  
            cFontName := _HMG_DefaultFontName,  ;   // из MiniGUI.Init()  
            nFontSize := _HMG_DefaultFontSize,  ;   // из MiniGUI.Init()  
            lBold     := .F.  
   
    IF Valtype(cText) == 'N'  
       cText := repl('A', cText)  
    ENDIF  
   
    hFont  := InitFont(cFontName, nFontSize, lBold)  
    nWidth := GetTextWidth(0, cText, hFont)         // ширина текста  
    DeleteObject (hFont)  
   
    RETURN nWidth  
   
 FUNCTION GetTxtHeight( cText, nFontSize, cFontName, lBold )  // получить Height текста  
    LOCAL hFont, nHeight  
    DEFAULT cText     := "B"                 ,  ;  
            cFontName := _HMG_DefaultFontName,  ;   // из MiniGUI.Init()  
            nFontSize := _HMG_DefaultFontSize,  ;   // из MiniGUI.Init()  
            lBold     := .F.  
   
    hFont := InitFont( cFontName, nFontSize, lBold )  
    nHeight := GetTextHeight( 0, cText , hFont )    // высота шрифта  
    DeleteObject( hFont )  
   
    RETURN nHeight

А в prg делай
#include <hmg.ch>
#include <i_MySets.ch>
...
Можно в hmg.ch добавить такую строку

SergKis
постоянный участник
Пост N: 3541 Зарегистрирован: 17.02.12

Отправлено: 11.12.20 13:34. Заголовок: PS Т.к. это крайняя ..

PS
Т.к. это крайняя версия hmg (если и будет меняться, то редко) можешь смело в h_tbrowse.prg добавить
#include <i_MySets.ch> // без стр. #xtranslate ...
и пересобрать только tsbrowse.lib
можешь еще свои доп. ф-ии определить в ch file.
Если будет new версия, установишь и снова добавишь в h_tbrowse.prg #include <i_MySets.ch>

Vlad04
постоянный участник
Пост N: 842 Зарегистрирован: 13.10.05

Отправлено: 13.12.20 21:05. Заголовок: gfilatov2002 Было з..

gfilatov2002
Было заявлено

цитата:

исходники HMG-IDE Роберто Лопеза, которые я адаптировал для Минигуи

Где искать ?

gfilatov2002
moderator
Пост N: 1824 Зарегистрирован: 11.02.10

Отправлено: 14.12.20 15:23. Заголовок: Vlad04 пишет: Где и..

Vlad04 пишет:

цитата:

Где искать ?

Посмотри в папке \samples\Advanced\hmgide

Vlad04
постоянный участник
Пост N: 843 Зарегистрирован: 13.10.05

Отправлено: 17.12.20 11:51. Заголовок: BtnTextBox естествен..

BtnTextBox естественно нет ?

gfilatov2002
moderator
Пост N: 1825 Зарегистрирован: 11.02.10

Отправлено: 06.01.21 11:09. Заголовок: gfilatov2002 пишет: ..

gfilatov2002 пишет:

цитата:

Пересмотрел свои планы

Снова пересмотрел свои планы, и решил выпустить январскую сборку (с учетом последних исправлений

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

Скрытый текст

  * Fixed: The symbol fonts were abandoned in the internal function 
     _DefineFont() (introduced in the build 16.12). 
  
   * Fixed: An Image index assigning was ignored in the Grid control 
     with 'ColumnControls' property defined as NIL 
     (introduced in the build 20.06). 
  
   * The command DEFINE FONT <font> FONTNAME <name> ... will delete 
     automatically a previous font definition instead of the error 
     message. 
  
   * Adaptation of MiniGUI core for compatibility with Borland/ 
     Embarcadero C++ 7.20 64-bit compiler. 
  
   * Added the Harbour contrib library for Cabinet file (*.CAB) 
     compression and extraction. 
  
   * Added the binary of HMG IDE tool of Roberto Lopez. 
  
   * Updated SQLite3 library and the some examples.

Andrey
постоянный участник
Пост N: 6872 Зарегистрирован: 12.09.06

Отправлено: 06.01.21 11:35. Заголовок: Отличная новость ! ..

Отличная новость !

Поздравляю всех с Рождеством !

gfilatov2002
moderator
Пост N: 1826 Зарегистрирован: 11.02.10

Отправлено: 19.01.21 11:47. Заголовок: Всем кому это интересно 8-)

Всем кому это интересно

Завершена подготовка новой сборки 21.01 для BCC 5.8.2 и компиляторов Harbour и xHarbour, которая будет опубликована послезавтра.

В основном сборка содержит исправления для обнаруженных недоработок, но есть и новое - добавлена библиотека HbCab для сжатия информации в формате CAB.

gfilatov2002
moderator
Пост N: 1827 Зарегистрирован: 11.02.10

Отправлено: 21.01.21 10:29. Заголовок: Опубликована январск..

Опубликована январская сборка библиотеки, которая доступна по адресу:

http://hmgextended.com/files/CONTRIB/hmg-21.01-setup.exe

Желаю всем удачи в этом году

Andrey
постоянный участник
Пост N: 6873 Зарегистрирован: 12.09.06

Отправлено: 22.01.21 12:46. Заголовок: gfilatov2002 пишет: ..

gfilatov2002 пишет:

цитата:

Опубликована январская сборка библиотеки

Отличная новость!

Пере собрал свою прогу, вроде работает !

Haz
администратор
Пост N: 1675 Зарегистрирован: 20.02.11

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

gfilatov2002 пишет:

цитата:

Опубликована январская сборка

Григорий, спасибо.

Andrey
постоянный участник
Пост N: 6888 Зарегистрирован: 12.09.06

Отправлено: 11.02.21 16:35. Заголовок: Небольшой баг, и я с..

Небольшой баг, и я с ним уже сталкивался.
На форму положили большой LABEL1, далее
если второй LABEL2 (меньшего размера) положить на первый, то нет показа.
Второй LABEL2 беру из другого *.prg
Если положить GETBOX - показ есть, всякие FRAME или CHECKLABEL есть.

Странно...
Если из другого *.prg ставлю так:

 
    @ aWin[1], aWin[2] LABEL Label_2 PARENT &cForm WIDTH aWin[3] HEIGHT nHLbl VALUE "text defect" ; 
        SIZE 14 BOLD FONTCOLOR BLACK BACKCOLOR RED 
     .... 
     FORM_MyDefect(cForm,aTabWin,aBClr,aFont) 
 .... 
 FUNCTION FORM_MyDefect() 
 ... 
    DEFINE TAB Tab_ZDef OF &cForm                            ; 
    ..... 
             @ nRow1, nCol LABEL Label_3 ....  // этот LABEL-3 показывается без PARENT &cForm

Почему LABEL_2 не показывается, а LABEL-3 показывается ?

И у объекта

 
    DEFINE TAB Tab_ZDef OF &cForm                            ; 
       AT nTabRow, nTabCol WIDTH nTabWidth HEIGHT nTabHeight ; 
       VALUE nPgValue BACKCOLOR aTabBColor                   ; 
       FONT cPgFont SIZE nPgFSize BOLD                       ; 
       HOTTRACK HTFORECOLOR BLACK HTINACTIVECOLOR GRAY

Не показываются вкладки !!!

Стоит убрать большой LABEL1 с формы все работает, показ всех объектов есть.

SergKis
постоянный участник
Пост N: 3563 Зарегистрирован: 17.02.12

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

gfilatov2002
Поправил в c_controlmisc.c

 
 HB_FUNC( INSERTVKEY ) 
 { 
    if( hb_parni( 2 ) != NULL ) 
    { 
       keybd_event 
       ( 
          ( BYTE ) hb_parni( 2 ),  // virtual-key code 
          0,                       // hardware scan code 
          0,                       // flags specifying various function options 
          0                        // additional data associated with keystroke 
       ); 
    } 
  
    if( hb_parni( 1 ) != NULL ) 
    { 
       keybd_event 
       ( 
          ( BYTE ) hb_parni( 1 ),     // virtual-key code 
          0, 
          0, 
          0 
       ); 
    } 
  
    if( hb_parni( 2 ) != NULL ) 
    { 
       keybd_event 
       ( 
          ( BYTE ) hb_parni( 2 ),  // virtual-key code 
          0,                       // hardware scan code 
          KEYEVENTF_KEYUP,         // flags specifying various function options 
          0                        // additional data associated with keystroke 
       ); 
    } 
 } 
 для использования с VK_MENU, VK_SHIFT, VK_CONTROL клавишами 
 InsertVKey( , VK_MENU)  // активация строки main menu 
 InsertVKey(VK_V, VK_CONTROL) // Ctrl+V 
 ...

Включил в lib из примеров ф-ии HB_FUNC( SHELLEXECUTEEX ), HB_FUNC( TERMINATEPROCESS )
Скрытый текст

 
 #pragma BEGINDUMP 
  
 #include <windows.h> 
 #include <hbapi.h> 
 #include <shlobj.h> 
  
 HB_FUNC( SHELLEXECUTEEX ) 
 { 
    SHELLEXECUTEINFO SHExecInfo; 
    ZeroMemory(&SHExecInfo, sizeof(SHExecInfo)); 
  
    SHExecInfo.cbSize = sizeof(SHExecInfo); 
    SHExecInfo.fMask  = SEE_MASK_NOCLOSEPROCESS; 
    SHExecInfo.hwnd      = HB_ISNIL( 1 ) ? GetActiveWindow() : (HWND) hb_parnl( 1 ); 
    SHExecInfo.lpVerb = (LPCSTR) hb_parc( 2 ); 
    SHExecInfo.lpFile = (LPCSTR) hb_parc( 3 ); 
    SHExecInfo.lpParameters = (LPCSTR) hb_parc( 4 ); 
    SHExecInfo.lpDirectory  = (LPCSTR) hb_parc( 5 ); 
    SHExecInfo.nShow  = hb_parni( 6 ); 
  
    if( ShellExecuteEx(&SHExecInfo) ) 
       hb_retnl( (LONG) SHExecInfo.hProcess ); 
    else 
       hb_retnl( NULL ); 
 } 
  
 HB_FUNC( TERMINATEPROCESS ) 
 { 
    hb_retl( (BOOL) TerminateProcess( (HANDLE) hb_parnl( 1 ), 0 ) ); 
 } 
  
 #pragma ENDDUMP

и сделал аналог _Execute(...)

 
 *-----------------------------------------------------------------------------* 
 FUNCTION _ExecuteEx( hWnd , cOperation , cFile , cParameters , cDirectory , nState ) 
 *-----------------------------------------------------------------------------* 
  
 RETURN ShellExecuteEx( hb_defaultValue( hWnd, GetActiveWindow() ) , ; 
    cOperation /* possible values are 'edit', 'explore', 'find', 'open', 'print' */ , ; 
    hb_defaultValue( cFile, "" ) , cParameters , cDirectory , hb_defaultValue( nState, SW_SHOWNORMAL ) )

То есть:
если PID есть, то приложение уже запустилось,
если не сработал PostMessage(hWnd, WM_CLOSE, 0, 0) для внешнего приложения,
делаем TerminateProcess( hPid ),
если это не помогло, то запускаем
cRun := %windir%/System32/taskkill.exe /T /IM <AppName.exe> через
_ExecuteEx( 0, "runas", cRun, , , SW_HIDE )

С этими изменениями стало проще бороться с внешними приложениями

gfilatov2002
moderator
Пост N: 1828 Зарегистрирован: 11.02.10

Отправлено: 22.02.21 11:55. Заголовок: SergKis пишет: для ..

SergKis пишет:

цитата:

для использования с VK_MENU, VK_SHIFT, VK_CONTROL клавишами

Благодарю за помощь, но для этих целей у нас уже есть специальная функция HMG_PressKey()

Пример использования для эмуляции нажатия Ctrl + Shift + A:

цитата:

HMG_PressKey( VK_CONTROL, VK_SHIFT, VK_A )

Остальные функции для выгрузки сторонних приложений есть в примерах и библиотеке ProcInfo

SergKis
постоянный участник
Пост N: 3564 Зарегистрирован: 17.02.12

Отправлено: 22.02.21 12:19. Заголовок: gfilatov2002 пишет д..

gfilatov2002 пишет

цитата:

для этих целей у нас уже есть специальная функция HMG_PressKey()

Эта ф-я нажимает и отпускает клавиши списком, как аналог
AEval({ VK_CONTROL, VK_SHIFT, VK_A }, {|n| _PushKey( n ) })
совместно нажать VK_CONTROL + VK_V + отпустить VK_CONTROL не получится

цитата:

есть в примерах

ShellExecuteEx(...) удобней исп., чем ShellExecute(...) может тогда заменить, а не таскать из примеров, если не добавлять

SergKis
постоянный участник
Пост N: 3565 Зарегистрирован: 17.02.12

Отправлено: 22.02.21 12:24. Заголовок: SergKis пишет не пол..

SergKis пишет

цитата:

не получится

Все получится, это я просмотрел, второе событие отжатие в обратном порядке
Сори

Andrey
постоянный участник
Пост N: 6890 Зарегистрирован: 12.09.06

Отправлено: 22.02.21 17:59. Заголовок: SergKis пишет: Shel..

SergKis пишет:

цитата:

ShellExecuteEx(...) удобней исп., чем ShellExecute(...) может тогда заменить, а не таскать из примеров, если не добавлять

Я тоже таскаю свою функцию ShellExecuteEx(...), пришлось делать её самому и я давно ещё предлагал её добавить.
Хотелось бы иметь такую функцию в библиотеке сразу.

gfilatov2002
moderator
Пост N: 1829 Зарегистрирован: 11.02.10

Отправлено: 23.02.21 12:31. Заголовок: Andrey пишет: я дав..

Andrey пишет:

цитата:

я давно ещё предлагал её добавить

Добавил Си-функцию ShellExecuteEx() в новую сборку, которая выйдет на этой неделе.

Сейчас занят переработкой Си-кода доя использования кодировки Unicode, пример MainDemo отрабатывает уже нормально.

rvu

Пост N: 307 Зарегистрирован: 05.11.05

Отправлено: 24.02.21 15:20. Заголовок: gfilatov2002 пишет: ..

gfilatov2002 пишет:

цитата:

Сейчас занят переработкой Си-кода доя использования кодировки Unicode, пример MainDemo отрабатывает уже нормально.

Я даже удивлен. Ожидал здесь множество эмоций, а никто не прокомментировал. Нужная же вещь для тех, у кого больше двух языков в программе и то, один из них английский.

SergKis
постоянный участник
Пост N: 3566 Зарегистрирован: 17.02.12

Отправлено: 24.02.21 16:09. Заголовок: rvu пишет Я даже уди..

rvu пишет

цитата:

Я даже удивлен. Ожидал здесь множество эмоций, а никто не прокомментировал.

Эмоции будут когда пощупаем, т.к. кому надо было unicode, варианты реализации были сделаны для работы ...
Как их адаптировать под hmg unicode, вопрос пока открытый.
А то что потребность в hmg unicode была и есть, это несомненно.
Григорию большой респект, что нашел время и взялся за адаптацию

gfilatov2002
moderator
Пост N: 1830 Зарегистрирован: 11.02.10

Отправлено: 24.02.21 18:02. Заголовок: SergKis пишет: потр..

SergKis пишет:

цитата:

потребность в hmg unicode была и есть

Вот так выглядит пример использования Unicode для японского языка:

Как говорится, HMG Power Ready

Andrey
постоянный участник
Пост N: 6891 Зарегистрирован: 12.09.06

Отправлено: 24.02.21 19:15. Заголовок: gfilatov2002 пишет: ..

gfilatov2002 пишет:

цитата:

Вот так выглядит пример использования Unicode для японского языка:

Это классно ! Ждём результата !
Но интересуют примеры допустим русский и украинский язык.
Допустим на форме объекты BUTTON, LABEL, GETBOX на русском языке,
а нужно сделать BUTTON, LABEL на украинском, GETBOX оставляем на русском языке.
Как сделать чтение и замену допустим из ini-файлов-языка или из DBF-файла ?

Вот такой пример бы очень пригодился.

SergKis
постоянный участник
Пост N: 3567 Зарегистрирован: 17.02.12

Отправлено: 24.02.21 19:58. Заголовок: Andrey пишет Вот так..

Andrey пишет

цитата:

Вот такой пример бы очень пригодился

+ тсб с колонкой на RU и колонкой на UA

Петр
постоянный участник
Пост N: 1586 Зарегистрирован: 09.10.06

Отправлено: 25.02.21 01:49. Заголовок: Andrey пишет: Но ин..

Andrey пишет:

цитата:

Но интересуют примеры допустим русский и украинский язык.

Есть такая кодовая страница Windows-1251.
"Windows-1251 выгодно отличается от других 8‑битных кириллических кодировок (таких как CP866, KOI8-R и ISO 8859-5) наличием практически всех символов, использующихся в русской типографике для обычного текста (отсутствует только значок ударения); Она также содержит все символы для других славянских языков: украинского, белорусского, сербского, македонского и болгарского" - из Википедии.
cp1251 широко используется в госучреждениях Украины при работе с Казначейством (Державна казначейська служба України).

"Структура транспортного файлу Реєстр бюджетних фінансових зобов’язань.
Транспортний файл має відповідати структурі dBaseIII. Дані в транспортному файлі мають відповідати кодовій сторінці Win-1251, кодова сторінка Win-1251 має бути зазначена в заголовку файлу" - это из требований к файлам подаваемых клиентами.

SergKis пишет:

цитата:

+ тсб с колонкой на RU и колонкой на UA

Как вы себе такой пример представляете?
Добавил Русский и Украинский в языковую панель. Установил cp1251 и работаешь. Здесь юникод нафиг ненужен.

Andrey пишет:

цитата:

Как сделать чтение и замену допустим из ini-файлов-языка или из DBF-файла

Это элементарные технические приемы, которые вы должны применять самостоятельно, поскольку в библиотеке отсутствует стандартная ("из коробки") поддержка файлов языковых ресурсов.

SergKis
постоянный участник
Пост N: 3568 Зарегистрирован: 17.02.12

Отправлено: 25.02.21 07:46. Заголовок: Петр пишет Как вы се..

Петр пишет

цитата:

Как вы себе такой пример представляете?

Для UA не скажу, для LV866 (en,ru,lv), его мы вставляем в hb unicode и своя hmg unicode 2012 года
hb_cdpSelect("LV866") ; hb_setTermCP("LV866")
и все - 3и языка на контролах и базах

цитата:

Есть такая кодовая страница Windows-1251

Есть и 1257+DE+FR, а UA в продолжении вопроса от Андрея написал, т.к. в тсб фонты идут по handle (используя hardset ?), а базы в LV866.
Или переводим все в utf8, включая dbf и работаем hb_cdpSelect("UTF8") ; hb_setTermCP("UTF8") ?

SergKis
постоянный участник
Пост N: 3569 Зарегистрирован: 17.02.12

Отправлено: 25.02.21 07:55. Заголовок: SergKis пишет 3и язы..

SergKis пишет

цитата:

3и языка на контролах и базах

Язык программы то же en,ru,lv, а txt, ini, cfg файлы все имеют BOM и utf8 тексты внутри

gfilatov2002
moderator
Пост N: 1831 Зарегистрирован: 11.02.10

Отправлено: 25.02.21 11:35. Заголовок: Всем кому это интересно :)

Опубликована февральская сборка библиотеки, которая доступна по адресу:

http://hmgextended.com/files/CONTRIB/hmg-21.02-setup.exe

Эта версия использует, как обычно, ANSI charset (посмотреть кодировку можно, вызвав функцию MiniGUIVersion())

Работа над UNICODE-версией продолжается, начинается этап тестирования и исправления допущенных ошибок (неточностей)

gfilatov2002
moderator
Пост N: 1832 Зарегистрирован: 11.02.10

Отправлено: 25.02.21 11:38. Заголовок: Петр Рад приветство..

Петр
Рад приветствовать на форуме

Возможно ли обратиться к Вам за помощью в реализации Unicode-cборки

Петр
постоянный участник
Пост N: 1587 Зарегистрирован: 09.10.06

Отправлено: 25.02.21 20:57. Заголовок: gfilatov2002 пишет: ..

gfilatov2002 пишет:

цитата:

Петр
Рад приветствовать на форуме

Здравствуйте, Григорий!
К сожалению, сейчас я здесь редко бываю.

цитата:

Возможно ли обратиться к Вам за помощью в реализации Unicode-cборки

Пишите на почту, которая gmail, если чем-то смогу помочь - помогу обязательно.

rvu

Пост N: 309 Зарегистрирован: 05.11.05

Отправлено: 26.02.21 14:18. Заголовок: gfilatov2002 пишет: ..

gfilatov2002 пишет:

цитата:

Опубликована февральская сборка библиотеки

Спасибо! И особое спасибо за доработки браузера!

gfilatov2002
moderator
Пост N: 1833 Зарегистрирован: 11.02.10

Отправлено: 05.03.21 17:32. Заголовок: Всем кому это интересно :)

TBrowse уже работает в Unicode режиме

Тестирование продолжается...

SergKis
постоянный участник
Пост N: 3571 Зарегистрирован: 17.02.12

Отправлено: 06.03.21 11:33. Заголовок: gfilatov2002 Добавь..

gfilatov2002
Добавьте в h_objects.prg

 
 CLASS TKeyData 
 ... 
    METHOD Keys()         INLINE hb_HKeys( ::aKey ) 
    METHOD Values()       INLINE hb_HValues( ::aKey ) 
    METHOD CloneHash()    INLINE hb_HClone( ::aKey ) 
    METHOD Clone()        INLINE __objClone( Self ) 
    METHOD Sort()         INLINE ::aKey := hb_HSort( ::aKey ) 
    METHOD Fill( xVal )   INLINE hb_HFill( ::aKey, xVal ) 
  
    _METHOD GetAll( lAll ) 
 ...

цитата:

TBrowse уже работает в Unicode режиме

Это отличная новость

Хотелось уточнения для колонок тсб, к примеру выше.
Одна колонка UA кодировка в базе, другая LV1257 и третья DE, все другие RU1251.
Как установки кодировок будут выглядеть ?

gfilatov2002
moderator
Пост N: 1834 Зарегистрирован: 11.02.10

Отправлено: 08.03.21 21:40. Заголовок: SergKis пишет: Доба..

SergKis пишет:

цитата:

Добавьте в h_objects.prg

Сделал, благодарю за помощь

SergKis пишет:

цитата:

Хотелось уточнения для колонок тсб

Пока не знаю, как это реализовать...

SergKis
постоянный участник
Пост N: 3578 Зарегистрирован: 17.02.12

Отправлено: 08.03.21 23:09. Заголовок: gfilatov2002 пишет П..

gfilatov2002 пишет

цитата:

Пока не знаю, как это реализовать...

По идее уст. CP utf8 глобально и USE ... на базу с содержимым полей в utf8 (с языками разными) должны отображаться в тсб колонках правильно. Если это так, то, по идее, в выше указанном условии, данные колонок привести к utf8, hb_StrToUtf8(..., "CP колонки"), поставив в блок кода колонки :bDecode, в :bEncode сделать обратную операцию hb_Utf8ToStr(..., "CP колонки"). USE ... так же делаем без указания CP

SergKis
постоянный участник
Пост N: 3579 Зарегистрирован: 17.02.12

Отправлено: 09.03.21 09:23. Заголовок: gfilatov2002 Предла..

gfilatov2002
Предлагаю поправить

 
 METHOD DoKeyEvent( nKey ) CLASS Get 
  
    LOCAL n, r := 0, cKey := hb_ntos( nKey ) 
  
    IF Len( ::aKeyEvent ) > 0 
  
       cKey += iif( _GetKeyState( VK_CONTROL ), '#', '' ) 
       cKey += iif( _GetKeyState( VK_SHIFT   ), '^', '' ) 
       cKey += iif( _GetKeyState( VK_MENU    ), '@', '' ) 
       IF ( n := AScan( ::aKeyEvent, {| a | a[ 1 ] == cKey } ) ) > 0 
          IF HB_ISBLOCK( ::aKeyEvent[ n ][ 2 ] ) 
             //Eval( ::aKeyEvent[ n ][ 2 ], Self, nKey, cKey ) 
             Do_ControlEventProcedure( ::aKeyEvent[ n ][ 2 ], __mvGet( ::name ), Self, nKey, cKey ) 
             r := 1 
          ENDIF 
       ENDIF 
  
    ENDIF 
  
 RETURN r

тогда в боке кода будет среда This для контрола GETBOX, как в блоках кода @ y,x GETBOX ...

gfilatov2002
moderator
Пост N: 1835 Зарегистрирован: 11.02.10

Отправлено: 09.03.21 10:47. Заголовок: SergKis пишет: тогд..

SergKis пишет:

цитата:

тогда в боке кода будет среда This для контрола GETBOX

Предложение интересное, но смущает значение переменной __mvGet( ::name ), которая передается вторым параметром.
Там должен быть числовой параметр, а Вы передаете строковый

Или я что-то упустил

SergKis
постоянный участник
Пост N: 3582 Зарегистрирован: 17.02.12

Отправлено: 09.03.21 10:57. Заголовок: gfilatov2002 пишет И..

gfilatov2002 пишет

цитата:

Или я что-то упустил

 
 FUNCTION _DefineGetBox ( ControlName, ParentFormName, x, y, w, h, Value, ; 
 ... 
    k := _GetControlFree() 
 ... 
    Public &mVar. := k 
 ... 
    oget := Get() 
    oget:New( -1, -1, { | x | iif( x == NIL, oget:cargo, oget:cargo := x ) }, '', cPicture ) 
    oget:cargo     := Value 
    oget:preblock  := when 
    oget:postblock := valid 
    oget:message   := cmessage 
    oget:name      := mVar 
    oget:control   := ControlHandle 
    oget:SetFocus() 
    oget:original  := oGet:buffer 
 ...

Это имя переменной, в которой определен индекс контрола и __mvGet( ::name ) дает из public переменной номер индекса, можно проверять на наличие переменной, но это излишне, т.к. объект существует пока есть контрол GETBOX

gfilatov2002
moderator
Пост N: 1836 Зарегистрирован: 11.02.10

Отправлено: 09.03.21 11:15. Заголовок: SergKis пишет: дает..

SergKis пишет:

цитата:

дает из public переменной номер индекса

Ok, принято

gfilatov2002
moderator
Пост N: 1837 Зарегистрирован: 11.02.10

Отправлено: 17.03.21 17:39. Заголовок: Всем кому это интересно 8-)

Подготовил 3-ю бета-версию для новой сборки 21.03

Что нового (кратко):
Скрытый текст

* Implementation of UNICODE support in the MiniGUI core libraries.

* Fixed ANIGIF control: restored a proper handling of the DELAY clause
(bug was introduced in the build 20.10 (update 2)).

* The Tab page(s) at owner-draw colored TAB control supports now
PNG, GIF and TIF images. The 'Transparent' property will be added
to these images automatically.

* Updated 'Open Table InSpector' sample:
- added the source code for the OTIS library version 1.20 b01;
- updated documentation (look at \Doc folder).

* Updated SQLite3 library.

* Updated some examples for UNICODE support.

Поддержка уникода потребовала серьезного пересмотра Си-кода ядра библиотеки

Возможно, что-то я упустил из виду...

Andrey
постоянный участник
Пост N: 6920 Зарегистрирован: 12.09.06

Отправлено: 18.03.21 11:39. Заголовок: Очень ждём ! :sm12:..

Очень ждём !

SergKis
постоянный участник
Пост N: 3626 Зарегистрирован: 17.02.12

Отправлено: 20.03.21 11:18. Заголовок: gfilatov2002 Неболь..

gfilatov2002
Небольшая правка

 
 CLASS TWndData				//--------------------------------------------------- 
 ... 
 	ACCESS VarName								 INLINE ::cVar 
 	ACCESS FocusedControl						INLINE _GetFocusedControl ( ::cName ) 
 ... 
 	METHOD SetFocus( xName )		INLINE iif( empty(xName),  SetFocus( ::nHandle ), ; 
 		 iif( HB_ISOBJECT(::GetObj(xName)), ::GetObj(xName):SetFocus(), DoMethod(::cName, xName, "SetFocus") ) ) 
 ...

gfilatov2002
moderator
Пост N: 1840 Зарегистрирован: 11.02.10

Отправлено: 20.03.21 13:39. Заголовок: SergKis пишет: Небо..

SergKis пишет:

цитата:

Небольшая правка

Принято с благодарностью

SergKis
постоянный участник
Пост N: 3636 Зарегистрирован: 17.02.12

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

gfilatov2002
Правка по колонке тсб

 
 METHOD ToWidth( uLen, nKfc, lHeader ) CLASS TSColumn 
  
    LOCAL nWidth, nLen, cTyp, cChr := 'B', hFont := ::hFont 
  
    DEFAULT nKfc := 1 
  
    IF HB_ISLOGICAL( lHeader ) 
       hFont := iif( lHeader, ::hFontHead, ::hFontFoot ) 
       DEFALT hFont := ::hFont 
    ENDIF 
  
    If HB_ISCHAR( uLen ) 
       cChr := uLen 
    ElseIf ! Empty( ::cPicture ) .and. HB_ISCHAR( ::cPicture ) 
       If Empty( uLen ) 
 ... 
    nWidth := GetTextWidth( 0, cChr, hFont ) 
 ...

SergKis
постоянный участник
Пост N: 3637 Зарегистрирован: 17.02.12

Отправлено: 23.03.21 12:14. Заголовок: PS Возможно такой ва..

PS
Возможно такой вариант лучше ?

 
    If HB_ISCHAR( uLen ) 
       IF CRLF $ uLen 
          cChr := "" 
          FOR EACH uLen IN hb_ATokens( uLen ) 
              IF Len( uLen ) > Len( cChr ) ; cChr := uLen 
              ENDIF 
          NEXT 
       ELSE 
          cChr := uLen 
       ENDIF 
    ElseIf ! Empty( ::cPicture ) .and. HB_ISCHAR( ::cPicture )

gfilatov2002
moderator
Пост N: 1841 Зарегистрирован: 11.02.10

Отправлено: 23.03.21 12:24. Заголовок: SergKis пишет: Возм..

SergKis пишет:

цитата:

Возможно такой вариант лучше ?

Да, в таком случае учитываются многострочные ячейки...

Благодарю за помощь

gfilatov2002
moderator
Пост N: 1842 Зарегистрирован: 11.02.10

Отправлено: 31.03.21 09:31. Заголовок: Всем кому это интересно 8-)

Опубликована новая сборка 21.03 для BCC 5.8.2 и компиляторов Harbour и xHarbour.

Базовый дистрибутив для кодировки ANSI находится по адресу

http://hmgextended.com/files/CONTRIB/hmg-21.03-setup.exe

Огромная благодарность Сергею Киселеву за помощь при подготовке этой сборки

P.S. Я также подготовил архив для UNICODE сборки 21.03, который доступен всем, кто решит поддержать разработку библиотеки.

SergKis
постоянный участник
Пост N: 3667 Зарегистрирован: 17.02.12

Отправлено: 31.03.21 10:58. Заголовок: gfilatov2002 Неболь..

gfilatov2002
Небольшая правка, упустил слегка (согласовать TWndData и TCnlData)

 
 CLASS TWndData 
 ... 
    ACCESS WO INLINE ::oCargo 
    ACCESS WP INLINE ::oProp 
  
    METHOD SetProp( xKey, xVal ) INLINE ::oProp:Set( xKey, xVal ) 
    METHOD GetProp( xKey ) INLINE iif( pCount() > 0, ::oProp:Get( xKey ), ::oProp ) 
 ... 
 CLASS TCnlData INHERIT TWndData 
 ... 
    METHOD GetProp( xKey ) INLINE iif( pCount() > 0, ::oWin:oProp:Get( xKey ), ::oWin:oProp ) 
 ... 
 Применять 
 DEFINE WINDOW ... 
 ... 
 WITH OBJECT (This.Object):GetProp() 
 :nTable := 3 
 :cTable := "oReport11" 
 ... 
 END WITH 
 ... 
 (This.Object):Event(20, {|ow| 
     LOCAL cBrw, nBrw 
     WITH OBJECT ow:GetProp()  // или ow:WP 
     cBrw := :cTable 
     nBrw := :nTable 
     ... 
     END WITH 
     ... 
     RETURN NIL 
     })

цитата:

подготовил архив для UNICODE

Можно получить в личке, для пощупать

SergKis
постоянный участник
Пост N: 3668 Зарегистрирован: 17.02.12

Отправлено: 31.03.21 11:20. Заголовок: gfilatov2002 AC..

gfilatov2002
ACCESS WO INLINE ::oCargo
ACCESS WP INLINE ::oProp
В TWndData есть, глаз замылился

gfilatov2002
moderator
Пост N: 1843 Зарегистрирован: 11.02.10

Отправлено: 31.03.21 11:44. Заголовок: SergKis пишет: ACCE..

SergKis пишет:

цитата:

ACCESS WO INLINE ::oCargo
ACCESS WP INLINE ::oProp

Благодарю за помощь

Уже обновил по-быстрому мартовскую сборку

SergKis
постоянный участник
Пост N: 3669 Зарегистрирован: 17.02.12

Отправлено: 31.03.21 20:38. Заголовок: gfilatov2002 Что не..

gfilatov2002
Что не так делаю в unicode сборке ?
prg -> utf8 с bom, поставил
SET CODEPAGE TO UNICODE
собрал exe и тсб с lEdit := .T.
USE ... без указания CDP
пытаюсь в колонку CITY добавить в конец RU русскую букву и на добавляет, а EN буквы все ok!
Пример APP_OOPREPORT\demo.prg поправил слегка Скрытый текст

 
 п»ї/* 
  * MINIGUI - Harbour Win32 GUI library Demo 
  * 
  */ 
  
 #include "hmg.ch" 
 #include "tsbrowse.ch" 
  
 REQUEST HB_CODEPAGE_RU1251 
 REQUEST DBFCDX 
  
 FIELD FIRST, LAST, AGE, STATE, CITY, INCOMING, OUTLAY 
  
 *-----------------------------------------------------------------------------* 
 FUNCTION Main() 
 *-----------------------------------------------------------------------------* 
    LOCAL nY, nX, nW, nH, hSpl, oTabl, cAlias 
    LOCAL cWnd := 'wMain' 
  
    SET CODEPAGE TO UNICODE 
  
    RddSetDefault("DBFCDX") 
  
    SET CENTURY    ON 
    SET DATE       GERMAN 
    SET DELETED    ON 
    SET EXCLUSIVE   ON 
    SET EPOCH TO     2000 
    SET AUTOPEN    ON 
    SET EXACT        ON 
    SET SOFTSEEK     ON 
  
    SET NAVIGATION EXTENDED 
    SET FONT       TO "Arial", 11 
    SET DEFAULT ICON TO "hmg_ico" 
  
    *-------------------------------- 
    SET OOP ON 
    *-------------------------------- 
  
    DEFINE FONT Normall  FONTNAME _HMG_DefaultFontName ; 
                             SIZE _HMG_DefaultFontSize 
    DEFINE FONT FontBold FONTNAME _HMG_DefaultFontName ; 
                             SIZE _HMG_DefaultFontSize BOLD 
    DEFINE FONT FontNorm FONTNAME "Courier New"       ; 
                             SIZE _HMG_DefaultFontSize 
  
    USE Employee  ALIAS BASE  SHARED  NEW 
  
    cAlias := Alias() 
  
    DEFINE WINDOW &cWnd AT 0,0 WIDTH 950 HEIGHT 650 ; 
       TITLE 'MiniGUI Demo for TBrowse report' ; 
       MAIN  NOMAXIMIZE  NOSIZE ; 
       ON RELEASE  dbCloseAll() ; 
       ON INTERACTIVECLOSE (This.Object):Action 
  
         DEFINE STATUSBAR BOLD 
          STATUSITEM ''          ACTION Nil 
          STATUSITEM '' WIDTH  80 ACTION Nil 
          STATUSITEM '' WIDTH 430 ACTION Nil 
       END STATUSBAR 
  
       DEFINE SPLITBOX HANDLE hSpl 
       DEFINE TOOLBAR ToolBar_1 CAPTION "REPORT" BUTTONSIZE 52,32 FLAT 
  
          BUTTON E0  CAPTION ' '      PICTURE 'cabinet' ACTION Nil ; 
                                       SEPARATOR 
          BUTTON 01  CAPTION 'First' PICTURE 'n1'    ; 
                     TOOLTIP 'Column report FIRST   Ctrl+1, Shift+1'  ; 
                     ACTION  _wPost(1) SEPARATOR 
          BUTTON 02  CAPTION 'Last'   PICTURE 'n2'   ; 
                     TOOLTIP 'Column report LAST Ctrl+2, Shift+2'  ; 
                     ACTION  _wPost(2) SEPARATOR 
          BUTTON 03  CAPTION 'Age'     PICTURE 'n3'  ; 
                     TOOLTIP 'Column report AGE  Ctrl+3, Shift+3'   ; 
                     ACTION  _wPost(3) SEPARATOR 
          BUTTON 04  CAPTION 'State' PICTURE 'n4'    ; 
                     TOOLTIP 'Column report STATE   Ctrl+4, Shift+4'  ; 
                     ACTION  _wPost(4) SEPARATOR 
          BUTTON 05  CAPTION 'City'   PICTURE 'n5'   ; 
                     TOOLTIP 'Column report CITY Ctrl+5, Shift+5'  ; 
                     ACTION  _wPost(5) SEPARATOR 
          BUTTON 06  CAPTION 'State ?' PICTURE 'n6'                  ; 
                     TOOLTIP 'Column report STATE + Left(LAST, 1)  Ctrl+6, Shift+6'  ; 
                     ACTION  _wPost(6) SEPARATOR 
          BUTTON 07  CAPTION 'City ?'  PICTURE 'n7'                  ; 
                     TOOLTIP 'Column report CITY + Left(LAST, 1)   Ctrl+7, Shift+7'  ; 
                     ACTION  _wPost(7) SEPARATOR 
       END TOOLBAR 
  
       DEFINE TOOLBAR ToolBar_2 CAPTION "" BUTTONSIZE 42,32 FLAT 
          BUTTON 99  CAPTION 'Exit'  PICTURE 'exit'  ACTION _wPost(99) 
       END TOOLBAR 
       END SPLITBOX 
  
       WITH OBJECT This.Object          // ---- Window events 
       // StatusBar 
       :StatusBar:Say(MiniGUIVersion(), 3) 
       // ToolBar 1 
       :Event(  1, {|ow,ky| Report(ow, ky) } ) 
       :Event(  2, {|ow,ky| Report(ow, ky) } ) 
       :Event(  3, {|ow,ky| Report(ow, ky) } ) 
       :Event(  4, {|ow,ky| Report(ow, ky) } ) 
       :Event(  5, {|ow,ky| Report(ow, ky) } ) 
       :Event(  6, {|ow,ky| Report(ow, ky) } ) 
       :Event(  7, {|ow,ky| Report(ow, ky) } ) 
       // ToolBar 2 
       :Event( 99, {|ow  | ow:Release() } ) 
       // Tsb. Right click - context menu 
       :Event( 90, {|ow  | MenuReport(ow) } ) 
       // StatusBar 
       :Event( 91, {|ow  | ow:StatusBar:Say('... W A I T ...') } ) 
       :Event( 92, {|ow  | ow:StatusBar:Say('')               } ) 
       END WITH                         // ---- Window events 
  
       nY := GetWindowHeight(hSpl) 
       nX := 1 
       nW := This.ClientWidth  - nX * 2 
       nH := This.ClientHeight - This.StatusBar.Height - nY 
  
       DEFINE TBROWSE oTabl  AT nY, nX  ALIAS cAlias  WIDTH nW  HEIGHT nH  CELL ; 
              TOOLTIP 'Right click - context menu'                              ; 
              FONT    {"Normal", "FontBold", "FontBold"}                        ; 
              FOOTERS .T. EDIT                                                  ; 
              COLUMNS {"FIRST", "LAST", "AGE", "STATE", "CITY", "INCOMING", "OUTLAY"} ; 
              COLNUMBER {1, 40} LOADFIELDS COLSEMPTY 
  
          //:hFontHead := GetFontHandle( "FontBold" ) 
          //:hFontFoot := GetFontHandle( "FontBold" ) 
  
          :SetAppendMode( .F. ) 
          :SetDeleteMode( .F. ) 
  
          //:LoadFields(.F.) 
  
          :lNoGrayBar := .T. 
          :nWheelLines  := 1 
          :nClrLine     := COLOR_GRID 
          :nHeightCell  += 2 
          :nHeightHead  := :nHeightCell + 2 
          :nHeightFoot  := :nHeightCell + 2 
          //:lDrawFooters := .T. 
          //:lFooting     := .T. 
          :lNoVScroll := .F. 
          :lNoHScroll := .T. 
          :bChange    := {|ob| ob:DrawFooters() } 
          :bRClicked   := {|p1,p2,p3,ob| p1:=p2:=p3:=Nil, _wPost(90, ob:cParentWnd) } 
  
          :SetColor( { CLR_FOCUSB }, { { |a,b,c| If( c:nCell == b, {RGB( 66, 255, 236), RGB(209, 227, 248)}, ; 
                                                                   {RGB(220, 220, 220), RGB(220, 220, 220)} ) } } ) 
  
          :aColumns[ 1 ]:cFooting := { |nc,ob| nc := ob:nAt, iif( Empty(nc), '', hb_ntos(nc) ) } 
          :aColumns[ 2 ]:cFooting := hb_ntos( (cAlias)->( LastRec() ) ) 
  
          :UserKeys( VK_1, {|ob| _wPost(1, ob:cParentWnd) }, .T. ) 
          :UserKeys( VK_2, {|ob| _wPost(2, ob:cParentWnd) }, .T. ) 
          :UserKeys( VK_3, {|ob| _wPost(3, ob:cParentWnd) }, .T. ) 
          :UserKeys( VK_4, {|ob| _wPost(4, ob:cParentWnd) }, .T. ) 
          :UserKeys( VK_5, {|ob| _wPost(5, ob:cParentWnd) }, .T. ) 
          :UserKeys( VK_6, {|ob| _wPost(6, ob:cParentWnd) }, .T. ) 
          :UserKeys( VK_7, {|ob| _wPost(7, ob:cParentWnd) }, .T. ) 
  
          :ResetVScroll( .T. ) 
          :oHScroll:SetRange( 0, 0 ) 
          :AdjColumns() 
  
       END TBROWSE 
  
       oTabl:SetNoHoles() 
       oTabl:SetFocus() 
  
       ON KEY SHIFT+1 ACTION wPost(1) 
       ON KEY SHIFT+2 ACTION wPost(2) 
       ON KEY SHIFT+3 ACTION wPost(3) 
       ON KEY SHIFT+4 ACTION wPost(4) 
       ON KEY SHIFT+5 ACTION wPost(5) 
       ON KEY SHIFT+6 ACTION wPost(6) 
       ON KEY SHIFT+7 ACTION wPost(7) 
     //ON KEY ESCAPE  ACTION wPost(99) 
       ON KEY ESCAPE  ACTION {|| iif( oTabl:IsEdit, oTabl:SetFocus(), _wPost(99) ) }  // РІС‹С…РѕРґ РїРѕ ESC 
  
    END WINDOW 
  
    CENTER   WINDOW &cWnd 
    ACTIVATE WINDOW &cWnd 
  
 RETURN Nil 
  
 *-----------------------------------------------------------------------------* 
 FUNCTION _ShowFormContextMenu( cForm, nRow, nCol, lCenter ) 
 *-----------------------------------------------------------------------------* 
    LOCAL xContextMenuParentHandle := 0, hWnd, aRow 
  
    DEFAULT nRow := -1, nCol := -1, lCenter := .F. 
  
    If .Not. _IsWindowDefined(cForm) 
       xContextMenuParentHandle := _HMG_xContextMenuParentHandle 
    Else 
       xContextMenuParentHandle := GetFormHandle(cForm ) 
    Endif 
  
    If xContextMenuParentHandle == 0 
       MsgMiniGuiError("Context Menu is not defined. Program terminated") 
    EndIf 
  
    lCenter := lCenter .or. ( nRow == 0 .or. nCol == 0 ) 
    hWnd   := GetFormHandle(cForm) 
  
    If lCenter 
       If nCol == 0 
          nCol := int( GetWindowWidth (hWnd) / 2 ) 
       EndIf 
       If nRow == 0 
          nRow := int( GetWindowHeight(hWnd) / 2 ) 
       EndIf 
    ElseIf nRow < 0 .or. nCol < 0 
       aRow := GetCursorPos() 
       nRow := aRow[1] 
       nCol := aRow[2] 
    EndIf 
  
    TrackPopupMenu ( _HMG_xContextMenuHandle , nCol , nRow , xContextMenuParentHandle ) 
  
 RETURN Nil 
  
 *-----------------------------------------------------------------------------* 
 STATIC FUNC MenuReport( oWnd, aTxt, lPost, nRow, nCol, lCenter, nZeroLen ) 
 *-----------------------------------------------------------------------------* 
    LOCAL cWnd := oWnd:Name 
    LOCAL nItm := 0, cNam, cImg, i 
    LOCAL lDis := .F. 
    LOCAL bAct := {|| nItm := Val(This.Name) } 
  
    Default nZeroLen := 4, lPost := .T. 
    Default aTxt := { ; 
                      'Column report FIRST', ; 
                      'Column report LAST ', ; 
                      'Column report AGE  ', ; 
                      'Column report STATE', ; 
                      'Column report CITY ', ; 
                      'Column report STATE + Left(LAST, 1)', ; 
                      'Column report CITY + Left(LAST, 1) '  ; 
                    } 
  
    DEFINE CONTEXT MENU OF &cWnd 
       For i := 1 To len(aTxt) 
           cNam := StrZero(i, nZeroLen) 
           If  i > 9 
              cImg := Nil 
           Else 
              cImg := 'n' + hb_ntos(i) 
           EndIf 
           _DefineMenuItem( aTxt[ i ], bAct, cNam, cImg, .F., lDis, , , , .F., .F.) 
       NEXT 
       SEPARATOR 
       MENUITEM 'Exit'  ACTION NIL 
    END MENU 
  
    _ShowFormContextMenu(cWnd, nRow, nCol, lCenter ) 
  
    DEFINE CONTEXT MENU OF &cWnd 
    END MENU 
    DO EVENTS 
  
    If nItm > 0 .and. lPost 
       oWnd:PostMsg(nItm) 
    EndIf 
  
 RETURN nItm 
  
 *-----------------------------------------------------------------------------* 
 STATIC FUNC Report( oWnd, nEvent ) 
 *-----------------------------------------------------------------------------* 
    LOCAL nOld := Select(), cKey, aRpt 
    LOCAL oBrw := (This.oTabl.Object):Tsb 
    LOCAL cAls := oBrw:cAlias 
    LOCAL nRec := (cAls)->( RecNo() ) 
    LOCAL b, o := oKeyData() 
    LOCAL cNam := oBrw:aColumns[ nEvent ]:cHeading 
  
    oWnd:Action := .F. 
    oBrw:lEnabled := .F. 
    oWnd:StatusBar:Say('... W A I T ...') 
    This.&(StrZero(nEvent, 2)).Enabled := .F. 
    This.E0.Caption := hb_ntos(nEvent) 
    DO EVENTS 
  
    // keys to summarize the report 
    b := { {|| Alltrim( FIRST ) }, ; 
           {|| Alltrim( LAST )  }, ; 
           {|| hb_ntos( AGE )  }, ; 
           {|| Alltrim( STATE ) }, ; 
           {|| Alltrim( CITY )  }, ; 
           {||         STATE   + ', ' + LEFT( LAST, 1 ) + '...' }, ; 
           {||         CITY  + ', ' + LEFT( LAST, 1 ) + '...' }  ; 
         } 
  
    wApi_Sleep(500)           // specially delay for the test 
  
    dbSelectArea( cAls ) 
  
    GO TOP                    // create report in container object 
    DO WHILE ! EOF() 
       DO EVENTS 
       cKey := Eval( b[ nEvent ] ) 
       o:Sum( cKey, { 1, cKey, 1, INCOMING, OUTLAY, INCOMING - OUTLAY } ) 
       SKIP 
    ENDDO 
    GOTO nRec 
                              // report from the container object to the array 
    aRpt := o:Eval(.T.)      // array value {{...}, {...}, ...} 
  
    dbSelectArea( nOld ) 
  
    wApi_Sleep(500)           // specially delay for the test 
  
    oWnd:StatusBar:Say('') 
    DO EVENTS 
    oWnd:Action := .T. 
  
    TsbReport( oWnd, nEvent, aRpt, cNam ) 
  
    (This.oTabl.Object):Tsb:lEnabled := .T.      // oBrw:lEnabled := .T. 
    (This.oTabl.Object):SetFocus()               // oBrw:SetFocus() 
    This.&(StrZero(nEvent, 2)).Enabled := .T. 
    This.E0.Caption := '' 
    DO EVENTS 
  
 RETURN Nil 
  
 *-----------------------------------------------------------------------------* 
 STATIC FUNC TsbReport( oWnd, nEvent, aArray, cColName ) 
 *-----------------------------------------------------------------------------* 
    LOCAL aCap, oRpt, nY, nX, hSpl 
    LOCAL aHead, aSize, aFoot, aPict, aAlign, aName, aFontHF 
    LOCAL a, i, o := oKeyData() 
  
    // calculate the results 
    FOR EACH a IN aArray 
        For i := 1 To Len(a) 
            If i < 3 
               o:Sum(i, 1)        // quantity 
            Else 
               o:Sum(i, a[ i ])    // amount 
            EndIf 
        Next 
    NEXT 
  
    a := o:Eval(.T.)             // array {{value}, ...} 
  
    aAlign := array(Len(a)) 
    aSize  := array(Len(a)) 
    aPict  := array(Len(a)) 
    aFoot  := array(Len(a)) 
    aSize [ 1 ] := 50 
    aPict [ 1 ] := '9999' 
    aAlign[ 1 ] := DT_CENTER 
  
    AEVal(a, {|ns,nn| aFoot[ nn ] := iif( nn == 1, '', hb_ntos(ns) ) }) 
  
    // report title Report 
    aCap := { 'Column report FIRST', ; 
              'Column report LAST' , ; 
              'Column report AGE'  , ; 
              'Column report STATE', ; 
              'Column report CITY' , ; 
              'Column report STATE, LAST ?...', ; 
              'Column report CITY,  LAST ?...'  ; 
             } 
  
    If   nEvent == 6 
       cColName := 'State, Last ? ...' 
    ElseIf nEvent == 7 
       cColName := 'City, Last ? ...' 
    ElseIf nEvent == 3 .or. nEvent == 4    // Age, State 
       aSize [ 2 ] := 80 
       aAlign[ 2 ] := DT_CENTER 
    EndIf 
  
    // report column headers 
    aHead := { "#", cColName, "Quantity", "Incoming", "Outlay", "Balance" } 
  
    aFontHF := GetFontHandle("FontBold") 
  
    DEFINE WINDOW Report ; 
       AT   0, 0 ; 
       WIDTH  700  ; 
       HEIGHT 450 + GetTitleHeight() + GetBorderHeight() ; 
       TITLE aCap[ nEvent ] ; 
       MODAL NOSIZE ; 
       ON RELEASE Nil 
  
       DEFINE SPLITBOX HANDLE hSpl 
       DEFINE TOOLBAR ToolBar_1 CAPTION "" BUTTONSIZE 42,32 FLAT 
  
       BUTTON 01  CAPTION 'Print'  PICTURE 'printer'  ; 
                     TOOLTIP 'Report printing   F5'  ; 
                     ACTION  wPost()  SEPARATOR 
       BUTTON 02  CAPTION 'Excel'  PICTURE 'excel'   ; 
                     TOOLTIP 'Export to MS Excel   F6' ; 
                     ACTION  wPost()  SEPARATOR 
       END TOOLBAR 
  
       DEFINE TOOLBAR ToolBar_2 CAPTION "" BUTTONSIZE 42,32 FLAT 
          BUTTON 99  CAPTION 'Exit'  PICTURE 'exit'  ACTION wPost() 
       END TOOLBAR 
       END SPLITBOX 
  
       // ToolBar 1 
       (This.Object):Event(  1, {|ow| oWnd:StatusBar:Say('... W A I T ...'), ; 
            MsgBox('P r i n t i n g.  This.Name = ' + This.Name, ow:Name), ; 
                                      oWnd:StatusBar:Say('') } ) 
       (This.Object):Event(  2, {|ow| oWnd:PostMsg(91),                      ; 
            MsgBox('Export to MS Excel. This.Name = ' + This.Name, ow:Name), ; 
                                      oWnd:PostMsg(92) } ) 
       // ToolBar 2 
       (This.Object):Event( 99, {|ow| ow:Release()  } ) 
  
       nY := GetWindowHeight(hSpl) 
       DEFINE TBROWSE oRpt  AT nY, nX  WIDTH  This.ClientWidth            ; 
                                       HEIGHT This.ClientHeight - nY  CELL ; 
                                       TOOLTIP 'Double click on title - sorting' 
  
       :SetArrayTo( aArray, aFontHF, aHead, aSize, aFoot, aPict, aAlign, aName ) 
  
       :lNoGrayBar := .T. 
       :nWheelLines    := 1 
       :nClrLine       := COLOR_GRID 
       :nHeightCell    += 5 
       :nHeightHead    := :nHeightCell + 2 
       :nHeightFoot    := :nHeightCell + 2 
       :lDrawFooters := .T. 
       :lFooting     := .T. 
       :lNoVScroll := .F. 
       :lNoHScroll := .T. 
  
       :SetColor( { CLR_FOCUSB }, { { |a,b,c| If( c:nCell == b, {RGB( 66, 255, 236), RGB(209, 227, 248)}, ; 
                                                                {RGB(220, 220, 220), RGB(220, 220, 220)} ) } } ) 
       :aColumns[ 1 ]:bData   := {|| oRpt:nAt } 
       :aColumns[ 1 ]:lIndexCol := .F. 
  
       If nEvent == 6 .or. nEvent == 7 
          :aColumns[ 2 ]:hFont  := GetFontHandle('FontNorm') 
          :aColumns[ 2 ]:nWidth += 70 
       EndIf 
  
       :UserKeys( VK_F5, {|ob| wPost(1, ob) } ) 
       :UserKeys( VK_F6, {|ob| wPost(2, ob) } ) 
  
       :AdjColumns({3, 4, 5, 6})   // :AdjColumns() 
  
       END TBROWSE 
  
       oRpt:SetNoHoles() 
       oRpt:SetFocus() 
  
       ON KEY ESCAPE ACTION wPost(99) 
  
    END WINDOW 
  
    CENTER   WINDOW Report 
    ACTIVATE WINDOW Report 
  
 RETURN Nil 
  
 *-----------------------------------------------------------------------------* 
 FUNC wPost( nEvent, nIndex, xParam ) 
 *-----------------------------------------------------------------------------* 
    LOCAL oWnd 
  
    If HB_ISOBJECT(nIndex) 
  
       oWnd := _WindowObj(nIndex:cParentWnd) 
       oWnd:SetProp(nEvent, xParam) 
       oWnd:PostMsg(nEvent) 
  
    Else 
  
       DEFAULT nEvent := val( This.Name ) 
  
       If nEvent > 0 
          oWnd := (ThisWindow.Object) 
          oWnd:SetProp(nEvent, xParam) 
          oWnd:PostMsg(nEvent, nIndex) 
       EndIf 
  
    EndIf 
  
 RETURN Nil 
  
 *-----------------------------------------------------------------------------* 
 FUNC wSend( nEvent, nIndex, xParam ) 
 *-----------------------------------------------------------------------------* 
    LOCAL oWnd 
  
    If HB_ISOBJECT(nIndex) 
  
       oWnd := _WindowObj(nIndex:cParentWnd) 
       oWnd:SetProp(nEvent, xParam) 
       oWnd:SendMsg(nEvent) 
  
    Else 
  
       DEFAULT nEvent := val( This.Name ) 
  
       If nEvent > 0 
          oWnd := (ThisWindow.Object) 
          oWnd:SetProp(nEvent, xParam) 
          oWnd:SendMsg(nEvent, nIndex) 
       EndIf 
  
    EndIf 
  
 RETURN Nil

SergKis
постоянный участник
Пост N: 3670 Зарегистрирован: 17.02.12

Отправлено: 31.03.21 20:53. Заголовок: PS DEFINE FONT No..

 
    DEFINE FONT Normall   FONTNAME _HMG_DefaultFontName ;

поправил лишнюю букву, результат тот же.

gfilatov2002
moderator
Пост N: 1844 Зарегистрирован: 11.02.10

Отправлено: 31.03.21 21:19. Заголовок: SergKis пишет: пыта..

SergKis пишет:

цитата:

пытаюсь в колонку CITY добавить в конец RU русскую букву и на добавляет

А это контрол GETBOX шалит, он использует для проверки ввода Харбор-функцию IsAlpha(), которая не пропускает символы с кодом > 255. Кстати, в библиотеке TSBrowse тоже есть своя функция _IsChar() с таким же ограничением.
Надо подумать, чем можно их заменить.

Возможно, надо сделать обертку для Си-функции hb_charIsAlpha( iChar )

SergKis
постоянный участник
Пост N: 3671 Зарегистрирован: 17.02.12

Отправлено: 01.04.21 01:09. Заголовок: gfilatov2002 Может ..

gfilatov2002
Может это подойдет Скрытый текст

 
 HB_FUNC( ISUTF )                       /* Этот текст UTF ?  */ 
 { 
   byte *s; 
   byte c; 
   int ln, e; 
  
   s  = (byte *) hb_parc(1);            /* Исходная строка в UTF-8  */ 
   ln = hb_parclen(1); 
   e  = 0; 
  
   while(ln > 0){ 
     c = *s++; ln--; 
  
     if( (c & 0x80 )==0x00){ 
     } else if( (c & 0xE0 )==0xC0 ){ 
  
        c = *s++; ln--; 
        if( ! ((c & 0xC0)==0x80) ) e++; 
  
     } else if( (c & 0xE0 )==0xE0 ){ 
        c = *s++; ln--; 
  
        if( (c & 0xC0)==0x80){ 
           c = *s++; ln--; 
  
           if( ! ((c & 0xC0)==0x80) ) e++; 
  
        } 
        else e++; 
     } 
     else e++; 
   } 
   hb_retl( e==0 ); 
 }

? IsUtf("Привет ! ļķņ"), IsUtf(hb_StrToUtf8("Привет ! ļķņ")) // .F. .T.

gfilatov2002
moderator
Пост N: 1845 Зарегистрирован: 11.02.10

Отправлено: 01.04.21 11:17. Заголовок: SergKis пишет: Може..

SergKis пишет:

цитата:

Может это подойдет

Нет, такая функция уже есть в Харборе - hb_StrIsUTF8()
Я поправил класс TGet и внес изменения в обработку нажатой клавиши для GetBox, чтобы можно было ввести unicode символы.
GetBox уже заработал с русским языком, но в TsBrowse надо править также методы KeyChar и Edit

Может Вы сможете это сделать с учетом вашей уникодной hmg 2.07

SergKis
постоянный участник
Пост N: 3672 Зарегистрирован: 17.02.12

Отправлено: 01.04.21 12:35. Заголовок: gfilatov2002 пишет в..

gfilatov2002 пишет

цитата:

в TsBrowse надо править также методы KeyChar и Edit

У нас ничего исправленного в методах нет, т.к. cdp utf8 не используется, сразу в unicode все.
И GetBox в этом направлении не трогался (там др. версия его).

цитата:

такая функция уже есть в Харборе - hb_StrIsUTF8()

Которую давал текст, уже исп. с 10 года. Я хотел предложить на ней или родной вариант типа
#xtranslate _IsAlpha( cChar ) => iif( hb_StrIsUTF8(), .T., IsAlpha( cChar ) )
и в TGET использовать, добавив _ к IsAlpha( cChar )

Хорошо бы с nKey иметь похожую ф-ю.
Помочь не против

Ответов - 300 , стр: 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 All [только новые]

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

Тему читают:

- участник сейчас на форуме

- участник вне форума

Все даты в формате GMT 3 час. Хитов сегодня: 318
Права: смайлы да, картинки да, шрифты да, голосования нет
аватары да, автозамена ссылок вкл, премодерация откл, правка нет

Создай свой форум на сервисе Borda.ru
Форум находится на 59 месте в рейтинге
Текстовая версия