TsBrowse в Минигуи (продолжение)

Форум » GUI » TsBrowse в Минигуи (продолжение) » Ответить

TsBrowse в Минигуи (продолжение)

Vlad04: TsBrows определяется в виде строки ПАРМЕТРОВ объекта и их значений К примеру [quote] DEFINE TBROWSE oBrw2 ; AT 60,450 ; ALIAS cAlias ; OF Form1 ; WIDTH 330 ; HEIGHT 340 ; FONT "Verdana" ; SIZE 9 ; ON DBLCLICK CopyRec(); ON GOTFOCUS fModelo_Hab(2) ; AUTOFILTER ; CELLED EDIT; VALUE nRec; GRID [/quote] Здесь я собрал параметры из разных tBrows Можно или нет и какие парметры заменить выражением ( и каким) ? oBrw2:.... oBrw2:....

Ответов - 300, стр: 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 All

SergKis: PS DATA bKeyEvent надо убрать, остался от опытов

Haz: SergKis пишет: У себя исп. вариант без кнопки Сергей. Спасибо. В понедельник поткстирую

Haz: Сергей : может будет интересно. У меня есть очень draft, ну совсем бета альтернативного комбо в ячейке. Руки не доходят довести до ума, но испьзую так как есть. В понедельник скину в форум пример. Глянешь, интересны идеи. Суть в том, что вместо комбика попытался использовать бровс по базе. В последних проектах использую успешно, хоть и бета. А вот времени на осмысление нет. И чтоб совсем точки над ё, я не прошу сделать за меня. Я предлагаю идею и готов выслушать мнение.

