Вылет из программы...

Форум » GUI » Вылет из программы... » Ответить

Вылет из программы...

Andrey: Всем привет ! Как можно в МиниГуи программе сделать вызов своих функций при аварийном завершении программы (т.е. при вылете) ? Т.е. хочу сделать сразу после появления MsgBox() вызов 2-3 функций и потом сделать DbCloseAll(). Как это реализовать ? Для чего это нужно, поясню: при входе в свою программу я пишу в базу кто и когда вошел в программу (логин пользователя). И при выходе из программы, стираю этого пользователя из базы. Если программа "вылетает", то юзер числится как работающий. Древнее наследие с клипера, хотел переделать, да так и осталось.

Ответов - 173, стр: 1 2 3 4 5 6 7 8 9 All

SergKis: Andrey пишет И как понять из-за чего свалилась программа ? тут Called from SITEDBFLOG(1093) in module: Source\form_site.prg Called from COPYPGSQL3ALGORITM(1293) in module: Source\form_site.prg Сообщение о ON RELEASE это уже следствие, т.к. окно нормальное, наверно, есть и окно WaitWindow висит индикатором.

Andrey: Понял тебя. Убрал нафиг это самописное окно, поставил стандартное и сделал вывод в лог-файл. Спасибо !

Andrey: Вот сегодняшняя ошибка у юзера. На кнопке вызываю контекстное меню - примерно как в примере SAMPLES\BASIC\Menu\menudemo6.prg У меня не вылетает, а у юзера 7 минут работы и вылет... Вот такая ошибка:[pre2] Time from start: 0 days 1 hours 7 mins 13 secs Error MGERROR/0 Form Form_3Card is not defined. Program terminated. --------------------------------- Stack Trace --------------------------------- Called from MSGMINIGUIERROR(100) in module: h_error.prg Called from GETFORMHANDLE(2248) in module: h_windows.prg Called from _DEFINECONTEXTMENU(709) in module: h_menu.prg Called from DYNAMICCONTEXTMENUEXTEND(159) in module: Source\menu_context.prg Called from SPISKI_MENU_PRINT(808) in module: Source\tsb_form_card.prg Called from (b)FORM_TSB_CARD(274) in module: Source\tsb_form_card.prg Called from DO_WINDOWEVENTPROCEDURE(82) in module: h_objmisc.prg Called from TWNDDATA:DOEVENT(726) in module: h_objects.prg Called from DO_ONWNDLAUNCH(250) in module: h_objmisc.prg Called from (b)INIT(123) in module: h_init.prg Called from EVENTS(1241) in module: h_events.prg Called from MYEVENTSHANDLER(1511) in module: Source\main.prg Called from DOMESSAGELOOP(0) Called from _ACTIVATEWINDOW(1516) in module: h_windows.prg Called from FORM_TSB_CARD(282) in module: Source\tsb_form_card.prg [/pre2] Вот код: [pre2] _ShowContextMenu(cForm, nY, nX, .F. ) ; InkeyGui(10) // menu runs through the queue RELEASE FONT Font_1dcm RELEASE FONT Font_2dcm DEFINE CONTEXT MENU OF &cForm // deleting menu after exiting - строка 159 END MENU [/pre2] И почему окно теряется ? Как исправить ?

SergKis: Andrey пишет И почему окно теряется ? Как исправить ? Почему нет окна, ты скорее ответишь. Исправить, как обычно[pre2] IF _IsWindowDefined( cForm ) DEFINE CONTEXT MENU OF &cForm // deleting menu after exiting - строка 159 END MENU ENDIF [/pre2]

Andrey: Появляется периодически вот такая ошибка: [pre2]Error BASE/2020 Неверный аргумент: PQRESULTSTATUS --------------------------------- Stack Trace --------------------------------- Called from PQRESULTSTATUS(0) Called from TPQSERVER:LISTTABLES(237) in module: tpostgre.prg Called from MYISTABLEPG(122) in module: Source\use_Postgres.prg Called from PGSQLMYOTVET(554) in module: Source\form_site2otvet.prg Called from DOWNLDOTVETMAST(354) in module: Source\form_site2otvet.prg Called from (b)SHOW_OTVETMASTER(198) in module: Source\form_site2otvet.prg [/pre2] Вылет идёт в модуле самой библиотеки. А как понять и исправить чтобы не вылетало ? Во второй программе такая же ошибка:[pre2] Error BASE/2020 Неверный аргумент: PQRESULTSTATUS</p> --------------------------------- Stack Trace --------------------------------- Called from PQRESULTSTATUS(0) Called from TPQSERVER:LISTTABLES(237) in module: tpostgre.prg Called from MYISTABLEPG(122) in module: use_Postgres.prg Called from PGSQLMYOTVET(616) in module: form_site3otvet.prg Called from DOWNLDOTVETMAST(544) in module: form_site3otvet.prg Called from (b)FORM_OTVETMASTER(269) in module: form_site3otvet.prg Called from DO_WINDOWEVENTPROCEDURE(82) in module: h_objmisc.prg Called from TWNDDATA:DOEVENT(726) in module: h_objects.prg Called from DO_ONWNDLAUNCH(250) in module: h_objmisc.prg Called from (b)INIT(123) in module: h_init.prg Called from EVENTS(1241) in module: h_events.prg[/pre2] Посмотрел сам исходник:[pre2] METHOD ListTables() CLASS TPQserver LOCAL result := {} LOCAL i LOCAL res := PQexec( ::pDB, ; "SELECT table_name" + ; " FROM information_schema.tables" + ; " WHERE table_schema = " + DataToSql( ::Schema ) + " AND table_type = 'BASE TABLE'" ) IF ( ::lError := PQresultStatus( res ) != PGRES_TUPLES_OK ) ::cError := PQresultErrorMessage( res ) ELSE FOR i := 1 TO PQlastrec( res ) AAdd( result, PQgetvalue( res, i, 1 ) ) NEXT ::cError := "" ENDIF RETURN result // строка 237 [/pre2] Мой исходник: [pre2] cPgTable := "response" // Проверка на существование таблицы lRet := MyIsTablePg( cPgTable, M->oServer ) IF !lRet ? "Нет таблицы ["+cPgTable+"] на СЕРВЕРЕ-БД !" // выводим надпись ...... // Проверка на существование таблицы FUNCTION MyIsTablePg( cNamePgTable, oSrvPg ) LOCAL oTbl, cTable, lSeek := .f. cTable := LOWER( cNamePgTable ) oTbl := oSrvPg:ListTables() // строка 122 ? ProcNL()[/pre2] Я библиотеку C:\MiniGUI\SOURCE\HbPgSql собрал ещё в 2017 году и так не менял. А нужно менять ?

