Форум » 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:....
gfilatov2002: Dima пишет: Что нужно корректно сказать бровсу что бы правильно его обновить ? См. в примере ниже использование функции myUpdate() для обновления первой колонки, которая находится под фильтром /* * MINIGUI - Harbour Win32 GUI library Demo * */ #include "minigui.ch" #include "tsbrowse.ch" #include "Dbstruct.ch" REQUEST DBFCDX FUNCTION Main() LOCAL cDbf := GetStartupFolder() + '\Test.dbf' LOCAL i, cAlias LOCAL oBrw_1 SET CENTURY ON SET DELETED ON IF ! File( cDbf ) CreateTable() ENDIF rddSetDefault( 'DBFCDX' ) cAlias := cFileNoExt( cDbf ) USE ( cDbf ) Alias ( cAlias ) SHARED NEW set filter to code > 90 go top Test->( ordSetFocus( 1 ) ) DEFINE WINDOW Form_1 ; At 0, 0 ; WIDTH 600 ; HEIGHT 470 ; TITLE 'TsBrowse sample: Order' ; MAIN ; NOMAXIMIZE ; NOSIZE END WINDOW oBrw_1 := CreateBrowse( "oBrw_1", 'Form_1', 2, 2, Form_1.Width - 10, ; Form_1.Height - GetTitleHeight() - iif( IsThemed(), 1, 2 ) * GetBorderHeight() - 2, cAlias ) // modify the default settings oBrw_1:aColumns[ 1 ]:cHeading := "Number" oBrw_1:SetColSize( 1, 94 ) oBrw_1:aColumns[ 1 ]:nAlign := DT_RIGHT // editing is available for ALL columns FOR i := 1 TO Test->( Fcount() ) - 1 oBrw_1:aColumns[ i ]:lEdit := TRUE NEXT oBrw_1:aColumns[ 1 ]:nEditMove := DT_DONT_MOVE oBrw_1:aColumns[ 5 ]:cHeading := "Birthday" oBrw_1:SetColSize( 5, 120 ) // hide the last column oBrw_1:HideColumns( 6, .T. ) CENTER WINDOW Form_1 ACTIVATE WINDOW Form_1 RETURN NIL FUNCTION CreateBrowse( cBrw, cParent, nRow, nCol, nWidth, nHeight, cAlias ) LOCAL oBrw DEFINE TBROWSE &cBrw ; AT nRow, nCol ; ALIAS cAlias ; OF &cParent ; WIDTH nWidth ; HEIGHT nHeight ; COLORS { CLR_BLACK, CLR_BLUE } ; FONT "MS Sans Serif" ; SIZE 9 :SetAppendMode( .F. ) :SetDeleteMode( .F. ) :lNoHScroll := .T. :lCellBrw := .T. :nSelWidth := 16 END TBROWSE // loading the ALL database fields LoadFields( cBrw, cParent ) oBrw := TBrw_Obj( cBrw, cParent ) WITH OBJECT oBrw :nHeightCell += 2 :nHeightHead += 18 :nWheelLines := 1 :lNoChangeOrd := TRUE :hBrush := CreateSolidBrush( 230, 240, 255 ) :SetColor( { 16 }, { RGB( 43, 149, 168 ) } ) // SyperHeader backcolor :SetColor( { 3 }, { RGB( 255, 255, 255 ) } ) // Header font color :SetColor( { 4 }, { {|| { RGB( 43, 149, 168 ), RGB( 0, 54, 94 ) } } } ) // Header backcolor :SetColor( { 17 }, { RGB( 255, 255, 255 ) } ) // Font color in SyperHeader :SetColor( { 6 }, { {|| { RGB( 255, 255, 74 ), RGB( 240, 240, 0 ) } } } ) // Cursor backcolor :SetColor( { 12 }, { {|| { RGB( 128, 128, 128 ), RGB( 250, 250, 250 ) } } } ) // Inactive cursor backcolor :SetColor( { 2 }, { {|| RGB( 230, 240, 255 ) } } ) // Grid backcolor :SetColor( { 1 }, { {|| RGB( 0, 0, 0 ) } } ) // Text color in grid :SetColor( { 5 }, { {|| RGB( 0, 0, 255 ) } } ) // Text color of cursor in grid :SetColor( { 11 }, { {|| RGB( 0, 0, 0 ) } } ) // Text color of inactive cursor in grid :nClrLine := COLOR_GRID :aColumns[1]:bPostEdit := { | uVal, oBr | myUpdate(uVal, oBr) } :ResetVScroll() END OBJECT RETURN oBrw Static Function myUpdate(Val, oBrw) local lRefresh oBrw:nLen := ( oBrw:cAlias )->( Eval( oBrw:bLogicLen ) ) ( oBrw:cAlias )->( DbSkip() ) lRefresh := ( oBrw:cAlias )->( EOF() ) ( oBrw:cAlias )->( DbSkip( -1 ) ) oBrw:nRowPos -= If( lRefresh .and. ; ! ( oBrw:cAlias )->( BOF() ), 1, 0 ) oBrw:Refresh( .T. ) Return nil Static Function TBrw_Obj( cBrw, cParent ) Local oBrw, i If ( i := GetControlIndex( cBrw, cParent ) ) > 0 oBrw := _HMG_aControlIds [ i ] EndIf Return oBrw Procedure CreateTable Local aDbf[6][4], i aDbf[1][ DBS_NAME ] := "Code" aDbf[1][ DBS_TYPE ] := "Numeric" aDbf[1][ DBS_LEN ] := 10 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 ] := "Married" aDbf[4][ DBS_TYPE ] := "Logical" aDbf[4][ DBS_LEN ] := 1 aDbf[4][ DBS_DEC ] := 0 // aDbf[5][ DBS_NAME ] := "Birth" aDbf[5][ DBS_TYPE ] := "Date" aDbf[5][ DBS_LEN ] := 8 aDbf[5][ DBS_DEC ] := 0 // aDbf[6][ DBS_NAME ] := "Bio" aDbf[6][ DBS_TYPE ] := "Memo" aDbf[6][ DBS_LEN ] := 10 aDbf[6][ DBS_DEC ] := 0 DBCREATE("Test", aDbf, "DBFCDX") Use test Via "DBFCDX" 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 Married With ( i/2 == int(i/2) ) replace birth with date()-Max(10000, Random(20000))+Random(LastRec()) Next i Index On field->code Tag code Use Return
Dima: Haz gfilatov2002 Спасибо ! Работает.
Haz: Dima пишет: Спасибо ! Работает. Не за что вот этот кусок из метода DeleteRow и из примера Григория все делает [pre2] oBrw:nLen := ( oBrw:cAlias )->( Eval( oBrw:bLogicLen ) ) ( oBrw:cAlias )->( DbSkip() ) lRefresh := ( oBrw:cAlias )->( EOF() ) ( oBrw:cAlias )->( DbSkip( -1 ) ) oBrw:nRowPos -= If( lRefresh .and. ; ! ( oBrw:cAlias )->( BOF() ), 1, 0 ) oBrw:Refresh( .T. ) [/pre2]
Andrey: Всем привет. Делал таблицу и полдня бился с глухим зависанием программы. Пока не стал отключал построчно создание Tsbrowse. Вот такой код вешает программу наглухо: Add Super Header To oBrw1 From Column 1 To Column 1 ; Color CLR_WHITE, { nBackForm, nHeadColor1 } ; Title "" 3DLook BITMAP LoadImage("WMenu") HORZ DT_LEFT Я тоже не понимал почему, а потом дошло... В ресурсы забыл добавить "WMenu" ... Там в сами исходники поставить проверку на наличие BITMAP можно ?
gfilatov2002: Andrey пишет: Там в сами исходники поставить проверку на наличие BITMAP можно ? Да, это возможно, в таком случае будет генерироваться минигуи-ошибка, как при отсутствии формы или контрола
Andrey: gfilatov2002 пишет: Да, это возможно, в таком случае будет генерироваться минигуи-ошибка, как при отсутствии формы или контрола Отлично !
Andrey: Всем привет ! Вывожу пустую таблицу. Потом открываю нужную базу и пытаюсь заново показать в уже построенном Tsbrowse. cAlias := ALIAS() // старая база cNewAlias := "NewBase" // удалить колонки старой базы nJ := oBrw1:nColCount() FOR nI := 1 TO nJ oBrw1:DelColumn( nI ) NEXT (cAlias)->(DbCloseArea()) // закрыть старую базу SELECT(cNewAlias) oBrw1:cAlias := cNewAlias oBrw1:Reset() LoadFields( "oBrw1", cForm, .F.) // все поля не редактируемые oBrw1:Refresh(.T.) Фигня получается... Первая колонка от старой таблицы остаётся. Цвета в таблице тоже пропадают. Курсор собранный в один - тоже пропадает. Как правильно сделать мне - открытие базы в уже построенном Tsbrowse ?
SergKis: Andrey пишет: oBrw1:cAlias := cNewAlias oBrw1:Reset() LoadFields( "oBrw1", cForm, .F.)... Фигня получается... Получается все правильно, как заказывал: - LoadFields() ставит FieldWBlock(..., Select(cAlias)), привязка к области - cNewAlias это др. область - вывод, открывать cNewAlias в той же области или переписать на свой вариант FieldWBlock(...), пример FieldABlock(bBlock, cAlias):[pre2] FUNCTION FIELDABLOCK( cFieldName, cAlias ) IF cAlias == NIL; cAlias := Alias(); ENDIF IF ISCHARACTER( cFieldName ) .AND. ISCHARACTER( cAlias ) RETURN &( "{| x | iif( x == NIL, "+ ; "(["+cAlias+"])->( FieldGet( FieldPos( ["+cFieldName+"] ) ) )"+ ; "(["+cAlias+"])->( FieldPut( FieldPos( ["+cFieldName+"] ) ) ) }" ) ENDIF RETURN NIL [/pre2]
SergKis: PS чуток пропустил "(["+cAlias+"])->( FieldPut( FieldPos( ["+cFieldName+"] ), x ) ) }" )
Andrey: SergKis пишет: Получается все правильно, как заказывал: - LoadFields() ставит FieldWBlock(..., Select(cAlias)), привязка к области - cNewAlias это др. область Не совсем понял ? Я же делаю перед этим переключение на новый алиас: SELECT(cNewAlias) oBrw1:cAlias := cNewAlias Попробую со старым... потом напишу.
Andrey: Переделал на открытие старого алиаса. Всё равно фигня получается. 1) Остаётся первая колонка из предыдущей базы, причём дублирует информацию с другой колонки. 2) Цвета определённые ранее теряются полностью. Вот скрин: Как правильно сделать мне - открытие базы в уже построенном Tsbrowse ?
SergKis: Andrey Переоткрываешь так ? dbSelectArea(cAlias) dbCloseArea() dbUseArea( .F., , cFileDbf, cAlias, ...)
Andrey: SergKis пишет: Переоткрываешь так ? Нет, не так. Но база под старым алиасом нормально открывается. Попробовал как предложил, та же самая фигня. База открыта нормально, а в таблице бардак.
Dima: Andrey пишет: oBrw1:Reset() LoadFields( "oBrw1", cForm, .F.) // все поля не редактируемые oBrw1:Refresh(.T.) А если так LoadFields( "oBrw1", cForm, .F.) // все поля не редактируемые oBrw1:Reset() Рефреш не нужен
Andrey: Dima пишет: А если так База открывается нормально. Поля показываются тоже, НО: Andrey пишет: Всё равно фигня получается. 1) Остаётся первая колонка из предыдущей базы, причём дублирует информацию с другой колонки. 2) Цвета определённые ранее теряются полностью. Вот скрин: (см. выше) Нужно удалить колонку из старой базы и восстановить все цвета и состояние сборного курсора из предыдущей базы. Если нельзя так, то скажите пожалуйста как можно.
Петр: Andrey пишет: 1) Остаётся первая колонка из предыдущей базы, причём дублирует информацию с другой колонки. 2) Цвета определённые ранее теряются полностью. Все по феншую. см. код метода DelColumn А что мешает после добавления новых столбов удалить столбец №1? Перед манипуляциями с oBrw1 cохраните цвета aColors := oBrw1:aColors и восстановите в нужный момент oBrw1:aColors := aColors Перерисуйте oBrw1
SergKis: Andrey пишет База открыта нормально, а в таблице бардак Так oBrw:LoadFields(...) создает колонки[pre2] cBlock := 'FieldWBlock("' + aStru[ nE, 1 ] + '",Select("' + ::cAlias + '"))' ::AddColumn( TSColumn():New( cHeading, FieldWBlock( aStru[ nE, 1 ], Select( ::cAlias ) ),cPicture, ; { ::nClrText, ::nClrPane }, { nAlign, DT_CENTER }, nSize,, lEditable,,, cOrder,,,, ; 5,,,, Self, cBlock ) ) [/pre2] т.е. aStru от старой базы. Структуры соответствут в базах (пустой и нормальной) ? На простом примере показал бы.
SergKis: Andrey еще [pre2] METHOD DelColumn( nPos ) CLASS TSBrowse Local oCol, nMin, nMax, nI, ; nLen := Len( ::aSuperHead ) Default nPos := 1 If Len( ::aColumns ) == 1 // cannot delete last column Return Nil // ... or Nil if last column EndIf ... [/pre2]
Петр: SergKis пишет: т.е. aStru от старой базы. С какой радости, если [pre2]SELECT(cNewAlias) oBrw1:cAlias := cNewAlias ... METHOD LoadFields( lEditable ) CLASS TSBrowse ... aStru := ( ::cAlias )->( DbStruct() ) [/pre2]
SergKis: Петр Только во всей этой катавасии со сменой структуры и колонок (SuperHeader, Footer, цветов), большого смысла не вижу. Сначала показалось, что речь идет о смене с пустого файла на нормальный, а тут ... Проще удалить контрол Tsb и пересоздать новый, чем сохранять цвета, удалять колонки (первую сделать одинаковой и удалять со второй и дальше), создавать снова колонки после первой..., заголовки, восстанавливать цвета .... По мне, больше головной боли.
полная версия страницы