Цветной DBEDIT() / TBROWSE()

Форум » [x]Harbour » Цветной DBEDIT() / TBROWSE() » Ответить

Цветной DBEDIT() / TBROWSE()

Sergy: Извините за глупый вопрос, но не прошло и 20 лет моего программирования на Clipper/Harbour, как возникла потребность отображать некоторые строки/столбцы другим цветом. Подскажите пожалуйста, как подступиться к этому вопросу. Идеально было-бы как-то использовать DBEDIT(), а не TBROWSE() - тк в объектах и наследовании я не силен. Спасибо.

Ответов - 9

Andrey: Sergy пишет: Идеально было-бы как-то использовать DBEDIT(), а не TBROWSE() - тк в объектах и наследовании я не силен. Не знаю насчёт DBEDIT(), а для TBROWSE() у меня есть готовый пример. Можешь смело применять. https://cloud.mail.ru/public/c9356541557a/xHARBOUR И нет там никакого наследования, всё через функции.

gfilatov2002: Sergy пишет: как подступиться к этому вопросу Во-первых, использовать DBEDIT() для раскраски строк/столбцов не получится Во-вторых, надо использовать для этого TBROWSE объект, как это предусмотрели разработчики. Посмотри, как это делается в функции FancyColors() в примере ниже для Клиппера [pre2]/* file dbedit.prg * Purpose: provide alternate (traditional) edit mode * * Copyright (c) 1990-1993, Computer Associates International Inc. * All rights reserved. * > Root program (c) 1992, 1993 (c) Computer Associates > Reference: (\clipper\source\sample\tbdemo.prg) > > Function db_Help (c) 1993, 1994 Mickey R. Burnette, unpublished original work > (c) 1993, 1994 SofKinetics, Inc., all rights reserved > > History: 04/04/93 Initial release > 01/05/94 Added comments to function in prep to upload to CompuServe > 01/05/94 db_Help() placed in the public domain by author. Enjoy. */ #include "Inkey.ch" #include "directry.ch" #include "Setcurs.ch" #include "Error.ch" #include "box.ch" #include "achoice.ch" // These #defines use the browse's "cargo" slot to hold the append mode flag #define TURN_ON_APPEND_MODE(b) (b:cargo := .T.) #define TURN_OFF_APPEND_MODE(b) (b:cargo := .F.) #define IS_APPEND_MODE(b) (b:cargo) #define MY_HEADSEP "НСН" #define MY_COLSEP " і " FUNCTION dbedit( cFile, cIndex ) LOCAL cScreen, aDirectory := {}, aNames := {}, pitem LOCAL bSaveHandler, error local nRow := row(), nCol := col(), cOldColor cScreen := SAVESCREEN() if ( IsColor() ) cOldColor := SetColor("w+/b, b/w, b") else cOldColor := SetColor("w/n, n/w") end Set(_SET_BELL, .f.) Set(_SET_SCOREBOARD, .f.) if empty ( cfile ) clear screen aDirectory := directory("*.DBF") asort( aDirectory,,, { | x, y | x[1] < y[1] } ) aeval(aDirectory, { | File | aadd( aNames, File[F_NAME] ) } ) @ 7, 64 to 18, 77 DOUBLE pitem := achoice(8, 65, 17, 76, aNames) if pitem > 0 cFile := aNames[pitem] else cFile := "" endif endif if empty(cfile) alert("No file chosen!;-OR-;No files to choose!") SetColor(cOldColor) SetPos(nRow, nCol) RESTSCREEN(,,,,cScreen) QUIT endif RESTSCREEN(,,,,cScreen) // Lazy man's error checking bSaveHandler := ERRORBLOCK( {|x| BREAK(x)} ) BEGIN SEQUENCE USE ( cFile ) index ( cIndex ) NEW RECOVER USING error IF error:genCode == EG_OPEN alert("Error opening file!;Aborting...") SetColor(cOldColor) SetPos(nRow, nCol) RESTSCREEN(,,,,cScreen) RETURN NIL ELSE // Assume it was a problem with the params alert("Error!;Aborting...") SetColor(cOldColor) SetPos(nRow, nCol) RESTSCREEN(,,,,cScreen) RETURN NIL ENDIF QUIT END // Restore the default error handler ERRORBLOCK(bSaveHandler) // Save screen, set color, etc. SETCOLOR("N/BG") CLEAR SCREEN @ 0, 19 SAY "DbEdit Utility by SofKinetics, Incorporated" @ 1, 0 to 1, 79 @ 24, 4 SAY "Press ESC to exit editor. Press ENTER, ALT-F3 for alternate edit mode." Set Key K_ALT_F3 to db_Help //MyBrowse(3, 6, MAXROW() - 2, MAXCOL() - 6) MyBrowse(3, 0, MAXROW() - 2, MAXCOL() ) // Put things back SET COLOR TO SetColor(cOldColor) SetPos(nRow, nCol) RESTSCREEN(,,,,cScreen) RETURN NIL FUNCTION MyBrowse(nTop, nLeft, nBottom, nRight) LOCAL browse // The TBrowse object LOCAL cColorSave, nCursSave // State preservers LOCAL nKey // Keystroke LOCAL lMore // Loop control // Make a "stock" Tbrowse object for the current workarea browse := StockBrowseNew(nTop, nLeft, nBottom, nRight) // This demo uses the browse's "cargo" slot to hold a logical // value of true (.T.) when the browse is in "append mode", // otherwise false (.F.) (see #defines at top). TURN_OFF_APPEND_MODE(browse) // Use a custom 'skipper' to handle append mode (see below) browse:skipBlock := { |x| Skipper(x, browse) } // Change the heading and column separators browse:headSep := MY_HEADSEP browse:colSep := MY_COLSEP // Play with the colors FancyColors(browse) // Insert a column at the left for "Rec #" and freeze it AddRecno(browse) // Save cursor shape, turn the cursor off while browsing nCursSave := SetCursor(SC_NONE) // Scooby DOO WHILE lMore := .T. DO WHILE lMore // Don't let the cursor move into frozen columns IF browse:colPos <= browse:freeze browse:colPos := browse:freeze + 1 ENDIF // Stabilize the display until it's stable or a key is pressed nKey := 0 DO WHILE nKey == 0 .AND. .NOT. browse:stable browse:stabilize() nKey := InKey() ENDDO IF browse:stable IF browse:hitBottom .AND. .NOT. IS_APPEND_MODE(browse) // Banged against EOF; go into append mode TURN_ON_APPEND_MODE(browse) nKey := K_DOWN ELSE IF browse:hitTop .OR. browse:hitBottom TONE(125, 0) ENDIF // Make sure that the current record is showing // up-to-date data in case we are on a network. browse:refreshCurrent() ForceStable(browse) // Everything's done -- just wait for a key nKey := InKey(0) ENDIF ENDIF IF nKey == K_ESC // Esc means leave lMore := .F. ELSE // Apply the key to the browse ApplyKey(browse, nKey) ENDIF ENDDO SETCURSOR(nCursSave) RETURN NIL FUNCTION Skipper(n, browse) LOCAL lAppend LOCAL i lAppend := IS_APPEND_MODE(browse) // see #defines at top i := 0 IF n == 0 .OR. LASTREC() == 0 // Skip 0 (significant on a network) SKIP 0 ELSEIF n > 0 .and. RECNO() != LASTREC() + 1 // Skip forward DO WHILE i < n SKIP 1 IF ( EOF() ) IF ( lAppend ) i++ ELSE SKIP -1 ENDIF EXIT ENDIF i++ ENDDO ELSEIF n < 0 // Skip backward DO WHILE i > n SKIP -1 IF ( BOF() ) EXIT ENDIF i-- ENDDO ENDIF RETURN i function ApplyKey(browse, nKey) DO CASE CASE nKey == K_DOWN browse:down() CASE nKey == K_PGDN browse:pageDown() CASE nKey == K_CTRL_PGDN browse:goBottom() TURN_OFF_APPEND_MODE(browse) CASE nKey == K_UP browse:up() IF IS_APPEND_MODE(browse) TURN_OFF_APPEND_MODE(browse) browse:refreshAll() ENDIF CASE nKey == K_PGUP browse:pageUp() IF IS_APPEND_MODE(browse) TURN_OFF_APPEND_MODE(browse) browse:refreshAll() ENDIF CASE nKey == K_CTRL_PGUP browse:goTop() TURN_OFF_APPEND_MODE(browse) CASE nKey == K_RIGHT browse:right() CASE nKey == K_LEFT browse:left() CASE nKey == K_HOME browse:home() CASE nKey == K_END browse:end() CASE nKey == K_CTRL_LEFT browse:panLeft() CASE nKey == K_CTRL_RIGHT browse:panRight() CASE nKey == K_CTRL_HOME browse:panHome() CASE nKey == K_CTRL_END browse:panEnd() CASE nKey == K_RETURN DoGet(browse) OTHERWISE KEYBOARD CHR(nKey) DoGet(browse) ENDCASE RETURN NIL Function DoGet(browse) LOCAL bIns, lScore, lExit LOCAL col, get, nKey LOCAL lAppend, xOldKey, xNewKey // Make sure screen is fully updated, dbf position is correct, etc. ForceStable(browse) // If confirming a new record, do the physical append lAppend := IS_APPEND_MODE(browse) IF lAppend .AND. RECNO() == LASTREC() + 1 APPEND BLANK ENDIF // Save the current record's key value (or NIL) // (for an explanation, refer to the rambling note below) xOldKey := IF( EMPTY(INDEXKEY()), NIL, &(INDEXKEY()) ) // Save global state lScore := Set(_SET_SCOREBOARD, .F.) lExit := Set(_SET_EXIT, .T.) bIns := SetKey(K_INS) // Set insert key to toggle insert mode and cursor shape SetKey( K_INS, {|| InsToggle()} ) // Set initial cursor shape SetCursor( IF(ReadInsert(), SC_INSERT, SC_NORMAL) ) // Get the current column object from the browse col := browse:getColumn(browse:colPos) // Create a corresponding GET get := GetNew(Row(), Col(), col:block, col:heading,, browse:colorSpec) // Read it using the standard reader // NOTE: for a shared database, an RLOCK() is required here ReadModal( {get} ) // Restore state SetCursor(0) Set(_SET_SCOREBOARD, lScore) Set(_SET_EXIT, lExit) SetKey(K_INS, bIns) // Get the record's key value (or NIL) after the GET xNewKey := IF( EMPTY(INDEXKEY()), NIL, &(INDEXKEY()) ) // If the key has changed (or if this is a new record) IF .NOT. (xNewKey == xOldKey) .OR. (lAppend .AND. xNewKey != NIL) // Do a complete refresh browse:refreshAll() ForceStable(browse) // Make sure we're still on the right record after stabilizing DO WHILE &(INDEXKEY()) > xNewKey .AND. .NOT. browse:hitTop() browse:up() ForceStable(browse) ENDDO ENDIF // turn append mode off after each new record TURN_OFF_APPEND_MODE(browse) // Check exit key from get nKey := LASTKEY() IF nKey == K_UP .OR. nKey == K_DOWN .OR. ; nKey == K_PGUP .OR. nKey == K_PGDN // Ugh KEYBOARD( CHR(nKey) ) ENDIF RETURN NIL FUNCTION ForceStable(browse) DO WHILE .NOT. browse:stabilize() ENDDO RETURN NIL Function InsToggle() IF READINSERT() READINSERT(.F.) SETCURSOR(SC_NORMAL) ELSE READINSERT(.T.) SETCURSOR(SC_INSERT) ENDIF RETURN NIL FUNCTION StockBrowseNew(nTop, nLeft, nBottom, nRight) LOCAL browse LOCAL n, column, cType // Start with a new browse object from TBrowseDB() browse := TBrowseDB(nTop, nLeft, nBottom, nRight) // Add a column for each field in the current workarea FOR n := 1 TO FCount() // Make a new column column := TBColumnNew( FieldName(n), ; FieldWBlock(FieldName(n), Select()) ) // Add the column to the browse browse:addColumn(column) NEXT RETURN browse function FancyColors(browse) LOCAL n, column LOCAL xValue // Set up a list of colors for the browse to use browse:colorSpec := "N/W, N/BG, B/W, B/BG, B/W, B/BG, R/W, B/R" // Loop through the columns, choose some colors for each FOR n := 1 TO browse:colCount // Get (a reference to) the column column := browse:getColumn(n) // Get a sample of the underlying data by evaluating the codeblock xValue := EVAL(column:block) IF VALTYPE(xValue) != "N" // For non-numeric, just use colors 3 and 4 ("B/W" and "B/BG") column:defColor := {3, 4} ELSE // For numbers, use a color block to highlight negative values column:colorBlock := {|x| if( x < 0, {7, 8}, {5, 6} )} // Set default colors also (controls the heading color) column:defColor := {7, 8} ENDIF NEXT RETURN NIL function AddRecno(browse) LOCAL column // Create the column object column := TBColumnNew( " Rec #", {|| RECNO()} ) // Insert it as the leftmost column browse:insColumn(1, column) // Freeze it at the left browse:freeze := 1 RETURN NIL static function db_Help() // cProc, nLine, cVar are not used local nBottom := maxrow(), nStart := 1, nOffset := 0 local cScreen := savescreen( 0, 0, nBottom, maxcol() ) local getlist := {}, cFields := {}, cNames := {}, i, nFields, nVoff, vLoc local cOldColor := SetColor( "W+/B, N/W, B" ) local aMsg := { ; ">> Use Cursor Keys to navigate / PgDn to save / Esc to abort <<", ; ">> More fields to edit: PgDn for next screen <<", ; ">> PgUp for previous screen / PgDn to save / Esc to abort <<" } clear screen /* Since this function was written to slave from within tbrowse, we always know that we have an active database selected. To make this more generic, a test should be made early to determine if a database is truly open */ nFields := fcount() /* nVoff and following code only used to provide an optional top margin. This code could be replaced with an algorithm to provide more control */ nVoff := 0 do case case nFields < ( nBottom * 0.66 ) nVoff := 5 case nFields > ( nBottom * 0.33 ) .and. nFields < ( nBottom * .66 ) nVoff := 2 end case /* Build the necessary arrays by looping... A more sophisticated routine could use an external database or array to look up the fieldnames and translate to phrases to be used in the @says. Optional information in this database could contain picture information, ranges, validate functions, expressions to macro expand to code blocks, etc. */ for i = 1 to nFields aadd( cNames, padr(fieldname( i ), 10 ) ) // @ say aadd( cFields, fieldget( i ) ) // @ get next /* Use of the 'Begin Sequence' construct can be enhanced to handle a custom Error handler ,etc. Very flexible. */ BEGIN SEQUENCE DO WHILE nOffset <= nFields // the main loop clear typeahead ; clear screen vLoc := 0 for i = ( nStart + nOffset ) to min( nBottom + nOffset, nFields ) @ nVoff + vLoc++, 0 say padr(str(i,2),3) + cNames get cFields next @ nBottom, 0 say padc( iif( nFields > nBottom, ; iif( nOffset > nBottom, aMsg[3], aMsg[2] ), ; aMsg[1] ), 80 ) read // remember that {getlist} is set to null after 'read' // user abort? if lastkey() == K_ESC BREAK endif /* Control keys increment or decrement nOffset. Note that a PdDn or CursorDown out-of-bounds on last display screen will set nOffset == nFields, the 'Do' loop will restart but the 'for' loop will not execute and {getlist} will be null upon entry to READ and remodal will fall thru. The logic will then see nOffset == nFields and increment nOffset by 1, thus causing the Do Loop to terminate. Link with /b and use CLD to view this if you question the logic. */ if lastkey() == K_PGUP .or. lastkey() == K_UP nOffset := max( 0, nOffset - nBottom ) else iif( nOffset == nFields, ; nOffset++, ; nOffset := min(nOffset + nBottom, nFields) ) endif ENDDO END SEQUENCE /* Update database is user did not abort using escape. If needed, a commit() could be used after the update to force a hard write to disk */ if lastkey() != K_ESC for i = 1 to nFields fieldput( i, cFields ) next else tone(300,3) alert("ESC pressed! Update aborted...", ; {"Press ENTER"} ) endif /* This routine was entered by interrupting a tbrowse edit, DoGet(). Stuff an ENTER into the keyboard buffer to terminate the edit condition and update the tbrowse display to reflect any changes to the current record. If the routine is to be used outside of a tbrowse, then this probably should be removed from the function... */ clear typeahead ; keyboard chr( K_ENTER ) SetColor( cOldColor ) restscreen(0, 0, nBottom, maxcol(), cScreen ) Return NIL[/pre2]

