Форум » 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:....
SergKis: Andrey пишет Можно ли при открытие базы в ТСБ (метод dbf) создать 6 своих виртуальных колонок перед колонками dbf ? Вариантов много. Вот один из них[pre2] BEGIN SEQUENCE WITH { |e|break(e) } DbUseArea( .F., cRdd, cFile, cAls, lShared, , cCdp ) lUse := ! NetErr() .and. Used() nMsg := 0 END SEQUENCE IF lUse k := 6 aField := Array(FCount()+k) aField[1] := FieldName(1) aField[2] := FieldName(1) aField[3] := FieldName(1) aField[4] := FieldName(1) aField[5] := FieldName(1) aField[6] := FieldName(1) FOR i := 1 TO FCount() ; aField[ k+i ] := FieldName(i) NEXT ENDIF ... DEFINE TBROWSE oBrw AT y,x WIDTH w HEIGHT h CELL ; ALIAS ALIAS() ; FONT (App.Object):Cargo:aFonts ; BRUSH { 255, 255, 230 } ; COLORS aClr ; ON GOTFOCUS oCar:FocusedControl := "oBrw" ; COLUMNS aField ; FOOTER .T. ; FIXED COLSEMPTY ; LOADFIELDS GOTFOCUSSELECT ; COLNUMBER { k+1, 60 } ; ENUMERATOR LOCK ... FOR i := 1 TO :aColumns o := :aColumns[ i [ IF o:cName == "ORDKEYNO" ; EXIT ENDIF o:cAlias := :cAlias o:bData := {|| Nil } o:bValue := {|u,obr,ncol,ocol| Local nrec := (obr)->( RecNo() ) u := ocol[ncol]:Cargo[nrec] // вирт. значение Return u } o:cField := "" switch i case 1 o:Cargo := aVirtual1 // массив виртуальных данных o:cName := VIRT1 o:cFieldTyp := "C" o:nFieldLen := 20 o:nFieldDec := 0 o:nWidth := o:ToWidth(o:nFieldLen, 0.8) exit case 2 o:Cargo := aVirtual2 // массив виртуальных данных o:cName := VIRT2 o:cFieldTyp := "N" o:nFieldLen := 7 o:nFieldDec := 0 o:nWidth := o:ToWidth(o:nFieldLen) exit case 3 ... exit case 4 ... exit case 5 ... exit case 6 ... exit end switch NEXT ... [/pre2]
SergKis: PS Еще сбросить или поставить Picture для колонки o:cPicture := Nil
SergKis: SergKis пишет Вот один из них Работающий вариант с 6-ю вирт. колонками [pre2] FUNCTION GetVirtAll() // создали массивы со значениями для вирт. колонок Local aDim1 := {}, aDim2 := {}, aDim3 := {}, aDim4 := {}, aDim5 := {}, aDim6 := {} Local nOld := RecNo(), cAls := ALIAS(), nRec GO TOP DO WHILE !EOF() nRec := RecNo() AAdd(aDim1, nRec + 10) AAdd(aDim2, nRec + 20) AAdd(aDim3, nRec + 30) AAdd(aDim4, nRec + 40) AAdd(aDim5, nRec + 50) AAdd(aDim6, nRec + 60) SKIP ENDDO GOTO nOld RETURN { aDim1, aDim2, aDim3, aDim4, aDim5, aDim6 } ... SELECT 0 cAls := "_A_"+hb_ntos(Select())+"_" BEGIN SEQUENCE WITH { |e|break(e) } DbUseArea( .F., cRdd, cFile, cAls, lShared, , cCdp ) lUse := ! NetErr() .and. Used() nMsg := 0 END SEQUENCE IF lUse aField := Array(FCount()+6) aField[1] := FieldName(1) aField[2] := FieldName(1) aField[3] := FieldName(1) aField[4] := FieldName(1) aField[5] := FieldName(1) aField[6] := FieldName(1) FOR i := 1 TO FCount() ; aField[ k+i ] := FieldName(i) NEXT ENDIF ... IF lUse This.Cargo:aVirtualAll := GetVirtAll() AAdd(aClr, { 6, {|c,n,b| c := n, iif( b:nCell == n, -CLR_BLUE, -RGB(128,225,225) ) } } ) AAdd(aClr, {12, {|c,n,b| c := n, iif( b:nCell == n, -CLR_BLUE, -RGB(128,225,225) ) } } ) x := 2 i := 1 y := GetWindowHeight(hSpl) + i h := This.ClientHeight - y - i * 2 - 1 w := This.ClientWidth - x * 2 This.Cargo:nSplitHeight := y DEFINE TBROWSE oBrw AT y,x WIDTH w HEIGHT h CELL ; ALIAS ALIAS() ; FONT (App.Object):Cargo:aFonts ; BRUSH { 255, 255, 230 } ; COLORS aClr ; ON GOTFOCUS oCar:FocusedControl := "oBrw" ; COLUMNS aField ; FOOTER .T. ; FIXED COLSEMPTY ; LOADFIELDS GOTFOCUSSELECT ; COLNUMBER { 6+1, 60 } ; ENUMERATOR LOCK :Cargo := oKeyData() :nColOrder := 0 :lNoChangeOrd := .T. :nWheelLines := 1 :lNoGrayBar := .F. :lNoLiteBar := .F. :lNoResetPos := .F. :lNoPopUp := .T. :lNoHScroll := .T. :nCellMarginLR := 1 :nStatusItem := 0 :lNoKeyChar := .T. // method :KeyChar disabled :lCheckBoxAllReturn := .T. // Enter modify value oCol:lCheckBox :lPickerMode := .F. // формат даты нормальный :nHeightCell := (App.Object):H1 + 3 :nHeightHead := :nHeightCell :nHeightFoot := :nHeightCell :SetDeleteMode( .T., .F., {|rec,obr| DelRecords(rec, obr) }, ; {|obr| obr:Cargo:nRecnoDraw := 0, obr:DrawSelect() } ) FOR i := 1 TO Len(:aColumns) o := :aColumns[ i ] IF o:cName == "ORDKEYNO"; EXIT ENDIF o:cAlias := :cAlias o:Cargo := This.Cargo:aVirtualAll[ i ] // массив виртуальных данных o:cName := 'VIRT'+hb_ntos(i) o:cHeading := "("+hb_ntos(i)+")" o:cFooting := "" o:cPicture := Nil o:bData := {|| Nil } o:bValue := {|u,obr,ncol,ocol| Local nrec := (obr:cAlias)->( RecNo() ) u := ocol:Cargo[nrec] // вирт. значение Return u } o:nAlign := DT_CENTER o:nFAlign := DT_CENTER o:cField := "" o:cFieldTyp := "N" o:nFieldLen := 5 o:nWidth := o:ToWidth(o:nFieldLen) NEXT ... [/pre2]
Avf: При вызове CONTEXT MENU для TsBrowse , CONTEXT MENU в другом окне не работает. Хотя для других контролов все нормально. Так в примере ниже: CONTEXT MENU OF Form2 появляется после ITEM "Item 1 from TBROWSE" ACTION Window2(), а после ITEM "Item 1 from BUTON" ACTION Window2() - нет. [pre2] #include "minigui.ch" #include "TSBrowse.ch" #translate dbcreate(<file>, <struct>) => hb_dbcreatetemp(<file>, <struct>) PROCEDURE main LOCAL i, br_zaw dbCreate( 'test', { { 'c1', 'C', 30, 0 }, ; { 'n1', 'N', 12, 2 } } ) IF SELECT( 'test' ) == 0 dbUseArea( .T.,, 'test' ) ENDIF FOR i := 1 TO 100 test->( dbAppend() ) test->c1 := Str( i ) test->n1 := test->( RecNo() ) NEXT test->( dbGoTop() ) DEFINE WINDOW Form1 ; AT 0,0 ; WIDTH 640 ; HEIGHT 480 ; TITLE "HMG Example of Context Menu" ; MAIN ; FONT 'Tahoma' SIZE 9 DEFINE TBROWSE oBrw AT 15, 10 OF Form1 ALIAS "test" WIDTH 450 HEIGHT 330 ADD COLUMN TO oBrw DATA {|| test->c1 } ALIGN DT_LEFT, DT_CENTER, DT_CENTER TITLE 'C!' SIZE 150 ADD COLUMN TO oBrw DATA {|| test->n1 } ALIGN DT_RIGHT, DT_CENTER, DT_CENTER TITLE 'N1' SIZE 100 END TBROWSE DEFINE BUTTON B ROW 350 COL 10 CAPTION 'Set BUTTON' ACTION ( MsgInfo("Button") ) END BUTTON DEFINE CONTEXT MENU CONTROL oBrw OF Form1 ITEM "Item 1 from TBROWSE" ACTION Window2() END MENU DEFINE CONTEXT MENU CONTROL B OF Form1 ITEM "Item 1 from BUTON" ACTION Window2() END MENU END WINDOW CENTER WINDOW Form1 ACTIVATE WINDOW Form1 Return Nil func Window2() DEFINE WINDOW Form2 ; AT 10,10 ; WIDTH 400 ; HEIGHT 400 ; TITLE "HMG Example of Context Menu in two windows" ; ICON "ACON_MAIN" ; MODAL ON KEY ESCAPE ACTION ThisWindow.Release DEFINE CONTEXT MENU OF Form2 ITEM "Item 2" ACTION MsgInfo("oK") END MENU END WINDOW CENTER WINDOW Form2 ACTIVATE WINDOW Form2 Return Nil [/pre2]
Andrey: Уважаемый Avf 1) Очень тяжело смотреть исходник без форматирования, я думаю что никто и не смотрел больше. 2) Пример собрался, а дальше что смотреть ? Мне не понятно. Может другие поняли.
Avf: Я очень извиняюсь, форматирование чего-то исчезло(был невнимателен) при копировании на форум. С контролов TsBrowse и Button вызывается контекстное меню. После выбора Item открывается новое окно. В новом окне тоже вызывается контекстное меню. В случае, если пришли через Button - все работает. Если через TsBrowse, меню не отображается. Еще раз, извиняюсь, у нас тут и так бошка на части разваливается(РБ).
Pasha: Движок форума съедает пробелы слева. Надо использовать стиль - моноширинный шрифт
Andrey: Мне сложно на это ответить. Я ещё не такой большой спец по МиниГуи.
Dima: Avf пишет: Я очень извиняюсь, форматирование чего-то исчезло(был невнимателен) при копировании на форум. я поправил , сейчас нормально
Avf: Спасибо, Дима.
SergKis: Avf Работает вариант [pre2] // Demo Context menu #include "minigui.ch" #include "TSBrowse.ch" #translate dbcreate(<file>, <struct>) => hb_dbcreatetemp(<file>, <struct>) PROCEDURE main LOCAL i, br_zaw SET OOP ON dbCreate( 'test', { { 'c1', 'C', 30, 0 }, ; { 'n1', 'N', 12, 2 } } ) IF SELECT( 'test' ) == 0 dbUseArea( .T.,, 'test' ) ENDIF FOR i := 1 TO 100 test->( dbAppend() ) test->c1 := Str( i ) test->n1 := test->( RecNo() ) NEXT test->( dbGoTop() ) DEFINE WINDOW Form1 ; AT 0,0 ; WIDTH 640 ; HEIGHT 480 ; TITLE "HMG Example of Context Menu" ; MAIN ; FONT 'Tahoma' SIZE 9 (This.Object):Event(1, {|| Window2() } ) DEFINE TBROWSE oBrw AT 15, 10 OF Form1 ALIAS "test" WIDTH 450 HEIGHT 330 ADD COLUMN TO oBrw DATA {|| test->c1 } ALIGN DT_LEFT, DT_CENTER, DT_CENTER TITLE 'C!' SIZE 150 ADD COLUMN TO oBrw DATA {|| test->n1 } ALIGN DT_RIGHT, DT_CENTER, DT_CENTER TITLE 'N1' SIZE 100 END TBROWSE DEFINE BUTTON B ROW 350 COL 10 CAPTION 'Set BUTTON' ACTION ( MsgInfo("Button") ) END BUTTON DEFINE CONTEXT MENU CONTROL oBrw OF Form1 ITEM "Item 1 from TBROWSE" ACTION _wPost(1) //Window2() END MENU DEFINE CONTEXT MENU CONTROL B OF Form1 ITEM "Item 1 from BUTON" ACTION _wPost(1) //Window2() END MENU END WINDOW CENTER WINDOW Form1 ACTIVATE WINDOW Form1 Return Nil func Window2() DEFINE WINDOW Form2 ; AT 10,10 ; WIDTH 400 ; HEIGHT 400 ; TITLE "HMG Example of Context Menu in two windows" ; ICON "ACON_MAIN" ; MODAL ON KEY ESCAPE ACTION ThisWindow.Release DEFINE CONTEXT MENU OF Form2 ITEM "Item 2" ACTION _wPost(1) //MsgInfo("oK") END MENU (This.Object):Event(1, {|| MsgInfo("OK!") } ) END WINDOW CENTER WINDOW Form2 ACTIVATE WINDOW Form2 Return Nil [/pre2]
Avf: Спасибо, Ceргей. Да, действительно, работая с eventами, можно обойти все недочеты в подобных ситуациях.
Andrey: SergKis пишет: Для Timestamp колонок это как в h_tbrowse.prg, можешь подобрать длину в символах не 20, а сколько надо у тебя Перенес эту тему сюда. Нужно наверное поставить там 24 знака для ВСЕХ, чтобы не съедались колонки ? А для этих колонок сделать вот так ! [pre2] ELSEIF cType $ "+^" // Type: [+] [^] // если в базе будет 1 000 000 записей, то нужно 7 знаков oCol:nWidth := GetTextWidth( Nil, REPL("9",7), hFont ) // 7 знака[/pre2] У меня разрешение экрана 1920х1080, может из-за этого съедаются колонки ? Сделал отдельный пример, первую таблицу по умолчанию, во вторую таблицу добавил свою функцию myPartWidthTsb( oBrw ) // поправить ширину колонок Тогда колонки 24,26,27,28 показываются полностью. Вот проект - https://cloud.mail.ru/public/2h5G/5HCw2TY2G Народ, посмотрите на своих мониторах, будут у вас съедаться колонки 24,26,27,28 в первой таблице ?
SergKis: Andrey [pre2] DEFINE TBROWSE oBrw1 ; AT nY, nX ALIAS aArray WIDTH nW HEIGHT nH CELL ; FONT aFont ; BRUSH YELLOW ; HEADERS aHead ; COLSIZES aSize ; PICTURE aPict ; JUSTIFY aAlign ; COLUMNS aField ; COLNAMES aName ; FOOTERS aFoot ; FIXED COLSEMPTY ; LOADFIELDS ; /*COLNUMBER { 1, 40 } */ ; ENUMERATOR LOCK EDIT ? procname(), "FontWidth =", GetTextWidth( 0, Replicate( "9", 24 ), GetFontHandle(aFont[ 1 ]) ), GetFontWidth(aFont[ 1 ], 20), GetTextWidth( 0, Replicate( "B", 20 ), GetFontHandle(aFont[ 1 ]) ) дает у меня MYBRW1 FontWidth = 216 220 220 216 - это что предлагаешь ты 220 - это то что стоит в :LoadFields(), получено 2-мя способами т.е. вариант в тсб на 4 pixel > твоего варианта [/pre2] Что дает у тебя ? Andrey пишет если в базе будет 1 000 000 записей, то нужно 7 знаков Тогда увеличишь, когда надо будет, я же показывал, к примеру :GetColumn("ID"):nWidth := (App.Object):W1 :GetColumn("VM"):nWidth := (App.Object):W1 или др. способом :GetColumn("ID"):nWidth := GetFontWidth(aFont[ 1 ], 7) :GetColumn("VM"):nWidth := GetFontWidth(aFont[ 1 ], 12) к примеру, если поле "N" и короткое, и надо по нему подводить итог (сумму), то делаю так[pre2] ELSEIF o:cFieldTyp == "N" .and. o:nFieldLen < 10 o:nWidth += GetFontWidth("Normal", 3) [/pre2] т.е. все ситации не засунешь во внутрь h_tbrowse.prg, что то придется писать и для своих баз можешь учесть все, что надо
SergKis: Andrey пишет посмотрите на своих мониторах, будут у вас съедаться колонки 24,26,27,28 в первой таблице ? на 3х PC нормально показывает не съедает ничего (1. win 8.1 [15"], 2. win 10 [14"], 3. win 8.1 [11"] ), exe твоей сборки
Andrey: SergKis пишет: ? procname(), "FontWidth =", GetTextWidth( 0, Replicate( "9", 24 ), GetFontHandle(aFont[ 1 ]) ), GetFontWidth(aFont[ 1 ], 20), GetTextWidth( 0, Replicate( "B", 20 ), GetFontHandle(aFont[ 1 ]) ) дает у меня MYBRW1 FontWidth = 216 220 220 216 - это что предлагаешь ты 220 - это то что стоит в :LoadFields(), получено 2-мя способами т.е. вариант в тсб на 4 pixel > твоего варианта Что дает у тебя ? MYBRW1 FontWidth = 240 200 200 У меня разрешение 1920х1080, win 8.1 [24"] Вот наверное из-за этого и съедаются колонки. Т.е. на всех мониторах красивого оформления НЕ ПОЛУЧИТСЯ без доп.функций, например как я написал myPartWidthTsb( oBrw ) // поправить ширину колонок SergKis пишет: т.е. все ситации не засунешь во внутрь h_tbrowse.prg, что то придется писать и для своих баз можешь учесть все, что надо Хорошо, понял. Буду делать свою добавку к ТСБ.
SergKis: Andrey Попробуй добавку ? procname(), "FontWidth =", GetTextWidth( 0, Replicate( "9", 24 ), GetFontHandle(aFont[ 1 ]) ), GetFontWidth(aFont[ 1 ], 20), ; GetTextWidth( 0, Replicate( "B", 20 ), GetFontHandle(aFont[ 1 ]) ) ?? (App.Object):W(2.3) она у меня 218 что у тебя ?
Andrey: SergKis пишет: что у тебя ? (App.Object):W(2.3)= 218
SergKis: Andrey Попробуй присвоить :nWidth := (App.Object):W(2.4) или (App.Object):W(2.5) для колонок "T" как будет выглядеть tsb
Andrey: SergKis пишет: Попробуй присвоить :nWidth := (App.Object):W(2.4) или (App.Object):W(2.5) для колонок "T" как будет выглядеть tsb Отлично выглядит на (App.Object):W(2.5) ! Попробовал фонт "Arial" вместо "DejaVu Sans Mono" для TsbNorm - стало лучше. Фонт "DejaVu Sans Mono" моноширинный, а Arial обычный Вот и компенсируются размеры ячеек.
полная версия страницы