SergKis: Haz пишет Суть в том, что вместо комбика попытался использовать бровс по базе. С этого начинал, с combo (и с поиском по букве). В итоге отказался, со временем маленький список -> в большой, + колонки ... Практически везде перехожу на тсб (с hb 2.0 browse, на 3.2 переделываю на тсб) А вот времени на осмысление нет. Со временем туго, согласен, справочники делаю по такой схеме (с поправками на задачу конечно), как идея (код из задачи, как есть) [pre2] // SPR modal window #include "minigui.ch" #include "tsbrowse.ch" MEMVAR oApp, oMain, oTbr, aReturn FUNC SprAGENT() LOCAL cBrw := 'AGENT' LOCAL cDbf := cBrw LOCAL cCapt := gTxt(Agenti) LOCAL nOrder := 1 LOCAL aColumn := { 'TNOM' , 'FIO' , 'FIO3' } LOCAL aName := { 'KOD' , 'NAM' , 'NOTE' } LOCAL aHeader := { gTxt(Kod) , gTxt(Nam), gTxt(Note) } LOCAL aWidth := { gW(1) , gW(2) , gW(2) } LOCAL aOrder := { 'KOD' , 'NAM' , } LOCAL aEdit := { .F. , .F. , .F. } LOCAL aAlign := { 1 , 0 , 0 } LOCAL aFAlign := { 1 , 0 , 0 } LOCAL aPicture := { , , } LOCAL aFixLite := { .T. , .T. , .T. } LOCAL aNoDescend := { .T. , .T. , .T. } LOCAL aOnGotFocusSelect := { .T. , .T. , .T. } LOCAL aEmptyValToChar := { .T. , .T. , .T. } LOCAL aEditMove := { 0 , 0 , 0 } LOCAL aBlockData := { , , } LOCAL aFields := { , , } LOCAL aData := { aColumn , ; // 1 aName , ; // 2 aHeader , ; // 3 aWidth , ; // 4 aOrder , ; // 5 aEdit , ; // 6 aAlign , ; // 7 aFAlign , ; // 8 aPicture , ; // 9 aFixLite , ; // 10 aNoDescend , ; // 11 aOnGotFocusSelect , ; // 12 aEmptyValToChar , ; // 13 aEditMove , ; // 14 aBlockData , ; // 15 aFields ; // 16 } RETURN SprGet( cBrw, cCapt, aData, nOrder ) FUNC SprU04() LOCAL cBrw := 'U04' LOCAL cDbf := cBrw LOCAL cCapt := gTxt(Klienti) LOCAL nOrder := 2 LOCAL aColumn := { 'R_1' , 'R_2' , 'R_4' , 'R_5' , 'R_13' , 'R_34' } LOCAL aName := { 'KOD' , 'NAM' , 'RNR' , 'PNR' , 'GRU' , 'ADR' } LOCAL aHeader := { gTxt(Kod) , gTxt(Nam), gTxt(Kli_R_4), gTxt(Kli_R_5), gTxt(Kli_R_13), gTxt(Kli_R_34) } LOCAL aWidth := { gW(1) , gW(3.5) , gW(1.5) , gW(1.5) , gW(1) , gW(4)+gW(0.5) } LOCAL aOrder := { 'KOD' , 'NAM' , , , , } LOCAL aEdit := { .F. , .F. , .F. , .F. , .F. , .F. } LOCAL aAlign := { 1 , 0 , 0 , 0 , 0 , 0 } LOCAL aFAlign := { 1 , 0 , 0 , 0 , 0 , 0 } LOCAL aPicture := { , , , , , } LOCAL aFixLite := { .T. , .T. , .T. , .T. , .T. , .T. } LOCAL aNoDescend := { .T. , .T. , .T. , .T. , .T. , .T. } LOCAL aOnGotFocusSelect := { .T. , .T. , .T. , .T. , .T. , .T. } LOCAL aEmptyValToChar := { .T. , .T. , .T. , .T. , .T. , .T. } LOCAL aEditMove := { 0 , 0 , 0 , 0 , 0 , 0 } LOCAL aBlockData := { , , , , , {|| KliAdr() } } LOCAL aFields := { , , , , , } LOCAL aData := { aColumn , ; // 1 aName , ; // 2 aHeader , ; // 3 aWidth , ; // 4 aOrder , ; // 5 aEdit , ; // 6 aAlign , ; // 7 aFAlign , ; // 8 aPicture , ; // 9 aFixLite , ; // 10 aNoDescend , ; // 11 aOnGotFocusSelect , ; // 12 aEmptyValToChar , ; // 13 aEditMove , ; // 14 aBlockData , ; // 15 aFields ; // 16 } RETURN SprGet( cBrw, cCapt, aData, nOrder ) * ----------------------------------------------------------------------------------- * FUNC SprGet( cID, cTitle, aData, nOrder, cBrwName ) * ----------------------------------------------------------------------------------- * LOCAL nY, nX, nH, nW, nT LOCAL cBrw := iif( empty(cBrwName), 'oSprav', cBrwName ) LOCAL cDbf := cID LOCAL cAls := cID LOCAL cWnd := 'w'+cBrw LOCAL aColumn := aData[ 1 ] // 1 LOCAL aName := aData[ 2 ] // 2 LOCAL aHeader := aData[ 3 ] // 3 LOCAL aWidth := aData[ 4 ] // 4 LOCAL aOrder := aData[ 5 ] // 5 LOCAL aEdit := aData[ 6 ] // 6 LOCAL aAlign := aData[ 7 ] // 7 LOCAL aFAlign := aData[ 8 ] // 8 LOCAL aPicture := aData[ 9 ] // 9 LOCAL aFixLite := aData[ 10 ] // 10 LOCAL aNoDescend := aData[ 11 ] // 11 LOCAL aOnGotFocusSelect := aData[ 12 ] // 12 LOCAL aEmptyValToChar := aData[ 13 ] // 13 LOCAL aEditMove := aData[ 14 ] // 14 LOCAL aBlockData := aData[ 15 ] // 15 LOCAL aFields := aData[ 16 ] // 16 LOCAL nDcell := 5 LOCAL nI, nK := len(aColumn) LOCAL hWnd := iif( _HMG_BeginWindowMDIActive, GetActiveMdiHandle(), GetActiveWindow() ) LOCAL nWndY := GetWindowRow (hWnd) LOCAL nWndX := GetWindowCol (hWnd) LOCAL nWndH := GetWindowHeight(hWnd) LOCAL nWndW := GetWindowWidth (hWnd) LOCAL nModH := GetClientHeight(hWnd) LOCAL nModW := GetVScrollBarWidth() + 2 + nK LOCAL nAls := Select() LOCAL hSpl, cNam, aHmg, oGet, cPic, oCel DEFAULT nOrder := 2 PRIVATE oTbr, aReturn := {} If ! Spr_Use( cDbf, cAls, .T. ) MsgStop( gTxt(NotUsed) + CRLF + cDbf + '.DBF', gTxt(Info) ) RETURN aReturn EndIf SET ORDER TO nOrder cAls := Alias() aHmg := Save_Rest_HMG(hWnd) AEval(aWidth, {|nw| nModW += nw }) nY := int( (nWndH - nModH) / 2 ) + nWndY nX := int( (nWndW - nModW) / 2 ) + nWndX DEFINE WINDOW &cWnd ; AT nY, nX ; WIDTH nModW ; HEIGHT nModH ; TITLE cTitle ; ICON oApp:Icon ; MODAL NOSIZE ; ON RELEASE ( iif( Select(cAls) > 0, (cAls)->( dbCloseArea() ), ), dbSelectArea(nAls) ) DEFINE SPLITBOX HANDLE hSpl DEFINE TOOLBAR ToolBar_1 BUTTONSIZE 68,32 FLAT BUTTON 06 CAPTION gTxt(Sort) PICTURE 'page_123' ACTION oTbr:PostMsg( WM_KEYDOWN, VK_F6, 0 ) ; TOOLTIP 'F6' SEPARATOR BUTTON 07 CAPTION gTxt(Find) PICTURE 'page_fltr' ACTION Press_Key(oTbr) ; TOOLTIP 'F7' SEPARATOR BUTTON E1 CAPTION ' ' PICTURE 'br_empty' ACTION NIL ; SEPARATOR BUTTON 13 CAPTION gTxt(Vibor) PICTURE 'page_enter' ACTION oTbr:PostMsg( WM_KEYDOWN, VK_RETURN, 0 ) ; TOOLTIP 'Enter' SEPARATOR END TOOLBAR DEFINE TOOLBAR ToolBar_2 BUTTONSIZE 48,32 FLAT BUTTON 10 CAPTION gTxt(Exit) PICTURE 'exit' ACTION ThisWindow.Release ; TOOLTIP 'Esc' END TOOLBAR END SPLITBOX nW := ThisWindow.ClientWidth nY := GetWindowHeight(hSpl) nX := 0 nH := ThisWindow.ClientHeight - nY nT := nY DEFINE TBRW &cBrw TO oTbr AT nY,nX WIDTH nW HEIGHT nH ALIAS cAls CELL oTbr:Cargo := cID :aColSel := aColumn :hFontHead := gProp(TsbHeader) :hFontFoot := gProp(TsbFooter) :LoadFields(.T.) :nWheelLines := 1 :nClrLine := COLOR_GRID :nHeightCell += nDcell :nHeightHead += nDcell :nHeightFoot := :nHeightCell :lNoGrayBar := .F. :lDrawFooters := .T. :lFooting := .T. :lNoVScroll := .F. :lNoHScroll := .T. :nFreeze := 1 :lLockFreeze := .F. :nFireKey := VK_F4 // default Edit :nLineStyle := LINES_ALL // LINES_NONE LINES_ALL LINES_VERT LINES_HORZ LINES_3D LINES_DOTTED :SetColor( { CLR_FOCUSB }, { { |a,b,c| If( c:nCell == b, {Rgb( 66, 255, 236), Rgb(209, 227, 248)}, ; {Rgb(220, 220, 220), Rgb(220, 220, 220)} ) } } ) For nI := 1 To nK oCol := :aColumns [ nI ] oCol:cName := aName [ nI ] oCol:cField := aColumn [ nI ] oCol:cHeading := aHeader [ nI ] oCol:nWidth := aWidth [ nI ] oCol:lEdit := aEdit [ nI ] oCol:nAlign := aAlign [ nI ] oCol:nFAlign := aFAlign [ nI ] oCol:lFixLite := aFixLite [ nI ] oCol:lOnGotFocusSelect := aOnGotFocusSelect[ nI ] oCol:lEmptyValToChar := aEmptyValToChar [ nI ] oCol:nEditMove := aEditMove [ nI ] If ! empty(aPicture [ nI ]) oCol:cPicture := aPicture [ nI ] EndIf If ! empty(aOrder[ nI ]) oCol:cOrder := aOrder [ nI ] // отключаем подсветку в Footer // If oCol:cName == "KOD" // oCol:cFooting := { |nc,obr| nc := (obr:cAlias)->( OrdKeyNo() ), ; // iif( empty(nc), '', hb_ntos(nc) ) } // ElseIf oCol:cName == "NAM" // oCol:cFooting := { |nc,obr| nc := (obr:cAlias)->( OrdKeyCount() ), ; // ' '+iif( empty(nc), '', hb_ntos(nc) ) } // EndIf EndIf If ! empty(aBlockData[ nI ]) If HB_ISCHAR(aBlockData[ nI ]) oCol:bData := AliasBlock(aBlockData[ nI ], cAls, .T.) Else oCol:bData := aBlockData[ nI ] EndIf EndIf If ! empty(aFields [ nI ]) oCol:cField := aFields [ nI ] EndIf Next :nCell := :nColumn('NAM') :aSortBmp := { LoadImage("br_up"), LoadImage("br_dn") } // отключаем подсветку в Footer // :bChange := {|obr| obr:DrawFooters() } :bLDblClick := {|p1,p2,p3,obr| p1:=p2:=p3:=Nil, obr:PostMsg( WM_KEYDOWN, VK_RETURN, 0 ) } :SetIndexCols( :nColumn('KOD'), :nColumn('NAM') ) :SetOrder(:nColumn(iif( nOrder == 1, 'KOD', 'NAM') )) if :nLen > :nRowCount() :ResetVScroll( .T. ) :oHScroll:SetRange(0,0) EndIf :UserKeys(VK_F6 , {|obr,nky,cky| Order_Set(obr,nky,cky)}) :UserKeys(VK_F7 , {|obr | Press_Key(obr )}) :UserKeys(VK_RETURN, {|obr | Recno_Get(obr )}) :UserKeys( , {|obr,nky,cky| Press_Key(obr,nky,cky)}) END TBRW oTbr:SetNoHoles() oTbr:SetFocus() cPic := StrTran( oTbr:GetColumn('KOD'):cPicture, '@K ', '' ) oCel := oTbr:GetCellInfo( 1, oTbr:nColumn('KOD') ) nX := 2 nW := oCel:nWidth - 5 nH := oTbr:nHeightCell nY := nT + GetWindowHeight(oTbr:hWnd) - oTbr:nHeightFoot // 550 @ nY, nX GETBOX KOD OBJ oGet HEIGHT nH WIDTH nW VALUE space(len(cPic)) ; BACKCOLOR oApp:BColorGet PICTURE cPic ; ON CHANGE Seek__Set(oTbr) ; INVISIBLE NOTABSTOP oGet:lOnGotFocusSelect := .F. oGet:OnEscape := {|og| og:GetObj():Hide(), oTbr:SetFocus(), .T. } oGet:OnEnter := {|og| og:GetObj():Hide(), oTbr:SetFocus() } oGet:OnDown := {|og| og:GetObj():Hide(), oTbr:SetFocus() } oGet:OnUp := {|og| og:GetObj():Hide(), oTbr:SetFocus() } cPic := StrTran( oTbr:GetColumn('NAM'):cPicture, '@K ', '' ) oCel := oTbr:GetCellInfo( 1, oTbr:nColumn('NAM') ) nX := oCel:nCol + 2 nW := oCel:nWidth - 10 @ nY, nX GETBOX NAM OBJ oGet HEIGHT nH WIDTH nW VALUE space(len(cPic)) ; BACKCOLOR oApp:BColorGet PICTURE cPic ; ON CHANGE Seek__Set(oTbr) ; INVISIBLE NOTABSTOP oGet:lOnGotFocusSelect := .F. oGet:OnEscape := {|og| og:GetObj():Hide(), oTbr:SetFocus(), .T. } oGet:OnEnter := {|og| og:GetObj():Hide(), oTbr:SetFocus() } oGet:OnDown := {|og| og:GetObj():Hide(), oTbr:SetFocus() } oGet:OnUp := {|og| og:GetObj():Hide(), oTbr:SetFocus() } END WINDOW ACTIVATE WINDOW &cWnd Save_Rest_HMG(aHmg) dbSelectArea(nAls) RETURN aReturn * ----------------------------------------------------------------------------------- * STATIC FUNC KliAdr() * ----------------------------------------------------------------------------------- * LOCAL cAdr, cAls := oTbr:cAlias If empty((cAls)->R_34) cAdr := Alltrim((cAls)->R_3 ) + ' ' + AllTrim((cAls)->R_3A) Else cAdr := Alltrim((cAls)->R_34) + ' ' + AllTrim((cAls)->R_35) EndIf RETURN cAdr * ----------------------------------------------------------------------------------- * STATIC FUNC Order_Set( oBrw, nKey, cKey ) * ----------------------------------------------------------------------------------- * LOCAL cOrd := (oBrw:cAlias)->( OrdSetFocus() ) If cOrd == "KOD" oBrw:nCell := oBrw:nColumn('NAM') oBrw:SetOrder( oBrw:nCell ) Else oBrw:nCell := oBrw:nColumn('KOD') oBrw:SetOrder( oBrw:nCell ) EndIf oBrw:SetFocus() RETURN Nil * ----------------------------------------------------------------------------------- * STATIC FUNC Seek__Set( oBr ) * ----------------------------------------------------------------------------------- * LOCAL oBrw := iif( empty(oBr), oTsb, oBr ) LOCAL cBrw := oBrw:Cargo LOCAL cAls := oBrw:cAlias LOCAL cNam := (cAls)->( OrdName() ) LOCAL cVal := _GetValue(cNam, oBrw:cParentWnd) If ! empty(cVal) If cNam == 'KOD' If 'U02' != cBrw cVal := TR0(cVal) EndIf Else cVal := ELRU(Trim(upper(cVal))) EndIf (cAls)->( dbSeek(cVal) ) oBrw:GotoRec( (cAls)->( RecNo()) ) DoEvents() EndIf RETURN Nil * ----------------------------------------------------------------------------------- * STATIC FUNC Press_Key( oBrw, nKey, cKey ) * ----------------------------------------------------------------------------------- * LOCAL cNam := (oBrw:cAlias)->( OrdName() ) LOCAL oSpr := _WindowObj(oBrw:cParentWnd) LOCAL oGet := oSpr:GetObj(cNam) If empty(nKey) oGet:Show() oGet:SetFocus() DoEvents() Else cKey := VK2Char(nKey) If len(cKey) > 0 oGet:Show() oGet:SetFocus() DoEvents() oGet:Get:VarPut(space(len(oGet:Get:Picture))) _PushKey(nKey) EndIf EndIf RETURN Nil * ----------------------------------------------------------------------------------- * STATIC FUNC Recno_Get( oBrw, nKey, cKey ) * ----------------------------------------------------------------------------------- * LOCAL cID := oBrw:Cargo LOCAL cAls := oBrw:cAlias LOCAL oWnd := _WindowObj(oBrw:cParentWnd) If cID $ 'U03,U04' AAdd(aReturn, (cAls)->R_1) AAdd(aReturn, (cAls)->R_2) ElseIf cID $ 'AGENT,KART' AAdd(aReturn, (cAls)->TNOM) AAdd(aReturn, (cAls)->FIO ) EndIf oWnd:Release() RETURN Nil ЗЫ oGet:OnEscape := {|og| og:GetObj():Hide(), oTbr:SetFocus(), .T. } oGet:OnEnter := {|og| og:GetObj():Hide(), oTbr:SetFocus() } oGet:OnDown := {|og| og:GetObj():Hide(), oTbr:SetFocus() } oGet:OnUp := {|og| og:GetObj():Hide(), oTbr:SetFocus() } это аналоги oGet:SetKeyEvent В задаче применяю (окно с тсб и рядом типа карточки) y := nRow x := nCol n := 'KliKod' // код клиента (справочник) @ y, x GETBOX &n OBJ o WIDTH oSt:W(10) HEIGHT oSt:H('G') VALUE space(4) ACTION wPost(91) IMAGE 'view' ; VALID SayGet_Value(.T., .T.) BACKCOLOR BG FONTCOLOR FC o:lOnGotFocusSelect := .T. o:OnEscape := {|og| oView:SetFocus(), .T. } o:OnF5 := {| | wPost(91) } y += This.&(n).Height + b n := 'KliNam' @ y, x GETBOX &n OBJ o WIDTH oSt:W(35) HEIGHT oSt:H('G') VALUE space(10) ; READONLY BACKCOLOR BG FONTCOLOR FC NOTABSTOP ... y += This.&(n).Height + b n := 'KliAgent' // код агента, для клиента (справочник) @ y, x GETBOX &n OBJ o WIDTH oSt:W(10) HEIGHT oSt:H('G') VALUE space(5) ACTION wPost(92) IMAGE 'view' ; VALID SayAgent_Value(.T., .T.) PICTURE '99999' BACKCOLOR BG FONTCOLOR FC o:lOnGotFocusSelect := .T. o:OnF5 := {| | wPost(92) } o:OnEscape := {|og| oView:SetFocus(), .T. } This.&(n).Value := TR0( Alltrim(gProp(Agent)), Len( This.&(n).Value ) ) x += This.&(n).Width n := 'NamAgent' @ y, x GETBOX &n OBJ o WIDTH oSt:W(25) HEIGHT oSt:H('G') VALUE space(30) ; READONLY BACKCOLOR BG FONTCOLOR FC NOTABSTOP ... и события (как я без них) For i := 1 To nCnt :Event( i, {|ow,ky| PressTBar(ow, ky), TsbCreate(ow, ky) } ) Next :Event( 91, {|ow | KliU04(ow) } ) :Event( 92, {|ow | KliAgent(ow) } ) :Event( 98, {|ow | OrdSave(ow) } ) :Event( 99, {|ow | oWnd:Action := .T., ow:Release() } ) END WITH // ---- Window events ... [/pre2]

