6. SetConsoleTitle и GetConsoleTitle соотсвенно ..

2. SetConsoleCursorPosition а чтоб получить то через GetConsoleScreenBufferInfo

5. через SetConsoleTextAttribute

1. FillConsoleOutputCharacter комбинируя с SetConsoleCursorPosition

это так... экспромтом ... с работы вернусь .. дальше что нить думать будем...

Ответить

Хм возникла у меня идейка одна +) злая... надеюсь сегодня будет время попробовать.. +)

Ответить

Ответить

Предлагаю желающим написать функции для работы
с консолью для PBWIN 7.x
Мой вклад, примерная схема реализации событий от клавиатуры,
или аналог оператора INKEY$ из досовских версий бейсика.
Функция  Inkey возвращает скан-код нажатой клавиши.

Для полноценной работы с консолью, еще желательна поддержка
мыши, а также операторов: CLS, LOCATE, COLOR, PRINT, INPUT

'----------------------------------------------------------
'Компилировать только в препроцессоре Семёна Матусовского!

'% SUBSYSTEM CONSOLE

#Compile Exe
#Dim All
#Include "WIN32API.INC"
Global hCons     As Dword
Global hInp      As Long
Global hOut      As Long
Global lRslt     As Long

'*****************************************************
'Функция считывает с консоли код любой нажатой клавиши.
Function Inkey() As String
Local InputRecords()   As Input_Record
Local lpNumberOfEvents As Long
Local lpNumberOfEvent  As Long
Local lResult          As Long
Local VirtualScanCode  As Word
Local VirtualKeyCode   As Word
Local AsciiChar        As Word
Local tKbdSymbol       As Word
Local lReturn          As String
Do
If IsFalse(GetNumberOfConsoleInputEvents (hInp, lpNumberOfEvents)) Then
ElseIf lpNumberOfEvents Then
ReDim InputRecords(1 To lpNumberOfEvents) As Input_Record
lResult = ReadConsoleInput(hInp, InputRecords(1).EventType, lpNumberOfEvents, lpNumberOfEvents)
If lResult And lpNumberOfEvents Then
For lpNumberOfEvent = 1 To lpNumberOfEvents
Select Case (InputRecords(lpNumberOfEvent).EventType And &H0000000F)
Case 1 ' Key Event
Select Case (InputRecords(lpNumberOfEvent).Event.keyEvent.bKeyDown And &H00000001)
Case 1: ' KeyDown
VirtualScanCode = InputRecords(lpNumberOfEvent).Event.keyEvent.wVirtualScanCode
VirtualKeyCode  = InputRecords(lpNumberOfEvent).Event.keyEvent.wVirtualKeyCode
AsciiChar       = InputRecords(lpNumberOfEvent).Event.keyEvent.uChar
tKbdSymbol = InputRecords(lpNumberOfEvent).Event.keyEvent.dwControlKeyState
lReturn=Format$(VirtualScanCode)
End Select
End Select
Next
End If
Else
End If
If Trim$(lReturn) <> "" Then
Function = lReturn
Exit Loop
End If
Loop
End Function
'*****************************************************

Function PBMain()
Local SecAttr   As SECURITY_ATTRIBUTES
Local InpRec    As INPUT_RECORD
Local n         As Long
Local EvNum     As Long
Local s         As Asciz * 200
Local sp        As Asciz Ptr

hInp = GetStdHandle( %STD_INPUT_HANDLE )
hOut = GetStdHandle( %STD_OUTPUT_HANDLE )
hCons = CreateConsoleScreenBuffer( %GENERIC_READ Or %GENERIC_WRITE, _
%FILE_SHARE_READ Or %FILE_SHARE_WRITE, SecAttr, %CONSOLE_TEXTMODE_BUFFER, 0 )

1:
s=Inkey ' Ожидается нажатие кнопки на клавиатуре
s=s+Chr$(32)
sp=VarPtr(s)
n=Len(s)
n = WriteConsole( hOut, s, n, n, 0 )
GoTo 1 'Бесконечный цикл, выход по CTRL+C
End Function
'----------------------------------------------------------                  
                                                      

Ответить

SUB CLS()

