После глобального поиска по архивам, сетям и консультаций собрал наконец-то рабочий 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 ...
- участник сейчас на форуме
- участник вне форума