Haz: Сергей Haz пишет: У меня есть очень draft, ну совсем бета альтернативного комбо в ячейке. Выдернул из проекта , переписал под CDX вроде работает . Логика похожа на твой пример - те же массивы заголовков, полей и пр. Подчеркиваю это совсем бета , по мере допиливаю понемногу. Но что это понятно из примера [pre2] #include "minigui.ch" #include "tsbrowse.ch" #include "hmg.ch" #include "common.ch" Static oMain Procedure Main() local i := 0 local cCol := "" PUBLIC aFont := {} SET OOP ON REQUEST DBFCDX SET CENTURY ON SET DELETED ON RDDSETDEFAULT('DBFCDX') DEFINE FONT Font_1 FONTNAME "Arial" SIZE 8 DEFINE FONT Font_2 FONTNAME "Arial" SIZE 8 ITALIC AAdd( aFont, GetFontHandle( "Font_1" ) ) AAdd( aFont, GetFontHandle( "Font_2" ) ) if ! File('base1.dbf') DBCreate( "BASE1.DBF" , {{"REC", "N", 4, 0},{"ID", "N", 4, 0} } ) end if ! File('base2.dbf') DBCreate( "BASE2.DBF" , {{"ID", "N", 4, 0}, {"NAME", "C", 20, 0} } ) end USE "BASE1.DBF" EXCL NEW ALIAS "BASE1" USE "BASE2.DBF" EXCL NEW ALIAS "BASE2" IF BASE2->(Eof()) FOR i := 1 TO 100 BASE2->(dbAppend()) BASE2->ID := i BASE2->NAME := RandStr( 20 ) END INDEX ON ID TAG "ID" TO "BASE2" END IF BASE1->(Eof()) FOR i := 1 TO 10 BASE1->(dbAppend()) BASE1->ID := i END END BASE2->(OrdSetFocus("ID")) DEFINE WINDOW Form1 ; AT 0,0 ; WIDTH 355 ; HEIGHT 600 ; TITLE "MAIN" ; MAIN ; FONT 'Tahoma' SIZE 10 oMain :=This.Object END WINDOW DEFINE TBROWSE oBrw At 25, 5 ALIAS "BASE1" ; OF Form1 ; WIDTH oMain:ClientWidth - 10 ; HEIGHT oMain:ClientHeight - 10 :LoadFields( TRUE ) :lCellBrw := TRUE :nHeightCell := 22 :nHeightHead := 22 END TBROWSE AEval(oBrw:aColumns(), {|oCol| oCol:bPrevEdit := {|xVal, oBrw| TEST_PrevEdit( xVal, oBrw ) } }) cCol := "REC" oBrw:SetColSize( cCol , 50) with object oBrw:GetColumn( cCol ) :cHeading := "RecNo #" :cPicture := Replicate("9", 4) :lEdit := FALSE :nAlign := DT_RIGHT :bData := { || BASE1->(RECNO()) } end cCol := "ID" oBrw:SetColSize( cCol , 250) with object oBrw:GetColumn( cCol ) :cHeading := "String" :cPicture := Replicate("X", 20) :lEdit := TRUE :nAlign := DT_LEFT :bData := { || SeekID( BASE1->ID ) } end Form1.CENTER ACTIVATE WINDOW Form1 Return FUNCTION RandStr( nLen ) LOCAL cSet := "qwertyuiopasdfghjklzxcvbnmQWERTYUIOPASDFGHJKLZXCVBNM" LOCAL cStr := "" LOCAL i := 0 FOR i := 1 TO nLen cStr += SubStr( cSet, Random( 52 ), 1 ) NEXT RETURN cStr FUNC SeekID(nId) LOCAL xRet := NIL IF BASE2->(dbSeek( nId, FALSE )) xRet := BASE2->NAME END RETURN xRet FUNC TEST_PrevEdit( xVal, oBrw ) LOCAL cCol := Upper(oBrw:aColumns[oBrw:nCell]:cName ) LOCAL cAlias := oBrw:cAlias LOCAL cSql := "" LOCAL nPos := 0 LOCAL nRecSave := 0 LOCAL nOrdSave := 0 LOCAL lRet := TRUE DO CASE CASE cCol == "ID" xLbx := LBX():New() xLbx:cAlias := "BASE2" xLbx:cRetField := "ID" xLbx:aHeaders := {'Тип'} xLbx:aWidth := {250} xLbx:aField := {'NAME'} xLbx:nHeightCell := 20 xLbx:nHeightHead := 0 xLbx:nHeightFoot := 0 xLbx:bPostBlock := {|| NIL } xLbx:ListBox( oBrw, xVal ) lRet := FALSE END RETURN lRet FUNC ToRGB(nColor) LOCAL nR := 0 LOCAL nG := 0 LOCAL nB := 0 LOCAL cColor := NTOC(nColor, 16) /* BBGGRR, где XX - число от 00 до FF. */ nR := CTON(SUBSTR( cColor, 5, 2 ), 16) nG := CTON(SUBSTR( cColor, 3, 2 ), 16) nB := CTON(SUBSTR( cColor, 1, 2 ), 16) RETURN {nR, nG, nB } //////////////////////////////// #include "minigui.ch" #include "tsbrowse.ch" #include "common.ch" #include "hmg.ch" #define GWL_STYLE (-16) #define GWL_EXSTYLE (-20) #define WS_BORDER 0x00800000 #define WS_EX_CLIENTEDGE 0x00000200 #define WS_EX_DLGMODALFRAME 0x00000001 #define WS_EX_LEFTSCROLLBAR 0x00004000 #define WS_EX_TOOLWINDOW 0x00000080 #define WS_DLGFRAME 0x00400000 #include "hbclass.ch" CREATE CLASS Lbx VAR oBrw VAR oBrwParent VAR oWLbx VAR oLbx VAR aHeaders INIT {} VAR aFooters INIT {} VAR aData INIT {} VAR aAlign INIT {} VAR aFAlign INIT {} VAR aHAlign INIT {} VAR aWidth INIT {} VAR aField INIT {} VAR aFont INIT {} VAR cAlias INIT "LBX" VAR cRetField INIT "NAME" VAR bPostBlock INIT nil VAR bSearch INIT nil VAR nHeightCell INIT 20 VAR nHeightHead INIT 20 VAR nHeightFoot INIT 20 METHOD New() METHOD ListBox(oBrw, xVal) METHOD Release(oBrw) METHOD UserKeys( nKey, nFlg, oBrw, oBrwParent, cRetField ) ENDCLASS METHOD Lbx:new() RETURN SELF METHOD Lbx:ListBox(oBrw, xVal) LOCAL nRecCount := 0 LOCAL nCol := 0 LOCAL nWidth := 0 LOCAL nHeight := 0 LOCAL nRow := 0 LOCAl oCell LOCAL aWRect := {0,0,0,0} LOCAL aCRect := {0,0,0,0} LOCAL lFlip := FALSE LOCAL i := 0 LOCAL nWh := 0 if !Empty( ::aWidth ) AEval(::aWidth, {|e| nWh += e + 1 }) end SET OOP ON GetWindowRect(oBrw:hWnd, aWRect ) oCell := oBrw:GetCellinfo(oBrw:nRowPos, oBrw:nCell, FALSE) nCol := oCell:nCol + aWRect[1] - Getproperty(oBrw:cParentWnd, oBrw:cControlName, "Col") nRow := oCell:nRow + aWRect[2] - Getproperty(oBrw:cParentWnd, oBrw:cControlName, "Row") nWidth := oCell:nWidth nHeight := oCell:nHeight // Поправка на координаты прииспользовании TAB IF __objHasData(oBrw, 'nColShift') IF oBrw:nColShift <> NIL nCol := nCol - oBrw:nColShift END END IF __objHasData(oBrw, 'nRowShift') IF oBrw:nRowShift <> NIL nRow := nRow - oBrw:nRowShift END END // // Если правый край выезжает за экрам IF nWh > nWidth IF nCol < aWRect[1] nCol := oCell:nCol + aWRect[1] - Getproperty(oBrw:cParentWnd, oBrw:cControlName, "Col") END IF nWh + nCol > Getproperty(oBrw:cParentWnd, "Width") nCol := Getproperty(oBrw:cParentWnd, "Width") - nWh - 35 END nWidth := nWh END // Если выезжает за низ окна IF oMain:ClientHeight - nRow - 130 < Min( ((::cAlias)->(RecCount()) + 2) * ::nHeightCell ,300 ) // Нужно показывать вверх lFlip := TRUE END DEFINE WINDOW LBEX ; AT nRow + IF( lFlip, -Min( ( (::cAlias)->(RecCount()) + 2) * ::nHeightCell ,300 ), nHeight ), nCol ; WIDTH nWidth ; HEIGHT Min( (::cAlias)->(RecCount() + 2) * (::nHeightCell) + (::nHeightCell) ,300 ) ; NOCAPTION ; CHILD ; ON LOSTFOCUS {|| oWLbx:Release()} ; ON RELEASE {|| ::Release( oBrw ) } oWLbx :=This.Object END WINDOW hWnd := GetFormHandle("LBEX") SetWindowLong(hWnd, GWL_EXSTYLE, WS_EX_TOOLWINDOW ) SetWindowLong(hWnd, GWL_STYLE, WS_DLGFRAME) (::cAlias)->(dbGoTop()) DEFINE TBROWSE oLbx At 25, 0 ALIAS ::cAlias ; OF LBEX ; WIDTH oWLbx:Width-3 ; HEIGHT oWLbx:Height - 30 ; END TBROWSE ::oBrw := oLbx ::oBrwParent := oBrw SetWindowLong (::oBrw:hWnd, GWL_EXSTYLE, WS_EX_STATICEDGE) if hb_isArray(::aField) .AND. Len( ::aField) > 0 ::oBrw:aColSel := ::aField endif ::oBrw:LoadFields( TRUE ) ::oBrw:lCellBrw := TRUE ::oBrw:nHeightCell := ::nHeightCell ::oBrw:nHeightHead := ::nHeightHead ::oBrw:nHeightFoot := ::nHeightFoot ::oBrw:lNoChangeOrd := TRUE ::oBrw:lNoHScroll := TRUE ::oBrw:ChangeFont( M->aFont[ 1 ], , 3 ) // nLevel 1 = Cells 2= Headers 3 = Footers ::oBrw:ChangeFont( M->aFont[ 1 ], , 2 ) // nLevel 1 = Cells 2= Headers 3 = Footers ::oBrw:ChangeFont( M->aFont[ 2 ], , 1 ) // nLevel 1 = Cells 2= Headers 3 = Footers ::oBrw:bLDblClick := {|| ; (::oBrwParent:cAlias)->&(::oBrwParent:GetColumn(::oBrwParent:nCell):cName ) := (::oBrw:cAlias)->&(::cRetField),; oWLbx:Release(); } ::oBrw:bUserKeys := {|nKy,nFl,oBr| ::UserKeys(nKy, nFl, oBr ) } ::oBrw:SetColor( { 6 }, { { |a,b,c| IF( c:nCell == b, -CLR_HRED , -RGB(128,225,225) ) } } ) // фон курсора ::oBrw:SetColor( { 2 }, { { || GetSysColor( COLOR_BTNFACE ) } }, ) // фон ::oBrw:hBrush := CreateSolidBrush( ToRGB(GetSysColor( COLOR_BTNFACE ))[1],; ToRGB(GetSysColor( COLOR_BTNFACE ))[2],; ToRGB(GetSysColor( COLOR_BTNFACE ))[3] ) IF hb_isArray( ::aWidth ) .AND. Len( ::aWidth ) > 0 FOR i := 1 TO Len(::aWidth) ::oBrw:SetColSize(i, ::aWidth[ i ] ) END ELSE ::oBrw:SetColSize(1, nWidth ) END IF hb_IsArray( ::aHeaders ) .AND. Len( ::aHeaders ) > 0 FOR i := 1 TO Len(::aHeaders) ::oBrw:aColumns[ i ]:cHeading := ::aHeaders[ i ] END END AEval(::oBrw:aColumns(), {|oCol| oCol:nClrSeleBack := oCol:nClrFocuBack, oCol:nClrSeleFore := oCol:nClrFocuFore, oCol:lEdit := FALSE }) DEFINE IMAGE Image_1 PARENT LBEX ROW 3 COL 0 WIDTH 15 HEIGHT 15 PICTURE 'FIND' STRETCH .F. END IMAGE DEFINE GETBOX Text_FTS PARENT LBEX ROW 0 COL 16 WIDTH oWLbx:Width - 42 HEIGHT ::nHeightCell VALUE Space(100) FONTNAME 'Arial' FONTSIZE 9 FONTBOLD FALSE TOOLTIP '' READONLY FALSE MAXLENGTH 100 BACKCOLOR {255,255,255} ON CHANGE IF( HB_IsBlock(::bSearch), Eval( ::bSearch, ::Self , This.Value ), nil ) END GETBOX DEFINE BUTTONEX Button_Del PARENT LBEX ROW 3 COL oWLbx:Width - 22 WIDTH 15 HEIGHT 15 ACTION {|| (::oBrwParent:cAlias)->&( ::oBrwParent:GetColumn(oBrw:nCell):cName ) := 0, oWLbx:Release() } CAPTION "" PICTURE "DB_CANCEL" TABSTOP .F. TOOLTIP "ВНИМАНИЕ Нажимая здесь Вы очистите значение в ячейке таблицы !" FONTNAME "Arial" FONTSIZE 9 END BUTTONEX ON KEY ESCAPE OF LBEX ACTION LBEX.Release Domethod( "LBEX", "Text_FTS", "SetFocus") ::oBrw:SetNoHoles() ::oBrw:SetFocus() ::oBrw:Reset() ACTIVATE WINDOW LBEX RETURN NIL METHOD Release( oBrw ) oBrw:SetFocus() oBrw:DrawSelect() IF(HB_IsBlock( ::bPostBlock), Eval(::bPostBlock, oBrw, oLbx ), NIL) RETURN NIL METHOD UserKeys( nKey, nFlg, oBrw ) Local uRet, cOrd, oCell, nRow, nPos nFlg := Nil do case case nKey == VK_RETURN .OR. nKey == VK_SPACE uRet := .F. (::oBrwParent:cAlias )->&( ::oBrwParent:GetColumn(::oBrwParent:nCell):cName ) := (::oBrw:cAlias)->&(::cRetField) oWLbx:Release() Case nKey < 48 oBrw:SetFocus() otherwise uRet := .F. oBrw:SetFocus() End RETURN uRet [/pre2]