DIM gEtInfo AS CONSOLE_SCREEN_BUFFER_INFO

GetConsoleScreenBufferInfo std_output, gEtInfo

FillConsoleOutputCharacter std_output, 32, _

(gEtInfo.srWindow.xRight - gEtInfo.srWindow.xLeft) _

*(gEtInfo.srWindow.xBottom - gEtInfo.srWindow.xTop), BYVAL 0, BYVAL 0

LOCATE 0, 0

END SUB

SUB LOCATE(x AS WORD, y AS WORD)

DIM Pos AS DWORD PTR

MoveMemory BYVAL VARPTR(Pos), x, 2

MoveMemory BYVAL (VARPTR(Pos)+2), y, 2

SetConsoleCursorPosition STD_OUT_HANDLE, Pos

END SUB

Очистка экрана в ПБ идёт именно так +) установка курсора тоже так что .. это так сказать ... полная замена этим функциям....

единтсвенно что уже бесит .. после изучения откомпилированых программ довно уже заметил что там много мусора.... зачем то открывается ключ реестра и закрывается... и тд итп... поглядити и увидете мноГОООО флуда.... + если используете инклуды то надо всё чистить InClean ом а иначе даже не используемые константы и прочии .. гадости будут у вас в екзешники !...

Ответить

std_output - STD_OUT_HANDLE +) забыл подправить ...

Ответить

Кстати, у меня твои функции не работают! ((

Может полный исходник приведешь...

Ответить

Без проблем... вот я просто как то уже хотел .. сделать все функции и поэтому и глядел под дизассемблером как делается в самом ... консольном компиляторе то там столько мусора что даже как то ПБ противен стал +) просто обидно даже что ВБ хороший компилятор оптимизирует хорошо но юзает рантайм... а вот ПБ не юзает рантайм но блин хлама там и неоптимизированости дочерта +)

ИНКЛУД!

%TRUE  = 1
%FALSE = 0
%NULL  = 0

%STD_INPUT_HANDLE  = -10&
%STD_OUTPUT_HANDLE = -11&
'my const and types
TYPE COORD
  x AS INTEGER
  y AS INTEGER
END TYPE
TYPE SMALL_RECT
  xLeft AS INTEGER
  xTop AS INTEGER
  xRight AS INTEGER
  xBottom AS INTEGER
END TYPE
TYPE CONSOLE_SCREEN_BUFFER_INFO
  dwSize AS COORD
  dwCursorPosition AS COORD
  wAttributes AS WORD
  srWindow AS SMALL_RECT
  dwMaximumWindowSize AS COORD
END TYPE
'external declaration
DECLARE SUB InitBIOS()
DECLARE SUB STDOUT (psBuffer AS ASCIIZ)
DECLARE SUB STDOUTLINE (psBuffer AS ASCIIZ)
'api declaration
DECLARE FUNCTION WriteConsole LIB "KERNEL32.DLL" ALIAS "WriteConsoleA" (BYVAL hConsoleOutput AS DWORD, lpBuffer AS ASCIIZ, BYVAL nNumberOfCharsToWrite AS LONG, lpNumberOfCharsWritten AS LONG, BYVAL lpReserved AS LONG) AS LONG
DECLARE FUNCTION GetStdHandle LIB "KERNEL32.DLL" ALIAS "GetStdHandle" (BYVAL nStdHandle AS DWORD) AS DWORD
DECLARE FUNCTION SetConsoleTitle LIB "KERNEL32.DLL" ALIAS "SetConsoleTitleA" (lpConsoleTitle AS ASCIIZ) AS LONG
DECLARE FUNCTION SetConsoleCursorPosition LIB "KERNEL32.DLL" ALIAS "SetConsoleCursorPosition" (BYVAL hConsoleOutput AS DWORD, BYVAL dwCursorPosition AS DWORD) AS LONG
DECLARE SUB MoveMemory LIB "KERNEL32.DLL" ALIAS "RtlMoveMemory" (pDestination AS ANY, pSource AS ANY, BYVAL cbLength AS LONG)
DECLARE FUNCTION FillConsoleOutputCharacter LIB "KERNEL32.DLL" ALIAS "FillConsoleOutputCharacterA" (BYVAL hConsoleOutput AS DWORD, BYVAL bCharacter AS BYTE, BYVAL nLength AS DWORD, BYVAL dwWriteCoord AS DWORD, lpNumberOfCharsWritten AS DWORD) AS LONG
DECLARE FUNCTION GetConsoleScreenBufferInfo LIB "KERNEL32.DLL" ALIAS "GetConsoleScreenBufferInfo" (BYVAL hConsoleOutput AS DWORD, lpConsoleScreenBufferInfo AS CONSOLE_SCREEN_BUFFER_INFO) AS LONG