SergKis: Andrey пишет А как понять и исправить чтобы не вылетало ? Ты уже приходил с таким вопросом и даже согласился использовать begin .. sequnce ... И где оно ... Например так сделать[pre2] FUNC aSrvPgListTables( oSrvPg, nWhl ) LOCAL lRet, oTbl Default nWhl := 10 WHILE nWhl-- > 0 lRet := .F. BEGIN SEQUENCE WITH { |e|break(e) } oTbl := oSrvPg:ListTables() lRet := .T. END SEQUENCE IF lRet ; EXIT ENDIF wApi_Sleep(100) END Default oTbl := {} RETU oTbl[/pre2] И замени oTbl := oSrvPg:ListTables() на oTbl := aSrvPgListTables(oSrvPg, 20) // ~ 2 сек. IF Empty(oTbl) ; MsgStop("Нет данных о таблице[ах]", "ERROR") ENDIF

Andrey: SergKis пишет: Ты уже приходил с таким вопросом и даже согласился использовать begin .. sequnce ... Да поставил дополнительно PQping( M->cPubPgConnInfo ) // проверка доступности сервера и пропала та ошибка, сейчас другая вылезла. Спасибо !

Andrey: Блин, как это достало... Переделал сохранение данных вместо формы на контейнер, т.е. на окно делаю так: [pre2] (This.Object):Cargo := oKeyData() // создать объект (контейнер) для окна &cFormName oCrg := (This.Object):Cargo oCrg:aGlobalSection := aGlobalSection oCrg:aRunFunc := {cGlobSection,cFormName,nTable} oCrg:cAlias := ALIAS() oCrg:aMemIndexOpen := aCargoMemIndexOpen ... и т.д. порядка 20 переменных[/pre2] Прога перестала падать в местах где читаю/записываю данные в контейнер. Всего 4 раза упала за этот день, и то 2 раза по ОДИНАКОВОЙ ошибке. Достижение. Классно ! Спасибо SergKis ! Но вот с выводом сообщений на форму - беда. Теперь там стала падать. Вот ошибка: [pre2]User: SERVER/User2/Алла 1раз - Time from start: 0 days 1 hours 16 mins 27 secs 2раз - Time from start: 0 days 3 hours 6 mins 56 secs Error MGERROR/0 Control: Label_Filter Of Form_Table_Abon Not defined. Program terminated. --------------------------------- Stack Trace --------------------------------- Called from MSGMINIGUIERROR(0) Called from VERIFYCONTROLDEFINED(0) Called from GETPROPERTY(0) Called from TSBLBL_FILTER(890) in module: Source\Tbrw_table.prg Called from MYINITFORMTABLE(839) in module: Source\Tbrw_table.prg Called from (b)FORM_MYTABLE(353) in module: Source\Tbrw_table.prg Called from DO_WINDOWEVENTPROCEDURE(0) Called from TWNDDATA:DOEVENT(0) Called from DO_ONWNDLAUNCH(0) Called from (b)INIT(0) Called from EVENTS(0) Called from MYEVENTSHANDLER(1539) in module: Source\main.prg Called from DOMESSAGELOOP(0) Called from _ACTIVATEWINDOW(0) Called from FORM_MYTABLE(706) in module: Source\Tbrw_table.prg Called from TBRWABONENT(36) in module: Source\Tbrw_1Run.prg Called from (b)HB_MACROBLOCK(0) .... [/pre2] Вот мой код: [pre2]FUNCTION TsbLbl_Filter(cForm, cLabel) LOCAL nLblWidth := GetProperty(cForm, "Label_Filter", "Width") // строка 890 LOCAL nSize := GetProperty(cForm, "Label_Filter", "FontSize" ) LOCAL cFont := GetProperty(cForm, "Label_Filter", "FontName" ) LOCAL cStroka := "Поиск: " + cLabel // nSize и cFont оставил для изменения шрифта для длиного текста SetProperty(cForm, "Label_Filter", "Value" , cStroka) SetProperty(cForm, "Label_Filter", "Tooltip" , cStroka) RETURN NIL[/pre2] И как эту ошибку обойти ? Куда делся объект Label_Filter с формы ? Форма на экране, объект тоже должен быть - ОКНО ЖЕ НЕ ЗАКРЫТО !

