Автор вопроса: @CyRax PTR | Web-сайт:basicproduction.nm.ru/ | ICQ: 204447456
Кому интересно потестите на выбиваемость тултипы и падающий список. Ещё возможен вариант ненахождения путей к папке \WinAPI. В чём причина не пойму. 5-6 раз нормально передаёт строку, а потом или вопросики или кракозяблы. Скорее всего это глюк PB. Поэтому пока решил передавать не строку, а байтовый массив и его длину для CopyMemory. === Ссылка: http://basicproduction.nm.ru/POWERBASIC/PBNAVIGATOR/PBNav_A1.rar --- Установка: - Распакуйте в каталог \BIN --- Тест: 1. Откройте BAS-файл с инклюдами (#INCLUDE "Filespec") 2. Выберите в левом Combo SUB/FUNCTION или в правом CALLBACK; 2. Для показа тултипа введите имя объявленной (любой) или существующей (только из инклюда) процедуры и нажмите пробел или скобку. К примеру: ShowWindow Макросы пока не поддерживаются; 3. Для показа списка введите имя локальной UDT-переменной и нажмите точку. Юнионы и интерфейсы пока не поддерживаются. --- Пока не находит: - Процедуры текущего модуля; - Переменные в секции деклараций; - Не обрабатывает линейный разделитель ":". === Журнал процедур отключён для ускорения. Если кто хочет отследить ошибочную процедуру - могу выложить версию с логом в консоли.
Совсем неплохо! Только вот дизайнер форм там зачем? Ведь есть же PB-FORMS и дизайнеры ресурсов... И вообще, это мое мнение, лучше реализовать подход Семена Матусовского в его пропроцессоре к PB. Т.е. расширять возможности стандартного редактора PB, у Матусовского там можно создавать консольные приложения, компилировать ресурсы прямо из коментариев, запихивать DLL внутрь экзешника, и т.д.
Исходники к препроцессору прилагаются...
Рад что тебе понравилось. Ну дизайнером форм это назвать сложно. Скорее визуальный навигатор по формам. Для быстрых прог сгодится и как дизайнер, но всё равно дизайн будет упираться на внешние инструменты (PB Forms) и т.д.
Честно говоря препроцессор я не смотрел (времени не было), но сдаётся что это совсем для другого уровня програмеров. Да и для других целей я думаю. Может если он такой классный, то как нибудь присобачить его к этой IDE? Или он только на PB Edit расчитан?
Насчёт консоли. Если выложите исходники, тогда можно будет поставлять консольные функции в виде INC-файла.
Не стесняйтесь насчёт идей. Всё равно для посетителей этого форума (в нынешнем составе) IDE будет бесплатной.
---
PS: Потестите PB-шники, а то лажа будет если выбьет.
Type CONSOLE_EVENT SCAN_KB As String * 2 KEY_KB As String * 2 CHAR_KB As String * 2 ASCIIN_KB As String * 2 ASCIIC_KB As String * 2
End Type
'************************************************* Global hConsoleIn As Dword Global hConsoleOut As Dword Global hConsoleErr As Dword Global ConsoleEvent As CONSOLE_EVENT '*************************************************
Declare Function SetConsoleCursorPosition Lib "KERNEL32.DLL" Alias "SetConsoleCursorPosition" (ByVal hConsoleOutput As Dword, ByVal dwCursorPosition As COORD ) As Long
Declare Function ConsoleInit() As Dword Declare Function ConsolePrint(ByVal Txt As Asciiz * 255) As Dword Declare Function ConsoleRead() As String Declare Sub CLS() Declare Sub LOCATE(ByVal x As Word, ByVal y As Word) Declare Function Inkey() As String Declare Sub ConsoleColor(ByVal ton As Word, ByVal fon As Word)
'(Инициализация косоли) '************************************************* Function ConsoleInit() As Dword hConsoleIn = GetStdHandle(%STD_INPUT_HANDLE) hConsoleOut = GetStdHandle(%STD_OUTPUT_HANDLE) hConsoleErr = GetStdHandle(%STD_ERROR_HANDLE) End Function '*************************************************
'Функция печати на консоль строки '************************************************* Function ConsolePrint(ByVal Txt As Asciiz * 255) As Dword WriteConsole hConsoleOut, TXT, Len(TXT), %NULL, %NULL End Function '*************************************************
'Функция чтения строки с консоли '************************************************* Function ConsoleRead() As String Dim sInput As String * 255 Call ReadConsole(hConsoleIn, sInput, Len(sInput), %NULL, scrap& 'get the input 'FUNCTION = Left$(sInput, InStr(sInput, Chr$(0)) - 3) Function=sInput End Function '*************************************************
'Функция очистки консоли '************************************************* Sub CLS() Local ConsoleBuffer As CONSOLE_SCREEN_BUFFER_INFO Local dwConSize As Dword GetConsoleScreenBufferInfo hConsoleOut,ConsoleBuffer dwConSize=ConsoleBuffer.dwSize.X * ConsoleBuffer.dwSize.Y FillConsoleOutputCharacter hConsoleOut, 32,dwConSize , ByVal 0, ByVal 0 LOCATE 0,0 End Sub '*************************************************
'Функция установки позиции курсора '************************************************* Sub LOCATE(ByVal x As Word, ByVal y As Word) Local Pos As COORD Pos.x=x Pos.y=y SetConsoleCursorPosition hConsoleOut, Pos End Sub '*************************************************
'Функция обработки событий от клавиатуры '************************************************* 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 (hConsoleIn , lpNumberOfEvents)) Then ElseIf lpNumberOfEvents Then ReDim InputRecords(1 To lpNumberOfEvents) As Input_Record lResult = ReadConsoleInput(hConsoleIn, 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 If ((tKbdSymbol And %LEFT_ALT_PRESSED) Or (tKbdSymbol And %RIGHT_ALT_PRESSED)) Then lReturn = lReturn + "[ALT]" If ((tKbdSymbol And %LEFT_CTRL_PRESSED) Or (tKbdSymbol And %RIGHT_CTRL_PRESSED)) Then lReturn = lReturn + "[CTRL]" If ((tKbdSymbol And %SHIFT_PRESSED)) Then lReturn = lReturn + "[SHIFT]" If ((tKbdSymbol And %ENHANCED_KEY)) Then lReturn = lReturn + "[ENANCE]" If ((tKbdSymbol And %CAPSLOCK_ON)) Then lReturn = lReturn + "[CAPS]"
End Select End Select Next End If Else ' Sleep 1 End If If Trim$(lReturn) <> "" Then Function = ConsoleEvent.SCAN_KB Exit Loop End If Loop End Function
'Установка цвета '************************************************* Sub ConsoleColor(ByVal ton As Word, ByVal fon As Word) Local clr As Dword clr = (ton And 15) + ((fon And 15) * 16) SetConsoleTextAttribute hConsoleOut, clr End Sub '*************************************************
Фух, ну и намучался я с твоим кодом.
Теперь работает.
Во первых ConsoleInit у меня не работает напрочь.
Использовал имеющуюся у меня STDOUT
---
#If %Def(%Pb_Win32)
Function STDOUT (Z As String) As Long
' returns TRUE (non-zero) on success
Local hStdOut As Long, nCharsWritten As Long
Local w As String
hStdOut = GetStdHandle (%STD_OUTPUT_HANDLE)
If hSTdOut = -1& Then ' invalid handle value, coded in line to avoid casting differences in Win32API.INC
AllocConsole
hStdOut = GetStdHandle (%STD_OUTPUT_HANDLE)
End If
w = Z & $CrLf
Function = WriteFile(hStdOut, ByVal StrPtr(W), Len(W), nCharsWritten, ByVal %NULL)
End Function
#EndIf
---
Из за этого не работает весь код. При вызове SetConsoleCursorPosition
выдаёт ошибку 6(ERROR_INVALID_HANDLE). Это значит что hConsoleOut неверен. Передала LOCATE на основе STDOUT.
---
Sub LOCATE(ByVal x As Integer, ByVal y As Integer)
Local hStdOut As Long
hStdOut = GetStdHandle (%STD_OUTPUT_HANDLE)
If hSTdOut = -1& Then
AllocConsole
hStdOut = GetStdHandle (%STD_OUTPUT_HANDLE)
End If
If SetConsoleCursorPosition(hStdOut, MakDwd(x,y))=0 Then MsgBox Str$(GetLastError)
End Sub
---
Во вторых, как видно из этого кода. Портить Win32API.inc вовсе необязательно. Потому как общественность тебя осудит. Можно это обойти.
===
Остальное позже гляну.
Function WinMain ( ByVal hInstance As Dword, _
ByVal hPrevInst As Dword, _
ByVal lpszCmdLine As Asciiz Ptr, _
ByVal nCmdShow As Long ) As Long
ConsoleInit
ConsolePrint "Hello!"
Local tmp As String
Do While TMP <> "27"
inkey
TMP=ConsoleEvent.KEY_KB
ConsolePrint Chr$(Val(TMP))
Loop
End Function
Console.inc
Type COORD
x As Integer
y As Integer
End Type
Type CONSOLE_EVENT
SCAN_KB As String * 2
KEY_KB As String * 2
CHAR_KB As String * 2
ASCIIN_KB As String * 2
ASCIIC_KB As String * 2
End Type
'Глобальные переменные
'*************************************************
Global hConsoleIn As Dword
Global hConsoleOut As Dword
Global hConsoleErr As Dword
Global ConsoleEvent As CONSOLE_EVENT
'*************************************************
Declare Function SetConsoleCursorPosition Lib "KERNEL32.DLL" Alias "SetConsoleCursorPosition" (ByVal hConsoleOutput As Dword, ByVal dwCursorPosition As COORD ) As Long
Declare Function ConsoleInit() As Dword
Declare Function ConsolePrint(ByVal Txt As Asciiz * 255) As Dword
Declare Function ConsoleRead() As String
Declare Sub CLS()
Declare Sub LOCATE(ByVal x As Word, ByVal y As Word)
Declare Function Inkey() As String
Declare Sub ConsoleColor(ByVal ton As Word, ByVal fon As Word)
'(Инициализация косоли)
'*************************************************
Function ConsoleInit() As Dword
hConsoleIn = GetStdHandle(%STD_INPUT_HANDLE)
hConsoleOut = GetStdHandle(%STD_OUTPUT_HANDLE)
hConsoleErr = GetStdHandle(%STD_ERROR_HANDLE)
End Function
'*************************************************
'Функция печати на консоль строки
'*************************************************
Function ConsolePrint(ByVal Txt As Asciiz * 255) As Dword
WriteConsole hConsoleOut, TXT, Len(TXT), %NULL, %NULL
End Function
'*************************************************
'Функция чтения строки с консоли
'*************************************************
Function ConsoleRead() As String
Dim sInput As String * 255
Call ReadConsole(hConsoleIn, sInput, Len(sInput), %NULL, scrap& 'get the input
'FUNCTION = Left$(sInput, InStr(sInput, Chr$(0)) - 3)
Function=sInput
End Function
'*************************************************
'Функция очистки консоли
'*************************************************
Sub CLS()
Local ConsoleBuffer As CONSOLE_SCREEN_BUFFER_INFO
Local dwConSize As Dword
GetConsoleScreenBufferInfo hConsoleOut,ConsoleBuffer
dwConSize=ConsoleBuffer.dwSize.X * ConsoleBuffer.dwSize.Y
FillConsoleOutputCharacter hConsoleOut, 32,dwConSize , ByVal 0, ByVal 0
LOCATE 0,0
End Sub
'*************************************************
'Функция установки позиции курсора
'*************************************************
Sub LOCATE(ByVal x As Word, ByVal y As Word)
Local Pos As COORD
Pos.x=x
Pos.y=y
SetConsoleCursorPosition hConsoleOut, Pos
End Sub
'*************************************************
'Функция обработки событий от клавиатуры
'*************************************************
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
 o
If IsFalse(GetNumberOfConsoleInputEvents (hConsoleIn , lpNumberOfEvents)) Then
ElseIf lpNumberOfEvents Then
ReDim InputRecords(1 To lpNumberOfEvents) As Input_Record
lResult = ReadConsoleInput(hConsoleIn, 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
If ((tKbdSymbol And %LEFT_ALT_PRESSED) Or (tKbdSymbol And %RIGHT_ALT_PRESSED)) Then lReturn = lReturn + "[ALT]"
If ((tKbdSymbol And %LEFT_CTRL_PRESSED) Or (tKbdSymbol And %RIGHT_CTRL_PRESSED)) Then lReturn = lReturn + "[CTRL]"
If ((tKbdSymbol And %SHIFT_PRESSED)) Then lReturn = lReturn + "[SHIFT]"
If ((tKbdSymbol And %ENHANCED_KEY)) Then lReturn = lReturn + "[ENANCE]"
If ((tKbdSymbol And %CAPSLOCK_ON)) Then lReturn = lReturn + "[CAPS]"
End Select
End Select
Next
End If
Else
' Sleep 1
End If
If Trim$(lReturn) <> "" Then
Function = ConsoleEvent.SCAN_KB
Exit Loop
End If
Loop
End Function
'Установка цвета
'*************************************************
Sub ConsoleColor(ByVal ton As Word, ByVal fon As Word)
Local clr As Dword
clr = (ton And 15) + ((fon And 15) * 16)
SetConsoleTextAttribute hConsoleOut, clr
End Sub
'*************************************************
Я польностью отказался от стандартного PBEDIT и пользуюсь только PrePBEd Матусовсого. Для меня он намного удобнее в работе. И потом, к PrePBEd постоянно выходят дополнения и апдейты, исходный код ведь открыт...
Вот самый последний апгрейд к препроцессору
Console Display Handling он для консольного компиллера и использует его на 90% +)
@CyRax PTR - я его использую потому что он делает удобнее среду плюс патчит экзешник после создания чтоб он открывал консоль ... вот и всё...
Если используешь AllocConsole то не можешь работать в унаследованной консоли! Всегда создается новая, это не удобно если запускаешь твою прогу из консольного приложения типа NC или FAR
А если попробовать через CreateRemoteThread?
По идее тогда он будет искать StdHandle в родительском процессе потока.
В исходниках ничего такого нет? Или он просто меняет SUBSYSTEM с GUI на CONSOLE в экзешнике?