Sergy: Спасибо за примеры, пошел ковырять oColumn:colorSpec

Sergy: Разобрался. Оставлю тут, может кому пригодится. 1) нужно заранее перечислить все возможные (нужные) комбинации цветов в oBrowse, например, так: oBrowse:colorSpec := "N/W, N/BG, B/W, B/BG, B/W, B/BG, R/W, B/R" первые пять пар цветов - обычно стандартные, берутся из SETCOLOR(), остальные - добавляются по желанию. 2) нужно в каждом столбце задать блок кода, который будет возвращать значение в виде массива с двумя числами, например: {1,2}, где числа - номера нужных пар цвета из oBrowse:colorSpec для отображения текущей ячейки в "стандартном" и выделенном цвете. Интереснее всего, конечно, это делать динамически, на основании текущего поля, например так: oColumn:colorBlock := {|| IIF( table->value < 0, {7,8}, {1,2})} Если значение нужного поля в таблице меньше нуля, оно будет отображено цветом 7 (R/W) или выделено (курсор на этом поле) цветом 8 (B/R) Если оно равно или больше нуля = "стандартной" парой цветов 1 (N/W) и 2 (N/BG)

Dima: Sergy А раньше не юзал совсем Browse ? Я изначально сваял свой универсальный бровс на основе Browse