SergKis: Игорь Поправь [ i ], начиная с этого текста и т.д. [pre2] IF hb_isArray( ::aWidth ) .AND. Len( ::aWidth ) > 0 FOR i := 1 TO Len(::aWidth) ::oBrw:SetColSize(i, ::aWidth[ i ] ) END ELSE ::oBrw:SetColSize(1, nWidth ) END [/pre2]

Dima: SergKis пишет: Игорь Поправь [ i ], начиная с этого текста и т.д. Поправил

Haz: Dima пишет: Поправил и я

SergKis: Haz пишет Глянешь, интересны идеи. Суть в том, что вместо комбика попытался использовать бровс по базе 1.Таких вариантов поля (Id -> наименование) замена, практически нет в работе, все как то сложнее. 2.Кроме id записи, есть клиентский код, который пользователи любят и вводят его (многие наизусть), а не через наименование. К примеру: - ФИО однозначно не определяет запись, надо ТАБ.НОМЕР и\или персональный код - наименование магазина, так же однозначно на дает запись, надо страну\город\адрес\регистр.номер(ИНН) или клиентский код - группы материалов\товаров могут иметь одинаковые наименования, но разные клиентские коды и др. показатели. ... 3.От ведения на тсб практически отказался, осталось только на совсем простеньких справочниках. Ввод, корректировку делаю на окне типа InputWindow(...) из hmg. Там validы, заполнение доп. полей и т.д. 4. Замену ComboBox-у делаю на GetBox-ах, как показал в примере выше. Если исп. в тсб на колонке вызов справочника, то исп. установку клавиши F5 на колонку (изменеия в MiniGui.lib перед примером выше) и VALID колонки, если значение задают не через вызов справочника, а кодом руками. Есть такое использование (в тсб) на окнах запросов для получения отчетов. 5.Мысли по твоему варианту: - возможность указывать, кол-во строк в тсб, если меньше, то окно меньше - располагать окно с тсб не только сверху\снизу, но и слева\справа, указывая L[eft],R[ight],T[op],B[ottom] - если использовать механизм назначенной клавиши для вызова списка, ввод в само поле можно исп. для поиска в списке или в footer, как у меня в примере

