Еще немного Browse

Форум » GUI » Еще немного Browse » Ответить

Еще немного Browse

valery2: С Рождеством всех и Новым Годом ! Может, кому будет интересен пример, приведенный ниже. Что он делает ? : 1. Помечает строки правым кликом, при этом не нужен никакой элемент признака в базе!, т.е. имеющиеся в наличии базы не нуждаются в перестройке . ( Тем же кликом метки убираются ) 2. Удаляет меченые строки 3. Отрицательные числа ( только числовые поля ) подсвечиваются желтым цветом. Вот и всё. Пример рабочий. Конечно, есть еще над чем поработать. Например, работу с отр. числами перевести в MyEvents. А вообще, хочется сделать что-то вроде «супер-заголовка» TsBrowse и очень раздражает отображение логических полей. Нужно бы «птички», или, хотя бы, «звездочки». Может у кого-нибудь имеются соображения ?

Ответов - 1

valery2: #include "minigui.ch" #include "Dbstruct.ch" MEMVAR met 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->Balans' } local rfi2:= { 'Test1->Code' , 'Test1->Sum1' , 'Test1->Sum2' , 'Test1->Sum3' } Public MET:={} SET BROWSESYNC ON SET DELETED ON SET EVENTS FUNCTION TO MYEVENTS DEFINE WINDOW Form_1 ; AT 0,0 ; WIDTH 910 ; HEIGHT 543 ; TITLE 'MiniGUI Browse test' ; MAIN NOMAXIMIZE; ON INIT OpenTables(); ON RELEASE dbcloseall() DEFINE STATUSBAR STATUSITEM 'Right Click To Marked / Unmarked record' STATUSITEM '<Delete> : Delete record(s)' WIDTH 200 END STATUSBAR @ 10,10 BROWSE Browse_1; WIDTH 400; HEIGHT 370; HEADERS { 'Code', 'First Name', 'Last Name', 'Birth Date', "Balans" }; WIDTHS { 50 , 100 , 100 , 100 , 100 }; WORKAREA Test; FIELDS rfi1 ; DYNAMICFORECOLOR {acolor, acolor, acolor, acolor, acolor}; DYNAMICBACKCOLOR inmet(rfi1) @ 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[5][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 ] := "Balans" aDbf[5][ DBS_TYPE ] := "Numeric" aDbf[5][ DBS_LEN ] := 10 aDbf[5][ 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 balans 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, x, cFormName := "", cControlName := "" , result:=0, cControlType:= "", BrowseArea:= 0 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) 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, x, result:=.F., BrowseArea:=0, BrowseAlias:= "", BackArea:= "", BackRec:=0 i := ASCAN( _HMG_aControlhandles, GetFocus()) if i>0 BrowseArea := _HMG_aControlSpacing 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(ix, 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:=0, BrowseAlias:= "", BackArea:= "", BackRec:=0, cAlias:="" local cArri:={} i := ASCAN( _HMG_aControlhandles, GetFocus()) if i>0 BrowseArea := _HMG_aControlSpacing 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:=0, sumrec2:=0, cArri:=kolmet() local i, ii, ij, ik, cFormName, cControlName, pod1, pod2 Local BrowseArea:=0, BrowseAlias:= "", BackArea:= "", BackRec:=0, cAlias:="" sumrec:=len(cArri) sumrec2:=sumrec if sumrec2=0 sumrec2:=1 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 BackArea := Alias() BackRec := RecNo() IF Select (BrowseArea) != 0 Select &BrowseArea cAlias:=alias()+' ' ik:=len(cAlias) 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("+str(il)+", "+rfi[il]+")= .F. , ( 255 + ( 255 * 256 ) + ( 255 * 65536 ) ) , ( 255 + ( 255 * 256 ) + ( 0 * 65536 ) ) ) }" i:=&(ii) aadd(ccolor,i) next return ccolor

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