Нужен обработчик TBROWSE

Форум » [x]Harbour » Нужен обработчик TBROWSE » Ответить

Нужен обработчик TBROWSE

Andrey: Всем привет и всех с прадником ! Поделитесь обработчиком (с мышкой) TBROWSE для хХарбора (для многопользовательской работы в сети), а то клиперный глючит и отловить глюки не могу. Заранее спасибо за ответ.

Ответов - 9

Andrey: Если жалко, то дайте пожалуйста пример для работы с мышкой в TBROWSE.

Andrey: Так что никто не работает с мышкой в TBROWSE ? А то нашел один пример, только там нельзя мышкой скакать по столбцам !

Vlad04: Как найдешь, сообщи. Мне то же надо. Паша как то выкладывал подходы к решению проблемы

Pasha: CASE ( nKey == K_LBUTTONDOWN .or. nKey == K_LDBLCLK ) mBrowse(oB) ... STATIC FUNCTION mBrowse(oB) // ------------------------------------------------------------- // Обработка нажатия мышки для TBrowse - обьекта oB // ------------------------------------------------------------- Local rowMouse := MRow(), colMouse := MCol() Local cCol := Col(), cRow := Row() Local newCol, newRow IF rowMouse >= oB:nTop .and. rowMouse <= oB:nBottom .and.; colMouse >= oB:nLeft .and. colMouse <= oB:nRight WHILE colMouse < cCol .or. colMouse > cCol + oB:colWidth(oB:colPos) + 1 IF colMouse < cCol IF oB:colPos == 1 EXIT ENDIF cCol -= oB:colWidth(oB:colPos - 1) + 1 oB:left() ELSE IF oB:colPos == oB:colCount EXIT ENDIF cCol += oB:colWidth(oB:colPos) + 1 oB:right() ENDIF ENDDO IF rowMouse != cRow oB:deHilite() oB:rowPos += rowMouse - cRow #ifdef __HARBOUR__ if oB:rowPos < 1 oB:rowPos := 1 endif #endif ELSE Keyboard CHR(K_ENTER) ENDIF ELSEIF colMouse == oB:nRight + 1 IF rowMouse == oB:nTop + 2 oB:up() ELSEIF rowMouse == oB:nBottom - 2 oB:down() ENDIF ENDIF RETURN NIL

Andrey: Спасибо Павел !