SergKis: Haz, Dima Как то правка не прошла [pre2] ::oBrw:aColumns[ i ]:cHeading := ::aHeaders[ i ] // тут надо, может и ниже тоже END END [/pre2]

Haz: SergKis пишет: Мысли по твоему варианту Про назначение клавиш - спасибо. Прикину как прикрутить. В остальном пример сильно кастрирван. Там есть список полей, которые нужно показать в бровсе и поле которое нужно вернуть из справочника. ID и NAME это частный случай. Поиск по справочнику делаю по содержимому getbox через вызов bSearch. В примере не смог его показать т. к. это FTS поиск от ADS, то есть по вхождению в любых полях. Как в CDX сделать не знаю. У меня для поиска клиента, к примеру, можно в Getbox ввести ИНН или КПП или форму собственноси или почтрвый индекс или чего ещё. или через пробел все это сразу сразу. В FTS задается что искать, любое или все. И бровс фильтрует записи по условию поиска. Все уже привыкли не думая набирать или часть наименования или адреса или телефона. А вот до назначения клавиш я не допер. Повешу на них доп инструмент. У меня главный косяк в том что на модальной форме этот бровс ругается что из модала можно только модал. А если бровс сам сделать модальным, то на нем не отыграть потерю фокуса так как модал не его потерять). Твой пример посмотрел, все понятно. Спасибо буду использовать