Andrey: Всем привет ! Хочу поделиться своим опытом по работе ТСБ в МиниГуи. Делал программу, одновременная работа одного модуля с пятью похожими таблицами. Кол-во полей для редактирования от 50 до 200. Прога создавалась с 2015 года, вроде работала, но коряво, постоянно терялись объекты на окнах и вылет программы. За день раз 10 программа могла упасть у одного пользователя, а если открывал несколько таблиц, то труба, обязательно упадёт. Пока не помог SergKis исправить данную ситуацию, перевести все на контейнер и события ! Огромное спасибо тебе SergKis ! Сейчас прога перестала вылетать на этом модуле. Правлю другие вылеты проги. Кому интересно, привожу заготовку как надо делать. На кнопки всегда ставлю НОМЕР события и имя объекта (имя кнопки), а уже в событие ставлю функции обработки. Писать код в событиях одно удовольствие. В ини-файле описываю все поля, цвета, кнопки таблицы, иконки, фонты и т.д. [pre2][Section_Dogovor] Поля_БД = { "NDOG", "DateDog", ....} Поля_карточки = { "NDOG", "DateDog", ....} Название_полей_карточки = { "Номер договора", "Дата договора", ....} [Tsb_Dogovor/Таблица_Настройки] Font_0=------------ фонты таблицы ----------------- Font_1={"Tahoma", 18, .F., .F.} Font_2={"Times New Roman", 18, .T., .F.} Font_3={"Times New Roman", 18, .F., .F.} Font_4={"Arial Black", 20, .T., .F.} Font_5={"DejaVu Sans Mono", 18, .F., .F.} Font_6={"Snap ITC", 20, .T., .F.} Font_7={"Comic Sans MS", 12, .T., .F.} HandleFont_1=Font_Tsb_Cell1 HandleFont_2=Font_Tsb_Head1 HandleFont_3=Font_Tsb_Foot1 HandleFont_4=Font_Tsb_SpcHd1 HandleFont_5=Font_Tsb_Edit1 HandleFont_6=Font_Tsb_SuperHd1 HandleFont_7=Font_Tsb_DelRecno1 SizeColonm={115, 30, 142, 123, 655, 142, 138, 127, 149, 151, 190, 265, 265, 213, 0, 0} .......... [Section_Abonent] .......... [/pre2] Примерный шаблон программы: [pre2]Вызов на кнопках c главного меню программы: FormMyTable("Form_Dogovor",1,"Section_Dogovor",....) FormMyTable("Form_Abonent",2,"Section_Abonent",....) ..... FormMyTable("Form_Oplata",5,"Section_Oplata",....) FUNCTION FormMyTable(cFormName,nTable,cIniSection,....) IF !_IsWindowActive( cFormName ) PRIVATE oBrw // создать окно ожидания aBegin := WaitWinCreate( 'Создаю таблицу ...' ) // считывание фонтов таблицы из ини-файла IniGetTbrwFont(cIniSection+"/Таблица_Настройки", @aTableFont, @aTableHndlFont) // задать все используемые фонты cTbl := HB_NtoS(nTable) aTsbFont := {"Font_Tsb_Cell" +cTbl, "Font_Tsb_Head" +cTbl, ; "Font_Tsb_Foot" +cTbl, "Font_Tsb_SpcHd"+cTbl, ; "Font_Tsb_Edit" +cTbl } DEFINE WINDOW &cFormName At 0, 0 ; WIDTH nWinWidth HEIGHT nWinHeight ; TITLE cTitle ICON cIco ; WINDOWTYPE STANDARD TOPMOST ; NOMAXIMIZE NOSIZE ; BACKCOLOR aBackColor ; FONT cFont SIZE nFontSize ; ON INIT {|| DoEvents(), _wPost(1) } ; // !!! обязательно DoEvents() ON RELEASE { || DoMethod( "Form_Main", "Restore" ) } ..... (This.Object):Cargo := oKeyData() // создать объект (контейнер) для окна &cFormName oCrg := (This.Object):Cargo oCrg:cAlias := ALIAS() oCrg:aTsbFilter := {} oCrg:aTsbSort := {} oCrg:aTsbField := GetProfile( cIniSection, "Поля_БД", {} ) oCrg:aCardField := GetProfile( cIniSection, "Поля_карточки", {} ) oCrg:aCardName := GetProfile( cIniSection, "Название_полей_карточки", {} ) oCrg:aWinUpColor := GetProfile( cIniSection, "Цвет_фона_верх_формы", BLACK ) oCrg:aBackColor := GetProfile( cIniSection, "Цвет_фона_всей_формы", BLACK ) oCrg:lDeletedView := .F. // отключить флаг показа удал.записей oCrg:aUpMenu2Button := GetProfile( cIniSection, "Кнопки_верху_таблицы", {} ) // объекты верхних кнопок ..... oCrg:nTable := nTable // номер таблицы oCrg:cFont := cFont oCrg:nFontSize := nFontSize oCrg:nTsbFootCol := GetProfile( cIniSection, "Показ_строки_подвала_итого", 2 ) // кнопки меню вверху окна aUpTBar := myUpBarTable(cFormName,nTable,..) nWinHUp := aUpTBar[1] // высота кнопок + отступы кнопок nWinXUp := aUpTBar[2] + 10 // конец всех кнопок ..... nHUp := nWinHUp @ nHUp, 0 LABEL Label_Filter VALUE "Поиск: нет" WIDTH nW/2 HEIGHT 40 ... @ nHUp, nW/2 LABEL Label_Sort VALUE "Сортировка: нет" WIDTH nW/2 HEIGHT 40 ... ..... Select(Select(cBaseMain)) oCrg:cAlias := ALIAS() goto TOP nY := This.Label_Filter.Row + This.Label_Filter.Height + 1 DEFINE TBROWSE oBrw AT nY,nX WIDTH nW HEIGHT nH CELL ; FONT aTsbFont ; ON CHANGE {|ob| ChangeBrowse(ob) } ; ON GOTFOCUS {|ob| ChangeBrowse(ob) } ; BACKCOLOR aBackColor ; ON INIT {|ob| ; ob:nColOrder := 0 ,; // убрать значок сортировки по полю ob:lNoChangeOrd := .T.,; // убрать сортировку по полю ob:nWheelLines := 1 ,; // прокрутка колесом мыши с шагом ... ob:lNoGrayBar := .F.,; // показывать неактивный курсор в таблице ob:lNoLiteBar := .F.,; // при переключении фокуса на другое окно не убирать "легкий" Bar ob:lNoResetPos := .F.,; // предотвращает сброс позиции записи на gotfocus ob:lNoPopUp := .T.,; // избегает всплывающее меню при щелчке правой кнопкой мыши по заголовку столбца ob:nStatusItem := 0 ,; // в 1-й Item StatusBar не выводить автоматом из тсб ob:lPickerMode := .F.,; // формат даты нормальный ob:nCellMarginLR := 1 ; // отступ от линии ячейки при прижатии влево, вправо на кол-во пробелов } // !!! только эти установки в ON INIT !!! oBrw:lCheckBoxAllReturn := .T. // Enter modify value oCol:lCheckBox sBrw( nTable, oBrw) // запомнить oBrw по номеру nTable CreateBrowseTable(cFormName,nTable) // создать таблицу: поля, цвета и т.д. oBrw:nCell := 3 // передвинуть МАРКЕР на 3 колонку END TBROWSE {|ob| ob:SetNoHoles(), ob:SetFocus(), ob:Refresh() } CreateBrowseContextMenu(cFormName,nTable) // контекстное меню ТСБ // на окне oCrg:nWinHUp := nWinHUp // для правки заголовка верха меню oCrg:oBrw := oBrw // сам объект таблица // НОМЕР СОБЫТИЯ кнопок или показа: 0, 1, 3, 4, 5, 6, 7, 10, 40, 90, 100 и т.д. WITH OBJECT This.Object :Event( 0, {|ow,ky,ob| MsgBox(hb_ntos(ky)+": "+ob:cControlName+" Value "+; cValToChar(ob:GetValue(ob:nCell)), "INFO-"+ow:Name) } ) :Event( 1, {|ow| This.Topmost := .F., myInitFormTable(ow) } ) :Event( 3, {| | // Помощь / О таблице LOCAL hHandle hHandle := ThisWindow.Handle This.oBut_Help.Enabled := .F. Darken2Open(hHandle) MyHelpTable(cFormName,nTable) Darken2Close(hHandle) This.oBut_Help.Enabled := .T. Tsb4Focus(nTable) Return Nil } ) :Event( 6, {|ow,ky,aRSort| // Label_Sort LOCAL nWidth, nSize, cFont, cStr LOCAL cLbl := "Label_Sort", cForm := ow:Name ky := LEN(aRSort) > 0 cStr := "Сортировка: " + iif( ky, aRSort[1], "нет" ) ow:Cargo:aTsbSort := aRSort IF _IsControlDefined(cLbl, cForm) nWidth := GetProperty(cForm, cLbl, "Width") nSize := GetProperty(cForm, cLbl, "FontSize" ) cFont := GetProperty(cForm, cLbl, "FontName" ) SetProperty(cForm, cLbl, "Value" , cStr) ELSE myLogTbrw("*** ERROR *** LABEL "+cLbl+" not found ! FormName =", cForm, nTable ) ENDIF RETURN NIL } ) :Event( 7, {|ow,ky,cStr| // Label_Filter LOCAL nWidth, nSize, cFont LOCAL cLbl := "Label_Filter", cForm := ow:Name ky := "Поиск: " cStr := ky + cStr IF _IsControlDefined(cLbl, cForm) nWidth := GetProperty(cForm, cLbl, "Width") nSize := GetProperty(cForm, cLbl, "FontSize" ) cFont := GetProperty(cForm, cLbl, "FontName" ) SetProperty(cForm, cLbl, "Value" , cStr) ELSE myLogTbrw("*** ERROR *** LABEL "+cLbl+" not found ! FormName =", cForm, nTable ) ENDIF RETURN NIL } ) :Event(10, {|ow,ky,cBtn| // вызов Карточка / oBut_Card LOCAL oBrw := ow:Cargo:oBrw SetProperty(ow:Name, cBtn, "Enabled", .F.) ky := 110 // переназначаем на новое событие _wSend(ky, oBrw:cParentWnd, oBrw) SetProperty(ow:Name, cBtn, "Enabled", .T.) Tsb4Focus(nTable) Return Nil } ) :Event(90, {|ow| This.oBut_Exit.Enabled := .F. ,; // Выход TsbCloseIndex(ow:Name,nTable) ,; ReleaseTableFont(nTable,"удалить фонты") ,; _wSend(99) } ) :Event(99, {|ow| ow:Release() } ) :Event(110, {|ow,ky,oBrw| // ---------- Показ Карточки ------------ LOCAL cParent := "", nValButton := 0 // не использую LOCAL cForm := ow:Name LOCAL hWnd := ow:Handle Darken2Open(ow:Handle) // затенение ? ProcNL() ? This.Name, ThisWindow.Name, Application.Handle, hWnd ? ky, ow:Name, oBrw:cAlias SetWaitCursor( Application.Handle ) SetCursorSystem( IDC_WAIT ) SetWaitCursor( hWnd ) // Курсор мышки - ожидание myCard(oBrw, nTable, ... ) // сама карточка Darken2Close(ow:Handle) // убрать затенение Tsb4Focus(nTable) Return Nil } ) END WITH ON KEY .... END WINDOW DoMethod( cFormName, "Center" ) ACTIVATE WINDOW &cFormName ON INIT {|| SetProperty(cFormName, "Topmost", .T.) } ELSE // !IsWindowActive() SwitchToWin( cFormName ) // переключить на тек.форму Tsb4Focus(nTable) ENDIF // !IsWindowActive() RETURN NIL //////////////////////////////////////////////////////////////////// STATIC FUNCTION ChangeBrowse(oBrw) LOCAL o, cVal, cLen, nLen, aItogo, nColFoot, cFormName, nTable .......... SET WINDOW THIS TO oBrw // использовать данные из контейнера cFormName := This.Name o := This.Cargo nTable := o:nTable nColFoot := o:nTsbFootCol aItogo := o:aItogo ....... cVal := HB_NToS( (oBrw:cAlias)->(OrdKeyNo()) ) nLen := (oBrw:cAlias)->(OrdKeyCount()) oBrw:aColumns[1]:cFooting := { || ALLTRIM(Transform( nLen, "9 999 999" )) } oBrw:aColumns[nColFoot]:cFooting := { || " Записи: " + cVal + "/" + cLen } oBrw:DrawFooters() // выполнить прорисовку подвала SET WINDOW THIS TO RETURN Nil /////////////////////////////////////////////////////////////////////////////// // вывод кнопок верхнего меню STATIC FUNCTION myUpBarTable(cFormName,nTable,....) ............ aObj2 := Data_UpMenu(nTable) aRBtn := aObj2[1] aCBtn := aObj2[2] aWBtn := aObj2[3] aHBtn := aObj2[4] aBtnObj := aObj2[5] aBtnCap := aObj2[6] aGrd1Clr := aObj2[7] aGrd2Clr := aObj2[8] aBtnIco := aObj2[9] a2FntClr := aObj2[10] a4BtnFont := aObj2[11] aBtnPst := aObj2[12] ..... // вывод кнопок на форму FOR nI := 1 TO Len(aBtnCap) cCapt := ATREPL( ";", aBtnCap[nI], CRLF ) nPost := aBtnPst[nI] // цифры - событие на кнопке aGrad := { aGrd1Clr[nI], aGrd2Clr[nI] } my2BUTTON(aRBtn[nI], aCBtn[nI], aWBtn[nI], aHBtn[nI], aBtnObj[nI], cCapt,; aGrad, , aBtnIco[nI], a2FntClr[nI], a4BtnFont[nI], nPost ) NEXT /////////////////////////////////////////////////////////////////////////////// // считать в массив названия,цвет,иконки,ширину кнопки и т.д. // можно сделать и чтение из ини-файла STATIC FUNCTION Data_UpMenu(nTable) ............... nW := GetDesktopWidth() cIcoXX := IIF( nW >= 1280, "64", "48" ) // размер иконки IF nTable == 1 aBtnCap := { "", "Карта","Карточка","Добавить;запись", ....} aBtnIco := { {"iMaps"+cIcoXX+"x1" ,"iMaps"+cIcoXX+"x2" } ,; {"iEditCard"+cIcoXX+"x1","iEditCard"+cIcoXX+"x2"} ,; {"iInsert"+cIcoXX+"x1","iInsert"+cIcoXX+"x2"} ,; ..... {"iExit"+cIcoXX+"x1" ,"iExit"+cIcoXX+"x2" } } aBtnClr := { aMainIcoBCls ,; // 1 Помощь COLOR_BLUE_VK ,; // 2 Карта COLOR_DARK_GREY ,; // 3 Карточка COLOR_DARK_GREY ,; // 4 Добавить запись ....... COLOR_RED_METRO } // 13 Выход aBtnObj := { "oBut_Help" , "oBut_Maps" , "oBut_Card" , "oBut_Ins", .... } aBtnPst := { 3, 4, 10, 11, 22, 20, 21, 50, 70, 60, 80, 85, 90 } // _wPost(Х) ELSEIF nTable == 2 // таблица: Список абонентов .............. [/pre2] Полная функция вывода кнопки: [pre2]///////////////////////////////////////////////////////////////////////////////////////////// FUNCTION my2BUTTON(y, x, w, h, cObj, cCapt, aBtnGrad, aBtnClr, aIcon, aFntClr, aFnt, nwPost ) LOCAL aGrOver, aGrFill, nSizeIcon, lSizeIcon, y1, x1, lTextVertical, cForm DEFAULT cCapt := "" , aFntClr := { BLACK, YELLOW } DEFAULT aFnt := { "Tahona", 12 , .T. , .F. } , aIcon := {"Icon1x1","Icon1x1",.F.,48} DEFAULT aBtnGrad := {} , aBtnClr := { BLUE, YELLOW } cForm := _HMG_ThisFormName IF LEN(aFnt) == 4 lTextVertical := aFnt[4] // VERTICAL ELSE lTextVertical := .F. ENDIF IF LEN(aIcon) < 3 ; lSizeIcon := .F. ELSE ; lSizeIcon := aIcon[3] ENDIF IF LEN(aIcon) < 4 ; nSizeIcon := 32 ELSE ; nSizeIcon := aIcon[4] ENDIF IF LEN(aBtnGrad) > 0 aGrOver := { { 0.5, aBtnGrad[2], aBtnGrad[1] }, { 0.5, aBtnGrad[1], aBtnGrad[2] } } aGrFill := { { 0.5, aBtnGrad[1], aBtnGrad[2] }, { 0.5, aBtnGrad[2], aBtnGrad[1] } } IF lSizeIcon IF lTextVertical // VERTICAL @ y, x BUTTONEX &cObj PARENT &cForm WIDTH w HEIGHT h CAPTION cCapt ICON aIcon[1] ; NOXPSTYLE HANDCURSOR NOTABSTOP ; BACKCOLOR aGrOver GRADIENTFILL aGrFill ; FONT aFnt[1] SIZE aFnt[2] BOLD VERTICAL ; ON MOUSEHOVER ( This.GradientFill := aGrFill , This.Fontcolor := aFntClr[2] ,; This.Icon := LoadIconByName(aIcon[2], nSizeIcon, nSizeIcon) ) ; ON MOUSELEAVE ( This.GradientOver := aGrOver , This.Fontcolor := aFntClr[1] ,; This.Icon := LoadIconByName(aIcon[1], nSizeIcon, nSizeIcon) ) ; ON INIT {|| This.Cargo := nwPost } ; ACTION _wPost(This.Cargo, , This.Name) ELSE @ y, x BUTTONEX &cObj PARENT &cForm WIDTH w HEIGHT h CAPTION cCapt ICON aIcon[1] ; NOXPSTYLE HANDCURSOR NOTABSTOP ; BACKCOLOR aGrOver GRADIENTFILL aGrFill ; FONT aFnt[1] SIZE aFnt[2] BOLD ; ON MOUSEHOVER ( This.GradientFill := aGrFill , This.Fontcolor := aFntClr[2] ,; This.Icon := LoadIconByName(aIcon[2], nSizeIcon, nSizeIcon) ) ; ON MOUSELEAVE ( This.GradientOver := aGrOver , This.Fontcolor := aFntClr[1] ,; This.Icon := LoadIconByName(aIcon[1], nSizeIcon, nSizeIcon) ) ; ON INIT {|| This.Cargo := nwPost } ; ACTION _wPost(This.Cargo, , This.Name) ENDIF // при первом построении изменить размер иконки This.&(cObj).Icon := LoadIconByName( aIcon[1], nSizeIcon, nSizeIcon ) ELSE IF lTextVertical // VERTICAL @ y, x BUTTONEX &cObj PARENT &cForm WIDTH w HEIGHT h CAPTION cCapt ICON aIcon[1] ; NOXPSTYLE HANDCURSOR NOTABSTOP ; BACKCOLOR aGrOver GRADIENTFILL aGrFill ; FONT aFnt[1] SIZE aFnt[2] BOLD VERTICAL ; ON MOUSEHOVER ( This.GradientFill := aGrFill , This.Icon := aIcon[2] ,; This.Fontcolor := aFntClr[2] ) ; ON MOUSELEAVE ( This.GradientOver := aGrOver , This.Icon := aIcon[1] ,; This.Fontcolor := aFntClr[1] ) ; ON INIT {|| This.Cargo := nwPost } ; ACTION _wPost(This.Cargo, , This.Name) ELSE @ y, x BUTTONEX &cObj PARENT &cForm WIDTH w HEIGHT h CAPTION cCapt ICON aIcon[1] ; NOXPSTYLE HANDCURSOR NOTABSTOP ; BACKCOLOR aGrOver GRADIENTFILL aGrFill ; FONT aFnt[1] SIZE aFnt[2] BOLD ; ON MOUSEHOVER ( This.GradientFill := aGrFill , This.Icon := aIcon[2] ,; This.Fontcolor := aFntClr[2] ) ; ON MOUSELEAVE ( This.GradientOver := aGrOver , This.Icon := aIcon[1] ,; This.Fontcolor := aFntClr[1] ) ; ON INIT {|| This.Cargo := nwPost } ; ACTION _wPost(This.Cargo, , This.Name) ENDIF ENDIF ELSE IF lSizeIcon IF lTextVertical // VERTICAL @ y, x BUTTONEX &cObj PARENT &cForm WIDTH w HEIGHT h CAPTION cCapt ICON aIcon[1] ; NOXPSTYLE HANDCURSOR NOTABSTOP BACKCOLOR aBtnClr[1] ; FONT aFnt[1] SIZE aFnt[2] BOLD VERTICAL ; ON MOUSEHOVER ( This.Backcolor := aBtnClr[2] , This.Fontcolor := aFntClr[2] ,; This.Icon := LoadIconByName(aIcon[2],nSizeIcon,nSizeIcon) ); ON MOUSELEAVE ( This.Backcolor := aBtnClr[1] , This.Fontcolor := aFntClr[1] ,; This.Icon := LoadIconByName(aIcon[1],nSizeIcon,nSizeIcon) ); ON INIT {|| This.Cargo := nwPost } ; ACTION _wPost(This.Cargo, , This.Name) ELSE @ y, x BUTTONEX &cObj PARENT &cForm WIDTH w HEIGHT h CAPTION cCapt ICON aIcon[1] ; NOXPSTYLE HANDCURSOR NOTABSTOP BACKCOLOR aBtnClr[1] ; FONT aFnt[1] SIZE aFnt[2] BOLD ; ON MOUSEHOVER ( This.Backcolor := aBtnClr[2] , This.Fontcolor := aFntClr[2] ,; This.Icon := LoadIconByName(aIcon[2],nSizeIcon,nSizeIcon) ); ON MOUSELEAVE ( This.Backcolor := aBtnClr[1] , This.Fontcolor := aFntClr[1] ,; This.Icon := LoadIconByName(aIcon[1],nSizeIcon,nSizeIcon) ); ON INIT {|| This.Cargo := nwPost } ; ACTION _wPost(This.Cargo, , This.Name) ENDIF // при первом построении изменить размер иконки This.&(cObj).Icon := LoadIconByName( aIcon[1], nSizeIcon, nSizeIcon ) ELSE IF lTextVertical // VERTICAL @ y, x BUTTONEX &cObj PARENT &cForm WIDTH w HEIGHT h CAPTION cCapt ICON aIcon[1] ; NOXPSTYLE HANDCURSOR NOTABSTOP BACKCOLOR aBtnClr[1] ; FONT aFnt[1] SIZE aFnt[2] BOLD VERTICAL ; ON MOUSEHOVER ( This.Backcolor := aBtnClr[2] , This.Icon := aIcon[2] ,; This.Fontcolor := aFntClr[2] ) ; ON MOUSELEAVE ( This.Backcolor := aBtnClr[1] , This.Icon := aIcon[1] ,; This.Fontcolor := aFntClr[1] ) ; ON INIT {|| This.Cargo := nwPost } ; ACTION _wPost(This.Cargo, , This.Name) ELSE @ y, x BUTTONEX &cObj PARENT &cForm WIDTH w HEIGHT h CAPTION cCapt ICON aIcon[1] ; NOXPSTYLE HANDCURSOR NOTABSTOP BACKCOLOR aBtnClr[1] ; FONT aFnt[1] SIZE aFnt[2] BOLD ; ON MOUSEHOVER ( This.Backcolor := aBtnClr[2] , This.Icon := aIcon[2] ,; This.Fontcolor := aFntClr[2] ) ; ON MOUSELEAVE ( This.Backcolor := aBtnClr[1] , This.Icon := aIcon[1] ,; This.Fontcolor := aFntClr[1] ) ; ON INIT {|| This.Cargo := nwPost } ; ACTION _wPost(This.Cargo, , This.Name) ENDIF ENDIF ENDIF y1 := y + This.&(cObj).Height x1 := x + This.&(cObj).Width RETURN { y1, x1 }[/pre2]