Andrey: После глобального поиска по архивам, сетям и консультаций собрал наконец-то рабочий Tbrowse&Mouse ! Кому нужно вышлю мылом вместе с bat-никами для сборки, а так выкладываю здесь. Пришлось еще и кучу дополнительных функций тащить. Кому они не понадобится, сами отрезайте. Спасибо всем живущим на этом сайте за помощь ! ////////////////////////////////////////////////////////////////////// // // Tbrows-Demo.PRG // // Copyright: // Verchenko Andrey, 30195@mail.ru , (c) 2008. All rights reserved. // Adaptation demo Tbrowse and mouse for console of [x]Harbour. // // Contents: // Tbrowse&Mouse demo-application for Clipper, [x]Harbour // ////////////////////////////////////////////////////////////////////// // Собрана из различных источников. // Отдельное спасибо Сидорову Александру. ////////////////////////////////////////////////////////////////////// #include "inkey.ch" #include "setcurs.ch" #include 'tbrowse.CH' #include "set.ch" #include "button.ch" MEMVAR num_color, i_color, nColorBrowse FIELD FirstName, LastName, Age, Date, Rate, Logik FUNCTION MAIN() LOCAL nI, aPoleField, aPoleName, aPolePict, aWinTbrow LOCAL cColWin , cColSpr , cColTbrow, cColScroll, cTemp, nRet LOCAL aKeyMouse := {}, aColorUsl := {}, nWidth PUBLIC SetLang // Для GTWVT - терминала раскоментировать эти строки, // а для GTWIN - наоборот закоментировать. /* if hb_gt_version() = 'WVT' nWidth := Wvt_GetScreenWidth() // Установить по умолчанию DO CASE CASE nWidth >= 1024 Wvt_SetFont( "Lucida Console", 18 ) //Wvt_SetFont( 'Courier New', 18 ) //Wvt_SetFont('Terminal',18,10) CASE nWidth >= 800 Wvt_SetFont('System',16,-8) OTHERWISE Wvt_SetFont('Terminal',12,6) ENDCASE Wvt_SetCodePage(255) // #define OEM_CHARSET 255 - from wingdi.h //---------- windows title and icon for xHarbour ----------- GTInfo( 26, "Tbrowse and mouse" ) //GTInfo( 28, "Main_ICO" ) endif */ #ifndef __HARBOUR__ M->SetLang := "CLIPPER" #else M->SetLang := "HARBOUR" #endif SET SCOREBOARD OFF SET TALK OFF SET DELETED ON SETMODE(24,80) SETCOLOR("15/1") CLEAR SCREEN ?? " Верченко Андрей, 30195@mail.ru , (c) 2008. All rights reserved." ? " Adaptation demo Tbrowse and mouse for console of [x]Harbour." aWinTbrow := { 3, 10, 21, 69 } // Координаты DbEdit cColTbrow := "14/0,0/12" // Цвет DbEdit в GET'e cColSpr := "15/2" // Цвет окна и символов DbEdit cColWin := "0/15" // Цвет заголовка окна cColScroll:= "0/15" // Цвет бегунков SetColor( cColSpr ) @ aWinTbrow[ 1 ], aWinTbrow[ 2 ], aWinTbrow[ 3 ], aWinTbrow[ 4 ] BOX "╔═╗║╝═╚║ " @ aWinTbrow[ 1 ], aWinTbrow[ 2 ] SAY PadC( "Пример редактирования Tbrowse", ; aWinTbrow[ 4 ] - aWinTbrow[ 2 ]+1 ) COLOR( cColWin ) LINE23() // строка-помощь клавиш управления // Описание координат кнопок для мышки внизу экрана AAdd( aKeyMouse, { MaxRow(), 2, MaxRow(), 4, K_DEL } ) AAdd( aKeyMouse, { MaxRow(), 6, MaxRow(), 8, K_INS } ) AAdd( aKeyMouse, { MaxRow(), 32, MaxRow(), 40, K_F5 } ) AAdd( aKeyMouse, { MaxRow(), 42, MaxRow(), 54, K_F8 } ) AAdd( aKeyMouse, { MaxRow(), 70, MaxRow(), 78, K_ESC } ) // Цвет условия в Tbrowse AAdd( aColorUsl, { { || Age == 0 }, "12/2" } ) // неопред. AAdd( aColorUsl, { { || Age > 0 .AND. Age <= 8 }, "10/2" } ) // дошколник AAdd( aColorUsl, { { || Age > 8 .AND. Age <= 17 }, "14/2" } ) // школьник AAdd( aColorUsl, { { || Age > 17 .AND. Age <= 50 }, "15/2" } ) // работает AAdd( aColorUsl, { { || Age > 50 }, "0/2" } ) // пенсионер aPoleField := { "FirstName" , "LastName" , "Age" , "Date" , "Rate" , "Logik" } aPoleName := { ";Фамилия" , ";Имя" , ";Возраст" , "Дата;рождения", ";???" , ";Да или нет" } aPolePict := { "@S15 "+REPLICATE("x",20),"@S12 "+REPLICATE("x",20), "@Z 999", "99.99.99" , "@Z 9999.99", "x" } FOR nI := 1 TO Len( aPoleName ) // специально для Харбора, т.к. не выводит заголовок, // если 1-знак ";" cTemp := SubStr( aPoleName[ nI ] , 1 , 1 ) IF cTemp == ";" aPoleName[ nI ] := " " + aPoleName[ nI ] ENDIF NEXT // создадим тестовую базу Create_Test_DBF() USE TEST NEW // следующие две строчки подключают мышку Set( _SET_EVENTMASK, INKEY_ALL ) MSETCURSOR( .T. ) /* Синтаксис стандартного DbEdit'a Dbedit(aWinTbrow[1]+1,aWinTbrow[2]+1,aWinTbrow[3]-1,aWinTbrow[4]-2,; aPoleField, 'FuncUSER',aPolePict, aPoleName,"┬─","│") */ // Реализация DbEdit'a через Tbrowse с мышкой nRet := MyDbEdit( aWinTbrow[ 1 ] + 1, aWinTbrow[ 2 ] + 1, aWinTbrow[ 3 ] - 1, aWinTbrow[ 4 ] - 2, ; aPoleField, "Not-Func", aPolePict, aPoleName, "┬─", "│", ; { cColSpr, cColTbrow,cColScroll },; aKeyMouse, aColorUsl ) USE RETURN NIL *= == == == == == == == == == == == == == == == == == == == == == == == == == == == == == == FUNCTION MyDbEdit( nTop, nLeft, nBottom, nRight, aFields, cFuncEdit, aFieldPict, aFieldName,; cSepar1, cSepar2, aColor, aKeyMouse , aColorUsl ) LOCAL cScr := SaveScreen(,,,, ), nCursor := SetCursor( SC_NONE ) LOCAL oBrowse, oColumn, nKey, cStatus, lCont, nColPair, nColPair2 LOCAL nTemp, nI, bTemp, nRec, nBarScll LOCAL aScroll, aScrollGrz, cUslColor LOCAL nRet, cTekCol, y, x, nRetMouse, GETLIST:={} LOCAL cTbrColor := aColor[ 1 ], cGetColor := aColor[ 2 ] // Цвет GETa LOCAL cColScroll := aColor[ 3 ] // Цвет бегунков PRIVATE num_color, i_color, nColorBrowse /* задание символов рамки" */ oBrowse := TBrowseDB( nTop, nLeft, nBottom, nRight ) //oBrowse:colSep := " " oBrowse:colSep := cSepar2 oBrowse:headSep := cSepar1 //oBrowse:headSep := "──" //oBrowse:border := '─│─└│' /* задание цветов TBrowse-объекта */ oBrowse:colorSpec := cTbrColor + "," + cGetColor + ", 0/14 " //, W+/N, GR+/B, R+/B"+cUslColor // создание цвета для кодоблока по условию cUslColor := "" IF LEN( aColorUsl ) > 0 FOR nI := 1 TO Len( aColorUsl ) cUslColor := cUslColor + aColorUsl[ nI, 2 ] + "," NEXT ENDIF // подсчет уже существующего кол-ва цветов в массиве nColorBrowse := NUMAT( "/", oBrowse:colorSpec ) oBrowse:colorSpec := oBrowse:colorSpec + ", " + cUslColor DBGoTop() FOR nI := 1 TO Len( AFields ) bTemp := AFields[ nI ] oColumn := TBCOLUMNNEW( aFieldName[ nI ], { || &bTemp } ) oColumn:Picture := aFieldPict[ nI ] IF LEN( aColorUsl ) > 0 // назначение цветов по кодоблоку oColumn:colorBlock := { || i_color := 0, num_color := 1, ; AEval( aColorUsl, { | x | i_color ++, IIf( Eval( x[ 1 ] ), num_color := i_color, ) } ), { num_color + nColorBrowse, 2 } } ENDIF oBrowse:addColumn( oColumn ) NEXT /* задание бегунков TBrowse-объекта */ nTemp := 0 // подсчет кол-ва строк в заголовке полей FOR nI := 1 TO Len( aFieldName ) nTemp := Max( NUMAT( ";", aFieldName[ nI ] ), nTemp ) NEXT aScroll := ScrollBarNew( oBrowse:nTop + nTemp + 1, oBrowse:nRight + 2, oBrowse:nBottom , cColScroll, 1 ) ScrollBarDisplay( aScroll ) nTemp := 0 // подсчет кол-ва столбцов для формата FOR nI := 1 TO oBrowse:freeze nTemp := nTemp + Len( aFieldPict[ nI ] ) + 1 NEXT aScrollGrz := ScrollBagNew( oBrowse:nBottom + 1 , oBrowse:nLeft + nTemp , oBrowse:nRight, cColScroll, 1 ) // Рисуем нижний индикатор, если кол-во полей > 3 IF Len( aFields ) > 3 ScrollBagDisplay( aScrollGrz ) ENDIF CLEAR TYPEAHEAD // назначаем на нажатие левой кнопки мышки блок кода, // который будет отработан по этому событию oBrowse:SetKey( K_LBUTTONDOWN ; , { | o | ( myMouseTB( o, MROW(), MCOL() ) ):refreshAll(), TBR_CONTINUE } ) oBrowse:SetKey( K_LDBLCLK ; , { | o | ( myMouseTB( o, MROW(), MCOL() ) ):refreshCurrent(), TBR_EXIT } ) oBrowse:SetKey( K_ENTER ; , { | o | ( myMouseTB( o, MROW(), MCOL() ) ):refreshCurrent(), TBR_EXIT } ) oBrowse:SetKey( K_ESC ; , { | o | ( myMouseTB( o, MROW(), MCOL() ) ):refreshCurrent(), TBR_EXIT } ) //oBrowse:SETKEY(K_ENTER , { |oBrowse, nKey| TBR_EXCEPTION } ) oBrowse:SetKey( K_ENTER , { | oBrowse, nKey | TBR_EXIT } ) oBrowse:SetKey( K_ESC , { | oBrowse, nKey | TBR_EXIT } ) oBrowse:SetKey( K_F5 , { | oBrowse, nKey | K_F5 } ) oBrowse:SetKey( K_F8 , { | oBrowse, nKey | K_F8 } ) oBrowse:SetKey( K_F9 , { | oBrowse, nKey | K_F9 } ) oBrowse:SetKey( K_F10 , { | oBrowse, nKey | K_F10 } ) oBrowse:SetKey( K_F11 , { | oBrowse, nKey | K_F11 } ) oBrowse:SetKey( K_F12 , { | oBrowse, nKey | K_F12 } ) oBrowse:SetKey( K_INS , { | oBrowse, nKey | K_INS } ) oBrowse:SetKey( K_DEL , { | oBrowse, nKey | K_DEL } ) oBrowse:SetKey( K_F1 , { | oBrowse, nKey | K_F1 } ) oBrowse:SetKey( K_ALT_X , { | oBrowse, nKey | K_ALT_X } ) oBrowse:SetKey( K_ALT_M , { | oBrowse, nKey | K_ALT_M } ) // Хочу чтоб при открытии базы КУРСОР стоял на 2 колонке #ifndef __HARBOUR__ KEYBOARD Chr( K_RIGHT ) #else HB_KeyPut( K_RIGHT ) #endif /* главный цикл просмотра */ lCont := .T. DO WHILE lCont /* Устанавливает текущей строке стандартные цвета */ oBrowse:refreshCurrent() DispBegin() /* стабилизация */ DO WHILE ! oBrowse:stabilize() ENDDO //oBrowse:forceStable() // Выделение цветом текущей строки nColPair := 2 nColPair2 := 4 oBrowse:colorRect( { oBrowse:rowPos, 1, oBrowse:rowPos, oBrowse:colCount }, ; { nColPair, nColPair2 } ) oBrowse:hilite() // Повторная стабилизация //DO WHILE .NOT. oBrowse:stabilize() //ENDDO //oBrowse:ForceStable() DispEnd() /* сигналы о начале и конце базы */ IF oBrowse:hitBottom.OR.oBrowse:hitTop Tone( 500, 3 ) ENDIF /* строка состояния */ x := Col() ; y := Row() cStatus := "─" + LTrim( Str( ORDKEYNO() ) ) + '/' + LTrim( Str( ORDKEYCOUNT( 1 ) ) ) + "─" cTekCol := NTOCOLOR( SCREENATTR( nTop - 1, nRight - Len( cStatus ) - 2 ) ) @ nTop - 1, nRight - Len( cStatus ) - 2 SAY cStatus COLOR ( cTekCol ) // Полоски индикации // Перерисовать указатель индикации ScrollBarUpdate( aScroll, ORDKEYNO(), ORDKEYCOUNT(), .T. , cColScroll ) // Рисуем нижнию индикатор, если кол-во полей > 3 IF Len( aFieldName ) > 3 ScrollBagUpdate( aScrollGrz, oBrowse:colPos - oBrowse:freeze, oBrowse:colCount - oBrowse:freeze, .T. ) ENDIF @ y, x SAY "" /* Определение нажатия клавиши или мышки */ nKey := oBrowse:applykey( Inkey( 0, INKEY_ALL ) ) /* доп.обработка нажатий клавиш мышки */ IF LastKey() > 999 nRetMouse := Ask2Mouse( aKeyMouse, MROW(), MCOL() ) IF LEN(aKeyMouse) > 0 nRetMouse := Ask2Mouse( aKeyMouse, MROW(), MCOL() ) IF nRetMouse # 0 nKey := aKeyMouse[ nRetMouse, 5 ] Inkey( 0.1 ) ENDIF ENDIF ENDIF /* обработка нажатых клавиш */ DO CASE CASE nKey == K_UP oBrowse:up() CASE nKey == K_DOWN oBrowse:down() CASE nKey == K_LEFT oBrowse:Left() CASE nKey == K_RIGHT oBrowse:Right() CASE nKey == K_PGUP oBrowse:pageUp() CASE nKey == K_PGDN oBrowse:pageDown() CASE nKey == K_HOME //oBrowse:home() // - закоментировано, чтоб курсор не прыгал в 1 столбец CASE nKey == K_END oBrowse:END() CASE nKey == K_CTRL_PGUP oBrowse:goTop() CASE nKey == K_CTRL_PGDN oBrowse:goBottom() CASE nKey == K_CTRL_LEFT oBrowse:panLeft() CASE nKey == K_CTRL_RIGHT oBrowse:panRight() CASE nKey == K_CTRL_HOME oBrowse:panHome() CASE nKey == K_CTRL_END oBrowse:panEnd() /* Обработка собственных клавиш */ CASE nKey == K_ESC .OR. ( nKey == - 1 .AND. LastKey() == K_ESC ) nKey := K_ESC lCont := .F. CASE nKey == K_F1 // Help() CASE nKey == K_ALT_X // QuitDos() CASE nKey == K_ALT_M // KeyMem() CASE nKey == K_ENTER .OR. LastKey() == K_ENTER .OR. ; ( nKey == - 1 .AND. LastKey() == K_LDBLCLK ) nKey := K_ENTER nI := oBrowse:colPos // Можно воспользоваться станд. обработчиком - см. примеры Tbrowsa // DoGet( oBrowse, cGetColor, { | oGet | EditIt( oGet ) } ) nRet := myKey_Edit( nI, aFields[ nI ], aFieldPict[ nI ], cGetColor ) IF nRet > 0 oBrowse:RefreshAll() oBrowse:RefreshCurrent() oBrowse:configure() oBrowse:invalidate() ENDIF STABL_SP_POS( oBrowse ) // установка курсора на найденую запись !!!! CASE nKey == K_INS nRet := MyKey_INS() IF nRet > 0 oBrowse:RefreshAll() oBrowse:RefreshCurrent() oBrowse:configure() oBrowse:invalidate() ENDIF STABL_SP_POS( oBrowse ) // установка курсора на найденую запись !!!! CASE nKey == K_DEL nRet := MyKey_DEL() IF nRet > 0 WHILE eof().OR.!DELETED() EVAL(oBrowse:skipBlock,1) ENDDO STABL_SP_POS(oBrowse) oBrowse:configure() oBrowse:invalidate() ENDIF CASE nKey == K_F5 MyKey_F5() CASE nKey == K_F8 MyKey_F8() // Сортировка. STABL_SP_POS( oBrowse ) // установка курсора на найденую запись !!!! CASE nKey == K_F9 // Любая ваша функция //nRet := MyKey_F9() CASE nKey == K_F10 // Любая ваша функция //nRet := myKey_F10() CASE nKey == K_F11 // Дубль nRec := RecNo() nRet := MyKey_F11() IF nRet > 0 oBrowse:RefreshAll() DBGoTo( nRec ) oBrowse:RefreshCurrent() oBrowse:configure() oBrowse:invalidate() ENDIF STABL_SP_POS( oBrowse ) // установка курсора на найденую запись !!!! CASE nKey == K_F12 // Любая ваша функция //nRet := myKey_F10() ENDCASE ENDDO /* Восстановление курсора */ SetCursor( nCursor ) MSETCURSOR( .F. ) RETURN nKey *= == == == == == == == == == == == == == == == == == == == == == == == == == == == == == == STATIC FUNCTION myMouseTB ( o, r, c ) LOCAL nPos := o:hittest( r, c ) //@ 24, 0 say nPos IF nPos == HTNOWHERE //мышь вне окна BROWSE //tone(300,10) ELSEIF nPos == HTTOPLEFT //верхний левый угол o:panHome() ELSEIF nPos == HTTOP //верхняя горизонтальная линия окна o:up() ELSEIF nPos == HTTOPRIGHT //и так далее o:gotop() ELSEIF nPos == HTRIGHT o:Right() ELSEIF nPos == HTBOTTOMRIGHT o:gobottom() ELSEIF nPos == HTBOTTOM o:down() ELSEIF nPos == HTLEFT o:Left() //elseif nPos==HTCELL //o:() ELSE //эта системная функция вызывается по умолчанию //она работает только внутри BROWSE окна и переводит курсор //на нужную позицию tbMouse( o, r, c ) ENDIF RETURN o // End of static Function *= == == == == == == == == == == == == == == == == == == == == == == == == == == == == == == STATIC FUNCTION Ask2Mouse( aMenu, nYMouse, nXMouse ) LOCAL nRet := 0, nJM, nIM, aYMouse := { }, aXMouse := { }, nJ, nI LOCAL nYtmp, nXtmp, lMouse := .F. FOR nJM := 1 TO Len( aMenu ) IF nYMouse >= aMenu[ nJM, 1 ] .AND. nYMouse <= aMenu[ nJM, 3 ] AAdd( aYMouse, nJM ) ENDIF NEXT FOR nIM := 1 TO Len( aMenu ) IF nXMouse >= aMenu[ nIM, 2 ] .AND. nXMouse <= aMenu[ nIM, 4 ] AAdd( aXMouse, nIM ) ENDIF NEXT IF Len( aYMouse ) > 0 .AND. Len( aXMouse ) > 0 FOR nI := 1 TO Len( aYMouse ) nYtmp := aYMouse[ nI ] FOR nJ := 1 TO Len( aXMouse ) nXtmp := aXMouse[ nJ ] IF nYtmp == nXtmp lMouse := .T. nRet := nYtmp ENDIF NEXT NEXT ENDIF RETURN nRet *= == == == == == == == == == == == == == == == == == == == == == == == == == == == == == == * Добавил Сидоров Александр *= == == == == == == == == == == == == == == == == == == == == == == == == == == == == == == STATIC FUNCTION Stabl_sp_pos( b ) // установка курсора на найденую запись !!!! LOCAL File_Pos := RecNo() b:rowPos = 1 - Eval( b:skipBlock, 1 - b:RowPos ) //Выполнить любой Skipper(b:RowPos-b:RowCount) goto File_Pos b:RefreshAll() DO WHILE ! b:stabilize() ENDDO RETURN NIL *= == == == == == == == == == == == == == == == == == == == == == == == == == == == == == == == == == == == == = * Эта функция только в качестве примера *= == == == == == == == == == == == == == == == == == == == == == == == == == == == == == == STATIC FUNCTION MyKey_Edit( nI, cPoleField, cPolePict, cGetColor ) LOCAL cPoleEdit, GETLIST := {}, nRet := 1 LOCAL x, y, cTekColor := SetColor() SetColor( cGetColor ) x := Col() ; y := Row() LINE23EDIT() cPoleEdit := FieldGet( FIELDNUM( cPoleField ) ) Set CURSOR ON @ y, x GET FIELD->&cPoleField PICTURE cPolePict READ Set CURSOR OFF LINE23() IF LASTKEY() == K_ESC nRet := 0 ENDIF SetColor( cTekColor ) RETURN nRet *= == == == == == == == == == == == == == == == == == == == == == == == == == == == == == == STATIC FUNCTION MyKey_F5() LOCAL nRet := 0, cScr0 := SaveScreen(,,,,) Alert( " Меню печати !" ) RestScreen(,,,, cScr0 ) RETURN nRet *= == == == == == == == == == == == == == == == == == == == == == == == == == == == == == == STATIC FUNCTION MyKey_F8() LOCAL nRet := 0, aMenu := { }, cScr0 := SaveScreen(,,, ) AAdd( aMenu, " 1-Сортировка " ) AAdd( aMenu, " 2-Сортировка " ) AAdd( aMenu, " Выход " ) nRet := Alert( " Выберите сортировку !;", aMenu ) IF nRet == 0 .OR. nRet == Len( aMenu ) nRet := "" ELSE ENDIF RestScreen(,,,, cScr0 ) RETURN nRet *= == == == == == == == == == == == == == == == == == == == == == == == == == == == == == == STATIC FUNCTION MyKey_INS() LOCAL nK, nRet := 0 nK := Alert( "Вы хотите вставить новую запись?", { "[ Да ]", "[ Нет ]" } ) IF nK == 1 DBAppend() nRet := 1 ELSE ENDIF RETURN nRet *= == == == == == == == == == == == == == == == == == == == == == == == == == == == == == == STATIC FUNCTION MyKey_DEL() LOCAL nK, nRet := 0 nK := ALERT( "Вы хотите удалить эту запись ?", { "[ Да ]", "[ Нет ]" } ) IF nK == 1 DELETE nRet := 1 ELSE ENDIF RETURN nRet *= == == == == == == == == == == == == == == == == == == == == == == == == == == == == == == STATIC FUNCTION MyKey_F9() LOCAL nRet := 0 RETURN nRet *= == == == == == == == == == == == == == == == == == == == == == == == == == == == == == == STATIC FUNCTION MyKey_F10( nI, cPoleField, cPolePict, cGetColor ) LOCAL nRet := 0 RETURN nRet *= == == == == == == == == == == == == == == == == == == == == == == == == == == == == == == STATIC FUNCTION MyKey_F11() LOCAL nK, nRet := 0 nK := ALERT( "Вы хотите продублировать эту запись?", { "[ Да ]", "[ Нет ]" } ) IF nK == 1 Tone( 800, 2 ) Alert( "Сделайте сами обработку !" ) ENDIF // K RETURN nRet *= == == == == == == == == == == == == == == == == == == == == == == == == == == == == == == STATIC FUNCTION MyKey_F12() LOCAL nRet := 0 RETURN nRet *= == == == == == == == == == == == == == == == == == == == == == == == == == == == == == == FUNCTION Line23Edit() LOCAL cColor := SetColor() LOCAL nY := MaxRow() , nX := 0 , nLen := MaxCol() SetColor( "0/12" ) @ nY, nX SAY PadC( "", nLen+1 ) COLOR( "0/12" ) @ nY, nX SAY " ВВОДИТЕ. Ins-вставка Del-удаление <- -Удаление слева Enter <┘-конец ввода" SetColor( "N*/R" ) @ nY, nX SAY " ВВОДИТЕ!" SetColor( "GR+/R" ) @ nY, nX + 10 SAY "Ins" @ nY, nX + 23 SAY "Del" @ nY, nX + 37 SAY " <-" @ nY, nX + 57 SAY "Enter <╜ " SetColor( cColor ) RETURN NIL *= == == == == == == == == == == == == == == == == == == == == == == == == == == == == == == FUNCTION LINE23() LOCAL cColor := SetColor() LOCAL nY := MaxRow() , nX := 0 , nLen := MaxCol() SetColor( "0/15" ) @ nY, nX SAY PadC( "", nLen+1 ) color( "0/15" ) @ nY, nX SAY " Del/Ins-удаление/новая запись F5-Печать F8-сортировка F9/10/11/12 Esc-Выход" @ nY, nX + 1 SAY "Del" COLOR( "GR+/R" ) @ nY, nX + 5 SAY "Ins" COLOR( "GR+/R" ) @ nY, nX + 31 SAY "F5" COLOR( "GR+/R" ) @ nY, nX + 41 SAY "F8" COLOR( "GR+/R" ) @ nY, nX + 56 SAY "F9/10/11/12" COLOR( "GR+/R" ) @ nY, nX + 69 SAY "Esc" COLOR( "GR+/R" ) SetColor( cColor ) RETURN NIL *= == == == == == == == == == == == == == == == == == == == == == == == == == == == == == == * От: Alexander S.Kresin http://kresin.belgorod.su/rus/index.html *= == == == == == == == == == == == == == == == == == == == == == == == == == == == == == == FUNCTION Create_Test_DBF() LOCAL cTable := "test.dbf", aDbf, nI, n1, n2 aDbf := { { "FirstName", "C", 20, 0 }, ; { "LastName" , "C", 20, 0 }, ; { "Age" , "N", 3, 0 }, ; { "Date" , "D", 8, 0 }, ; { "Rate" , "N", 6, 2 }, ; { "Logik" , "L", 1, 0 } } IF !FILE(cTable) // если нет базы, то создать ее DBCreate( cTable, aDbf ) USE ( cTable ) NEW FOR nI := 1 TO 100 APPEND BLANK n1 := hb_RandomInt( 80 ) n2 := hb_RandomInt( 50 ) REPLACE FIELD->Age WITH n1, ; FIELD->Date WITH Date() - 365 * n2 + n1, ; FIELD->Rate WITH 56.5 - n1 / 2 REPLACE FIELD->FirstName WITH "A" + Chr( 64 + n2 ) + PadL( nI, 10, '0' ), ; FIELD->LastName WITH "B" + Chr( 70 + n2 ) + PadL( nI, 12, '0' ), ; FIELD->Logik WITH ( ( FIELD->Age % 2 ) == 1 ) NEXT USE ENDIF RETURN NIL *= == == == == == == == == == == == == == == == == == == == == == == == == == == == == == == * Функция для совместимости с Clipper 5.3 добавил Павел Царенко *= == == == == == == == == == == == == == == == == == == == == == == == == == == == == == == Function SETRC( nOldRow, nOldCol ) LOCAL nRow, nCol if nRow == nil nRow := Row() endif if nCol == nil nCol := Col() endif SetPos(nRow, nCol) RETURN NIL *= == == == == == == == == == == == == == == == == == == == == == == == == == == == == == == * * Далее для простоты включена программа Scrolbar.prg из * стандартной поставки Clipper 5.3 и немного модифицированная * *= == == == == == == == == == == == == == == == == == == == == == == == == == == == == == == /*** * * Scrolbar.prg * * Implements a scroll bar that can be updated as the cursor moves down * in a TBrowse object, ACHOICE(), DBEDIT(), or MEMOEDIT() * * Copyright (c) 1993, Computer Associates International Inc. * All rights reserved. * * NOTE: Compile with /n /w */ //start #include "Fileman.ch" /*** * * Fileman.ch * * Include file for Fileman.prg * * Copyright (c) 1993, Computer Associates International. * All rights reserved. * */ // The elements in aFileMan #define FM_ROWTOP 1 #define FM_COLTOP 2 #define FM_ROWBOTTOM 3 #define FM_COLBOTTOM 4 #define FM_COLOR 5 #define FM_PATH 6 #define FM_RETURNFILE 7 #define FM_OLDCOLOR 8 #define FM_OLDSCREEN 9 #define FM_OLDSELECT 10 #define FM_ELEMENTS 10 // Для имени внешнего редактора ( 10-10-94 05:02pm ) #define FM_EDITOR "wd.com" // The elements in aTab #define TB_ROWTOP 1 #define TB_COLTOP 2 #define TB_ROWBOTTOM 3 #define TB_COLBOTTOM 4 #define TB_COLOR 5 #define TB_POSITION 6 #define TB_ELEMENTS 6 // Для горизонтального меню ( 07-24-94 12:10pm ) #define TB_LEFTROW 1 #define TB_LEFTCOL 2 #define TB_RIGHTROW 3 #define TB_RIGHTCOL ...

