Форум » GUI » Новая версия Расширенного релиза библиотеки MiniGUI (часть VI ) (продолжение) » Ответить
Новая версия Расширенного релиза библиотеки MiniGUI (часть VI ) (продолжение)
gfilatov: Начало темы находится здесь, а теперь АНОНС * АНОНС * АНОНС * АНОНС * АНОНС Готовится к опубликованию новая сборка №48, которая выйдет в конце недели. Если у Вас есть интересные наработки для включения в новый релиз, то сейчас самое удобное время для их отправки мне Кратко, что нового: - исправление обнаруженных ошибок и неточностей кода; - новый класс HEADERIMAGE для Grid и Browse; - свойство Address в Hyperlink может теперь открывать папку или файл на диске; - добавлен NOTABSTOP класс для Browse; - поддержка пользовательских компонентов (заимствована из оффициального релиза); - расширения и исправления в библиотеках TsBrowse и PropGrid; - обновлены сборки Харбор и HMGS-IDE; - новые и обновленные старые примеры (как обычно ).
gfilatov2002: SergKis пишет: надо в ф-ях сделать Поправил, пример отработал после этого нормально. Благодарю за помощь
gfilatov2002: На английском форуме задали вопрос о том, как динамически изменить встроенный комбо при редактировании грида. Написал такую функцию и пример для проверки (см. ниже). [pre2] #include "minigui.ch" /* * PROCEDURE Main * * Defines and activates the main window containing a grid and buttons for demonstration purposes. * * Purpose: * This procedure serves as the entry point for the grid demo application. It creates a main window with a grid control to display and edit data, and two buttons to manipulate the grid's content. * The grid demonstrates features like cell editing, column controls (textbox and combobox), and data justification. The buttons allow for dynamic modification of the combobox items and adding new rows to the grid. * This procedure showcases the capabilities of the HMG Extended grid control and provides a basic example of how to interact with it programmatically. * * Notes: * The Random(4) function used when adding a new item assumes a random number generator is available and seeded appropriately. */ PROCEDURE Main LOCAL nId DEFINE WINDOW m AT 0, 0 WIDTH 600 HEIGHT 400 TITLE 'Grid Demo' MAIN DEFINE GRID g ROW 10 COL 10 WIDTH 472 HEIGHT 200 HEADERS { "Name", "City", "Amount" } WIDTHS { 200, 150, 100 } celled .T. allowedit .T. COLUMNCONTROLS { { 'TEXTBOX', 'CHARACTER' }, { 'COMBOBOX', { 'A', 'B', 'C', 'D' } }, { 'TEXTBOX', 'NUMERIC', "999999.99" } } ITEMS { { "Person 1", 1, 1000 }, { "Person 2", 3, 2000 } } JUSTIFY { 0, 0, 1 } END GRID DEFINE BUTTON b1 ROW 230 COL 10 WIDTH 240 CAPTION "Replace inplaced combobox items" ACTION ReplaceGridEditComboItems( "g", "m", 2, { "FIRST", "SECOND", "THIRD", "FOURTH" } ) END BUTTON DEFINE BUTTON b2 ROW 260 COL 10 WIDTH 240 CAPTION "Add a new item in grid" ACTION ( nId := m.g.ItemCount, m.g.AddItem( { "Person " + hb_ntos( ++nId ), Random( 4 ), nId * 1000 } ) ) END BUTTON ON KEY ESCAPE ACTION thiswindow.release() END WINDOW m.CENTER m.ACTIVATE RETURN /* * FUNCTION ReplaceGridEditComboItems(cGridName, cWindowName, nColIndex, aNewItems) * * Replaces the items in the combobox control of a specific column within a grid. * * Parameters: * cGridName (CHARACTER): The name of the grid control. * cWindowName (CHARACTER): The name of the window containing the grid. * nColIndex (NUMERIC): The index of the column whose combobox items are to be replaced (1-based). * aNewItems (ARRAY): An array containing the new items to be displayed in the combobox. * * Returns: * NIL * * Purpose: * This function allows for the dynamic modification of the combobox items within a grid column. This is useful when the available options in a combobox need to change based on user input or other application logic. * The function retrieves the current cell values of the specified column, updates the combobox items in the internal control data structure, and then resets the cell values to refresh the display. * For example, you might use this function to update the list of available products in a combobox based on the selected category in another combobox. * * Notes: * This function relies on the internal HMG Extended data structures (_HMG_aControlMiscData1) to access and modify the combobox items. Changes to these internal structures in future versions of HMG Extended may break this function. * The function assumes that the specified column actually contains a combobox control. Calling this function on a column with a different control type will likely result in an error. * The cell values are stored in an array aCell to preserve the current selection of each combobox in the column. * The function uses GetControlIndex to find the index of the grid control within the window's control array. This index is then used to access the grid's internal data structures. */ FUNCTION ReplaceGridEditComboItems ( cGridName, cWindowName, nColIndex, aNewItems ) LOCAL i := GetControlIndex ( cGridName, cWindowName ) LOCAL nItemCount := GetProperty( cWindowName, cGridName, "ItemCount" ) LOCAL aCell := {}, ni LOCAL aEditcontrols := _HMG_aControlMiscData1[ i ][ 13 ] // Store the current cell values of the specified column in the aCell array. ni := 0 DO WHILE ni < nItemCount AAdd( aCell, GetProperty( cWindowName, cGridName, "Cell", ++ni, nColIndex ) ) ENDDO // Check if the column contains a combobox control. IF aEditControls[ nColIndex ][ 1 ] == "COMBOBOX" // Replace the combobox items with the new items. aEditControls[ nColIndex ][ 2 ] := aNewItems _HMG_aControlMiscData1[ i ][ 13 ] := aEditControls // Restore the cell values to refresh the display. ni := 0 DO WHILE ni < nItemCount SetProperty( cWindowName, cGridName, "Cell", ++ni, nColIndex, aCell[ ni ] ) ENDDO ENDIF RETURN NIL [/pre2]
SergKis: А не проще, формировать новый массив для комбо и помещать его новый адрес на место старого ? Это один запрос к базе\серверу ... Когда использовал GRID (правда очень давно не пользуюсь) так и делал, записей в комбо не много, как правило
gfilatov2002: SergKis пишет: формировать новый массив для комбо и помещать его новый адрес на место старого Да, именно так и сделано. Возможно, я не совсем понял, что значит помещать новый адрес на место старого.
SergKis: gfilatov2002 пишет Возможно, я не совсем понял, что значит помещать новый адрес на место старого Примерно так aCBox := mySelect(...) _HMG_aControlMiscData1[ i ][ 13 ] := aCBox или _HMG_aControlMiscData1[ i ][ 13 ] := mySelect(...) правда точно не помню назначения в _HMG_aControlMiscData1[ i ] для комбо
gfilatov2002: SergKis пишет: Примерно так Значит, я все понял правильно. Я использовал точно такой же алгоритм, и добавил перерисовку грида с новыми параметрами комбо.
SergKis: gfilatov2002 Пример хороший и сделан правильно, но, по мне, это плохая схема использования комбо в жизни GRID, т.к. item-ы при вводе требуют валидности, да и замена всего массива требует проверки изменения item-ов (они были ?). Комбо в GRID это оч. редко или совсем не меняемые справочники типа {"муж.","жен."}, должности, отделы, ... +, когда комбо ячейка в фокусе, то оч. легко случайно, клавишей, сменить значение в ячейке и мышкой уйти на др. ячейку и не заметить этого. По мне это пример, как не надо работать с комбо
gfilatov2002: SergKis пишет: По мне это пример, как не надо работать с комбо Поддерживаю! SergKis пишет: Комбо в GRID это оч. редко или совсем не меняемые справочники Полностью согласен. P.S. Я просто ответил на вопрос на форуме...
gfilatov2002: Написал такой пример для проверки новой функции HMG_LISTTIMERS(). [pre2] #include "minigui.ch" STATIC nTickCount := 0 // Counter to show timer is working /* * FUNCTION Main() * * Initializes the main application window and defines its controls. * * Purpose: * This is the entry point of the application. It creates the main window, * defines the buttons, labels, and edit box, and sets up their initial * properties and event handlers. The window is then centered and activated. * This function sets up the user interface for testing timer functionality. * * Notes: * The window definition includes buttons to start, stop, and list timers, * a label to display the tick count, and an edit box to display timer information. */ FUNCTION Main() DEFINE WINDOW Form_1 ; AT 0, 0 ; WIDTH 420 HEIGHT 340 ; TITLE "HMG_LISTTIMERS() Function Test" ; MAIN @ 20, 20 BUTTON btnStart ; CAPTION "Start Timer" ; WIDTH 100 HEIGHT 28 ; ACTION StartTimer() @ 20, 140 BUTTON btnStop ; CAPTION "Stop Timer" ; WIDTH 100 HEIGHT 28 ; ACTION StopTimer() @ 60, 20 BUTTON btnList ; CAPTION "List Timers" ; WIDTH 100 HEIGHT 28 ; ACTION ListTimers() @ 100, 20 LABEL lblCounter ; VALUE "Tick Count: 0" ; WIDTH 300 HEIGHT 24 @ 140, 20 EDITBOX edtOutput ; WIDTH 370 HEIGHT 140 ; NOHSCROLL ; READONLY END WINDOW CENTER WINDOW Form_1 ACTIVATE WINDOW Form_1 RETURN NIL /* * PROCEDURE OnTimer() * * Updates the tick count label on the main form. * * Purpose: * This procedure is called by the timer at a regular interval (defined in StartTimer()). * It increments the global tick counter (nTickCount) and updates the value of the * lblCounter label on the main form to display the current tick count. This provides * a visual indication that the timer is running. * * Notes: * The nTickCount variable is a global variable that is incremented each time the timer fires. */ PROCEDURE OnTimer() nTickCount++ Form_1.lblCounter.VALUE := "Tick Count: " + LTrim( Str( nTickCount ) ) RETURN /* * PROCEDURE StartTimer() * * Starts or creates a timer that calls the OnTimer() procedure. * * Purpose: * This procedure is called when the "Start Timer" button is clicked. It checks if a timer * named "Timer_1" already exists on the form. If it does, it enables the timer. If it * doesn't exist, it creates a new timer with an interval of 1000 milliseconds (1 second) * and sets its action to call the OnTimer() procedure. A message box is then displayed * to confirm that the timer has been started. * * Notes: * The IsControlDefined() function is used to check if the timer control already exists. */ PROCEDURE StartTimer() IF IsControlDefined( Timer_1, Form_1 ) Form_1.Timer_1.Enabled := .T. ELSE DEFINE TIMER Timer_1 PARENT Form_1 INTERVAL 1000 ACTION OnTimer() END TIMER ENDIF MsgInfo( "Timer started." ) RETURN /* * PROCEDURE StopTimer() * * Stops the timer if it is running. * * Purpose: * This procedure is called when the "Stop Timer" button is clicked. It retrieves a list of * currently active timers using the HMG_LISTTIMERS() function. If there is exactly one * timer in the list (presumably Timer_1), it disables the timer by setting its Enabled * property to .F.. A message box is then displayed to confirm that the timer has been stopped. * * Notes: * The HMG_LISTTIMERS() function returns an array of active timers. * The Enabled property of the timer control determines whether the timer is running or not. */ PROCEDURE StopTimer() LOCAL aTimers := HMG_LISTTIMERS() IF Len( aTimers ) == 1 Form_1.Timer_1.Enabled := .F. MsgInfo( "Timer stopped." ) ENDIF RETURN /* * FUNCTION ListTimers() * * Displays a list of currently active timers in the edit box on the main form. * * Purpose: * This function is called when the "List Timers" button is clicked. It retrieves a list of * currently active timers using the HMG_LISTTIMERS() function. If there are no active timers, * it displays a message indicating that. Otherwise, it iterates through the list of timers * and formats the timer information (window handle, timer ID, and interval) into a string. * This string is then displayed in the edtOutput edit box on the main form. * * Notes: * The HMG_LISTTIMERS() function returns an array of active timers. Each element in the array * is itself an array containing the timer's window handle, timer ID, and interval. */ FUNCTION ListTimers() LOCAL aTimers := HMG_LISTTIMERS() LOCAL cOutput := "" LOCAL i IF Len( aTimers ) == 0 cOutput := "No active timers." ELSE FOR i := 1 TO Len( aTimers ) cOutput += "Timer #" + LTrim( Str( i ) ) + CRLF cOutput += " hWnd : " + LTrim( Str( aTimers[ i ][ 1 ] ) ) + CRLF cOutput += " Timer ID : " + LTrim( Str( aTimers[ i ][ 2 ] ) ) + CRLF cOutput += " Interval : " + LTrim( Str( aTimers[ i ][ 3 ] ) ) + " ms" + CRLF + CRLF NEXT ENDIF Form_1.edtOutput.VALUE := cOutput RETURN NIL [/pre2] Вопрос: нужен ли такой пример в поставке библиотеки?
Andrey: Да пускай будет !
gfilatov2002: Andrey пишет: пускай будет Спасибо за отклик! Ниже приведена окончательная версия этого примера: [pre2] #include "minigui.ch" STATIC nTickCount := 0 // Counter to show timer is working /* * FUNCTION Main() * * Initializes the main application window and defines its controls. * * Purpose: * This is the entry point of the application. It creates the main window, * defines the buttons, labels, and edit box, and sets up their initial * properties and event handlers. The window is then centered and activated. * This function sets up the user interface for testing timer functionality. * * Notes: * The window definition includes buttons to start, stop, and list timers, * a label to display the tick count, and an edit box to display timer information. */ FUNCTION Main() DEFINE WINDOW Form_1 ; AT 0, 0 ; WIDTH 420 HEIGHT 340 ; TITLE "HMG_LISTTIMERS() Function Test" ; MAIN ; ON RELEASE OnReleaseResources() DEFINE STATUSBAR STATUSITEM "Ready" END STATUSBAR @ 20, 20 BUTTON btnStart ; CAPTION "Start Timer" ; WIDTH 100 HEIGHT 28 ; ACTION StartTimer() @ 20, 140 BUTTON btnStop ; CAPTION "Stop Timer" ; WIDTH 100 HEIGHT 28 ; ACTION StopTimer() @ 60, 20 BUTTON btnList ; CAPTION "List Timers" ; WIDTH 100 HEIGHT 28 ; ACTION ListTimers() @ 60, 140 BUTTON btnReset ; CAPTION "Reset Count" ; WIDTH 100 HEIGHT 28 ; ACTION ResetCounter() @ 100, 20 LABEL lblCounter ; VALUE "Tick Count: 0" ; WIDTH 300 HEIGHT 24 @ 140, 20 EDITBOX edtOutput ; WIDTH 370 HEIGHT 140 ; NOHSCROLL ; READONLY END WINDOW CENTER WINDOW Form_1 ACTIVATE WINDOW Form_1 RETURN NIL /* * FUNCTION OnReleaseResources() * * Releases the timer control when the form is closed. * * Purpose: * This function is called when the main form is closed (ON RELEASE event). * It checks if the Timer_1 control is defined on the form. If it is, it releases * the timer's resources to prevent memory leaks or other issues. * * Notes: * Releasing controls when they are no longer needed is good practice to ensure * efficient resource management. */ FUNCTION OnReleaseResources IF IsControlDefined( Timer_1, Form_1 ) Form_1.Timer_1.RELEASE ENDIF RETURN NIL /* * PROCEDURE OnTimer() * * Updates the tick count label on the main form. * * Purpose: * This procedure is called by the timer at a regular interval (defined in StartTimer()). * It increments the global tick counter (nTickCount) and updates the value of the * lblCounter label on the main form to display the current tick count. This provides * a visual indication that the timer is running. * * Notes: * The nTickCount variable is a global variable that is incremented each time the timer fires. */ PROCEDURE OnTimer() nTickCount++ Form_1.lblCounter.VALUE := "Tick Count: " + LTrim( Str( nTickCount ) ) RETURN /* * PROCEDURE StartTimer() * * Starts or creates a timer that calls the OnTimer() procedure. * * Purpose: * This procedure is called when the "Start Timer" button is clicked. It checks if a timer * named "Timer_1" already exists on the form. If it does, it enables the timer. If it * doesn't exist, it creates a new timer with an interval of 1000 milliseconds (1 second) * and sets its action to call the OnTimer() procedure. The status bar is updated to indicate * that the timer has been started. * * Notes: * The IsControlDefined() function is used to check if the timer control already exists. */ PROCEDURE StartTimer() IF IsControlDefined( Timer_1, Form_1 ) IF Form_1.Timer_1.Enabled Form_1.StatusBar.Item( 1 ) := "Timer already running" RETURN ELSE Form_1.Timer_1.Enabled := .T. ENDIF ELSE DEFINE TIMER Timer_1 PARENT Form_1 INTERVAL 1000 ACTION OnTimer() END TIMER ENDIF Form_1.StatusBar.Item( 1 ) := "Timer started" RETURN /* * PROCEDURE StopTimer() * * Stops the timer if it is running. * * Purpose: * This procedure is called when the "Stop Timer" button is clicked. It disables the timer * by setting its Enabled property to .F.. The status bar is updated to indicate whether * the timer was stopped or if there was no timer running. * * Notes: * The Enabled property of the timer control determines whether the timer is running or not. */ PROCEDURE StopTimer() IF IsControlDefined( Timer_1, Form_1 ) .AND. Form_1.Timer_1.Enabled Form_1.Timer_1.Enabled := .F. Form_1.StatusBar.Item( 1 ) := "Timer stopped" ELSE Form_1.StatusBar.Item( 1 ) := "No timer to stop" ENDIF RETURN /* * FUNCTION ListTimers() * * Displays a list of currently active timers in the edit box on the main form. * * Purpose: * This function is called when the "List Timers" button is clicked. It retrieves a list of * currently active timers using the HMG_LISTTIMERS() function. If there are no active timers, * it displays a message indicating that. Otherwise, it iterates through the list of timers * and formats the timer information (window handle, timer ID, and interval) into a string. * This string is then displayed in the edtOutput edit box on the main form. The status bar * is updated to show the number of timers listed. * * Notes: * The HMG_LISTTIMERS() function returns an array of active timers. Each element in the array * is itself an array containing the timer's window handle, timer ID, and interval. */ FUNCTION ListTimers() LOCAL aTimers := HMG_LISTTIMERS() LOCAL cOutput := "" LOCAL i IF Len( aTimers ) == 0 cOutput := "No active timers." ELSE FOR i := 1 TO Len( aTimers ) cOutput += "Timer #" + LTrim( Str( i ) ) + CRLF cOutput += " hWnd : " + LTrim( Str( aTimers[ i ][ 1 ] ) ) + CRLF cOutput += " Timer ID : " + LTrim( Str( aTimers[ i ][ 2 ] ) ) + CRLF cOutput += " Interval : " + LTrim( Str( aTimers[ i ][ 3 ] ) ) + " ms" + CRLF + CRLF NEXT ENDIF Form_1.edtOutput.VALUE := cOutput Form_1.StatusBar.Item( 1 ) := "Listed " + LTrim( Str( Len( aTimers ) ) ) + " timer(s)" RETURN NIL /* * PROCEDURE ResetCounter() * * Resets the tick counter to zero. * * Purpose: * This procedure is called when the "Reset Count" button is clicked. It resets the global * tick counter (nTickCount) to zero and updates the lblCounter label on the main form to * reflect the reset value. The status bar is also updated to indicate that the counter * has been reset. * * Notes: * The nTickCount variable is a global variable that is incremented by the timer. */ PROCEDURE ResetCounter() nTickCount := 0 Form_1.lblCounter.VALUE := "Tick Count: 0" Form_1.StatusBar.Item( 1 ) := "Counter reset" RETURN [/pre2]
SergKis: gfilatov2002 Чем ф-я aTm := HMG_LISTTIMERS() лучше aTm := HMG_GetFormControls(ThisWindow.Name, "TIMER" ) ? Есть ли в ней имя таймера для пакетной работы типа cForm := ThisWindow.Name FOR EACH cTm IN HMG_GetFormControls(cForm, "TIMER" ) ? cForm, cTm, This.&(cTm).Interval, , This.&(cTm).Enabled ...
gfilatov2002: SergKis пишет: Чем ф-я aTm := HMG_LISTTIMERS() лучше aTm := HMG_GetFormControls(ThisWindow.Name, "TIMER" ) ? Дело не в том, что лучше, а что хуже. Это просто еще одна возможность для работы с таймерами. Кстати, функция HMG_LISTTIMERS() не привязана к конкретному окну (как HMG_GetFormControls(ThisWindow.Name, "TIMER" ) ), а показывает все активные таймеры, которые установлены в данный момент в программе.
SergKis: gfilatov2002 пишет показывает все активные таймеры т.е. Enabled == .T. , а Enabled == .F. нет ? функция HMG_LISTTIMERS() не привязана к конкретному окну
gfilatov2002: SergKis пишет: т.е. Enabled == .T. , а Enabled == .F. - нет Именно так
SergKis: gfilatov2002 пишет Именно так Это мало что дает, т.е. снимок не отражает картину, особенно, если таймеры короткие (100 - 300 мс) и они на время работы блока кода ставятся Enable := .F. и потом .T. (все таймеры исп. этот механизм) Что то определить по таким данным ф-ии сложно. Возможно, надо, что бы ф-я возвращала все таймера назначенные в программе с их тек. соостоянием Enable ?
gfilatov2002: SergKis пишет: Что то определить по таким данным ф-ии сложно. Так как основное использование этой функции - для отладки кода, то можно временно убрать Enable := .F. в режиме отладки. Но это уже вопросы конкретной реализации работы таймеров...
SergKis: gfilatov2002 пишет временно убрать Enable := .F. в режиме отладки Зачем такая канитель, тем более, что это для отладки (ставить Enable := .T. надо для каждого таймера, его блока кода) ? Проще получать весь список "TIMER" и иметь в массиве элемент Enabled для анализа, возможно, имя таймера и имя окна (дополнительно к handle) PS Такой массив можно использовать и для управления таймерами (включать\выключать их работу), а не только для отладки
gfilatov2002: Выложил первое обновление для сборки 25.07 Update 1 Что нового: - исправление обнаруженных ошибок; - добавлены две новые функции (на уровне Си-кода) для проверки наличия секций и ключей в ини-файлах: IsINISectionExists( cSection, cIniFile ) -> .T. / .F. IsINIKeyExists( cSection, cKey, cIniFile ) -> .T. / .F. - добавлены комментарии в код библиотеки и некоторых примеров.
SergKis: gfilatov2002 Положил на ftp пример работы _TBrowse(...) с отборами\выборками из базы
gfilatov2002: SergKis Спасибо, посмотрю, конечно. P.S. Пример очень лаконичный и насыщенный. Вот его краткое описание, сгенерированное ИИ: [pre2] /* * Demonstrates the use of two TBrowse objects to display data from two related DBF files. * * Purpose: * This function creates a main window containing two TBrowse objects. Each TBrowse displays data from a different DBF file ("CUSTOMER2" accessed via aliases CUST1 and CUST2). * The TBrowse objects are related through a relation set up between the DBF files. * The function demonstrates how to use the _TBrowse() function to manage multiple TBrowse objects within a single window and how to switch focus between them using the TAB key. * It also shows how to handle the ESCAPE key to exit edit mode or close the window. * The function uses temporary DBF files created in memory to filter the data displayed in each TBrowse (one showing records where RecNo() % 2 != 0, the other where RecNo() % 2 == 0). * * Notes: * The function relies on the Sets_TSB() function to configure the TBrowse objects. * The CUSTOMER2.DBF file must exist in the same directory as the executable. * The temporary DBF files are deleted when the window is closed. */ [/pre2]
Andrey: gfilatov2002 пишет: Вот его краткое описание, сгенерированное ИИ: Это надо поставить в начале примера ! Иначе непонятно что это за пример...
SergKis: gfilatov2002 Добавил в пример более широкую информацию в Title окна и SuperHeader тсб (просьба Андрея), + почистил код немного Положил на ftp PS Для понимания о чем речь (кому интересно), пример demo8.prg тут [pre2] /* * MINIGUI - Harbour Win32 GUI library Demo * */ #define _HMG_OUTLOG #include "hmg.ch" #include "tsbrowse.ch" #include "dbinfo.ch" REQUEST DBFCDX FUNCTION Main() LOCAL cForm := "wMain" LOCAL nY, nX, nH, nW LOCAL oTsb1, oTsb2, aFile := {}, cFile, aAls := {} LOCAL cAls1 := "CUST_1" , cAls2 := "CUST_2" LOCAL cDbf := "CUSTOMER2", cID := "CUSTNO" LOCAL cSel1 := "RecNo() %2 != 0" LOCAL cSel2 := "RecNo() %2 == 0" LOCAL cTitl := " Select, Relation and Edit. " + MiniGuiVersion() Sets_TSB() // App.Cargo:oTsb create cFile := App.Cargo:cPathDbf + cDbf USE ( cFile ) ALIAS ( cAls1 ) NEW SHARED INDEX ON &cID TAG ID SET ORDER TO 1 GO TOP AAdd( aFile, Select2Mem(cSel1, cID) ) AAdd( aAls , StrTran(cAls1, "_", "") ) GO TOP USE ( cFile ) ALIAS ( cAls2 ) NEW SHARED SET ORDER TO 1 GO TOP AAdd( aFile, Select2Mem(cSel2, cID) ) AAdd( aAls , StrTran(cAls2, "_", "") ) GO TOP USE ( aFile[1] ) ALIAS ( aAls[1] ) NEW //SHARED SET RELATION TO ROWID INTO &cAls1 GO TOP USE ( aFile[2] ) ALIAS ( aAls[2] ) NEW //SHARED SET RELATION TO ROWID INTO &cAls2 GO TOP DEFINE WINDOW &cForm TITLE "Demo 2 TBrowse." + cTitl ; MAIN NOSIZE TOPMOST ; ON INIT ( This.Topmost := .F., _wPost(0) ) ; ON RELEASE ( This.Hide, _wSend(90) ) This.Cargo := oHmgData() This.Maximize This.Cargo:aFile := aFile nY := nX := 0 nW := This.ClientWidth nH := Int( This.ClientHeight / 2 ) oTsb1 := App.Cargo:oTsb:Clone() oTsb1:cBrw := "Brw_1" oTsb1:uAlias := aAls[1] oTsb1:cAlsFld := cAls1 // relation oTsb1:cAlsKey := NIL //"CUSTNO" // field relation oTsb1:lAlsEdit := !Empty(oTsb1:cAlsKey) // lock edit oTsb1:aSelFld := NIL // FieldNames relation, array oTsb1:nY := nY oTsb1:nX := nX oTsb1:nW := nW oTsb1:nH := nH oTsb1:lSuperHd := .T. oTsb1:cSuperHd := oTsb1:cBrw + "." + oTsb1:uAlias + " -> " + ; Lower((oTsb1:uAlias)->( dbInfo( DBI_FULLPATH ) )) + ; space(3) + "SELECT: " + cSel1 + space(3) + ; "RELATION: TO ROWID INTO " +oTsb1:cAlsFld + ; space(3) + "EDIT: " oTsb1:cSuperHd += iif( oTsb1:lAlsEdit, "TRUE", "FALSE" ) oTsb1:aSuperHdColor := {CLR_YELLOW, CLR_HBLUE} nY += nH nH -= 1 oTsb2 := App.Cargo:oTsb:Clone() oTsb2:cBrw := "Brw_2" oTsb2:uAlias := aAls[2] oTsb2:cAlsFld := cAls2 // relation oTsb2:cAlsKey := cID // field relation oTsb2:lAlsEdit := !Empty(oTsb2:cAlsKey) // lock edit oTsb2:aSelFld := NIL // FieldNames relation, array oTsb2:lZebra := .F. oTsb2:lChess := .T. oTsb2:nY := nY oTsb2:nH := nH oTsb2:lSuperHd := .T. oTsb2:cSuperHd := oTsb2:cBrw + "." + oTsb2:uAlias + " -> " + ; Lower((oTsb2:uAlias)->( dbInfo( DBI_FULLPATH ) )) + ; space(3) + "SELECT: " + cSel2 + space(3) + ; "RELATION: TO ROWID INTO " +oTsb2:cAlsFld + ; space(3) + "EDIT: " oTsb2:cSuperHd += iif( oTsb2:lAlsEdit, "TRUE", "FALSE" ) oTsb2:aSuperHdColor := {CLR_HBLUE, CLR_YELLOW} This.Cargo:aBrw := _TBrowse({ oTsb1, oTsb2 }) This.Cargo:nBrw := 1 This.Cargo:aBrw[ This.Cargo:nBrw ]:SetFocus() ON KEY F1 ACTION NIL ON KEY TAB ACTION {|| Local ab := ThisWindow.Cargo:aBrw, ob Local nb := ThisWindow.Cargo:nBrw + 1 nb := iif( nb > Len(ab), 1, nb ) ob := ab[ nb ] ob:SetFocus() Return Nil } ON KEY ESCAPE ACTION {|| Local ab := ThisWindow.Cargo:aBrw, ob Local nb := ThisWindow.Cargo:nBrw ob := ab[ nb ] IF ob:IsEdit ; ob:SetFocus() ELSE ; _wSend(99) ENDIF Return Nil } WITH OBJECT This.Object :Event( 0, {|ow| AEval(ow:Cargo:aBrw, {|ob| ob:Show() }), DoEvents() }) :Event(90, {|ow| dbCloseAll() hb_FileDelete("*.cdx") AEval(ow:Cargo:aFile, {|cf| dbDrop(cf, cf, "DBFCDX") }) FErase("mem") //!!! Return Nil }) :Event(99, {|ow| ow:Release() }) END WITH END WINDOW ACTIVATE WINDOW &cForm RETURN NIL STATIC FUNCTION Select2Mem(bMode, cFld) LOCAL nOld := Select() LOCAL aRecs := {}, cAls := Alias() LOCAL cFile := "mem:" + cAls, nFld, aRec, nRec Default cFld := "CUSTNO" IF IsChar( bMode ) ; bMode := &("{|| "+bMode + " }") ENDIF DO EVENTS nFld := FieldPos(cFld) GO TOP DO WHILE !EOF() DO EVENTS nRec := iif( EVal( bMode ), RecNo(), 0 ) IF nRec > 0 AAdd(aRecs, { FieldGet(nFld), Deleted() }) ENDIF SKIP ENDDO GO TOP DO EVENTS dbDrop(cFile, cFile, "DBFCDX") dbCreate( cFile, {{"ROWID", "N", 10, 0}}, "DBFCDX", .T., cAls + "_" ) FOR EACH aRec IN aRecs dbAppend() FieldPut(1, aRec[1]) IF ! Empty( aRec[2] ) ; dbDelete() ENDIF NEXT dbGoTop() dbCloseArea() dbSelectArea(nOld) DO EVENTS RETURN cFile STATIC FUNCTION Sets_TSB( oTsb ) LOCAL oac := App.Cargo Default oac:oTsb := oTsb ; Default oac:oTsb := oHmgData() oac:oTsb:aEdit := .F. oac:oTsb:aFoot := .T. oac:oTsb:lZebra := .T. oac:oTsb:aNumber := { 1, App.Object:W(0.5) } oac:oTsb:uSelector := 20 oac:oTsb:bInit := {|ob,op| Local cn := op:cAlsKey, lEdit, oc ob:Hide() lEdit := !Empty(op:lAlsEdit) ob:LoadFields(lEdit, op:aSelFld, op:cAlsFld) IF !Empty(cn) .and. ob:nColumn(cn, .T.) > 0 ob:DelColumn(cn) ENDIF IF lEdit ; ob:lRecLockArea := lEdit ENDIF Return Nil } oac:oTsb:bAfter := {|ob| Local oc := ob:aColumns[1] oc:nClrBack := {|na,nc,obr| Local ocol := obr:aColumns[nc] Local nclr := ocol:nClrHeadBack IF (obr:cAlias)->( Deleted() ) nclr := CLR_HGRAY na := nc ENDIF Return nclr } Return Nil } oac:oTsb:bGotFocus := {|ob| Local owc IF IsObject(ob) SET WINDOW THIS TO ob:cParentWnd owc := This.Cargo owc:nBrw := ob:Cargo:nBrw SET WINDOW THIS TO ENDIF Return Nil } oac:oTsb:nHeightCell := App.Object:H(1.2) oac:oTsb:nHeightHead := App.Object:H(1.2) oTsb := oac:oTsb RETURN oTsb *----------------------------------------------------------------------------* INIT PROCEDURE Sets_ENV() *----------------------------------------------------------------------------* LOCAL cFont := "Arial", nSize := 12, oac rddSetDefault( "DBFCDX" ) SET DECIMALS TO 4 SET EPOCH TO 2000 SET DATE TO GERMAN SET CENTURY ON SET DELETED OFF SET AUTOPEN ON SET EXACT ON SET EXCLUSIVE ON SET SOFTSEEK ON SET OOP ON SET TOOLTIPSTYLE BALLOON SET MULTIPLE QUIT WARNING SET WINDOW MAIN OFF SET NAVIGATION EXTENDED SET WINDOW MODAL PARENT HANDLE ON //SET DEFAULT ICON TO "1MG" SET ShowRedAlert ON App.Cargo := oHmgData() ; oac := App.Cargo oac:lLogDel := .T. oac:cLogFile := hb_FNameExtSet( App.ExeName, ".log" ) oac:cPathDbf := ".\" oac:nMenuBmpH := 24 SET FONT TO cFont, nSize _DefineFont("Normal" , cFont, nSize , .F., .F. ) _DefineFont("Bold" , cFont, nSize , .T., .F. ) _DefineFont("Italic" , cFont, nSize-4, .F., .T. ) // Alert* font _DefineFont("DlgFont" , cFont, nSize+2, .F., .F. ) _SetGetLogFile( oac:cLogFile ) IF oac:lLogDel ; hb_FileDelete( oac:cLogFile ) ENDIF SET MENUSTYLE EXTENDED SetMenuBitmapHeight( oac:nMenuBmpH ) // RETURN [/pre2]
gfilatov2002: SergKis пишет: Положил на ftp Большое спасибо! Andrey пишет: Это надо поставить в начале примера Добавил комментарии в код (см. ниже) [pre2] /* * MINIGUI - Harbour Win32 GUI library Demo * */ #define _HMG_OUTLOG #include "hmg.ch" #include "tsbrowse.ch" #include "dbinfo.ch" REQUEST DBFCDX /* * FUNCTION Main() * * Demonstrates the use of two TBrowse objects to display data from two related DBF files. * * Purpose: * This function creates a main window containing two TBrowse objects. Each TBrowse displays data from a different DBF file ("CUSTOMER2" accessed via aliases CUST1 and CUST2). * The TBrowse objects are related through a relation set up between the DBF files. * The function demonstrates how to use the _TBrowse() function to manage multiple TBrowse objects within a single window and how to switch focus between them using the TAB key. * It also shows how to handle the ESCAPE key to exit edit mode or close the window. * The function uses temporary DBF files created in memory to filter the data displayed in each TBrowse (one showing records where RecNo() % 2 != 0, the other where RecNo() % 2 == 0). * * Notes: * The function relies on the Sets_TSB() function to configure the TBrowse objects. * The CUSTOMER2.DBF file must exist in the same directory as the executable. * The temporary DBF files are deleted when the window is closed. */ FUNCTION Main() LOCAL cForm := "wMain" LOCAL nY, nX, nH, nW LOCAL oTsb1, oTsb2, aFile := {}, cFile, aAls := {} LOCAL cAls1 := "CUST_1" , cAls2 := "CUST_2" LOCAL cDbf := "CUSTOMER2", cID := "CUSTNO" LOCAL cSel1 := "RecNo() %2 != 0" LOCAL cSel2 := "RecNo() %2 == 0" LOCAL cTitl := " Select, Relation and Edit. " + MiniGuiVersion() Sets_TSB() // App.Cargo:oTsb create cFile := App.Cargo:cPathDbf + cDbf USE ( cFile ) ALIAS ( cAls1 ) NEW SHARED INDEX ON &cID TAG ID SET ORDER TO 1 GO TOP AAdd( aFile, Select2Mem(cSel1, cID) ) AAdd( aAls , StrTran(cAls1, "_", "") ) GO TOP USE ( cFile ) ALIAS ( cAls2 ) NEW SHARED SET ORDER TO 1 GO TOP AAdd( aFile, Select2Mem(cSel2, cID) ) AAdd( aAls , StrTran(cAls2, "_", "") ) GO TOP USE ( aFile[1] ) ALIAS ( aAls[1] ) NEW SHARED SET RELATION TO ROWID INTO &cAls1 GO TOP USE ( aFile[2] ) ALIAS ( aAls[2] ) NEW SHARED SET RELATION TO ROWID INTO &cAls2 GO TOP DEFINE WINDOW &cForm TITLE "Demo 2 TBrowse." + cTitl ; MAIN NOSIZE TOPMOST ; ON INIT ( This.Topmost := .F., _wPost(0) ) ; ON RELEASE ( This.Hide, _wSend(90) ) This.Cargo := oHmgData() This.Maximize This.Cargo:aFile := aFile nY := nX := 0 nW := This.ClientWidth nH := Int( This.ClientHeight / 2 ) oTsb1 := App.Cargo:oTsb:Clone() oTsb1:cBrw := "Brw_1" oTsb1:uAlias := aAls[1] oTsb1:cAlsFld := cAls1 // relation oTsb1:cAlsKey := NIL //"CUSTNO" // field relation oTsb1:lAlsEdit := !Empty(oTsb1:cAlsKey) // lock edit oTsb1:aSelFld := NIL // FieldNames relation, array oTsb1:nY := nY oTsb1:nX := nX oTsb1:nW := nW oTsb1:nH := nH oTsb1:lSuperHd := .T. oTsb1:cSuperHd := oTsb1:cBrw + "." + oTsb1:uAlias + " -> " + ; Lower((oTsb1:uAlias)->( dbInfo( DBI_FULLPATH ) )) + ; space(3) + "SELECT: " + cSel1 + space(3) + ; "RELATION: TO ROWID INTO " +oTsb1:cAlsFld + ; space(3) + "EDIT: " oTsb1:cSuperHd += iif( oTsb1:lAlsEdit, "TRUE", "FALSE" ) oTsb1:aSuperHdColor := {CLR_YELLOW, CLR_HBLUE} nY += nH nH -= 1 oTsb2 := App.Cargo:oTsb:Clone() oTsb2:cBrw := "Brw_2" oTsb2:uAlias := aAls[2] oTsb2:cAlsFld := cAls2 // relation oTsb2:cAlsKey := cID // field relation oTsb2:lAlsEdit := !Empty(oTsb2:cAlsKey) // lock edit oTsb2:aSelFld := NIL // FieldNames relation, array oTsb2:lZebra := .F. oTsb2:lChess := .T. oTsb2:nY := nY oTsb2:nH := nH oTsb2:lSuperHd := .T. oTsb2:cSuperHd := oTsb2:cBrw + "." + oTsb2:uAlias + " -> " + ; Lower((oTsb2:uAlias)->( dbInfo( DBI_FULLPATH ) )) + ; space(3) + "SELECT: " + cSel2 + space(3) + ; "RELATION: TO ROWID INTO " +oTsb2:cAlsFld + ; space(3) + "EDIT: " oTsb2:cSuperHd += iif( oTsb2:lAlsEdit, "TRUE", "FALSE" ) oTsb2:aSuperHdColor := {CLR_HBLUE, CLR_YELLOW} This.Cargo:aBrw := _TBrowse({ oTsb1, oTsb2 }) This.Cargo:nBrw := 1 This.Cargo:aBrw[ This.Cargo:nBrw ]:SetFocus() ON KEY F1 ACTION NIL ON KEY TAB ACTION {|| Local ab := ThisWindow.Cargo:aBrw, ob Local nb := ThisWindow.Cargo:nBrw + 1 nb := iif( nb > Len(ab), 1, nb ) ob := ab[ nb ] ob:SetFocus() Return Nil } ON KEY ESCAPE ACTION {|| Local ab := ThisWindow.Cargo:aBrw, ob Local nb := ThisWindow.Cargo:nBrw ob := ab[ nb ] IF ob:IsEdit ; ob:SetFocus() ELSE ; _wSend(99) ENDIF Return Nil } WITH OBJECT This.Object :Event( 0, {|ow| AEval(ow:Cargo:aBrw, {|ob| ob:Show() }), DoEvents() }) :Event(90, {|ow| dbCloseAll() hb_FileDelete("*.cdx") AEval(ow:Cargo:aFile, {|cf| dbDrop(cf, cf, "DBFCDX") }) FErase("mem") Return Nil }) :Event(99, {|ow| ow:Release() }) END WITH END WINDOW ACTIVATE WINDOW &cForm RETURN NIL /* * STATIC FUNCTION Select2Mem(lMode, cFld) * * Creates a temporary in-memory DBF file containing records from the current work area based on a filter condition. * * Parameters: * lMode (LOGICAL): If .T., selects records where RecNo() % 2 == 0. If .F., selects records where RecNo() % 2 != 0. * cFld (CHARACTER, optional): The field to copy to the new DBF. Defaults to "CUSTNO". * * Returns: * CHARACTER: The alias of the newly created in-memory DBF file (e.g., "mem:ALIAS"). * * Purpose: * This function is used to create temporary DBF files in memory that contain a subset of the data from an existing DBF file. * This allows for filtering and displaying specific records in TBrowse objects without modifying the original DBF file. * The function iterates through the records in the current work area, applies the filter condition based on lMode, and copies the specified field (cFld) and deletion status to the new in-memory DBF. * The new DBF file is created with a single field named "ROWID" of type Numeric. * * Notes: * The function uses the dbDrop() function to delete any existing DBF file with the same alias before creating the new one. * The function uses dbCreate() to create the new in-memory DBF file. * The function uses dbAppend() and FieldPut() to add records to the new DBF file. * The function uses dbDelete() to mark records as deleted in the new DBF file if they were deleted in the original DBF file. * The function restores the original work area after creating the new DBF file. */ STATIC FUNCTION Select2Mem(bMode, cFld) LOCAL nOld := Select() LOCAL aRecs := {}, cAls := Alias() LOCAL cFile := "mem:" + cAls, nFld, aRec, nRec Default cFld := "CUSTNO" IF IsChar( bMode ) ; bMode := &("{|| "+bMode + " }") ENDIF DO EVENTS nFld := FieldPos(cFld) GO TOP DO WHILE !EOF() DO EVENTS nRec := iif( EVal( bMode ), RecNo(), 0 ) IF nRec > 0 AAdd(aRecs, { FieldGet(nFld), Deleted() }) ENDIF SKIP ENDDO GO TOP DO EVENTS dbDrop(cFile, cFile, "DBFCDX") dbCreate( cFile, {{"ROWID", "N", 10, 0}}, "DBFCDX", .T., cAls + "_" ) FOR EACH aRec IN aRecs dbAppend() FieldPut(1, aRec[1]) IF ! Empty( aRec[2] ) ; dbDelete() ENDIF NEXT dbGoTop() dbCloseArea() dbSelectArea(nOld) DO EVENTS RETURN cFile /* * STATIC FUNCTION Sets_TSB( oTsb ) * * Configures default settings for TBrowse objects used in the application. * * Parameters: * oTsb (OBJECT, optional): An existing TBrowse object to configure. If NIL, a new oHmgData() object is created. * * Returns: * OBJECT: The configured TBrowse object (either the passed object or the newly created one). * * Purpose: * This function centralizes the configuration of common TBrowse settings, promoting code reuse and consistency. * It sets properties such as zebra striping, column numbering, and event handlers for initialization, after-browse operations, and focus changes. * The function also defines closures (code blocks) for customizing the appearance and behavior of the TBrowse objects. * This allows for dynamic modification of the TBrowse based on the data being displayed. * * Notes: * The function uses the App.Cargo object to store the TBrowse settings. * The bInit closure is responsible for loading the fields into the TBrowse and handling column customization. * The bAfter closure is responsible for customizing the appearance of the TBrowse after it has been loaded. * The bGotFocus closure is responsible for setting the focus to the TBrowse object and updating the window title. */ STATIC FUNCTION Sets_TSB( oTsb ) LOCAL oac := App.Cargo Default oac:oTsb := oTsb, oac:oTsb := oHmgData() oac:oTsb:aEdit := .F. oac:oTsb:aFoot := .T. oac:oTsb:lZebra := .T. oac:oTsb:aNumber := { 1, App.Object:W(0.5) } oac:oTsb:uSelector := 20 oac:oTsb:bInit := {|ob,op| Local cn := op:cAlsKey, lEdit, oc ob:Hide() lEdit := !Empty(op:lAlsEdit) ob:LoadFields(lEdit, op:aSelFld, op:cAlsFld) IF !Empty(cn) .and. ob:nColumn(cn, .T.) > 0 ob:DelColumn(cn) ENDIF IF lEdit ; ob:lRecLockArea := lEdit ENDIF Return Nil } oac:oTsb:bAfter := {|ob| Local oc := ob:aColumns[1] oc:nClrBack := {|na,nc,obr| Local ocol := obr:aColumns[nc] Local nclr := ocol:nClrHeadBack IF (obr:cAlias)->( Deleted() ) nclr := CLR_HGRAY na := nc ENDIF Return nclr } Return Nil } oac:oTsb:bGotFocus := {|ob| Local owc IF IsObject(ob) SET WINDOW THIS TO ob:cParentWnd owc := This.Cargo owc:nBrw := ob:Cargo:nBrw SET WINDOW THIS TO ENDIF Return Nil } oac:oTsb:nHeightCell := App.Object:H(1.2) oac:oTsb:nHeightHead := App.Object:H(1.2) oTsb := oac:oTsb RETURN oTsb /* * INIT PROCEDURE Sets_ENV() * * Initializes the application environment, setting various system parameters and defining fonts. * * Purpose: * This procedure sets up the Harbour MiniGUI Extended Edition (HMG Extended) environment for the application. * It configures the default RDD (Replaceable Database Driver), date and time formats, display settings, and other system parameters. * It also defines custom fonts for use throughout the application, ensuring a consistent look and feel. * The procedure also sets up logging functionality, creating a log file to record application events and errors. * * Notes: * The procedure uses the rddSetDefault() function to set the default RDD to DBFCDX. * The procedure uses the SET command to configure various system parameters. * The procedure uses the _DefineFont() function to define custom fonts. * The procedure uses the _SetGetLogFile() function to set the log file. * The procedure uses the hb_FileDelete() function to delete the log file if it already exists. */ INIT PROCEDURE Sets_ENV() LOCAL cFont := "Arial", nSize := 12, oac rddSetDefault( "DBFCDX" ) SET DECIMALS TO 4 SET EPOCH TO 2000 SET DATE TO GERMAN SET CENTURY ON SET DELETED OFF SET AUTOPEN ON SET EXACT ON SET EXCLUSIVE ON SET SOFTSEEK ON SET OOP ON SET TOOLTIPSTYLE BALLOON SET MULTIPLE QUIT WARNING SET NAVIGATION EXTENDED SET WINDOW MODAL PARENT HANDLE ON SET ShowRedAlert ON App.Cargo := oHmgData() ; oac := App.Cargo oac:lLogDel := .T. oac:cLogFile := hb_FNameExtSet( App.ExeName, ".log" ) oac:cPathDbf := ".\" SET FONT TO cFont, nSize _DefineFont("Normal" , cFont, nSize , .F., .F. ) _DefineFont("Bold" , cFont, nSize , .T., .F. ) _DefineFont("Italic" , cFont, nSize-4, .F., .T. ) // Alert* font _DefineFont("DlgFont" , cFont, nSize+2, .F., .F. ) _SetGetLogFile( oac:cLogFile ) IF oac:lLogDel ; hb_FileDelete( oac:cLogFile ) ENDIF RETURN [/pre2]
SergKis: gfilatov2002 пишет [pre2] * STATIC FUNCTION Select2Mem(lMode, cFld) * * Creates a temporary in-memory DBF file containing records from the current work area based on a filter condition. * * Parameters: * lMode (LOGICAL): If .T., selects records where RecNo() % 2 == 0. If .F., selects records where RecNo() % 2 != 0. ...[/pre2] Это место я поменял для индикации и более гибкого отбора на [pre2] STATIC FUNCTION Select2Mem(bMode, cFld) LOCAL nOld := Select() LOCAL aRecs := {}, cAls := Alias() LOCAL cFile := "mem:" + cAls, nFld, aRec, nRec Default cFld := "CUSTNO" IF IsChar( bMode ) ; bMode := &("{|| "+bMode + " }") ENDIF DO EVENTS nFld := FieldPos(cFld) GO TOP DO WHILE !EOF() DO EVENTS nRec := iif( EVal( bMode ), RecNo(), 0 ) IF nRec > 0 AAdd(aRecs, { FieldGet(nFld), Deleted() }) ENDIF SKIP ENDDO ...[/pre2] т.е. можно задавать, например, в Main LOCAL cSel1 := "'BOX' $ upper(ADDR1)" //"RecNo() %2 != 0" LOCAL cSel2 := ... получим отбор из других, заданных условий PS Можно задавать поля для колонок тсб, переменные oTsb1:aSelFld := NIL // FieldNames relation, array oTsb2:aSelFld := NIL // FieldNames relation, array например oTsb1:aSelFld := {"COUNTRY", "STATE", "CITY", "COMPANY", "ADDR1"} oTsb2:aSelFld := {"COUNTRY", "STATE", "CITY", "COMPANY", "ADDR1"}
gfilatov2002: SergKis пишет: Это место я поменял Поправил описание функции следующим образом: [pre2] /* * STATIC FUNCTION Select2Mem(bMode, cFld) * * Creates a temporary in-memory DBF file containing records from the current work area based on a filter condition. * * Parameters: * bMode (BLOCK): A code block (closure) that defines the filter condition. It should evaluate to .T. for records to be included in the temporary DBF. * cFld (CHARACTER, optional): The field to copy to the new DBF. Defaults to "CUSTNO". * * Returns: * CHARACTER: The alias of the newly created in-memory DBF file (e.g., "mem:ALIAS"). * * Purpose: * This function is used to create temporary DBF files in memory that contain a subset of the data from an existing DBF file. * This allows for filtering and displaying specific records in TBrowse objects without modifying the original DBF file. * The function iterates through the records in the current work area, applies the filter condition defined by the bMode code block, and copies the specified field (cFld) and deletion status to the new in-memory DBF. * The new DBF file is created with a single field named "ROWID" of type Numeric. * This function is crucial for creating dynamic views of data based on specific criteria. * * Notes: * The function uses the dbDrop() function to delete any existing DBF file with the same alias before creating the new one. * The function uses dbCreate() to create the new in-memory DBF file. * The function uses dbAppend() and FieldPut() to add records to the new DBF file. * The function uses dbDelete() to mark records as deleted in the new DBF file if they were deleted in the original DBF file. * The function restores the original work area after creating the new DBF file. * The bMode parameter *must* be a valid code block that can be evaluated in the context of the current work area. */ [/pre2]
SergKis: gfilatov2002 Положил на ftp пример аналог demo8, но работа тсб без индексов и set relation. Кому интересно demo9.prg тут [pre2] /* * MINIGUI - Harbour Win32 GUI library Demo * */ #define _HMG_OUTLOG #include "hmg.ch" #include "tsbrowse.ch" #include "dbinfo.ch" REQUEST DBFCDX FUNCTION Main() LOCAL cForm := "wMain" LOCAL nY, nX, nH, nW LOCAL oTsb1, oTsb2, aFile := {}, cFile, aAls := {} LOCAL cAls1 := "CUST_1" , cAls2 := "CUST_2" LOCAL cDbf := "CUSTOMER2", cID := "CUSTNO" LOCAL cSel1 := "RecNo() %2 != 0" LOCAL cSel2 := "RecNo() %2 == 0" LOCAL cTitl := " Select, NO Relation and Edit. " + MiniGuiVersion() Sets_TSB() // App.Cargo:oTsb create cFile := App.Cargo:cPathDbf + cDbf USE ( cFile ) ALIAS ( cAls1 ) NEW SHARED AAdd( aFile, Select2Mem(cSel1, cID) ) AAdd( aAls , StrTran(cAls1, "_", "") ) GO TOP USE ( cFile ) ALIAS ( cAls2 ) NEW SHARED AAdd( aFile, Select2Mem(cSel2, cID) ) AAdd( aAls , StrTran(cAls2, "_", "") ) GO TOP USE ( aFile[1] ) ALIAS ( aAls[1] ) NEW GO TOP USE ( aFile[2] ) ALIAS ( aAls[2] ) NEW GO TOP DEFINE WINDOW &cForm TITLE "Demo 2 TBrowse." + cTitl ; MAIN NOSIZE TOPMOST ; ON INIT ( This.Topmost := .F., _wPost(0) ) ; ON RELEASE ( This.Hide, _wSend(90) ) This.Cargo := oHmgData() This.Maximize This.Cargo:aFile := aFile nY := nX := 0 nW := This.ClientWidth nH := Int( This.ClientHeight / 2 ) oTsb1 := App.Cargo:oTsb:Clone() oTsb1:cBrw := "Brw_1" oTsb1:uAlias := aAls[1] oTsb1:cAlsFld := cAls1 // relation oTsb1:cAlsKey := NIL //"CUSTNO" // field relation oTsb1:lAlsEdit := !Empty(oTsb1:cAlsKey) // lock edit //oTsb1:aSelFld := NIL // FieldNames relation, array oTsb1:aSelFld := {"COUNTRY", "STATE", "CITY", "COMPANY", "ADDR1"} oTsb1:nY := nY oTsb1:nX := nX oTsb1:nW := nW oTsb1:nH := nH oTsb1:lSuperHd := .T. oTsb1:cSuperHd := oTsb1:cBrw + "." + oTsb1:uAlias + " -> " + ; Lower((oTsb1:uAlias)->( dbInfo( DBI_FULLPATH ) )) + ; space(3) + "SELECT: " + cSel1 + space(3) + ; "RELATION: TO ROWNR INTO " +oTsb1:cAlsFld + ; space(3) + "EDIT: " oTsb1:cSuperHd += iif( oTsb1:lAlsEdit, "TRUE", "FALSE" ) oTsb1:aSuperHdColor := {CLR_YELLOW, CLR_HBLUE} nY += nH nH -= 1 oTsb2 := App.Cargo:oTsb:Clone() oTsb2:cBrw := "Brw_2" oTsb2:uAlias := aAls[2] oTsb2:cAlsFld := cAls2 // relation oTsb2:cAlsKey := cID // field relation oTsb2:lAlsEdit := !Empty(oTsb2:cAlsKey) // lock edit oTsb2:aSelFld := NIL // FieldNames relation, array oTsb2:lZebra := .F. oTsb2:lChess := .T. oTsb2:nY := nY oTsb2:nH := nH oTsb2:lSuperHd := .T. oTsb2:cSuperHd := oTsb2:cBrw + "." + oTsb2:uAlias + " -> " + ; Lower((oTsb2:uAlias)->( dbInfo( DBI_FULLPATH ) )) + ; space(3) + "SELECT: " + cSel2 + space(3) + ; "RELATION: TO ROWNR INTO " +oTsb2:cAlsFld + ; space(3) + "EDIT: " oTsb2:cSuperHd += iif( oTsb2:lAlsEdit, "TRUE", "FALSE" ) oTsb2:aSuperHdColor := {CLR_HBLUE, CLR_YELLOW} This.Cargo:aBrw := _TBrowse({ oTsb1, oTsb2 }) This.Cargo:nBrw := 1 This.Cargo:aBrw[ This.Cargo:nBrw ]:SetFocus() ON KEY F1 ACTION NIL ON KEY TAB ACTION {|| Local ab := ThisWindow.Cargo:aBrw, ob Local nb := ThisWindow.Cargo:nBrw + 1 nb := iif( nb > Len(ab), 1, nb ) ob := ab[ nb ] ob:SetFocus() Return Nil } ON KEY ESCAPE ACTION {|| Local ab := ThisWindow.Cargo:aBrw, ob Local nb := ThisWindow.Cargo:nBrw ob := ab[ nb ] IF ob:IsEdit ; ob:SetFocus() ELSE ; _wSend(99) ENDIF Return Nil } WITH OBJECT This.Object :Event( 0, {|ow| AEval(ow:Cargo:aBrw, {|ob| ob:Show() }), DoEvents() }) :Event(90, {|ow| dbCloseAll() AEval(ow:Cargo:aFile, {|cf| dbDrop(cf, cf, "DBFCDX") }) FErase("mem") Return Nil }) :Event(99, {|ow| ow:Release() }) END WITH END WINDOW ACTIVATE WINDOW &cForm RETURN NIL STATIC FUNCTION Select2Mem(bMode, cFld) LOCAL nOld := Select() LOCAL aRecs := {}, cAls := Alias() LOCAL cFile := "mem:" + cAls, nFld, aRec, nRec Default cFld := "CUSTNO" IF IsChar( bMode ) ; bMode := &("{|| "+bMode + " }") ENDIF DO EVENTS nFld := FieldPos(cFld) GO TOP DO WHILE !EOF() DO EVENTS nRec := iif( EVal( bMode ), RecNo(), 0 ) IF nRec > 0 AAdd(aRecs, { RecNo(), Deleted() }) ENDIF SKIP ENDDO GO TOP DO EVENTS dbDrop(cFile, cFile, "DBFCDX") dbCreate( cFile, {{"ROWNR", "N", 10, 0}}, "DBFCDX", .T., cAls + "_" ) FOR EACH aRec IN aRecs dbAppend() FieldPut(1, aRec[1]) IF ! Empty( aRec[2] ) ; dbDelete() ENDIF NEXT dbGoTop() dbCloseArea() dbSelectArea(nOld) DO EVENTS RETURN cFile STATIC FUNCTION Sets_TSB( oTsb ) LOCAL oac := App.Cargo Default oac:oTsb := oTsb ; Default oac:oTsb := oHmgData() oac:oTsb:aEdit := .F. oac:oTsb:aFoot := .T. oac:oTsb:lZebra := .T. oac:oTsb:aNumber := { 1, App.Object:W(0.5) } oac:oTsb:uSelector := 20 oac:oTsb:bInit := {|ob,op| Local cn := op:cAlsKey, lEdit, oc ob:Hide() lEdit := !Empty(op:lAlsEdit) ob:LoadFields(lEdit, op:aSelFld, op:cAlsFld) IF lEdit ; ob:lRecLockArea := lEdit ENDIF ob:bOnDrawLine := {|obr| Local cAls := obr:Cargo:oParam:cAlsFld (cAls)->( dbGoTo((obr:cAlias)->ROWNR) ) Return Nil } Return Nil } oac:oTsb:bAfter := {|ob| Local oc := ob:aColumns[1] oc:nClrBack := {|na,nc,obr| Local ocol := obr:aColumns[nc] Local nclr := ocol:nClrHeadBack IF (obr:cAlias)->( Deleted() ) nclr := CLR_HGRAY na := nc ENDIF Return nclr } Return Nil } oac:oTsb:bGotFocus := {|ob| Local owc IF IsObject(ob) SET WINDOW THIS TO ob:cParentWnd owc := This.Cargo owc:nBrw := ob:Cargo:nBrw SET WINDOW THIS TO ENDIF Return Nil } oac:oTsb:nHeightCell := App.Object:H(1.2) oac:oTsb:nHeightHead := App.Object:H(1.2) oTsb := oac:oTsb RETURN oTsb *----------------------------------------------------------------------------* INIT PROCEDURE Sets_ENV() *----------------------------------------------------------------------------* LOCAL cFont := "Arial", nSize := 12, oac rddSetDefault( "DBFCDX" ) SET DECIMALS TO 4 SET EPOCH TO 2000 SET DATE TO GERMAN SET CENTURY ON SET DELETED OFF SET AUTOPEN OFF SET EXACT ON SET EXCLUSIVE ON SET SOFTSEEK ON SET OOP ON SET TOOLTIPSTYLE BALLOON SET MULTIPLE QUIT WARNING SET WINDOW MAIN OFF SET NAVIGATION EXTENDED SET WINDOW MODAL PARENT HANDLE ON //SET DEFAULT ICON TO "1MG" SET ShowRedAlert ON App.Cargo := oHmgData() ; oac := App.Cargo oac:lLogDel := .T. oac:cLogFile := hb_FNameExtSet( App.ExeName, ".log" ) oac:cPathDbf := ".\" oac:nMenuBmpH := 24 SET FONT TO cFont, nSize _DefineFont("Normal" , cFont, nSize , .F., .F. ) _DefineFont("Bold" , cFont, nSize , .T., .F. ) _DefineFont("Italic" , cFont, nSize-4, .F., .T. ) // Alert* font _DefineFont("DlgFont" , cFont, nSize+2, .F., .F. ) _SetGetLogFile( oac:cLogFile ) IF oac:lLogDel ; hb_FileDelete( oac:cLogFile ) ENDIF SET MENUSTYLE EXTENDED SetMenuBitmapHeight( oac:nMenuBmpH ) // RETURN [/pre2]
gfilatov2002: SergKis пишет: Положил на ftp пример Большое спасибо, обязательно посмотрю...
gfilatov2002: SergKis Еще раз благодарю за новый пример. Ниже - его прокомментированная версия: [pre2] /* * MINIGUI - Harbour Win32 GUI library Demo * */ #define _HMG_OUTLOG #include "hmg.ch" #include "tsbrowse.ch" #include "dbinfo.ch" REQUEST DBFCDX /* * FUNCTION Main() * * Demonstrates the use of TBrowse controls with data selection, relation, and editing capabilities. * * Purpose: * This function demonstrates the use of two TBrowse controls to display and interact with data from a DBF file. * It performs the following steps: * 1. Sets up the TBrowse environment using Sets_TSB(). * 2. Opens two instances of the "CUSTOMER2" DBF file with different aliases and selection criteria. * 3. Creates two memory tables based on the selection criteria. * 4. Defines a main window with two TBrowse controls, each displaying data from one of the memory tables. * 5. Configures the TBrowse controls with specific properties, including aliases, relation fields, and editability. * 6. Sets up key bindings for navigation and exiting the application. * 7. Activates the main window, making it visible to the user. * * Notes: * - The "CUSTOMER2" DBF file is assumed to exist in the application's directory. * - The Sets_TSB() function is responsible for initializing the TBrowse environment and setting default properties. * - The Select2Mem() function creates a memory table based on a selection criteria. * - The application uses the App.Cargo object to store application-wide data, such as the TBrowse objects and file paths. */ FUNCTION Main() LOCAL cForm := "wMain" LOCAL nY, nX, nH, nW LOCAL oTsb1, oTsb2, aFile := {}, cFile, aAls := {} LOCAL cAls1 := "CUST_1" , cAls2 := "CUST_2" LOCAL cDbf := "CUSTOMER2", cID := "CUSTNO" LOCAL cSel1 := "RecNo() %2 != 0" LOCAL cSel2 := "RecNo() %2 == 0" LOCAL cTitl := " Select, Relation and Edit. " + MiniGuiVersion() Sets_TSB() // App.Cargo:oTsb create cFile := App.Cargo:cPathDbf + cDbf USE ( cFile ) ALIAS ( cAls1 ) NEW SHARED AAdd( aFile, Select2Mem(cSel1, cID) ) AAdd( aAls , StrTran(cAls1, "_", "") ) GO TOP USE ( cFile ) ALIAS ( cAls2 ) NEW SHARED AAdd( aFile, Select2Mem(cSel2, cID) ) AAdd( aAls , StrTran(cAls2, "_", "") ) GO TOP USE ( aFile[1] ) ALIAS ( aAls[1] ) NEW GO TOP USE ( aFile[2] ) ALIAS ( aAls[2] ) NEW GO TOP DEFINE WINDOW &cForm TITLE "Demo 2 TBrowse." + cTitl ; MAIN NOSIZE TOPMOST ; ON INIT ( This.Topmost := .F., _wPost(0) ) ; ON RELEASE ( This.Hide, _wSend(90) ) This.Cargo := oHmgData() This.Maximize This.Cargo:aFile := aFile nY := nX := 0 nW := This.ClientWidth nH := Int( This.ClientHeight / 2 ) oTsb1 := App.Cargo:oTsb:Clone() oTsb1:cBrw := "Brw_1" oTsb1:uAlias := aAls[1] oTsb1:cAlsFld := cAls1 // relation oTsb1:cAlsKey := NIL // field relation oTsb1:lAlsEdit := !Empty(oTsb1:cAlsKey) // lock edit //oTsb1:aSelFld := NIL // FieldNames relation, array oTsb1:aSelFld := {"COUNTRY", "STATE", "CITY", "COMPANY", "ADDR1"} oTsb1:nY := nY oTsb1:nX := nX oTsb1:nW := nW oTsb1:nH := nH oTsb1:lSuperHd := .T. oTsb1:cSuperHd := oTsb1:cBrw + "." + oTsb1:uAlias + " -> " + ; Lower((oTsb1:uAlias)->( dbInfo( DBI_FULLPATH ) )) + ; space(3) + "SELECT: " + cSel1 + space(3) + ; "RELATION: TO ROWID INTO " +oTsb1:cAlsFld + ; space(3) + "EDIT: " oTsb1:cSuperHd += iif( oTsb1:lAlsEdit, "TRUE", "FALSE" ) oTsb1:aSuperHdColor := {CLR_YELLOW, CLR_HBLUE} nY += nH nH -= 1 oTsb2 := App.Cargo:oTsb:Clone() oTsb2:cBrw := "Brw_2" oTsb2:uAlias := aAls[2] oTsb2:cAlsFld := cAls2 // relation oTsb2:cAlsKey := cID // field relation oTsb2:lAlsEdit := !Empty(oTsb2:cAlsKey) // lock edit oTsb2:aSelFld := NIL // FieldNames relation, array oTsb2:lZebra := .F. oTsb2:lChess := .T. oTsb2:nY := nY oTsb2:nH := nH oTsb2:lSuperHd := .T. oTsb2:cSuperHd := oTsb2:cBrw + "." + oTsb2:uAlias + " -> " + ; Lower((oTsb2:uAlias)->( dbInfo( DBI_FULLPATH ) )) + ; space(3) + "SELECT: " + cSel2 + space(3) + ; "RELATION: TO ROWID INTO " +oTsb2:cAlsFld + ; space(3) + "EDIT: " oTsb2:cSuperHd += iif( oTsb2:lAlsEdit, "TRUE", "FALSE" ) oTsb2:aSuperHdColor := {CLR_HBLUE, CLR_YELLOW} This.Cargo:aBrw := _TBrowse({ oTsb1, oTsb2 }) This.Cargo:nBrw := 1 This.Cargo:aBrw[ This.Cargo:nBrw ]:SetFocus() ON KEY F1 ACTION NIL ON KEY TAB ACTION {|| Local ab := ThisWindow.Cargo:aBrw, ob Local nb := ThisWindow.Cargo:nBrw + 1 nb := iif( nb > Len(ab), 1, nb ) ob := ab[ nb ] ob:SetFocus() Return Nil } ON KEY ESCAPE ACTION {|| Local ab := ThisWindow.Cargo:aBrw, ob Local nb := ThisWindow.Cargo:nBrw ob := ab[ nb ] IF ob:IsEdit ; ob:SetFocus() ELSE ; _wSend(99) ENDIF Return Nil } WITH OBJECT This.Object :Event( 0, {|ow| AEval(ow:Cargo:aBrw, {|ob| ob:Show() }), DoEvents() }) :Event(90, {|ow| dbCloseAll() AEval(ow:Cargo:aFile, {|cf| dbDrop(cf, cf, "DBFCDX") }) FErase("mem") Return Nil }) :Event(99, {|ow| ow:Release() }) END WITH END WINDOW ACTIVATE WINDOW &cForm RETURN NIL /* * STATIC FUNCTION Select2Mem(bMode, cFld) * * Creates a memory table containing records selected from the current database based on a given condition. * * Parameters: * bMode (BLOCK or CHARACTER): A code block or character expression that defines the selection criteria. * If a code block, it should evaluate to .T. for records to be included. * If a character expression, it is converted to a code block. * cFld (CHARACTER, optional): The name of the field to be used as the ROWID in the memory table. Defaults to "CUSTNO". * * Returns: * CHARACTER: The alias of the newly created memory table. * * Purpose: * This function is used to create a temporary memory table containing a subset of records from a DBF file, * based on a specified selection criteria. This allows for filtering and manipulating data without directly * modifying the original DBF file. The memory table includes a "ROWNR" field that stores the original record number * from the DBF file, enabling a relation between the memory table and the original DBF. * * Notes: * - The function uses dbCreate() to create the memory table, which is automatically opened. * - The function uses dbAppend() and FieldPut() to add records to the memory table. * - The function uses dbDelete() to mark records as deleted in the memory table if they were deleted in the original DBF. * - The function uses dbDrop() to delete the memory table if it already exists. * - The function uses dbCloseArea() to close the memory table after it has been created. * - The function uses dbSelectArea() to restore the original selected work area. */ STATIC FUNCTION Select2Mem(bMode, cFld) LOCAL nOld := Select() LOCAL aRecs := {}, cAls := Alias() LOCAL cFile := "mem:" + cAls, nFld, aRec, nRec Default cFld := "CUSTNO" IF IsChar( bMode ) ; bMode := &("{|| "+bMode + " }") ENDIF DO EVENTS nFld := FieldPos(cFld) GO TOP DO WHILE !EOF() DO EVENTS nRec := iif( EVal( bMode ), RecNo(), 0 ) IF nRec > 0 AAdd(aRecs, { RecNo(), Deleted() }) ENDIF SKIP ENDDO GO TOP DO EVENTS dbDrop(cFile, cFile, "DBFCDX") dbCreate( cFile, {{"ROWNR", "N", 10, 0}}, "DBFCDX", .T., cAls + "_" ) FOR EACH aRec IN aRecs dbAppend() FieldPut(1, aRec[1]) IF ! Empty( aRec[2] ) ; dbDelete() ENDIF NEXT dbGoTop() dbCloseArea() dbSelectArea(nOld) DO EVENTS RETURN cFile /* * STATIC FUNCTION Sets_TSB( oTsb ) * * Configures the default settings and event handlers for TBrowse objects used in the application. * * Parameters: * oTsb (OBJECT, optional): An existing TBrowse object to configure. If not provided, a new oHmgData() object is created. * * Returns: * OBJECT: The configured TBrowse object (either the provided object or the newly created one). * * Purpose: * This function centralizes the configuration of TBrowse objects, ensuring consistency across the application. * It sets default properties such as editability, footer visibility, zebra striping, and column numbering. * It also defines event handlers for initialization, drawing lines, and gaining focus. * This function promotes code reusability and simplifies the creation of TBrowse controls. * * Notes: * - The function uses the App.Cargo object to store application-wide data, such as the default TBrowse settings. * - The bInit codeblock is executed when the TBrowse object is initialized. It loads the fields to be displayed and sets up the record locking area. * - The bOnDrawLine codeblock is executed when a line is drawn in the TBrowse object. It positions the cursor in the related DBF file. * - The bAfter codeblock is executed after the TBrowse object is displayed. It sets the background color of deleted records. * - The bGotFocus codeblock is executed when the TBrowse object gains focus. It sets the active window and updates the application's current TBrowse object. */ STATIC FUNCTION Sets_TSB( oTsb ) LOCAL oac := App.Cargo DEFAULT oac:oTsb := oTsb, oac:oTsb := oHmgData() oac:oTsb:aEdit := .F. oac:oTsb:aFoot := .T. oac:oTsb:lZebra := .T. oac:oTsb:aNumber := { 1, App.Object:W(0.5) } oac:oTsb:uSelector := 20 oac:oTsb:bInit := {|ob,op| Local cn := op:cAlsKey, lEdit, oc ob:Hide() lEdit := !Empty(op:lAlsEdit) ob:LoadFields(lEdit, op:aSelFld, op:cAlsFld) IF lEdit ; ob:lRecLockArea := lEdit ENDIF ob:bOnDrawLine := {|obr| Local cAls := obr:Cargo:oParam:cAlsFld (cAls)->( dbGoTo((obr:cAlias)->ROWNR) ) Return Nil } Return Nil } oac:oTsb:bAfter := {|ob| Local oc := ob:aColumns[1] oc:nClrBack := {|na,nc,obr| Local ocol := obr:aColumns[nc] Local nclr := ocol:nClrHeadBack IF (obr:cAlias)->( Deleted() ) nclr := CLR_HGRAY na := nc ENDIF Return nclr } Return Nil } oac:oTsb:bGotFocus := {|ob| Local owc IF IsObject(ob) SET WINDOW THIS TO ob:cParentWnd owc := This.Cargo owc:nBrw := ob:Cargo:nBrw SET WINDOW THIS TO ENDIF Return Nil } oac:oTsb:nHeightCell := App.Object:H(1.2) oac:oTsb:nHeightHead := App.Object:H(1.2) oTsb := oac:oTsb RETURN oTsb /* * INIT PROCEDURE Sets_ENV() * * Initializes the application environment, setting various system settings and defining fonts. * * Purpose: * This procedure sets up the application's environment by configuring various system settings, * such as the default RDD, date format, decimal precision, and font settings. It also defines * application-specific settings, such as the log file path and whether to delete the log file on startup. * This ensures that the application runs consistently across different systems and configurations. * * Notes: * - The procedure sets the default RDD to DBFCDX, which is a common RDD for DBF files. * - The procedure sets the date format to German. * - The procedure sets various other system settings, such as SET DELETED OFF, SET EXACT ON, and SET SOFTSEEK ON. * - The procedure defines three fonts: "Normal", "Bold", and "Italic". * - The procedure creates an oHmgData() object and stores it in App.Cargo for application-wide data storage. * - The procedure sets the log file path and whether to delete the log file on startup. */ INIT PROCEDURE Sets_ENV() LOCAL cFont := "Arial", nSize := 12, oac rddSetDefault( "DBFCDX" ) SET DECIMALS TO 4 SET EPOCH TO 2000 SET DATE TO GERMAN SET CENTURY ON SET DELETED OFF SET AUTOPEN OFF SET EXACT ON SET EXCLUSIVE ON SET SOFTSEEK ON SET OOP ON SET TOOLTIPSTYLE BALLOON SET MULTIPLE QUIT WARNING SET NAVIGATION EXTENDED SET WINDOW MODAL PARENT HANDLE ON SET ShowRedAlert ON App.Cargo := oHmgData() ; oac := App.Cargo oac:lLogDel := .T. oac:cLogFile := hb_FNameExtSet( App.ExeName, ".log" ) oac:cPathDbf := ".\" SET FONT TO cFont, nSize _DefineFont("Normal" , cFont, nSize , .F., .F. ) _DefineFont("Bold" , cFont, nSize , .T., .F. ) _DefineFont("Italic" , cFont, nSize-4, .F., .T. ) // Alert* font _DefineFont("DlgFont" , cFont, nSize+2, .F., .F. ) _SetGetLogFile( oac:cLogFile ) IF oac:lLogDel ; hb_FileDelete( oac:cLogFile ) ENDIF RETURN [/pre2]
Softlog86: Доброго дня всем форумчанам . Давно не писал на Clipper/Harbour , а вот теперь снова понадобилось кой чего автоматизировать ... Подскажите , где сейчас находятся дистрибутивы Hаrbour и MiniGui ? Хочу установить всё для работы на новом компьютере .
Dima: Softlog86 пишет: Подскажите , где сейчас находятся дистрибутивы Hаrbour и MiniGui ? Хочу установить всё для работы на новом компьютере . http://hmgextended.com/download.html
gfilatov2002: Завершена подготовка новой сборки 25.08, которая будет опубликована на следующей неделе. Кратко, что нового: [pre2] Enhancements * Added support for CenterAlign and RightAlign properties in StatusBar items without requiring color attributes. (Requested by Ivanil Marcelino) * Improved _Alert() function now correctly handles the AlwaysOnTop parameter. * HMG_PressKey() now displays an “Invalid parameter” message for better error handling. * Registry function RegCreateKey() replaced with the recommended RegCreateKeyEx() WinAPI call. --- Library and Core Updates * Refactored network functions for improved performance and maintainability: NetRecLock(), NetFileLock(), NetAppend(), NetDelete(), and NetRecall() * Internal modules improved for: * PDF management * Help file handling * Hotkey configuration * StatusBar keyboard shortcuts * Windows Registry access * DBF/Array conversions (HMG_DbfToArray(), HMG_ArrayToDbf()) * Updated libraries: * HbSQLite3 now uses SQLite version 3.50.3 * HbVpdf library now includes full function documentation * Shell32 source refactored * SQLRDD library updated (Pro version) * Harbour Compiler 3.2.0dev (SVN 2025-07-19 19:44) integrated (Pro version) --- New Samples * Custom Progress Bar using OOP Location: \samples\Basic\MyProgressbar * Registry Wrapper Test Location: \samples\Basic\REGISTRY_4 * Two memory tables based on selection criteria Location: \samples\Advanced\Tsb_2tsb (demo8.prg and demo9.prg) --- Updated Samples with Detailed Comments The following samples have been updated with comprehensive inline documentation: * DATA_BOUND * Grid_8 * AlertBoxes * HotKeyBox * HotKeys * FastFind * REPORT_GENERATOR * EZ_Lines (Pro version) * HMG_Tetris (Pro version) * MineSweeper (Pro version) * Sudoku (Pro version) [/pre2]
gfilatov2002: Выложил новую сборку 25.08 Стандартная версия click here ПРО-версия (архив под паролем) click here Желаю всем хорошего дня!
gfilatov2002: Обновил HMGS-IDE 1.4.4.8 по адресу: http://www.hmgextended.com/files/HMGS-IDE/ide.zip Что нового: *Fixed : Incorrect double save of Tree control in TAB after modifying the form. Bug reported by Varga Zsolt Желаю всем хороших выходных.
krutoff: Григорий, спасибо за новую версию! Перешел с версии 25.05 и обратил внимание, что картинки в меню поменяли фон. У меня в моих менюшках фон стал и белый и малиновый и черный.. Посмотреть пример - miniGui\SAMPLES\BASIC\MENU_Picture:
gfilatov2002: krutoff пишет: картинки в меню поменяли фон Благодарю за сообщение! Вернул прежний вид картинок в меню: Исправление будет включено в следующую сборку.
Andrey: Версия МиниГуи 25.06Pro MsgDebug() портит текущий АЛИАС базы !!! [pre2] ? ProcNL(), ALIAS() // вернет "User2Log" MsgDebug("меню фильтра - { cStr, cFilter, cSort }", ALIAS() ) ? ProcNL(), ALIAS() // вернет "" [/pre2] Оказывается и AlertInfo() тоже портит текущий АЛИАС базы !!! [pre2] ? ProcNL(), ALIAS(), INDEXORD() AlertInfo("TEST !" ) ? ProcNL(), ALIAS(), INDEXORD() Вернёт: >>> MYTSBFILTER(941) => user2tsb.prg USER2LOG 3 >>> MYTSBFILTER(944) => user2tsb.prg '' 0 [/pre2] И MsgInfo("Test " + ALIAS() + " " + HB_NtoS(INDEXORD())) - аналогично портит алиас
Andrey: Выяснил, что при запуске программы эти функции не портят алиас, но потом при открытии базы (стандартное открытие и создание индексов), начинается чехарда с этим алиасом, после вывода на экран - теряется алиас. Где и что происходит - не понимаю ?
gfilatov2002: Выложил новую сборку 25.09 Смотрите список изменений этой версии в файле doc\changelog.txt Стандартная версия click here ПРО-версия (архив под паролем) click here Желаю всем хорошего дня!
Andrey: Обратите внимание на пример - SAMPLES\Advanced\Tsb_array_report Проба одного расчёта разными методами. [pre2]Отчёт по базе 2 млн. записей (1404 Мб. на диске HDD) считается за: SCOPE - время счёта 00:00:10.711 (10 секунд) - потрясающая скорость DoWhile -> Array - время счёта 00:00:57.393 - это тоже отличная скорость SCOPE + FILTER - время счёта 00:02:02.459 Условная индексация - время счёта 01:08:17.608[/pre2]
SergKis: gfilatov2002 Может вместо STATIC PROCEDURE AddIfUnique( aList, cName ) сделать (полезная ф-я)[pre2] *-----------------------------------------------------------------------------* FUNCTION HMG_AddIfUnique( aList, cName ) *-----------------------------------------------------------------------------* IF ! Empty( cName ) .AND. AScan( aList, cName, , , .T. ) == 0 AAdd( aList, cName ) RETURN .T. ENDIF RETURN .F. [/pre2]
gfilatov2002: SergKis пишет: Может вместо STATIC PROCEDURE AddIfUnique( aList, cName ) сделать Да, конечно. Благодарю за предложение
SergKis: и еще добавить в h_dbf_aux *-----------------------------------------------------------------------------* FUNCTION HMG_ConvertType( uVal, cTypeDst ) *-----------------------------------------------------------------------------* RETURN ConvertType( uVal, cTypeDst )
SergKis: gfilatov2002 На ftp положил предложение, комментарий в demo.prg
SergKis: gfilatov2002 Можно сделать в ф-ях: SetProperty( Arg1 , ... ) GetProperty( Arg1 , ... ) DoMethod ( Arg1 , ... ) Default Arg1 := _HMG_ThisFormName Для использования в блоках кода, получаемых b := &("{|| ... }"), т.к. имя тек. формы не известно - получается динамически от FormName := HMG_GetUniqueName("..."), например
gfilatov2002: SergKis пишет: Default Arg1 := _HMG_ThisFormName Думаю, это можно записать таким образом: IF ! Empty( _HMG_ThisFormName ) Default Arg1 := _HMG_ThisFormName ENDIF Благодарю за предложение
SergKis: gfilatov2002 пишет IF ! Empty( _HMG_ThisFormName ) Это не имеет смысла, т.к. пишем SetProperty(, ...), т.е. будет прерывание при Empty( _HMG_ThisFormName ) и не заданном Arg1, надо использовать SET WINDOW THIS TO ... до исп. SetProperty(, ...). использование в оконных событиях и при _wPost(...), _wSend(...) событиях все будет ok!
gfilatov2002: SergKis пишет: Это не имеет смысла Понял, спасибо за разъяснение.
SergKis: gfilatov2002 Внес изменения в hmg 25.09 (ранее на ftp давал, сейчас свежие), положил на ftp, MDI пока не трогал В demo.prg варианты использования. Default Arg1 := _HMG_ThisFormName сделал
SergKis: gfilatov2002 Положил расширенный вариант примера на ftp
gfilatov2002: SergKis пишет: Положил расширенный вариант примера OK
SergKis: gfilatov2002 Предложение добавить [pre2] SetProperty( Arg1 , ... ) ... Default Arg1 := _HMG_ThisFormName IF PCount() > 3 Default Arg2 := _HMG_ThisControlName ENDIF ... GetProperty( Arg1 , ... ) DoMethod ( Arg1 , ... ) ... Default Arg1 := _HMG_ThisFormName IF PCount() > 2 Default Arg2 := _HMG_ThisControlName ENDIF ... для вариантов ... ON MOUSEHOVER {|| SetProperty(,, 'Backcolor', GetProperty(,, 'Cargo', aBtnBClr2)) , SetProperty(,, 'Fontcolor', GetProperty(,, 'Cargo', aBtnFClr2)) } ; ON MOUSELEAVE {|| SetProperty(,, 'Backcolor', GetProperty(,, 'Cargo', aBClr)), SetProperty(,, 'Fontcolor', GetProperty(,, 'Cargo', aFClr) } ; ... [/pre2]
gfilatov2002: SergKis пишет: Предложение добавить Принято. Благодарю за помощь
Andrey: Andrey пишет: Версия МиниГуи 25.06Pro MsgDebug() портит текущий АЛИАС базы !!! Разобрался с такой ошибкой ! Если в ТСБ назначить клавиши F3, F4, ... на не существующие события на окне, то происходит такая фигня. Лечится только перепроверкой своего кода.
SergKis: gfilatov2002 Положил на ftp вариант и для MDI с примерами
SergKis: gfilatov2002 Предложение отключать VerifyControlDefined(), возникающая ошибка, достаточно, понятна и без доп. контроля[pre2] STATIC s_lVerifyControl := .T. ... FUNCTION GetProperty ( Arg1 , Arg2 , Arg3 , Arg4 , Arg5 , Arg6 , Arg7 , Arg8 ) ... LOCAL cHeader, nAlignHeader, cFooter, nAlingFooter, nState IF IsLogical( Arg1 ) ; RETURN s_lVerifyControl ENDIF Default Arg1 := _HMG_ThisFormName ... PROCEDURE SetProperty( Arg1 , Arg2 , Arg3 , Arg4 , Arg5 , Arg6 , Arg7 , Arg8 ) ... LOCAL cMacro, cProc #endif IF IsLogical( Arg1 ) ; s_lVerifyControl := Arg1 ; RETURN ENDIF Default Arg1 := _HMG_ThisFormName ... STATIC PROCEDURE VerifyControlDefined ( cParentName , cControlName ) *-----------------------------------------------------------------------------* IF s_lVerifyControl .AND. ! Empty ( cControlName ) ; .AND. ! _IsControlDefined ( cControlName , cParentName ) MsgMiniGuiError ( "Control: " + cControlName + " Of " + cParentName + " Not defined." ) ENDIF RETURN [/pre2]
SergKis: PS. В готовом модуле, такая проверка не нужна (лишняя), в ini всегда можно иметь настройку [COM] ... lVerifyControl = .T. ; .T. - ON , .F. - OFF ... и команду SetProperty(App.Cargo:oIni:COM:lVerifyControl) в INIT PROCEDURE ...
gfilatov2002: SergKis пишет: В готовом модуле, такая проверка не нужна (лишняя) Переписал эту функцию таким образом: [pre2] *-----------------------------------------------------------------------------* STATIC PROCEDURE VerifyControlDefined ( cParentName , cControlName ) *-----------------------------------------------------------------------------* IF Set( _SET_DEBUG ) .AND. !Empty ( cControlName ) .AND. !_IsControlDefined ( cControlName , cParentName ) MsgMiniGuiError ( "Control: " + cControlName + " Of " + cParentName + " Not defined." ) ENDIF RETURN [/pre2] Теперь можно управлять этой функцией с помощью установки отладочного режима в приложении: AltD( 1 )
SergKis: gfilatov2002 пишет AltD(1) Это немного не то. Если на окне ~50 LABEL+GETBOX, то будет поиск по списку контролов, как минимум, 2-а раза 1. VerifyControlDefined ( cParentName , cControlName ) 2. Для запрошенного действия над контролом. И это может быть не единственное окно и список контролов достаточно большой. В отлаженной программе 1-ый пункт не нужен - лишний прогон поиска, по мне, это приобретение ф-ии не лучшее. В версии hmg от 2012 года не было VerifyControlDefined (...) совсем и все OK! сообщения будут ~ такими, достаточно однотипными, что для отлаженной программы (редкое срабатывание) [pre2] Error BASE/1132 Переполнение массива: Неверное количество аргументов Args: [1] = A { ... } length: 24 [2] = N 0 Called from _SETVALUE(287) in module: h_controlmisc.prg Called from SETPROPERTY(4397) in module: h_controlmisc.prg Called from (b)MAIN(124) in module: demo.prg ...[/pre2] вполне читаемо
gfilatov2002: gfilatov2002 пишет: можно управлять этой функцией с помощью установки отладочного режима Видимо, я высказался непонятно. Теперь в отлаженной программе НЕ будет такой проверки. Если потребуется делать такую проверку, то это возможно в режиме отладки, который включается с помощью вызова AltD(1)
SergKis: gfilatov2002 Если нет AltD(1), то нет и проверки, я так понял, но у меня НИКОГДА нет режима AltD, команды такой в коде. И на своем PC при разработке VerifyControl удобна в отладке (есть вызов, нет его - не важно), а на PC клиента уже она лишняя. Т.е. надо вставлять в INIT PROCEDURE ... AltD( App.Cargo:oIni:nVerifyControl ) ? Где nVerifyControl = 0\1
gfilatov2002: SergKis пишет: надо вставлять в INIT PROCEDURE ... AltD( App.Cargo:oIni:nVerifyControl ) Где nVerifyControl = 0\1 Да, верно.
SergKis: gfilatov2002 А применение AltD(0\1) разве не тащит лишние объектники в модуль, для реализации своих решений ? А при таком решении будет тащить всегда, раньше были рекомендации, не включать в конечную программу эти модули. Были какие то решения о динамическом переводе режима 0 в режим 1 и получении всей информации о программе у клиента.
gfilatov2002: SergKis пишет: разве не тащит лишние объектники в модуль Нет, конечно. Вот эта функция из исходников Харбора: [pre2] #define ALTD_DISABLE 0 #define ALTD_ENABLE 1 PROCEDURE AltD( nAction ) IF PCount() == 0 ELSEIF HB_ISNUMERIC( nAction ) SWITCH nAction CASE ALTD_DISABLE Set( _SET_DEBUG, .F. ) EXIT CASE ALTD_ENABLE Set( _SET_DEBUG, .T. ) EXIT ENDSWITCH ENDIF RETURN [/pre2]
SergKis: gfilatov2002 AltD(0)
SergKis: gfilatov2002 Положил вариант примера basic\mdi_2 на ftp
gfilatov2002: Благодарю за поправки в функции _TBrowse() P.S. Добавил пропущенный второй параметр при определении кодового блока [pre2] {|ob,op| _TBrowse_bAdjColumns(ob,op) }[/pre2]
SergKis: gfilatov2002 пишет Добавил пропущенный второй параметр Нашел неточность в _TBrowse[pre2] ... IF HB_ISARRAY( oParam:aFont ) IF Len( oParam:aFont ) < 5 ASize( oParam:aFont, 5 ) ENDIF FOR i := 1 TO Len( oParam:aFont ) IF Empty( oParam:aFont[ i ] ) ; oParam:aFont[ i ] := oParam:aFont[ 1 ] ENDIF NEXT ELSE ... [/pre2]
SergKis: gfilatov2002 Предложение (множественное выполнение блоков кода в ::bOnDrawLine) [pre2] METHOD DrawLine( xRow, lDrawCell ) CLASS TSBrowse ... IF ::bOnDrawLine != NIL IF IsArray( ::bOnDrawLine ) FOR nI := 1 TO Len( ::bOnDrawLine ) IF IsBlock( ::bOnDrawLine[ nI ] ) IF ! Empty( Eval( ::bOnDrawLine[ nI ], Self, xRow ) ) RETURN Self ENDIF ENDIF NEXT ELSEIF ! Empty( Eval( ::bOnDrawLine, Self, xRow ) ) RETURN Self ENDIF ENDIF /* IF ::bOnDrawLine != NIL IF ! Empty( Eval( ::bOnDrawLine, Self, xRow ) ) RETURN Self ENDIF ENDIF */ ... METHOD DrawSelect( xRow, lDrawCell ) CLASS TSBrowse ... IF ::bOnDrawLine != NIL IF IsArray( ::bOnDrawLine ) FOR nI := 1 TO Len( ::bOnDrawLine ) IF IsBlock( ::bOnDrawLine[ nI ] ) IF ! Empty( Eval( ::bOnDrawLine[ nI ], Self, xRow ) ) RETURN Self ENDIF ENDIF NEXT ELSEIF ! Empty( Eval( ::bOnDrawLine, Self, xRow ) ) RETURN Self ENDIF ENDIF /* IF ::bOnDrawLine != NIL IF ! Empty( Eval( ::bOnDrawLine, Self, xRow ) ) RETURN Self ENDIF ENDIF */ ... [/pre2] Другие предложения и примеры положил на ftp
gfilatov2002: SergKis пишет: Предложение Большое спасибо за эти дополнения. Обязательно посмотрю новые примеры с подключением третьей базы. P.S. Все изменения приняты, примеры 8 и 9 стали компактными.
SergKis: gfilatov2002 Добавил назначение событий нажатий кнопок мышки, положил на ftp
SergKis: gfilatov2002 Небольшая правка[pre2] METHOD CellMarginLeftRight( nJ, cData, oColumn, nAlign, lMultiLine, nOut ) CLASS TSBrowse ... IF HB_ISCHAR( cBuf ) .AND. Len( cBuf ) > 0 DEFAULT cData := "" DEFAULT lMultiLine := CRLF $ cData IF lMultiLine ... [/pre2]
gfilatov2002: SergKis пишет: правка OK Благодарю за дополнения
SergKis: gfilatov2002 Еще небольшая правка h_controlmisc2.prg [pre2] STATIC FUNCTION _TBrowse_bBody( ob, op ) ... IF IsArray( aCol ) .and. Len( aCol ) > 0 a := {} FOR EACH cCol IN aCol nCol := iif( IsChar(cCol), ob:nColumn( cCol, .T. ), cCol ) IF nCol > 0 ; AAdd(a, nCol) ENDIF NEXT IF Len( a ) > 0 ; ob:HideColumns( a, .T. ) ; DO EVENTS ENDIF ENDIF [/pre2]
SergKis: gfilatov2002 На ftp положил пример, по использованию, на основе примера от Андрея
gfilatov2002: SergKis пишет: положил пример, по использованию Большое спасибо
SergKis: gfilatov2002 Еще правка и пример с ее использованием положил[pre2] STATIC FUNCTION _TBrowse_Create( oParam, uAlias, cBrw, nY, nX, nW, nH ) ... IF IsArray( oParam:aSizeLen ) .and. Len( oParam:aSizeLen ) > 0 j := Len( oParam:aSizeLen ) oParam:aSize := array( j ) ; AFill( oParam:aSize, 10 ) ... [/pre2]
gfilatov2002: SergKis пишет: Еще правка OK
SergKis: gfilatov2002 Предложение добавить параметры (для вариантов работы без препроцессора в блоках кода) [pre2] FUNCTION _DoControlEventProcedure ( bBlock, i, cEventType, nParam, nParam2 ) ... IF _HMG_BeginWindowActive == .F. .OR. !( hb_defaultValue( cEventType, '' ) == 'CONTROL_ONCHANGE' ) .OR. _HMG_MainClientMDIHandle != 0 #ifdef _OBJECT_ i := _WindowObj( _HMG_aFormHandles[ _HMG_ThisFormIndex ] ) #endif lRetVal := Eval ( bBlock, hb_defaultValue( nParam, 0 ), nParam2, _HMG_ThisControlName, i ) ENDIF ... FUNCTION _DoWindowEventProcedure ( bBlock, i, cEventType ) ... #ifdef _OBJECT_ i := _WindowObj( _HMG_aFormHandles[ _HMG_ThisFormIndex ] ) #endif lRetVal := Eval ( bBlock, _HMG_ThisFormName, i ) ... [/pre2] PS. Положил на ftp примеры с _TBrowse(...), возможно, будут интересны, использованы расчеты размеров от фонта, т.е. App.Object, можно менять размер фонта, переменные cFont := "Arial", nSize := 12
gfilatov2002: SergKis пишет: Предложение добавить параметры Это, конечно, возможно. Но я не понял, почему в функции _DoControlEventProcedure() использовано i := _WindowObj( _HMG_aFormHandles[ _HMG_ThisFormIndex ] ) а не i := _ControlObj( _HMG_ThisControlName, _HMG_ThisFormName )
SergKis: gfilatov2002 пишет почему в функции _DoControlEventProcedure() использовано Дело в том, что не все контролы имеют объект (например, CheckLabel не имеет, перекрылись по месту хранения handle), а усложнять код с объектами не оч. хотелось. Получить объект можно внутри блока кода, через объект окна, т.е. oc := ow:GetObj(cControlName), поэтому i := _ControlObj( _HMG_ThisControlName, _HMG_ThisFormName ) не использовал
gfilatov2002: SergKis пишет: не все контролы имеют объект Понял, принято. Благодарю за пояснение.
SergKis: gfilatov2002 пишет принято С этой правкой получился простой анализ работы с фокусами контролов в блоке, т.е. проверяем на NIL ON GOTFOCUS {|p1,p2,cnm,ind| p1 := iif( ind == NIL, "Нельзя работать", "Можно работать"), ... } ; ON LOSTFOCUS {|p1,p2,cnm,ind| p1 := iif( ind == NIL, "Нельзя работать", "Можно работать"), ... } так же поступаем с фокусами окон ON GOTFOCUS {|cnm,ind,p1| p1 := iif( ind == NIL, "Нельзя работать", "Можно работать"), ... } ; ON LOSTFOCUS {|cnm,ind,p1| p1 := iif( ind == NIL, "Нельзя работать", "Можно работать"), ... }
Andrey: Григорий, как из своей программы изменить цвета Program error ? Я задаю свои функции Alert*() на базе твоих...
gfilatov2002: Andrey пишет: как из своей программы изменить цвета Program error Сейчас эти цвета задаются в ядре без возможности их изменения извне. Но, конечно, возможно добавить логику для их задания пользователем.
Andrey: gfilatov2002 пишет: Но, конечно, возможно добавить логику для их задания пользователем. Сделайте пожалуйста !
SergKis: gfilatov2002 Положил ftp предложение по :FilterFTS(...) для массива
gfilatov2002: SergKis пишет: предложение по :FilterFTS(...) для массива OK Благодарю за помощь
SergKis: gfilatov2002 положил yf ftp предложение и пример по :FilterFTS(...)
SergKis: gfilatov2002 Возьмите пример еще раз, забыл проверить его на фонты 12, 14, 16 размера
SergKis: gfilatov2002 Предложение добавить в :FilterFTS() улучшить обработку логических полей[pre2] METHOD FilterFTS_Line( cFind, lUpper, lAll ) CLASS TSBrowse ... IF lAll .AND. ! HB_ISCHAR( xVal ) IF HB_ISLOGICAL( xVal ) xVal := iif( xVal, ".T.", ".F." ) ELSE xVal := cValToChar( xVal ) ENDIF ENDIF ... и соответственно в :CalcTotal() сделать так же IF lAll .AND. ! HB_ISCHAR( xVal ) IF HB_ISLOGICAL( xVal ) xVal := iif( xVal, ".T.", ".F." ) ELSE xVal := cValToChar( xVal ) ENDIF ENDIF [/pre2] тогда в примерах ловятся значения поля MARRIED на .t.\.f.
gfilatov2002: SergKis пишет: CalcTotal() Увы, использование этого метода перемещает указатель на второй элемент массива при нажатии мышкой на пустой Getbox. Если, убрать вызов :CalcTotal(), то указатель остается на первом элементе массива после отработки метода FilterFTS() . Можно это поправить
SergKis: gfilatov2002 пишет Можно это поправить Заменить ::DrawFooters() на ::Refresh()[pre2] METHOD CalcTotal(cTotal, cNoTotal, lDraw) CLASS TSBrowse ... NEXT //::DrawFooters() ::Refresh(.F.) DO EVENTS [/pre2] PS. Положил на ftp доработанные примеры
gfilatov2002: SergKis пишет: Положил на ftp доработанные примеры Большое спасибо за оперативность! Примеры работают нормально.
gfilatov2002: Выложил новую сборку 25.10 Стандартная версия click here ПРО-версия (архив под паролем) click here В эту сборку были добавлены все последние предложения Сергея вместе с поясняющими примерами. Желаю всем хорошего дня!
sashaBG: Как использовать свою версию метода FilterFTS_Line не трогая библиотеку? Я не силен в ООП. Хочу сделать поиск по несколькими словами. У себя я не запускаю фильтр при каждом нажатии клавиши, а при наличии SPACE в конце строки или при нажатии ENTER. Моя модификация такая: На примере Tsb_filter помоему работает многословный поиск со знаком .and. между словами. [pre2] // ============================================================================ // METHOD TSBrowse:FilterFTS_Line() by SergKis // ============================================================================ METHOD FilterFTS_Line( cFind, lUpper, lAll ) CLASS TSBrowse LOCAL nCol, oCol, xVal, lRet := .F., n, aFind, lFind DEFAULT lUpper := .T., lAll := .F. FOR nCol := 1 TO Len( ::aColumns ) oCol := ::aColumns[ nCol ] IF nCol == 1 .AND. ::lSelector ; LOOP ELSEIF ! oCol:lVisible ; LOOP ELSEIF oCol:lBitMap ; LOOP ENDIF xVal := ::bDataEval( oCol, , nCol ) IF lAll .AND. ! HB_ISCHAR( xVal ) xVal := cValToChar( xVal ) ENDIF IF HB_ISCHAR( xVal ) aFind := hb_ATokens(cFind) FOR n := 1 TO len(aFind) IF lUpper lFind := aFind[n] $ Upper( xVal ) ELSE lFind := aFind[n] $ xVal ENDIF lRet := lFind IF ! lFind EXIT ENDIF NEXT IF lRet EXIT ENDIF ENDIF NEXT RETURN lRet [/pre2]
SergKis: sashaBG пишет работает многословный поиск со знаком .and. между словами Работает такой вариант, но он учтет и не нужный вариант, например cFind := "Краска белая" "Краска матовая белая" "Краска белая" "Краска ... белая" "Белая ... краска " т.е. выбор не совсем тот, что просили, нужно указание разделителя в первых байтах, например, в своих поисках использовал алгоритм, если в 1-ом байте " ", то поиск на вхождение, если нет, то на точное равенство слева заданного. В данном случае можно поступить так же, если 1-ый байт " ", то ваш алгоритм aFind := hb_ATokens( Upper( alltrim(cFind) ) ), иначе, как сейчас
SergKis: gfilatov2002 Попробовал добавить вариант от sashaBG в :FilterFTS с вкл. его алгоритма от наличия первого пробела в cFind, работает. Сделал [pre2] METHOD FilterFTS( cFind, lUpper, lBottom, lFocus, lAll ) CLASS TSBrowse LOCAL nLen := 0, cAlias := ::cAlias, ob := Self LOCAL aArray, aLine, nLine, nCol, oCol, xVal, lRet LOCAL nAtPos, nLastPos, aFind, nFind := 0 DEFAULT lUpper := .T., lAll := .F. IF !HB_ISCHAR( cFind ) .or. Len( cFind ) == 0 RETURN nFind ENDIF IF lUpper cFind := Upper( cFind ) ENDIF IF Left( cFind, 1 ) == " " aFind := hb_ATokens( substr( cFind, 2 ) ) ELSE aFind := { cFind } ENDIF IF ::lIsDbf IF ! Empty( cFind ) ( cAlias )->( dbSetFilter( {|| ob:FilterFTS_Line( cFind, lUpper, lAll, ob ) }, ; "ob:FilterFTS_Line( cFind, lUpper, lAll, ob)" ) ) ELSE ( cAlias )->( dbClearFilter() ) ENDIF ( cAlias )->( dbGoTop() ) DO While !( cAlias )->( Eof() ) SysRefresh() nLen++ ( cAlias )->( dbSkip( 1 ) ) ENDDO nFind := nLen ::bLogicLen := {|| nLen } ::lInitGoTop := .T. ::Reset( lBottom ) ELSEIF ::lIsArr .AND. ! Empty( cFind ) IF ::aArray_FTS == NIL ::aArray_FTS := ::aArray ELSE ::aArray := ::aArray_FTS ENDIF nAtPos := ::nAt nLastPos := ::nLastPos aArray := {} FOR EACH aLine IN ::aArray nLine := hb_enumindex( aLine ) ::nAt := nLine FOR EACH oCol IN ::aColumns nCol := hb_enumindex( oCol ) IF nCol == 1 .AND. ::lSelector ; LOOP ELSEIF ! oCol:lVisible ; LOOP ELSEIF oCol:lBitMap ; LOOP ENDIF xVal := ob:bDataEval( oCol, , nCol ) IF lAll .AND. ! HB_ISCHAR( xVal ) IF HB_ISLOGICAL( xVal ) xVal := iif( xVal, ".T.", ".F." ) ELSE xVal := cValToChar( xVal ) ENDIF ENDIF IF HB_ISCHAR( xVal ) FOR EACH cFind IN aFind IF lUpper lRet := cFind $ Upper( xVal ) ELSE lRet := cFind $ xVal ENDIF IF !lRet EXIT ENDIF NEXT IF lRet AAdd( aArray, aLine ) EXIT ENDIF ENDIF NEXT ::Skip() NEXT ::nAt := nAtPos ::nLastPos := nLastPos IF ( nFind := Len( aArray ) ) > 0 ::aArray := aArray ::Reset( lBottom ) ELSEIF IsArray( ::aArray_FTS ) ::aArray := { Array( Len( ::aArray_FTS[1] ) ) } ::Reset( lBottom ) ENDIF ELSEIF ::lIsArr .AND. Empty( cFind ) IF IsArray( ::aArray_FTS ) ::aArray := ::aArray_FTS ::aArray_FTS := NIL ENDIF nFind := Len( ::aArray ) ::Reset( lBottom ) ENDIF IF ! Empty( lFocus ) ::SetFocus() ENDIF RETURN nFind METHOD FilterFTS_Line( cFind, lUpper, lAll ) CLASS TSBrowse LOCAL nCol, oCol, xVal, lRet := .F., aFind DEFAULT lUpper := .T., lAll := .F. IF Left( cFind, 1 ) == " " aFind := hb_ATokens( substr( cFind, 2 ) ) ELSE aFind := { cFind } ENDIF FOR nCol := 1 TO Len( ::aColumns ) oCol := ::aColumns[ nCol ] IF nCol == 1 .AND. ::lSelector ; LOOP ELSEIF ! oCol:lVisible ; LOOP ELSEIF oCol:lBitMap ; LOOP ENDIF xVal := ::bDataEval( oCol, , nCol ) IF lAll .AND. ! HB_ISCHAR( xVal ) IF HB_ISLOGICAL( xVal ) xVal := iif( xVal, ".T.", ".F." ) ELSE xVal := cValToChar( xVal ) ENDIF ENDIF IF HB_ISCHAR( xVal ) FOR EACH cFind IN aFind IF lUpper lRet := cFind $ Upper( xVal ) ELSE lRet := cFind $ xVal ENDIF IF !lRet EXIT ENDIF NEXT IF lRet EXIT ENDIF ENDIF NEXT RETURN lRet [/pre2] В примерах Advanced\Tsb_FilterFTS поправил [pre2]demo.prg ... b2 := {|| Local cVal := Trim( This.Value ) ... demo2.prg ... oac:oBlk:b_2 := {|| Local cVal := Trim( This.Value ) ... [/pre2] Т.е. поиск в длинном тексте колонки с .and. работает в таком варианте
gfilatov2002: SergKis пишет: от наличия первого пробела в cFind, работает OK У меня тоже работает. Но теперь надо объяснять пользователям насчет использования первого пробела для поиска в длинных строках. Это реально сделать
SergKis: С Summer87 такая фишка работала (как я писал выше про поиск $ или на ==) и всегда с новой версией все в один голос говорили, что бы это не менял. Так, что даже не знаю, что сказать Но убирается режим легко (на уровне разработчика), в примере, вместо Trim(cVal), ставим AllTrim(cVal)
gfilatov2002: SergKis пишет: все в один голос говорили, что бы это не менял
SergKis: gfilatov2002 Andrey пишет (Пост N: 8052) Григорий, как из своей программы изменить цвета Program error ? Я задаю свои функции Alert*() на базе твоих... gfilatov2002 пишет Сейчас эти цвета задаются в ядре без возможности их изменения извне. Предлагаю дать возможность разработчику делать свои окна вместо системных. Для этого небольшая правка ErrorSys.prg [pre2] STATIC PROCEDURE ShowError( cErrorMessage, oError ) ... cMsg += iif( _lShowDetailError(), cErrorMessage, ErrorMessage( oError ) ) IF !Replicate(chr(9), 3) $ cMsg IF ISLOGICAL( _HMG_lOnErrorStop ) .AND. _HMG_lOnErrorStop ... ENDIF ENDIF ErrorLevel( 1 ) IF ISBLOCK( _HMG_bOnErrorExit ) Eval( _HMG_bOnErrorExit ) ENDIF ... т.е. разработчик в своем модуле делает ~так (пример Tsb_2tsb\demo_e.prg) ... Function Main() ... LOCAL cTitl := " Mouse (Right, Left) click events" cTitl += " - Version 0.2 (29.09.2025)" cTitl += " Press key F1 for error" ... ON KEY F1 ACTION iif( AlertYesNo("Make the program terminate with an error ?"), ; This.Buff.SetFocus, ) ON KEY TAB ACTION {|| ... FUNCTION my_ErrorExit(cMsg,oErr,cTxt,cErr) IF pCount() > 0 AlertStop(cErr) cTxt := oErr ENDIF RETURN cMsg + Replicate(chr(9), 3) // отказываемся от показа окон ошибки hmg [/pre2] PS. Или вводить переменную среды hmg для анализа ситуации, возможно просто вертуть .F. и проверить возврат в ErrorSys.prg
gfilatov2002: SergKis пишет: Предлагаю дать возможность разработчику делать свои окна вместо системных. Такая возможность есть в библиотеке изначально. Базовые примеры находятся в папках Basic\Hmg_Error Basic\Hmg_Error_2
SergKis: gfilatov2002 пишет Такая возможность есть в библиотеке изначально Подмена системы обработок ошибок (она существует давно с clipper времен), это несколько не то, что я предложил. Система обработок ошибок остается как есть, заменяем только окно вывода ошибки, которое часто вылазит за пределы экрана, искажается и хочется, как Андрею, покраску и фонты сменить в некоторых строках вывода, а может и не выдавать окно, просто вернув, например, .F.. Обработка ErrorLog.htm или тексты cErr можно отработать и в др. месте. Окно ошибки пугает user и вполне при сбое можно перезапустить модуль на прежнее окно работы, даже без сообщений, сморгнул экран для user и дальше работай
Haz: SergKis пишет: Предлагаю дать возможность разработчику делать свои окна вместо системных. Для этого небольшая правка ErrorSys.prg Стесняюсь спросить, а зачем? Пользователю насрать на красоту сообщения об ошибке, если разраб их обрабатывает, то и юзер эту красоту не увидит. Если нужно о чем то предупредитт юзера, то у разраба полно способов нарисовать свое окно любое. Errorsys открыт полностью, делай что хочешь, объект ошибки не бином Ньютона, чес слово не понял смысла зачем изобретать велосипед. А то становится похоже на мем, программа, работает ху*во, но ошибки показывает красиво
Andrey: Haz пишет: Errorsys открыт полностью, делай что хочешь, Сделал правку его, прога у заказчика не всегда показывает ошибки, писал уже ранее - выдаёт ошибки, что нет фонта на окне и ошибка НЕ ТА, что привела к краху. У меня работает без сбоев, у заказчика периодически вылетает. Сам видел ошибку - на хорошем сервере - ошибка SELECT базы, хотя потом после перезапуска, прога работает без ошибок в этом месте программы. Хрень получается... Переключение между прогами 1С, Мозилой и Минигуи - непонятная штука, особенно если у заказчика мало памяти. Сейчас после замены на свой Alert*() вот такое окно: Юзер будет в шоке. А если пришлет такую ошибку на телефон, то ни фига не видно ! Из-за этого и просил изменить цвета.
SergKis: Haz пишет Пользователю насрать на красоту сообщения об ошибке Глубокое заблуждение, при приеме, вникают в каждую букву, не то что в окно, его вид, если заказчик серьезный. Errorsys открыт полностью, делай что хочешь, объект ошибки не бином Ньютона, чес слово не понял смысла зачем изобретать велосипед Сейчас так и есть, обработчик со времен Clipper5\VO, перенесенный в hb, таскается из проекта в проект. Зачем, если обработчик текущий в hmg устраивает ? Мешает, что нет возможности отключить окно конечное совсем или заменить его своим. Это и ограничивает свободу действий, именно, как разработчика систем. Предложение совсем копеечное, обработать спец. символы или .T.\.F. в имеющейся, готовой системе обработок ошибок, кому не нужно - даже не заметит этого А то становится похоже на мем, программа, работает ху*во, но ошибки показывает красиво А если наоборот ? Программа работает красиво, а ошибки криво и это заложено по умолчанию, в стандарт, т.к. сейчас часто Alert окно искажено, т.е. тексты уходят вправо за экран и вниз, а кнопка <OK> поверх текста
Haz: SergKis пишет: ошибки криво и это заложено по умолчанию, в стандарт, т.к. сейчас часто Alert окно искажено, т.е. тексты уходят вправо за экран и вниз, а кнопка <OK> поверх текста Так я о том, что все строится на объекте ошибки и инструментария создать свою обработку и тем более раскрасить ее по своему вкусу предостаточно. На вкус и цвет все фломастеры разные и в некоторых интерфейсах Алерт выглядит как красная тряпка перед быком, тем более со стеком вызова процедур при виде которого пользователь не понимает ровным счётом ничего Если не устраивает стандартная процедура обработки, делаем свою с подробным протоколом и автоматической отправкой разработчику, если нужно предупредить пользователя вывешиваем флаг с лозунгами что уже знаем и работаем. Тем более , что информация об ошибке стандартным обработчиком иногда ни о чем. К примеру при открытом через ole excel читается текстовой файл параметров и если файла нет выдаёт discspace(0) при сотнях гигов свободного места Уже как то обсуждали , и мое мнение нужно не окно на пол экрана со стеком в цветах африканского авангарда,а удобный инструмент логирования ошибки, оправки лога разработчику и удобный вьюер этого лога. Пользователю достаточно обычного окна с уведомлениями о том что ситуация контролируется.
SergKis: Haz пишет Если не устраивает стандартная процедура обработки, делаем свою с подробным протоколом и автоматической отправкой разработчику УСТРАИВАЕТ ! Кроме окна сообщения MsgStop() или Alert и ничего лишнего не надо, все есть в параметрах пользовательского блока кода, что и куда девать это совсем др. вопрос
Andrey: Haz пишет: Уже как то обсуждали , и мое мнение нужно не окно на пол экрана со стеком в цветах африканского авангарда,а удобный инструмент логирования ошибки, оправки лога разработчику Да это нужная вещь в программе. Сделал с помощью Сергея, недавно похожее, в новой версии МиниГуи пример - \SAMPLES\Advanced\Tsb_EventLog Запись ошибки и действий пользователя в dbf-файл. [pre2] Журнал событий в программе - запись действий пользователей в программе. Статистика выполнения(события программы) по операторам за периоды времени - кнопка "F5 Отчёты". События программы - справочник смотреть/добавлять: user2log.prg функция EVENTS_Dim(). Аварийная ошибка в программе - смотреть модуль: demo.prg _HMG_bOnErrorInit := {|cMsg,oErr,cTxt,cErr| my_ErrorExit(cMsg,oErr,cTxt,cErr) } _HMG_bOnErrorExit := {| | my_ErrorExit() } Сама функция в demo_ErrorLog.prg [/pre2]
gfilatov2002: Andrey пишет: Из-за этого и просил изменить цвета. Проблема с цветами сообщения об ошибке уже решена. Сейчас возможно настроить все цвета в этом сообщении. SergKis пишет: сейчас часто Alert окно искажено, т.е. тексты уходят вправо за экран и вниз, а кнопка <OK> поверх текста Эту проблему тоже решил. Благодарю всех за это полезное обсуждение
SergKis: gfilatov2002 пишет Проблема с цветами сообщения об ошибке уже решена. Сейчас возможно настроить все цвета в этом сообщении Это хорошо Но обработка ошибок, это одно, а вывод их на устройства (диск, console, gui), это другое, как и то куда девать данные об ошибке
SergKis: gfilatov2002 Правка в :FilterFTS() небольшая [pre2] METHOD FilterFTS( cFind, lUpper, lBottom, lFocus, lAll ) CLASS TSBrowse ... FOR EACH aLine IN ::aArray ... IF nCol == 1 .AND. ::lSelector ; LOOP ELSEIF !Empty(oCol:cName) .and. oCol:cName == "ARRAYNO" ; LOOP ELSEIF ! oCol:lVisible ; LOOP ... METHOD FilterFTS_Line( cFind, lUpper, lAll ) CLASS TSBrowse ... IF nCol == 1 .AND. ::lSelector ; LOOP ELSEIF !Empty(oCol:cName) .and. oCol:cName == "ORDKEYNO" ; LOOP ELSEIF ! oCol:lVisible ; LOOP ELSEIF oCol:lBitMap ; LOOP ENDIF ... [/pre2] стал работать, с наличием колонки oTsb:aNumber := ... в списке колонок
gfilatov2002: SergKis пишет: Правка в :FilterFTS() OK. Благодарю за помощь
alex_II: Перешел с версии 25.03 на 25.10 и споткнулся на ровном месте. Изменилась работа команды UNCOMPRESS cName EXTRACTPATH Path_Dbf BLOCK {|cFile,nPos| ShowProgress(cFile,nPos,cForm)} Теперь существующие в Path_Dbf файлы не переписываются из архива, хотя раньше всё работало.
gfilatov2002: alex_II пишет: Теперь существующие в Path_Dbf файлы не переписываются из архива Благодарю за сообщение! Теперь при извлечении файлов используется флаг HB_FO_EXCL create and open only if file doesn't exist Если это критично для Вашей программы, то этот флаг можно убрать, и затем пересобрать библиотеку hbziparc. P.S. Я уже сделал необходимые правки кода, чтобы восстановить предыдущий функционал команды UNCOMPRESS.
alex_II: gfilatov2002 пишет: P.S. Я уже сделал необходимые правки кода, чтобы восстановить предыдущий функционал команды UNCOMPRESS. Спасибо за разъяснение, а пока подожду на версии 25.03
SergKis: gfilatov2002 Не большое предложение по :CalcTotal(...), использовать Picture колонки для вывода суммы итога в footer, если задан[pre2] METHOD CalcTotal( cTotal, cNoTotal, lDraw, lPicture ) CLASS TSBrowse ... FOR nK := 1 TO nCols oCol := ::aColumns[nK] IF !aTot[nK] ; LOOP ENDIF IF Empty( aSum[nK] ) xVal := "" ELSEIF !Empty( lPicture ) .and. !Empty( oCol:cPicture ) xVal := AllTrim( Transform( aSum[nK], oCol:cPicture ) ) ELSE xVal := hb_ntos( aSum[nK] ) ENDIF oCol:cFooting := xVal NEXT ...[/pre2] при lPicture := .T. в параметре Может быть, надо сделать, Default lPicture := .T. , но не уверен в этом, т.е. можно без этого параметра делать[pre2] ELSEIF !Empty( lPicture ) .and. !Empty( oCol:cPicture ) xVal := AllTrim( Transform( aSum[nK], oCol:cPicture ) ) [/pre2] но остается вопрос, если колонка узкая и с oCol:cPicture не помещается, а без него (hb_ntos...) все ok!, а :cPicture задан ?
gfilatov2002: SergKis пишет: надо сделать, Default lPicture := .T. Принято с использованием этого параметра, как наиболее универсальный вариант. Если задано oCol:cPicture, то эта установка в приоритете, с возможностью включить ее использование с помощью параметра lPicture := .T., который по умолчанию задан, как lPicture := .F.
gfilatov2002: Подготовил первый релиз-кандидат для ПРО-версии сборки 25.11 Кратко, что нового: [pre2]Fixes * Memory leaks in CHECKLABEL control: this fix avoids memory and GDI leaks that would previously happen when replacing images or destroying windows. * HbZipArc library: hb_ZipFile() and hb_UnzipFile() major fixes. New * Adaptation of MiniGUI core is completed for using Zig language as LLVM C compiler frontend. Please note that the library format of this compiler is fully compatible with MinGW. Updates * Improved output of the Error message window with using SET SHOWREDALERT ON command. * Unicode support: Fixed getting the name of the currently set hotkey in HotKeyBox. * TSBrowse 9.0 adaptation: Improved FilterFTS() method now works with arrays and added new CalcTotal() method. * Update for using SQLITE3 version 3.51.0 (from 3.50.4). * Updated Harbour Compiler 3.2.0dev (SVN 2025-10-23 21:45): * updated hbmk2 tool to define __ARCH64BIT__ at .prg level; * added support for using Zig as LLVM C compiler frontend; * added use of read lock when accessing the FPT memo file. New Samples * Simple ChartView class for GraphPlus library. * CSV Viewer for .txt, .csv and .arr files. Enhanced Samples * Refactored Arkanoid Mini Game 🎮 (PRO version). * Updated ChatGPT-generated samples. IMPORTANT NOTE I will only release the Standard build 25.11 if I get at least 10 upvotes that will donate to that build. [/pre2] Пока я НЕ знаю, когда будет опубликован этот релиз... Все зависит от интереса к этой работе у пользователей библиотеки. Желаю всем хороших выходных.
Andrey: Да ! Новый релиз нужен ! Ждем с не терпеньем ! Спасибо большое Григорий за твою огромную работу !
gfilatov2002: Andrey пишет: Новый релиз нужен Я могу опубликовать новую сборку хоть завтра, но НЕ вижу большого интереса у пользователей библиотеки (кроме ОДНОГО человека ).
alex_II: gfilatov2002 пишет: Да ! Новый релиз нужен ! Ждем с не терпеньем ! Спасибо большое Григорий за твою огромную работу !
alex_II: Andrey пишет: Да ! Новый релиз нужен ! Ждем с не терпеньем ! Спасибо большое Григорий за твою огромную работу ! Присоединяюсь.
gfilatov2002: Выложил новую сборку 25.11 Стандартная версия click here ПРО-версия (архив под паролем) click here Желаю всем хорошего дня!
Andrey: gfilatov2002 пишет: Выложил новую сборку 25.11 Что-то описания нет в ChangeLog.txt для: 1) Три способа скачивания файла с сайта - \SAMPLES\Advanced\Updating_program_from_website На базе этого примера можно делать свою программу для обновления с сайта новых версий программы. 2) Работа с файлами Microsoft Access - \SAMPLES\Advanced\mg_Access Спасибо БОЛЬШОЕ за новую версию ! Примеров libcurl-test(0.3).7z и Tsb_image_dbf(0.38).7z нет в библиотеке. Хорошие же примеры, небольшие.
sashaBG: У меня предложение по FilterFTS_Line: Сначало собрать строку, а потом в ней искать совпадения: [pre2] // ============================================================================ // METHOD TSBrowse:FilterFTS_Line() by SergKis // ============================================================================ METHOD FilterFTS_Line( cFind, lUpper, lAll ) CLASS TSBrowse LOCAL nCol, oCol, xVal,cRow:="", lRet := .F., aFind DEFAULT lUpper := .T., lAll := .F. IF Left( cFind, 1 ) == " " aFind := hb_ATokens( substr( cFind, 2 ) ) ELSE aFind := { cFind } ENDIF FOR nCol := 1 TO Len( ::aColumns ) oCol := ::aColumns[ nCol ] IF nCol == 1 .AND. ::lSelector ; LOOP ELSEIF !Empty(oCol:cName) .AND. oCol:cName == "ORDKEYNO" ; LOOP ELSEIF ! oCol:lVisible ; LOOP ELSEIF oCol:lBitMap ; LOOP ENDIF xVal := ::bDataEval( oCol, , nCol ) IF lAll .AND. ! HB_ISCHAR( xVal ) IF HB_ISLOGICAL( xVal ) xVal := iif( xVal, ".T.", ".F." ) ELSE xVal := cValToChar( xVal ) ENDIF ENDIF IF HB_ISCHAR( xVal ) cRow += iif( lUpper, Upper( xVal ), xVal ) ENDIF NEXT FOR EACH cFind IN aFind lRet := cFind $ cRow IF !lRet EXIT ENDIF NEXT RETURN lRet[/pre2]
SergKis: sashaBG пишет Сначало собрать строку, а потом в ней искать совпадения: По мне, такой вариант сравнения не совсем, а может и совсем, не корректен, т.к. например, 2а последних символа одного поля + 2а первых символа следующего, дадут .T. для cFind, а это не так, по отдельности поля не совпадают с cFind. Возможно, для такого поиска надо применять метод :FilterData(cFilter, ...), т.к. в выражении cFilter можете определять для себя, какие поля идут слитно, а какие по отдельности или собрать строку по записи и проверить на вхождение заданного фрагмента
sashaBG: Нет возражений! Попробую тогда через FilterData !
Andrey: Опять кнопка убегает на окне ошибки !
SergKis: gfilatov2002 Правка[pre2] METHOD FilterFTS( cFind, lUpper, lBottom, lFocus, lAll ) CLASS TSBrowse ... DEFAULT lUpper := .T., lAll := .F. IF !HB_ISCHAR( cFind ) cFind := "" ELSEIF lUpper cFind := Upper( cFind ) ENDIF IF Left( cFind, 1 ) == " " .and. Len( cFind ) > 1 aFind := hb_ATokens( substr( cFind, 2 ) ) ELSE ... METHOD CalcTotal( cTotal, cNoTotal, lDraw, lPicture ) CLASS TSBrowse ... IF Empty( aSum[nK] ) xVal := "" ELSEIF !Empty( lPicture ) .and. !Empty( oCol:cPicture ) xVal := AllTrim( Transform( aSum[nK], oCol:cPicture ) ) IF "*" $ xVal xVal := hb_ntos( aSum[nK] ) ENDIF ELSE xVal := hb_ntos( aSum[nK] ) ENDIF oCol:cFooting := xVal ... [/pre2]
gfilatov2002: SergKis пишет: Правка Принято
gfilatov2002: Завершена подготовка обновленной ноябрьской сборки 25.11 Update 1, которая будет опубликована завтра Выход этой сборки стал возможен только благодаря поддержке Андрея Верченко Желаю всем хорошего дня!
gfilatov2002: Выложил обновление сборки 25.11 Update 1 Стандартная бесплатная версия click here ПРО-версия (архив под паролем) click here Желаю всем хороших выходных!
Andrey: Вижу в ресурсах default.ico, но не вижу подключения в файлах *.rc Как подключить к себе в программу эту иконку ? Можно внести её в minigui.rc как [pre2]1MG ICON default.ico[/pre2]
Dima: Andrey пишет: но не вижу подключения в файлах *.rc c:\MiniGUI\SAMPLES\Applications\Cumple\cumple.rc c:\MiniGUI\SAMPLES\BASIC\Template\demo.rc c:\MiniGUI\UTILS\MPM\mpm.rc c:\MiniGUI\UTILS\MPMC\mpmc.rc
SergKis: Andrey C:\MiniGUI\SAMPLES\BASIC\Template\demo.rc[pre2] /* the first icon will also defines the executable icon in Explorer */ MAIN ICON ".\..\..\..\RESOURCES\DEFAULT.ICO" PAPER GIF "Paper.gif"[/pre2]
Andrey: SergKis пишет: MAIN ICON ".\..\..\..\RESOURCES\DEFAULT.ICO" У меня другие пути к Минигуи. Проекты собираю на диске W:\ Эту иконку могу и в проект к себе в папку собирать, но это же не дело ! Легче в примерах писать так: [pre2] SET DEFAULT ICON TO "1MG"[/pre2] Ресурсный файл МиниГуи увеличится на размер DEFAULT.ICO Там уже есть иконки... Сложно добавить ещё одну ? В папке C:\MiniGUI\SAMPLES 33 файлов размером 994308 байт - 1mg.ico Вот экономия места в самой библиотеке. Для анализа файлов в папке МиниГуи использовал проект mg_zip
Haz: Andrey пишет: Как подключить к себе в программу эту иконку Ты уж определись с хотелками, себе в программу или всем ? Тем более икону, которую каждый под проект выбирает индивидуально.
Andrey: Haz пишет: Ты уж определись с хотелками, себе в программу или всем ? Всем ! 33 примера используют эту иконку. Для экономии места нужно ВСЕГО НАВСЕГО прописать эту иконку в ресурсном файле МиниГуи и всё. В дальнейшем примеры легко будет делать с главной иконкой МиниГуи.
Haz: Andrey пишет: Для экономии места нужно ВСЕГО НАВСЕГО прописать эту иконку в ресурсном файле МиниГуи и всё. Странная экономия , да там полно дублей разных и BMP и DBF и ICO и AVI .... вот пример который создаст отчет о дублях [pre2] Procedure Main() local cFile, aFiles, cDir, aFile, aHash, cStr, cKey aHash := hb_Hash() cDir := "c:\minigui" cFile := "" cStr := "" aFiles := {} aFiles := hb_DirScan( cDir, "*.*" ) nLen := 0 for each aFile in aFiles cKey := upper( hb_FNameNameExt( aFile[1] ) ) + "." + hb_ntoc( aFile[2] ) if !hb_hHasKey(aHash, cKey ) aHash[ cKey ] := hb_Hash() aHash[ cKey ]["COUNT"] := 1 aHash[ cKey ]["FILE"] := upper(hb_FNameNameExt( aFile[1] )) aHash[ cKey ]["SIZE"] := aFile[2] else aHash[ cKey ]["COUNT"] ++ aHash[ cKey ]["SIZE"] += aFile[2] end end cStr += PADR("FILE NAME", 30, " ") + " " + PadL("COUNT", 6, " ") + " " + PADL("SIZE", 13," ") + hb_eol() cStr += PADR("-", 30, " ") + " " + PadL("-", 6, " ") + " " + PADL("-", 13," ") + hb_eol() for Each cKey in hb_hKeys( aHash ) if aHash[ cKey ]["COUNT"] > 1 cStr += PADR(aHash[ cKey ]["FILE"], 30, " ") + " " + PadL(hb_ntoc(aHash[ cKey ]["COUNT"]), 6, " ") + " " + transform(aHash[ cKey ]["SIZE"], "9 999 999 999" )+ hb_eol() end end strFile( cStr, "Dupe.txt") Return nil [/pre2] уверен после просмотра результатат в Dupe/txt желание экономить пропадет
Andrey: Haz пишет: да там полно дублей разных и BMP и DBF и ICO и AVI .. Да я согласен с этим, что полно дублей. Просто насчёт иконки 1MG бросилось в глаза, вот и предложил. 1Мб только одной иконки в библиотеке, как то многовато !
полная версия страницы