САМ КОД МОДУЛЯ

'% SUBSYSTEM CONSOLE
#COMPILE EXE
#DIM ALL
#INCLUDE "xtpsd.inc"
GLOBAL std_input AS DWORD, std_output AS DWORD
       
SUB LOCATE(x AS WORD, y AS WORD)
    DIM Pos AS DWORD PTR
    MoveMemory BYVAL VARPTR(Pos), x, 2
    MoveMemory BYVAL (VARPTR(Pos)+2), y, 2
    SetConsoleCursorPosition std_output, Pos
END SUB

SUB CLS()
    DIM gEtInfo AS CONSOLE_SCREEN_BUFFER_INFO
    GetConsoleScreenBufferInfo std_output, gEtInfo
    FillConsoleOutputCharacter std_output, 32, _
        (gEtInfo.srWindow.xRight - gEtInfo.srWindow.xLeft) _
       *(gEtInfo.srWindow.xBottom - gEtInfo.srWindow.xTop), BYVAL 0, BYVAL 0
    LOCATE 0, 0
END SUB
FUNCTION WINMAIN (BYVAL hInst AS DWORD, BYVAL hPrevInstance AS DWORD, _
                  BYVAL lpszCmdLine AS ASCIIZ PTR, BYVAL nCmdShow AS LONG) AS LONG
    InitBIOS
    SetConsoleTitle "-=XTPS=- by Ilichev Roman (05-2004 roman3k@mail.ru)"
    LOCATE 10,10
    STDOUTLINE "Program started at " & TIME$ & " | " & DATE$
    CLS
    STDOUTLINE "CLEAR"

    DO:LOOP
END FUNCTION

SUB InitBIOS()
    std_output = GetStdHandle(%STD_OUTPUT_HANDLE)
    std_input = GetStdHandle(%STD_INPUT_HANDLE)
END SUB

SUB STDOUTLINE (psBuffer AS ASCIIZ)
    psBuffer = psBuffer & $CRLF
    WriteConsole std_output, psBuffer, LEN(psBuffer), BYVAL %NULL, BYVAL %Null
END SUB

SUB STDOUT (psBuffer AS ASCIIZ)
    WriteConsole std_output, psBuffer, LEN(psBuffer), BYVAL %NULL, BYVAL %Null
END SUB

Ответить

xtpsв.inc - название инклуда соотсвенно модуль как хочешь называй.... да и насчёт инклудов делать их лучше тоже самому +) а то мусора будет ещё больше... как то кстати задавал разработчикам этот вопрос мол почему неоптимизирует их компилятор так как ВБ... и почему столько мусора... ну ответ был дал удивляющий ну и логичный ... мол всё ровно .. в итоге .. у ПБ программы скорость и размер меньше... но блин еслиб ещё оптимизация шла как у ВБ ... тогда бы и скорость былаб больше гораздо а размер гораздо меньше +)..

Ответить

скорость больше а размер меньше хотел написать +)

Ответить

Ну сравнил, VB могучая майкрософт создала, над ним может сотни программеров и тестеров горбатилось! А PB от силы несколько человек писало, если даже не сам автор...

Ответить

Просто обидно что он чем то лучше а чем то хуже +)

Ответить

Кстати, спасибо за исходник, очень пригодился! )

Будешь еще добавлять в него функции?

Ну что-то, типа COLOR, PANEL и т.п.

Ответить

Хорошо добавлю... если желаешь +) сегодня после работы ... вечерком постараюсь выложить если не успею то завтро утром...

Ответить

Ок, спасибо!

Думаю это многим пригодится...

)

Ответить