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

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

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

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

gfilatov: Обновил сборку компилятора Харбор 1.1.0 для BCC 5.5.1 (Harbour MiniGUI Extended Distribution) по адресу: http://minigui.mylivepage.ru/file/?fileid=6753 и xHarbour 1.2.0 (Rev. 6371) для BCC 5.5.1 (CVS 2009-02-08 19:39) по адресу: http://minigui.mylivepage.ru/file/?fileid=6752

krutoff: Удалил Папку xHarbour Удалил папки Lib, xLib, Source из MiniGUI Поставил новую версию xHarbour 1.2.0 (6371) с hbzip.lib Установил релиз 1.6-62 Запустил MakeAllLibs.bat - все библиотеки сформировались. Но... Пример Zip дает те же неразрешимые ссылки и еще заметил, что при сборке DBView: Error: Unresolved external '_HB_FUN_HB_CODEPAGE_RU1251' referenced from C:\MINIGUI\SAMPLES\APPLICATIONS\DBFVIEW\SOURCE\DBFVIEW.OBJ

SkyNET: krutoff пишет: HB_CODEPAGE_RU1251 Так это русская кодировка ! Нужна библиотека codepage.lib !


krutoff: Библиотека codepage.lib, как и все остальные необходимые там есть. При восстановлении старой версии xHarbour 1.1.0 (и старой hbzip.lib) и предыдущей версии MakeLib.Bat с ключом -w2 и все работает.

gfilatov: Обновил с учетом последних изменений IDE на сайте http://minigui.mylivepage.ru по адресу: http://minigui.mylivepage.ru/file/?fileid=6833 Что нового: - исправление обнаруженных ошибок; - добавлена возможность переносить элементы управления с одной вкладки на другую в Tab.

gfilatov: Новый релиз библиотеки выложил по адресу: http://minigui.mylivepage.ru/file/?fileid=6845 а также, как обычно, на сервере http://hmgextended.com по адресу: http://hmgextended.com/files/CONTRIB/hmg-1.6-63-setup.zip Кратко, что нового: - чистка Си-кода для устранения устаревших Си-конструкций в [x]Harbour; - новый элемент управления Folder, свойство TopMost для окон; - Browse в режиме построчного редактирования может обращаться к связанным базам, используя их алиас; - исправления в библиотеке HbSqlDD; - обновлены сборки Харбор и HMGS-IDE, а также HbSQLite3; - обновлены некоторые старые примеры. Желаю всем удачной выкачки!

krutoff: Народ, откликнитесь! Что, у всех идет версия 1.6-62, 1.6-63 на xHarbour'е, или это я только такой неумеха ?

gfilatov: krutoff пишет: у всех идет версия 1.6-62, 1.6-63 на xHarbour'е Да, у меня работает без проблем на примерах из папки samples\Basic Для проверки использовал xHarbour Compiler build 1.2.0 (SimpLex) (Rev. 6371) Harbour Build Info --------------------------- Version: xHarbour build 1.2.0 Intl. (SimpLex) (Rev. 6371) PCode Version: 10 Compiler: Borland C++ 5.5.1 (32 bit) Built on: Feb 9 2009 14:37:26 Last ChangeLog entry: 2009-02-08 19:39 UTC-0600 Vicente Guerra <vicente@guerra.com.mx> ChangeLog CVS version: ChangeLog,v 1.6371 2009/02/09 01:42:19 guerra000 Exp Harbour extensions: Yes CA-Clipper 5.2e undocumented: Yes CA-Clipper 5.2e strict compatibility: No CA-Clipper 5.3x compatible extensions: Yes Alaska Xbase++ compatible extensions: Yes CA-Visual Objects compatible extensions: No Multisoft Flagship compatible extensions: Yes Microsoft FoxPro compatible extensions: Yes dBase compatible extensions: No Object file generation support: No ANSI C usage: Non strict C++ mode: Off Compiler YACC debug mode: Off Memory tracing and statistics: Off Maximum symbol name length: 63 ---------------------------

krutoff: У меня тоже все идет, кроме подключения Zip