Andrey: ... 4 // The main menu items #define MN_LOOK 1 #define MN_COPY 2 #define MN_RENAME 3 #define MN_DELETE 4 #define MN_PRINT 5 #define MN_OPEN 6 // The Up and Down arrows, highlight and background char's for the thumb tab #define TB_UPARROW Chr( 24 ) #define TB_DNARROW Chr( 25 ) #define TB_HIGHLIGHT Chr( 219 ) #define TB_BACKGROUND Chr( 176 ) // Для горизонтального меню ( 07-24-94 12:10pm ) #define TB_LEFTARROW Chr( 27 ) #define TB_RIGHTARROW Chr( 26 ) // The checkmark for the tagged files #define FM_CHECK Chr( 251 ) // Other definitions #define FM_SINGLEFRAME "┌─┐│┘─└│" #define FM_SINGLEBORDER "├┤┬┴" #define FM_DOUBLEFRAME "╔═╗║╝═╚║" #define FM_DOUBLEBORDER "╠╣╦╩" #define FM_LEFT 1 #define FM_RIGHT 2 #define FM_TOP 3 #define FM_BOTTOM 4 #define FM_HORIZONTAL 2 #define FM_VERTICAL 4 //end #include "Fileman.ch" /*** * * ScrollBarNew( <nTopRow>, <nTopColumn>, <nBottomRow>, * <cColorString>, <nInitPosition> ) --> aScrollBar * * Create a new scroll bar array with the specified coordinates */ FUNCTION ScrollBarNew( nTopRow, nTopColumn, nBottomRow, ; cColorString, nInitPosition ; ) LOCAL aScrollBar := Array( TB_ELEMENTS ) aScrollBar[ TB_ROWTOP ] := nTopRow aScrollBar[ TB_COLTOP ] := nTopColumn aScrollBar[ TB_ROWBOTTOM ] := nBottomRow aScrollBar[ TB_COLBOTTOM ] := nTopColumn // Set the default color to White on Black if none specified IF ( cColorString == NIL ) cColorString := "W/N" ENDIF aScrollBar[ TB_COLOR ] := cColorString // Set the starting position IF ( nInitPosition == NIL ) nInitPosition := 1 ENDIF aScrollBar[ TB_POSITION ] := nInitPosition RETURN ( aScrollBar ) /*** * * ScrollBarDisplay( <aScrollBar> ) --> aScrollBar * * Display a scoll bar array to the screen * */ FUNCTION ScrollBarDisplay( aScrollBar ) LOCAL cOldColor, cTop, cBottom LOCAL nRow, nOldRow, nOldCol cOldColor := SetColor( aScrollBar[ TB_COLOR ] ) nOldRow := Row() nOldCol := Col() IF M->SetLang == "HARBOUR" cTop := "^" ; cBottom := "v" ELSE cTop := Chr( 30 ) ; cBottom := Chr( 31 ) ENDIF // Draw the arrows @ aScrollBar[ TB_ROWTOP ], aScrollBar[ TB_COLTOP ] SAY cTop // стрелка вверх @ aScrollBar[ TB_ROWBOTTOM ], aScrollBar[ TB_COLBOTTOM ] SAY cBottom // стрелка вниз // Draw the background FOR nRow := ( aScrollBar[ TB_ROWTOP ] + 1 ) TO ; ( aScrollBar[ TB_ROWBOTTOM ] - 1 ) @ nRow, aScrollBar[ TB_COLTOP ] SAY Chr( 176 ) // линия прокрутки NEXT SetColor( cOldColor ) SETRC( nOldRow, nOldCol ) RETURN ( aScrollBar ) /*** * * ScrollBarUpdate( <aScrollBar>, <nCurrent>, <nTotal>, * <lForceUpdate> ) --> aScrollBar * * Update scroll bar array with new tab position and redisplay tab **/ FUNCTION ScrollBarUpdate( aScrollBar, nCurrent, nTotal, lForceUpdate , cNewColor ) LOCAL cOldColor, nOldRow, nOldCol LOCAL nNewPosition LOCAL nScrollHeight := ( aScrollBar[ TB_ROWBOTTOM ] - ; aScrollBar[ TB_ROWTOP ] ; ) - 1 IF ( nTotal < 1 ) nTotal := 1 ENDIF IF ( nCurrent < 1 ) nCurrent := 1 ENDIF IF ( nCurrent > nTotal ) nCurrent := nTotal ENDIF IF ( lForceUpdate == NIL ) lForceUpdate := .F. ENDIF IF ( cNewColor == NIL ) cNewColor := "" ENDIF cOldColor := SetColor( aScrollBar[ TB_COLOR ] ) nOldRow := Row() nOldCol := Col() // Determine the new position nNewPosition := Round( ( nCurrent / nTotal ) * nScrollHeight, 0 ) // Resolve algorythm oversights nNewPosition := IF( nNewPosition < 1, 1, nNewPosition ) nNewPosition := IF( nCurrent == 1, 1, nNewPosition ) nNewPosition := IF( nNewPosition == 1 .AND.nCurrent <> 1, 2, nNewPosition ) nNewPosition := IF( nCurrent == nTotal, nScrollHeight , nNewPosition ) nNewPosition := IF( nNewPosition >= nScrollHeight .AND.nCurrent <> nTotal, ; nScrollHeight - 1, nNewPosition ) // Overwrite the old position (if different), then draw in the new one IF ( nNewPosition <> aScrollBar[ TB_POSITION ] .OR. lForceUpdate ) @ ( aScrollBar[ TB_POSITION ] + aScrollBar[ TB_ROWTOP ] ), ; aScrollBar[ TB_COLTOP ] SAY Chr( 176 ) // линия прокрутки @ ( nNewPosition + aScrollBar[ TB_ROWTOP ] ), aScrollBar[ TB_COLTOP ] SAY ; Chr( 219 ) // CHR( 254 ) IF Len( cNewColor ) > 0 @ ( nNewPosition + aScrollBar[ TB_ROWTOP ] ), aScrollBar[ TB_COLTOP ] SAY ; Chr( 254 ) COLOR( cNewColor ) ENDIF aScrollBar[ TB_POSITION ] := nNewPosition ENDIF SetColor( cOldColor ) SETRC( nOldRow, nOldCol ) RETURN ( aScrollBar ) /*** * * ScrollBagNew( <nLeftRow>, <nLeftColumn>, <nRightColumn>, * <cColorString>, <nInitPosition> ) --> aScrollBar * * Создает массив для полосы скролирования с необходимыми параметрами */ /*********************************************************** * ScrollBagNew() --> aScrollBar * Параметры : nLeftRow - номер строки, в которой будет полоса скрол. nLeftColumn - номер начального столбца полосы скрол., nRightColumn - номер конечного столбца полосы скрол. cColorString - строка цвета, в кот. изображается полоса nInitPosition - начальная позиция "бегунка" * Возвращает: Массив */ FUNCTION ScrollBagNew( nLeftRow, nLeftColumn, nRightColumn, ; cColorString, nInitPosition ; ) LOCAL aScrollBar := Array( TB_ELEMENTS ) aScrollBar[ TB_LEFTROW ] := nLeftRow aScrollBar[ TB_LEFTCOL ] := nLeftColumn aScrollBar[ TB_RIGHTROW ] := nLeftRow aScrollBar[ TB_RIGHTCOL ] := nRightColumn // Set the default color to White on Black if none specified IF ( cColorString == NIL ) cColorString := "W/N" ENDIF aScrollBar[ TB_COLOR ] := cColorString // Set the starting position IF ( nInitPosition == NIL ) nInitPosition := 1 ENDIF aScrollBar[ TB_POSITION ] := nInitPosition RETURN ( aScrollBar ) /*** * * ScrollBagDisplay( <aScrollBar> ) --> aScrollBar * * Рисует горизонтальную полоску на экране * */ FUNCTION ScrollBagDisplay( aScrollBar ) LOCAL cOldColor, cRight, cLeft LOCAL nCol, nOldRow, nOldColumn cOldColor := SetColor( aScrollBar[ TB_COLOR ] ) nOldRow := Row() nOldColumn := Col() IF M->SetLang == "HARBOUR" cLeft := "<" ; cRight := ">" ELSE cLeft := Chr( 17 ) ; cRight := Chr( 16 ) ENDIF // Draw the arrows @ aScrollBar[ TB_LEFTROW ], aScrollBar[ TB_LEFTCOL ] SAY cLeft @ aScrollBar[ TB_RIGHTROW ], aScrollBar[ TB_RIGHTCOL ] + 1 SAY cRight // Draw the background FOR nCol := ( aScrollBar[ TB_LEFTCOL ] + 1 ) TO ; ( aScrollBar[ TB_RIGHTCOL ] ) @ aScrollBar[ TB_LEFTROW ], nCol SAY Chr( 176 ) NEXT SetColor( cOldColor ) SETRC( nOldRow, nOldColumn ) RETURN ( aScrollBar ) /*** * * ScrollBagUpdate( <aScrollBar>, <nCurrent>, <nTotal>, * <lForceUpdate> ) --> aScrollBar * * Прорисовывает новое положение бегунка **/ FUNCTION ScrollBagUpdate( aScrollBar, nCurrent, nTotal, lForceUpdate ) LOCAL cOldColor, nOldRow, nOldColumn LOCAL nNewPosition LOCAL nScrollHeight nScrollHeight := aScrollBar[ TB_RIGHTCOL ] - aScrollBar[ TB_LEFTCOL ] IF ( nTotal < 1 ) nTotal := 1 ENDIF IF ( nCurrent < 1 ) nCurrent := 1 ENDIF IF ( nCurrent > nTotal ) nCurrent := nTotal ENDIF IF ( lForceUpdate == NIL ) lForceUpdate := .F. ENDIF cOldColor := SetColor( aScrollBar[ TB_COLOR ] ) nOldRow := Row() nOldColumn := Col() // Determine the new position nNewPosition := Round( ( nCurrent / nTotal ) * nScrollHeight, 0 ) // Resolve algorythm oversights nNewPosition := IF( nNewPosition < 1, 1, nNewPosition ) nNewPosition := IF( nCurrent == 1, 1, nNewPosition ) nNewPosition := IF( nNewPosition == 1 .AND.nCurrent <> 1, 2, nNewPosition ) nNewPosition := IF( nCurrent == nTotal, nScrollHeight, nNewPosition ) nNewPosition := IF( nNewPosition >= nScrollHeight .AND.nCurrent <> nTotal, ; nScrollHeight - 1, nNewPosition ; ) IF ( nNewPosition <> aScrollBar[ TB_POSITION ] .OR. lForceUpdate ) @ aScrollBar[ TB_LEFTROW ], ; ( aScrollBar[ TB_POSITION ] + aScrollBar[ TB_LEFTCOL ] ) ; SAY Chr( 176 ) @ aScrollBar[ TB_LEFTROW ], ; ( nNewPosition + aScrollBar[ TB_LEFTCOL ] ) ; SAY Chr( 254 ) aScrollBar[ TB_POSITION ] := nNewPosition ENDIF SetColor( cOldColor ) SETRC( nOldRow, nOldColumn ) RETURN ( aScrollBar )

viton2008: Andrey Пришлите пример на viton@tut.by заранее спасибо

alex_II: И мне пожалуйста тоже на leksile@mail.ru Заранее благодарю

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