Dima: Sergy Держи примеры из Clipper на тему Browse https://cloud.mail.ru/public/L6q9/F7ZezfnDw

Sergy: Dima пишет: А раньше не юзал совсем Browse ? Я изначально сваял свой универсальный бровс на основе Browse Тк в наследованиях и прочем не силен - взял харборовский DBEDIT() и добавил в него лишь несколько важных для меня вещей (единая для всей программы реакция на мышь, обновление заголовка окна программы и тп). Сейчас вот добавил поддержку цвета. Твои примеры посмотрю, спасибо.

azoo: Разобрался. Оставлю тут, может кому пригодится. 1) нужно заранее перечислить все возможные (нужные) комбинации цветов в oBrowse, например, так: oBrowse:colorSpec := "N/W, N/BG, B/W, B/BG, B/W, B/BG, R/W, B/R" первые пять пар цветов - обычно стандартные, берутся из SETCOLOR(), остальные - добавляются по желанию. 2) нужно в каждом столбце задать блок кода, который будет возвращать значение в виде массива с двумя числами, например: {1,2}, где числа - номера нужных пар цвета из oBrowse:colorSpec для отображения текущей ячейки в "стандартном" и выделенном цвете. Интереснее всего, конечно, это делать динамически, на основании текущего поля, например так: oColumn:colorBlock := {|| IIF( table->value < 0, {7,8}, {1,2})} Если значение нужного поля в таблице меньше нуля, оно будет отображено цветом 7 (R/W) или выделено (курсор на этом поле) цветом 8 (B/R) Если оно равно или больше нуля = "стандартной" парой цветов 1 (N/W) и 2 (N/BG) Sergy , а пример рабочий есть ? Нашёл такой пример в хелпе по xHarbour // The example calls DbEdit() with a user function and initializes // the TBrowse object inits initial display with custom colors. // A color block is defined so that the rows in the browser are // displayed with alernating colors. #include "Inkey.ch" #include "Dbedit.ch" #ifndef DE_INIT #define DE_INIT -1 #endif PROCEDURE Main LOCAL bColor := {|x| IIf( Recno() % 2 == 0, {1,2}, {3,4} ) } Local aCols := { ; { "LASTNAME" , bColor }, ; { "FIRSTNAME", bColor }, ; { "CITY" , bColor }, ; { "ZIP" , bColor } ; } USE Customer NEW DbEdit(,,,, aCols, "UserFunc", ,{ "Lastname","Firstname", "City", "Zip"} ) CLOSE ALL RETURN FUNCTION UserFunc( nMode, nCol, oTBrowse ) LOCAL GetList := {} LOCAL nReturn := DE_CONT DO CASE CASE nMode == DE_INIT oTBrowse:colorSpec := "n/bg,w+/r,w+/bg,w+/r,w+/gr" CASE nMode == DE_HITTOP Tone(1000) CASE nMode == DE_HITBOTTOM Tone(500) CASE LastKey() == K_ESC nReturn := DE_ABORT CASE LastKey() == K_ENTER SetCursor(1) @ Row(), Col() Get &(oTBrowse:getColumn(nCol):heading) READ SetCursor(0) CLEAR TYPEAHEAD ENDCASE RETURN nReturn но он видно только для xHarbour