Andrey: Очередной вылет из программы: [pre2]Error DBFCDX/1022 Требуется блокировка --------------------------------- Stack Trace --------------------------------- Called from FIELDPUT(0) Called from MYSAVECARD(2737) in module: Source\Tbrw_fCard.prg Called from (b)MYCARDFIELDGETBOX(1983) in module: Source\Tbrw_fCard.prg Called from _DOCONTROLEVENTPROCEDURE(0) Called from EVENTS(0) Called from MYEVENTSHANDLER(1554) in module: Source\main.prg Called from DOMESSAGELOOP(0) Called from _ACTIVATEWINDOW(0) Called from SHOW_CARD(373) in module: Source\Tbrw_fCard.prg Called from MYCARDTABLE(3362) in module: Source\Tbrw_table.prg Called from MYACTIONENTER(1604) in module: Source\Tbrw_table.prg Called from (b)FORM_MYTABLE(688) in module: Source\Tbrw_table.prg Called from DO_WINDOWEVENTPROCEDURE(0) Called from TWNDDATA:DOEVENT(0) Called from DO_ONWNDLAUNCH(0) Called from (b)INIT(0) Called from EVENTS(0) [/pre2] Вот код программы:[pre2] // сетевой захват записи IF (cAlias)->(RLock()) FOR nI := 1 TO LEN(aStatEditFields) cObj := aStatEditFields[ nI, 1 ] cFld := aStatEditFields[ nI, 2 ] If ( nPos := FieldPos(cFld) ) > 0 FieldPut( nPos, _GetValue(cObj, cForm) ) // строка 2737 //MsgLog(nI,cObj,cFld, _GetValue(cObj, cForm) ) EndIf NEXT (cAlias)->KOPERAT := M->nOperat (cAlias)->DATEVVOD := DATE()[/pre2] Почему вылет, что не так делаю ?