SergKis: Haz пишет У меня главный косяк в том что на модальной форме этот бровс ругается что из модала можно только модал. А если бровс сам сделать модальным, то на нем не отыграть потерю фокуса так как модал не его потерять). 1 Можно делать два типа окна для child и modal имея признак в объекте. - modal делать похожим на справочник и иметь кнопку выхода+Esc - child как сейчас, но можно и одинаково оформлять вызывать с модального окна модальный режим, с др. child 2 GetBox_FTS можно делать с двумя\одной родными кнопками с image для поиска\очистки или еще что то. 3 Исп. не bPrevEdit, а Valid и назн. клавишу для вызова списка, тогда в поле TGETBOX можно не вызывая списка вводить, если был On Change (меняем значение в поле тсб - поиск) по клавише или в valid по Enter вызываем объект списка, переносим значение из TGETBOX в GetBox_FTS с отработкой оного. 4 Иметь метод в объекте установки Row, Col отображения списка относительно родителя и задания кол-ва строк в списке

Haz: SergKis пишет: Можно делать два типа окна для child и modal 1 Буду тип задавать по типу родителя. Так решается проблема что из чего вызывать. Вот как быть с потерей фокуса у модала ?? не дает он его терять, а у меня на это событие справочник закрывается с отказом от выбора. 2 - 4 Согласен . это уже детали реализации.