Sergy: azoo пишет: Sergy , а пример рабочий есть ? да, использую вот так: в текст стандартного DbEdit() добавил два (последних по списку) параметра - массив блоков кода и строку с цветовой таблицей: [pre2]FUNCTION dbEdit( nTop, nLeft, nBottom, nRight, ; acColumns, xUserFunc, ; xColumnSayPictures, xColumnHeaders, ; xHeadingSeparators, xColumnSeparators, ; xFootingSeparators, xColumnFootings, ; aColorBlocks, cColorTable )[/pre2] внутри DBEDIT() добавил: [pre2] IF HB_ISSTRING(cColorTable) // задан цвет ? oBrowse:colorSpec := cColorTable // заменяем полностью таблицу цветов и ENDIF // и добавляем новые (если есть) [/pre2] чуть ниже, при генерации столбцов - еще немного: [pre2] IF HB_ISARRAY( aColorBlocks ) // задан массив блоков кода ? IF nPos <= LEN(aColorBlocks) // в пределах ? oColumn:colorBlock := aColorBlocks[nPos] // назначаем столбцу блок кода ENDIF // ELSEIF HB_ISBLOCK( aColorBlocks ) // задан один блокна всех ? oColumn:colorBlock := aColorBlocks // присваиваем всем столбцам одинаковый ENDIF oBrowse:addColumn( oColumn ) [/pre2] С внутренностями DBEDIT() закончил, вызов в программе выглядит так: DBEDIT(куча, разных, параметров, ...., и, в, самом, конце, {||IIF(MyFunc() > 0, {1,2} , {6,2} )}, cColorString) Где обычно cColorString := SETCOLOR()+",15/2,10/4" или что-то типа того. Пять пар стандартных цветов и несколько дополнительных. Блок кода - в данном случае один на все столбцы, соотв. вся строка целиком будет менять цвет в зависимости от результата MyFunc(): Значение {1,2} означает - "первая пара из cColorString" для невыделенной ячейки и "вторая пара из cColorString" для выделенной (активной). Соотв. значение массива {6,2} означает шестую и вторую пару. Если задать "массив блоков кода", то можно каждую ячейку выделять на основании любых условий.

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