Dima: (cAlias)->(FieldPut(..........

Andrey: Спасибо Dima ! Уже про это Сергей писал, да я код старый перекинул, торопился и вот результат... Ошибка плавающая, вылазит только когда несколько таблиц открываю, т.е. после переключения между таблицами.

Dima: Andrey пишет: Ошибка плавающая, вылазит только когда несколько таблиц открываю Не забывай всегда (где он допустим) указывать (cAlias)-> , ну ты понял , надеюсь......

SergKis: Andrey пишет If ( nPos := FieldPos(cFld) ) > 0 FieldPut( nPos, _GetValue(cObj, cForm) ) // строка 2737 //MsgLog(nI,cObj,cFld, _GetValue(cObj, cForm) ) EndIf Уже предлагал тебе использовать объект-контейнер для работы с записями dbf (думаю, ошибок будет меньше) Повторю твой код, но с объектом LOCAL oRec := oKeyData() ... oRec:&(cFld) := _GetValue(cObj, cForm) oRec:KOPERAT := M->nOperat oRec:DATEVVOD := DATE() ... IF (cAlias)->( RLock() ) (cAlias)->( oRecPut(oRec) ) (cAlias)->( dbUnLock() ) ENDIF Выкладывал ф-ии, повторю что бы не искать [pre2] *----------------------------------------------------------------------------* FUNCTION oRecGet( aField, oRec ) *----------------------------------------------------------------------------* LOCAL cFld, nPos Default oRec := oKeyData() IF ISCHAR(aField) aField := alltrim(aField) IF left(aField, 1) == "{" .and. right(aField, 1) == "}" aField := &aField ELSE aField := hb_ATokens(aField, ",") ENDIF ENDIF IF ISARRAY(aField) FOR EACH cFld IN aField IF Empty( cFld ) ; LOOP ELSEIF ISARRAY(cFld) ; cFld := cFld[1] // массив как структура ENDIF cFld := alltrim(cFld) IF ( nPos := FieldPos(cFld) ) > 0 oRec:Set( trim(FieldName(nPos)), FieldGet(nPos) ) ENDIF NEXT ELSE AEval( Array( FCount() ), {|v,n| v:=n, oRec:Set( trim(FieldName(n)), FieldGet(n) ) } ) ENDIF RETURN oRec *----------------------------------------------------------------------------* FUNCTION oRecPut( oRec, aField ) *----------------------------------------------------------------------------* LOCAL aFld, cFld, nPos, xVal, nCnt := 0 IF ISCHAR( aField ) aField := alltrim(aField) IF left(aField, 1) == "{" .and. right(aField, 1) == "}" aField := &aField ELSE aField := hb_ATokens(aField, ",") ENDIF ENDIF IF ISARRAY( aField ) FOR EACH cFld IN aField IF ISARRAY(cFld) ; cFld := aFld[1] // массив как структура ENDIF IF Empty( cFld ) ; LOOP ENDIF cFld := upper(alltrim( cFld )) xVal := oRec:Get( cFld ) IF xVal == NIL ; LOOP ENDIF IF ( nPos := FieldPos(cFld) ) > 0 IF FieldType( nPos ) $ "+^="; LOOP // защита записи ENDIF FieldPut( nPos, xVal ) nCnt++ ENDIF NEXT ELSE FOR EACH aFld IN oRec:GetAll(.F.) cFld := aFld[1] IF Empty(cFld) .or. aFld[2] == NIL ; LOOP ENDIF IF ( nPos := FieldPos(cFld) ) > 0 IF FieldType( nPos ) $ "+^="; LOOP // защита записи ENDIF FieldPut( nPos, aFld[2] ) nCnt++ ENDIF NEXT ENDIF RETURN nCnt > 0 [/pre2]

Andrey: Спасибо БОЛЬШОЕ ! Этот код ещё в 2016 делал, перетаскивал из терминалки.

Andrey: Продолжаю бороться с ошибками в своей программе. У меня прога не вылетает, а у юзера иногда вылетает. Вот код такой: [pre2]DEFINE WINDOW Form_SeekAdr ; .... @ nRow, 550 BUTTONEX Button_Street WIDTH 44 HEIGHT nFontSize*2 ; CAPTION "?" FONTCOLOR BLACK BOLD NOXPSTYLE HANDCURSOR NOTABSTOP ; ACTION {|| aRet2 := SelectStreet(nCity) ,; // показ другого окна MODAL со списком улиц IF( LEN(aRet2) == 0, cStreet := "", cStreet := aRet2[2] ) ,; Form_SeekAdr.GetBox_CDom.Value := "" ,; Form_SeekAdr.GetBox_CStro.Value := "" ,; Form_SeekAdr.GetBox_CKorp.Value := "" ,; Form_SeekAdr.GetBox_CPdzd.Value := "" ,; Form_SeekAdr.GetBox_CKvar.Value := "" ,; cDom := cStro := cKorp := cPdzd := cKvar := "" ,; Form_SeekAdr.Label_Street.Value := " "+cStreet ,; SayLabelAdres(2,cCity,cStreet) ,; MyFocus() } // ошибка !!! строка 314 [/pre2] Ошибка у юзера: [pre2]Time from start: 0 days 5 hours 2 mins 54 secs Error MGERROR/0 Control: GetBox_CDom Of Form_SeekAdr Not defined. Program terminated. --------------------------------- Stack Trace --------------------------------- Called from MSGMINIGUIERROR(0) Called from VERIFYCONTROLDEFINED(0) Called from SETPROPERTY(0) Called from (b)FORM_F7ADRES(314) in module: Source\table_F7Adres.prg Called from _DOCONTROLEVENTPROCEDURE(0) Called from EVENTS(0) Called from MYEVENTSHANDLER(1554) in module: Source\main.prg Called from DOMESSAGELOOP(0) Called from _ACTIVATEWINDOW(0) Called from FORM_F7ADRES(459) in module: Source\table_F7Adres.prg [/pre2] Почему так происходит ? Как избавиться от этой ошибки ?

Andrey: Вот такая у меня ошибка: [pre2]Error BASE/1102 Неверный аргумент: UPPER Args: [1] = U --------------------------------- Stack Trace --------------------------------- Called from UPPER(0) Called from (b)TCNLDATA(795) in module: h_objects.prg Called from TCNLDATA:DEL(0) Called from (b)TCNLDATA(834) in module: h_objects.prg Called from TCNLDATA:DESTROY(0) Called from TWNDDATA:__msgDestructor(736) in module: h_objects.prg Called from SHELLEXECUTE(0) Called from PRINT_A81(1437) in module: Source\table_f5sklad4.prg Called from (b)FORM_A81(1029) in module: Source\table_f5sklad4.prg [/pre2] Строка 1437 - ShellExecute( , "Open", cFileLog,,, 1 )

Dima: Andrey пишет: Error BASE/1102 Неверный аргумент: UPPER Args: [1] = U Ну так и проверь что у тебя попадает в качестве параметра в функцию UPPER

Andrey: Dima пишет: Ну так и проверь что у тебя попадает в качестве параметра в функцию UPPER Это не у меня попадает. Я вызываю ShellExecute( , "Open", cFileLog,,, 1 ), блокнот поднимается с файлом, а потом наступает КРАХ программы. Почему ? Я ещё вижу в блокноте - две строчки ENTER-ом сдвигает. Хотя ничего не посылаю блокноту. Вот этот код почему срабатывает ? [pre2]Called from UPPER(0) Called from (b)TCNLDATA(795) in module: h_objects.prg Called from TCNLDATA:DEL(0) Called from (b)TCNLDATA(834) in module: h_objects.prg Called from TCNLDATA:DESTROY(0) Called from TWNDDATA:__msgDestructor(736) in module: h_objects.prg[/pre2]

PSP: Andrey пишет: UPPER Args: [1] = U Это означает, что первый аргумент функции Upper имеет тип Undefined. Вот и проверяй, что за херня в cFileLog в этот момент содержится.

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