Автор | Сообщение |
Vlad04
|
| постоянный участник
|
Пост N: 420
Зарегистрирован: 13.10.05
|
|
Отправлено: 19.12.13 18:16. Заголовок: TsBrowse в Минигуи (продолжение)
TsBrows определяется в виде строки ПАРМЕТРОВ объекта и их значений К примеру цитата: | 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 |
| Здесь я собрал параметры из разных tBrows Можно или нет и какие парметры заменить выражением ( и каким) ? oBrw2:.... oBrw2:....
| |
|
Ответов - 300
, стр:
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
All
[только новые]
|
|
SergKis
|
| постоянный участник
|
Пост N: 1810
Зарегистрирован: 17.02.12
|
|
Отправлено: 11.05.18 19:19. Заголовок: PS DATA bKeyEvent н..
PS DATA bKeyEvent надо убрать, остался от опытов
| |
|
Haz
|
| |
Пост N: 1240
Зарегистрирован: 20.02.11
|
|
Отправлено: 11.05.18 22:17. Заголовок: SergKis пишет: У се..
SergKis пишет: цитата: | У себя исп. вариант без кнопки |
| Сергей. Спасибо. В понедельник поткстирую
| |
|
Haz
|
| |
Пост N: 1241
Зарегистрирован: 20.02.11
|
|
Отправлено: 11.05.18 22:58. Заголовок: Сергей : может буде..
Сергей : У меня есть очень draft, ну совсем бета альтернативного комбо в ячейке. Руки не доходят довести до ума, но испьзую так как есть. В понедельник скину в форум пример. Глянешь, интересны идеи. Суть в том, что вместо комбика попытался использовать бровс по базе. В последних проектах использую успешно, хоть и бета. А вот времени на осмысление нет. И чтоб совсем точки над ё, я не прошу сделать за меня. Я предлагаю идею и готов выслушать мнение.
| |
|
SergKis
|
| постоянный участник
|
Пост N: 1811
Зарегистрирован: 17.02.12
|
|
Отправлено: 12.05.18 00:04. Заголовок: Haz пишет Суть в том..
Haz пишет цитата: | Суть в том, что вместо комбика попытался использовать бровс по базе. |
| С этого начинал, с combo (и с поиском по букве). В итоге отказался, со временем маленький список -> в большой, + колонки ... Практически везде перехожу на тсб (с hb 2.0 browse, на 3.2 переделываю на тсб) цитата: | А вот времени на осмысление нет. |
| Со временем туго, согласен, справочники делаю по такой схеме (с поправками на задачу конечно), как идея (код из задачи, как есть) Скрытый текст
// 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 ...
|
| |
|
Haz
|
| |
Пост N: 1244
Зарегистрирован: 20.02.11
|
|
Отправлено: 14.05.18 18:09. Заголовок: Сергей Haz пишет: У..
Сергей Haz пишет: цитата: | У меня есть очень draft, ну совсем бета альтернативного комбо в ячейке. |
| Выдернул из проекта , переписал под CDX вроде работает . Логика похожа на твой пример - те же массивы заголовков, полей и пр. Подчеркиваю это совсем бета , по мере допиливаю понемногу. Но что это понятно из примера Скрытый текст
#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
|
| |
|
SergKis
|
| постоянный участник
|
Пост N: 1812
Зарегистрирован: 17.02.12
|
|
Отправлено: 14.05.18 19:08. Заголовок: Игорь Поправь , начи..
Игорь Поправь [ i ], начиная с этого текста и т.д. 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
| |
|
Dima
|
| |
Пост N: 6825
Зарегистрирован: 17.05.05
|
|
Отправлено: 14.05.18 21:46. Заголовок: SergKis пишет: Игор..
SergKis пишет: цитата: | Игорь Поправь [ i ], начиная с этого текста и т.д. |
| Поправил
| |
|
Haz
|
| |
Пост N: 1245
Зарегистрирован: 20.02.11
|
|
Отправлено: 14.05.18 21:50. Заголовок: Dima пишет: Поправи..
Dima пишет: и я
| |
|
SergKis
|
| постоянный участник
|
Пост N: 1813
Зарегистрирован: 17.02.12
|
|
Отправлено: 14.05.18 22:00. Заголовок: Haz пишет Глянешь, и..
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
|
| постоянный участник
|
Пост N: 1814
Зарегистрирован: 17.02.12
|
|
Отправлено: 14.05.18 22:12. Заголовок: Haz, Dima Как то пр..
Haz, Dima Как то правка не прошла ::oBrw:aColumns[ i ]:cHeading := ::aHeaders[ i ] // тут надо, может и ниже тоже END END
| |
|
Haz
|
| |
Пост N: 1247
Зарегистрирован: 20.02.11
|
|
Отправлено: 14.05.18 23:08. Заголовок: SergKis пишет: Мысл..
SergKis пишет: Про назначение клавиш - спасибо. Прикину как прикрутить. В остальном пример сильно кастрирван. Там есть список полей, которые нужно показать в бровсе и поле которое нужно вернуть из справочника. ID и NAME это частный случай. Поиск по справочнику делаю по содержимому getbox через вызов bSearch. В примере не смог его показать т. к. это FTS поиск от ADS, то есть по вхождению в любых полях. Как в CDX сделать не знаю. У меня для поиска клиента, к примеру, можно в Getbox ввести ИНН или КПП или форму собственноси или почтрвый индекс или чего ещё. или через пробел все это сразу сразу. В FTS задается что искать, любое или все. И бровс фильтрует записи по условию поиска. Все уже привыкли не думая набирать или часть наименования или адреса или телефона. А вот до назначения клавиш я не допер. Повешу на них доп инструмент. У меня главный косяк в том что на модальной форме этот бровс ругается что из модала можно только модал. А если бровс сам сделать модальным, то на нем не отыграть потерю фокуса так как модал не его потерять). Твой пример посмотрел, все понятно. Спасибо буду использовать
| |
|
|
SergKis
|
| постоянный участник
|
Пост N: 1816
Зарегистрирован: 17.02.12
|
|
Отправлено: 16.05.18 12:19. Заголовок: Haz пишет У меня гла..
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
|
| |
Пост N: 1249
Зарегистрирован: 20.02.11
|
|
Отправлено: 16.05.18 16:14. Заголовок: SergKis пишет: Можн..
SergKis пишет: цитата: | Можно делать два типа окна для child и modal |
| 1 Буду тип задавать по типу родителя. Так решается проблема что из чего вызывать. Вот как быть с потерей фокуса у модала ?? не дает он его терять, а у меня на это событие справочник закрывается с отказом от выбора. 2 - 4 Согласен . это уже детали реализации.
| |
|
SergKis
|
| постоянный участник
|
Пост N: 1817
Зарегистрирован: 17.02.12
|
|
Отправлено: 16.05.18 17:07. Заголовок: Haz пишет Вот как б..
Haz пишет цитата: | Вот как быть с потерей фокуса у модала ?? не дает он его терять, а у меня на это событие справочник закрывается с отказом от выбора. |
| По мне, выбор по Enter, DblClick, Button Ok (выбор сделан, список убираем), а все остальное отказ. Выход базовый по кнопке крестику (своя, работа с NOCAPTION .T.) или Esc (отказ, список убираем). Потеря фокуса - для child режима - частный случай отказа
| |
|
SergKis
|
| постоянный участник
|
Пост N: 1818
Зарегистрирован: 17.02.12
|
|
Отправлено: 16.05.18 18:11. Заголовок: PS Игорь, вспомнилос..
PS Игорь, вспомнилось, ты вроде занимался морганием модальных окон при потере фокуса, можно туда приблуду вставить типа, по handle окна получить объект (если есть) и получить свойство bBlock := oW:GetProp('LostFocus') и если блок задан, выполнить Do_WindowEventProcedure ( bBlock, oW:Index, oW ) В объект окна списка ставить блок (ThisWindow.Object):SetProp('LostFocus', {|ow| ow:Release() }
| |
|
Haz
|
| |
Пост N: 1251
Зарегистрирован: 20.02.11
|
|
Отправлено: 16.05.18 19:51. Заголовок: SergKis пишет: Игор..
SergKis пишет: цитата: | Игорь, вспомнилось, ты вроде занимался морганием модальных окон при потере фокуса, можно туда приблуду вставить |
| Примерно так и думаю. Пока ещё не смотрел. Хочу сделать не трогая исходников. Не получится., придется править.
| |
|
SergKis
|
| постоянный участник
|
Пост N: 1820
Зарегистрирован: 17.02.12
|
|
Отправлено: 16.05.18 21:12. Заголовок: Haz пишет Не получит..
Haz пишет цитата: | Не получится., придется править. |
| Тогда в TWndData можно добавить DATA bLostFocusModal и устанавливать и работать с ним
| |
|
Andrey
|
| постоянный участник
|
Пост N: 5871
Зарегистрирован: 12.09.06
|
|
Отправлено: 17.05.18 13:49. Заголовок: Andrey пишет: Сдела..
Andrey пишет: цитата: | Сделал в версии 18.04 кол-во строк 240, подвал есть. На 250 строках подвала уже нет и вот такая таблица получается: ..... Что-то ерундит алгоритм выгрузки в эксель. Как и где подправить ? |
| Предложение по правке этой ошибки (h_tbrowse.prg): 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 И ещё при печати подвала: 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 Григорий, файл h_tbrowse.prg который присылал мне, я исправил и выслал на почту.
| |
|
gfilatov2002
|
| moderator
|
Пост N: 1279
Зарегистрирован: 11.02.10
|
|
Отправлено: 17.05.18 15:36. Заголовок: Andrey пишет: Предл..
Andrey пишет: цитата: | Предложение по правке этой ошибки |
| Благодарю за это исправление Проблема с выводом подвала решена
| |
|
Andrey
|
| постоянный участник
|
Пост N: 5873
Зарегистрирован: 12.09.06
|
|
Отправлено: 17.05.18 17:25. Заголовок: gfilatov2002 пишет: ..
gfilatov2002 пишет: цитата: | Проблема с выводом подвала решена |
| ДА ! И проблема показа текстовых столбцов вида 3/2, 1/5 и т.д. ТОЖЕ решена в отправленном модуле !
| |
|
Ответов - 300
, стр:
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
All
[только новые]
|
|
|