krutoff: 1. Если в установках среды стоит строка: MG_CMP=XHARBOUR (чтобы использовать xHarbour по умолчанию) то дает резавершенные ссылки (см. выше). 2. Если по умолчанию стоит HARBOUR и при компиляции примера указать параметр /X ( XHARBOUR ) тогда все компилируется как положены. Вот такая загадка. Буду копать дальше. (Григорий, наверное, использовал при сборке примеров вариант №2)

gfilatov: krutoff пишет: Григорий, наверное, использовал при сборке примеров вариант №2 Да, конечно. Это - базовый вариант, поскольку по умолчанию используется Харбор.

krutoff: 1. В конфигурации HARBOUR по умолчанию при компиляции с параметром /X /Z формируются строки библиотек : c:\minigui\harbour\lib\ziparchive.lib + c:\MiniGUI\xharbour\lib\hbzip.lib + !!! И ПОЭТОМУ ВСЁ РАБОТАЕТ. 2. В конфигурации XHARBOUR по умолчанию при компиляции с параметром /X /Z формируются строки библиотек : c:\MiniGUI\xharbour\lib\hbzip.lib + c:\MiniGUI\xharbour\lib\hbzip.lib + !!! И ПОЭТОМУ НЕ РАБОТАЕТ - поставил вместо первой строки ziparchive.lib -> ВСЁ ЗАРАБОТАЛО 3. Дальше буду решать проблемы с codepage.lib

krutoff: У меня в компиляции при подключении дополнительных библиотек ( например adordd.lib ) с параметром /X все равно берется базовый маршрут HARBOUR

krutoff: DBView при компиляции с параметром /X дает неразрешимые ссылки "Error: Unresolved external '_HB_FUN_HB_CODEPAGE_RU1251' referenced from C:\MINIGUI\SAMPLES\APPLICATIONS\DBFVIEW\SOURCE\DBFVIEW.OBJ "

gfilatov: krutoff пишет: DBView при компиляции с параметром /X дает неразрешимые ссылки Спасибо за сообщение! Оказывается, в январе этого года разработчики xHarbour переименовали кодировку RU1251 в RUWIN. Надо просто заменить в REQUEST RU1251 и при использовании строки "RU1251" на REQUEST RUWIN и "RUWIN". Эти исправления будут доступны в следующей сборке

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

krutoff: Григорий, но остается открытым вопрос - при использовании Zip подключать билиотеку (Harbour) ziparchive.lib и (xHarbour) hbzip.lib одновременно???

sashaBG: Столкнулся вот с тaкой проблемой : иногда из за неправильной установкой Win XP шрифты в PREVEW отображаются крокозяблами если в процедуре печати нарочно указать нужный шрифт все ок . Где нужно вставиь команду SET FONT TO <Font> , <Size> чтобы не переделывать процедуры печати пробовал в начале программы - не работает

gfilatov: АНОНС * АНОНС * АНОНС * АНОНС * АНОНС Готовится к опубликованию новая сборка №64, которая выйдет на этой неделе. Если у Вас есть интересные наработки для включения в новый релиз, то сейчас самое удобное время для их отправки мне Кратко, что нового: - исправление обнаруженных ошибок и неточностей кода; - в реестр теперь можно записывать числовые данные как DWORD значения; - небольшие коррекции при блокировке записи в элементе управления Browse; - MessageBox-функции теперь поддерживают данные любого типа; - обновлена сборка компилятора Харбор; - обновлены некоторые старые примеры (как обычно ).

