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

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

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

gfilatov: Начало темы находится здесь, а теперь АНОНС * АНОНС * АНОНС * АНОНС * АНОНС Готовится к опубликованию новая сборка №48, которая выйдет в конце недели. Если у Вас есть интересные наработки для включения в новый релиз, то сейчас самое удобное время для их отправки мне Кратко, что нового: - исправление обнаруженных ошибок и неточностей кода; - новый класс HEADERIMAGE для Grid и Browse; - свойство Address в Hyperlink может теперь открывать папку или файл на диске; - добавлен NOTABSTOP класс для Browse; - поддержка пользовательских компонентов (заимствована из оффициального релиза); - расширения и исправления в библиотеках TsBrowse и PropGrid; - обновлены сборки Харбор и HMGS-IDE; - новые и обновленные старые примеры (как обычно ).

Ответов - 300, стр: 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 All

gfilatov2002: SergKis пишет: Хорошо бы с nKey иметь похожую ф-ю Да, такая функция уже есть в Харборе - hb_UChar(nKey) SergKis пишет: Помочь не против Я обновил архив уникод версии 21.03 с учетом последних изменений, посмотрите, пожалуйста

SergKis: gfilatov2002 пишет GetBox уже заработал с русским языком Забрал архив, TGET от 01.04.2021 Взял пример GetBox\demo.prg -> utf8 с bom, изменил [pre2] #include "hmg.ch" REQUEST HB_CODEPAGE_UTF8 REQUEST HB_CODEPAGE_RU1251 *----------------------------- Function MAIN() *----------------------------- SET CODEPAGE TO UNICODE SET CENTURY ON SET DATE ANSI SET ShowDetailError ON SET DELETED ON SET BROWSESYNC ON SET FONT TO "Arial", 10 ... [/pre2] ввода русских букв нет, курсор перемещается с набранной буквой, вместо буквы [] квадратик

gfilatov2002: SergKis пишет: ввода русских букв нет Да, все верно - надо было еще править Tget класс для корректной обработки шаблонов ввода. Сейчас этот пример уже заработал, осталось поправить BackSpace, и можно залить исправленный архив. Кстати, Ваш пример с использованием TBrowse теперь тоже понимает русский язык

gfilatov2002: gfilatov2002 пишет: осталось поправить BackSpace Запарился исправлять TGet класс и его стыковку c GetBox. Сейчас все заработало, выложил исправленный архив для проверки. Прошу прощения за задержку...

SergKis: gfilatov2002 пишет Запарился исправлять TGet класс и его стыковку c GetBox Попробовал вариант [pre2] #translate SubStr( <s> , ) => hb_USubStr( <s>, ) #translate SubStr( <s> , , <l> ) => hb_USubStr( <s>, , <l> ) #translate Left( <s> , <l> ) => hb_ULeft( <s>, <l> ) #translate Right( <s> , <l> ) => hb_URight( <s>, <l> ) #translate At( <c> , <s> ) => hb_UAt( <c>, <s> ) #translate RAt( <c> , <s> ) => hb_URAt( <c>, <s> ) [/pre2] Работает, вроде, по -pOut.prg смотрел Сложнее с Len(...), надо смотреть только для строк, я так понимаю Или что то не учитываю ?

SergKis: PS По поводу Len(...), может так[pre2] FUNCTION __Len( x ) IF HB_ISCHAR( x ) ; RETURN hb_ULen( x ) ENDIF RETURN Len( x ) #translate Len( <s> ) => __Len( <s> ) [/pre2]

SergKis: PS2 Еще [pre2] #translate PadR( <s> , <l> ) => hb_UPadR( <s> , <l> ) #translate PadC( <s> , <l> ) => hb_UPadC( <s> , <l> ) #translate PadL( <s> , <l> ) => hb_UPadL( <s> , <l> ) [/pre2]

SergKis: gfilatov2002 пишет Сейчас все заработало, выложил исправленный архив для проверки. Примеры GetBox\demo.prg и вариант App_OppReport отработали с RU и LV языками Пример тсб тут https://TransFiles.ru/5c5r6

SergKis: gfilatov2002 Из колонки по Ctrl+C и Ctrl+V в редактор с utf8 все ok! А обратно, из редактора utf8 в колонку вставка ломает текст.

gfilatov2002: SergKis пишет: обратно, из редактора utf8 в колонку вставка ломает текст Уже поправил эту ошибку Благодарю за сообщение P.S. Выложил для проверки архив сборки с последними исправлениями.

SergKis: gfilatov2002 Собрал пример unicode, dbf ru1251 https://TransFiles.ru/231cz Показывает ok! :Edit нет, не пойму uValue в TGetBox должна в utf8 попадать, но ... бяки в корректировке

SergKis: PS На последней сборке так же все

SergKis: gfilatov2002 Нашел [pre2] METHOD bDataEval( oCol, xVal, nCol ) CLASS TSBrowse ... IF xVal == NIL // FieldGet DEFAULT nCol := ::nCell IF HB_ISBLOCK( oCol:bValue ) IF lNoAls ; xVal := Eval( oCol:bValue, NIL, Self, nCol, oCol ) ELSE ; xVal := ( cAlias )->( Eval( oCol:bValue, NIL, Self, nCol, oCol ) ) ENDIF ELSE IF lNoAls ; xVal := Eval( oCol:bData ) ELSE ; xVal := ( cAlias )->( Eval( oCol:bData ) ) ENDIF ENDIF IF HB_ISBLOCK( oCol:bDecode ) //.AND. nCol != NIL IF lNoAls ; xVal := Eval( oCol:bDecode, xVal, Self, nCol, oCol ) ELSE ; xVal := ( cAlias )->( Eval( oCol:bDecode, xVal, Self, nCol, oCol ) ) ENDIF ENDIF ELSE // FieldPut DEFAULT nCol := ::nCell IF HB_ISBLOCK( oCol:bEncode ) //.AND. nCol != NIL IF lNoAls ; xVal := Eval( oCol:bEncode, xVal, Self, nCol, oCol ) ELSE ; xVal := ( cAlias )->( Eval( oCol:bEncode, xVal, Self, nCol, oCol ) ) ENDIF ENDIF [/pre2]

SergKis: PS Добавил колонку с cdp DEWIN, работает (ввод через Clipboard с сайта, язык не ставил), все ok!

SergKis: PS2 Не понял, но не подключает REQUEST HB_LANG_LVWIN, а cplvwin.c есть в hb Придется свою либ перекодировки подключать

SergKis: gfilatov2002 Вопросик по hbfbird. В contrib есть, в hb hmg не включен. Есть причина или просто так ?

SergKis: Кому интересно, пример unicode с dbf ru1251 и dewin колонками https://TransFiles.ru/zxnsv Выборка на кнопках работает

gfilatov2002: SergKis пишет: Нашел Принято, благодарю за помощь SergKis пишет: Вопросик по hbfbird. В contrib есть, в hb hmg не включен. Просто FireBird никто здесь не использует, во всяком случае, запроса на него не было

SergKis: gfilatov2002 пишет Просто FireBird никто здесь не использует У нас оборудование вешают на него, кассы, охрана ... На свой версии, файлы получали csv, возможно, напрямую надо будет, с unicode версией это уже будет иметь смысл. Подключу к проекту потом.

SergKis: PS Не подскажите, почему не проходит REQUEST HB_LANG_LVWIN, раньше не использовал, перекодировали и работали с LV866, но в new версии, хотелось обойтись без лишних действий.

gfilatov2002: SergKis пишет: почему не проходит REQUEST HB_LANG_LVWIN Попробуйте использовать REQUEST HB_LANG_LV

SergKis: gfilatov2002 пишет REQUEST HB_LANG_LV Спасибо , собралось Нашел еще REQUEST HB_CODEPAGE_LVWIN это что ? Как то запутали все, бум разбирать, пробовать, бум

SergKis: gfilatov2002 С языками получилось в тсб все как надо Пример с 4-мя кодировками (Edit работает по ним) тут https://TransFiles.ru/yp6ui Языковые тексты из prg идут на ура (как должно быть при utf8) Спасибо за unicode версию

SergKis: PS REQUEST HB_LANG_LV Это Dos коировка REQUEST HB_CODEPAGE_LVWIN Это 1257 кодировка, которая нужна и в примере задействовал, все ok!

SergKis: gfilatov2002 Не могу найти (уже глаза сломал), где ::lDontChange становится .T. Делаю в примере (:lEdit := .T. все колонки и в показ добавил колонку MARRIED)[pre2] :lNoKeyChar := .T. // надо ставить иначе, lEdit := .T. по нажатию вкл. getbox на корркетировку :UserKeys(VK_1, {|ob| MsgBox( "Test " + ob:GetColumn(ob:nCell):cName + CRLF, ob:cParentWnd ) } ) :bLDblClick := {|up1,up2,nfl,ob| up1:=up2:=nfl, ob:PostMsg(WM_KEYDOWN, VK_RETURN, 0)} :UserKeys(VK_RETURN, {|ob| IF ob:GetColumn(ob:nCell):cName == "STREET" _wPost(111, ob:cParentWnd, ob) ELSEIF ob:GetColumn(ob:nCell):lCheckBox //cName == "MARRIED" ob:PostMsg( WM_KEYDOWN, VK_SPACE, 0 ) ; DO EVENTS ELSE _wPost(110, ob:cParentWnd, ob) ENDIF RETURN Nil } ) В :HandleEvent() попадаем сюда, выделено METHOD HandleEvent( nMsg, nWParam, nLParam ) CLASS TSBrowse ... ELSEIF nMsg == WM_CHAR .AND. ::lEditing RETURN 0 ELSEIF nMsg == WM_CHAR RETURN ::KeyChar( nWParam, nLParam ) ELSEIF nMsg == WM_KEYDOWN .AND. ::lDontChange RETURN 0 ELSEIF nMsg == WM_KEYDOWN RETURN ::KeyDown( nWParam, nLParam ) ... и отрубаются назначенные клавиши Enter, Spase, dblClick [/pre2] Может, свежим взглядом глянете ?

SergKis: PS Причем, отключаются только (фокус курсор установлен) на колонке логической MARRIED, на других все назначения клавиш и dblclick работают

SergKis: PS2 Пока писал, понял, дело не в ::lDontChange (но где она становится .T., все равно, интересно), а в :lNoKeyChar := .T.. По ней откл. метод ::KeyChar(), а в нем ::Edit() для логической колонки. Установленные события срабатывают, не работает ob:PostMsg( WM_KEYDOWN, VK_SPACE, 0 ), т.к. отключен ::KeyChar(). Тут что то надо ..., подумать

