Crt32

Crt32

Crt32 : Multi-millones de consejos para hacer su vida mas facil.

Delphi de 32 version de Pascal de la CRT de la unidad.
Colaborador: FRANK ZIMMER

la Implementacion de Turbo Pascal CRT-Unidad para Win32
Console Subsistema
& & & & & __ archivo CRT32.inf & & & & & & & & & & __
filename=Crt32
reemplazos=
fileversion=1.0.0127
filedescription=Aplicacion de Turbo Pascal CRT-Unidad para la Consola de Win32 Subsistema
target=Delphi 2.0
autor nombre=Frank Zimmer
autor [email protected]
autor URL=
el estado de los archivos=freeware
fuente completo=
categoria=Miscelanea
& & & & & __ Archivo CRT32.int & & & & & & & & & & __
{$APPTYPE CONSOLE}
unidad de crt32
{# freeware}
{# version 1.0.0127}
{# Fecha 18.01.1997}
{# el Autor Frank Zimmer}
{# descripcion
& nbsp Copyright © 1997, Frank Zimmer, [email protected]
& nbsp Version: 1.0.0119
& nbsp Fecha: 18.01.1997
& nbsp Implementacion de Turbo Pascal CRT-Unidad para la Consola de Win32 Subsistema
& nbsp testet con Windows NT 4.0
& nbsp En el Inicio, se obtiene el Enfoque a la Consola!!!!
& nbsp aplicacion ahora ( *no estan en el original Crt-Unidad):
& nbsp Procedimiento y Funcion:
& nbsp & nbsp & nbsp ClrScr
& nbsp & nbsp & nbsp ClrEol
& nbsp & nbsp & nbsp WhereX
& nbsp & nbsp & nbsp WhereY
& nbsp & nbsp & nbsp GotoXY
& nbsp & nbsp & nbsp InsLine
& nbsp & nbsp & nbsp DelLine
& nbsp & nbsp & nbsp HighVideo
& nbsp & nbsp & nbsp LowVideo
& nbsp & nbsp & nbsp NormVideo
& nbsp & nbsp & nbsp TextBackground
& nbsp & nbsp & nbsp TextColor
& nbsp & nbsp & nbsp Retraso // uso no processtime
& nbsp & nbsp & nbsp KeyPressed
& nbsp & nbsp & nbsp ReadKey // uso no processtime
& nbsp & nbsp & nbsp Sonido // con Windows NT tu puede utilizar las Variables SoundFrequenz, SoundDuration
& nbsp & nbsp & nbsp NoSound
& nbsp & nbsp & nbsp *TextAttribut // Conjunto de TextBackground y TextColor al mismo tiempo, util para Lastmode
& nbsp & nbsp & nbsp *FlushInputBuffer // Descarga el Teclado y todos los demas Eventos
& nbsp & nbsp & nbsp *ConsoleEnd // salida de 'Presione cualquier tecla' y espere a que la introduccion de la clave cuando no tubo
& nbsp & nbsp & nbsp *Canalizacion // True cuando la salida se redirige a una tuberia o un archivo
& nbsp Variables:
& nbsp & nbsp & nbsp WindMin // el min. WindowRect
& nbsp & nbsp & nbsp WindMax // max. WindowRect
& nbsp & nbsp & nbsp *ViewMax // max. ConsoleBuffer inicio en (1,1)
& nbsp & nbsp & nbsp TextAttr // Atributos Reales solo cambiando con este Rutinas
& nbsp & nbsp & nbsp LastMode // el Ultimo de los Atributos de solo cambiando con este Rutinas
& nbsp & nbsp & nbsp *SoundFrequenz // con Windows NT tu podria utilizar esta Variables
& nbsp & nbsp & nbsp *SoundDuration / / ¿cuanto tiempo campanas del altavoz -1 hasta???, valor predeterminado = -1
& nbsp & nbsp & nbsp *HConsoleInput // la Entrada de mango
& nbsp & nbsp & nbsp *HConsoleOutput // la Salida de mango
& nbsp & nbsp & nbsp *HConsoleError // el Error de mango

& nbsp Esta Fuente es gratis, se han divertido :-)
& nbsp Historia
& nbsp & nbsp & nbsp 23.01.97 Sonido, retraso, La pagina de codigos insertados y setfocus para la consola
& nbsp & nbsp & nbsp 24.01.97 Redirigido estado
}
interfaz
utiliza windows,mensajes
{$ifdef win32}
const
& nbsp & nbsp Negro = 0
& nbsp & nbsp Azul = 1
& nbsp & nbsp Verde = 2
& nbsp & nbsp Cian = 3
& nbsp & nbsp Rojo = 4
& nbsp & nbsp Magenta = 5
& nbsp & nbsp Marron = 6
& nbsp & nbsp gris claro = 7
& nbsp & nbsp DarkGray = 8
& nbsp & nbsp Azul = 9
& nbsp & nbsp LightGreen = 10
& nbsp & nbsp LightCyan = 11
& nbsp & nbsp LightRed = 12
& nbsp & nbsp LightMagenta = 13
& nbsp & nbsp Amarillo = 14
& nbsp & nbsp Blanco = 15
& nbsp & nbsp Funcion WhereX: integer
& nbsp & nbsp Funcion WhereY: integer
& nbsp & nbsp procedimiento ClrEol
& nbsp & nbsp procedimiento ClrScr
& nbsp & nbsp procedimiento InsLine
& nbsp & nbsp Procedimiento DelLine
& nbsp & nbsp Procedimiento GotoXY(const x,y:integer)
& nbsp & nbsp procedimiento HighVideo
& nbsp & nbsp procedimiento LowVideo
& nbsp & nbsp procedimiento NormVideo
& nbsp & nbsp procedimiento TextBackground(const Color:word)
& nbsp & nbsp procedimiento TextColor(const Color:word)
& nbsp & nbsp procedimiento TextAttribut(const Color,Fondo:word)
& nbsp & nbsp procedimiento de Retardo(const ms:integer)
& nbsp & nbsp funcion KeyPressed:boolean
& nbsp & nbsp funcion ReadKey:Char
& nbsp & nbsp Procedimiento de Sonido
& nbsp & nbsp Procedimiento NoSound
& nbsp & nbsp procedimiento ConsoleEnd
& nbsp & nbsp procedimiento FlushInputBuffer
& nbsp & nbsp Funcion de la Tuberia:boolean
var
& nbsp & nbsp HConsoleInput:thandle
& nbsp & nbsp HConsoleOutput:thandle
& nbsp & nbsp HConsoleError:Thandle
& nbsp & nbsp WindMin:tcoord
& nbsp & nbsp WindMax:tcoord
& nbsp & nbsp ViewMax:tcoord
& nbsp & nbsp TextAttr : Word
& nbsp & nbsp LastMode : Word
& nbsp & nbsp SoundFrequenz :Integer
& nbsp & nbsp SoundDuration : Integer
{$endif win32}
aplicacion
& & & & & __ archivo CRT32.pas & & & & & & & & & & __
{$APPTYPE CONSOLE}
unidad de crt32
{# freeware}
{# version 1.0.0127}
{# Fecha 18.01.1997}
{# el Autor Frank Zimmer}
{# descripcion
& nbsp Copyright © 1997, Frank Zimmer, [email protected]
& nbsp Version: 1.0.0119
& nbsp Fecha: 18.01.1997
& nbsp Implementacion de Turbo Pascal CRT-Unidad para la Consola de Win32 Subsistema
& nbsp testet con Windows NT 4.0
& nbsp En el Inicio, se obtiene el Enfoque a la Consola!!!!
& nbsp ( con * no estan en el original Crt-Unidad):
& nbsp Procedimiento y Funcion:
& nbsp & nbsp & nbsp ClrScr
& nbsp & nbsp & nbsp ClrEol
& nbsp & nbsp & nbsp WhereX
& nbsp & nbsp & nbsp WhereY
& nbsp & nbsp & nbsp GotoXY
& nbsp & nbsp & nbsp InsLine
& nbsp & nbsp & nbsp DelLine
& nbsp & nbsp & nbsp HighVideo
& nbsp & nbsp & nbsp LowVideo
& nbsp & nbsp & nbsp NormVideo
& nbsp & nbsp & nbsp TextBackground
& nbsp & nbsp & nbsp TextColor
& nbsp & nbsp & nbsp Retraso // uso no processtime
& nbsp & nbsp & nbsp KeyPressed
& nbsp & nbsp & nbsp ReadKey // uso no processtime
& nbsp & nbsp & nbsp Sonido // con Windows NT tu puede utilizar las Variables SoundFrequenz, SoundDuration
& nbsp & nbsp & nbsp NoSound
& nbsp & nbsp & nbsp *TextAttribut // Conjunto de TextBackground y TextColor al mismo tiempo, util para Lastmode
& nbsp & nbsp & nbsp *FlushInputBuffer // Descarga el Teclado y todos los demas Eventos
& nbsp & nbsp & nbsp *ConsoleEnd // salida de 'Presione cualquier tecla' y espere a que la introduccion de la clave cuando no tubo
& nbsp & nbsp & nbsp *Canalizacion // True cuando la salida se redirige a una tuberia o un archivo
& nbsp Variables:
& nbsp & nbsp & nbsp WindMin // el min. WindowRect
& nbsp & nbsp & nbsp WindMax // max. WindowRect
& nbsp & nbsp & nbsp *ViewMax // max. ConsoleBuffer inicio en (1,1)
& nbsp & nbsp & nbsp TextAttr // Atributos Reales solo cambiando con este Rutinas
& nbsp & nbsp & nbsp LastMode // el Ultimo de los Atributos de solo cambiando con este Rutinas
& nbsp & nbsp & nbsp *SoundFrequenz // con Windows NT su podrian utilizar estas Variables
& nbsp & nbsp & nbsp *SoundDuration / / ¿cuanto tiempo campanas del altavoz -1 hasta???, valor predeterminado = -1
& nbsp & nbsp & nbsp *HConsoleInput // la Entrada de mango
& nbsp & nbsp & nbsp *HConsoleOutput // la Salida de mango
& nbsp & nbsp & nbsp *HConsoleError // el Error de mango

& nbsp Esta Fuente es gratis, se han divertido :-)
& nbsp Historia
& nbsp & nbsp & nbsp 18.01.97 la primera aplicacion
& nbsp & nbsp & nbsp 23.01.97 de Sonido, el retraso de la pagina de codigos insertados y setfocus para la consola
& nbsp & nbsp & nbsp 24.01.97 Redirigido estado
}
interfaz
utiliza windows,mensajes
{$ifdef win32}
const
& nbsp & nbsp Negro = 0
& nbsp & nbsp Azul = 1
& nbsp & nbsp Verde = 2
& nbsp & nbsp Cian = 3
& nbsp & nbsp Rojo = 4
& nbsp & nbsp Magenta = 5
& nbsp & nbsp Marron = 6
& nbsp & nbsp gris claro = 7
& nbsp & nbsp DarkGray = 8
& nbsp & nbsp Azul = 9
& nbsp & nbsp LightGreen = 10
& nbsp & nbsp LightCyan = 11
& nbsp & nbsp LightRed = 12
& nbsp & nbsp LightMagenta = 13
& nbsp & nbsp Amarillo = 14
& nbsp & nbsp Blanco = 15
& nbsp & nbsp Funcion WhereX: integer
& nbsp & nbsp Funcion WhereY: integer
& nbsp & nbsp procedimiento ClrEol
& nbsp & nbsp procedimiento ClrScr
& nbsp & nbsp procedimiento InsLine
& nbsp & nbsp Procedimiento DelLine
& nbsp & nbsp Procedimiento GotoXY(const x,y:integer)
& nbsp & nbsp procedimiento HighVideo
& nbsp & nbsp procedimiento LowVideo
& nbsp & nbsp procedimiento NormVideo
& nbsp & nbsp procedimiento TextBackground(const Color:word)
& nbsp & nbsp procedimiento TextColor(const Color:word)
& nbsp & nbsp procedimiento TextAttribut(const Color,Fondo:word)

& nbsp & nbsp procedimiento de Retardo(const ms:integer)
& nbsp & nbsp funcion KeyPressed:boolean
& nbsp & nbsp funcion ReadKey:Char
& nbsp & nbsp Procedimiento de Sonido
& nbsp & nbsp Procedimiento NoSound
& nbsp & nbsp procedimiento ConsoleEnd
& nbsp & nbsp procedimiento FlushInputBuffer
& nbsp & nbsp Funcion de la Tuberia:boolean
var
& nbsp & nbsp HConsoleInput:tHandle
& nbsp & nbsp HConsoleOutput:thandle
& nbsp & nbsp HConsoleError:Thandle
& nbsp & nbsp WindMin:tcoord
& nbsp & nbsp WindMax:tcoord
& nbsp & nbsp ViewMax:tcoord
& nbsp & nbsp TextAttr : Word
& nbsp & nbsp LastMode : Word
& nbsp & nbsp SoundFrequenz :Integer
& nbsp & nbsp SoundDuration : Integer
{$endif win32}
aplicacion
{$ifdef win32}
utiliza sysutils
var
& nbsp & nbsp StartAttr:word
& nbsp & nbsp OldCP:integer
& nbsp & nbsp CrtPipe : Boolean
& nbsp & nbsp aleman : boolean
procedimiento ClrEol
var tC :tCoord
& nbsp & nbsp Len,Nw: integer
& nbsp & nbsp Cbi : TConsoleScreenBufferInfo
begin
& nbsp & nbsp GetConsoleScreenBufferInfo(HConsoleOutput,cbi)
& nbsp & nbsp len := cbi.dwsize.x-cbi.dwcursorposition.x
& nbsp & nbsp tc.x := cbi.dwcursorposition.x
& nbsp & nbsp tc.y := cbi.dwcursorposition.y
& nbsp & nbsp FillConsoleOutputAttribute(HConsoleOutput,textattr,len,tc,nw)
& nbsp & nbsp FillConsoleOutputCharacter(HConsoleOutput,#32,len,tc,nw)
fin
procedimiento ClrScr
var tc :tcoord
& nbsp & nbsp nw: integer
& nbsp & nbsp cbi : TConsoleScreenBufferInfo
begin
& nbsp & nbsp getConsoleScreenBufferInfo(HConsoleOutput,cbi)
& nbsp & nbsp tc.x := 0
& nbsp & nbsp tc.y := 0
& nbsp & nbsp FillConsoleOutputAttribute(HConsoleOutput,textattr,cbi.dwsize.x*cbi.dwsize.y,tc,nw)
& nbsp & nbsp FillConsoleOutputCharacter(HConsoleOutput,#32,cbi.dwsize.x*cbi.dwsize.y,tc,nw)
& nbsp & nbsp setConsoleCursorPosition(hconsoleoutput,tc)
fin
Funcion WhereX: integer
var cbi : TConsoleScreenBufferInfo
begin
& nbsp & nbsp getConsoleScreenBufferInfo(HConsoleOutput,cbi)
& nbsp & nbsp resultado := tcoord(cbi.dwCursorPosition).x 1
fin
Funcion WhereY: integer
var cbi : TConsoleScreenBufferInfo
begin
& nbsp & nbsp getConsoleScreenBufferInfo(HConsoleOutput,cbi)
& nbsp & nbsp resultado := tcoord(cbi.dwCursorPosition).y 1
fin
Procedimiento GotoXY(const x,y:integer)
var coord :tcoord
begin
& nbsp & nbsp coord.x := x-1
& nbsp & nbsp coord.y := y-1
& nbsp & nbsp setConsoleCursorPosition(hconsoleoutput,coord)
fin
procedimiento InsLine
var
& nbsp cbi : TConsoleScreenBufferInfo
& nbsp ssr:tsmallrect
& nbsp coord :tcoord
& nbsp ci :tcharinfo
& nbsp nw:integer
begin
& nbsp & nbsp getConsoleScreenBufferInfo(HConsoleOutput,cbi)
& nbsp & nbsp coord := cbi.dwCursorPosition
& nbsp & nbsp ssr.a la izquierda := 0
& nbsp & nbsp ssr.top := coord.y
& nbsp & nbsp ssr.derecha := cbi.srwindow.a la derecha
& nbsp & nbsp ssr.parte inferior := cbi.srwindow.inferior
& nbsp & nbsp ci.asciichar := #32
& nbsp & nbsp ci.atributos := cbi.wattributes
& nbsp & nbsp coord.x := 0
& nbsp & nbsp coord.y := coord.y 1
& nbsp & nbsp ScrollConsoleScreenBuffer(HconsoleOutput,ssr,nil,coord,ci)
& nbsp & nbsp coord.y := coord.y-1
& nbsp & nbsp FillConsoleOutputAttribute(HConsoleOutput,textattr,cbi.dwsize.x*cbi.dwsize.y,coord,nw)
fin
procedimiento DelLine
var
& nbsp cbi : TConsoleScreenBufferInfo
& nbsp ssr:tsmallrect
& nbsp coord :tcoord
& nbsp ci :tcharinfo
& nbsp nw:integer
begin
& nbsp & nbsp getConsoleScreenBufferInfo(HConsoleOutput,cbi)
& nbsp & nbsp coord := cbi.dwCursorPosition
& nbsp & nbsp ssr.a la izquierda := 0
& nbsp & nbsp ssr.top := coord.y 1
& nbsp & nbsp ssr.derecha := cbi.srwindow.a la derecha
& nbsp & nbsp ssr.parte inferior := cbi.srwindow.inferior
& nbsp & nbsp ci.asciichar := #32
& nbsp & nbsp ci.atributos := cbi.wattributes
& nbsp & nbsp coord.x := 0
& nbsp & nbsp coord.y := coord.y
& nbsp & nbsp ScrollConsoleScreenBuffer(HconsoleOutput,ssr,nil,coord,ci)
& nbsp & nbsp FillConsoleOutputAttribute(HConsoleOutput,textattr,cbi.dwsize.x*cbi.dwsize.y,coord,nw)
fin
procedimiento TextBackground(const Color:word)
begin
& nbsp & nbsp LastMode := TextAttr
& nbsp & nbsp textattr := (color shl 4) o (textattr y $f)
& nbsp & nbsp SetConsoleTextAttribute(hconsoleoutput,textattr)
fin
procedimiento TextColor(const Color:word)
begin
& nbsp & nbsp LastMode := TextAttr
& nbsp & nbsp textattr := (color y $f) o (textattr y $f0)
& nbsp & nbsp SetConsoleTextAttribute(hconsoleoutput,textattr)
fin
procedimiento TextAttribut(const Color,Fondo:word)
begin
& nbsp & nbsp LastMode := TextAttr
& nbsp & nbsp textattr := (color y $f) o (Fondo shl 4)
& nbsp & nbsp SetConsoleTextAttribute(hconsoleoutput,textattr)
fin
procedimiento HighVideo
begin
& nbsp & nbsp LastMode := TextAttr
& nbsp & nbsp textattr := textattr o $8
& nbsp & nbsp SetConsoleTextAttribute(hconsoleoutput,textattr)
fin
procedimiento LowVideo
begin
& nbsp & nbsp LastMode := TextAttr
& nbsp & nbsp textattr := textattr y $f7
& nbsp & nbsp SetConsoleTextAttribute(hconsoleoutput,textattr)
fin
procedimiento NormVideo
begin
& nbsp & nbsp LastMode := TextAttr
& nbsp & nbsp textattr := startAttr
& nbsp & nbsp SetConsoleTextAttribute(hconsoleoutput,textattr)
fin
procedimiento FlushInputBuffer
begin
& nbsp & nbsp FlushConsoleInputBuffer(hconsoleinput)
fin
funcion keypressed:boolean
var NumberOfEvents:integer
begin
& nbsp & nbsp GetNumberOfConsoleInputEvents(hconsoleinput,NumberOfEvents)
& nbsp & nbsp resultado := NumberOfEvents > 0
fin
funcion ReadKey: Char
var
& nbsp & nbsp NumRead: Integer
& nbsp & nbsp InputRec: TInputRecord
begin
& nbsp & nbsp mientras no ReadConsoleInput(HConsoleInput,
& nbsp & nbsp & nbsp & nbsp & nbsp & n sp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp InputRec,
& nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp 1,
& nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp NumRead) o
& nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp (InputRec.EventType <> KEY_EVENT)
& nbsp & nbsp Resultado := InputRec.KeyEvent.AsciiChar
fin
procedimiento de retardo(const ms:integer)
begin
& nbsp & nbsp sueño(ms)
fin
Procedimiento de Sonido
begin
& nbsp & nbsp windows.beep(SoundFrequenz,soundduration)
fin
Procedimiento NoSound
begin
& nbsp & nbsp windows.beep(soundfrequenz,0)
fin
procedimiento ConsoleEnd
begin
& nbsp & nbsp si isconsole y no crtpipe, a continuacion,
& nbsp & nbsp empezar
& nbsp & nbsp & nbsp & nbsp si wherex > 1 entonces writeln
& nbsp & nbsp & nbsp & nbsp textcolor(verde)
& nbsp & nbsp & nbsp & nbsp setfocus(GetCurrentProcess)
& nbsp & nbsp & nbsp & nbsp si aleman entonces escribir('Bitte eine Gusto empujar!')
& nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp & nbsp else write('Presione cualquier tecla!')
& nbsp & nbsp & nbsp & nbsp normvideo
& nbsp & nbsp & nbsp & nbsp FlushInputBuffer
& nbsp & nbsp & nbsp & nbsp ReadKey
& nbsp & nbsp & nbsp & nbsp FlushInputBuffer
& nbsp & nbsp final
fin
la funcion de la Tuberia:boolean
begin
& nbsp & nbsp resultado := crtpipe
fin
procedimiento init
var
& nbsp & nbsp cbi : TConsoleScreenBufferInfo
& nbsp & nbsp tc : tcoord
begin
& nbsp SetActiveWindow(0)
& nbsp HConsoleInput := GetStdHandle(STD_InPUT_HANDLE)
& nbsp HConsoleOutput := GetStdHandle(STD_OUTPUT_HANDLE)
& nbsp HConsoleError := GetStdHandle(STD_Error_HANDLE)
& nbsp si getConsoleScreenBufferInfo(HConsoleOutput,cbi), a continuacion,
& nbsp empezar
& nbsp & nbsp & nbsp TextAttr := cbi.wAttributes
& nbsp & nbsp & nbsp StartAttr := cbi.wAttributes
& nbsp & nbsp & nbsp lastmode := cbi.wAttributes
& nbsp & nbsp & nbsp tc.x := cbi.srwindow.a la izquierda 1
& nbsp & nbsp & nbsp tc.y := cbi.srwindow.top 1
& nbsp & nbsp & nbsp windmin := tc
& nbsp & nbsp & nbsp ViewMax := cbi.dwsize
& nbsp & nbsp & nbsp tc.x := cbi.srwindow.derecho 1
& nbsp & nbsp & nbsp tc.y := cbi.srwindow.inferior 1
& nbsp & nbsp & nbsp windmax := tc
& nbsp & nbsp & nbsp crtpipe := false
& nbsp final mas crtpipe := true
& nbsp SoundFrequenz := 1000
& nbsp SoundDuration := -1
& nbsp oldCp := GetConsoleoutputCP
& nbsp SetConsoleoutputCP(1252)
& nbsp aleman := $07 = (LoWord(GetUserDefaultLangID) y $3ff)
fin
inicializacion
& nbsp & nbsp init
la finalizacion
& nbsp SetConsoleoutputCP(oldcp)
{$endif win32}
final.