Готовится к опубликованию новая сборка №48, которая выйдет в конце недели. Если у Вас есть интересные наработки для включения в новый релиз, то сейчас самое удобное время для их отправки мне
Кратко, что нового:
- исправление обнаруженных ошибок и неточностей кода; - новый класс HEADERIMAGE для Grid и Browse; - свойство Address в Hyperlink может теперь открывать папку или файл на диске; - добавлен NOTABSTOP класс для Browse; - поддержка пользовательских компонентов (заимствована из оффициального релиза); - расширения и исправления в библиотеках TsBrowse и PropGrid; - обновлены сборки Харбор и HMGS-IDE; - новые и обновленные старые примеры (как обычно ).
/* * 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 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
Отправлено: 02.07.25 13:35. Заголовок: А не проще формирова..
А не проще, формировать новый массив для комбо и помещать его новый адрес на место старого ? Это один запрос к базе\серверу ... Когда использовал GRID (правда очень давно не пользуюсь) так и делал, записей в комбо не много, как правило
Отправлено: 02.07.25 14:05. Заголовок: gfilatov2002 пишет В..
gfilatov2002 пишет
цитата:
Возможно, я не совсем понял, что значит помещать новый адрес на место старого
Примерно так aCBox := mySelect(...) _HMG_aControlMiscData1[ i ][ 13 ] := aCBox или _HMG_aControlMiscData1[ i ][ 13 ] := mySelect(...) правда точно не помню назначения в _HMG_aControlMiscData1[ i ] для комбо
gfilatov2002 Пример хороший и сделан правильно, но, по мне, это плохая схема использования комбо в жизни GRID, т.к. item-ы при вводе требуют валидности, да и замена всего массива требует проверки изменения item-ов (они были ?). Комбо в GRID это оч. редко или совсем не меняемые справочники типа {"муж.","жен."}, должности, отделы, ... +, когда комбо ячейка в фокусе, то оч. легко случайно, клавишей, сменить значение в ячейке и мышкой уйти на др. ячейку и не заметить этого. По мне это пример, как не надо работать с комбо
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
/* * 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()
/* * 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()
/* * 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
Вопрос: нужен ли такой пример в поставке библиотеки?
Ниже приведена окончательная версия этого примера: Скрытый текст
#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()
/* * 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()
/* * 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
/* * 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"
Отправлено: 03.07.25 10:35. Заголовок: gfilatov2002 Чем ф-..
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 ...
Отправлено: 03.07.25 10:56. Заголовок: SergKis пишет: Чем ..
SergKis пишет:
цитата:
Чем ф-я aTm := HMG_LISTTIMERS() лучше aTm := HMG_GetFormControls(ThisWindow.Name, "TIMER" ) ?
Дело не в том, что лучше, а что хуже. Это просто еще одна возможность для работы с таймерами. Кстати, функция HMG_LISTTIMERS() не привязана к конкретному окну (как HMG_GetFormControls(ThisWindow.Name, "TIMER" ) ), а показывает все активные таймеры, которые установлены в данный момент в программе.
Отправлено: 03.07.25 14:55. Заголовок: gfilatov2002 пишет И..
gfilatov2002 пишет
цитата:
Именно так
Это мало что дает, т.е. снимок не отражает картину, особенно, если таймеры короткие (100 - 300 мс) и они на время работы блока кода ставятся Enable := .F. и потом .T. (все таймеры исп. этот механизм) Что то определить по таким данным ф-ии сложно. Возможно, надо, что бы ф-я возвращала все таймера назначенные в программе с их тек. соостоянием Enable ?
Отправлено: 04.07.25 09:52. Заголовок: SergKis пишет: Что ..
SergKis пишет:
цитата:
Что то определить по таким данным ф-ии сложно.
Так как основное использование этой функции - для отладки кода, то можно временно убрать Enable := .F. в режиме отладки. Но это уже вопросы конкретной реализации работы таймеров...
Отправлено: 04.07.25 10:42. Заголовок: gfilatov2002 пишет в..
gfilatov2002 пишет
цитата:
временно убрать Enable := .F. в режиме отладки
Зачем такая канитель, тем более, что это для отладки (ставить Enable := .T. надо для каждого таймера, его блока кода) ? Проще получать весь список "TIMER" и иметь в массиве элемент Enabled для анализа, возможно, имя таймера и имя окна (дополнительно к handle) PS Такой массив можно использовать и для управления таймерами (включать\выключать их работу), а не только для отладки
P.S. Пример очень лаконичный и насыщенный. Вот его краткое описание, сгенерированное ИИ:
цитата:
/* * 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. */
gfilatov2002 Добавил в пример более широкую информацию в Title окна и SuperHeader тсб (просьба Андрея), + почистил код немного Положил на ftp PS Для понимания о чем речь (кому интересно), пример demo8.prg тут Скрытый текст
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()
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 }
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
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
/* * 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()
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 }
/* * 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"
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 }
/* * 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
Отправлено: 10.07.25 14:28. Заголовок: gfilatov2002 пишет ..
gfilatov2002 пишет
цитата:
* 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. ...
Это место я поменял для индикации и более гибкого отбора на
STATIC FUNCTION Select2Mem(bMode, cFld) LOCAL nOld := Select() LOCAL aRecs := {}, cAls := Alias() LOCAL cFile := "mem:" + cAls, nFld, aRec, nRec Default cFld := "CUSTNO"
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 ...
т.е. можно задавать, например, в 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"}
Отправлено: 10.07.25 15:19. Заголовок: SergKis пишет: Это ..
SergKis пишет:
цитата:
Это место я поменял
Поправил описание функции следующим образом:
цитата:
/* * 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. */
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 }
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
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
/* * 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()
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 }
/* * 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"
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 }
/* * 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
Отправлено: 16.07.25 11:56. Заголовок: Доброго дня всем фор..
Доброго дня всем форумчанам . Давно не писал на Clipper/Harbour , а вот теперь снова понадобилось кой чего автоматизировать ... Подскажите , где сейчас находятся дистрибутивы Hаrbour и MiniGui ? Хочу установить всё для работы на новом компьютере .
Григорий, спасибо за новую версию! Перешел с версии 25.05 и обратил внимание, что картинки в меню поменяли фон. У меня в моих менюшках фон стал и белый и малиновый и черный.. Посмотреть пример - miniGui\SAMPLES\BASIC\MENU_Picture:
Отправлено: 10.09.25 11:18. Заголовок: Выяснил, что при зап..
Выяснил, что при запуске программы эти функции не портят алиас, но потом при открытии базы (стандартное открытие и создание индексов), начинается чехарда с этим алиасом, после вывода на экран - теряется алиас. Где и что происходит - не понимаю ?
Отправлено: 12.09.25 22:48. Заголовок: Обратите внимание на..
Обратите внимание на пример - SAMPLES\Advanced\Tsb_array_report Проба одного расчёта разными методами.
Отчёт по базе 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
Отправлено: 13.09.25 12:12. Заголовок: и еще добавить в h_d..
и еще добавить в h_dbf_aux *-----------------------------------------------------------------------------* FUNCTION HMG_ConvertType( uVal, cTypeDst ) *-----------------------------------------------------------------------------* RETURN ConvertType( uVal, cTypeDst )
Отправлено: 14.09.25 16:01. Заголовок: gfilatov2002 Можно ..
gfilatov2002 Можно сделать в ф-ях: SetProperty( Arg1 , ... ) GetProperty( Arg1 , ... ) DoMethod ( Arg1 , ... ) Default Arg1 := _HMG_ThisFormName Для использования в блоках кода, получаемых b := &("{|| ... }"), т.к. имя тек. формы не известно - получается динамически от FormName := HMG_GetUniqueName("..."), например
Отправлено: 14.09.25 17:52. Заголовок: gfilatov2002 пишет I..
gfilatov2002 пишет
цитата:
IF ! Empty( _HMG_ThisFormName )
Это не имеет смысла, т.к. пишем SetProperty(, ...), т.е. будет прерывание при Empty( _HMG_ThisFormName ) и не заданном Arg1, надо использовать SET WINDOW THIS TO ... до исп. SetProperty(, ...). использование в оконных событиях и при _wPost(...), _wSend(...) событиях все будет ok!
gfilatov2002 Внес изменения в hmg 25.09 (ранее на ftp давал, сейчас свежие), положил на ftp, MDI пока не трогал В demo.prg варианты использования. Default Arg1 := _HMG_ThisFormName сделал
Версия МиниГуи 25.06Pro MsgDebug() портит текущий АЛИАС базы !!!
Разобрался с такой ошибкой ! Если в ТСБ назначить клавиши F3, F4, ... на не существующие события на окне, то происходит такая фигня. Лечится только перепроверкой своего кода.
Отправлено: 20.09.25 08:03. Заголовок: PS. В готовом модул..
PS. В готовом модуле, такая проверка не нужна (лишняя), в ini всегда можно иметь настройку [COM] ... lVerifyControl = .T. ; .T. - ON , .F. - OFF ... и команду SetProperty(App.Cargo:oIni:COM:lVerifyControl) в INIT PROCEDURE ...
Отправлено: 20.09.25 17:43. Заголовок: gfilatov2002 пишет A..
gfilatov2002 пишет
цитата:
AltD(1)
Это немного не то. Если на окне ~50 LABEL+GETBOX, то будет поиск по списку контролов, как минимум, 2-а раза 1. VerifyControlDefined ( cParentName , cControlName ) 2. Для запрошенного действия над контролом. И это может быть не единственное окно и список контролов достаточно большой. В отлаженной программе 1-ый пункт не нужен - лишний прогон поиска, по мне, это приобретение ф-ии не лучшее. В версии hmg от 2012 года не было VerifyControlDefined (...) совсем и все OK! сообщения будут ~ такими, достаточно однотипными, что для отлаженной программы (редкое срабатывание)
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 ...
можно управлять этой функцией с помощью установки отладочного режима
Видимо, я высказался непонятно. Теперь в отлаженной программе НЕ будет такой проверки. Если потребуется делать такую проверку, то это возможно в режиме отладки, который включается с помощью вызова
Отправлено: 20.09.25 18:10. Заголовок: gfilatov2002 Если н..
gfilatov2002 Если нет AltD(1), то нет и проверки, я так понял, но у меня НИКОГДА нет режима AltD, команды такой в коде. И на своем PC при разработке VerifyControl удобна в отладке (есть вызов, нет его - не важно), а на PC клиента уже она лишняя. Т.е. надо вставлять в INIT PROCEDURE ... AltD( App.Cargo:oIni:nVerifyControl ) ? Где nVerifyControl = 0\1
Отправлено: 20.09.25 18:23. Заголовок: gfilatov2002 А прим..
gfilatov2002 А применение AltD(0\1) разве не тащит лишние объектники в модуль, для реализации своих решений ? А при таком решении будет тащить всегда, раньше были рекомендации, не включать в конечную программу эти модули. Были какие то решения о динамическом переводе режима 0 в режим 1 и получении всей информации о программе у клиента.
Отправлено: 23.09.25 16:53. Заголовок: gfilatov2002 пишет Д..
gfilatov2002 пишет
цитата:
Добавил пропущенный второй параметр
Нашел неточность в _TBrowse
... 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 ...
Отправлено: 27.09.25 22:48. Заголовок: gfilatov2002 Еще не..
gfilatov2002 Еще небольшая правка h_controlmisc2.prg
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
gfilatov2002 Предложение добавить параметры (для вариантов работы без препроцессора в блоках кода)
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 ) ...
PS. Положил на ftp примеры с _TBrowse(...), возможно, будут интересны, использованы расчеты размеров от фонта, т.е. App.Object, можно менять размер фонта, переменные cFont := "Arial", nSize := 12
Отправлено: 02.10.25 12:44. Заголовок: gfilatov2002 пишет п..
gfilatov2002 пишет
цитата:
почему в функции _DoControlEventProcedure() использовано
Дело в том, что не все контролы имеют объект (например, CheckLabel не имеет, перекрылись по месту хранения handle), а усложнять код с объектами не оч. хотелось. Получить объект можно внутри блока кода, через объект окна, т.е. oc := ow:GetObj(cControlName), поэтому i := _ControlObj( _HMG_ThisControlName, _HMG_ThisFormName ) не использовал
Отправлено: 03.10.25 21:54. Заголовок: gfilatov2002 пишет п..
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, "Нельзя работать", "Можно работать"), ... }
Увы, использование этого метода перемещает указатель на второй элемент массива при нажатии мышкой на пустой Getbox. Если, убрать вызов :CalcTotal(), то указатель остается на первом элементе массива после отработки метода FilterFTS() . Можно это поправить
Отправлено: 10.10.25 13:15. Заголовок: sashaBG пишет работа..
sashaBG пишет
цитата:
работает многословный поиск со знаком .and. между словами
Работает такой вариант, но он учтет и не нужный вариант, например cFind := "Краска белая" "Краска матовая белая" "Краска белая" "Краска ... белая" "Белая ... краска " т.е. выбор не совсем тот, что просили, нужно указание разделителя в первых байтах, например, в своих поисках использовал алгоритм, если в 1-ом байте " ", то поиск на вхождение, если нет, то на точное равенство слева заданного. В данном случае можно поступить так же, если 1-ый байт " ", то ваш алгоритм aFind := hb_ATokens( Upper( alltrim(cFind) ) ), иначе, как сейчас
gfilatov2002 Попробовал добавить вариант от sashaBG в :FilterFTS с вкл. его алгоритма от наличия первого пробела в cFind, работает. Сделал Скрытый текст
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.
Отправлено: 10.10.25 19:11. Заголовок: С Clipper87 такая фи..
С Summer87 такая фишка работала (как я писал выше про поиск $ или на ==) и всегда с новой версией все в один голос говорили, что бы это не менял. Так, что даже не знаю, что сказать Но убирается режим легко (на уровне разработчика), в примере, вместо Trim(cVal), ставим AllTrim(cVal)
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
Отправлено: 11.10.25 21:58. Заголовок: gfilatov2002 пишет Т..
gfilatov2002 пишет
цитата:
Такая возможность есть в библиотеке изначально
Подмена системы обработок ошибок (она существует давно с clipper времен), это несколько не то, что я предложил. Система обработок ошибок остается как есть, заменяем только окно вывода ошибки, которое часто вылазит за пределы экрана, искажается и хочется, как Андрею, покраску и фонты сменить в некоторых строках вывода, а может и не выдавать окно, просто вернув, например, .F.. Обработка ErrorLog.htm или тексты cErr можно отработать и в др. месте. Окно ошибки пугает user и вполне при сбое можно перезапустить модуль на прежнее окно работы, даже без сообщений, сморгнул экран для user и дальше работай
Предлагаю дать возможность разработчику делать свои окна вместо системных. Для этого небольшая правка ErrorSys.prg
Стесняюсь спросить, а зачем? Пользователю насрать на красоту сообщения об ошибке, если разраб их обрабатывает, то и юзер эту красоту не увидит. Если нужно о чем то предупредитт юзера, то у разраба полно способов нарисовать свое окно любое. Errorsys открыт полностью, делай что хочешь, объект ошибки не бином Ньютона, чес слово не понял смысла зачем изобретать велосипед. А то становится похоже на мем, программа, работает ху*во, но ошибки показывает красиво
Сделал правку его, прога у заказчика не всегда показывает ошибки, писал уже ранее - выдаёт ошибки, что нет фонта на окне и ошибка НЕ ТА, что привела к краху. У меня работает без сбоев, у заказчика периодически вылетает. Сам видел ошибку - на хорошем сервере - ошибка SELECT базы, хотя потом после перезапуска, прога работает без ошибок в этом месте программы. Хрень получается... Переключение между прогами 1С, Мозилой и Минигуи - непонятная штука, особенно если у заказчика мало памяти.
Сейчас после замены на свой Alert*() вот такое окно: Юзер будет в шоке. А если пришлет такую ошибку на телефон, то ни фига не видно ! Из-за этого и просил изменить цвета.
Отправлено: 12.10.25 06:48. Заголовок: Haz пишет Пользовате..
Haz пишет
цитата:
Пользователю насрать на красоту сообщения об ошибке
Глубокое заблуждение, при приеме, вникают в каждую букву, не то что в окно, его вид, если заказчик серьезный.
цитата:
Errorsys открыт полностью, делай что хочешь, объект ошибки не бином Ньютона, чес слово не понял смысла зачем изобретать велосипед
Сейчас так и есть, обработчик со времен Clipper5\VO, перенесенный в hb, таскается из проекта в проект. Зачем, если обработчик текущий в hmg устраивает ? Мешает, что нет возможности отключить окно конечное совсем или заменить его своим. Это и ограничивает свободу действий, именно, как разработчика систем. Предложение совсем копеечное, обработать спец. символы или .T.\.F. в имеющейся, готовой системе обработок ошибок, кому не нужно - даже не заметит этого
цитата:
А то становится похоже на мем, программа, работает ху*во, но ошибки показывает красиво
А если наоборот ? Программа работает красиво, а ошибки криво и это заложено по умолчанию, в стандарт, т.к. сейчас часто Alert окно искажено, т.е. тексты уходят вправо за экран и вниз, а кнопка <OK> поверх текста
ошибки криво и это заложено по умолчанию, в стандарт, т.к. сейчас часто Alert окно искажено, т.е. тексты уходят вправо за экран и вниз, а кнопка <OK> поверх текста
Так я о том, что все строится на объекте ошибки и инструментария создать свою обработку и тем более раскрасить ее по своему вкусу предостаточно. На вкус и цвет все фломастеры разные и в некоторых интерфейсах Алерт выглядит как красная тряпка перед быком, тем более со стеком вызова процедур при виде которого пользователь не понимает ровным счётом ничего Если не устраивает стандартная процедура обработки, делаем свою с подробным протоколом и автоматической отправкой разработчику, если нужно предупредить пользователя вывешиваем флаг с лозунгами что уже знаем и работаем. Тем более , что информация об ошибке стандартным обработчиком иногда ни о чем. К примеру при открытом через ole excel читается текстовой файл параметров и если файла нет выдаёт discspace(0) при сотнях гигов свободного места Уже как то обсуждали , и мое мнение нужно не окно на пол экрана со стеком в цветах африканского авангарда,а удобный инструмент логирования ошибки, оправки лога разработчику и удобный вьюер этого лога. Пользователю достаточно обычного окна с уведомлениями о том что ситуация контролируется.
Отправлено: 12.10.25 10:15. Заголовок: Haz пишет Если не ус..
Haz пишет
цитата:
Если не устраивает стандартная процедура обработки, делаем свою с подробным протоколом и автоматической отправкой разработчику
УСТРАИВАЕТ ! Кроме окна сообщения MsgStop() или Alert и ничего лишнего не надо, все есть в параметрах пользовательского блока кода, что и куда девать это совсем др. вопрос
Отправлено: 12.10.25 12:01. Заголовок: Haz пишет: Уже как ..
Haz пишет:
цитата:
Уже как то обсуждали , и мое мнение нужно не окно на пол экрана со стеком в цветах африканского авангарда,а удобный инструмент логирования ошибки, оправки лога разработчику
Да это нужная вещь в программе. Сделал с помощью Сергея, недавно похожее, в новой версии МиниГуи пример - \SAMPLES\Advanced\Tsb_EventLog Запись ошибки и действий пользователя в dbf-файл.
Журнал событий в программе - запись действий пользователей в программе. Статистика выполнения(события программы) по операторам за периоды времени - кнопка "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
Принято с использованием этого параметра, как наиболее универсальный вариант. Если задано oCol:cPicture, то эта установка в приоритете, с возможностью включить ее использование с помощью параметра lPicture := .T., который по умолчанию задан, как lPicture := .F.
* 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.
Пока я НЕ знаю, когда будет опубликован этот релиз... Все зависит от интереса к этой работе у пользователей библиотеки.
Что-то описания нет в 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 нет в библиотеке. Хорошие же примеры, небольшие.
Отправлено: Вчера 14:25. Заголовок: sashaBG пишет Сначал..
sashaBG пишет
цитата:
Сначало собрать строку, а потом в ней искать совпадения:
По мне, такой вариант сравнения не совсем, а может и совсем, не корректен, т.к. например, 2а последних символа одного поля + 2а первых символа следующего, дадут .T. для cFind, а это не так, по отдельности поля не совпадают с cFind. Возможно, для такого поиска надо применять метод :FilterData(cFilter, ...), т.к. в выражении cFilter можете определять для себя, какие поля идут слитно, а какие по отдельности или собрать строку по записи и проверить на вхождение заданного фрагмента
Все даты в формате GMT
3 час. Хитов сегодня: 23
Права: смайлы да, картинки да, шрифты да, голосования нет
аватары да, автозамена ссылок вкл, премодерация откл, правка нет