SergKis: SergKis пишет Тут что то надо ..., подумать "Все уже украдено придумано до нас" [pre2] :UserKeys(VK_RETURN, {|ob| IF ob:GetColumn(ob:nCell):cName == "STREET" _wPost(111, ob:cParentWnd, ob) ELSEIF ob:GetColumn(ob:nCell):lCheckBox //cName == "MARRIED" ob:PostEdit(!ob:GetValue(ob:nCell), ob:nCell) ELSE _wPost(110, ob:cParentWnd, ob) ENDIF RETURN Nil } ) [/pre2]

SergKis: SergKis пишет Тут что то надо ..., подумать Похоже надо, т.к. на самой колонке с :lCheckBox == .T. не работает LDblClick, не выходит на MsgBox() а клавиши работают, т.е. имеем[pre2] // :lEdit := .T. на всех колонках :lNoKeyChar := .T. :UserKeys(VK_1, {|ob,lo| MsgBox( "Test " + ob:GetColumn(ob:nCell):cName + CRLF, ob:cParentWnd ) }) :bLDblClick := {|up1,up2,nfl,ob| up1:=up2:=nfl, MsgBox(":bLDblClick press", "INFO"), ; ob:PostMsg( WM_KEYDOWN, VK_RETURN, 0 ) } :UserKeys(VK_RETURN, {|ob| IF ob:GetColumn(ob:nCell):lCheckBox //cName == "MARRIED" ob:PostEdit(!ob:GetValue(ob:nCell), ob:nCell) RETURN Nil // завершить работу метода :KeyDown(), вкл. поле на корректировку ENDIF RETURN .T. // продолжить работу метода :KeyDown() } ) [/pre2]

SergKis: PS Не туда дописал [pre2] RETURN Nil // завершить работу метода :KeyDown(), вкл. поле на корректировку ENDIF RETURN .T. // продолжить работу метода :KeyDown(), вкл. поле на корректировку [/pre2]

SergKis: SergKis пишет // :lEdit := .T. на всех колонках :lNoKeyChar := .T. Может я рвусь в открытую дверь ? И есть способ отключить метод :KeyChar() для выключения авто корректировки в GetBox при нажатии букв, цифр. Пытаюсь понять некоторые моменты, отличающиеся в работе тек. версии hmg и своей раб. версией, т.к. при нажатии букв, цифр вкл. другие режимы работы.

SergKis: gfilatov2002 Можно чуток поправить [pre2] FUNCTION _GetStatusItemWidth( hWnd, nItem ) ... RETURN iif( !Empty(nItem), aItemWidth [nItem], aItemWidth ) h_objects.prg CLASS TStbData INHERIT TCnlData ... METHOD Width ( nItem, nWidth ) INLINE iif( HB_ISNUMERIC( nWidth ) .AND. nWidth > 0, ; _SetStatusWidth ( ::oWin:cName, hb_defaultValue( nItem, 1 ), nWidth ), ; _GetStatusItemWidth( ::oWin:nHandle, nItem ) ) [/pre2]

SergKis: Еще[pre2] METHOD KeyChar( nKey, nFlags ) CLASS TSBrowse LOCAL cComp, lProcess, cTypeCol LOCAL ix LOCAL lNoKeyChar := ::lNoKeyChar DEFAULT ::nUserKey := nKey cTypeCol := iif( ::nLen == 0, "U", ValType( ::bDataEval( ::aColumns[ ::nCell ] ) ) ) // Modificado por Carlos IF cTypeCol == "L" .AND. ::aColumns[ ::nCell ]:lCheckBox .AND. nKey == VK_SPACE lNoKeyChar := .F. ENDIF IF ::nUserKey == 255 .OR. ! ::lEnabled .OR. lNoKeyChar // from KeyDown() method RETURN 0 ENDIF IF ::lAppendMode RETURN 0 ENDIF ::lNoPaint := .F. //cTypeCol := iif( ::nLen == 0, "U", ValType( ::bDataEval( ::aColumns[ ::nCell ] ) ) ) // Modificado por Carlos IF Upper( ::aMsg[ 1 ] ) == "YES" [/pre2] тогда решается edit логического поля при ::lNoKeyChar := .T.

gfilatov2002: SergKis пишет: поправить OK SergKis пишет: решается edit логического поля при ::lNoKeyChar := .T. Принято с благодарностью P.S. Обновил unicode сборку с учетом всех последних изменений, в т.ч. обновил компилятор Harbour

gfilatov2002: Выложил 1-е обновление сборки 21,03 с учетом всех последних изменений по адресу http://hmgextended.com/files/CONTRIB/hmg-21.03-setup.exe Что нового: * New: Implementation of UNICODE support in the MiniGUI core libraries: - updated the Harbour TGet class; - updated the GETBOX control; - updated the TSBrowse library. Contributed by Grigory Filatov <gfilatov@inbox.ru> * Updated: Adaptation FiveWin Class TSBrowse 9.0 in HMG: - correction of using the variable :lNoKeyChar with the logical fields in the method KeyChar(). Contributed by SergKis * Updated: HbSQLite3 library: - update for using SQLITE3 version 3.35.4 (from 3.35.3). Contributed by Grigory Filatov <gfilatov@inbox.ru>. * Updated: Harbour Compiler 3.2.0dev (SVN 2021-03-31 20:37): * Updated: PostGreSQL library source code (see in folder \Source\HbPgSql). Contributed by Grigory Filatov <gfilatov@inbox.ru> (look at ReadMe.txt in folder \harbour) * Updated: 'Test application' sample. - updated C-code for unicode support. Contributed by Grigory Filatov <gfilatov@inbox.ru> (see in folder \samples\Basic\TEST_APPLICATION) * Updated: 'Using OOP events for creation of the reports' sample: - updated database for unicode compatibility. Contributed by Sergej Kiselev (see in folder \samples\Advanced\APP_OOPREPORT)

SergKis: gfilatov2002 Пример BASIC\Firebird работает в unicode версии, RU1251, LV1257 (LVWIN) поддерживает. Buid [pre2] Compile.bat ..\..\..\BATCH\hbmk2.bat demo.hbp demo.hbp # Keys compile #-prgflag=-w2 -es1 # Enable multi/single-thread Harbour VM -mt # Incremental-compilation mode -inc # folder where are all * .obj -workdir=OBJ # Name EXE-module -odemo # to list all * .prg demo.prg # project Resources #demo.rc # paths to the main and extension *.Lib -lminigui -ltsbrowse -lhbodbc.lib -lodbc32.lib [/pre2] Demo.prg (UTF8 с BOM) [pre2] /* * * Access a firebird database through ODBC * * Based on ODBC_2 sample included in MiniGui Extended distribution * Hugo Rozas M. * HMG Extended v1.9.98 * */ #define _HMG_OUTLOG #include 'hmg.ch' #include "miniprint.ch" REQUEST HB_CODEPAGE_UTF8 REQUEST HB_CODEPAGE_RU1251 REQUEST HB_LANG_DEWIN REQUEST HB_CODEPAGE_LVWIN REQUEST DBFCDX MEMVAR TitlePrint static oConnection *-------------------------------------------------------------------------------- FUNCTION Main() 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 navigation extended oConnection = todbc():new('DRIVER=Firebird/InterBase(r) driver;UID=SYSDBA;PWD=masterkey;DBNAME=EMPLOYEE.FDB;') oConnection:Open() define window form1; at 0,0 width 400 height 400 title 'Demo Odbc/Firebird'; Main; on init ( adjust(), load_data(1) ); on maximize ( adjust() ); on size ( adjust() ); on release ( oConnection:Destroy() ); font 'ms sans serif' size 8 @ 0, 0 button btn1 caption '&Add' width 55 height 20 action events_(1) @ 0, 60 button btn2 caption '&Edit' width 55 height 20 action events_(2) @ 0,120 button btn3 caption '&Delete' width 55 height 20 action events_(3) @ 0,180 button btn4 caption '&Print' width 55 height 20 action Print_List() @ 0,240 button btn5 caption '&Reload' width 55 height 20 action load_data(1) @ 0,300 button btn6 caption '&Quit' width 55 height 20 action form1.release define grid grid1 row 22 col 5 width 300 height 300 headers {'Id','First Name','Last Name','Salary'} widths { 50, 80,110,115 } justify {BROWSE_JTFY_RIGHT,BROWSE_JTFY_LEFT,BROWSE_JTFY_LEFT,BROWSE_JTFY_RIGHT} on dblclick events_(2) on change form1.statusbar.item(1) := "Register "+; ltrim(str(form1.grid1.value))+" of "+alltrim(str(form1.grid1.itemcount)) columncontrols { ; {'TEXTBOX','NUMERIC'} , ; {'TEXTBOX','CHARACTER'}, ; {'TEXTBOX','CHARACTER'}, ; {'TEXTBOX','NUMERIC'} ; } end grid define statusbar statusitem "Register " date end statusbar end window form1.center activate window form1 return *-------------------------------------------------------------------------------- procedure load_data(n) local i, oc form1.grid1.Deleteallitems oConnection:Setsql('SELECT * FROM Employee ORDER BY Emp_No') if !oConnection:Open() msgstop("Can't connect to database") else for i= 1 to len( oConnection:aRecordset ) form1.grid1.additem( oConnection:aRecordset[ i ] ) next form1.grid1.value := n end oConnection:Close() form1.grid1.setfocus return *-------------------------------------------------------------------------------- procedure events_(n) local cL_Name := "",cSalary := "",cF_Name := "", cID := "", Str do case case n == 1 .or. n == 2 if n = 2 cID := form1.grid1.cell( form1.grid1.value, 1 ) cF_Name := form1.grid1.cell( form1.grid1.value, 2 ) cL_Name := form1.grid1.cell( form1.grid1.value, 3 ) cSalary := form1.grid1.cell( form1.grid1.value, 4 ) end define window form1a; at 0,0 width 270 height 220; title iif(n = 2,'Edit','Add'); modal; font 'ms sans serif' size 8 @ 10, 10 label label1 width 60 height 20 value 'ID' RIGHTALIGN @ 40, 10 label label2 width 60 height 20 value 'First Name' RIGHTALIGN @ 70, 10 label label3 width 60 height 20 value 'Last Name' RIGHTALIGN @ 100,10 label label4 width 60 height 20 value 'Salary' RIGHTALIGN @ 10,80 textbox text1 width 40 height 20 value cID READONLY NUMERIC INPUTMASK '99999' NOTABSTOP @ 40,80 textbox text2 width 100 height 20 value cF_Name MaxLength 15 @ 70,80 textbox text3 width 170 height 20 value cL_Name MaxLength 25 @ 100,80 textbox text4 width 90 height 20 value cSalary NUMERIC INPUTMASK '9999999999.99' @ 150,60 button button1 caption '&Save' action save_data( n ) width 80 height 20 @ 150,150 button button2 caption '&Close' action form1a.release width 80 height 20 on key escape action form1a.button2.onclick end window form1a.center activate window form1a case n == 3 Str := "DELETE FROM Employee WHERE Emp_No="+str(form1.grid1.cell(form1.grid1.value,1)) if msgyesno('Delete this register? '+hb_osnewline()+form1.grid1.cell(form1.grid1.value,2),'Confirm') oConnection:Setsql( Str ) if !oConnection:Open() msgstop("Can't delete the register") else n := form1.grid1.value form1.grid1.deleteitem( n ) form1.grid1.value := iif(n > 1, n-1, 1) form1.statusbar.item(1) := "Register "+; ltrim(str(form1.grid1.value))+" of "+alltrim(str(form1.grid1.itemcount)) end oConnection:Close() form1.grid1.setfocus end endcase Form1.Grid1.SetFocus() return *-------------------------------------------------------------------------------- procedure save_data(n) *-------------------------------------------------------------------------------- local Str, cID if n = 1 If ( form1a.text1.value = 0 ) cID := "null" else cID := "'"+Alltrim(Str(form1a.text1.value))+"'" end Str := "INSERT INTO Employee (EMP_NO,FIRST_NAME,LAST_NAME,SALARY) VALUES ("+cID+; ",'"+form1a.text2.value+; "','"+form1a.text3.value+; "','"+Alltrim(Str(form1a.text4.value))+; "')" //msgstop( Str ) else cID := "'"+Alltrim(Str(form1a.text1.value))+"'" Str := "UPDATE Employee SET FIRST_NAME='"+form1a.text2.value+"',"+; " LAST_NAME='"+form1a.text3.value + "'," + ; " SALARY='" + Str(form1a.text4.value) + "'" + ; " WHERE Emp_No=" + cID //msgstop( Str ) end oConnection:Setsql( Str ) if !oConnection:Open() msgstop("Can't update Employee table") end oConnection:Close() if n == 1 load_data( form1.grid1.itemcount+1 ) else form1.grid1.cell( form1.grid1.value, 1 ) := form1a.text1.value form1.grid1.cell( form1.grid1.value, 2 ) := form1a.text2.value form1.grid1.cell( form1.grid1.value, 3 ) := form1a.text3.value form1.grid1.cell( form1.grid1.value, 4 ) := form1a.text4.value end form1.statusbar.item(1) := "Register "+; ltrim(str(form1.grid1.value))+" de "+alltrim(str(form1.grid1.itemcount)) form1a.release return *-------------------------------------------------------------------------------- procedure adjust() *-------------------------------------------------------------------------------- form1.grid1.width := form1.width - 20 form1.grid1.height:= ( form1.height- form1.grid1.row ) - 60 return *-------------------------------------------------------------------------------- procedure Print_List() *-------------------------------------------------------------------------------- Local nomimp, PAG, LIN, I Local cL_Name,cSalary,cF_Name,cID Private TitlePrint := "Employee List" nomimp := GetPrinter() SELECT PRINTER nomimp ORIENTATION PRINTER_ORIENT_PORTRAIT PREVIEW START PRINTDOC NAME TitlePrint START PRINTPAGE PAG:=0 LIN:=0 FOR I := 1 TO form1.grid1.ItemCount cID := form1.grid1.Cell( I, 1 ) cF_Name := form1.grid1.Cell( I, 2 ) cL_Name := form1.grid1.Cell( I, 3 ) cSalary := form1.grid1.Cell( I, 4 ) IF LIN>=260 .OR. PAG=0 IF PAG<>0 @ LIN+5,105 PRINT "Continue on Page: "+LTRIM(STR(PAG+1)) CENTER END PRINTPAGE START PRINTPAGE ENDIF PAG++ @ 20,20 PRINT "Business Name" @ 20,190 PRINT "Page: "+LTRIM(STR(PAG)) RIGHT @ 25,20 PRINT DATE() @ 25,105 PRINT "Name of Business" CENTER @ 35,105 PRINT TitlePrint FONT "ft18" CENTER LIN:=55 @ LIN+4,20 PRINT LINE TO LIN+4,130 @ LIN,27 PRINT "ID" RIGHT @ LIN,40 PRINT "First Name" @ LIN,70 PRINT "Last Name" @ LIN,125 PRINT "Salary" RIGHT LIN:=LIN+5 ENDIF @ LIN,27 PRINT cID RIGHT @ LIN,40 PRINT cF_Name @ LIN,70 PRINT cL_Name @ LIN,125 PRINT TRANSFORM( cSalary , "9,999,999,999.99" ) RIGHT LIN:=LIN+5 NEXT I END PRINTPAGE END PRINTDOC return [/pre2]

gfilatov2002: SergKis пишет: Пример BASIC\Firebird работает в unicode версии Ok Благодарю за подтверждение

gfilatov2002: Выложил 2-е обновление сборки 21.03 с учетом всех последних исправлений по адресу http://hmgextended.com/files/CONTRIB/hmg-21.03-setup.exe Что нового: [pre2] * Fixed: ON SIZE event is triggered to early in the Modal window with the defined menu. Bug was reported by Theo Pluijm <trmpluym/at/gmail.com>. Based upon a contribution of HMG user Edward. Adapted for Minigui Extended by Grigory Filatov <gfilatov@inbox.ru> * Modified: Adaptation of the MiniGUI core for compatibility with the latest Harbour compiler version 3.0.0 (SVN 2011-07-17 19:15): - the updated header include\i_pseudofunc.ch; - added translate directives for missed Harbour 3.2 functions; - Vista's TaskDialog implementation was blocked due to the incompatibility with Harbour 3.0. Contributed by Grigory Filatov <gfilatov@inbox.ru>. * Updated: Implementation of UNICODE support in the MiniGUI core: - fixed problem with the returned items value in ListBox, ComboBox and GET ini file command. Bug was reported by Allan De Sa. Contributed by Grigory Filatov <gfilatov@inbox.ru> * Updated: Harbour Compiler 3.2.0dev (SVN 2021-04-10 23:32): * Updated: PostGreSQL library source code (see in folder \Source\HbPgSql). Contributed by Grigory Filatov <gfilatov@inbox.ru> (look at ReadMe.txt in folder \harbour) * New: 'ButtonEx and Snap Control' sample: added the function Snap2Ctrl(). Contributed by Pierpaolo Martinello <pier.martinello[at]alice.it> (see demo3.prg in folder \samples\Basic\BUTTON_1) [/pre2] Также подготовил MinGW сборки с использованием свежей версии 10.3 (вышла 8 апреля 2021 г.)

Andrey: Поставил, полёт нормальный !

gfilatov2002: Завершена подготовка 3-го обновления сборки 21.03, которое выйдет послезавтра. Что нового: * New: The OwnerDraw Menu style supported the following optional command: - SET MENUTHEME [ DEFAULT | XP | 2000 | DARK | USER <aMenu> ] [ OF <form> ] Based on using of the function HMG_SetMenuTheme(). Contributed by Grigory Filatov <gfilatov@inbox.ru> (see menudemo2.prg in folder \samples\Basic\Menu) * Updated: Synchronized Extended HMG for compatibility with Official HMG: - added the useful functions (and appropriate properties) below: - TreeItemGetParentValue(); - TreeItemSetNodeFlag(). Based upon a contribution of Claudio Soto <srvet@adinet.com.uy>. Adapted for Minigui Extended by Grigory Filatov <gfilatov@inbox.ru> (see demo in folder \samples\Basic\TreeMenu_3) * Updated: Implementation of UNICODE support in the MiniGUI core: - fixed problem with the TIMEPICKER format string. Bug was reported by Allan De Sa. Contributed by Grigory Filatov <gfilatov@inbox.ru> * Updated: HbSQLite3 library: - update for using SQLITE3 version 3.35.5 (from 3.35.4). Contributed by Grigory Filatov <gfilatov@inbox.ru>. * Updated: Harbour Compiler 3.2.0dev (SVN 2021-04-14 22:25). Contributed by Grigory Filatov <gfilatov@inbox.ru> (look at ReadMe.txt in folder \harbour) * New: 'Save/Load Tree Structure in the JSON format' sample. Based upon a contribution of HMG user Edward. Adapted for Minigui Extended by Grigory Filatov <gfilatov@inbox.ru> (see in folder \samples\Basic\TreeMenu_3) * Updated: 'Simple PDF Class' sample: - updated for using of the recent PDF Class version. Based upon a contribution of Jose Quintas. Adapted for Minigui Extended by Grigory Filatov <gfilatov@inbox.ru> (see in folder \samples\Advanced\HaruPDF_2) Ваши комментарии приветствуются...

gfilatov2002: Как и обещал, выложил 3-е обновление сборки 21.03 с учетом всех последних исправлений Рассматриваю эту сборку как финальную по причинам, которые неоднократно озвучивались ранее (слабый интерес и отсутствие поддержки).

krutoff: Проверил псевдофункцию _SetStatusItemWidth из файла i_status.ch - она не работает. Отработала процедура PROCEDURE _SetStatusWidth ( ParentForm , Item , Size ) файла h_controlmisc.prg

rvu: В уникодной версии пытаюсь вывести значение из базы, где оно записано в кодировке 1251 HB_STRTOUTF8(ALLTRIM(BASECONFIG->NAME2)) Показывает ерунду. А так - HB_STRTOUTF8('проба') нормально показывает. Пытался второй параметр HB_STRTOUTF8() прописывать, что ни пробовал, ничего не вышло. Можно, конечно, саму базу под UTF8 переделать, но интересно, почему здесь не работает.

SergKis: rvu HB_STRTOUTF8(ALLTRIM(BASECONFIG->NAME2), "RU1251")

rvu: SergKis При компиляции выдает ощибку. Причем, со словом "проба" тоже. Неверный аргумент. Подумал, что HB_STRTOUTF8('проба') это неверно, у меня же текст программы уникодный. Что и куда она перекодирует? Написал HB_STRTOUTF8(HB_UTF8TOSTR('проба')) и даже HB_UTF8TOSTR('проба'). Текст, написанный в программе она никак никуда не меняет.

SergKis: Ранее уже выкладывал пример unicode, повторю тут https://TransFiles.ru/2f2l2

rvu: SergKis Отлично! Спасибо! К сожалению эти примеры долго не живут, упустил я его в прошлый раз.

SergKis: PS чуток поправить надо (колонку вставил, а в отчетах не поправил) [pre2] *-----------------------------------------------------------------------------* STATIC FUNC Report( oWnd, nEvent ) *-----------------------------------------------------------------------------* ... LOCAL cNam := oBrw:aColumns[ nEvent+oBrw:nColumn("MARRIED") ]:cHeading ... [/pre2]

rvu: Вызывал раньше из своей основной программы другую, которую закрывал такой функцией: #define WM_CLOSE 0x0010 FUNCTION CloseIt() PARAMETERS closeDoc LOCAL hWnd := FindWindowEx( ,,, Substr(closeDoc,2,LEN(closeDoc)-2) ) IF IsWindowHandle( hWnd ) PostMessage( hWnd, WM_CLOSE, 0, 0 ) Return .T. ENDIF Return .F. После перехода на уникод перестало работать, IsWindowHandle( hWnd ) возвращает .F. хотя тайтл окна правильный. Попробовал hb_utf8Substr, не помогло, да и вряд ли могло бы, у меня в тайтле только английские буквы и числа и пробел между ними.

SergKis: попробуйте EnumWindows() в примерах есть использование, поищите

Dima: rvu пишет: После перехода на уникод перестало работать, IsWindowHandle( hWnd ) возвращает .F. А что именно возвращается в hWnd в уникодной версии ?

SergKis: Dima пишет А что именно возвращается в hWnd в уникодной версии ? Наверно 0 (не найдено), т.к. ф-я [pre2] HB_FUNC( FINDWINDOWEX ) { #ifndef UNICODE LPCSTR lpszClass = ( char * ) hb_parc( 3 ); LPCSTR lpszWindow = ( char * ) hb_parc( 4 ); #else LPWSTR lpszClass = AnsiToWide( ( char * ) hb_parc( 3 ) ); LPWSTR lpszWindow = AnsiToWide( ( char * ) hb_parc( 4 ) ); #endif HB_RETNL( ( LONG_PTR ) FindWindowEx( ( HWND ) HB_PARNL( 1 ), ( HWND ) HB_PARNL( 2 ), lpszClass, lpszWindow ) ); #ifdef UNICODE hb_xfree( lpszClass ); hb_xfree( lpszWindow ); #endif } [/pre2] Через EnumWindows() можно получить весь список hWnd, title и ClassName

rvu: Dima пишет: А что именно возвращается в hWnd в уникодной версии ? SergKis пишет: Наверно 0 Да, 0.

Dima: SergKis пишет: попробуйте EnumWindows() Это конечно вариант , но с другой стороны если "сломали" работающую функцию FindWindowEx в уникодной версии , то надо бы починить.

SergKis: Dima пишет то надо бы починить. С этим никто не спорит. Понятно , что для unicode перелопачено много текста и отладка требуется. Попробовал ф-ю EnumWindows() вариант (unicode версия hmg) [pre2] *-----------------------------------------------------------------------------* STATIC FUNCTION HandlesHbWin( cText, cClass, lLogOut ) *-----------------------------------------------------------------------------* LOCAL i, h, t LOCAL aWnd := EnumWindows() LOCAL aTmp := {} LOCAL aRet := {} IF Empty(cClass) aTmp := aWnd ELSE FOR EACH h IN aWnd IF IsWindowHandle( h ) .and. GetClassName( h ) == cClass AAdd( aTmp, h ) ENDIF NEXT ENDIF IF ! empty(cText) .and. HB_ISCHAR(cText) .and. Len(aTmp) > 0 FOR EACH h IN aTmp IF IsWindowHandle( h ) t := GetWindowText( h ) IF cText $ t ; AAdd( aRet, h ) ENDIF ENDIF NEXT ELSE aRet := aTmp ENDIF IF ! Empty(lLogOut) FOR i := 1 TO Len(aTmp) IF IsWindowHandle( aTmp[ i ] ) t := GetWindowText(aTmp[ i ]) _LogFile( .T., str(i, 5), aTmp[ i ], GetClassName(aTmp[ i ]), t ) ENDIF NEXT ENDIF RETURN aRet [/pre2] Не работает GetWindowText(), через имя класса hWnd получен, через GetWindowText() нет. Вариант unicode ф-ии GetWindowText() нашей версии и версии hmg [pre2] Наш (работает) HB_FUNC( GETWINDOWTEXT ) { HWND hWnd = ( HWND ) hb_parnl( 1 ); int iLen = GetWindowTextLength( hWnd ); TCHAR *cText = ( TCHAR * ) hb_xgrab( (iLen + 1)*2 ); int iRet = GetWindowText( hWnd, ( LPTSTR ) cText, (iLen + 1)*2 ); hb_retclen_t( cText, iRet ); hb_xfree( cText ); } uncode HMG HB_FUNC( GETWINDOWTEXT ) { #ifdef UNICODE LPSTR pStr; #endif HWND hWnd = ( HWND ) HB_PARNL( 1 ); int iLen = GetWindowTextLength( hWnd ); LPTSTR szText = ( TCHAR * ) hb_xgrab( ( iLen + 1 ) * sizeof( TCHAR ) ); iLen = GetWindowText( hWnd, szText, iLen + 1 ); #ifndef UNICODE iLen = GetWindowText( hWnd, szText, iLen + 1 ); hb_retclen( szText, iLen ); #else GetWindowText( hWnd, szText, iLen + 1 ); pStr = WideToAnsi( szText ); hb_retc( pStr ); hb_xfree( pStr ); #endif hb_xfree( szText ); } [/pre2]

SergKis: PS Результат вызовов ф-ии HandlesHbWin(...) в log [pre2] Find Text = HandlesHbWin('VLC iptv viewer.', , .T.) // не найдено - все в журнал 1 131180 tooltips_class32 '' 2 131202 SynTPEnhTFPWndClass Forcepad driver tray window 3 131138 SynTrackCursorWindowClass '' 4 131140 SynTPHelperWndClass '' 5 65922 ForegroundStaging '' 6 65872 ForegroundStaging '' 7 65754 tooltips_class32 '' 8 65782 tooltips_class32 '' 9 65776 tooltips_class32 '' 10 65772 tooltips_class32 '' 11 65746 tooltips_class32 '' 12 131338 TaskListThumbnailWnd '' 13 131336 tooltips_class32 '' 14 65796 tooltips_class32 '' 15 65792 tooltips_class32 '' 16 65714 Shell_TrayWnd '' 17 65794 tooltips_class32 '' 18 65756 NotifyIconOverflowWindow '' 19 66056 SystemTray_Main Battery Meter 20 66088 ATL:00007FF855FA21F0 '' 21 66114 ATL:00007FF84C89C230 Network Flyout 22 66112 PNIHiddenWnd '' 23 65950 CiceroUIWndFrame CiceroUIWndFrame 24 66480 Internet Explorer_Hidden '' 25 66478 Internet Explorer_Hidden '' 26 66476 Internet Explorer_Hidden '' 27 66468 Internet Explorer_Hidden '' 28 65942 ClassicShell.COwnerWindow '' 29 65888 CiceroUIWndFrame CiceroUIWndFrame 30 65886 CiceroUIWndFrame TF_FloatingLangBar_WndTitle 31 65836 tooltips_class32 '' 32 4457622 GDI+ Hook Window Class GeпЊ°дІ¤; 33 590832 ConsoleWindowClass {C:\MiniGuiUnicode\SAMPLES\_Test\APP_OOPREPORT} - Far 3.0.5511 x64 РђРґРјРёРЅРёСЃС‚СЂР°С‚РѕСЂ 34 4261026 VLC video main 0000029B6AE00660 VLC (Direct3D11 output) 35 7341156 Qt5QWindowIcon Р°ВњР°РђР±В‚Р± Р°Р‚Р°В’ - РњРµРґРёР°РїСЂРѕРёРіСЂС‹РІР°С‚РµР»СЊ VLC 36 22217626 QTrayIconMessageWindowClass QTrayIconMessageWindow 37 11535482 Static VLC ghk 3.0.12 38 12780242 GDI+ Hook Window Class G 39 3802124 Chrome_WidgetWin_1 '' 40 6292588 Chrome_WidgetWin_1 РќРѕРІР°СЏ РІРµСЂСЃРёСЏ Р Р°СЃС€РёСЂРµРЅРЅРѕРіРѕ СЂРµР»РёР·Р° Р±РёР±Р»РёРѕС‚РµРєРё MiniGUI (С‡Р°СЃС‚СЊ VI ) (РїСЂРѕРґРѕР»Р¶РµРЅРёРµ) - Google Chrome 41 12190726 Chrome_WidgetWin_0 '' 42 79496232 Chrome_WidgetWin_0 '' 43 15598672 Chrome_WidgetWin_0 '' 44 13763674 Chrome_StatusTrayWindow '' 45 9438310 Chrome_SystemMessageWindow '' 46 76153996 Chrome_WidgetWin_0 '' 47 722154 Base_PowerMessageWindow '' 48 13173218 crashpad_SessionEndWatcher '' 49 65862 ApplicationManager_DesktopShellWindow '' 50 3276890 CTouchPadSynchronizer TouchPad object helper window 51 3211396 CTouchPadSynchronizer TouchPad object helper window 52 328538 FarHiddenWindowClass '' 53 525076 WindowsForms10.Window.8.app.0.d3a00f_r6_ad1 IntelВ® Management and Security Status 54 262970 WindowsForms10.Window.0.app.0.d3a00f_r6_ad1 '' 55 394082 WindowsForms10.tooltips_class32.app.0.d3a00f_r6_ad1 '' 56 328026 ComboLBox '' 57 394230 ComboLBox '' 58 131802 .NET-BroadcastEventWindow.4.0.0.0.d3a00f.0 .NET-BroadcastEventWindow.4.0.0.0.d3a00f.0 59 328080 GDI+ Hook Window Class G 60 131608 WindowsForms10.Window.0.app.0.141b42a_r34_ad1 '' 61 131352 GDI+ Hook Window Class G 62 197630 .NET-BroadcastEventWindow.4.0.0.0.141b42a.0 .NET-BroadcastEventWindow.4.0.0.0.141b42a.0 63 459726 ATL:00A9A850 Lightshot_Tray_Wnd 64 66490 GDI+ Hook Window Class G 65 66502 VSyncHelper-000001EE4DD3B2A0-235bd58 '' 66 66506 VSyncHelper-000001EE4DD3B240-235c065 '' 67 66508 VSyncHelper-000001EE4DD3B1E0-235c1ac '' 68 66504 VSyncHelper-000001EE4DD3B180-235c013 '' 69 66360 GadgetHostListener '' 70 66354 8GadgetPackHelper '' 71 66350 BasicWindow SidebarBroadcastWatcher 72 66346 GDI+ Hook Window Class G 73 197044 EVERYTHING_TASKBAR_NOTIFICATION '' 74 131546 WindowsForms10.Window.0.app.0.14a43c5_r6_ad1 '' 75 131544 .NET-BroadcastEventWindow.4.0.0.0.14a43c5.0 .NET-BroadcastEventWindow.4.0.0.0.14a43c5.0 76 66208 HwndWrapper[SmartAudio3.exe;;666cf6d2-fb24-4259-95a1-8873a2d0dd06] '' 77 66200 HwndWrapper[SmartAudio3.exe;;498f853c-6c9e-4451-92fc-be6461d8dd95] SystemResourceNotifyWindow 78 131732 HwndWrapper[SmartAudio3.exe;;ea92a926-afef-45ac-b7bf-165f90465a8d] MediaContextNotificationWindow 79 197240 ATL:00007FF848D17D50 HDAudioAPI-D9A3021B-9BCE-458C-B667-9029C4EF4050 80 131206 SynTPEnhTrayWndClass Touchpad driver tray icon window 81 66106 CTouchPadSynchronizer TouchPad object helper window 82 66104 SynTPEnhWndClass Touchpad driver helper window 83 66100 ScrollerooWindowClass Touchpad driver backward compatibility window 84 66096 WorkerW '' 85 66048 WorkerW '' 86 66050 OleDdeWndClass DDE Server Window 87 65930 TabletModeCoverWindow '' 88 66066 WorkerW '' 89 66068 WorkerW '' 90 65912 DummyDWMListenerWindow '' 91 65906 EdgeUiInputTopWndClass '' 92 65870 OleDdeWndClass DDE Server Window 93 65858 WorkerW '' 94 65854 ClassicStartMenu.CStartHookWindow StartHookWindow 95 65844 WorkerW '' 96 65842 WorkerW '' 97 65822 WorkerW '' 98 65820 WorkerW '' 99 131716 AfxFrameOrView140su MicTray 100 197210 WorkerW '' 101 131710 BluetoothNotificationAreaIconWindowClass BluetoothNotificationAreaIconWindowClass 102 262754 QLBCONTROLLER QLBController 103 131190 MS_WebcheckMonitor MS_WebcheckMonitor 104 65712 #32770 The Event Manager Dashboard 105 65686 DDEMLEvent '' 106 65682 DDEMLMom '' 107 131104 PushNotificationsPowerManagement Windows Push Notifications Platform 108 131106 COMTASKSWINDOWCLASS Task Host Window 109 65620 Dwm DWM Notification Window 110 131110 CicLoaderWndClass '' 111 263244 tooltips_class32 '' 112 131652 ESET Client Frame ESET Smart Security 113 66438 SideBar_HTMLHostWindow '' 114 66426 BasicWindow Clock 115 66466 SideBar_HTMLHostWindow '' 116 66462 BasicWindow iBattery 117 66442 SideBar_HTMLHostWindow '' 118 66430 BasicWindow Calendar 119 66440 SideBar_HTMLHostWindow '' 120 66428 BasicWindow WeatherCenter 121 14615606 tooltips_class32 '' 122 1443008 HMG_FORM_wM3U VLC iptv viewer. 123 9962252 WorkerW '' 124 65828 Progman Program Manager 125 66134 MSCTFIME UI MSCTFIME UI 126 66102 IME Default IME 127 131142 IME Default IME 128 1507496 MSCTFIME UI MSCTFIME UI 129 65924 IME Default IME 130 1311580 MSCTFIME UI MSCTFIME UI 131 65860 IME Default IME 132 65814 MSCTFIME UI MSCTFIME UI 133 65716 IME Default IME 134 66090 IME Default IME 135 8979572 IME Default IME 136 328526 MSCTFIME UI MSCTFIME UI 137 459756 IME Default IME 138 19334172 IME Default IME 139 41550874 MSCTFIME UI MSCTFIME UI 140 656526 IME Default IME 141 1049794 IME Default IME 142 8324128 IME Default IME 143 26149966 MSCTFIME UI MSCTFIME UI 144 656604 IME Default IME 145 7471792 IME Default IME 146 9962518 IME Default IME 147 5964892 IME Default IME 148 394056 IME Default IME 149 525300 MSCTFIME UI MSCTFIME UI 150 459580 IME Default IME 151 262562 IME Default IME 152 131354 IME Default IME 153 197248 IME Default IME 154 132062 IME Default IME 155 66492 IME Default IME 156 66356 IME Default IME 157 66352 IME Default IME 158 66348 IME Default IME 159 196986 IME Default IME 160 131734 IME Default IME 161 131706 IME Default IME 162 66098 IME Default IME 163 65856 IME Default IME 164 65830 MSCTFIME UI MSCTFIME UI 165 65824 IME Default IME 166 66182 IME Default IME 167 66178 IME Default IME 168 66152 IME Default IME 169 65718 IME Default IME 170 131102 IME Default IME 171 197230 MSCTFIME UI MSCTFIME UI 172 131578 IME Default IME 173 66452 MSCTFIME UI MSCTFIME UI 174 66434 IME Default IME 175 66474 MSCTFIME UI MSCTFIME UI 176 66464 IME Default IME 177 66456 MSCTFIME UI MSCTFIME UI 178 66436 IME Default IME 179 66454 MSCTFIME UI MSCTFIME UI 180 66432 IME Default IME 181 65850 MSCTFIME UI MSCTFIME UI 182 65684 IME Default IME 183 5440658 MSCTFIME UI MSCTFIME UI 184 10159236 IME Default IME Find Class = HandlesHbWin(, 'HMG_FORM_wM3U', .T.) // найдено 1 1443008 HMG_FORM_wM3U VLC iptv viewer. [/pre2]

SergKis: SergKis пишет Не работает GetWindowText() Виноват, работает GetWindowText() и HandlesHbWin() работает. Похоже заработался вчера.

gfilatov2002: Выложил майскую ANSI сборку 21.05 с учетом всех последних изменений по адресу http://hmgextended.com/files/CONTRIB/hmg-21.05-setup.exe Рассматриваю эту сборку как финальную P.S. Архив уникодной сборки также обновил с учетом обсуждения работы функции GetWindowText()

SergKis: gfilatov2002 пишет Архив уникодной сборки также обновил Можно получить этот вариант на посмотрреть ?

rvu: gfilatov2002 А хорошо бы в уникодной версии тоже завести программы-примеры. SergKis выкладывал на днях один.

rvu: gfilatov2002 пишет: Архив уникодной сборки также обновил с учетом обсуждения работы функции GetWindowText() А FindWindowEx() будете менять под уникод?

gfilatov2002: SergKis пишет: Можно получить этот вариант на посмотрреть ? Отправил ссылку в личку

SergKis: gfilatov2002 Спасибо

SergKis: gfilatov2002 что то не то с GetWindowText() unicode [pre2] /* * MINIGUI - Harbour Win32 GUI library Demo * */ #define _HMG_OUTLOG #include "hmg.ch" REQUEST HB_CODEPAGE_UTF8 REQUEST HB_CODEPAGE_RU1251 REQUEST DBFCDX *-----------------------------------------------------------------------------* FUNCTION Main() *-----------------------------------------------------------------------------* 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 OOP ON *-------------------------------- ? "Find Text =", "HandlesHbWin('VLC iptv viewer.', , .T.)" ? HandlesHbWin("VLC iptv viewer.", , .T.) ? ? "Find Class = ", "HandlesHbWin(, 'HMG_FORM_wM3U', .T.)" ? HandlesHbWin(, "HMG_FORM_wM3U", .T.) ? RETURN *-----------------------------------------------------------------------------* STATIC FUNCTION HandlesHbWin( cText, cClass, lLogOut ) *-----------------------------------------------------------------------------* LOCAL i, h, t LOCAL aWnd := EnumWindows() LOCAL aTmp := {} LOCAL aRet := {} IF Empty(cClass) aTmp := aWnd ELSE FOR EACH h IN aWnd IF IsWindowHandle( h ) .and. GetClassName( h ) == cClass AAdd( aTmp, h ) ENDIF NEXT ENDIF IF ! empty(cText) .and. HB_ISCHAR(cText) .and. Len(aTmp) > 0 ? aTmp FOR EACH h IN aTmp ? hb_enumindex(h), h, IsWindowHandle( h ) IF IsWindowHandle( h ) ?? "t =" BEGIN SEQUENCE WITH { |e|break(e) } ?? "->" t := GetWindowText( h ) ?? "<-" END SEQUENCE ?? t IF cText $ t ; AAdd( aRet, h ) ENDIF ENDIF NEXT ELSE aRet := aTmp ENDIF IF ! Empty(lLogOut) FOR i := 1 TO Len(aTmp) IF IsWindowHandle( aTmp[ i ] ) t := GetWindowText(aTmp[ i ]) _LogFile( .T., str(i, 5), aTmp[ i ], GetClassName(aTmp[ i ]), t ) ENDIF NEXT ENDIF RETURN aRet [/pre2] Снимается "Abnormal program termination"

gfilatov2002: SergKis пишет: что то не то Ваш пример у меня отработал нормально. Прошу попробовать снова с самого начала...

SergKis: gfilatov2002 пишет Прошу попробовать снова с самого начала... Так и сделал, не помогло. Убрал GetWndowText(), вывод только класса - работает, на запросе текста валится на строке 32 15008680 GDI+ Hook Window Class Пример [pre2] /* * MINIGUI - Harbour Win32 GUI library Demo * */ #define _HMG_OUTLOG #include "hmg.ch" REQUEST HB_CODEPAGE_UTF8, HB_CODEPAGE_RU1251 REQUEST DBFCDX *-----------------------------------------------------------------------------* FUNCTION Main() *-----------------------------------------------------------------------------* 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 OOP ON *-------------------------------- ? "Find Text =", "HandlesHbWin(, , .T.)" ? HandlesHbWin( , , .T.) ? /* ? "Find Class = ", "HandlesHbWin(, 'HMG_FORM_wM3U', .T.)" ? HandlesHbWin(, "HMG_FORM_wM3U", .T.) ? */ ? "Find Text =", "HandlesHbWin('VLC iptv viewer.', , .T.)" ? HandlesHbWin("VLC iptv viewer.", , .T.) ? */ RETURN *-----------------------------------------------------------------------------* STATIC FUNCTION HandlesHbWin( cText, cClass, lLogOut ) *-----------------------------------------------------------------------------* LOCAL i, h, t LOCAL aWnd := EnumWindows() LOCAL aTmp := {} LOCAL aRet := {} IF Empty(cClass) aTmp := aWnd ELSE FOR EACH h IN aWnd IF IsWindowHandle( h ) .and. GetClassName( h ) == cClass AAdd( aTmp, h ) ENDIF NEXT ENDIF IF ! empty(cText) .and. HB_ISCHAR(cText) .and. Len(aTmp) > 0 ? aTmp FOR EACH h IN aTmp ? hb_enumindex(h), h, IsWindowHandle( h ) IF IsWindowHandle( h ) ?? "t =" BEGIN SEQUENCE WITH { |e|break(e) } ?? "->" t := GetWindowText( h ) ?? "<-" END SEQUENCE ?? t IF cText $ t ; AAdd( aRet, h ) ENDIF ENDIF NEXT ELSE aRet := aTmp ENDIF IF ! Empty(lLogOut) FOR i := 1 TO Len(aTmp) IF IsWindowHandle( aTmp[ i ] ) //t := GetWindowText(aTmp[ i ]) _LogFile( .T., str(i, 5), aTmp[ i ], GetClassName(aTmp[ i ]) /*, t*/ ) ENDIF NEXT ENDIF RETURN aRet [/pre2] Log файл (сначала вывод только с классом, потом с текстом) [pre2] Find Text = HandlesHbWin(, , .T.) 1 131138 SynTrackCursorWindowClass 2 131180 tooltips_class32 3 131202 SynTPEnhTFPWndClass 4 131140 SynTPHelperWndClass 5 65922 ForegroundStaging 6 65872 ForegroundStaging 7 65754 tooltips_class32 8 65782 tooltips_class32 9 65776 tooltips_class32 10 65772 tooltips_class32 11 65746 tooltips_class32 12 131336 tooltips_class32 13 65796 tooltips_class32 14 65792 tooltips_class32 15 65950 CiceroUIWndFrame 16 65714 Shell_TrayWnd 17 131338 TaskListThumbnailWnd 18 65794 tooltips_class32 19 65756 NotifyIconOverflowWindow 20 66056 SystemTray_Main 21 66088 ATL:00007FF855FA21F0 22 66114 ATL:00007FF84C89C230 23 66112 PNIHiddenWnd 24 66480 Internet Explorer_Hidden 25 66478 Internet Explorer_Hidden 26 66476 Internet Explorer_Hidden 27 66468 Internet Explorer_Hidden 28 65942 ClassicShell.COwnerWindow 29 65888 CiceroUIWndFrame 30 65886 CiceroUIWndFrame 31 65836 tooltips_class32 32 15008680 GDI+ Hook Window Class 33 590832 ConsoleWindowClass 34 65862 ApplicationManager_DesktopShellWindow 35 4063322 CTouchPadSynchronizer 36 3997828 CTouchPadSynchronizer 37 66442 SideBar_HTMLHostWindow 38 66430 BasicWindow 39 328538 FarHiddenWindowClass 40 525076 WindowsForms10.Window.8.app.0.d3a00f_r6_ad1 41 262970 WindowsForms10.Window.0.app.0.d3a00f_r6_ad1 42 394082 WindowsForms10.tooltips_class32.app.0.d3a00f_r6_ad1 43 328026 ComboLBox 44 394230 ComboLBox 45 131802 .NET-BroadcastEventWindow.4.0.0.0.d3a00f.0 46 328080 GDI+ Hook Window Class 47 131608 WindowsForms10.Window.0.app.0.141b42a_r34_ad1 48 131352 GDI+ Hook Window Class 49 197630 .NET-BroadcastEventWindow.4.0.0.0.141b42a.0 50 459726 ATL:00A9A850 51 66490 GDI+ Hook Window Class 52 66502 VSyncHelper-000001EE4DD3B2A0-235bd58 53 66506 VSyncHelper-000001EE4DD3B240-235c065 54 66508 VSyncHelper-000001EE4DD3B1E0-235c1ac 55 66504 VSyncHelper-000001EE4DD3B180-235c013 56 66360 GadgetHostListener 57 66354 8GadgetPackHelper 58 66350 BasicWindow 59 66346 GDI+ Hook Window Class 60 197044 EVERYTHING_TASKBAR_NOTIFICATION 61 131546 WindowsForms10.Window.0.app.0.14a43c5_r6_ad1 62 131544 .NET-BroadcastEventWindow.4.0.0.0.14a43c5.0 63 66208 HwndWrapper[SmartAudio3.exe;;666cf6d2-fb24-4259-95a1-8873a2d0dd06] 64 66200 HwndWrapper[SmartAudio3.exe;;498f853c-6c9e-4451-92fc-be6461d8dd95] 65 131732 HwndWrapper[SmartAudio3.exe;;ea92a926-afef-45ac-b7bf-165f90465a8d] 66 197240 ATL:00007FF848D17D50 67 131206 SynTPEnhTrayWndClass 68 66106 CTouchPadSynchronizer 69 66104 SynTPEnhWndClass 70 66100 ScrollerooWindowClass 71 66096 WorkerW 72 66048 WorkerW 73 66050 OleDdeWndClass 74 65930 TabletModeCoverWindow 75 66066 WorkerW 76 66068 WorkerW 77 65912 DummyDWMListenerWindow 78 65906 EdgeUiInputTopWndClass 79 65870 OleDdeWndClass 80 65858 WorkerW 81 65854 ClassicStartMenu.CStartHookWindow 82 65844 WorkerW 83 65842 WorkerW 84 65822 WorkerW 85 65820 WorkerW 86 131716 AfxFrameOrView140su 87 197210 WorkerW 88 131710 BluetoothNotificationAreaIconWindowClass 89 262754 QLBCONTROLLER 90 131190 MS_WebcheckMonitor 91 65712 #32770 92 65686 DDEMLEvent 93 65682 DDEMLMom 94 131104 PushNotificationsPowerManagement 95 131106 COMTASKSWINDOWCLASS 96 65620 Dwm 97 131110 CicLoaderWndClass 98 263244 tooltips_class32 99 131652 ESET Client Frame 100 66438 SideBar_HTMLHostWindow 101 66426 BasicWindow 102 66440 SideBar_HTMLHostWindow 103 66428 BasicWindow 104 66466 SideBar_HTMLHostWindow 105 66462 BasicWindow 106 9962252 WorkerW 107 65828 Progman 108 66134 MSCTFIME UI 109 66102 IME 110 131142 IME 111 1507496 MSCTFIME UI 112 65924 IME 113 65814 MSCTFIME UI 114 65716 IME 115 66090 IME 116 15401362 IME 117 328526 MSCTFIME UI 118 459756 IME 119 1311580 MSCTFIME UI 120 65860 IME 121 66456 MSCTFIME UI 122 66436 IME 123 394056 IME 124 525300 MSCTFIME UI 125 459580 IME 126 262562 IME 127 131354 IME 128 197248 IME 129 132062 IME 130 66492 IME 131 66356 IME 132 66352 IME 133 66348 IME 134 196986 IME 135 131734 IME 136 131706 IME 137 66098 IME 138 65856 IME 139 65830 MSCTFIME UI 140 65824 IME 141 66182 IME 142 66178 IME 143 66152 IME 144 65718 IME 145 131102 IME 146 197230 MSCTFIME UI 147 131578 IME 148 66452 MSCTFIME UI 149 66434 IME 150 66454 MSCTFIME UI 151 66432 IME 152 66474 MSCTFIME UI 153 66464 IME 154 65850 MSCTFIME UI 155 65684 IME ARRAY[155] Find Text = HandlesHbWin('VLC iptv viewer.', , .T.) ARRAY[155] 1 131138 .T. t = -> <- '' 2 131180 .T. t = -> <- '' 3 131202 .T. t = -> <- Forcepad driver tray window 4 131140 .T. t = -> <- '' 5 65922 .T. t = -> <- '' 6 65872 .T. t = -> <- '' 7 65754 .T. t = -> <- '' 8 65782 .T. t = -> <- '' 9 65776 .T. t = -> <- '' 10 65772 .T. t = -> <- '' 11 65746 .T. t = -> <- '' 12 131336 .T. t = -> <- '' 13 65796 .T. t = -> <- '' 14 65792 .T. t = -> <- '' 15 65950 .T. t = -> <- CiceroUIWndFrame 16 65714 .T. t = -> <- '' 17 131338 .T. t = -> <- '' 18 65794 .T. t = -> <- '' 19 65756 .T. t = -> <- '' 20 66056 .T. t = -> <- Battery Meter 21 66088 .T. t = -> <- '' 22 66114 .T. t = -> <- Network Flyout 23 66112 .T. t = -> <- '' 24 66480 .T. t = -> <- '' 25 66478 .T. t = -> <- '' 26 66476 .T. t = -> <- '' 27 66468 .T. t = -> <- '' 28 65942 .T. t = -> <- '' 29 65888 .T. t = -> <- CiceroUIWndFrame 30 65886 .T. t = -> <- TF_FloatingLangBar_WndTitle 31 65836 .T. t = -> <- '' 32 15008680 .T. t = -> [/pre2] В последней версии не unicode - все работает

SergKis: PS восстановил пред. версию hmg-21.03-unicode, снятия нет, строка получается в лог такая (с бяками) 32 5244084 GDI+ Hook Window Class Geꆐ䮀;

gfilatov2002: SergKis пишет: не помогло. Убрал GetWndowText(), вывод только класса - работает, на запросе текста валится Проверял работу Вашего примера под Windows 7 и Windows 10 - проблем не было. На всякий случай привожу текущую реализацию функции GetWindowText() [pre2]HB_FUNC( GETWINDOWTEXT ) { #ifdef UNICODE LPSTR pStr; #endif HWND hWnd = ( HWND ) HB_PARNL( 1 ); int iLen = GetWindowTextLength( hWnd ); LPTSTR szText = ( TCHAR * ) hb_xgrab( ( iLen + 1 ) * sizeof( TCHAR ) ); #ifndef UNICODE iLen = GetWindowText( hWnd, szText, iLen + 1 ); hb_retclen( szText, iLen ); #else GetWindowText( hWnd, szText, iLen + 1 ); pStr = WideToAnsi( szText ); hb_retc( pStr ); hb_xfree( pStr ); #endif hb_xfree( szText ); [/pre2]

SergKis: gfilatov2002 пишет На всякий случай привожу текущую реализацию функции GetWindowText() Ф-ии отличаются, у меня вариант в zip такой [pre2] HB_FUNC( GETWINDOWTEXT ) { #ifdef UNICODE LPSTR pStr; #endif HWND hWnd = ( HWND ) HB_PARNL( 1 ); int iLen = GetWindowTextLength( hWnd ); LPTSTR szText = ( TCHAR * ) hb_xgrab( ( iLen + 1 ) * sizeof( TCHAR ) ); #ifndef UNICODE iLen = GetWindowText( hWnd, szText, iLen + 1 ); hb_retclen( szText, iLen ); #else GetWindowText( hWnd, szText, ( iLen + 1 ) * sizeof( TCHAR ) ); pStr = WideToAnsi( szText ); hb_retc( pStr ); hb_xfree( pStr ); #endif hb_xfree( szText ); } [/pre2] сделал правку, но сборка не удалась, много warning-ов и в итоге не собирается пример PS в своей версии unicode строка 32 15008680 GDI+ Hook Window Class выглядит так 37 22086474 GDI+ Hook Window Class G

gfilatov2002: SergKis пишет: сборка не удалась Я уже обновил архив Unicode сборки, адрес прежний

SergKis: gfilatov2002 пишет обновил архив Unicode сборки Работает пример на этой сборке, но смущает строка с бяками (в файле бяки визуально ? в квадратике) 32 86835678 GDI+ Hook Window Class G用眠眎; в нашей сборке кракозябликов нет

gfilatov2002: Dima пишет: если "сломали" работающую функцию FindWindowEx в уникодной версии , то надо бы починить. Поправил работу функции FindWindowEx в уникодной версии Залил Unicode архив с исправлением как 1-й апдейт версии 21.05

rvu: gfilatov2002 пишет: Поправил работу функции FindWindowEx в уникодной версии Залил Unicode архив с исправлением как 1-й апдейт версии 21.05 Большое спасибо!

rvu: Использую HPDFPRINT. А какую кодировку писать для уникода в SET HPDFDOC ENCODING TO? И работает ли это вообще с уникодом?

Andrey: Искал для себя пример, нашёл вылет БЕЗ ПОКАЗА ОКНА ОШИБКИ в примере BASIC\Tooltip\TrackingToolTips Что править не разбирался. Подскажите как можно сделать типа Show Balloon для окна расположенного в Панели задач ? Для трея примеры нашёл, а для Панели задачи нет. Можно ли сделать Show Balloon чтобы располагался в правом верхнем углу рабочего стола на 10-20 секунд ?

gfilatov2002: Andrey пишет: нашёл вылет БЕЗ ПОКАЗА ОКНА ОШИБКИ в примере BASIC\Tooltip\TrackingToolTips Поправил в первом апдейте сборки 21.05 Благодарю за помощь

gfilatov2002: Выложил Update 1 для сборки 21.05 с учетом всех последних исправлений и дополнений по адресу http://hmgextended.com/files/CONTRIB/hmg-21.05-setup.exe Обновил также UNICODE архив для всех заинтересованных лиц

i3t4j6: gfilatov2002 пишет: Выложил майскую ANSI сборку 21.05 с учетом всех последних изменений Нельзя ли предусмотреть возможность переключения на старый добрый вариант вывода информации в ErrorLog file (без анимации) ?

gfilatov2002: i3t4j6 пишет: вариант вывода информации в ErrorLog file (без анимации Просматриваю файл ErrorLog по клавише F3 в Total Commanderе - никакой анимации там нет. Другой вариант - собственный обработчик ошибок, образцы есть в примерах

i3t4j6: Program Error -вывод ошибки на экран - обыкновенный текст на белом фоне, а не желтое на красном и на весь экран !

gfilatov2002: i3t4j6 пишет: вывод ошибки на экран - обыкновенный текст на белом фоне Понял Тогда только вариант с собственным обработчиком

Haz: i3t4j6 пишет: Program Error -вывод ошибки на экран - обыкновенный текст на белом фоне, а не желтое на красном и на весь экран ! у меня вообще валится без всяких окон, ни красных ни белых , хорошо хоть лог пишет [pre2] Time from start: 0 days 0 hours 0 mins 3 secs Error MGERROR/0 Control: Btn_01 Of oDlg Not defined. Program terminated. <details><summary> --------------------------------- Stack Trace --------------------------------- </summary> Called from MSGMINIGUIERROR(0) Called from VERIFYCONTROLDEFINED(0) Called from SETPROPERTY(0) Called from FILLDLG(0) Called from HMG_ALERT(0) Called from _ALERT(0) Called from ALERTSTOP(0) Called from SHOWERROR(0) Called from DEFERROR(0) Called from (b)ERRORSYS(0) Called from K_BROWSE(35) in module: K_Browse.prg Called from OPENPRJ(194) in module: Module.prg Called from (b)MAIN(290) in module: Main.prg Called from DO_WINDOWEVENTPROCEDURE(0) Called from TWNDDATA:DOEVENT(0) Called from DO_ONWNDLAUNCH(0) Called from (b)INIT(0) Called from EVENTS(0) Called from DOMESSAGELOOP(0) Called from _ACTIVATEWINDOW(0) Called from MAIN(404) in module: Main.prg [/pre2] Саму ошибку сделал специально чтоб посмотреть на красное [pre2] FUNCTION K_Browse(oWnd, nPage) LOCAl cSql := "" LOCAl cBrw, cBrw1 := "" LOCAl oBrw, oBrw1 LOCAl cAlias := "" LOCAl cAlias1 := "" LOCAL nRecCount := 0 LOCAL aFields := {} LOCAL cCol := "" ? a[1] // вот тут обращение к несуществующему массиву [/pre2] ЗЫ пока Пересобрал библиотеку со старой редакцией ShowError(). работает хоть

Andrey: Haz пишет: у меня вообще валится без всяких окон, ни красных ни белых , хорошо хоть лог пишет Возьми в новом исходнике ErrorSys.prg строка 242: [pre2] AlertStop( cMsg, "Program Error", "ZZZ_B_STOP64", 64, { { 217, 67, 67 } }, .T., bInit )[/pre2] Поставь так: [pre2] MsgStop( cMsg, "Program Error") // обыкновенный текст на белом фоне [/pre2] Но ошибка на красном фоне приятней смотрится и юзер понятней что ошибка. Я писал об ошибке в HMG_ALERT(), что-то там надо докрутить. У меня тоже вылетает в FILLDLG(). Скорее всего ошибка здесь: [pre2] bInit := {|| iif( GetControlType( "Say_01", "oDlg" ) == "EDIT",, ( ; SetProperty( "oDlg", "Say_01", "FontColor", YELLOW ), ; SetProperty( "oDlg", "Say_01", "Alignment", "CENTER" ), ; SetProperty( "oDlg", "Say_02", "FontColor", YELLOW ), ; SetProperty( "oDlg", "Say_02", "Alignment", "CENTER" ) ) ) }[/pre2] Не находит объект Say_02. Ради теста добавь к себе в проект ErrorSys.prg и посмотри... Я у себя сделал сохранения скрина экрана ошибки в папку ошибок - полезная штука для анализа ошибок. У меня в проге один модуль работает с пятью таблицами. И когда происходит ошибка, то я не могу понять где произошла ошибка. Нет алиаса базы при ошибке, нет номера записи при ошибке. Есть только номер строки ошибки и всё. Скрин экрана ОЧЕНЬ помогает при анализе ошибки.

Haz: Andrey пишет: Возьми в новом исходнике ErrorSys.prg строка 242: так уже старый вариант в исхоники перекомпилил Andrey пишет: Но ошибка на красном фоне приятней смотрится и юзер понятней что ошибка. Ну тут на вкус и цвет все фломастеры разные. Мне наоборот кажется что от красных окон пользователи в обморок падать начнут. У меня есть проекты с очень бледным интерфейсом по цветам ( заказчик пожелал ) и красное окно точно ему не понравится.

Andrey: Haz пишет: Мне наоборот кажется что от красных окон пользователи в обморок падать начнут. У меня наоборот, юзер не сообщает об ошибке. Можно поправить на свой ЛЮБОЙ цвет в строке 237: [pre2] SET MSGALERT BACKCOLOR TO MAROON SET MSGALERT FONTCOLOR TO WHITE[/pre2] С новым модулем ErrorSys.prg легче стало править окно ошибки под себя. В старом модуле у меня при ошибке кнопки Ok иногда не было видно, уходило за границу экрана. Да и скопировать ошибку в буфер экрана - это уже давно у всех есть, а в МиниГуи не было до сих пор. В новом модуле ErrorSys.prg так же зашит поиск по трём фильтрам: Если прога стоит на сервере терминалов, то не понятно было какая станция свалилась по ошибке. Сейчас добавлена вот такая строка: [pre2] Html_LineText( HtmArch, 'User: ' + NetName() + " / " + GetUserName() )[/pre2] Я в своём обработчике ошибок (исправленном под себя) добавил ещё такие строки:[pre2] Html_LineText( HtmArch, 'Application: ' + GetExeFileName() + " " + M->cPubVersProg ) Html_LineText( HtmArch, 'User: ' + NetName()+"/"+hb_UserName()+"/"+M->cOperator ) Html_LineText( HtmArch, 'DbInfo: Alias - '+ ALIAS() + ', Ord - ' + OrdSetFocus() + ; ', Recno - ' + HB_NtoS(RecNo()) + '/' + HB_NtoS(LastRec()) )[/pre2]

Haz: Andrey пишет: У меня наоборот, юзер не сообщает об ошибке. я Сам смотрю по логам, плюс прилетает на почту сообщение ( опционально ) и в Bitrix сообщением по некоторым проектам считаю что пользователь и сообщать не должен, т.к. многие прочитать что написано не в состоянии. Andrey пишет: Можно поправить на свой ЛЮБОЙ цвет в строке 237: вопрос не в цвете, как поправить знаю. Вопрос в тихом падении, пользователь даже понять не может куда все делось. Andrey пишет: В новом модуле ErrorSys.prg зашит поиск по трём фильтрам: наверное это хорошо. иногда быстрее просто текстовым просмотром глянуть особенно с телефона . Мне не принципиально в каком виде лог ведется , главное там все есть.

i3t4j6: Haz пишет: Ну тут на вкус и цвет все фломастеры разные. Поэтому я и предложил предусмотреть возможность переключения между классическим вариантом и мультиками.

gfilatov2002: i3t4j6 пишет: я и предложил предусмотреть возможность переключения между классическим вариантом и мультиками. Благодарю за подсказку Я добавил во втором апдейте текущей сборки новую команду: SET SHOWREDALERT [ON | OFF] для возможности управлять видом этого окна. Скоро выложу это обновление

SergKis: gfilatov2002 пишет Я добавил во втором апдейте текущей сборки новую команду: Может вариант блока кода обработчика сделать для замены, что то такое[pre2] STATIC bErrorSys FUNC _bErrorSys( bErr ) IF pCount() > 0 ; bErrorSys := bErr ENDIF RETURN bErrorSys *-----------------------------------------------------------------------------* PROCEDURE ErrorSys *-----------------------------------------------------------------------------* LOCAL bErr := _bErrorSys( bErr ) IF Valtype(bErr) != "B" ; bErr := { | oError | DefError( oError ) } ENDIF ErrorBlock( bErr ) #ifndef __XHARBOUR__ Set( _SET_HBOUTLOG, GetStartUpFolder() + "\error.log" ) Set( _SET_HBOUTLOGINFO, MiniGUIVersion() ) #endif RETURN [/pre2]

gfilatov2002: SergKis пишет: Может вариант блока кода обработчика сделать для замены Сергей! Идея понятна, но для такой замены есть же стандартные средства со времен Клиппера

SergKis: gfilatov2002 пишет для такой замены есть же стандартные средства со времен Клиппера Что то я подзабыл, как это делать, так давно было Для hmg подменяем ErrorSys.prg на свой вариант

gfilatov2002: SergKis пишет: подзабыл, как это делать См. примеры в папках: - basic\MyErrorFunc; - basic\Hmg_Error_2.

gfilatov2002: Выложил Update 2 для сборки 21.05 по адресу http://hmgextended.com/files/CONTRIB/hmg-21.05-setup.exe

SergKis: gfilatov2002 пишет См. примеры в папках: Спасибо Примеры видел, но не вдохновили. Заменой prg (полученный new obj), показалось удобнее в использовании. Предложил блок кода для более гибких вариантов, подменой на лету, если кому надо комбинировать html\txt\...

SergKis: gfilatov2002 Небольшая добавка [pre2] METHOD SetArrayTo( aArray, uFontHF, aHead, aSizes, uFooter, aPicture, aAlign, aName ) CLASS TSBrowse ... FOR nI := 1 TO Len( ::aArray ) FOR nN := 1 TO nColumns If HB_ISCHAR( ::aArray[ nI, nN ] ) .and. CRLF $ ::aArray[ nI, nN ] cData := "" AEval(hb_aTokens(::aArray[ nI, nN ], CRLF), {|x| x := trim(x), cData := If( Len(x) > Len(cData), x, cData )}) Else cData := cValToChar( ::aArray[ nI, nN ] ) EndIf IF Len( cData ) > Len( aDefMaxVal[ nN ] ) IF aDefType[ nN ] == "C" aDefMaxVal[ nN ] := Trim( cData ) aDefMaxLen[ nN ] := Max( aDefMaxLen[ nN ], Len( aDefMaxVal[ nN ] ) ) ELSE aDefMaxVal[ nN ] := cData aDefMaxLen[ nN ] := Max( aDefMaxLen[ nN ], Len( cData ) ) ENDIF ENDIF NEXT NEXT ... [/pre2]

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

SergKis: gfilatov2002 Надо еще поправить, т.к. aDefMaxLen[ nI ] помешает расчету[pre2] METHOD SetArrayTo( aArray, uFontHF, aHead, aSizes, uFooter, aPicture, aAlign, aName ) CLASS TSBrowse ... line 12950 FOR nI := 1 TO nColumns cType := ValType( ::aArray[ 1, nI ] ) aDefType[ nI ] := cType IF cType $ "CM" ::aDefValue[ nI ] := Space( Len( ::aArray[ 1, nI ] ) ) aDefMaxVal[ nI ] := Trim( ::aArray[ 1, nI ] ) aDefMaxLen[ nI ] := iif( CRLF $ aDefMaxVal[ nI ], 0, Len( aDefMaxVal[ nI ] ) ) aDefAlign[ nI ] := DT_LEFT ... [/pre2]

gfilatov2002: SergKis пишет: Надо еще поправить OK

gfilatov2002: Подготовил 3-й апдейт для сборки 25.05, который выйдет на этой неделе Что нового: [pre2] * Modified: The some internal SetGet functions were defined as Static. Contributed by Grigory Filatov <gfilatov@inbox.ru> (see h_controlmisc.prg in folder \Source). * Updated: Adaptation FiveWin Class TSBrowse 9.0 in HMG: - minor correction in the method SetArrayTo in the TSBrowse class. Contributed by Sergej Kiselev (see demo in folder \samples\Advanced\Tsb_SetArrayTo) * Updated: HbSQLite3 library: - update for using SQLITE3 latest version 3.36.0dev. Contributed by Grigory Filatov <gfilatov@inbox.ru>. * Updated: 'GraphPlus library demo' sample. Based upon a contribution of S.Rathinagiri <srgiri@dataone.in> Adapted for Minigui Extended by Grigory Filatov <gfilatov@inbox.ru> (see in folder \samples\Advanced\GraphPlus) * Updated: 'Source Code Formatter' utility. Contributed by Grigory Filatov <gfilatov@inbox.ru> (see in folder \Utils\ofmt) [/pre2] Если у Вас есть полезные дополнения для библиотеки, то я с удовольствием их рассмотрю с целью включения в эту сборку...

Haz: gfilatov2002 пишет: Если у Вас есть полезные дополнения для библиотеки, то я Григорий, не знаю полезно ли? В одном из проектов делал замену errorsys на вывод лога не в html, а в json. Плюс встроенный вьювер ошибок по этому json. Достаточно компактно кажет всю информацию по ошибке. Потом идею бросил, но там так и работает. Если потребуется, могу в отдельный пример накидать. Так ради альтернативы, поскольку там по сути ничего нового, просто вывод в хтмл заменил на запись в json, и стандартные бровсы по массивам

gfilatov2002: Haz пишет: могу в отдельный пример накидать Да, конечно. Такой пример будет интересен в качестве альтернативы...

SergKis: gfilatov2002 Поправить надо[pre2] CLASS TWndData ... METHOD GetProp( xKey ) INLINE iif( xKey == NIL, ::oProp, ::oProp:Get( xKey ) ) ... [/pre2]

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

rvu: В уникодной версии Upper() только с английским языком работает msginfo(UPPER('abc абв áéíóú')) -> ABC абв áéíóú При этом DEFINE COMBOBOX ... UPPERCASE .T. END COMBOBOX переводит регистр правильно в любом языке из тех, что пробовал. Раньше, в неуникодной программе, я переводил данные в STR, потом делал Upper, но сейчас msginfo(HB_STRTOUTF8(UPPER(HB_UTF8TOSTR('abcабв',"RU1251")),"RU1251")) тоже не работает. Как бы с этим справиться? В принципе, могу, конечно, написать свою функцию, где условно 'абвгдежзийклмнопрстуфхцчшщъыьэюя' менять на 'АБВГДЕЖЗИЙКЛМНОПРСТУФХЦЧШЩЪЫЬЭЮЯ'. Но может есть уже штатные средства?

SergKis: rvu пишет В уникодной версии Upper() только с английским языком работает Работает с русским, но с показом списка вопросик. Пример поправленный BASE\Combo_1 https://TransFiles.ru/jyfhn список Combo_1 контрола не отобржается, а выбор работает список Combo_2 контрола работает нормльно

gfilatov2002: rvu пишет: Как бы с этим справиться? Добавил две новые функции: - HMG_UPPER(), - HMG_LOWER(). Результат работы см. на картинке.

SergKis: gfilatov2002 пишет Добавил две новые функции: А разве старые upper() и lower() не должны работать с utf8 сразу ? Если переносить тексты в unicode версию, замучишься править

gfilatov2002: SergKis пишет: разве старые upper() и lower() не должны работать с utf8 Увы, не работают. Это выглядит, как недоработка в Харборе...

gfilatov2002: SergKis пишет: Если переносить тексты в unicode версию Проблема решается с помощью препроцессора

rvu: SergKis пишет: Если переносить тексты в unicode версию, замучишься править В редакторе сразу все. Автоматом. Почему нет?

SergKis: gfilatov2002 пишет Проблема решается с помощью препроцессора rvu пишетВ редакторе сразу все. Автоматом. Почему нет? Это ф-ии hb, они должны работать в UNICODE сборке автоматом, по идее, без костылей иначе смысл такой сборки теряется, тут работает, а здесь нет. gfilatov2002 пишет Увы, не работают. Это выглядит, как недоработка в Харборе... Получается, что строки надо переводить из utf8 в нужную кодировку работать, как раньше, в однобайтной сборке и опять переводить в utf8 для контролов. Тогда смысл utf8 кодировки теряется, контролы в unicode, а работа в однобайтной схеме вполне хватило бы, переводить строки unicode->ansi->unicode, без utf8

rvu: SergKis пишет: работа в однобайтной схеме вполне хватило бы, переводить строки unicode->ansi->unicode, без utf8 Да вот не смогли мы мои хотелки реализовать в своё время. Я тогда очень пытался по вашим советам.

rvu: Следующая проблема с уникодной версией: msginfo(AT('D','ABCDEF')) -> 4 msginfo(AT('Г','АБВГДЕ')) -> 7 С hb_At() аналогично.

gfilatov2002: rvu пишет: С hb_At() аналогично Пробуйте функцию hb_UAt() Также в Харборе есть такие дополнительные функции hb_ULeft() hb_URight() hb_ULen() и т.д.

gfilatov2002: Выложил Update 3 для сборки 21.05 с учетом всех последних исправлений и дополнений по адресу http://hmgextended.com/files/CONTRIB/hmg-21.05-setup.exe Обновил также UNICODE архив...

rvu: gfilatov2002 , спасибо!

SergKis: gfilatov2002 пишет Обновил также UNICODE архив... Пример выше Combo_1 работает, показывает список развернутый, если поправить имя фонта (в родном hmg примере имя задано неверно) [pre2] #define _HMG_OUTLOG #include "hmg.ch" REQUEST HB_CODEPAGE_UTF8, HB_CODEPAGE_RU1251 FUNCTION Main LOCAL a1, a2 SET CODEPAGE TO UNICODE a1 := { ' 1 | Līnijas ' , ' 2 | Rindās ' , ' 3 | Drukāt ' } //a1 := { ' 1 | Один ' , ' 2 | Два ' , ' 3 | Три ' } a2 := { ' 1 | Один - Uno' , ' 2 | Два - Dos' , ' 3 | Три - tres' } a1 := &( hmg_upper(hb_valtoexp(a1)) ) DEFINE WINDOW Form_1 ; AT 0,0 ; WIDTH 400 ; HEIGHT 200 ; TITLE 'ComboBox Demo' ; MAIN @ 20,20 COMBOBOX Combo_1 ; WIDTH 150 ; ITEMS a1 ; VALUE 1 ; ON ENTER {|| MsgInfo ( hb_ntos(This.Combo_1.ITEMHEIGHT)+CRLF+ ; hb_ntos(This.Combo_1.Value)+CRLF+ ; This.Combo_1.DisplayValue ) } ; // UPPERCASE ; ITEMHEIGHT 21 ; FONT 'Courier New' SIZE 12 DEFINE COMBOBOX Combo_2 ROW 20 COL ( This.Combo_1.Col+This.Combo_1.Width + 10 ) WIDTH 150 ITEMS a2 VALUE 1 ON ENTER {|cn| cn :=This.Name, MsgInfo ( hb_ntos(This.&(cn).ITEMHEIGHT)+CRLF+ ; hb_ntos(This.&(cn).Value)+CRLF+ ; This.&(cn).DisplayValue ) } //LOWERCASE .T. ITEMHEIGHT 17 END COMBOBOX END WINDOW CENTER WINDOW Form_1 ACTIVATE WINDOW Form_1 Return Nil [/pre2]

Haz: gfilatov2002 пишет: Да, конечно. Такой пример будет интересен в качестве альтернативы... собрал на скорую тест лог ошибок в json . Еще подпилю позже чуть https://drive.google.com/drive/folders/1Bf5cWHu6qnsv8xJw8aXapZvABQ3JTPdZ?usp=sharing

gfilatov2002: Haz пишет: собрал на скорую OK Подход понравился...

Haz: gfilatov2002 пишет: Подход понравился Это то , что выдернул из проекта и включил в отдельный пример, чтоб показать о чем речь. Сама идея тут понятна, но пример нужно доделать, этим займусь в ближайшее дни. В проекте работает до сих пор успешно, ошибки просматривать удобно и быстро. Что касается вывода сообщения пользователю , этим не заморачивался, просто пишу извини не получилось и войди заново. 😝

Haz: gfilatov2002 пишет: Подход понравился Это то , что выдернул из проекта и включил в отдельный пример, чтоб показать о чем речь. Сама идея тут понятна, но пример нужно доделать, этим займусь в ближайшее дни. В проекте работает до сих пор успешно, ошибки просматривать удобно и быстро. Что касается вывода сообщения пользователю , этим не заморачивался, просто пишу извини не получилось и войди заново. 😝

rvu: gfilatov2002 пишет: Пробуйте функцию hb_UAt() Также в Харборе есть такие дополнительные функции hb_ULeft() hb_URight() hb_ULen() и т.д. hb_URAT() нет.

SergKis: rvu Небольшой пример [pre2] #define _HMG_OUTLOG #include "hmg.ch" REQUEST HB_CODEPAGE_UTF8, HB_CODEPAGE_RU1251, HB_CODEPAGE_RU866 REQUEST DBFCDX *-----------------------------------------------------------------------------* FUNCTION Main() *-----------------------------------------------------------------------------* LOCAL cT, cF, n1, n2, t1, t2, t3, t4 SET CODEPAGE TO UNICODE cF := hb_Utf8ToStr("замена", "RU866") cT := hb_memoread("demo.txt") // текст RU866 n1 := At(cF, cT) n2 := RAt(cF, cT) t1 := left(cT, n1) t2 := subs(cT, n2) ? n1, t1 ? n2, t2 ? t3 := hb_StrToUtf8(t1, "RU866") t4 := hb_StrToUtf8(t2, "RU866") ? t3 ? t4 ? RETURN demo.txt. кодировка RU866 -------------------------------- 0 ··· 101 999 1 замена из ремф. замена на аналог из ремфонда 101 1 2 план. устан. ТО плановые установки ТО 101 1 3 возврат с пл.ус возврат с плановых установок 101 1 4 ремонт на месте ремонт на месте 86 1 5 установка в кв. установка в кв. клиента 101 4 6 дополн. услуги дополнительные услуги 101 5 7 монтаж по дог. монтаж АДС по договору польз. 101 2 8 установка под. установка в подъезде 33 4 9 замена а/у замена абон.устройств 101 1 10 замена инд.обор замена индивид. оборудования 101 1 11 установка в под 33 2 12 монтаж на под 33 2 13 установка в под установка в подъезде 33 4 14 установка в по. установка в подъезде 33 4 13 ремонт на месте ремонт на месте 33 1 14 33 0 11 замена замена оборудования 80 4 12 замена общая замена оборудования всего 86 1 13 86 0 [/pre2]

rvu: SergKis пишет: cF := hb_Utf8ToStr("замена", "RU866") У меня не только русский язык. У меня любой язык. И собрать свою Rat() легко можно из hb_UAt() и hb_ULen(). Тут важно определиться, что должно быть по определению в уникодной версии. Это пусть Григорий скажет.

SergKis: rvu пишет У меня не только русский язык. У меня любой язык Если у вас все базы в utf8, старых вариантов нет и в одном поле присутствуют все языки мира, то ф-ии utf8 в помощь. В др. случаях можно применять и однобайтовые варианты, переводя в utf8 только для контролов

gfilatov2002: rvu пишет: важно определиться, что должно быть по определению в уникодной версии. Конечно, опираемся на Unicode-функционал, который есть в Харборе. Если необходимая реализация отсутствует, то приходится восполнять пробел. rvu пишет: hb_URAT() нет. Эта функция находится в TODO листе Харбора. rvu пишет: собрать свою Rat() легко можно из hb_UAt() и hb_ULen(). Значит, надо идти по этому пути, поскольку дальнейшее развитие Харбора в большом тумане...

rvu: SergKis пишет: В др. случаях можно применять и однобайтовые варианты, переводя в utf8 только для контролов Я пробовал с русским, писал об этом: rvu пишет: msginfo(HB_STRTOUTF8(UPPER(HB_UTF8TOSTR('abcабв',"RU1251")),"RU1251")) Но и это не вышло. Не знаю почему. Там контролы используются, кроме вывода?

SergKis: rvu пишет Но и это не вышло Upper() в unicode переводит ТОЛЬКО английские буквы, потому и не вышло. Другой функционал разделен по именам ф-й.

rvu: gfilatov2002 пишет: Значит, надо идти по этому пути, поскольку дальнейшее развитие Харбора в большом тумане... А что с его развитием вообще? И что с Минигуи Роберто Лопеса? Как я понял там финальная версия 3.4.3? Я смотрел англоязычный форум, вроде, какая-то версия 3.4.4. существует, но я ее не смотрел. Она рабочая? Есть смысл ее ставить и смотреть?

rvu: SergKis пишет: Upper() в unicode переводит ТОЛЬКО английские буквы, потому и не вышло. Для любых кодировок? Тогда понятно. Я же переводил в STR.

gfilatov2002: rvu пишет: что с его развитием вообще? Этого не знает никто, поскольку форум разработчиков Харбора давно молчит. rvu пишет: что с Минигуи Роберто Лопеса? Его никто не поддерживает на постоянной основе. rvu пишет: какая-то версия 3.4.4. существует Уже есть версия 3.5 с минимальными улучшениями. rvu пишет: Она рабочая? Есть смысл ее ставить и смотреть? Да, она рабочая, но, конечно, содержит небольшие ошибки, которые периодически всплывают у пользователей. Смысл посмотреть всегда есть, а вдруг понравится Вывод: если не будет мотивации для разработки (материальной и моральной), то судьба любого дела будет под вопросом.

rvu: gfilatov2002 пишет: собрать свою Rat() легко можно из hb_UAt() и hb_ULen(). Значит, надо идти по этому пути, поскольку дальнейшее развитие Харбора в большом тумане... Function valRat Parameters Pr1,Pr2 If hb_UAt(Pr1,Pr2)=0 Return 0 Endif Return hb_ULen(Pr2)-hb_UAt(Pr1,Pr2)+1 Вы подобные вещи будете у себя включать? Это пустяк, но могут быть посложнее функции. И, наверное, их надо не под зарезервированными именами делать, не hb_URAT(). Так как это имя может потом использоваться в изначальном Харборе.

rvu: gfilatov2002 пишет: Уже есть версия 3.5 с минимальными улучшениями. А ссылку дадите, чтобы самому не искать? gfilatov2002 пишет: если не будет мотивации для разработки (материальной и моральной) Моральная очень даже есть - пользуемся (ничего, что я за всех?)

SergKis: rvu пишет hb_ULen(Pr2)-hb_UAt(Pr1,Pr2)+1 Это если Pr1 встречается 1 раз, если nn раз ? Как в примере выше

rvu: SergKis пишет: Это если Pr1 встречается 1 раз, если nn раз ? Ну вот. Я просто ни разу не использовал ее кроме первого вхождения. Но, кстати, посмотрел Help: SYNTAX RAT(<cSearch>, <cTarget>) --> nPosition ARGUMENTS <cSearch> is the character string to be located. <cTarget> is the character string to be searched. RETURNS RAT() returns the position of <cSearch> within <cTarget> as an integer numeric value. If <cSearch> is not found, RAT() returns zero. Вот где точно неправильно! — If <cSearch> is not found, RAT() returns zero. Добавил: Function valRat Parameters Pr1,Pr2 If hb_UAt(Pr1,Pr2)=0 Return 0 Endif Return hb_ULen(Pr2)-hb_UAt(Pr1,Pr2)+1

SergKis: rvu Зачем городить огород Поищите в hb src\* по Alt+F7 в Far *.c "hb_func( hb_U" посмотрите список найденного, там будет hb_Utf8Rat(...) Используйте в примере выше[pre2] ? n1, t1 ? n2, t2 ? "hb_Utf8Rat", hb_Utf8Rat("замена", hb_StrToUtf8(cT, "RU866")) ? [/pre2]

gfilatov2002: rvu пишет: ссылку дадите click here

rvu: SergKis пишет: "hb_Utf8Rat", hb_Utf8Rat("замена", hb_StrToUtf8(cT, "RU866")) Мне не только русский нужен.

SergKis: rvu пишет Мне не только русский нужен. Вы реально думаете, что ф-ии hb_U...() только для русского языка

rvu: Смутило: hb_StrToUtf8(cT, "RU866") А зачем тогда в примере перекодировку писать? SergKis пишет: Зачем городить огород Григорий написал: gfilatov2002 пишет: Эта функция находится в TODO листе Харбора.

SergKis: rvu пишет А зачем тогда в примере перекодировку писать? Пример был на показ использования однобайтных ф-ий в теле программы на Utf8 ( SET CODEPAGE TO UNICODE ) Взял, что было под рукой, русский (был еще латышский) текст, думал так будет понятнее.

rvu: Поторопился я сказать, что все работает. Не туда посмотрел. Так надо запрашивать? - msginfo(hb_Utf8Rat('ó','áéíóú')) -> 4

SergKis: rvu Что не так ? áéíóú -> 4 áéíóú 12345 Ищет с конца, позиция от начала

rvu: SergKis пишет: Что не так ? Извините. Пришел в офис, а тут задергали. Ничего не соображаю. Это у меня всё не так. Свою хрень себе оставлю, чтобы с конца показывала. Зачем это нужно пока не знаю.

rvu: hb_utf8Len() и hb_ULen() ничем не отличаются? Остальные аналогичные тоже?

Haz: Haz пишет: собрал на скорую тест лог ошибок в json . Еще подпилю позже чуть подпилил чуть https://drive.google.com/file/d/162KSwaSB5_cdALxvLxTmq3AjEO8VkBfa/view?usp=sharing

gfilatov2002: Haz пишет: подпилил Спасибо

gfilatov2002: Выложил Update 4 для сборки 21.05 с учетом всех последних исправлений и дополнений по адресу http://hmgextended.com/files/CONTRIB/hmg-21.05-setup.exe Обновил также UNICODE архив

SergKis: gfilatov2002 Неточность (tget) GETBOX при выполнении присваивания не срабатывает ON CHANGE ...[pre2] METHOD VarPut( xValue, lReFormat ) CLASS Get ... IF lReFormat ::cType := ValType( xValue ) ::xVarGet := xValue ::lEdit := .F. ::Changed := .T. ::Picture := ::cPicture ENDIF ... [/pre2] с добавкой работают _SetGetBoxValue(), _SetValue() и SetProperty(..., ..., "Value", ...) Пример [pre2] /* * MINIGUI - Harbour Win32 GUI library Demo * * Copyright 2021, Verchenko Andrey <verchenkoag@gmail.com> * Copyright 2021, Sergej Kiselev <bilance@bilance.lv> * * Пример построения карточки на базе объекта Tab * События на объектах карточки, контейнер на объектах * Передача и обработка данных на объектах * An example of building a card based on the Tab object * Events at card objects, container at objects * Transfer and processing of data at sites */ #define _HMG_OUTLOG #include "hmg.ch" Function Main Local nG := 20 SET MSGALERT BACKCOLOR TO { 238, 249, 142 } // for HMG_Alert() DEFINE FONT DlgFont FONTNAME "DejaVu Sans Mono" SIZE 14 // for HMG_Alert() SET OOP ON SET FONT TO "Arial", 14 DEFINE WINDOW Form_1 ; AT 0,0 WIDTH 990 HEIGHT 480 ; TITLE 'Harbour MiniGUI Demo: Tab + Button event' ; MAIN ; BACKCOLOR {0,155,173} ; ON SIZE SizeTest(nG) ; ON RELEASE _wSend(103) (This.Object):Cargo := oKeyData() // создать объект (контейнер) для окна Form_1 (This.Object):Cargo:nBtn := 0 (This.Object):Cargo:nModify := 0 @ 5, 990 - nG - 200 BUTTON Btn_Ex CAPTION "Exit" WIDTH 150 HEIGHT 35 ; BOLD ACTION ThisWindow.Release SetTab_1(,nG) // построение Tab / building Tab myThisObjectEvent() // события на объектах формы / events on form objects ON KEY ESCAPE ACTION {|| (ThisWindow.Cargo):nModify := 0 , ; ThisWindow.Release } END WINDOW Form_1.Center Form_1.Activate Return Nil //////////////////////////////////////////////////////////////////////////////// Function myThisObjectEvent (This.Object):Event( 100, {|ow,ky,cn| // обработка кнопок типа "I" Local oBtn := This.&(cn).Cargo Local nMod := ow:Cargo:nModify Local cForm := ow:Name Local aObjName := oBtn:aObjName // список наименований объектов на строке карточки ? "Event(100) PressButton=" , cn, oBtn:nObjId, oBtn:nBtn, nMod, HB_ValToExp(oBtn:aDim), HB_ValToExp(aObjName) myPressButtonI(ky, cForm, cn, oBtn:nObjId, oBtn:nBtn, nMod, oBtn:aDim, aObjName) SetProperty(ow:Name, cn, "Enabled", .T.) Return Nil }) (This.Object):Event( 102, {|ow,ky,am| // обработка menu кнопоки типа "I" Local cn := am[1] // имя кнопки Local nm := am[2] // номер пункта menu Local oBtn := This.&(cn).Cargo Local nMod := ow:Cargo:nModify Local cForm := ow:Name Local aObjName := oBtn:aObjName // список наименований объектов на строке карточки ? "Event(102) PressButton=" , cn, nm, oBtn:nObjId, oBtn:nBtn, nMod, HB_ValToExp(oBtn:aDim), HB_ValToExp(aObjName) MsgDebug("Context menu=",nm," :Event=",ky, cForm, cn, nm, oBtn:nObjId, oBtn:nBtn, nMod, oBtn:aDim, aObjName) Return Nil }) (This.Object):Event( 103, {|ow| // Завершение работы Local nMod := ow:Cargo:nModify Local cForm := ow:Name, cGet, lGet Local aGet := HMG_GetFormControls(cForm, "GETBOX") ? "Event(103) GETBOX modifycation=", nMod IF nMod > 0 FOR EACH cGet IN aGet lGet := This.&(cGet).Cargo:lModify ? hb_enumindex(cGet), cGet, lGet IF !Empty(lGet) ?? This.&(cGet).Value ENDIF NEXT ENDIF Return Nil }) Return Nil ////////////////////////////////////////////////// Procedure SizeTest(nG) Local nW, nH nW := This.ClientWidth nH := This.ClientHeight Form_1.Tab_1.Width := nW - nG*2 Form_1.Tab_1.Height := nH - nG*2 Return #define COLOR_BTNFACE 15 /////////////////////////////////////////////////////////////////////////////// Procedure SetTab_1( lBottomStyle, nG ) Local nColor := GetSysColor( COLOR_BTNFACE ) Local aColor := {GetRed( nColor ), GetGreen( nColor ), GetBlue( nColor )} Local nI, nW, nH, aTabBC, aTabName, aRet, aDimCard Default lBottomStyle := .f. IF IsControlDefined(Tab_1, Form_1) Form_1.Tab_1.Release ENDIF nW := This.ClientWidth nH := This.ClientHeight aTabBC := {159,191,236} aRet := myListTab() // list of cards for tabs aDimCard := aRet[1] aTabName := aRet[2] DEFINE TAB Tab_1 ; OF Form_1 ; AT nG,nG WIDTH nW-nG*2 HEIGHT nH-nG*2 ; VALUE 1 ; HOTTRACK ; BACKCOLOR aTabBC ; FONT "Tahona" SIZE 16 ; ON CHANGE {|| NIL /*MsgInfo( 'Page is changed!' )*/ } _HMG_ActiveTabBottom := lBottomStyle FOR nI := 1 TO LEN( aTabName ) PAGE aTabName[ nI ] TOOLTIP 'Tooltip ' + aTabName[ nI ] // Show a list of cards on a tab ShowPageCard( nI, aDimCard[ nI ] ) END PAGE NEXT END TAB Form_1.Tab_1.BACKCOLOR := aTabBC //aColor Form_1.Tab_1.HTFORECOLOR := BLACK Form_1.Tab_1.HTINACTIVECOLOR := Form_1.Backcolor Return //////////////////////////////////////////////////////////////////// Function ShowPageCard( nI, aDimLine ) Local nJ, cObj, nRow, nCol, nWName, cName, nHLine, nWidth Local nFSize, nGLine nRow := 20 + 40 // отступ сверху Tab_1 nCol := 20 nHLine := 33 // высота строки в карточке nGLine := 20 // расстояние между строками в карточке nFSize := 16 // Определение мах длины по наименованию nWName := 0 FOR nJ := 1 TO LEN( aDimLine ) cName := aDimLine[ nJ, 2 ] + ":" nWidth := GetTxtWidth( cName, nFSize, "Comic Sans MS" ) nWName := MAX( nWidth, nWName ) NEXT For nJ := 1 TO LEN( aDimLine ) cObj := "Label_Name" + HB_NtoS( nJ ) + "_Page" + HB_NtoS( nI ) cName := aDimLine[ nJ, 2 ] @ nRow, nCol LABEL &cObj VALUE cName + ":" ; WIDTH nWName HEIGHT nHLine FONT "Comic Sans MS" SIZE nFSize ; FONTCOLOR BLUE TRANSPARENT RIGHTALIGN VCENTER // показать значений полей базы myCardFieldGetBox( nI, nJ, cObj, aDimLine[nJ], nRow, nCol + nWName + 5, nHLine, nFSize ) nRow += nHLine + nGLine Next Return Nil /////////////////////////////////////////////////////////////////////////////// Function myCardFieldGetBox( nI, nJ, cObj, aDim, nRow, nCol, nHLine, nFSize ) Local cFName := _HMG_DefaultFontName //, nFSize := _HMG_DefaultFontSize Local cTypeLine, xPole, nK, xDopType, xDopRun, cRowCardAccess, xRet Local aField, cField, cAType, cObjGbx, aDimObjAI, nWCol, nWBtn, nHBtn Local cBtnFontI, nBtnFSizeI, cBtnCaptI, nWidth, cMsg, bBlock, xOldGet Local cObjGbxA, nObjId, cForm := ThisWindow.Name cTypeLine := aDim[1] // тип построения строки А-массив, CDN-обычный, M-мемополе и т.д. xPole := aDim[3] // поля базы данных или А-массив xDopType := aDim[4] // доп.обработка построения поля базы данных xDopRun := aDim[5] // вызов функции для кнопки или нет вызова cRowCardAccess := IIF( LEN(aDim) == 6, aDim[6], "?" ) // доступ юзера к строке карточки // можно сделать проверку на доступ nWBtn := nHBtn := nHLine // ширина и высота кнопки cBtnFontI := "Wingdings" nBtnFSizeI := nFSize + 6 cBtnCaptI := CHR(40) // 139 cObjGbx := cObj + "_Gbox" IF cTypeLine == "A" nWCol := 0 // смещение по строке карточки aField := xPole // список полей - {"RC_abon" ,"?","RC_abon0","?"} aDimObjAI := ARRAY( LEN(aField) ) // для типа A - список наименований объектов // выведенных в этой стоке - передать на кнопку FOR nK := 1 TO LEN(aField) cField := ALLTRIM(aField[nK]) cAType := xDopType[nK] cObjGbxA := cObj + "_A" + cAType + "_" + HB_NtoS(nK) aDimObjAI[nK] := cObjGbxA nObjId := nI*1000 + nJ*100 + nK IF cAType == "D" .OR. cAType == "C" .OR. cAType == "N" xRet := "ALIAS()->" + cField // FIELDGET(FIELDNUM(cField)) nWidth := GetTxtWidth( xRet, nFSize, cFName ) + 10 xOldGet := xRet // первоначальное значение GetBox @ nRow , nCol + nWCol GETBOX &cObjGbxA VALUE xRet ; WIDTH nWidth HEIGHT nHLine ; // ReadOnly ; ON CHANGE {|| (ThisWindow.Cargo):nModify += 1, ; _logfile(.t., This.Name, This.Cargo:lModify), ; This.Cargo:lModify := .T., ; _logfile(.t., This.Name, This.Cargo:lModify) } ; ON INIT {|| This.Cargo := oKeyData(), ; // создать объект (контейнер) для этого объекта This.Cargo:lModify := .F. } ELSEIF cAType == "I" (This.Cargo):nBtn := nK @ nRow, nCol + nWCol BUTTONEX &cObjGbxA WIDTH nWBtn HEIGHT nHBtn ; CAPTION cBtnCaptI FONT cBtnFontI SIZE nBtnFSizeI ; NOXPSTYLE HANDCURSOR FONTCOLOR BLACK BACKCOLOR ORANGE ; ACTION {|| This.Enabled := .F., _wPost(100, , This.Name) } ; ON INIT {|| This.Cargo := oKeyData() ,; // создать объект (контейнер) для этой кнопки This.Cargo:nObjId := nObjId ,; This.Cargo:nBtn := (ThisWindow.Cargo):nBtn,; This.Cargo:aDim := aDim ,; This.Cargo:aObjName := aDimObjAI } // ON INIT надо задавать только блоком кода DEFINE CONTEXT MENU CONTROL &cObjGbxA MENUITEM "Context menu (1) this Button =" ACTION _wPost(102, , {cObjGbxA, 1}) MENUITEM "Context menu (2) this Button =" ACTION _wPost(102, , {cObjGbxA, 2}) END MENU nWidth := nWBtn ELSE cMsg := "Error! No handling type ["+cAType+"] !;" + HB_ValToExp(aDim) cMsg += ";;" + ProcNL(0) cMsg := AtRepl( ";", cMsg, CRLF ) MsgStop( cMsg ) ENDIF nWCol += nWidth + 2 IF nK % 2 = 0 nWCol += 20 ENDIF NEXT ELSEIF cTypeLine == "C" .OR. cTypeLine == "D" xRet := "ALIAS()->" + xPole nWidth := GetTxtWidth( xRet, nFSize, cFName ) + 10 xOldGet := xRet // первоначальное значение GetBox @ nRow , nCol GETBOX &cObjGbx VALUE xRet ; WIDTH nWidth HEIGHT nHLine ; ON CHANGE {|| (ThisWindow.Cargo):nModify += 1, ; _logfile(.t., This.Name, This.Cargo:lModify), ; This.Cargo:lModify := .T., ; _logfile(.t., This.Name, This.Cargo:lModify) } ; ON INIT {|| This.Cargo := oKeyData(), ; // создать объект (контейнер) для этого объекта This.Cargo:lModify := .F. } ELSE cMsg := "Error! No handling type ["+cTypeLine+"] !;" + HB_ValToExp(aDim) cMsg += ";;" + ProcNL(0) cMsg := AtRepl( ";", cMsg, CRLF ) MsgStop( cMsg ) ENDIF Return Nil //////////////////////////////////////////////////////////////////////////////////// // запись в журнал изменений GETBOX Function myChangeGetBox(xOld,xNew,cObj) ? ProcNL(), xOld, xNew, cObj IF VALTYPE(xOld) == "C" xOld := ALLTRIM(xOld) xNew := ALLTRIM(xNew) ENDIF IF xOld == xNew // пропуск записи в журнал ELSE ? " Change Getbox:" + cObj + ", [" + xOld + "] # [" + xNew + "]" ENDIF Return Nil //////////////////////////////////////////////////////////////////////////////////// Function myPressButtonI(nEvent, cForm, cObj, nObjId, nBtn, nMod, aDim, aObjNameLine) Local cMsg, cRun, cTtl, cBlock, aFunc, aParam, cRet, aFld, cField, cObjRt cTtl := "nEvent = " + hb_NtoS(nEvent) + ";" cTtl += "cForm = " + cForm + ";" cTtl += "cObj = " + cObj + ";" cTtl += "Button code in line :nObjId = " + hb_NtoS(nObjId) + ";" cTtl += "Button number in line :nBtn = " + hb_NtoS(nBtn) + ";" cTtl += "(This.Object):Cargo:nModify = " + hb_NtoS(nMod) + ";" cTtl += "Card string array passed: aDim= " + hb_ValToExp(aDim) + ";" cTtl += "The name of the constructed objects of this card line:;" cTtl += hb_ValToExp(aObjNameLine) aFunc := aDim[5] aFld := aDim[3] cRun := aFunc[nBtn] cField := aFld[nBtn-1] cObjRt := aObjNameLine[nBtn-1] IF !hb_IsFunction( cRun ) cMsg := "Functions " + cRun + "() not in the EXE file!;" cMsg += "call -" + hb_ValToExp(aDim) + ";" cMsg := AtRepl( ";", cMsg, CRLF ) MsgStop( cMsg, "Stop!") ELSE cTtl := AtRepl( ";", cTtl, CRLF ) aParam := { cTtl, cField, cObjRt, nBtn, aDim } cBlock := cRun + "(" + hb_ValToExp(aParam) + ")" cRet := Eval( hb_macroBlock( cBlock ) ) IF LEN(cRet) > 0 SetProperty(cForm, cObjRt, "Value", cRet) ENDIF ENDIF Return Nil ////////////////////////////////////////////////////////////////////////// Function BtnTestRC(aPar) Local cTtl, cFld, aDim, aClr, nI, nRet, cRet, aBtn, cMsg, nBtn, cObj Default aPar := {} cTtl := aPar[1] cFld := aPar[2] cObj := aPar[3] nBtn := aPar[4] aDim := aPar[5] aClr := { YELLOW, RED, GREEN, ORANGE } aBtn := {} cRet := "" FOR nI := 1 TO 4 AADD(aBtn, "0"+hb_ntoS(nI)+"00000"+hb_ntoS(nI) ) NEXT cMsg := cTtl + ";;" cMsg += "Select the desired value for the entry!;" cMsg += "Выберите нужное значение для записи !;" cMsg += "Запись в поле: " + cFld + " и объект: " + cObj nRet := HMG_Alert( cMsg, aBtn, aDim[2], NIL, NIL, NIL, aClr, NIL ) IF nRet > 0 cRet := aBtn[nRet] ENDIF Return cRet ////////////////////////////////////////////////////////////////// Function myListTab() Local i, aTabName, aDim, aRetDim := {} // TabPage 1 aDim := {} AADD( aDim, { "A", "Personal account / Personal account-2", {"RC_abon" ,"?","RC_abon0","?"} , {"C","I","C","I"}, {NIL,"BtnTestRC",NIL,"BtnTestRC" } , "2Card:(RC+RC0)" } ) AADD( aDim, { "A", "Personal account-3/ Personal account-4", {"RC_abon3" ,"?","RC_abon4","?"} , {"C","I","C","I"}, {NIL,"BtnTestRC",NIL,"BtnTestRC" } , "2Card:(RC34)" } ) AADD( aDim, { "C", "Name of the subscriber" , "FIO" , nil , nil , "" } ) AADD( aRetDim, aDim ) // TabPage 2 aDim := {} AADD( aDim, { "D", "Date of Birth" , "DBirth" , nil , nil , "" } ) AADD( aRetDim, aDim ) // TabPage 3 aDim := {} For i := 1 To 5 AADD( aDim, { "C", "Example of row "+hb_NtoS(i)+" of tab 3", "CTEXT_"+hb_NtoS(i) , nil , nil , "" } ) Next AADD( aDim, { "A", "Example of an event on a button", {"TEST22" ,"?"} , {"C","I"}, {NIL,"MyTest22"} , "3Card:Test22" } ) AADD( aRetDim, aDim ) aTabName := { "TabPage-1", "TabPage-2","TabPage-3" } Return { aRetDim, aTabName } /////////////////////////////////////////////////////////////////////////////// FUNCTION GetTxtWidth( cText, nFontSize, cFontName, lBold ) // получить Width текста Local hFont, nWidth Default cText := REPL('A', 2) Default cFontName := _HMG_DefaultFontName // из MiniGUI.Init() Default nFontSize := _HMG_DefaultFontSize // из MiniGUI.Init() Default 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 ProcNL(nVal) Default nVal := 0 RETURN "Call from: " + ProcName(nVal+1) + "(" + hb_ntos(ProcLine(nVal+1)) + ") --> " + ProcFile(nVal+1) [/pre2]

gfilatov2002: SergKis пишет: Неточность (tget) GETBOX при выполнении присваивания Принято Хотя, возможно, что при переформатировании значения в TGET классе срабатывание события ON CHANGE и не планировалось... Благодарю за помощь

SergKis: gfilatov2002 пишет Хотя, возможно, что при переформатировании значения в TGET классе срабатывание события ON CHANGE и не планировалось... Согласен, тут есть подводный камень для исп. ф-ии в ON CHANGE ... и после _SetValue() ручное применение той же ф-ии, могут привести к неточностям счетчиков изменений или еще чего то. Но "правильней" после присвоения\изменения данных GETBOX по _SetValue() ON CHANGE ... должен отрабатывать. Конфликт со старой версией ON CHANGE ... возможен.

Andrey: gfilatov2002 пишет: Принято Григорий, а в текущую версию эта добавка вошла ? А то я не могу пере собрать minigui.lib, ошибки лезут... Наверное из-за BCC 5.5

gfilatov2002: Andrey пишет: в текущую версию эта добавка вошла ? Нет, она будет включена в следующую июльскую сборку. Кстати, подготовил первую бетку этой сборки со следующим списком изменений: [pre2] * Fixed: Minor correction in the method VarPut() of the Harbour TGet class. It fixes the following problem: GetBox control do not execute the 'On Change' procedure after assigning a value at the calling of the function SetProperty ( Form, GetBox, 'Value', xValue ). Contributed by Sergej Kiselev. * Fixed: A missing PICTURE clause handling in the BROWSE control at the alternative syntax. Problem was reported by Pete D. Contributed by Grigory Filatov <gfilatov@inbox.ru> * New: A Star Rating is a type of rating question that allows users to rank attributes on a 5- or 10-point scale represented with stars. It is a 5-point matrix question, but instead of radio buttons or checkboxes, stars are used to represent it. Syntax: @ <row>,<col> RATING <name> [ OF <parent> ] ; [ WIDTH <w> ] ; [ HEIGHT <h> ] ; [ STARS <count> ] ; [ RATE <value> ] ; [ SPACING <space> ] ; [ ON CHANGE <change> ] ; [ TOOLTIP <tooltip> ] ; [ BORDER> ] There is the read/write 'Value' property for this control: Form.Rating.Value := 5 nRate := GetProperty( Form, Control, 'Value' ) - added auxiliary function ClearRating( Form, Control ). Contributed by Grigory Filatov <gfilatov@inbox.ru> (see demos in folder \samples\Basic\RATING) * Enhanced: INI file - added the following new commands: - GET BEGIN COMMENT TO <uVar>; - GET END COMMENT TO <uVar>; - SET BEGIN COMMENT TO <uVal>; - SET END COMMENT TO <uVal>; and the corresponding functions: - GetBeginComment() and SetBeginComment() to get/set a comment at the first line of an INI file; - GetEndComment() and SetEndComment() to get/set a comment at the last line of an INI file. Based upon a code borrowed from OOHG. Adapted for Minigui Extended by Grigory Filatov <gfilatov@inbox.ru> (see demo.prg in folder \samples\Basic\ini) * Updated: 'GraphPlus library' by S.Rathinagiri <srathinagiri@gmail.com> (see source in folder \Source\GraphPlus) Adapted for Minigui Extended by Grigory Filatov <gfilatov@inbox.ru> (see demo in folder \samples\Advanced\GraphPlus) * Updated: 'Print Pie Graph' sample: updated the data for May 2021. Contributed by Grigory Filatov <gfilatov@inbox.ru> (see demo.prg in folder \samples\Basic\GraphPrint) * Updated: 'Multiple Combined Search Box' sample: minor improvements. Contributed by Grigory Filatov <gfilatov@inbox.ru> (see in folder \samples\Advanced\CombinedSearchBox) [/pre2] Но пока не решил, когда опубликовать новую сборку, потому что ...

gfilatov2002: P.S. Картинка из новой сборки и полный текст этого примера ниже: [pre2]/* * HMG - Harbour Win32 GUI library Demo * * Copyright 2014-2021 Grigory Filatov <gfilatov@inbox.ru> */ #include "minigui.ch" Function Main DEFINE WINDOW Win_1 ; AT 0,0 ; WIDTH 400 HEIGHT 380 ; TITLE 'Rating Test' ; ICON 'star.ico' ; MAIN ; FONT "Arial" SIZE 14 ; BACKCOLOR WHITE DEFINE MAINMENU DEFINE POPUP "File" MENUITEM "Exit" ONCLICK ThisWindow.Release END POPUP END MENU @ 20, 20 LABEL LABEL_0 VALUE '5 Star Rating Scale' WIDTH 360 FONT "Arial" SIZE 16 CENTERALIGN BOLD TRANSPARENT @ 70, 40 LABEL LABEL_1 VALUE 'Loved It' BOLD TRANSPARENT @ 70, 180 RATING Rate_1 ; WIDTH 21 ; HEIGHT 21 ; STARS 5 ; FROM RESOURCE ; SPACING 15 ; RATE 5 @ 120, 40 LABEL LABEL_2 VALUE 'Liked It' BOLD TRANSPARENT @ 120, 180 RATING Rate_2 ; WIDTH 21 ; HEIGHT 21 ; STARS 5 ; FROM RESOURCE ; SPACING 15 ; RATE 4 @ 170, 40 LABEL LABEL_3 VALUE 'It was ok' BOLD TRANSPARENT @ 170, 180 RATING Rate_3 ; WIDTH 21 ; HEIGHT 21 ; STARS 5 ; FROM RESOURCE ; SPACING 15 ; RATE 3 @ 220, 40 LABEL LABEL_4 VALUE 'Disliked It' BOLD TRANSPARENT @ 220, 180 RATING Rate_4 ; WIDTH 21 ; HEIGHT 21 ; STARS 5 ; FROM RESOURCE ; SPACING 15 ; RATE 2 @ 270, 40 LABEL LABEL_5 VALUE 'Hated It' BOLD TRANSPARENT @ 270, 180 RATING Rate_5 ; WIDTH 21 ; HEIGHT 21 ; STARS 5 ; FROM RESOURCE ; SPACING 15 ; RATE 1 END WINDOW Win_1.Center ACTIVATE WINDOW Win_1 Return Nil[/pre2]

krutoff: Заметил одну ситуацию, если в LABEL определяется INVISIBLE BLINK, то все равно показ идет и Visible == .T. @ 15,150 LABEL Label_1 VALUE 'Blink Test:' AUTOSIZE INVISIBLE BLINK

gfilatov2002: Выложил июльскую ANSI сборку 21.07 с учетом всех последних наработок по адресу http://hmgextended.com/files/CONTRIB/hmg-21.07-setup.exe Также подготовил эту сборку для таких бесплатных Си-компиляторов: - Embarcadero C++ 7.30 for Win32; - MinGW 32-bit (GCC with MCF thread model, built by LH_Mouse.) 11.1.1 20210708; - MinGW 64-bit (MinGW-W64 x86_64-posix-seh, built by Brecht Sanders) 11.1.1 20210710; - Microsoft Visual C++ 19.29.30037 (32/64-bit). Рассматриваю эту сборку как финальную Вот теперь ВСЕ...

SergKis: gfilatov2002 unicode версию сделайте по старому или новому адресу, пробую когда есть время Спасибо

gfilatov2002: SergKis пишет: unicode версию сделайте Отправил ссылку в личку

SergKis: gfilatov2002 пишет Отправил ссылку в личку Спасибо PS не успел предложить добавить к System. ... (но вдруг ... )[pre2] #xtranslate _GetAppCargo () => _HMG_MainCargo ///////////////////////////////////////////// // System pseudo-properties ///////////////////////////////////////////// #translate <p:System,Sys>.Cargo => _HMG_MainCargo #translate <p:System,Sys>.Cargo := <arg> => _HMG_MainCargo := <arg> #translate System.Clipboard => RetrieveTextFromClipboard() ... [/pre2] и в др. строках сделать <p:System,Sys>. коротко писать удобнее, например[pre2] Sys.Cargo := oKeyData() ; o := Sys.Cargo o:cUsr := "sysdba" o:cPsw := "masterkey" o:cFdb := "" o:cIP := "" o:nLang := 2 o:cCur := cmCurDir()+"\" o:cLog := o:cCur+"ealarm.log" o:BIN := o:cCur+"BIN"+"\" // доп. прогрммы LogFileName( o:cLog ) o:WRK := "WRK" o:HBK := "HBK" o:BAK := "BAK" // сюда складывть bak копию для gbak.exe (сканируем) o:FDB := "FDB" // сюда складывть fdb и снимок фйлов с него o:INI := "HBK\INI" a := {o:WRK, o:WRK+"\E", o:HBK, o:INI, o:BAK, o:FDB} ; AEval( a, {|cd| DirMake(cd) } ) o:WRK := o:cCur+o:WRK+"\" ; o:HBK := o:cCur+o:HBK+"\" ; o:INI:= o:cCur+o:INI+"\" o:FDB := o:cCur+o:FDB+"\" ; o:BAK := o:cCur+o:BAK+"\" ... или LOCAL o := Sys.Cargo o:oBaseText := oKeyData() o:oBaseText:aNew := {"Add new", "Jauns" , "Добавить" } o:oBaseText:aDel := {"Delete" , "Dzēst" , "Удалить" } o:oBaseText:aRefr := {"Refresh", "Atjaunot" , "Обновить" } o:oBaseText:aEdit := {"Edit" , "Rediģēt" , "Менять" } o:oBaseText:aSort := {"Sorting", "Šķirošana", "Сортировка"} o:oBaseText:aExit := {"Exit" , "Izeja" , "Выход" } ... LOCAL cForm := 'wListSel', t, o := Sys.Cargo, ot := o:oBaseText ... BUTTON BtnList CAPTION ot:cList PICTURE 'page_plus' ; TOOLTIP NIL SEPARATOR ; ACTION _wPost(1, , This.Name) BUTTON BtnSort CAPTION ot:cSort PICTURE 'page_123' ; TOOLTIP NIL SEPARATOR ; ACTION ( DoEvents(), _wPost(4, oMain:Cargo:cFocused, 0) ) DROPDOWN ... oCol := :GetColumn("EVENT") ; oCol:cHeading := ot:cEvnt oCol := :GetColumn("OBJECTNUM"); oCol:cHeading := ot:cObj oCol := :GetColumn("NAME") ; oCol:nWidth := oCol:ToWidth(50) oCol:cHeading := ot:cName oCol := :GetColumn("ADDRESS") ; oCol:nWidth := oCol:ToWidth(50) oCol:cHeading := ot:cAddr ... [/pre2]

gfilatov2002: SergKis пишет: #translate <p:System,Sys>.Cargo => _HMG_MainCargo #translate <p:System,Sys>.Cargo := <arg> => _HMG_MainCargo := <arg> Добавил в форме #translate <p:Application,App>.Cargo => _HMG_MainCargo #translate <p:Application,App>.Cargo := <arg> => _HMG_MainCargo := <arg> SergKis пишет: в др. строках сделать <p:System,Sys> Сделал Благодарю за помощь

SergKis: gfilatov2002 Сделал у себя [pre2] CLASS TSColumn ... DATA bDrawCell // before :bTSDrawCell() ... METHOD DrawLine( xRow, lDrawCell ) CLASS TSBrowse ... oColumn:oCell:lInvertColor := .F. // 32 Invert color IF ISBLOCK( oColumn:bDrawCell ) ; Eval( oColumn:bDrawCell, Self, oColumn:oCell, oColumn ) ENDIF IF lDrawCell ; ::TSDrawCell( oColumn:oCell, oColumn ) ENDIF ... METHOD DrawSelect( xRow, lDrawCell ) CLASS TSBrowse ... oColumn:oCell:lInvertColor := !(::lCellBrw .and. nJ != ::nCell) // 32 Invert color IF HB_ISBLOCK( oColumn:bDrawCell ) ; Eval( oColumn:bDrawCell, Self, oColumn:oCell, oColumn ) ENDIF If lDrawCell .and. ::lDrawLine ; ::TSDrawCell( oColumn:oCell, oColumn ) EndIf ... Потребовалось раскрасить код объекта в выборке многострочной по объектам (аналог покраски четных\нечетных строк, т.е. через строчку), а тут через объект. С использованием :bDrawCell() получилось просто. ... LOCAL oColor := oKeyData() LOCAL nMaxObj ... выбираем уникально объекты и ставим 0\1 (чет\нечет) INDEX ON OBJECTNUM TAG OBJ UNIQUE OrdSetFocus("OBJ") GO TOP nMaxObj := OrdKeyCount() ; i := 0 DO WHILE !EOF() ; oColor:Set( OBJECTNUM, int(i % 2) ) ; i++ ; SKIP ENDDO GO TOP ... на колонку кодов объектов в тсб ставим oCol := :GetColumn("OBJECTNUM"); oCol:cHeading := ot:cObj oCol:nFAlign := DT_CENTER oCol:cFooting := hb_ntos(nMaxObj) oCol:Cargo := oKeyData() oCol:Cargo:nMaxObj := nMaxObj oCol:Cargo:oColor := oColor oCol:Cargo:lColor := nMaxObj > 1 oCol:Cargo:aColor := { GetSysColor( COLOR_BTNFACE ) } // { CLR_HGRAY } oCol:bDrawCell := {|obrw,ocel,ocol| Local o := ocol:Cargo, nClr, nTo, cKod, nElm IF o:lColor nClr := ocel:nClrBack nTo := ocel:nClrTo cKod := ocel:uValue nElm := o:oColor:Get(cKod, 0) ocel:nClrBack := iif( nElm > 0, o:aColor[ nElm ], nClr ) ocel:nClrTo := iif( nElm > 0, o:aColor[ nElm ], nTo ) ENDIF Return Nil } ... [/pre2]

gfilatov2002: SergKis пишет: Сделал у себя ОК. Благодарю за предложение

gfilatov2002: Подготовил 1-й апдейт сборки 21.07 Подробности см. на английском форуме Минигуи. Обновил также Unicode архив. Искренне благодарю Андрея за многолетнюю поддержку Желаю всем мира и добра

Andrey: gfilatov2002 пишет: Подробности см. на английском форуме Минигуи. А нам тоже интересно, на русском, а не на буржуйском. Когда ТАБ внизу, большие фонты отображаются коряво ! Я не использую такие ТАБы но может другие используют. И картинки коряво сдвинуты... Пример отправил на почту.

gfilatov2002: Andrey пишет: Когда ТАБ внизу, большие фонты отображаются коряво Уже поправил эту недоработку, и "по-тихому" обновил 1-й апдейт сборки 21.07 по адресу http://hmgextended.com/files/CONTRIB/hmg-21.07-setup.exe Благодарю за пример

rvu: Компилирую с помощью ..\batch\compile.bat Сегодня заметил, стала говорить про множественные ресурсы: Duplicate resource: Type 16 (VERSIONINFO), ID 1; File мой файл ресурсов - .RES resource kept; file C:\MINIGUI\RESOURCES\MINIGUI.RES resource discarded. Не знаю как давно это появилось. Вытащил версию 21.05 — нет там такого. Как бы их примирить?

gfilatov2002: rvu пишет: Вытащил версию 21.05 — нет там такого. Как бы их примирить? Благодарю за сообщение Уже поправил эту недоработку, которая была вызвана ошибками в работе компилятора ресурсов Borland C++. P.S. Поправил также в Unicode-архиве...

rvu: Скачал заново. В unicode-версии пропало. А в неуникодной ничего не изменилось. Да и установочный файл такого же размера, что и раньше у меня был.

gfilatov2002: rvu пишет: в неуникодной ничего не изменилось Все правильно. Это исправление будет включено во второй апдейт сборки 21.07

rvu: gfilatov2002 пишет: Это исправление будет включено во второй апдейт сборки 21.07 Понял. Когда ожидается?

gfilatov2002: rvu пишет: Когда ожидается? Запланировал - на следующей неделе, если получится...

rvu: Понятно.

gfilatov2002: Завершена подготовка второго апдейта сборки 21.07, который будет опубликован послезавтра. Что нового: * New: Added the useful function HMG_FileCopy() to copy a file to a new file. Syntax: HMG_FileCopy( <cSourceFile>, <cTargetFile>, [<nBuffer>], [<bEval>] ) --> lSuccess where <cSourceFile> is the name of the source file including the path and the extension; <cTargetFile> is the name of the target file including the path and the extension; <nBuffer> is the buffer size in bytes. The default is 8192 bytes; <bEval> is the code block which is executed with the percentage of the file copied. This function returns false if an errors occurs, otherwise, it returns true. Based upon a contribution of Jacek Kubica <kubica/at/wssk.wroc.pl> (see demo in folder \samples\Basic\Filecopy) * Updated: Pacified a C-warning in the MiniGUI core for compatibility with the new Pelles C 11.0 (64-bit). Contributed by Grigory Filatov <gfilatov@inbox.ru> * New: The SELECTOR library source code (see in folder \Source\SELECTOR). Based upon a code of Janusz Piwowarski for Clipper. Contributed by Grigory Filatov <gfilatov@inbox.ru> (see demo in folder \samples\Basic\Charts_3) * Updated: Adaptation FiveWin Class TSBrowse 9.0 in HMG: - added the new variable :bDrawCell in the TSColumn class. This codeblock will executed in the methods DrawLine() and DrawSelect() before calling the method TSDrawCell(). Suggested and contributed by Sergej Kiselev. * New: 'Registry class for Xbase++ usage' sample. Based upon a contribution of HMG user Jimmy. Adapted for Minigui Extended by Grigory Filatov <gfilatov@inbox.ru> (see in folder \samples\Basic\RegClass) * New: 'Tab Control with OOP' sample. Contributed by Sergej Kiselev and Verchenko Andrey (see demo3.prg in folder \samples\Basic\TAB) Ваши комментарии приветствуются...

SergKis: gfilatov2002 пишет Ваши комментарии приветствуются... Пробовал под unicode пример Advanced\7-Zip, ... фокус не удался Может включить lib из примера в основную сборку ?

gfilatov2002: SergKis пишет: Может включить lib из примера в основную сборку ? Благодарю за предложение, но эта библиотека является устаревшей (с 2010 года). Ее функционал перенесен в ядро Харбора и в contrib библиотеку XHB.

SergKis: gfilatov2002 пишет эта библиотека является устаревшей (с 2010 года). Ее функционал перенесен в ядро Харбора и в contrib библиотеку XHB. Как я понял, в hb zip функционал (может ошибаюсь), а с запусками планировщиком (у нас, как правило) синхронизацию по backup откатам (баз) каталогов разных PC, используют 7z (7za.exe). 7z = ~1Г -> ~65Мб, а zip дает ~ в 2а раза больше файл после сжатия. Пример оказался очень в тему и жизненный, чуть поправил галочки настройки, добавил Size в grid и получилась автомат. распаковка 7z архива при заданных параметрах File7z, CtlgOut на входе запуска. Пока 7-zip32.dll была хорошим решением

SergKis: gfilatov2002 пишет Ее функционал перенесен в ядро Харбора и в contrib библиотеку XHB. Собрал hbdll32.lib на unicode версии, выбросил из своего модуля ранее [pre2] // Generate the full name of the installed 7-Zip through a registry entry OPEN REGISTRY oReg KEY HKEY_CURRENT_USER Section 'Software\7-Zip' GET VALUE cPath7z NAME 'Path' OF oReg CLOSE REGISTRY oReg[/pre2] Заработало. Кому интересно, тут [pre2] /* * MINIGUI - Harbour Win32 GUI library Demo * * Access to 7z archives by 7-zip32.dll * (c) 2008 Vladimir Chumachenko <ChVolodymyr@yandex.ru> * * Last Revised by Grigory Filatov 03/10/2017 */ #define _HMG_OUTLOG #include "CStruct.ch" // from Harbour\Contrib\xHB #include "HBCTypes.ch" // from Harbour\Contrib\xHB #include "WinTypes.ch" // from Harbour\Contrib\xHB #include "hmg.ch" #define ALONE_7Z '7za.exe' // console variant of 7-Zip archiver STATIC cPath7z := '' // Full path to installed 7-Zip archiver STATIC lPath7z := .F. MEMVAR oMain // C-structure, used in SevenZipFindFirst(), SevenZipFindNext() pragma pack( 4 ) #define FNAME_MAX32 512 typedef struct { ; DWORD dwOriginalSize; DWORD dwCompressedSize; DWORD dwCRC; UINT uFlag; UINT uOSType; WORD wRatio; WORD wDate; WORD wTime; char szFileName[ FNAME_MAX32 + 1 ]; char dummy1[ 3 ]; char szAttribute[ 8 ]; char szMode[ 8 ]; } INDIVIDUALINFO, * PINDIVIDUALINFO; FUNCTION Main( cMode, cPar1, cPar2 ) LOCAL cBuf, aBuf, cTm1, cTm2, nTime, aTmp, cTmp, nTmp, oTmp, cDir LOCAL cP1, cP2, cP3, cP4, cP5, cP6, cP7, cP8, cP9, nI, nK Default cMode := "", cPar1 := "", cPar2 := "" App.Cargo := oKeyData() ; o := App.Cargo ; SetsEnv() cMode := lower(cMode) wMain_7Zip( cMode, cPar1, cPar2 ) RETURN *----------------------------------------------------------------------------* FUNCTION wMain_7Zip( cMode, cPar1, cPar2 ) *----------------------------------------------------------------------------* LOCAL cExe := hb_progName() LOCAL cPth := left(cExe, RAt("\", cExe)) LOCAL oa, nG, nM, nY, nX, nW, nH, nL, nL1, nL2, g, y, x, w, h LOCAL cFont := 'Tahoma' LOCAL nSize := 9 LOCAL cTitl := 'Archiver 7-Zip interaction' LOCAL cIcon := 'main.ico' LOCAL lExtract := "e" $ cMode LOCAL nPost := 0 cPath7z := cPth + '7za.exe' lPath7z := hb_FileExists(cPath7z) SET FONT TO cFont, nSize DEFINE FONT DefFont FONTNAME cFont SIZE nSize oa := App.Object nX := 0 ; nW := oa:W4 * 2 // Sys.DesktopWidth * 0.5 nY := 0 ; nH := oa:H1 * 22 nG := oa:GapsWidth nM := oa:Left IF lExtract .and. !Empty(cPar1) .and. !Empty(cPar2) nPost := 5 ENDIF DEFINE WINDOW wMain At nY, nX CLIENTAREA nW, nH Title cTitl Icon cIcon ; Main NoMaximize NoSize ; ON INIT _wPost(nPost) PUBLIC oMain := This.Object ; This.Cargo := oKeyData() This.Cargo:cFile7z := cPar1 This.Cargo:cDirOut := cPar2 This.Cargo:lExtract := lExtract This.Cargo:nCount := 0 DEFINE STATUSBAR StatusItem '' StatusItem '' Width nW * 0.22 //120 StatusItem '' Width 40 StatusItem '' Width nW * 0.23 //130 END STATUSBAR y := nG ; x := nG ; w := This.ClientWidth - x*2 g := nM * 2 - nG * 3 - oa:H4 h := oa:H1 * 18 - nG DEFINE TAB tbMain at y, x Width w Height h DEFINE PAGE 'Archive' nL := w - nG * 2 - 30 nL1 := nL * 0.7 nL2 := nL - nL1 @ 30, 5 Grid grdContent Width w - nG * 2 Height h-oa:H2-nG ; Headers { 'Name', 'Size' } ; Widths { nL1 , nL2 } ; Multiselect y := This.ClientHeight - This.StatusBar.Height - nM * 2 - nG - oa:H1 @ y, 15 ButtonEx btnCreate Caption 'Create' ; Width oa:W2 ; Height oa:H2 ; Action _wPost(1) ; // RunTest( 1 ) ; Tooltip 'Create archive' @ y, 220 ButtonEx btnView Caption 'View' ; Width oa:W2 ; Height oa:H2 ; Action _wPost(2) ; // RunTest( 2 ) ; Tooltip 'View 7z/zip archive' @ y, 415 ButtonEx btnExtract Caption 'Extract' ; Width oa:W2 ; Height oa:H2 ; Action _wPost(3) ; // RunTest( 3 ) ; Tooltip 'Extract file(s) from archive' END PAGE DEFINE PAGE 'Options' @ 30, 5 Frame frmSelectTest ; Caption 'Select test' ; Width w - nG * 2 ; Height 65 ; Bold ; FontColor BLUE @ 55, 15 RadioGroup rdgSelectTest ; Options { '7-zip32.dll', '7-Zip', '7za.exe' } ; Width 100 ; Spacing 20 ; Value 1 ; ON Change wMain.btnExtract.Enabled := .F. ; Horizontal @ 110, 5 Frame frmCommon ; Caption 'Common' ; Width w - nG * 2 ; Height 65 ; Bold ; FontColor BLUE @ 135, 15 CheckBox cbxHide ; Caption 'Hide progressbar' ; Width 124 ; Value .F. @ 185, 5 Frame frmExtract ; Caption 'Extract' ; Width w - nG * 2 ; Height 65 ; Bold ; FontColor BLUE @ 210, 15 CheckBox cbxExtract ; Caption 'Extract files with full paths' ; Width 176 ; Value .F. @ 210, 200 CheckBox cbxYesAll ; Caption 'Assume (Yes) on all queries' ; Width 190 ; Value .T. @ 260, 5 Frame frmLinks ; Caption 'Links' ; Width w - nG * 2 ; Height 100 ; Bold ; FontColor BLUE @ 285, 15 LABEL lbl7z ; Value '7-Zip' ; Width 120 ; Height 15 @ 285, 140 Hyperlink hl7z ; Value 'http://www.7-zip.org' ; Address 'http://www.7-zip.org' ; HandCursor @ 305, 15 LABEL lblDLL_JA ; Value '7-Zip32.dll (Japanese)' ; Width 120 ; Height 15 @ 305, 140 Hyperlink hlDLL_JA ; Value 'http://www.csdinc.co.jp/archiver/lib/' ; Address 'http://www.csdinc.co.jp/archiver/lib/' ; Width 270 HandCursor @ 325, 15 LABEL lblDLL_EN ; Value '7-Zip32.dll (English)' ; Width 120 ; Height 15 @ 325, 140 Hyperlink hlDLL_EN ; Value 'http://www.csdinc.co.jp/archiver/lib/main-e.html' ; Address 'http://www.csdinc.co.jp/archiver/lib/main-e.html' ; Width 270 HandCursor END PAGE END TAB IF ! lPath7z wMain.rdgSelectTest.Enabled( 3 ) := .F. ENDIF wMain.btnExtract.Enabled := .F. IF nPost > 3 wMain.btnCreate.Hide ENDIF WITH OBJECT This.Object :Event( 1, {|ow,ky| RunTest(ky, ow) } ) :Event( 2, {|ow,ky| RunTest(ky, ow) } ) :Event( 3, {|ow,ky| RunTest(ky, ow) } ) :Event( 5, {|ow,ky,nCnt| ky := -1 //ow:Hide() ; DO EVENTS nCnt := RunTest(2, ow) IF nCnt > 0 ; ky := RunTest(3, ow) ENDIF //ow:Show() ; DO EVENTS ow:Release() Return Nil } ) :Event(99, {|ow| ow:Release() }) END WITH END WINDOW CENTER WINDOW wMain ACTIVATE WINDOW wMain RETURN Nil *----------------------------------------------------------------------------* STATIC PROCEDURE ShowStatus( cFile, cCount, cType, cVersion ) *----------------------------------------------------------------------------* wMain.StatusBar.Item (1) := cFile // Processed file wMain.StatusBar.Item (2) := cCount // Files in the archive wMain.StatusBar.Item (3) := cType // Archive type wMain.StatusBar.Item (4) := cVersion // Procedure Information RETURN Nil *----------------------------------------------------------------------------* STATIC FUNCTION Version7zip *----------------------------------------------------------------------------* LOCAL nVersion := SevenZipGetVersion(), ; // 7-zip nSubversion := SevenZipGetSubVersion(), ; // 7-zip32.dll cVersion := 'Version ' cVersion += ( Str( ( nVersion / 100 ), 5, 2 ) + '.' + StrZero( ( nSubversion / 100 ), 5, 2 ) ) RETURN cVersion *----------------------------------------------------------------------------* STATIC PROCEDURE RunTest( nChoice, oWnd ) *----------------------------------------------------------------------------* LOCAL nSelected := wMain.rdgSelectTest.Value LOCAL o := oWnd:Cargo LOCAL nRet := 0 DO CASE CASE ( nChoice == 1 ) // Create Archive IF ( nSelected == 1 ) ; CreateArc() // Process 7-zip32.dll ELSE ; CreateArcExternal() // Run 7z.exe or 7za.exe ENDIF CASE ( nChoice == 2 ) // View Content IF ( nSelected == 1 ) ; nRet := ViewArc( o:cFile7z, .F. ) ELSE ; ViewArcExternal() ENDIF CASE ( nChoice == 3 ) // Extract Files IF ( nSelected == 1 ) ; nRet := ExtractArc( o:cDirOut, .F. ) ELSE ; ExtractArcExternal() ENDIF ENDCASE RETURN nRet *----------------------------------------------------------------------------* STATIC PROCEDURE CreateArc *----------------------------------------------------------------------------* LOCAL aSource := GetFile( { { 'All files', '*.*' } }, ; 'Select file(s)', ; GetCurrentFolder(), .T., .T. ; ), ; cArcFile, ; cType := '', ; cCommand := 'A ', ; nDLLHandle IF !Empty( aSource ) cArcFile := PutFile ( { { '7-zip', '*.7z' }, { 'Zip', '*.zip' } }, ; 'Create archive', ; GetCurrentFolder(), ; .T. ; ) IF !Empty( cArcFile ) // Define the type of archive. The default is 7z, so // remember only in case of change in the dialog box. IF ( Upper( Right( cArcFile, 3 ) ) == 'ZIP' ) cType := 'zip' ENDIF // Build a command line to pass to the DLL IF wMain.cbxHide.Value cCommand += '-hide ' // Do not display the process ENDIF IF !Empty( cType ) cCommand += '-tzip ' // In ZIP format ENDIF cCommand += ( cArcFile + ' ' ) // Specify files to process AEval( aSource, {| elem | cCommand += ( '"' + elem + '" ' ) } ) cCommand := RTrim( cCommand ) IF !( ( nDLLHandle := LoadLibrary( '7-zip32.dll' ) ) > 0 ) MsgStop( "Can't load 7-zip32.dll.", 'Error' ) ELSE DllCall( nDLLHandle, DC_CALL_STD, 'SevenZip', _HMG_MainHandle, cCommand ) FreeLibrary( nDLLHandle ) // Fill In The Status Bar ShowStatus( cArcFile, '', iif( Empty( cType ), '7z', 'zip' ), Version7zip() ) ENDIF ENDIF ENDIF RETURN *----------------------------------------------------------------------------* STATIC FUNCTION ViewArc( xFile, lMsg ) *----------------------------------------------------------------------------* LOCAL cFile LOCAL nDLLHandle, nArcHandle, nResult, cValue, nCount := 0 LOCAL cType := '', oInfo, pInfo, aFiles := {}, nSize LOCAL nRet := -1 Default lMsg := .T. IF Empty( xFile ) cFile := GetFile( {{'7-zip', '*.7z'}, {'Zip', '*.zip'}}, ; 'Select archive', GetCurrentFolder(), .F., .T. ) ELSE cFile := xFile ENDIF IF !( ( nDLLHandle := LoadLibrary( '7-zip32.dll' ) ) > 0 ) IF lMsg ; MsgStop( "Can't load 7-zip32.dll.", 'Error' ) ENDIF RETURN nRet ENDIF nArcHandle := DllCall( nDLLHandle, DC_CALL_STD, 'SevenZipOpenArchive', _HMG_MainHandle, cFile, 0 ) // Открыть архив IF Empty( nArcHandle ) IF lMsg ; MsgStop( cFile + ' not opened.', 'Error' ) ENDIF nRet := 0 RETURN nRet ENDIF nCount := DllCall( nDLLHandle, DC_CALL_STD, 'SevenZipGetFileCount' , cFile ) // Количество элементов в архиве nResult := DllCall( nDLLHandle, DC_CALL_STD, 'SevenZipGetArchiveType', cFile ) // Тип архива DO CASE CASE ( nResult == 1 ) ; cType := 'ZIP' CASE ( nResult == 2 ) ; cType := '7Z' CASE ( nResult == -1 ) ; cType := 'Error' CASE ( nResult == 0 ) ; cType := '???' ENDCASE oInfo := ( STRUCT INDIVIDUALINFO ) pInfo := oInfo:GetPointer() // Looking for the 1st file. If the search result does not matter, pass pInfo // can be omitted. DllCall( nDLLHandle, DC_CALL_STD, 'SevenZipFindFirst', nArcHandle, '*', pInfo ) // Reset The Pointer oInfo := oInfo:Pointer( pInfo ) cValue := Space( FNAME_MAX32 ) DllCall( nDLLHandle, DC_CALL_STD, 'SevenZipGetFileName', nArcHandle, @cValue, FNAME_MAX32 ) nSize := DllCall( nDLLHandle, DC_CALL_STD, 'SevenZipGetOriginalSize', nArcHandle ) cValue := Trim(StrTran(cValue, chr(0), "")) IF !Empty( cValue ) // Fill out the form table. First, we enter the values into an array, // sort and pass the Grid AAdd( aFiles, { cValue, nSize } ) DO WHILE ( ( nResult := DllCall( nDLLHandle, DC_CALL_STD, 'SevenZipFindNext', nArcHandle, pInfo ) ) == 0 ) cValue := Space( FNAME_MAX32 ) DllCall( nDLLHandle, DC_CALL_STD, 'SevenZipGetFileName', nArcHandle, @cValue, FNAME_MAX32 ) nSize := DllCall( nDLLHandle, DC_CALL_STD, 'SevenZipGetOriginalSize', nArcHandle ) cValue := Trim(StrTran(cValue, chr(0), "")) AAdd( aFiles, { cValue, nSize } ) ENDDO wMain.grdContent.DeleteAllItems IF Len(aFiles) > 1 ASort( aFiles,,, {| x, y | x[ 1 ] < y[ 1 ] } ) ENDIF wMain.grdContent.DisableUpdate AEval( aFiles, {| elem | wMain.grdContent.AddItem( elem ) } ) wMain.grdContent.EnableUpdate wMain.grdContent.Value := { 1 } DO EVENTS wApi_Sleep(1000) ENDIF // Close the archive file, unload the library DllCall( nDLLHandle, DC_CALL_STD, 'SevenZipCloseArchive', nArcHandle ) FreeLibrary( nDLLHandle ) nRet := nCount // Fill In The Status Bar ShowStatus( cFile, ( 'Count files: ' + LTrim( Str( nCount ) ) ), cType, Version7zip() ) IF ( wMain.grdContent.ItemCount > 0 ) wMain.btnExtract.Enabled := .T. ENDIF RETURN nRet *----------------------------------------------------------------------------* STATIC PROCEDURE ExtractArc( xDir, lMsg ) *----------------------------------------------------------------------------* LOCAL aPos := wMain.grdContent.Value LOCAL cDir, cCommand, nPos, cFile, nDLLHandle LOCAL nRet := -1, nSize, aFiles := {}, cOut, nFile Default lMsg := .T. IF Empty( aPos ) IF lMsg ; MsgStop( 'Select item(s), please!', 'Error' ) ENDIF RETURN nRet ENDIF IF Empty( xDir ) ; cDir := GetFolder( 'Extract file(s) to' ) ELSE ; cDir := xDir ; cOut := cDir+"\" aPos := {} AEval(array(wMain.grdContent.ItemCount), {|xv,nn| xv:= nn, AAdd(aPos, nn)}) ENDIF IF !Empty( cDir ) // Retrieve while maintaining directory structure or not cCommand := ( iif( wMain.cbxExtract.Value, 'x', 'e' ) + ' ' ) IF wMain.cbxHide.Value // Do not display the process. But if you need to rewrite // existing files, the corresponding request anyway // will be output. cCommand += '-hide ' ENDIF // Overwrite existing files without warning IF wMain.cbxYesAll.Value cCommand += '-y ' ENDIF cCommand += ( '-o' + cDir + ' ' ) // Where to extract // Do not forget to add the name of the archive containing the extracted files // cCommand += ( '"' + AllTrim( wMain.Statusbar.Item( 1 ) ) + '" ' ) cCommand += ( AllTrim( wMain.Statusbar.Item( 1 ) ) + ' ' ) // Add the extracted files. To simplify processing: // if the number of marked items is equal to the total // quantity, it makes no sense to do an exhaustive search. IF ( Len( aPos ) == wMain.grdContent.ItemCount ) cCommand += '*.*' FOR EACH nPos In aPos ; Aadd( aFiles, wMain.grdContent.Item(nPos) ) NEXT ELSE FOR EACH nPos In aPos // Items containing only the directory name, skip cFile := AllTrim( wMain.grdContent.Item( nPos )[ 1 ] ) nSize := wMain.grdContent.Item( nPos )[ 2 ] AAdd( aFiles, {cFile, nSize} ) IF !( Right( cFile, 1 ) == '\' ) // cCommand += ( '"' + cFile + '" ' ) cCommand += ( cFile + ' ' ) ENDIF NEXT cCommand := RTrim( cCommand ) ENDIF IF !( ( nDLLHandle := LoadLibrary( '7-zip32.dll' ) ) > 0 ) IF lMsg ; MsgStop( "Can't load 7-zip32.dll.", 'Error' ) ENDIF nRet := -2 ELSE DllCall( nDLLHandle, DC_CALL_STD, 'SevenZip', _HMG_MainHandle, cCommand ) FreeLibrary( nDLLHandle ) IF lMsg ; MsgInfo( "Extraction is successfully.", 'Result' ) ENDIF nRet := 0 IF !Empty(cOut) FOR nPos := 1 TO Len(aFiles) cFile := aFiles[ nPos ][1] nSize := aFiles[ nPos ][2] IF ISCHAR(nSize) ; nSize := Val(nSize) ENDIF IF hb_FileExists(cOut+cFile) IF nSize != hb_fSize(cOut+cFile) ; nRet++ ENDIF ELSE ; nRet++ ENDIF NEXT IF nRet > 0 FOR nPos := 1 TO Len(aFiles) cFile := aFiles[ nPos ][1] fErase(cOut+cFile) NEXT ENDIF ENDIF ENDIF DO EVENTS wApi_Sleep(1000) ENDIF RETURN nRet DECLARE DLL_TYPE_WORD SevenZipGetVersion() in 7-zip32.dll DECLARE DLL_TYPE_WORD SevenZipGetSubVersion() in 7-zip32.dll *----------------------------------------------------------------------------* STATIC PROCEDURE CreateArcExternal *----------------------------------------------------------------------------* LOCAL aSource := GetFile( { { 'All files', '*.*' } }, ; 'Select file(s)', ; GetCurrentFolder(), .T., .T. ; ), ; cArcFile, ; nPos, ; cExt, ; cType := '', ; cCommand := ' A ' IF !Empty( aSource ) // Addressing directly to 7-Zip itself allows you to create // more types of archives cArcFile := PutFile ( { { '7-zip', '*.7z' }, ; { 'Zip', '*.zip' }, ; { 'GZip', '*.gzip' }, ; { 'BZip2', '*.bzip2' }, ; { 'Tar', '*.tar' } ; }, ; 'Create archive', ; GetCurrentFolder(), ; .T. ; ) IF !Empty( cArcFile ) // Define the type of archive. The default is 7z, so // remember only in case of change in the dialog box. nPos := RAt( '.', cArcFile ) cExt := Upper( Right( cArcFile, ( Len( cArcFile ) - nPos ) ) ) IF !( cExt == '7Z' ) cType := cExt ENDIF // Build the command line IF !Empty( cType ) cCommand += ( '-t' + cType + ' ' ) ENDIF cCommand += ( cArcFile + ' ' ) // Specify files to process AEval( aSource, {| elem | cCommand += ( '"' + elem + '" ' ) } ) // Run either the installed archiver or console // version located in the folder with the demo program IF ( wMain.rdgSelectTest.Value == 2 ) cCommand := ( cPath7z + cCommand ) ELSE cCommand := ( ALONE_7Z + cCommand ) ENDIF cCommand := RTrim( cCommand ) // Run in standby mode for the end of processing. If // while the archiver window itself is hidden (for aesthetics, because the window // console), to display that the work is being performed (if // the archive is large), you can display some kind of information window, // for example with a timer. // There is another option: for 7-Zip, run not% ProgramFiles% \ 7-Zip \ 7z.exe, // and% ProgramFiles% \ 7-Zip \ 7zG.exe is the graphical interface of the archiver. // Get the weird little progress bar on the screen. IF wMain.cbxHide.Value Execute File ( cCommand ) WAIT Hide ELSE Execute File ( cCommand ) Wait ENDIF // Fill In The Status Bar ShowStatus( cArcFile, '', iif( Empty( cType ), '7Z', cType ), ; iif( ( wMain.rdgSelectTest.Value == 2 ), '7-Zip', '7za' ) ) ENDIF ENDIF RETURN *----------------------------------------------------------------------------* STATIC PROCEDURE ViewArcExternal *----------------------------------------------------------------------------* // aFiles - a set of supported archive types. The base accept set for // console version (7za.exe), because its capabilities are more modest. LOCAL aFilters := { { '7-zip', '*.7z' }, ; { 'Zip', '*.zip' }, ; { 'Cab', '*.cab' }, ; { 'GZip', '*.gzip' }, ; { 'Tar', '*.tar' } ; }, ; cFile, ; aFiles := {}, ; cCommand, ; cTmpFile := '_Arc_.lst',; // Or GetTempFolder () + '\ _Arc_.lst' oFile, ; cString // Add archive types that the full version can work with (not all, // specified in the documentation, of course) IF ( wMain.rdgSelectTest.Value == 2 ) AAdd( aFilters, { 'Rar', '*.rar' } ) AAdd( aFilters, { 'Arj', '*.arj' } ) AAdd( aFilters, { 'Chm', '*.chm' } ) AAdd( aFilters, { 'Lzh', '*.lzh' } ) ENDIF IF Empty( cFile := GetFile( aFilters, 'Select archive', GetCurrentFolder(), .F., .T. ) ) RETURN Nil ENDIF // The contents of the archive are displayed in a temporary file and then read for display in // program. // You can, of course, use cmd.exe instead of GetEnv ('COMSPEC'), but // the name of the shell may be different in older versions of Windows cCommand := GetEnv( 'COMSPEC' ) + ' /C ' IF ( wMain.rdgSelectTest.Value == 2 ) // Quotation marks do not hurt, because Program Files has a space in the name. // Here you need to use exactly% ProgramFiles% \ 7-Zip \ 7z.exe, because // graphical version of 7zG.exe does not support redirecting output to a file cCommand := ( cCommand + '"' + cPath7z + '"' ) ELSE cCommand := ( cCommand + ALONE_7Z ) ENDIF // And the information will not be displayed in the table, but in the technical mode (switch // -slt). Then each file file will be described in several lines like this // (varies depending on the type of archive): // Path = Our archive file // Size = // Packed Size = // Modified = // Attributes = // CRC = // Method = // Block = // and the name of the archive element will be displayed in the line marked Path = // Temporary content file is better, of course, to create in // system folder of temporary files (GetTempFolder () + '\' + cTmpFile) cCommand += ( ' L -slt ' + cFile + ' > ' + cTmpFile ) Execute File ( cCommand ) WAIT Hide // A more refined solution would be to redirect the output of the console program // WinAPI function (use CreatePipe and work with it as usual // file), and not create a temporary file, but I'm not that subtle expert. IF File( cTmpFile ) // Temporary file may not be created, for example, due to the errors // in the command line. Additionally, it would not hurt to check its size. // If zero, then there is nothing in it. // Fill The Array oFile := TFileRead():New( cTmpFile ) oFile:Open() IF !oFile:Error() DO WHILE oFile:MoreToRead() IF !Empty( cString := oFile:ReadLine() ) // Several simplified processing. Just checking does not start // whether the line with "Path =" and, if so, then this is the file name. At // necessary, can be made more complicated. For example, ignore // directory names (line "Attributes = D ...." for .7z files) IF ( Left( cString, 7 ) == 'Path = ' ) cString := AllTrim( SubStr( cString, 8 ) ) IF !( cString == cFile ) AAdd( aFiles, { cString } ) ENDIF ENDIF ENDIF ENDDO oFile:Close() IF !Empty( aFiles ) wMain.grdContent.DeleteAllItems ASort( aFiles,,, {| x, y | x[ 1 ] < y[ 1 ] } ) wMain.grdContent.DisableUpdate AEval( aFiles, {| elem | wMain.grdContent.AddItem( elem ) } ) wMain.grdContent.EnableUpdate wMain.grdContent.Value := { 1 } // Fill in the status bar (it will store the name of the read // archive needed to extract files) ShowStatus( cFile, ( 'Count files: ' + LTrim( Str( Len( aFiles ) ) ) ), ; Upper( Right( cFile, ( Len( cFile ) - RAt( '.', cFile ) ) ) ), ; iif( ( wMain.rdgSelectTest.Value == 2 ), '7-Zip', '7za' ) ) ENDIF ENDIF IF ( wMain.grdContent.ItemCount > 0 ) wMain.btnExtract.Enabled := .T. ENDIF ENDIF // The temporary file also played a role. deleted. Team not // causes an error even if the deleted file does not exist. FErase ( cTmpFile ) RETURN Nil *----------------------------------------------------------------------------* STATIC PROCEDURE ExtractArcExternal *----------------------------------------------------------------------------* LOCAL aPos := wMain.grdContent.Value, ; cDir, ; cCommand, ; nPos, ; cFile IF Empty( aPos ) MsgStop( 'Select item(s), please!', 'Error' ) RETURN Nil ENDIF IF !Empty( cDir := GetFolder( 'Extract file(s) to' ) ) // Retrieve while maintaining directory structure or not cCommand := ( iif( wMain.cbxExtract.Value, 'X', 'E' ) + ' ' ) // Overwrite existing files without warning IF wMain.cbxYesAll.Value cCommand += '-y ' ENDIF cCommand += ( '-o' + cDir + ' ' ) // Where to extract cCommand += ( AllTrim( wMain.Statusbar.Item( 1 ) ) + ' ' ) IF ( Len( aPos ) == wMain.grdContent.ItemCount ) cCommand += '*.*' ELSE FOR EACH nPos In aPos // Items which containing only the directory name, skip cFile := AllTrim( wMain.grdContent.Item( nPos )[ 1 ] ) IF !( Right( cFile, 1 ) == '\' ) cCommand += ( cFile + ' ' ) ENDIF NEXT cCommand := RTrim( cCommand ) ENDIF IF ( wMain.rdgSelectTest.Value == 2 ) // If instead of 7z.exe use 7zG.exe, it will be displayed // operation indicator cCommand := ( cPath7z + ' ' + cCommand ) ELSE cCommand := ( ALONE_7Z + ' ' + cCommand ) ENDIF // Do it. IF wMain.cbxHide.Value .AND. !wMain.cbxYesAll.Value Execute File ( cCommand ) WAIT Hide ELSE Execute File ( cCommand ) Wait ENDIF MsgInfo( 'Extraction is successfully.', 'Result' ) ENDIF RETURN Nil *----------------------------------------------------------------------------* FUNCTION SetsEnv() *----------------------------------------------------------------------------* LOCAL cLog := ".\_MsgLog.txt" LOCAL cFont := "Arial" LOCAL nSize := 11 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 DEFAULT ICON TO "BIL_MAIN" *-------------------------------- SET OOP ON *-------------------------------- DEFINE FONT DlgFont FONTNAME "Tahoma" SIZE 14 fErase( cLog ) ; LogFileName( cLog ) RETURN Nil *----------------------------------------------------------------------------* FUNCTION LogFileName( cLog ) *----------------------------------------------------------------------------* RETURN _SetGetLogFile(cLog) [/pre2] Запуск для авто распаковки demo2.exe -e <FileName.7z> <FullDirNameUnPack> Текст помещаем как demo2.prg в Advanced\7-Zip

SergKis: PS Поправил текст, размеры кнопок, убрал chr(0) из имени файла из архива и при запуске demo2.exe -e <FileName.7z> <FullDirNameUnPack> берет все файлы из архива (архив ОБЯЗАТЕЛЬНО без подкаталогов)

gfilatov2002: Подготовил 2-й апдейт сборки 21.07 Обновил также Unicode архив.

rvu: Спасибо!

gfilatov2002: Выложил 3-й апдейт сборки 21.07 Добавлены новые интересные функции, выполнена оптимизация использования внутренних STATIC переменных в ядре библиотеки (их количество уменьшилось на треть). Обновил также Unicode архив. Желаю всем участникам форума мира и добра

SergKis: gfilatov2002 Если появилось облако переменных, может есть смысл, внести обработку в Events() сообщения WM_COPYDATA, т.е. примерно так [pre2] ... CASE nMsg == WM_COPYDATA .and. _SetGetGlobal("b_WM_COPYDATA") != Nil // to get data cData := GetMessageData( lParam, @nDataID ) EVal( _SetGetGlobal("b_WM_COPYDATA"), nDataID, cData ) [/pre2] PS. Почему массив, а не Hash, переменных ведь много можно организовать или для системных переменных завести отдельное пространство переменных

gfilatov2002: SergKis пишет: может есть смысл, внести обработку в Events() Благодарю за предложение, но это, по-моему, излишне. Хотя, есть над чем подумать... SergKis пишет: Почему массив, а не Hash Так привычнее, поскольку для хранения PUBLIC переменных используется единый массив также.

SergKis: gfilatov2002 пишет PUBLIC переменных используется единый массив также. Это скорее, исторический, минус для hmg, т.к. структура внутри получилась довольно костяная и индивидуальная (описания контролов, где внутренние массивы различаются). Подключение пользовательских обработчиков через SET EVENTS FUNCTION TO MYEVENTS решает многое, но требуют знаний. Так привычнее Использую оч. давно механизм oKeyData() для решения пространства переменных программы и в реале их бывает оч. много и это с учетом, что на окнах такие данные (глобальные) перекрываются локальными значениями В Hash ключ можно использовать не только строковые значения, что бывает очень удобно PS. Пропустил, а удаление переменной есть ?

gfilatov2002: SergKis пишет: а удаление переменной есть ? Нет Но Вы без труда напишите функцию _DelGlobal()

SergKis: gfilatov2002 пишет Но Вы без труда напишите функцию _DelGlobal() Я бы пошел по пути STATIC _HMG_STATIC := oKeyData() //{} и уже все было бы через hash, CLASS TKeyData вынес бы за скобку #ifdef _OBJECT_ Код дополнительный для обслуживания _HMG_STATIC написан PS. CLASS TThrData можно, наверно, удалить. Вряд ли его используют в потоках, а для др. он не нужен

SergKis: PS Ф-я может быть такой[pre2] STATIC _HMG_STATIC := oKeyData() *-----------------------------------------------------------------------------* FUNCTION _SetGetGlobal( cVarName, xNewValue ) *-----------------------------------------------------------------------------* LOCAL xOldValue IF pCount() == 0 RETURN _HMG_STATIC ELSEIF pCount() == 1 IF ISCHAR(cVarName) ; cVarName := upper(cVarName) ENDIF RETURN _HMG_STATIC:Get(cVarName, NIL) ELSEIF pCount() == 2 IF ISCHAR(cVarName) ; cVarName := upper(cVarName) ENDIF xOldValue := _HMG_STATIC:Get(cVarName, NIL) IF ISNIL(xNewValue) ; _HMG_STATIC:Del(cVarName) ELSE ; _HMG_STATIC:Set(cVarName, xNewValue) ENDIF ENDIF RETURN xOldValue [/pre2] Применять так дополнительно (кроме выше описанных) aKeys := _SetGetGlobal():Keys() // список всех переменных и ключей aValues := _SetGetGlobal():Values() // список всех значений aAll := _SetGetGlobal():GetAll() // массив всех переменных и значений, т.е. {{key, value},...} и дальше по списку методов класса TKeyData Для строковых переменных можно работать os := _SetGetGlobal() cPath := os:cPathData os:bMy := {|| ... } примеры с Cargo есть на эту тему

gfilatov2002: SergKis пишет: Ф-я может быть такой Выполнил предложенные изменения для использования хэша и класса TKeyData. Исправил присвоение SergKis пишет: STATIC _HMG_STATIC := oKeyData() поскольку нельзя присваивать статической переменной возврат функции ВСЕ РАБОТАЕТ (как описано выше)! БЛАГОДАРЮ ЗА ПОМОЩЬ

SergKis: gfilatov2002 Может сделать THmgData класс, почистив от лишнего и вернуть TKeyData за скобку ? [pre2] STATIC _HMG_STATIC *-----------------------------------------------------------------------------* FUNCTION _SetGetGlobal( cVarName, xNewValue ) *-----------------------------------------------------------------------------* LOCAL xOldValue IF _HMG_STATIC == NIL ; _HMG_STATIC := oHmgData() ENDIF IF pCount() == 0 RETURN _HMG_STATIC ELSEIF pCount() == 1 RETURN _HMG_STATIC:Get(cVarName, Nil) ELSEIF pCount() == 2 xOldValue := _HMG_STATIC:Get(cVarName, Nil) IF ISNIL( xNewValue ) ; _HMG_STATIC:Del(cVarName) ELSE ; _HMG_STATIC:Set(cVarName, xNewValue) ENDIF ENDIF RETURN xOldValue *-----------------------------------------------------------------------------* FUNCTION oHmgData( lUpper ) *-----------------------------------------------------------------------------* hb_default( @lUpper, .T. ) RETURN THmgData():New( lUpper ) /////////////////////////////////////////////////////////////////////////////// CLASS THmgData /////////////////////////////////////////////////////////////////////////////// PROTECTED: VAR lUpp AS LOGICAL VAR aKey INIT hb_Hash() EXPORTED: VAR Cargo METHOD New( lUpper ) INLINE ( ::lUpp := !Empty( lUpper ), Self ) CONSTRUCTOR METHOD Set( Key, Block ) INLINE iif( HB_ISHASH( Key ), ::aKey := Key, hb_HSet ( ::aKey, ::Upp( Key ), Block ) ) METHOD Get( Key, Def ) INLINE hb_HGetDef( ::aKey, ::Upp( Key ), Def ) METHOD Del( Key ) INLINE iif( ::Pos( Key ) > 0, hb_HDel( ::aKey, ::Upp( Key ) ), Nil ) METHOD Pos( Key ) INLINE hb_HPos( ::aKey, ::Upp( Key ) ) METHOD Upp( Key ) INLINE iif( HB_ISCHAR(Key) .and. ::lUpp, Upper( Key ), Key ) METHOD Len() INLINE Len( ::aKey ) METHOD Keys() INLINE hb_HKeys( ::aKey ) METHOD Values() INLINE hb_HValues( ::aKey ) METHOD CloneHash() INLINE hb_HClone( ::aKey ) _METHOD GetAll( lAll ) _METHOD Eval( Block ) _METHOD Destroy() ERROR HANDLER ControlAssign ENDCLASS /////////////////////////////////////////////////////////////////////////////// METHOD GetAll( lAll ) CLASS THmgData LOCAL aRet := {} IF HB_ISLOGICAL( lAll ) .AND. lAll ::Eval( {| val | AAdd( aRet, val ) } ) ELSE ::Eval( {| val, Key | AAdd( aRet, { Key, val } ) } ) ENDIF RETURN aRet METHOD Eval( Block ) CLASS THmgData LOCAL i, b := HB_ISBLOCK( Block ) LOCAL l := HB_ISLOGICAL( Block ) .AND. Block LOCAL a := iif( b, NIL, Array( 0 ) ) FOR i := 1 TO ::Len() IF b ; Eval( Block, hb_HValueAt( ::aKey, i ), hb_HKeyAt( ::aKey, i ), i ) ELSEIF l ; AAdd( a, hb_HValueAt( ::aKey, i ) ) ELSE ; AAdd( a, { hb_HValueAt( ::aKey, i ), hb_HKeyAt( ::aKey, i ), i } ) ENDIF NEXT RETURN a METHOD Destroy() CLASS THmgData LOCAL i, k, o IF HB_ISHASH( ::aKey ) FOR i := 1 TO Len( ::aKey ) k := hb_HKeyAt( ::aKey, i ) hb_HSet( ::aKey, k, Nil ) hb_HDel( ::aKey, k ) NEXT ENDIF IF HB_ISOBJECT( ::Cargo ) .AND. ::Cargo:ClassName == ::ClassName o := ::Cargo IF HB_ISHASH( o:aKey ) FOR i := 1 TO Len( o:aKey ) k := hb_HKeyAt( o:aKey, i ) hb_HSet( o:aKey, k, Nil ) hb_HDel( o:aKey, k ) NEXT ENDIF ENDIF RETURN NIL METHOD ControlAssign( xValue ) CLASS THmgData LOCAL cMessage, uRet, lError cMessage := __GetMessage() lError := .T. IF PCount() == 0 uRet := ::Get( cMessage ) lError := .F. ELSEIF PCount() == 1 ::Set( SubStr( cMessage, 2 ), xValue ) uRet := ::Get( cMessage ) lError := .F. ENDIF IF lError uRet := NIL ::MsgNotFound( cMessage ) ENDIF RETURN uRet [/pre2] PS. Можно и метод Destroy() убрать, hb сам справится с очисткой, при завершении работы

gfilatov2002: SergKis пишет: Может сделать THmgData класс Принято

SergKis: gfilatov2002 пишет Принято Допустил неточность в методе Eval(), поправил и выделил цветом PS. Можно сделать псевдофункции на замену __mvPublic, __mvGet, ... и перенаправить с PUBLIC переменных на hash в переменной, к примеру, _HMG_PUBLIC

gfilatov2002: SergKis пишет: Допустил неточность в методе Eval() Спасибо, исправил.

gfilatov2002: Опубликован 4-й апдейт сборки 21.07 Благодарю за помощь Сергея Киселева P.S. Обновил также Unicode архив.

SergKis: Григорий, сделав обще доступной с пользователем область переменных _SetGetGlobal(), не закладывается ли мина пересечения имен ? Может надо разделить, для пользователя _SetGetGlobal(), а для системных вещей, на пример, _SysGlobal()\_HmgGlobal(). По мне стремная ситуация получается с именами сейчас, к примеру IF _SetGetGlobal( 'lOnChangeEvent' ) == NIL Я так тоже люблю свои переменные называть. Или выкинуть из описания для пользователя использование _SetGetGlobal(), можно оставить ф-ю oHmgData() для использования в таком виде LOCAL oVar := oHmgData() oVar:cPathData := "\HBK\DATA" oVar:lShow := .T. oVar:cTitle := "Bla bla bla" ...

gfilatov2002: SergKis пишет: стремная ситуация получается с именами Согласен. Для безопасности добавлю префикс _HMG_ к этим системным переменным

SergKis: gfilatov2002 пишет Для безопасности добавлю префикс _HMG_ к этим системным переменным Для безопасности лучше разделить, наверное и списки раздельные, т.е. контроль у каждого за своими переменными нормальный, и по действиям проще, просканировал тексты сейчас, заменил на системное использование и все.

Haz: Всем привет. нашел у себя в старом проекте. Совсем забыл Может будет интересно [pre2] METHOD Show(lShow) CLASS TSBrowse hb_default(@lShow, .t.) if lShow ShowWindow(::hWnd) else HideWindow(::hWnd) end RETURN nil [/pre2] Используется для прорисовки в одних координатах разных бровсов в зависимости от условий, примерно так [pre2] ... oBrw_1:Show( lOk ) oBrw_2:Show( !lOk ) ... [/pre2] В итоге , в зависимости от значения lOk один бровс спрячется, а второй появится Правда делал через __objAddMethod() чтоб исходники не менять. Но суть та же

SergKis: Haz пишет Правда делал через __objAddMethod() чтоб исходники не менять. В TControl уже есть методы METHOD Hide() INLINE ShowWindow( ::hWnd, SW_HIDE ) METHOD Show() INLINE ShowWindow( ::hWnd, SW_SHOWNA ) они работают. Т.е. можно писать iif( lOk, oBrw:Show(), oBrw:Hide() ) Через __objAddMethod() ты просто замещал метод oBrw:Show, наследованный от TControl, своим кодом

Haz: SergKis пишет: TControl уже есть методы METHOD Hide() INLINE ShowWindow( ::hWnd, SW_HIDE ) Значит я изобрёл велосипед Нашёл разгребая архивы, не проверив исходники. Спасибо

SergKis: Haz пишет Значит я изобрёл велосипед Это часто бывает проще, чем разобрать, что где лежит и как работает. Сам страдаю таким, ну нет времени куда то залезть поглубже , делаешь быстро, что бы работало. Так что не бери в голову ... со временем все встает на свои места

SergKis: gfilatov2002 Предлагаю в GetBox для valid исп. вызов со средой This. контрола, т.е.[pre2] FUNCTION OGETEVENTS( hWnd, nMsg, wParam, lParam ) ... CASE nMsg == WM_INVALID ... //IF ! Eval( oGet:postblock, oGet ) IF ! Do_ControlEventProcedure ( oGet:postblock, __mvGet( oGet:name ), oGet ) // valid SetFocus( hWnd ) ... [/pre2] Пример тут [pre2] /* * MINIGUI - Harbour Win32 GUI library Demo * * Copyright 2021 Sergej Kiselev <bilance@bilance.lv> * Copyright 2021 Verchenko Andrey <verchenkoag@gmail.com> */ ANNOUNCE RDDSYS #define _HMG_OUTLOG #include "minigui.ch" Function Main Local nFSize := 16, cFName := "Arial" Local nWDate, nWTime, x, y, nG, x2, cTime, oGet, cSay, nHObj Local ix,cv SET CENTURY ON SET NAVIGATION EXTENDED nWDate := 290 nWTime := 160 nG := 20 cTime := Space(6) nHObj := nFSize*2 DEFINE WINDOW Form_1 ; AT 0,0 ; WIDTH 600 ; HEIGHT 490 ; TITLE "MiniGUI Date + Time Demo" ; MAIN ; FONT cFName SIZE nFSize y := 20 x := nG cSay := "Period from:" @ y, x LABEL Label_1 VALUE cSay WIDTH nWDate HEIGHT nHObj y += Form_1.Label_1.Height // дата период начало @ y, x DATEPICKER Date_1 VALUE DATE() WIDTH nWDate HEIGHT nHObj ; DATEFORMAT "dd'.'MMMM' 'yyyy" SHOWNONE x2 := Form_1.Date_1.Col + Form_1.Date_1.Width + nG // время период начало @ y, x2 GETBOX Time_1 OBJ oGet VALUE cTime WIDTH nWTime HEIGHT nHObj ; PICTURE "@R 99:99:99" VALID {|og| bValid( og ) } BUTTONWIDTH nHObj ; ON GOTFOCUS {|| SendMessage(This.Handle, 177 /*EM_SETSEL*/, 0, Len( This.Value )) } ; ON INIT {|| _SetAlign ( This.Name, ThisWindow.Name, "CENTER" ) } ; IMAGE {"MINIGUI_EDIT_CANCEL",NIL } ; ACTION ( This.Value := space(6) ) y += Form_1.Date_1.Height + nG*2 cSay := "Period to:" @ y, x LABEL Label_2 VALUE cSay WIDTH nWDate HEIGHT nHObj y += Form_1.Label_2.Height // дата период конец @ y, x DATEPICKER Date_2 VALUE DATE()+2 WIDTH nWDate HEIGHT nHObj ; DATEFORMAT "dd'.'MMMM' 'yyyy" SHOWNONE // время период конец @ y, x2 GETBOX Time_2 OBJ oGet VALUE cTime WIDTH nWTime HEIGHT nHObj ; PICTURE "@R 99:99:99" VALID {|og| bValid( og ) } BUTTONWIDTH nHObj ; ON GOTFOCUS {|| SendMessage(This.Handle, 177 /*EM_SETSEL*/, 0, Len( This.Value )) } ; ON INIT {|| _SetAlign ( This.Name, ThisWindow.Name, "CENTER" ) } ; IMAGE { "MINIGUI_EDIT_CANCEL", "MINIGUI_EDIT_OK" } ; ACTION ( This.Time_2.Value := cTime ) ; ACTION2 ( This.Time_2.Value := "235959" ) y += Form_1.Date_2.Height + nG @ y, x BUTTON Button_1 CAPTION "Get search bar" ; WIDTH nWDate + nWTime + nG HEIGHT 35 ; ACTION ( Form_1.Label_Search.Value := mySearchString() ) y += Form_1.Button_1.Height + nG * 2 @ y, x LABEL Label_Search VALUE "Search line:" WIDTH Form_1.Width - 40 ; HEIGHT 80 TOOLTIP "Search line" FONTCOLOR RED END WINDOW CENTER WINDOW Form_1 ACTIVATE WINDOW Form_1 Return Nil * ----------------------------------------------------------------------------------- * Function mySearchString() * ----------------------------------------------------------------------------------- * Local cDate1, cDate2, cTime1, cTime2, cRet cDate1 := HB_DTOC( Form_1.Date_1.Value, 'YYYY-MM-DD') cDate2 := HB_DTOC( Form_1.Date_2.Value, 'YYYY-MM-DD') cTime1 := left(trim(This.Time_1.Value) + repl("0", 6), 6) cTime2 := left(trim(This.Time_2.Value) + repl("0", 6), 6) cTime1 := Transform(cTime1, "@R 99:99:99") cTime2 := Transform(cTime2, "@R 99:99:99") cRet := "" // поиск по полю TSZ типа "T@=" // = ModTime 8 Last modified date & time of this record // @ DayTime 8 Date & Time // T Time 4 or 8 Only time (if width is 4 ) or Date & Time (if width is 8 ) IF VAL(cTime1) > 0 .OR. VAL(cTime2) > 0 // время задано cRet += '( HB_TSTOSTR(SKLAD->TSZ) >= "'+cDate1+'" .AND. ' cRet += 'HB_TSTOSTR(SKLAD->TSZ) <= "'+cDate2+'" )' cRet += ' ???? ' + cTime1 + ' ???? ' + cTime2 ELSE // время не задано cRet += '( HB_TSTOSTR(SKLAD->TSZ) >= "'+cDate1+'" .AND. ' cRet += 'HB_TSTOSTR(SKLAD->TSZ) <= "'+cDate2+'" )' ENDIF cRet += ' .AND. !DELETED()' Return cRet * ----------------------------------------------------------------------------------- * STATIC FUNCTION bValid( oGet, nPost ) // проверка правильности времени в GetBox * ----------------------------------------------------------------------------------- * LOCAL lRet, lVl1, lVl2, lVl3, nVal LOCAL cVal := left(trim(oGet:VarGet()) + repl("0", 6), 6) LOCAL hGet := This.Handle LOCAL hWnd := ThisWindow.Handle lVl1 := lVl2 := lVl3 := .F. nVal := Val(left(cVal, 2)) IF nVal >= 0 .and. nVal < 24 ; lVl1 := .T. ENDIF nVal := Val(subs(cVal, 3, 2)) IF nVal >= 0 .and. nVal < 60 ; lVl2 := .T. ENDIF nVal := Val(subs(cVal, 5, 2)) IF nVal >= 0 .and. nVal < 60 ; lVl3 := .T. ENDIF lRet := lVl1 .and. lVl2 .and. lVl3 IF ! lRet // есть команды\ф-ии управления временем Tooltip, если надо исп. ShowGetValid можно применить // т.е. сохранить старое, поставить новое и потом после ShowGetValid (InkeyGui) восстановить SetFocus(hGet) ShowGetValid( hGet, This.Name+": Задайте правильно значение времени ! ", 'ОШИБКА '+ThisWindow.Name, 'E' ) InkeyGui( 5 * 1000 ) SetFocus(hWnd) oGet:VarPut(space(6)) oGet:Refresh() SetFocus(hGet) lRet := .T. ENDIF RETURN lRet #pragma BEGINDUMP #define _WIN32_WINNT 0x0600 #include <windows.h> #include "hbapi.h" #include "hbapicdp.h" #include <commctrl.h> #if ( defined( __BORLANDC__ ) && __BORLANDC__ < 0x582 ) typedef struct _tagEDITBALLOONTIP { DWORD cbStruct; LPCWSTR pszTitle; LPCWSTR pszText; INT ttiIcon; // From TTI_* } EDITBALLOONTIP, *PEDITBALLOONTIP; #define EM_SHOWBALLOONTIP (ECM_FIRST + 3) // Show a balloon tip associated to the edit control #define Edit_ShowBalloonTip(hwnd, peditballoontip) (BOOL)SNDMSG((hwnd), EM_SHOWBALLOONTIP, 0, (LPARAM)(peditballoontip)) #define EM_HIDEBALLOONTIP (ECM_FIRST + 4) // Hide any balloon tip associated with the edit control #define Edit_HideBalloonTip(hwnd) (BOOL)SNDMSG((hwnd), EM_HIDEBALLOONTIP, 0, 0) #define ECM_FIRST 0x1500 // Edit control messages #endif // (__BORLANDC__ < 0x582) // ToolTip Icons (Set with TTM_SETTITLE) #define TTI_NONE 0 #define TTI_INFO 1 #define TTI_WARNING 2 #define TTI_ERROR 3 #if (_WIN32_WINNT >= 0x0600) #define TTI_INFO_LARGE 4 #define TTI_WARNING_LARGE 5 #define TTI_ERROR_LARGE 6 #endif // (_WIN32_WINNT >= 0x0600) /* ShowGetValid( hWnd, cText [ , cTitul ] [ , cTypeIcon ] ) */ #if ( HB_VER_MAJOR == 3 ) #define _hb_cdpGetU16( cdp, fCtrl, ch) hb_cdpGetU16(cdp, ch ) #define _hb_cdpGetChar(cdp, fCtrl, ch) hb_cdpGetChar(cdp, ch) #else #define _hb_cdpGetU16( cdp, fCtrl, ch) hb_cdpGetU16(cdp, fCtrl, ch ) #define _hb_cdpGetChar(cdp, fCtrl, ch) hb_cdpGetChar(cdp, fCtrl, ch) #endif HB_FUNC( SHOWGETVALID ) { int i, k; const char *tp, *s; WCHAR Text[512]; WCHAR Title[512]; EDITBALLOONTIP bl; PHB_CODEPAGE s_cdpHost = hb_vmCDP(); HWND hWnd = ( HWND ) hb_parnl(1); if( ! IsWindow( hWnd ) ) return; bl.cbStruct = sizeof( EDITBALLOONTIP ); bl.pszTitle = NULL; bl.pszText = NULL; bl.ttiIcon = TTI_NONE; if( HB_ISCHAR( 2 ) ){ ZeroMemory( Text, sizeof(Text) ); k = hb_parclen(2); s = (const char *) hb_parc(2); for(i=0;i<k;i++) Text[ i ] = _hb_cdpGetU16( s_cdpHost, TRUE, s[ i ] ); bl.pszText = Text; } if( HB_ISCHAR( 3 ) ){ ZeroMemory( Title, sizeof(Title) ); k = hb_parclen(3); s = (const char *) hb_parc(3); for(i=0;i<k;i++) Title[ i ] = _hb_cdpGetU16( s_cdpHost, TRUE, s[ i ] ); bl.pszTitle = Title; } tp = ( const char * ) hb_parc(4); switch( *tp ){ case 'E' : bl.ttiIcon = TTI_ERROR_LARGE; break; case 'e' : bl.ttiIcon = TTI_ERROR; break; case 'I' : bl.ttiIcon = TTI_INFO_LARGE; break; case 'i' : bl.ttiIcon = TTI_INFO; break; case 'W' : bl.ttiIcon = TTI_WARNING_LARGE; break; case 'w' : bl.ttiIcon = TTI_WARNING; break; } Edit_ShowBalloonTip( hWnd, &bl ); } #pragma ENDDUMP [/pre2]

Andrey: SergKis пишет: Function mySearchString() Функцию исправить ! Уже есть правильная у Григория.

SergKis: Andrey пишет Уже есть правильная у Григория. Тут другое, блок кода на valid запускается сейчас по Eval(...), что со средой This, неопределенно предлагаю ... (см. выше). Тогда This среда будет для текущего GETBOX. В примере, что у тебя ThisWindow.Name попадаем на окно GetBox, но можем и промахнуться, а This.Name им GetBox нет, есть опять имя окна.

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

SergKis: gfilatov2002 Поправил в примере выше bValid(), выделил цветом. Позволяет тогда без смены времени (в пределах времени tooltip) управлять длительностью сообщения ShowGetValid, т.е. нажав клавишу или клик мышой на getbox (InkeyGui сработает), переключится фокус и сообщение уйдет, потом возвращаем фокус на getbox или сообщение будет держаться пока время InkeyGui не кончится PS ShowGetValid имеет 6 вариантов image E,e,I,i,W,w, т.е. тут ShowGetValid( hGet, This.Name+": Задайте правильно значение времени ! ", 'ОШИБКА '+ThisWindow.Name, 'E' ) Можно использовать CRLF и chr(9) в тексте ShowGetValid( hGet, This.Name+": Text 1 !"+CRLF+"Text 2"+chr(9)+"ku-ku", 'ИНФОРМАЦИЯ '+ThisWindow.Name, 'i' )

gfilatov2002: SergKis пишет: Поправил в примере выше bValid() Спасибо, теперь работает хорошо

Петр: Andrey пишет: Уже есть правильная у Григория Судя по RC2 - пока нету..

Петр: Предложения по изменению c_datepicker.c #ifdef __XHARBOUR__ #define HB_ISDATETIME ISDATETIME #endif HB_FUNC( SETDATEPICK ) { HWND hwnd; SYSTEMTIME sysTime; hwnd = ( HWND ) HB_PARNL( 1 ); if ( hb_pcount() == 2 && HB_ISDATE( 2 ) ) { long lJulian; int iYear, iMonth, iDay; lJulian = hb_pardl( 2 ); hb_dateDecode( lJulian, &iYear, &iMonth, &iDay ); sysTime.wYear = ( WORD ) iYear; sysTime.wMonth = ( WORD ) iMonth; sysTime.wDay = ( WORD ) iDay; } else if( hb_pcount() > 2 ) { sysTime.wYear = ( WORD ) hb_parni( 2 ); sysTime.wMonth = ( WORD ) hb_parni( 3 ); sysTime.wDay = ( WORD ) hb_parni( 4 ); } else { sysTime.wYear = 2005; // date() ? sysTime.wMonth = 1; sysTime.wDay = 1; } sysTime.wDayOfWeek = 0; sysTime.wHour = 0; sysTime.wMinute = 0; sysTime.wSecond = 0; sysTime.wMilliseconds = 0; if( SendMessage( hwnd, DTM_SETSYSTEMTIME, GDT_VALID, ( LPARAM ) &sysTime ) == GDT_VALID ) hb_retl( HB_TRUE ); else hb_retl( HB_FALSE ); } HB_FUNC( SETTIMEPICK ) { HWND hwnd; SYSTEMTIME sysTime; hwnd = ( HWND ) HB_PARNL( 1 ); sysTime.wYear = 2005; sysTime.wMonth = 1; sysTime.wDay = 1; sysTime.wDayOfWeek = 0; sysTime.wHour = ( WORD ) hb_parni( 2 ); sysTime.wMinute = ( WORD ) hb_parni( 3 ); sysTime.wSecond = ( WORD ) hb_parni( 4 ); sysTime.wMilliseconds = 0; if( SendMessage( hwnd, DTM_SETSYSTEMTIME, GDT_VALID, ( LPARAM ) &sysTime ) == GDT_VALID ) hb_retl( HB_TRUE ); else hb_retl( HB_FALSE ); } HB_FUNC( GETDATEPICDATE ) { SYSTEMTIME st; st.wYear = 0; st.wMonth = 0; st.wDay = 0; SendMessage( ( HWND ) HB_PARNL( 1 ), DTM_GETSYSTEMTIME, 0, ( LPARAM ) &st ); hb_retd( st.wYear, st.wMonth, st.wDay ); } HB_FUNC( GETDATEPICKYEAR ) { SYSTEMTIME st; st.wYear = 0; SendMessage( ( HWND ) HB_PARNL( 1 ), DTM_GETSYSTEMTIME, 0, ( LPARAM ) &st ); hb_retni( st.wYear ); } HB_FUNC( GETDATEPICKMONTH ) { SYSTEMTIME st; st.wMonth = 0; SendMessage( ( HWND ) HB_PARNL( 1 ), DTM_GETSYSTEMTIME, 0, ( LPARAM ) &st ); hb_retni( st.wMonth ); } HB_FUNC( GETDATEPICKDAY ) { SYSTEMTIME st; st.wDay = 0; SendMessage( ( HWND ) HB_PARNL( 1 ), DTM_GETSYSTEMTIME, 0, ( LPARAM ) &st ); hb_retni( st.wDay ); } HB_FUNC( GETDATEPICKHOUR ) { SYSTEMTIME st; st.wHour = 0; if( SendMessage( ( HWND ) HB_PARNL( 1 ), DTM_GETSYSTEMTIME, 0, ( LPARAM ) &st ) == GDT_VALID ) hb_retni( st.wHour ); else hb_retni( -1 ); } HB_FUNC( GETDATEPICKMINUTE ) { SYSTEMTIME st; st.wMinute = 0; if( SendMessage( ( HWND ) HB_PARNL( 1 ), DTM_GETSYSTEMTIME, 0, ( LPARAM ) &st ) == GDT_VALID ) hb_retni( st.wMinute ); else hb_retni( -1 ); } HB_FUNC( GETDATEPICKSECOND ) { SYSTEMTIME st; st.wSecond = 0; if( SendMessage( ( HWND ) HB_PARNL( 1 ), DTM_GETSYSTEMTIME, 0, ( LPARAM ) &st ) == GDT_VALID ) hb_retni( st.wSecond ); else hb_retni( -1 ); } HB_FUNC( DTP_SETDATETIME ) { HWND hwnd; SYSTEMTIME sysTime; BOOL bTimeToZero = FALSE; hwnd = ( HWND ) HB_PARNL( 1 ); if( HB_ISDATETIME( 2 ) ) { int iYear, iMonth, iDay, iHour, iMinute, iSecond, iMSec; #ifdef __XHARBOUR__ long lJulian, lMilliSec; #endif #ifndef __XHARBOUR__ hb_timeStampUnpack( hb_partd( 2 ), &iYear, &iMonth, &iDay, &iHour, &iMinute, &iSecond, &iMSec ); #else if( hb_partdt( &lJulian, &lMilliSec, 2 ) ) { hb_dateDecode( lJulian, &iYear, &iMonth, &iDay ); hb_timeStampDecode( lMilliSec, &iHour, &iMinute, &iSecond, &iMSec ); } #endif sysTime.wYear = ( WORD ) iYear; sysTime.wMonth = ( WORD ) iMonth; sysTime.wDay = ( WORD ) iDay; sysTime.wDayOfWeek = 0; sysTime.wHour = ( WORD ) iHour; sysTime.wMinute = ( WORD ) iMinute; sysTime.wSecond = ( WORD ) iSecond; sysTime.wMilliseconds = ( WORD ) iMSec; } else if( HB_ISDATE( 2 ) ) { long lJulian; int iYear, iMonth, iDay; lJulian = hb_pardl( 2 ); hb_dateDecode( lJulian, &iYear, &iMonth, &iDay ); sysTime.wYear = ( WORD ) iYear; sysTime.wMonth = ( WORD ) iMonth; sysTime.wDay = ( WORD ) iDay; sysTime.wDayOfWeek = 0; bTimeToZero = TRUE; } else { sysTime.wYear = ( WORD ) hb_parnidef( 2, 2005 ); sysTime.wMonth = ( WORD ) hb_parnidef( 3, 1 ); sysTime.wDay = ( WORD ) hb_parnidef( 4, 1 ); sysTime.wDayOfWeek = 0; if( hb_pcount() >= 7 ) { sysTime.wHour = ( WORD ) hb_parni( 5 ); sysTime.wMinute = ( WORD ) hb_parni( 6 ); sysTime.wSecond = ( WORD ) hb_parni( 7 ); sysTime.wMilliseconds = ( WORD ) hb_parni( 8 ); } else bTimeToZero = TRUE; } if( bTimeToZero ) { sysTime.wHour = 0; sysTime.wMinute = 0; sysTime.wSecond = 0; sysTime.wMilliseconds = 0; } if( SendMessage( hwnd, DTM_SETSYSTEMTIME, GDT_VALID, ( LPARAM ) &sysTime ) == GDT_VALID ) hb_retl( HB_TRUE ); else hb_retl( HB_FALSE ); } HB_FUNC( DTP_GETDATETIME ) { SYSTEMTIME st; SendMessage( ( HWND ) HB_PARNL( 1 ), DTM_GETSYSTEMTIME, 0, ( LPARAM ) &st ); #ifdef __XHARBOUR__ hb_retdtl( hb_dateEncode( st.wYear, st.wMonth, st.wDay ), hb_timeStampEncode( st.wHour, st.wMinute, st.wSecond, st.wMilliseconds ) ); #else hb_rettd( hb_timeStampPack( st.wYear, st.wMonth, st.wDay, st.wHour, st.wMinute, st.wSecond, st.wMilliseconds ) ); #endif } Что нового Добавлена функция GetDatePickDate() GetDatePickDate( c ) == hb_Date( GetDatePickYear ( c ), GetDatePickMonth ( c ), GetDatePickDay ( c ) ) SetDatePick в качестве второго аргумента может получать тип Date SetDatePick(c, Date()) dtp_SetDatetime в качестве второго аргумента может получать тип Date, тогда она работает как SetDatePick() dtp_SetDatetime(c, Date()) Улучшена совместимость с xHarbour Также теперь функции SetDatePick(), SetTimePick(), dtp_SetDatetime() в зависимости от того успешно или нет они отработали, возвращают соответственно .T. или .F.

gfilatov2002: Петр пишет: Предложения по изменению c_datepicker.c Узнаю руку мастера Благодарю за помощь

gfilatov2002: Опубликована свежая сборка 21.09 Благодарю за помощь Сергея Киселева, Игоря Назарова и Петра Черного Друзья, без Вашей помощи этот релиз не состоялся бы... P.S. Обновил также Unicode архив. P.S. 2 Желаю всем мира и добра

SergKis: gfilatov2002 Можно ссылочку на Unicode архив, старая погибла.

gfilatov2002: SergKis пишет: ссылочку на Unicode архив Отправил в личку

SergKis: gfilatov2002 Спасибо PS Может есть смысл перевести Public &mVar и __mv... ф-ии на аналог _SetGetGlobal(), что то такое STATIC _HMG_PUBLIC FUNC _SetGetPublic(...) ... смотрел на эту тему исходники и файлы ch, должно получиться (окна и контролы, по формируемым именам, вроде укладываются в схему) В ф-ии _SetGetGlobal() можно убрать[pre2] IF ISCHAR( cVarName ) cVarName := Upper( cVarName ) ENDIF т.к. параметр имя проходит через метод :Upp() в нем такое делается, т.к. в :New( lUpper := .T.) [/pre2]

gfilatov2002: SergKis пишет: Может есть смысл перевести Public &mVar и __mv... ф-ии на аналог _SetGetGlobal(), что то такое STATIC _HMG_PUBLIC FUNC _SetGetPublic(...) ... Я не против, жду ваших предложений Но смогу ответить/рассмотреть уже только после отпуска, ухожу на две недели SergKis пишет: В ф-ии _SetGetGlobal() можно убрать Убрал, конечно Благодарю за помощь

Петр: SergKis пишет: Может есть смысл перевести Public &mVar и __mv... ф-ии на аналог _SetGetGlobal() И в чем будет ожидаемый профит ? Убытки в виде потери совместимости и падения производительности - это понятно.

SergKis: Петр пишет Убытки в виде падения производительности Почему ? Для public таблица описаний, если не ошибаюсь массив структуированный, а тут Hash Убытки в виде потери совместимости Где то нет Hash ? Сейчас он внутри hmg используется в getbox, TsBrowse, может еще где И в чем будет ожидаемый профит ? Уйти на STATIC

Петр: SergKis пишет: Где то нет Hash ? Сейчас он внутри hmg используется в getbox, TsBrowse Причем здесь Hash. Старый код с ухищрениями в виде прямого доступа к публичным переменным перестанет работать. А Hash используется там куда его воткнули, к месту или нет, как будто в getbox без Hash обойтись не было возможности. SergKis пишет: Уйти на STATIC Что это даст? Мне никогда не нравилась "внутренняя" реализация MiniGUI, но по крайней мере она существует не один год в именно в таком виде, как её реализовал Роберто Лопез. У нее есть недостатки, но есть и какая-то концепция. Вот новую концепцию хотелось бы и услышать.

SergKis: Петр пишет Вот новую концепцию хотелось бы и услышать. Как то не собирался концепции разводить. Хочется просто уменьшить ко-во Public переменных в динамической памяти. При всем уважении к реализации сборщика мусора (он хорошо работает), но потери адресов public переменных происходят, так же как это было и VO (Access violation). как будто в getbox без Hash обойтись не было возможности. Можно, но с hash удобнее и код проще. Старый код с ухищрениями в виде прямого доступа к публичным переменным перестанет работать Вот потому и спросил "Может ...", т.к. пока не встречал примеров на эту тему. Не знаю кто будет организовывать прямой доступ к переменной окна или к переменной контрола для хранения индекса (речь идет только о них), т.е.[pre2] mVar := '_' + ParentFormName + '_' + ControlName k := _GetControlFree() Public &mVar. := k или mVar := '_' + FormName k := AScan ( _HMG_aFormDeleted, .T. ) Public &mVar. := k и *-----------------------------------------------------------------------------* FUNCTION GetControlIndex ( ControlName , ParentForm ) *-----------------------------------------------------------------------------* LOCAL mVar := '_' + ParentForm + '_' + ControlName RETURN __mvGetDef ( mVar , 0 ) [/pre2] по крайней мере она существует не один год в именно в таком виде, как её реализовал Роберто Лопез Огромное САСИБО ему за это, но времени уже много прошло, жизнь идет дальше, возможно и тут надо что то менять

Петр: SergKis пишет: но потери адресов public переменных происходят Мне понравился подход Андрея: запретить пользователям пить кофе (курить, есть, пить, спать.. ). Это лучше чем разбираться в причинах падений программы. SergKis пишет: Как то не собирался концепции разводить. Ну ладно. А как будет выглядеть такой вот код с использованием Hash _HMG_ActiveFormName := IF( Empty( _HMG_ActiveFormName ), 'Form_1', _HMG_ActiveFormName ) _HMG_BeginWindowActive := .T. ну или после препроцессора _HMG_SYSDATA[33] := IF( Empty( _HMG_SYSDATA[33] ), "Form_1", _HMG_SYSDATA[33] ) _HMG_SYSDATA[34] := .T. без потери производительности и с соблюдением безопасности при mt.

SergKis: Петр пишет А как будет выглядеть такой вот код с использованием Hash Так и будет выглядеть, эти define не трогаем, речь идет о ф-ях __mv... __mvPublic, __mvGet, __mvPut, ... причем для ограниченного применения ТОЛЬКО для переменных от имен form и контрола, которые динамически формируются в момент создания DEFINE ... что то. Это строки [pre2] mVar := '_' + ParentFormName + '_' + ControlName k := _GetControlFree() Public &mVar. := k или mVar := '_' + FormName k := AScan ( _HMG_aFormDeleted, .T. ) Public &mVar. := k и *-----------------------------------------------------------------------------* FUNCTION GetControlIndex ( ControlName , ParentForm ) *-----------------------------------------------------------------------------* LOCAL mVar := '_' + ParentForm + '_' + ControlName RETURN __mvGetDef ( mVar , 0 ) [/pre2] тут hash просто напрашивается, по мне Мне понравился подход Андрея: запретить пользователям пить кофе Так он и не запрещает. По моей рекомендации убирает из блока кода внешнюю для него public переменную и переводит на внутреннюю полученную через параметр и это место работает. Просто мест, сделанных от стандартного подхода от MiniGui, у него много, вот они начинают сыпаться со временем нарастания программы

Петр: SergKis пишет: Так и будет выглядеть, эти define не трогаем, речь идет о ф-ях __mv... __mvPublic, __mvGet, __mvPut, ... причем для ограниченного применения ТОЛЬКО для переменных от имен form и контрола, которые динамически формируются в момент создания DEFINE ... что то. Наконец-то дошло. Идея хорошая. Ждем реализацию. SergKis пишет: Так он и не запрещает. Я там забыл смайлик поставить

SergKis: Петр пишет Ждем реализацию. Надо определиться по именам. Мне в голову лезет такое [pre2] #xtranslate _SetNameList( <x> , <v> ) => _SetGetNamesList( <x> , <v> ) #xtranslate _GetNameList( <x> ) => _SetGetNamesList( <x> ) #xtranslate _DelNameList( <x> ) => _SetGetNamesList( <x> , NIL , .T. ) *-----------------------------------------------------------------------------* FUNCTION _SetGetNamesList( cVarName, xNewValue, lDelete ) *-----------------------------------------------------------------------------* STATIC _HMG_NAMESLIST IF HB_ISNIL( _HMG_NAMESLIST ) _HMG_NAMESLIST := oHmgData() ENDIF IF PCount() == 1 RETURN _HMG_NAMESLIST:Get( cVarName, 0 ) ELSEIF PCount() == 2 _HMG_NAMESLIST:Set( cVarName, xNewValue ) ELSEIF PCount() == 3 IF lDelete ; _HMG_NAMESLIST:Del( cVarName ) ELSE ; _HMG_NAMESLIST:Set( cVarName, NIL ) ENDIF ENDIF RETURN _HMG_NAMESLIST [/pre2]

Петр: SergKis пишет: Надо определиться по именам. cVarName вроде уже как не cVarName, а cNewName d в случае Set или просто cName в других. А вот чего это Name FormsAndControlsNamesList или FCNamesList или ListOfFormsAndControlsNames или просто NamesList

SergKis: Петр пишет cVarName вроде уже как не cVarName тогда может так FUNCTION _SetGetNamesList( cName, nIndex, lDelete ) просто NamesList С этого начал, но в hmg сложились такие названия _SetGetGlobal, _SetGetCargo, может еще есть не помню пошел по этому пути в наименовании, а FormsAndControlsNamesList уж очень длинно прочитать, а выговорить вслух

gfilatov2002: Петр пишет: Идея хорошая. Ждем реализацию. Подготовил первый релиз-кандидат для новой сборки 21.10 с учетом обсуждения выше Кратко, что нового [pre2] * Fixed: DATEPICKER control: 'Value' property returns _always_ TimeStamp type (bug was introduced in the build 21.09). * Fixed: The clause NOSHOW was ignored on a startup of the Panel windows. That's exist in the official HMG version too. * Fixed detected resource leakage in the function ShellAbout() with usage of the MiniGUI Resources control system. * Added the important optimization the use of the internal PUBLIC variables at creating of the forms and controls in the MiniGUI core with using of the new function _SetGetNamesList() which create a GLOBAL hash for a storing of the Pseudo-Global variables. Note: There ia s slight chance of regression. * Added the OOP class TIniData for managing of the values in the ini files with converting an ini file string to the desired types. * Added the macro definition for call DLL function to the header file mgdefs.h for compatibility with Official HMG. * Updated header file i_hmgcompat.ch for compatibility with Official HMG. * Updated the TSBrowse, MiniPrint, MiniPrint2, PropGrid, PropSheet, hmg_qhtm and HbSQLite3 libraries. * Added the new interesting samples and updated some examples. [/pre2] Благодарю за помощь и ваше внимание к этому проекту

SergKis: gfilatov2002 Предложение поправить [pre2] CLASS TControl ... METHOD SuperKeyDown( nKey, nFlags, xObj ) ... METHOD SuperKeyDown( nKey, nFlags, xObj ) CLASS TControl ... if ::bKeyDown != nil return Eval( ::bKeyDown, nKey, nFlags, xObj ) endif ... METHOD KeyDown( nKey, nFlags ) CLASS TSBrowse ... CASE ::lIgnoreKey( nKey, nFlags ) // has to go before any other case statement ::SuperKeyDown( nKey, nFlags, Self ) ... ELSEIF ::lCellBrw .AND. ( nKey == VK_COPY .OR. nKey == VK_INSERT ) uTemp := cValToChar( ::bDataEval( ::aColumns[ nCol ] ) ) CopyToClipboard( uTemp ) SysRefresh() ELSE ::SuperKeyDown( nKey, nFlags, Self ) ENDIF ... ELSE ::SuperKeyDown( nKey, nFlags, Self ) ENDIF CASE nKey == VK_HOME ... OTHERWISE ::SuperKeyDown( nKey, nFlags, Self ) ENDCASE RETURN 0 ... METHOD New( cControlName, nRow, nCol, nWidth, nHeight, bLine, aHeaders, aColSizes, cParentWnd, ; // CLASS TSBrowse ... IF HB_ISARRAY(aHeaders) .and. Len(aHeaders) > 0 .and. aHeaders[1] == NIL aHeaders := NIL ENDIF IF HB_ISARRAY(aColSel) .and. Len(aColSel) > 0 .and. aColSel[1] == NIL aColSel := NIL ENDIF IF aColors != NIL ... тогда можно делать DEFINE TBROWSE Street OBJ oBrw AT nYBrw, nXBrw ALIAS cAls WIDTH nWBrw HEIGHT nHBrw ; HEADERS aHeader ; COLORS aColors ; BACKCOLOR aBrwBC ; JUSTIFY aAlign ; SELECTOR lSelector ; FONT aFont ; COLUMNS aField ; NAMES aNames ; FOOTERS aFooter ; LOADFIELDS ; EMPTYVALUE ; GOTFOCUSSELECT ; ON INIT {|ob| Tsb_Init( ob ) } ; задавая как массив или NIL (сейчас NIL не проходит) aHeader aField и задавать объект тсб в блоке кода (сейчас его нет) :bKeyDown := { |nKey,nFalgs,ob| myKeyAction(nKey, 0, nFalgs, ob) } и делать STATIC FUNCTION myKeyAction( nKey, nValButton, nFlags, oBrw) // static\public переменная oBrw_Street не нужна LOCAL oBrw := oBrw_Street LOCAL cForm, cAlias, cSearch, lRet := .T. DEFAULT nValButton := 0, nFlags := 0 IF ! ISOBJECT(oBrw) ; RETURN .F. ENDIF cForm := oBrw:cParentWnd cAlias := oBrw:cAlias ... [/pre2]

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

Haz: Хотел последнюю версию скачать .... на рабочий комп , по привычке набрал http://hmgextended.com/files/CONTRIB а там теперь живет [pre2] Forbidden You don't have permission to access this resource. Additionally, a 403 Forbidden error was encountered while trying to use an ErrorDocument to handle the request. [/pre2] что то поменялось ? или это конец ?

Dima: Haz так вот она http://hmgextended.com/files/CONTRIB/hmg-21.09-setup.exe

Haz: Dima пишет: так вот она а без указания конкретного релиза никак ? Список не посмотреть?

SergKis: Haz Может так пойдет http://hmgextended.com/

Dima: Haz пишет: а без указания конкретного релиза никак ? Список не посмотреть? Можно через ж... http://web.archive.org/web/20210314190309/http://hmgextended.com/files/CONTRIB/

Haz: Dima пишет: Можно через ж... через ж... у меня Тоже не работает.

Haz: SergKis пишет: Может так пойдет Так по ссылке на HMG пишет сайт не найден.💀

SergKis: Haz пишет Так по ссылке на HMG пишет сайт не найден. повторно вошел по адресу и скачал по ссылке http://hmgextended.com/files/CONTRIB/hmg-21.09-setup.exe

Haz: SergKis пишет: повторно вошел по адресу и скачал по ссылке скинь ссылку на список. Где все версии как раньше . У меня не работает

SergKis: Haz Архивные не доступны через сайт Какую надо, у мня есть, могу на ftp положить

Dima: Haz пишет: через ж... у меня Тоже не работает Да ладно Список конечно не весь , но всё же и потом как именуются файлы тоже понятно.

Haz: SergKis пишет: Архивные не доступны через сайт Понятно. Я просто не всегда форум отслеживаю . если где требовалось пересобрать проект. Просто дергал bcc и HMG с сайта. Исходники есть у клиента. Теперь придётся и свою версию hmg в облаках держать на случай работы в полях. Плюс иногда на новой версии старый проект не собрать и из-за мелкой правки пол дня переделывать придётся

Haz: Dima пишет: Да ладно Список конечно не весь да так работает Но последних там не будет скорее всего

Dima: Haz пишет: Но последних там не будет скорее всего Dima пишет: и потом как именуются файлы тоже понятно. http://hmgextended.com/files/CONTRIB/hmg-21.09-setup.exe http://hmgextended.com/files/CONTRIB/hmg-21.08-setup.exe http://hmgextended.com/files/CONTRIB/hmg-21.07-setup.exe http://hmgextended.com/files/CONTRIB/hmg-21.06-setup.exe и тд и тп :)

gfilatov2002: Опубликована новая сборка 21.10 Благодарю за помощь Сергея Киселева Желаю всем доброго здоровья и успеха в делах

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

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

imar2: Здравствуйте. Прошу помощи по HMG MiniGUI. У меня консольное приложение (переведено с Clipper'а). Почему-то HMG после версии 21.05 поля GET'ов на экране выделяет двоеточиями в начале и конце. Как это можно убрать и можно ли? Спасибо.

gfilatov2002: imar2 пишет: Как это можно убрать Надо добавить в самом начале главного модуля такую строку Set( _SET_DELIMITERS, .F. )

imar2: gfilatov2002, большое спасибо. Все стало ОК.

gfilatov2002: Выложил срочное обновление сборки 21.10 из-за обнаруженной досадной опечатки в коде по адресу: http://hmgextended.com/files/CONTRIB/hmg-21.10-setup.exe Что нового: [pre2] * Fixed: Bug due to stupid typo in the internal function _GenActivateId() (introduced in the build 21.10). Contributed by Grigory Filatov <gfilatov@inbox.ru> * Updated: WebCam commands processing for compatibility with Windows 11. Warning: You should switch ON your camera in the 'Settings': go to 'Privacy & Security' and navigate to Cameras. If you want to allow apps to have access to your camera, make sure that the 'Let apps access your camera' option is enabled. Now you can select specifically which apps can access your camera. Contributed by Grigory Filatov <gfilatov@inbox.ru> (see demo in folder \samples\Advanced\WebCam_2) * New: 'Draw Edge usage' sample. Based upon a contribution of Pablo Cesar Arrascaeta at HMGFORUM. Adapted for Minigui Extended by Grigory Filatov <gfilatov@inbox.ru> (see in folder \samples\Basic\DrawEdge) [/pre2]

SergKis: gfilatov2002 пишет Выложил срочное обновление сборки 21.10 к unicode сборке это относится ?

gfilatov2002: SergKis пишет: к unicode сборке это относится ? Да, уже обновил unicode сборку тоже. Благодарю за напоминание

SergKis: gfilatov2002 пишет уже обновил unicode сборку тоже получаю архив 21.10 unicode, но в нем все от 26.10.21 числа, в лучшем случае

gfilatov2002: SergKis пишет: получаю архив 21.10 unicode Только что проверил этот архив путем скачивания, там все в порядке. Возможно, вам стоит почистить кэш браузера

gfilatov2002: Снова обновил сборку 21.10 из-за обнаруженной недоработки после введения в ядро глобального хэша по адресу: http://hmgextended.com/files/CONTRIB/hmg-21.10-setup.exe Также выложил свежий unicode-архив для этой сборки

Andrey: gfilatov2002 пишет: Выложил срочное обновление сборки 21.10 из-за обнаруженной досадной опечатки в коде Перекомпилировал свою большую прогу. Теперь вылетает... Создаю на окне [pre2] DEFINE TBROWSE oBrwList ; ..... FONT aTsbFont ; BACKCOLOR aBackColor2 ; GRID ; // это oBrw:lCellBrw := TRUE EDIT // все колонки с lEdit := .T. END TBROWSE CreateBrowseAbonTxt('oBrwList', ....) END WINDOW CENTER WINDOW Form_AbLst ACTIVATE WINDOW Form_AbLst _hmg_InplaceParentHandle := hParent DoMethod(cWnd, 'SetFocus') IF ! empty(cFocus) DoMethod(cWnd, cFocus, 'SetFocus') ENDIF RETURN NIL .... STATIC FUNCTION CreateBrowseAbonTxt(cTbrName,....) .... // создаём таблицу из массива oBrwA := SetArrayTo( cTbrName, cForm, aArray, aFontHF, aHead, aFSize,; aFoot, aPict, aAlign, aName ) ..... MG_Debug(cTbrName,oBrwA:cControlName) // в лог выдаёт -> oBrwList oBrwList // по правой кнопки мышки - контекстное меню TBROWSE DEFINE CONTEXT MENU CONTROL &cTbrName ..... [/pre2] Ошибка при работе проги: [pre2]Error MGERROR/0 Form is not defined. Program terminated. Called from MSGMINIGUIERROR(0) Called from GETFORMHANDLE(0) Called from _DEFINECONTROLCONTEXTMENU(0) Called from CREATEBROWSEABONTXT(733) in module: form_dog2abon.prg Called from FORM_ABONLIST(461) in module: form_dog2abon.prg Called from DOGLISTABON(224) in module: form_dog2abon.prg Called from (b)FORM_MYTABLE(507) in module: tbrw_table.prg Called from DO_WINDOWEVENTPROCEDURE(0) Called from TWNDDATA:DOEVENT(0) Called from DO_ONWNDLAUNCH(0) Called from (b)INIT(0)[/pre2]

SergKis: Andrey пишет MG_Debug(cTbrName,oBrwA:cControlName) // в лог выдаёт -> oBrwList oBrwList Что просишь (по разному), то и получаешь cTbrName,oBrwA:cControlName спроси после поправленного MG_Debug(...) ? cForm, This.Name, ThisWindow.Name, oBrwA:cParentWnd, oBrwA:cControlName Думаю, что MG_Debug(...) (окно на варианте HMG_Alert()) между DEFINE WINDOW ... и END WINDOW портит среду This, т.е. что хотел, то и получил

gfilatov2002: Подготовил третий релиз-кандидат для новой сборки 21.11 со следующим списком изменений: [pre2] * Modified: The useful functions GetDesktopRealWidth() and GetDesktopRealHeight() were defined as Public for compatibility with Official HMG. Requested by HMG user Jimmy. Contributed by Grigory Filatov <gfilatov@inbox.ru> (see demo2.prg in folder \samples\Advanced\FitToDesktop) * Modified: The useful function HMG_GetLocaleInfo() was moved to MiniGUI core. Contributed by Grigory Filatov <gfilatov@inbox.ru> (see demo in folder \samples\Advanced\GetUserLocaleInfo) * Enhanced: Added the read/write property 'Editable' for the GRID control. You can set/get this property at runtime as usually: Win.Grid.Editable := lValue GetProperty( Form, Grid, 'Editable' ) --> .T. | .F. Contributed by Grigory Filatov <gfilatov@inbox.ru> (see demo in folder \samples\Basic\Grid_CellNavigation) * Updated: Synchronized Extended HMG for compatibility with Official HMG: - New: Added the read/write property 'CellNavigation' for a Grid control. You can set/get this property at runtime: - function syntax: SetProperty( FormName, GridName, 'CellNavigation', lValue ) GetProperty( FormName, GridName, 'CellNavigation' ) --> .T. | .F. - pseudo-OOP syntax: FormName.GridName.CellNavigation := lValue FormName.GridName.CellNavigation --> logical value Based upon a contribution of Claudio Soto <srvet/at/adinet.com.uy>. Adapted for Minigui Extended by Grigory Filatov <gfilatov@inbox.ru> (see demo in folder \samples\Basic\Grid_CellNavigation) * Updated: Adaptation FiveWin Class TSBrowse 9.0 in HMG: - added mouse click and double click processing in the Special Header; - added the new variables :nBmpMaskCell, :nBmpMaskHead, :nBmpMaskFoot and :nBmpMaskSpcHd in the TSColumn class. Usage: FUNCTION SetBrwEnum( oBrw, nOneCol ) LOCAL oCol, nI, nCnt := 0 DEFAULT nOneCol := 1 FOR EACH oCol IN oBrw:aColumns nI := hb_enumindex( oCol ) oCol:cSpcHeading := NIL oCol:cSpcHeading := iif( nI == nOneCol, "#" , "+" ) IF nI > nOneCol IF oCol:lVisible oCol:cSpcHeading := hb_ntos( ++nCnt ) oCol:nBmpMaskHead := 0x00CC0020 // SRCCOPY oCol:nBmpMaskSpcHd := 0x00CC0020 // SRCCOPY ENDIF ENDIF NEXT RETURN NIL Requested by Verchenko Andrey. Contributed by Sergej Kiselev (see demo in folder \samples\Advanced\Tsb_5Win) * Updated: HBPrinter library: - pacified the warning in the C-code for compatibility with MS Visual C++ 2022 compiler. Contributed by Grigory Filatov <gfilatov@inbox.ru> (see source in folder \Source\HBPrinter) * Updated: HbSQLite3 library: - update for using SQLITE3 latest version 3.37.0dev. Contributed by Grigory Filatov <gfilatov@inbox.ru>. * Updated: Harbour Compiler 3.2.0dev (SVN 2021-04-28 20:02): - restored support for alternative memory manager written by Doug Lea (enabled by default in Harbour). Contributed by Grigory Filatov <gfilatov@inbox.ru> (look at ReadMe.txt in folder \harbour) * New: 'Working with windows and one card' sample. Note: this example will require a widescreen monitor 22"+. Contributed by Sergej Kiselev and Verchenko Andrey (see in folder \samples\Advanced\Tsb_5Win) * Updated: 'HMG Grid Demo' sample: - updated for the recent changes in the Minigui core. Contributed by Grigory Filatov <gfilatov@inbox.ru> (see demo.prg in folder \samples\Basic\Grid_Test) * Updated: 'Center Image From Resource' sample. Based upon a contribution of Pierpaolo Martinello (see demo.prg in folder \samples\Basic\IMAGE) * Updated: 'Directory Tree' sample by Vladimir Chumachenko: - fixed handling of the file's name from the Zip archive. Contributed by Grigory Filatov <gfilatov@inbox.ru> (see in folder \samples\Advanced\DirTree) * Updated: 'Framework for SDI application' sample. Contributed by Grigory Filatov <gfilatov@inbox.ru> (see in folder \samples\Advanced\FrameWork) [/pre2] Благодарю за помощь и ваше внимание к этому проекту

SergKis: gfilatov2002 Небольшое предложение по TIMER, выполнять блок кода без смены среды This h_events.prg[pre2] **************************************************************************** CASE WM_TIMER **************************************************************************** i := AScan ( _HMG_aControlIds , wParam ) IF i > 0 IF _HMG_aControlPicture [ i ] == .T. // Once _DisableControl ( _HMG_aControlNames [ i ], GetParentFormName( i ) ) ENDIF IF _HMG_aControlVisible[ i ] _DoControlEventProcedure ( _HMG_aControlProcedures [ i ] , i ) ELSEIF ISBLOCK( _HMG_aControlProcedures[ i ] ) IF _HMG_BeginWindowActive == .F. .OR. _HMG_MainClientMDIHandle != 0 Eval ( _HMG_aControlProcedures[ i ] ) ENDIF ENDIF ENDIF EXIT **************************************************************************** Пример. На окне MAIN ставим TIMER, а работаем с др. окном в его событиях. Срабатывание TIMER на MAIN привод к смене на время This среды, что мешает ... DEFINE WINDOW wMain AT nY, nX WIDTH nW HEIGHT nH ; ... DEFINE TIMER Timer_1 INTERVAL 20 ACTION ( SetProperty(oMain:Name, "Timer_1", "Enabled", .F.), ; myFunc1(), SetProperty(oMain:Name, "Timer_1", "Enabled", .T.) ) This.Timer_1.Enabled := .F. // отключить до On Init _HMG_aControlVisible[ This.Timer_1.Index ] := .F. // выполнять блок кода без смены This среды ... [/pre2]

gfilatov2002: SergKis пишет: выполнять блок кода без смены среды This Принято.

SergKis: gfilatov2002 пишет Принято. Добавить надо для This.Timer_1.Visible := .T.\.F. и Set\GetProperty(..., .T.\.F.) [pre2] FUNCTION _ShowControl ( ControlName , ParentForm ) ... CASE T == "TIMER" OTHERWISE CShowControl ( c ) END CASE _HMG_aControlVisible [y] := .T. RETURN Nil FUNCTION _HideControl ( ControlName , ParentForm ) ... CASE T == "TIMER" OTHERWISE HideWindow ( c ) END CASE _HMG_aControlVisible [y] := .F. RETURN Nil [/pre2]

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

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

Dima: Andrey А сырец то смотрел ? [pre2] #define MG_VERSION "Harbour MiniGUI Extended Edition 21.10.3 (" *-----------------------------------------------------------------------------* FUNCTION MiniGuiVersion( nVer ) *-----------------------------------------------------------------------------* #ifndef __XHARBOUR__ LOCAL cVer := MG_VERSION + hb_ntos( hb_Version( HB_VERSION_BITWIDTH ) ) + "-bit)" #else LOCAL cVer := MG_VERSION + iif( IsExe64(), "64", "32" ) + "-bit)" #endif LOCAL anOfs cVer += " " + HMG_CharsetName() anOfs := { Len( cVer ), 40, 15 } hb_default( @nVer, 0 ) IF nVer > 2 nVer := 2 ELSEIF nVer < 0 nVer := 0 ENDIF RETURN Left( cVer, anOfs[ nVer + 1 ] ) [/pre2]

Andrey: Dima пишет: А сырец то смотрел ? Для чего ? Мне надо в коде версию сравнивать. Допустим новый пример MiniGUI\SAMPLES\Advanced\Tsb_5Win не будет работать в старых версиях МиниГуи. Отсюда будет не заслужанные восклицания, типа автор не отладил примеры. Т.е. примерно так хотелось бы [pre2] cMsg := "ВНИМАНИЕ !;" cMsg += "Для сборки требуется версия МиниГуи 21.11 или выше !;;" IF MiniGuiVersionNumba() < 211100 AlertStop(cMsg,"Checking the MiniGui version") ENDIF Вот сделал пока свою функцию так: FUNCTION MiniGuiVersionNumba() LOCAL cRegEx, cVer, aVal, nVer := 0, cVal := MiniGuiVersion() cRegEx := "\d+\.\d+[\d.]*" aVal := HB_RegEx(cRegEx, cVal) IF LEN(aVal) > 0 cVal := aVal[1] cVer := CHARREM( '.', cVal ) cVer := PADR(cVer,6,'0') nVer := VAL( cVer ) ENDIF RETURN nVer[/pre2] Но каждый раз таскать в примеры свою функцию не очень то и приятно. Хотя она тоже не постоянно требуется.

SergKis: Andrey Чем не нравится Harbour MiniGUI Extended Edition 21.11.0 (32-bit) ANSI не пойму ? 0 - базовая сборка, будет update 1 => 21.11.1

SergKis: Andrey пишет Это так должно быть или опечатка ? Думаю, что ты что то напутал с установками по каталогам или в файле BATCH\minigui.cfg пред. версия выдает Harbour MiniGUI Extended Edition 21.10.3 (32-bit) ANSI

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

Andrey: SergKis пишет: пробую новую версию от сегодня Опять недосмотрел ...

Andrey: gfilatov2002 пишет: Опубликована новая сборка 21.11 Собрал свои проги. Полёт нормальный. Обратите внимание на новый пример MiniGUI\SAMPLES\Advanced\Tsb_5Win

gfilatov2002: Andrey пишет: Полёт нормальный Благодарю за подтверждение

SergKis: Andrey пишет Вот сделал пока свою функцию так: FUNCTION MiniGuiVersionNumba() Можно проще в свой ch (prg) файл добавить[pre2] #xtranslate MiniGuiVersionChar() => Substr( MiniGuiVersion(), At(".", MiniGuiVersion()) - 2, 8 ) #xtranslate MiniGuiVersionNumba() => Int( Val( MiniGuiVersionChar() ) * 10000 + Val( Right(MiniGuiVersionChar(), 2) ) ) [/pre2] использовать ? "ver. =", MiniGuiVersion() ? "v.m. =", MiniGuiVersionChar() ? "numba =", MiniGuiVersionNumba()

Andrey: SergKis пишет: Можно проще в свой ch (prg) файл добавить Отличное решение !

krutoff: Ситуация такая: в ONINIT формы хочу передать фокус конкретному контролу. Если окно MODAL -> все Ok, если CHILD -> то фокус всегда на 1-м контроле. Раскопал: h_windows.prg строка 1536 -> этот блок всегда возвращает взад (на 1-й контрол): IF _SetFocusedSplitChild( i ) == .F. _SetActivationFocus( i ) ENDIF В модальном окне (строка 1513 ....) такого блока нет и поэтому SetFocus в ONINIT отрабатывает. Закоментировал этот блок - и все Ok. Можно ли блок удалить (строка 1536) ?

SergKis: krutoff попробуйте [pre2] SET OOP ON ... DEFINE WINDOW ... TOPMOST ; ON INIT ( This.Topmost := .F., _wPost(0) ) ... (This.Object):Event( 0, {|| This.<контрол>.SetFocus } ) ... [/pre2]

SergKis: gfilatov2002 Как то не закончено с new ф-ями: GetDesktopRealTop() GetDesktopRealLeft() GetDesktopRealWidth() GetDesktopRealHeight() в однобайтной версии hmg нет GetDesktopRealTop(), GetDesktopRealLeft() в unicode версии hmg нет GetDesktopRealTop(), GetDesktopRealLeft(), GetDesktopRealWidth(), GetDesktopRealHeight() Пример unicode https://TransFiles.ru/imyut запуск с параметром Mode : demo.exe 1 demo.exe 2 demo.exe 3 demo.exe Использование новых ф-ий лучше чем Sys.ClientWidth и Sys.ClientHeight

Петр: SergKis пишет: в однобайтной версии hmg нет GetDesktopRealTop(), GetDesktopRealLeft() А так ли они нужны? SergKis пишет: Использование новых ф-ий лучше чем Sys.ClientWidth и Sys.ClientHeight Чем?

gfilatov2002: SergKis пишет: в однобайтной версии hmg нет GetDesktopRealTop(), GetDesktopRealLeft() Уже добавил эти функции с использованием команды #xtranslate в заголовок hmg.ch

SergKis: Петр пишет Чем? Делаем в примере (остальные оставляем как есть)[pre2] FUNCTION wRu866() ... IF App.Cargo:nMode > 0 This.Row := 0 //GetDesktopRealTop() This.Col := 0 //GetDesktopRealLeft() This.Width := Sys.ClientWidth //GetDesktopRealWidth() This.Height := Sys.ClientHeight //GetDesktopRealHeight() //This.Maximize ENDIF ... [/pre2] Запускаем demo.exe 1 У меня win10 pro 14" монитор справа и снизу ~15 pixel отступы, почти в ширину VScrollBar-а Запускаем demo.exe 2 или 3 Со всех сторон есть зазор ~ 2-3 pixel А так ли они нужны? Наверно, так же как GetWindowRow(hwnd), GetWindowCol(hwnd) GetClientRow(hwnd), GetClientCol(hwnd) т.е. при их наличии, если вдруг, TaskBar окажется не внизу, то что то получим в результате

Петр: Поюзайте MiniGUI\SAMPLES\BASIC\Multi_Monitor несколько раз, каждый раз меняя позицию TaskBar. И свой пример попробуйте на системе с несколькими мониторами. SystemParametersInfo( SPI_GETWORKAREA..) работает с PRIMARY дисплеем.

SergKis: gfilatov2002 пишет Уже добавил эти функции Тут тоже надо поправить и добавить [pre2] #translate <p:System,Sys>.ClientRow => #translate <p:System,Sys>.ClientCol => #translate <p:System,Sys>.ClientWidth => ( GetDesktopWidth () - GetBorderWidth () ) #translate <p:System,Sys>.ClientHeight => ( GetDesktopHeight() - GetBorderHeight() - GetTaskBarHeight() ) [/pre2]

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

krutoff: SergKis Спасибо за код, но у меня Define window CHILD ... Define Window ... Virtual PANEL ... EDITBOX И мне надо дать фокус внутри 2-й формы

SergKis: krutoff пишет И мне надо дать фокус внутри 2-й формы И в чем разница ? Контролы на окне имеют уникальные имена. Вопрос, какую среду This надо в блоке кода ? Для среды This окна ON INIT {|| _wPost(10) } Для среды This контрола ON INIT {|| _wPost(10, This.<контрол>.Index) } Суть этих действий, завершить работу обработчика окна on init и организовать через очередь другое событие (обработчик) по _wPost(...), т.е. отработает [pre2] IF _SetFocusedSplitChild( i ) == .F. _SetActivationFocus( i ) ENDIF [/pre2] потом сработает, через очередь, событие\блок кода 10, зарегистрированный на окне

krutoff: SergKis пишет: потом сработает, через очередь, событие\блок кода 10, зарегистрированный на окне Спасибо! Отработало как часы!

Andrey: krutoff Посмотрите доку Сергея Events_in_MiniGui.RU.txt на русском в \MiniGUI\SAMPLES\Advanced\Tsb_5Win Ну и использование событий по тексту программы.

SergKis: gfilatov2002 Небольшая правка [pre2] METHOD DrawHeaders( lFooters, lDrawCell ) CLASS TSBrowse ... IF ::lDrawSpecHd ... nClrFore := ::GetValProp( nClrFore, nClrFore, nJ ) IF nI == nBegin .AND. ::lSelector nClrBacks := ::nClrSpcHdBack ELSE nClrBacks := iif( ::nPhantom == -1, ATail( ::aColumns ):nClrSpcHdBack, nClrPane ) ENDIF nClrBackS := ::GetValProp( nClrBackS, nClrBackS, nJ ) ... [/pre2] Сейчас SpecHeader имеет цвет SELECTOR-а nClrPane по Default, а все остальные цвета ячейки SELECTOR по вертикали ::nClrSpcHdBack (как у Header) PS Если возможно, включите в сборку последнюю версию LetoDbf, клиента и сервер

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

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

SergKis: gfilatov2002 надо[pre2] #translate <p:System,Sys>.ClientWidth => GetDesktopRealWidth () #translate <p:System,Sys>.ClientHeight => GetDesktopRealHeight() [/pre2] так, как сейчас, дает отступы справа, внизу ~15 pixel, в исправленном везде зазор ~2-3 pixel

gfilatov2002: SergKis пишет: надо #translate <p:System,Sys>.ClientWidth => GetDesktopRealWidth () #translate <p:System,Sys>.ClientHeight => GetDesktopRealHeight() Понял, поправлю

SergKis: gfilatov2002 пишет поправлю еще _TBrowse()[pre2] DEFAULT aColor := { ; { CLR_FOCUSB, {|c,n,b| c := n, iif( b:nCell == n, -CLR_HRED, -RGB( 128, 225, 225 ) ) } }, ; [/pre2] получше вид будет PS в примере Tsb_2tsb того же эффекта можно достичь кодом без AEval(...). По умолчанию oCol:lFixLite := .T., oCol:lOnGotFocusSelect := .T., oCol:lEmptyValToChar := .T. [pre2] LOCAL oTsb1, oTsb2 ... nH := Int( This.ClientHeight / 2 ) oTsb1 := oHmgData() oTsb1:aEdit := .T. oBrw1 := _TBrowse( oTsb1, "CUST1", "Brw_1", nY, nX, nW, nH ) //AEval( oBrw1:aColumns, {| oCol | oCol:lFixLite := .T., ; // oCol:lEdit := .T., ; // oCol:lOnGotFocusSelect := .T., ; // oCol:lEmptyValToChar := .T. } ) nY += nH + 1 nH -= 1 oTsb2 := oHmgData() oTsb2:aEdit := .T. oBrw2 := _TBrowse( oTsb2, "CUST2", "Brw_2", nY, nX, nW, nH ) //AEval( oBrw2:aColumns, {| oCol | oCol:lFixLite := .T., ; // oCol:lEdit := .T., ; // oCol:lOnGotFocusSelect := .T., ; // oCol:lEmptyValToChar := .T. } ) oBrw1:SetFocus() [/pre2]

gfilatov2002: SergKis пишет: еще _TBrowse() ... в примере Tsb_2tsb Понял, уже поправил и выложил новый инсталлятор Благодарю за помощь

SergKis: gfilatov2002 лучше так [pre2] STATIC FUNCTION RecordBrowse( oBrw ) LOCAL oCol, ; aArr := {} FOR EACH oCol IN oBrw:aColumns //AAdd( aArr, { oCol:cHeading, Eval( oCol:bData ) } ) AAdd( aArr, { oCol:cHeading, oBrw:GetValue( oCol ) } ) NEXT SBrowse( aArr, "Record View", {|| .T. }, { "Key", "Value" } ) RETURN NIL [/pre2]

gfilatov2002: SergKis пишет: лучше так OK

SergKis: gfilatov2002 Предлагаю правку SBrowse(), что бы можно было управлять тсб и окном + иметь общую ф-ю для работы с записью из тсб, т.е. [pre2] FUNCTION SBrowse( uAlias, cTitle, bSetUp, aCols, nWidth, nHeight, lSql ) // idea from xBrowse LOCAL cFormName, oBrw, nSaveSelect, cDbf, cAlias, lEdit, cTable LOCAL lbSetUp := HB_ISBLOCK( bSetUp ) DEFAULT uAlias := Alias(), ; cTitle := iif( ValType( uAlias ) == "C", uAlias, "SBrowse" ), ; bSetUp := {|| .F. }, ; aCols := {}, ; nWidth := GetSysMetrics( 0 ) * .75, ; nHeight := GetSysMetrics( 1 ) / 2, ; lSql := .F. IF ValType( uAlias ) == 'C' .AND. Select( uAlias ) == 0 nSaveSelect := Select() IF lSql cTable := GetUniqueName( "SqlTable" ) dbUseArea( .T.,, "SELECT * FROM " + uAlias, cTable,,, "UTF8" ) SELECT &cTable cAlias := cTable uAlias := cAlias ELSE cDbf := uAlias cAlias := uAlias TRY dbUseArea( .T., NIL, cDbf, cAlias, .T. ) uAlias := cAlias CATCH uAlias := { { uAlias } } END ENDIF ELSEIF ValType( uAlias ) == 'N' If ! Empty( Alias( uAlias ) ) uAlias := Alias( uAlias ) ELSE uAlias := { { uAlias } } ENDIF ELSEIF ValType( uAlias ) $ 'BDLP' uAlias := { { uAlias } } #ifdef __XHARBOUR__ ELSEIF ValType( uAlias ) == "H" uAlias := aHash2Array( uAlias ) #endif ENDIF cFormName := GetUniqueName( "SBrowse" ) DEFINE WINDOW &cFormName AT 0, 0 WIDTH nWidth HEIGHT nHeight TITLE cTitle CHILD BACKCOLOR RGB( 191, 219, 255 ) nWidth -= 20 nHeight -= 50 DEFINE TBROWSE oBrw AT 10, 10 Alias ( uAlias ) WIDTH nWidth - 16 HEIGHT nHeight - 30 HEADER aCols ; AUTOCOLS SELECTOR 20 lEdit := Eval( bSetUp, oBrw ) lEdit := iif( ValType( lEdit ) == "L", lEdit, .F. ) WITH OBJECT oBrw :nTop := 10 :nLeft := 10 :nBottom := :nTop + nHeight - 30 :nRight := :nLeft + nWidth - 16 :lEditable := lEdit :lCellBrw := lEdit :nClrLine := COLOR_GRID :nClrHeadBack := { CLR_WHITE, COLOR_GRID } :lUpdate := .T. :bRClicked := {|| Record_SBrowse( oBrw ) } IF lEdit AEval( :aColumns, {| o | o:lEdit := .T. } ) ENDIF END WITH END TBROWSE @ nHEIGHT - 12 - iif( _HMG_IsXPorLater, 3, 0 ), 10 BUTTON Btn_1 CAPTION oBrw:aMsg[ 44 ] WIDTH 70 HEIGHT 24 ; ACTION {|| oBrw:Report( cTitle,,,, .T. ), oBrw:GoTop() } @ nHEIGHT - 12 - iif( _HMG_IsXPorLater, 3, 0 ), 90 BUTTON Btn_2 CAPTION "Excel" WIDTH 70 HEIGHT 24 ; ACTION oBrw:ExcelOle() @ nHEIGHT - 12 - iif( _HMG_IsXPorLater, 3, 0 ), nWidth - 76 BUTTON Btn_3 CAPTION oBrw:aMsg[ 45 ] WIDTH 70 HEIGHT 24 ; ACTION ThisWindow.RELEASE If ! lEdit ON KEY ESCAPE ACTION ThisWindow.RELEASE ENDIF IF lbSetUp //!!! Eval( bSetUp, oBrw, .T. ) ENDIF END WINDOW CENTER WINDOW &cFormName ACTIVATE WINDOW &cFormName If ! Empty( cAlias ) ( cAlias )->( dbCloseArea() ) ENDIF If ! Empty( nSaveSelect ) Select( nSaveSelect ) ENDIF RETURN NIL // --------------------------------------------------------------------------------------------------------------------// FUNCTION Record_SBrowse( oBrw, cTitle, bSetUp, aHead, lNoCrLf ) LOCAL oCol, aArr := {}, cHdr DEFAULT cTitle := "Record View", bSetUp := {|| .T. }, aHead := { "Key", "Value" }, lNoCrLf := .T. FOR EACH oCol IN oBrw:aColumns cHdr := oCol:cHeading IF lNoCrLf .and. CRLF $ cHdr cHdr := StrTran( cHdr, CRLF, " " ) ENDIF AAdd( aArr, { cHdr, Eval( oCol:bData ) } ) NEXT SBrowse( aArr, cTitle, bSetUp, aHead ) RETURN NIL [/pre2] Задавая в FUNCTION SBrowse( uAlias, cTitle, bSetUp, aCols, nWidth, nHeight, lSql ) // idea from xBrowse в таком виде bSetUp := {|ob,xp| Local lRet := .T. IF !Empty(xp) // второй вход в блок. Можно менять размеры окна + параметры тсб по переменной ob и This. среды окна ... ENDIF Return lRet } и исп. Record_SBrowse( oBrw, cTitle, bSetUp, aHead ) как самостоятельный вызов к любому тсб. PS Назвать ф-ю можно по традиции FUNCTION _Record_SBrowse( oBrw, cTitle, bSetUp, aHead, lNoCrLf ) или FUNCTION _SBrowse_Record( oBrw, cTitle, bSetUp, aHead, lNoCrLf )

gfilatov2002: SergKis пишет: Предлагаю правку SBrowse() Принято

SergKis: gfilatov2002 пишет Принято Я в тексте небольшую правку сделал, перенес вызов блока 2-ой раз еще ниже (строки //!!!) Пример сейчас делаю. Ф-ю для работы с записью назвал FUNCTION SBrowse_Record( oBrw, cTitle, bSetUp, aHead, lNoCrLf ) как приложение к основной SBrowse(), если надо пере назвать, скажите

SergKis: SergKis пишет Пример сейчас делаю. Пример тут https://TransFiles.ru/jg78m PS Еще вариант вызова в примере [pre2] bSetUp := {|ob,xp| IF !Empty(xp) ob:SetNoHoles() ob:SetFocus() ENDIF Return .T. } sBrowse( Alias(), "DEMO. Test new SBrowse", bSetUp, , Sys.ClientWidth, Sys.ClientHeight ) [/pre2]

SergKis: gfilatov2002 Сделал др. вариант SBrowse, привязал размеры к размеру фонта Пример тут https://TransFiles.ru/7xea7 PS не оч. нравится место (может др. предложите) [pre2] lRec := HB_ISARRAY( uAlias ) .and. Len( uAlias[1] ) == 2 .and. Len( aCols ) == 2 .and. ; aCols[1] == "Key" .and. aCols[2] == "Value" [/pre2] возможно, надо добавить MODAL окно через параметр FUNCTION SBrowse( uAlias, cTitle, bSetUp, aCols, nWidth, nHeight, lSql, lModal ) // idea from xBrowse PS2 Забыл убрать опыт, надо поправить SBrowse [pre2] DEFAULT uAlias := Alias(), ; ... lSql := .F., ; bAfter := {|ob| ob:SetNoHoles(), ob:SetFocus() } ... и FUNCTION SBrowse_Record( oBrw, cTitle, bSetUp, aHead, nWidth, nHeight, lNoCrLf ) ... SBrowse( aArr, "Record View", bSetUp, { "Key", "Value" }, nWidth, nHeight ) ... [/pre2]

PSP: SergKis пишет: Сделал др. вариант SBrowse, привязал размеры к размеру фонта Пример тут https://TransFiles.ru/7xea7 Разрешите встрять) Если в примере нажать кнопку Excel, но экселя нет на компе, появляется окно с ошибкой, после закрытия которого бровс ломается.

SergKis: PSP пишет Если в примере нажать кнопку Excel, но экселя нет на компе, появляется окно с ошибкой, после закрытия которого бровс ломается Еще раз проверил, работает у меня и таблица и запись => все в Excel уходит, но если нет excel, надо в методе тсб добавлять проверку, но это другое , пока эти места идут, как есть.

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