valery2: gfilatov пишет: Если у Вас есть интересные наработки для включения в новый релиз Вот некое продолжение ( просмотр и обработка логических полей ) #include "minigui.ch" #include "Dbstruct.ch" MEMVAR met Memvar aresult , l, aWhen , aWhenVarNames, cMacroVar Function Main Local aColor := { || if ( rEven() == .F. , RGB( 0, 0, 0 ) , RGB( 255, 0, 0 ) ) } Local rfi1 := { 'Test->Code','Test->First', 'Test->Last' , 'Test->Birth', 'Test->Married', 'Test->Balance' } Local rfi2 := { 'Test1->Code' , 'Test1->Sum1' , 'Test1->Sum2' , 'Test1->Sum3' } Public met:={} SET DELETED ON SET BROWSESYNC ON SET EVENTS FUNCTION TO MYEVENTS DEFINE WINDOW Form_1; AT 0,0; WIDTH 880; HEIGHT 450; TITLE 'MiniGUI Browse test'; MAIN NOMAXIMIZE NOSIZE; ON INIT OpenTables(); ON RELEASE dbcloseall() DEFINE STATUSBAR STATUSITEM 'Mouse Right Click To Mark / Unmark a record' STATUSITEM '<Delete> : Delete record(s)' WIDTH 200 STATUSITEM '<Enter> : Edit inplace' WIDTH 200 END STATUSBAR @ 10,10 BROWSE Browse_1; WIDTH 400; HEIGHT 370; HEADERS { 'Code', 'First Name', 'Last Name', 'Birth Date', "Married", "Balance" }; WIDTHS { 40 , 90 , 90 , 60 , 40 , 100 }; WORKAREA Test; FIELDS rfi1; DYNAMICFORECOLOR {acolor, acolor, acolor, acolor, acolor, acolor}; DYNAMICBACKCOLOR inmet(rfi1); edit inplace @ 10,450 BROWSE Browse_2; WIDTH 400; HEIGHT 370; HEADERS { 'Code' , 'Summa1' , 'Summa2', 'Summa3'}; WIDTHS { 50 , 100 , 100 , 100 }; WORKAREA Test1; FIELDS rfi2; DYNAMICFORECOLOR {acolor, acolor, acolor, acolor}; DYNAMICBACKCOLOR inmet(rfi2) ON KEY ESCAPE ACTION Form_1.Release ON KEY DELETE ACTION rdel() END WINDOW CENTER WINDOW Form_1 ACTIVATE WINDOW Form_1 Return Nil Procedure OpenTables() if !file("test.dbf") CreateTable() endif if !file("test1.dbf") CreateTable() endif Use Test new Use Test1 new Return Procedure CreateTable Local aDbf[6][4], i, bdbf[4][4] aDbf[1][ DBS_NAME ] := "Code" aDbf[1][ DBS_TYPE ] := "Numeric" aDbf[1][ DBS_LEN ] := 3 aDbf[1][ DBS_DEC ] := 0 // aDbf[2][ DBS_NAME ] := "First" aDbf[2][ DBS_TYPE ] := "Character" aDbf[2][ DBS_LEN ] := 25 aDbf[2][ DBS_DEC ] := 0 // aDbf[3][ DBS_NAME ] := "Last" aDbf[3][ DBS_TYPE ] := "Character" aDbf[3][ DBS_LEN ] := 25 aDbf[3][ DBS_DEC ] := 0 // aDbf[4][ DBS_NAME ] := "Birth" aDbf[4][ DBS_TYPE ] := "Date" aDbf[4][ DBS_LEN ] := 8 aDbf[4][ DBS_DEC ] := 0 // aDbf[5][ DBS_NAME ] := "Married" aDbf[5][ DBS_TYPE ] := "Logical" aDbf[5][ DBS_LEN ] := 1 aDbf[5][ DBS_DEC ] := 0 // aDbf[6][ DBS_NAME ] := "Balance" aDbf[6][ DBS_TYPE ] := "Numeric" aDbf[6][ DBS_LEN ] := 10 aDbf[6][ DBS_DEC ] := 2 delete file test.dbf delete file test1.dbf DBCREATE("Test", aDbf) Use Test For i:= 1 To 100 append blank Replace code with i Replace First With 'First Name '+ Ltrim(Str(i)) Replace Last With 'Last Name '+ Ltrim(Str(i)) replace birth with date()-Max(10000, Random(20000))+Random(LastRec()) Replace Married With ( i/2 == int(i/2) ) replace Balance with i*10*if(i/5-int(i/5)=0,-1,1) Next i use bDbf[1][ DBS_NAME ] := "Code" bDbf[1][ DBS_TYPE ] := "Numeric" bDbf[1][ DBS_LEN ] := 3 bDbf[1][ DBS_DEC ] := 0 // bDbf[2][ DBS_NAME ] := "Sum1" bDbf[2][ DBS_TYPE ] := "Numeric" bDbf[2][ DBS_LEN ] := 10 bDbf[2][ DBS_DEC ] := 2 // bDbf[3][ DBS_NAME ] := "Sum2" bDbf[3][ DBS_TYPE ] := "Numeric" bDbf[3][ DBS_LEN ] := 10 bDbf[3][ DBS_DEC ] := 2 // bDbf[4][ DBS_NAME ] := "Sum3" bDbf[4][ DBS_TYPE ] := "Numeric" bDbf[4][ DBS_LEN ] := 10 bDbf[4][ DBS_DEC ] := 2 DBCREATE("Test1", bDbf) Use Test1 For i:= 1 To 30 append blank Replace code with i Replace sum1 With i*2*if(i/4-int(i/4)=0,-1,1) Replace sum2 With i*3*if(i/6-int(i/6)=0,-1,1) replace sum3 with i*10*if(i/5-int(i/5)=0,-1,1) Next i use Return #define WM_NOTIFY 78 #define NM_CLICK (-2) #define NM_RCLICK (-5) Function MyEvents ( hWnd, nMsg, wParam, lParam ) Local i, cFormName, cControlName, result, cControlType, BrowseArea if nMsg == WM_NOTIFY if GetNotifyCode ( lParam ) == NM_RCLICK i := Ascan( _HMG_aFormHandles , hWnd ) cFormName := if( i > 0, _HMG_aFormNames[ i ], "" ) i := Ascan( _HMG_aControlHandles, GetHwndFrom( lParam ) ) cControlName := if( i > 0, _HMG_aControlNames[ i ], "" ) cControlType := if( i > 0, _HMG_aControlType[ i ], "" ) BrowseArea := if(cControlType=="",0,_HMG_aControlSpacing[ i ]) if cControlType == "BROWSE" result:= pomet(cFormName, cControlName, BrowseArea) else result:= Events ( hWnd, nMsg, wParam, lParam ) endif else result:= Events ( hWnd, nMsg, wParam, lParam ) endif else result:= Events ( hWnd, nMsg, wParam, lParam ) endif Return result procedure pomet(cFormName, cControlName, BrowseArea) local namv := GetProperty( cFormName, cControlName , "Value") local jj IF Select (BrowseArea) != 0 Select &BrowseArea go namv jj:=ascan(met, alias()+' '+str(recno())) if jj=0 aadd(met,alias()+" "+str(recno())+"~"+cFormName+"`"+cControlName) else adel(met, jj) asize(met, len(met)-1) endif namv:=recno() skip if eof() go namv skip -1 endif endif SetProperty( cFormName, cControlName , "Value",recno()) DoMethod( cFormName , cControlName, "Refresh" ) return function rEven() Local i, result:=.F., BrowseArea, BackArea, BackRec i := ASCAN( _HMG_aControlhandles, GetFocus()) if i>0 BrowseArea := _HMG_aControlSpacing[ i ] BackArea := Alias() BackRec := RecNo() IF Select (BrowseArea) != 0 Select &BrowseArea result:= if ( ascan(MET,alias()+' '+str(recno())) = 0 , .F. , .T. ) dbselectarea(BackArea) go BackRec endif endif return result function cEven(rfi) Local result:=.F. if Valtype(rfi)=="N" if rfi<0 result:=.T. endif endif return result function kolmet() Local i, ii, ij, nStart := 1 Local BrowseArea, BackArea, BackRec, cAlias Local cArri:={} i := ASCAN( _HMG_aControlhandles, GetFocus()) if i>0 BrowseArea := _HMG_aControlSpacing[ i ] BackArea := Alias() BackRec := RecNo() IF Select (BrowseArea) != 0 Select &BrowseArea cAlias:=alias()+' ' ii:=len(cAlias) WHILE nstart > 0 nstart:=ascan(MET, cAlias,nstart) if nstart>0 ij:=len(met[nstart])-ii aadd(cArri,substr(met[nstart],ii+1,ij)) nstart:=nstart+1 endif ENDDO dbselectarea(BackArea) go BackRec endif endif return cArri procedure rdel() Local sumrec, sumrec2, cArri:=kolmet() Local i, ii, ij, cFormName, cControlName, pod1, pod2 Local BrowseArea, BackArea, BackRec, cAlias sumrec:=len(cArri) sumrec2:=sumrec if sumrec2=0 return endif if msgYesNo("Delete "+ltrim(str(sumrec2))+" record"+if(sumrec2=1,"?","s?"), "Delete records") i := ASCAN( _HMG_aControlhandles, GetFocus()) if i>0 BrowseArea := _HMG_aControlSpacing[ i ] BackArea := Alias() BackRec := RecNo() IF Select (BrowseArea) != 0 Select &BrowseArea cAlias:=alias()+' ' if sumrec=0 delete Skip if eof() Go Bottom EndIf else pod1:=at("~",cArri[1]) pod2:=at("`",cArri[1]) cFormName:=substr(cArri[1],pod1+1,pod2-1-pod1) cControlName:=substr(cArri[1],pod2+1,len(cArri[1])-pod2) for ii:=1 to sumrec go val(substr(cArri[ii],1,pod1-1)) delete ij:=ascan(MET, cAlias+cArri[ii]) adel(met, ij) asize(met, len(met)-1) next go top endif SetProperty( cFormName, cControlName , "Value",recno()) DoMethod( cFormName , cControlName, "Refresh" ) dbselectarea(BackArea) go BackRec endif endif endif return function inmet(rfi) Local il, i, ii, ij, ccolor:={} ij:=len(rfi) for il=1 to ij ii:="{ || if ( cEven("+rfi[il]+")= .F. , ( 255 + ( 255 * 256 ) + ( 255 * 65536 ) ) , ( 255 + ( 255 * 256 ) + ( 0 * 65536 ) ) ) }" i:=&(ii) aadd(ccolor,i) next return ccolor #ifndef __XHARBOUR__ #xcommand DEFAULT => OTHERWISE #endif *-----------------------------------------------------------------------------* Function _GetBrowseFieldValue ( cTemp ) *-----------------------------------------------------------------------------* Local cRet := 'Nil' Local cType := _TypeEx (cTemp) Switch cType CASE 'N' CASE 'F' CASE 'I' CASE 'B' CASE 'Y' cRet := lTrim ( Str (&cTemp) ) Exit CASE 'D' CASE 'T' cRet := Dtoc (&cTemp) Exit CASE 'C' CASE '@' cRet := rTrim ( &cTemp ) Exit CASE 'L' cRet := IIF ( &cTemp == .T. , ' '+chr(118)+' ' , ' ' ) Exit CASE 'M' cRet := '<memo>' If ! Empty (&cTemp) cRet := '<Memo>' EndIf Exit CASE 'G' cRet := '<General>' Exit DEFAULT If cType == 'UE' cRet := '<R-Next>' ElseIf cType == 'UI' cRet := _GetBrowseFnValue(cTemp) EndIf End Switch Return cRet *-----------------------------------------------------------------------------* Function _GetBrowseFnValue ( cTemp ) *-----------------------------------------------------------------------------* Local cRet := 'Nil' Switch ValType (cTemp) Case 'N' cRet := lTrim ( Str(&cTemp) ) Exit Case 'D' cRet := Dtoc(&cTemp) Exit Case 'L' cRet := IIF ( &cTemp == .T. , ' '+chr(118)+' ' , ' ' ) Exit Case 'C' cRet := rTrim ( &cTemp ) Exit Case 'M' cRet := '<Memo>' End Switch Return cRet *-----------------------------------------------------------------------------* Function _BrowseInPlaceEdit ( GridHandle , aValid , aValidMessages , aReadOnly , lock , append , aInputItems ) *-----------------------------------------------------------------------------* Local GridCol , GridRow , i , nrec , _GridWorkArea , BackArea , BackRec Local _GridFields , FieldName , CellData := '' , CellColIndex Local aStruct , Width , Decimals , sFieldname , ControlType Local Ldelta := 0 , aTemp , E , r , p , lInputItems := .F. , aItems := {}, aValues := {} Local abKeyBlocks := {} Local bOnDisplay := { || AADD(abKeyBlocks, _GetHotKey ( '_InPlaceEdit', 0, 27 )),; _ReleaseHotKey ( '_InPlaceEdit', 0, 27 ),; AADD(abKeyBlocks, _GetHotKey ('_InPlaceEdit', 0, 13 )),; _ReleaseHotKey ( '_InPlaceEdit', 0, 13 ) } Local bOnCloseUp := { || _DefineHotKey('_InPlaceEdit', 0, 27, abKeyBlocks[1]),; _DefineHotKey('_InPlaceEdit', 0, 13, abKeyBlocks[2]),; abKeyBlocks := {} } Local aEnabledTypes := {"N","C","D","L","M"} If append I := ascan ( _HMG_aControlhandles , GridHandle ) _BrowseInPlaceAppend ( '' , '' , i ) Return Nil EndIf If This.CellRowIndex != LISTVIEW_GETFIRSTITEM ( GridHandle ) Return Nil EndIf I := ascan ( _HMG_aControlhandles , GridHandle ) _GridWorkArea := _HMG_aControlSpacing _GridFields := _HMG_aControlRangeMin CellColIndex := This.CellColIndex If CellColIndex < 1 .or. CellColIndex > Len (_GridFields) Return Nil EndIf if Len ( _HMG_aControlBkColor ) > 0 .And. CellColIndex == 1 PlayHand() Return Nil EndIf If valType ( aInputItems ) == 'A' If Len ( aInputItems ) >= CellColIndex If ValType ( aInputItems [ CellColIndex ] ) == 'A' lInputItems := .T. EndIf EndIf EndIf If ValType ( aReadOnly ) == 'A' If Len ( aReadOnly ) >= CellColIndex If aReadOnly [ CellColIndex ] != Nil If aReadOnly [ CellColIndex ] == .T. _HMG_IPE_CANCELLED := .F. Return Nil EndIf EndIf EndIf EndIf FieldName := _GridFields [ CellColIndex ] If ASCAN(aEnabledTypes, _TypeEx ( FieldName )) < 1 MsgAlert ("Edit of this field is not supported.", "Warning") Return Nil EndIf r := at ( '>', FieldName ) if r != 0 sFieldName := Right ( FieldName, Len(Fieldname) - r ) p := Left ( FieldName, r - 2 ) If !( Upper( p ) == "FIELD" ) .And. !( Upper( p ) == "_FIELD" ) _GridWorkArea := p EndIf Else sFieldName := FieldName EndIf // It the specified area does not exists, when return If Select (_GridWorkArea) == 0 Return Nil EndIf // Save Original WorkArea BackArea := Alias() // Selects Grid's WorkArea Select &_GridWorkArea // Save Original Record Pointer BackRec := RecNo() IF _GridWorkArea == _HMG_aControlSpacing nRec := _GetValue ( '', '' , i ) Go nRec EndIf // If LOCK clause is present, try to lock. If lock == .T. If (_GridWorkArea)->( Rlock() ) == .F. MsgExclamation( _HMG_BRWLangError[9], _HMG_BRWLangError[10] ) // Restore Original Record Pointer Go BackRec // Restore Original WorkArea If Select (BackArea) != 0 Select &BackArea Else Select 0 EndIf Return Nil EndIf EndIf aTemp := __MVGET ( '_HMG_' + ALLTRIM(STR(_HMG_aControlhandles)) + '_WHEN' ) IF VALTYPE ( aTemp ) == 'A' IF LEN (aTemp) >= LEN (_GridFields) IF VALTYPE ( aTemp [CellColIndex] ) == 'B' E := EVAL ( aTemp [CellColIndex] ) IF E == .F. PlayHand() // Restore Original Record Pointer Go BackRec // Restore Original WorkArea If Select (BackArea) != 0 Select &BackArea Else Select 0 EndIf _HMG_IPE_CANCELLED := .F. Return Nil ENDIF ENDIF ENDIF ENDIF CellData := &FieldName aStruct := DbStruct() r := FieldPos ( sFieldName ) If r > 0 Width := aStruct [r] [DBS_LEN] Decimals := aStruct [r] [DBS_DEC] EndIf GridRow := GetWindowRow (GridHandle) GridCol := GetWindowCol (GridHandle) If lInputItems == .T. ControlType := 'X' Ldelta := 1 Else p := Type (FieldName) Switch p Case 'C' Case 'D' Case 'M' ControlType := p Exit Case 'L' ControlType := p Ldelta := 1 Exit Case 'N' ControlType := IFEMPTY(Decimals, 'I', 'F') End Switch EndIf _HMG_InplaceParentHandle := If( _HMG_BeginWindowMDIActive, GetActiveMdiHandle(), GetActiveWindow() ) If ControlType == 'M' r := InputBox ( '' , _HMG_aControlCaption [CellColIndex] , STRTRAN(CellData, chr(141), ' ') , , , .T. ) If _HMG_DialogCancelled == .F. Replace &FieldName With r _HMG_IPE_CANCELLED := .F. Else _HMG_IPE_CANCELLED := .T. EndIf (_GridWorkArea)->( dbrunlock() ) Else DEFINE WINDOW _InPlaceEdit; AT This.CellRow + GridRow - _HMG_aControlRow - 1 , This.CellCol + GridCol - _HMG_aControlCol + 2; WIDTH This.CellWidth; HEIGHT This.CellHeight + 6 + Ldelta; MODAL; NOCAPTION; NOSIZE; ON INIT _SetFocus ( 'Control_1' , '_InPlaceEdit' ) ON KEY CONTROL+U ACTION IF( _IsWindowActive('_InPlaceEdit'),; _InPlaceEdit.Control_1.Value := IF( ControlType == 'L', If ( CellData , 1 , 2 ), CellData ), NIL ) ON KEY RETURN ACTION IF( _IsWindowActive('_InPlaceEdit'),; _InPlaceEditOk ( i , _InPlaceEdit.Control_1.Value , aValid , CellColIndex ,; sFieldName , _GridWorkArea , aValidMessages , lock , ControlType , aInputItems ), NIL ) ON KEY ESCAPE ACTION ( _HMG_IPE_CANCELLED := .T. ,; dbrunlock(), IF( _IsWindowActive('_InPlaceEdit'), _InPlaceEdit.Release, NIL ) ) If lInputItems == .T. * Fill Items Array For p := 1 To Len ( aInputItems [ CellColIndex ] ) aadd ( aItems , aInputItems [ CellColIndex ] [p] [1] ) Next p * Fill Values Array For p := 1 To Len ( aInputItems [ CellColIndex ] ) aadd ( aValues , aInputItems [ CellColIndex ] [p] [2] ) Next p r := aScan ( aValues , CellData ) DEFINE COMBOBOX Control_1 ROW 0 COL 0 ITEMS aItems WIDTH This.CellWidth VALUE if ( Empty(r) , 1 , r ) FONTNAME _hmg_aControlFontName FONTSIZE _hmg_aControlFontSize ON LISTDISPLAY Eval( bOnDisplay ) ON LISTCLOSE Eval( bOnCloseUp ) END COMBOBOX ElseIf ControlType == 'C' CellData := rtrim ( CellData ) DEFINE TEXTBOX Control_1 ROW 0 COL 0 WIDTH This.CellWidth HEIGHT This.CellHeight + 6 VALUE CellData MAXLENGTH Width FONTNAME _hmg_aControlFontName FONTSIZE _hmg_aControlFontSize END TEXTBOX ElseIf ControlType == 'D' DEFINE DATEPICKER Control_1 ROW 0 COL 0 HEIGHT This.CellHeight + 6 WIDTH This.CellWidth VALUE CellData UPDOWN .T. SHOWNONE .T. FONTNAME _hmg_aControlFontName FONTSIZE _hmg_aControlFontSize END DATEPICKER ElseIf ControlType == 'L' DEFINE CHECKBOX Control_1 ROW 0 COL 0 WIDTH This.CellWidth CAPTION '' VALUE CellData FONTNAME _hmg_aControlFontName FONTSIZE _hmg_aControlFontSize END CHECKBOX ElseIf ControlType == 'I' DEFINE TEXTBOX Control_1 ROW 0 COL 0 NUMERIC .T. WIDTH This.CellWidth HEIGHT This.CellHeight + 6 VALUE CellData MAXLENGTH Width FONTNAME _hmg_aControlFontName FONTSIZE _hmg_aControlFontSize END TEXTBOX ElseIf ControlType == 'F' DEFINE TEXTBOX Control_1 ROW 0 COL 0 NUMERIC .T. INPUTMASK Replicate ( '9', Width - Decimals - 1 ) + '.' + Replicate ( '9', Decimals ) WIDTH This.CellWidth HEIGHT This.CellHeight + 6 VALUE CellData FONTNAME _hmg_aControlFontName FONTSIZE _hmg_aControlFontSize END TEXTBOX EndIf END WINDOW ACTIVATE WINDOW _InPlaceEdit EndIf _MdiWindowsActivate ( _HMG_InplaceParentHandle ) // GF HMG 47 _HMG_InplaceParentHandle := 0 SetFocus ( GridHandle ) // Restore Original Record Pointer Go BackRec // Restore Original WorkArea If Select (BackArea) != 0 Select &BackArea Else Select 0 EndIf Return Nil *-----------------------------------------------------------------------------* Static Procedure _InPlaceEditOk ( i , r , aValid , CellColIndex , sFieldName , AreaName , aValidMessages , lock , ControlType , aInputItems ) *-----------------------------------------------------------------------------* Local b , Result , mVar , TmpName If ValType ( aValid ) == 'A' If Len ( aValid ) >= CellColIndex If aValid [ CellColIndex ] != Nil Result := _GetValue ( 'Control_1' , '_InPlaceEdit' ) If GetControlType( 'Control_1' , '_InPlaceEdit' ) == 'COMBO' Result := iif ( Result == 1 , .T. , .F. ) EndIf TmpName := 'MemVar' + AreaName + sFieldname mVar := TmpName &mVar := Result b := Eval ( aValid [ CellColIndex ] ) If b == .f. If ValType ( aValidMessages ) == 'A' If Len ( aValidMessages ) >= CellColIndex If aValidMessages [CellColIndex] != Nil MsgExclamation ( aValidMessages [CellColIndex] ) Else MsgExclamation (_HMG_BRWLangError[11]) EndIf Else MsgExclamation (_HMG_BRWLangError[11]) EndIf Else MsgExclamation (_HMG_BRWLangError[11]) EndIf Else _InPlaceEditSave ( i , sFieldname , AreaName , r , lock , ControlType , aInputItems , CellColIndex ) EndIf Else _InPlaceEditSave ( i , sFieldname , AreaName , r , lock , ControlType , aInputItems , CellColIndex ) EndIf EndIf Else _InPlaceEditSave ( i , sFieldname , AreaName , r , lock , ControlType , aInputItems , CellColIndex ) EndIf _HMG_IPE_CANCELLED := .F. Return *-----------------------------------------------------------------------------* Static Procedure _InPlaceEditSave ( i , Fieldname , Alias , r , lock , ControlType , aInputItems , CellColIndex ) *-----------------------------------------------------------------------------* If ControlType == 'X' r := aInputItems [ CellColIndex ] [ r ] [ 2 ] EndIf If lock == .t. (Alias)->( Rlock() ) EndIf FieldName := Alias + "->" + Fieldname Replace &FieldName With r If lock == .t. (Alias)->( dbrunlock() ) EndIf _BrowseRefresh ( '' , '' , i ) _InPlaceEdit.Release Return



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