SergKis: Haz пишет Вот как быть с потерей фокуса у модала ?? не дает он его терять, а у меня на это событие справочник закрывается с отказом от выбора. По мне, выбор по Enter, DblClick, Button Ok (выбор сделан, список убираем), а все остальное отказ. Выход базовый по кнопке крестику (своя, работа с NOCAPTION .T.) или Esc (отказ, список убираем). Потеря фокуса - для child режима - частный случай отказа

SergKis: PS Игорь, вспомнилось, ты вроде занимался морганием модальных окон при потере фокуса, можно туда приблуду вставить типа, по handle окна получить объект (если есть) и получить свойство bBlock := oW:GetProp('LostFocus') и если блок задан, выполнить Do_WindowEventProcedure ( bBlock, oW:Index, oW ) В объект окна списка ставить блок (ThisWindow.Object):SetProp('LostFocus', {|ow| ow:Release() }

Haz: SergKis пишет: Игорь, вспомнилось, ты вроде занимался морганием модальных окон при потере фокуса, можно туда приблуду вставить Примерно так и думаю. Пока ещё не смотрел. Хочу сделать не трогая исходников. Не получится., придется править.

SergKis: Haz пишет Не получится., придется править. Тогда в TWndData можно добавить DATA bLostFocusModal и устанавливать и работать с ним

Andrey: Andrey пишет: Сделал в версии 18.04 кол-во строк 240, подвал есть. На 250 строках подвала уже нет и вот такая таблица получается: ..... Что-то ерундит алгоритм выгрузки в эксель. Как и где подправить ? Предложение по правке этой ошибки (h_tbrowse.prg): [pre2] nColHead := 0 For nCol := 1 To Len( ::aColumns ) If aColSel != Nil .and. AScan( aColSel, nCol ) == 0 Loop EndIf uData := If( ValType( ::aColumns[ nCol ]:cHeading ) == "B", Eval( ::aColumns[ nCol ]:cHeading ), ; ::aColumns[ nCol ]:cHeading ) If ValType( uData ) != "C" Loop EndIf uData := StrTran( uData, CRLF, Chr( 10 ) ) nColHead ++ oSheet:Cells( nLine, nColHead ):Value := uData If hProgress != Nil If nCount % nEvery == 0 SendMessage( hProgress, PBM_SETPOS, nCount, 0 ) EndIf nCount ++ EndIf Next nStart := ++ nLine // поставить вместо этого nStart := nLine + 1 EndIf[/pre2] И ещё при печати подвала: [pre2] If AScan( ::aColumns, { |o| o:cFooting != Nil } ) > 0 For nCol := 1 To Len( ::aColumns ) If ( aColSel != Nil .and. AScan( aColSel, nCol ) == 0 ) .or. ::aColumns[ nCol ]:cFooting == Nil Loop EndIf uData := If( ValType( ::aColumns[ nCol ]:cFooting ) == "B", Eval( ::aColumns[ nCol ]:cFooting ), ; ::aColumns[ nCol ]:cFooting ) uData := cValTochar( uData ) uData := StrTran( uData, CRLF, Chr( 10 ) ) oSheet:Cells( nLine + 1, nCol ):Value := uData // вот так сделать Next EndIf[/pre2] Григорий, файл h_tbrowse.prg который присылал мне, я исправил и выслал на почту.

gfilatov2002: Andrey пишет: Предложение по правке этой ошибки Благодарю за это исправление Проблема с выводом подвала решена

Andrey: gfilatov2002 пишет: Проблема с выводом подвала решена ДА ! И проблема показа текстовых столбцов вида 3/2, 1/5 и т.д. ТОЖЕ решена в отправленном модуле !

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