Crt32


Delphi 32 version de l'Pascal CRT unité.
Auteur: FRANK ZIMMER

la mise en Œuvre de Turbo Pascal CRT-Unité pour Win32
Console de sous-système
& & & & & __ Faire fichier CRT32.inf & & & & & & & & & & __
filename=Crt32
remplacement=
fileversion=1.0.0127
filedescription=la mise en Œuvre de Turbo Pascal CRT-Unité de Console Win32 sous-système
target=Delphi 2.0
le nom de l'auteur=Frank Zimmer
l'auteur [email protected]
autor URL=
l'état du fichier=freeware
source=
catégorie=Divers
& & & & & __ Faire fichier CRT32.int & & & & & & & & & & __
{$APPTYPE CONSOLE}
unité de crt32
{# freeware}
{# version 1.0.0127}
{# Date 18.01.1997}
{# Auteur Frank Zimmer}
{# description
& nbsp Copyright © 1997, Frank Zimmer, [email protected]
& nbsp Version: 1.0.0119
& nbsp Date: 18.01.1997
& nbsp de mise en Œuvre de Turbo Pascal CRT-Unité de Console Win32 sous-système
& nbsp testet avec Windows NT 4.0
& nbsp Au Démarrage, vous obtenez l'Accent sur la Console!!!!
& nbsp mise en œuvre maintenant ( *ne sont pas dans l'original Crt-Unité):
& nbsp Procédure et Fonction:
& 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 Retard // utilisez pas de processtime
& nbsp & nbsp & nbsp KeyPressed
& nbsp & nbsp & nbsp ReadKey // utilisez pas de processtime
& nbsp & nbsp & nbsp Sonore // avec Windows NT, vous pouvez utiliser les Variables SoundFrequenz, SoundDuration
& nbsp & nbsp & nbsp NoSound
& nbsp & nbsp & nbsp *TextAttribut // Set TextBackground et TextColor dans le même temps, utile pour Lastmode
& nbsp & nbsp & nbsp *FlushInputBuffer // vider le Clavier et tous les autres Événements
& nbsp & nbsp & nbsp *ConsoleEnd // sortie de 'Appuyez sur une touche' et attendre pour la saisie de la clé lorsqu'il n'est pas pipe
& nbsp & nbsp & nbsp Pipe * / / True si la sortie est redirigée vers un tuyau ou un fichier
& nbsp Variables:
& nbsp & nbsp & nbsp WindMin // min. WindowRect
& nbsp & nbsp & nbsp WindMax // max. WindowRect
& nbsp & nbsp & nbsp *ViewMax // max. ConsoleBuffer commencer à (1,1)
& nbsp & nbsp & nbsp TextAttr // Attributs Réels qu'en changeant avec cette Routines
& nbsp & nbsp & nbsp LastMode // Attributs uniquement en changeant avec cette Routines
& nbsp & nbsp & nbsp *SoundFrequenz // avec Windows NT votre pourrait utiliser ces Variables
& nbsp & nbsp & nbsp *SoundDuration // combien de temps les cloches de l'enceinte -1 jusqu'à la ??, par défaut = -1
& nbsp & nbsp & nbsp *HConsoleInput // Entrée-poignée
& nbsp & nbsp & nbsp *HConsoleOutput // Sortie-poignée
& nbsp & nbsp & nbsp *HConsoleError // l'Erreur-poignée

& nbsp Cette Source est un freeware, avoir du plaisir :-)
& nbsp Histoire
& nbsp & nbsp & nbsp 23.01.97 Son, retard, Page de codes insérés et setfocus pour la console
& nbsp & nbsp & nbsp 24.01.97 Redirigé état
}
interface
utilise windows,les messages
{$ifdef win32}
const
& nbsp & nbsp Noir = 0
& nbsp & nbsp Bleu = 1
& nbsp & nbsp Vert = 2
& nbsp & nbsp Cyan = 3
& nbsp & nbsp Rouge = 4
& nbsp & nbsp Magenta = 5
& nbsp & nbsp Marron = 6
& nbsp & nbsp LightGray = 7
& nbsp & nbsp Gris = 8
& nbsp & nbsp LightBlue = 9
& nbsp & nbsp Vert = 10
& nbsp & nbsp LightCyan = 11
& nbsp & nbsp LightRed = 12
& nbsp & nbsp LightMagenta = 13
& nbsp & nbsp Jaune = 14
& nbsp & nbsp Blanc = 15
& nbsp & nbsp Fonction WhereX: entier
& nbsp & nbsp Fonction WhereY: integer
& nbsp & nbsp procédure ClrEol
& nbsp & nbsp procédure ClrScr
& nbsp & nbsp procédure InsLine
& nbsp & nbsp Procédure DelLine
& nbsp & nbsp Procédure GotoXY(const x,y:integer)
& nbsp & nbsp procédure HighVideo
& nbsp & nbsp procédure LowVideo
& nbsp & nbsp procédure NormVideo
& nbsp & nbsp procédure TextBackground(const Couleur:word)
& nbsp & nbsp procédure TextColor(const Couleur:word)
& nbsp & nbsp procédure TextAttribut(const Couleur,arrière-plan:mot)
& nbsp & nbsp procédure de Retard(const ms:integer)
& nbsp & nbsp fonction KeyPressed:boolean
& nbsp & nbsp fonction ReadKey:Char
& nbsp & nbsp Procédure de Son
& nbsp & nbsp Procédure NoSound
& nbsp & nbsp procédure ConsoleEnd
& nbsp & nbsp procédure FlushInputBuffer
& nbsp & nbsp Fonction de la Pipe: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 : Mot
& nbsp & nbsp LastMode : Mot
& nbsp & nbsp SoundFrequenz :Integer
& nbsp & nbsp SoundDuration : Entier
{$endif win32}
application
& & & & & __ Faire fichier CRT32.pas & & & & & & & & & & __
{$APPTYPE CONSOLE}
unité de crt32
{# freeware}
{# version 1.0.0127}
{# Date 18.01.1997}
{# Auteur Frank Zimmer}
{# description
& nbsp Copyright © 1997, Frank Zimmer, [email protected]
& nbsp Version: 1.0.0119
& nbsp Date: 18.01.1997
& nbsp de mise en Œuvre de Turbo Pascal CRT-Unité de Console Win32 sous-système
& nbsp testet avec Windows NT 4.0
& nbsp Au Démarrage, vous obtenez l'Accent sur la Console!!!!
& nbsp ( avec un * ne sont pas dans l'original Crt-Unité):
& nbsp Procédure et Fonction:
& 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 Retard // utilisez pas de processtime
& nbsp & nbsp & nbsp KeyPressed
& nbsp & nbsp & nbsp ReadKey // utilisez pas de processtime
& nbsp & nbsp & nbsp Sonore // avec Windows NT, vous pouvez utiliser les Variables SoundFrequenz, SoundDuration
& nbsp & nbsp & nbsp NoSound
& nbsp & nbsp & nbsp *TextAttribut // Set TextBackground et TextColor dans le même temps, utile pour Lastmode
& nbsp & nbsp & nbsp *FlushInputBuffer // vider le Clavier et tous les autres Événements
& nbsp & nbsp & nbsp *ConsoleEnd // sortie de 'Appuyez sur une touche' et attendre pour la saisie de la clé lorsqu'il n'est pas pipe
& nbsp & nbsp & nbsp Pipe * / / True si la sortie est redirigée vers un tuyau ou un fichier
& nbsp Variables:
& nbsp & nbsp & nbsp WindMin // min. WindowRect
& nbsp & nbsp & nbsp WindMax // max. WindowRect
& nbsp & nbsp & nbsp *ViewMax // max. ConsoleBuffer commencer à (1,1)
& nbsp & nbsp & nbsp TextAttr // Attributs Réels qu'en changeant avec cette Routines
& nbsp & nbsp & nbsp LastMode // Attributs uniquement en changeant avec cette Routines
& nbsp & nbsp & nbsp *SoundFrequenz // avec Windows NT votre pourrait utiliser ces Variables
& nbsp & nbsp & nbsp *SoundDuration // combien de temps les cloches de l'enceinte -1 jusqu'à la ??, par défaut = -1
& nbsp & nbsp & nbsp *HConsoleInput // Entrée-poignée
& nbsp & nbsp & nbsp *HConsoleOutput // Sortie-poignée
& nbsp & nbsp & nbsp *HConsoleError // l'Erreur-poignée

& nbsp Cette Source est un freeware, amusez-vous :-)
& nbsp Histoire
& nbsp & nbsp & nbsp 18.01.97 la première mise en œuvre
& nbsp & nbsp & nbsp 23.01.97 Son, le retard, la page de Codes insérés et setfocus pour la console
& nbsp & nbsp & nbsp 24.01.97 Redirigé état
}
interface
utilise windows,les messages
{$ifdef win32}
const
& nbsp & nbsp Noir = 0
& nbsp & nbsp Bleu = 1
& nbsp & nbsp Vert = 2
& nbsp & nbsp Cyan = 3
& nbsp & nbsp Rouge = 4
& nbsp & nbsp Magenta = 5
& nbsp & nbsp Marron = 6
& nbsp & nbsp LightGray = 7
& nbsp & nbsp Gris = 8
& nbsp & nbsp LightBlue = 9
& nbsp & nbsp Vert = 10
& nbsp & nbsp LightCyan = 11
& nbsp & nbsp LightRed = 12
& nbsp & nbsp LightMagenta = 13
& nbsp & nbsp Jaune = 14
& nbsp & nbsp Blanc = 15
& nbsp & nbsp Fonction WhereX: entier
& nbsp & nbsp Fonction WhereY: integer
& nbsp & nbsp procédure ClrEol
& nbsp & nbsp procédure ClrScr
& nbsp & nbsp procédure InsLine
& nbsp & nbsp Procédure DelLine
& nbsp & nbsp Procédure GotoXY(const x,y:integer)
& nbsp & nbsp procédure HighVideo
& nbsp & nbsp procédure LowVideo
& nbsp & nbsp procédure NormVideo
& nbsp & nbsp procédure TextBackground(const Couleur:word)
& nbsp & nbsp procédure TextColor(const Couleur:word)
& nbsp & nbsp procédure TextAttribut(const Couleur,arrière-plan:mot)

& nbsp & nbsp procédure de Retard(const ms:integer)
& nbsp & nbsp fonction KeyPressed:boolean
& nbsp & nbsp fonction ReadKey:Char
& nbsp & nbsp Procédure de Son
& nbsp & nbsp Procédure NoSound
& nbsp & nbsp procédure ConsoleEnd
& nbsp & nbsp procédure FlushInputBuffer
& nbsp & nbsp Fonction de la Pipe: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 : Mot
& nbsp & nbsp LastMode : Mot
& nbsp & nbsp SoundFrequenz :Integer
& nbsp & nbsp SoundDuration : Entier
{$endif win32}
application
{$ifdef win32}
utilise sysutils
var
& nbsp & nbsp StartAttr:mot
& nbsp & nbsp OldCP:integer
& nbsp & nbsp CrtPipe : Boolean
& nbsp & nbsp allemand : boolean
procédure ClrEol
var tC :tCoord
& nbsp & nbsp Len,Nw: integer
& nbsp & nbsp Rcc : TConsoleScreenBufferInfo
begin
& nbsp & nbsp GetConsoleScreenBufferInfo(HConsoleOutput,rcc)
& nbsp & nbsp len := rcc.dwsize.x-rcc.dwcursorposition.x
& nbsp & nbsp tc.x := rcc.dwcursorposition.x
& nbsp & nbsp tc.y := rcc.dwcursorposition.y
& nbsp & nbsp FillConsoleOutputAttribute(HConsoleOutput,textattr,len,tc,nw)
& nbsp & nbsp FillConsoleOutputCharacter(HConsoleOutput,#32,len,tc,nw)
fin
procédure ClrScr
var tc :tcoord
& nbsp & nbsp nw: integer
& nbsp & nbsp rcc : TConsoleScreenBufferInfo
begin
& nbsp & nbsp getConsoleScreenBufferInfo(HConsoleOutput,rcc)
& nbsp & nbsp tc.x := 0
& nbsp & nbsp tc.y := 0
& nbsp & nbsp FillConsoleOutputAttribute(HConsoleOutput,textattr,rcc.dwsize.x*rcc.dwsize.y,tc,nw)
& nbsp & nbsp FillConsoleOutputCharacter(HConsoleOutput,#32,rcc.dwsize.x*rcc.dwsize.y,tc,nw)
& nbsp & nbsp setConsoleCursorPosition(hconsoleoutput,tc)
fin
Fonction de WhereX: integer
var rcc : TConsoleScreenBufferInfo
begin
& nbsp & nbsp getConsoleScreenBufferInfo(HConsoleOutput,rcc)
& nbsp & nbsp résultat := tcoord(rcc.dwCursorPosition).x 1
fin
Fonction de WhereY: integer
var rcc : TConsoleScreenBufferInfo
begin
& nbsp & nbsp getConsoleScreenBufferInfo(HConsoleOutput,rcc)
& nbsp & nbsp résultat := tcoord(rcc.dwCursorPosition).y 1
fin
Procédure GotoXY(const x,y:entier)
var coord :tcoord
begin
& nbsp & nbsp coord.x := x-1
& nbsp & nbsp coord.y := y-1
& nbsp & nbsp setConsoleCursorPosition(hconsoleoutput,coord)
fin
procédure InsLine
var
& nbsp rcc : TConsoleScreenBufferInfo
& nbsp ssr:tsmallrect
& nbsp coord :tcoord
& nbsp ci :tcharinfo
& nbsp nw:integer
begin
& nbsp & nbsp getConsoleScreenBufferInfo(HConsoleOutput,rcc)
& nbsp & nbsp coord := rcc.dwCursorPosition
& nbsp & nbsp ssr.à gauche := 0
& nbsp & nbsp ssr.haut := coord.y
& nbsp & nbsp ssr.droit := rcc.srwindow.droite
& nbsp & nbsp ssr.en bas := rcc.srwindow.bas
& nbsp & nbsp ci.asciichar := #32
& nbsp & nbsp ci.attributs := rcc.wattributes
& nbsp & nbsp coord.x := 0
& nbsp & nbsp coord.y := coord.y 1
& nbsp & nbsp ScrollConsoleScreenBuffer(HconsoleOutput,ssr,néant,coord,ci)
& nbsp & nbsp coord.y := coord.y-1
& nbsp & nbsp FillConsoleOutputAttribute(HConsoleOutput,textattr,rcc.dwsize.x*rcc.dwsize.y,coord,nw)
fin
procédure DelLine
var
& nbsp rcc : TConsoleScreenBufferInfo
& nbsp ssr:tsmallrect
& nbsp coord :tcoord
& nbsp ci :tcharinfo
& nbsp nw:integer
begin
& nbsp & nbsp getConsoleScreenBufferInfo(HConsoleOutput,rcc)
& nbsp & nbsp coord := rcc.dwCursorPosition
& nbsp & nbsp ssr.à gauche := 0
& nbsp & nbsp ssr.haut := coord.y 1
& nbsp & nbsp ssr.droit := rcc.srwindow.droite
& nbsp & nbsp ssr.en bas := rcc.srwindow.bas
& nbsp & nbsp ci.asciichar := #32
& nbsp & nbsp ci.attributs := rcc.wattributes
& nbsp & nbsp coord.x := 0
& nbsp & nbsp coord.y := coord.y
& nbsp & nbsp ScrollConsoleScreenBuffer(HconsoleOutput,ssr,néant,coord,ci)
& nbsp & nbsp FillConsoleOutputAttribute(HConsoleOutput,textattr,rcc.dwsize.x*rcc.dwsize.y,coord,nw)
fin
procédure TextBackground(const Couleur:word)
begin
& nbsp & nbsp LastMode := TextAttr
& nbsp & nbsp textattr := (couleur shl 4) ou (textattr et $f)
& nbsp & nbsp SetConsoleTextAttribute(hconsoleoutput,textattr)
fin
procédure TextColor(const Couleur:word)
begin
& nbsp & nbsp LastMode := TextAttr
& nbsp & nbsp textattr := (couleur et $f) ou (textattr et $f0)
& nbsp & nbsp SetConsoleTextAttribute(hconsoleoutput,textattr)
fin
procédure TextAttribut(const Couleur,arrière-plan:mot)
begin
& nbsp & nbsp LastMode := TextAttr
& nbsp & nbsp textattr := (couleur et $f) ou en arrière-plan (shl 4)
& nbsp & nbsp SetConsoleTextAttribute(hconsoleoutput,textattr)
fin
procédure HighVideo
begin
& nbsp & nbsp LastMode := TextAttr
& nbsp & nbsp textattr := textattr ou $8
& nbsp & nbsp SetConsoleTextAttribute(hconsoleoutput,textattr)
fin
procédure LowVideo
begin
& nbsp & nbsp LastMode := TextAttr
& nbsp & nbsp textattr := textattr et $f7
& nbsp & nbsp SetConsoleTextAttribute(hconsoleoutput,textattr)
fin
procédure NormVideo
begin
& nbsp & nbsp LastMode := TextAttr
& nbsp & nbsp textattr := startAttr
& nbsp & nbsp SetConsoleTextAttribute(hconsoleoutput,textattr)
fin
procédure FlushInputBuffer
begin
& nbsp & nbsp FlushConsoleInputBuffer(hconsoleinput)
fin
fonction de keypressed:boolean
var NumberOfEvents:integer
begin
& nbsp & nbsp GetNumberOfConsoleInputEvents(hconsoleinput,NumberOfEvents)
& nbsp & nbsp résultat := NumberOfEvents > 0
fin
fonction de ReadKey: Char
var
& nbsp & nbsp NumRead: Integer
& nbsp & nbsp InputRec: TInputRecord
begin
& nbsp & nbsp alors que pas ReadConsoleInput(HConsoleInput,
& ! & ! & ! & ! & ! & n sp & ! & ! & ! & ! & ! & ! & ! & ! & ! & ! & ! & ! & ! & ! & ! & ! & ! & ! & ! & ! & ! & ! & nbsp InputRec,
& ! & ! & ! & ! & ! & ! & ! & ! & ! & ! & ! & ! & ! & ! & ! & ! & ! & ! & ! & ! & ! & ! & ! & ! & ! & ! & ! & ! & nbsp 1,
& ! & ! & ! & ! & ! & ! & ! & ! & ! & ! & ! & ! & ! & ! & ! & ! & ! & ! & ! & ! & ! & ! & ! & ! & ! & ! & ! & ! & nbsp NumRead) ou
& ! & ! & ! & ! & ! & ! & ! & ! & ! & ! & nbsp (InputRec.EventType <> KEY_EVENT) ne
& nbsp & nbsp Résultat := InputRec.KeyEvent.AsciiChar
fin
procédure de retard(const ms:entier)
begin
& nbsp & nbsp sleep(ms)
fin
Procédure
begin
& nbsp & nbsp windows.bip(SoundFrequenz,soundduration)
fin
Procédure de NoSound
begin
& nbsp & nbsp windows.bip(soundfrequenz,0)
fin
procédure ConsoleEnd
begin
& nbsp & nbsp si isconsole et pas crtpipe puis
& nbsp & nbsp commencer
& ! & ! & ! & nbsp si wherex > 1 then writeln
& ! & ! & ! & nbsp textcolor(vert)
& ! & ! & ! & nbsp setfocus(fonction getcurrentprocess)
& ! & ! & ! & nbsp si l'allemand alors écrire('Bitte eine Goût drücken!')
& ! & ! & ! & ! & ! & ! & ! & ! & ! & ! & ! & ! & ! & nbsp else write('Appuyez sur une touche!')
& ! & ! & ! & nbsp normvideo
& ! & ! & ! & nbsp FlushInputBuffer
& ! & ! & ! & nbsp ReadKey
& ! & ! & ! & nbsp FlushInputBuffer
& nbsp & nbsp fin
fin
fonction de Tuyau:boolean
begin
& nbsp & nbsp résultat := crtpipe
fin
procédure init
var
& nbsp & nbsp rcc : 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,rcc)
& nbsp commencer
& nbsp & nbsp & nbsp TextAttr := rcc.wAttributes
& nbsp & nbsp & nbsp StartAttr := rcc.wAttributes
& nbsp & nbsp & nbsp lastmode := rcc.wAttributes
& nbsp & nbsp & nbsp tc.x := rcc.srwindow.gauche 1
& nbsp & nbsp & nbsp tc.y := rcc.srwindow.top 1
& nbsp & nbsp & nbsp windmin := tc
& nbsp & nbsp & nbsp ViewMax := rcc.dwsize
& nbsp & nbsp & nbsp tc.x := rcc.srwindow.droit 1
& nbsp & nbsp & nbsp tc.y := rcc.srwindow.bas 1
& nbsp & nbsp & nbsp windmax := tc
& nbsp & nbsp & nbsp crtpipe := false
& nbsp fin d'autre crtpipe := true
& nbsp SoundFrequenz := 1000
& nbsp SoundDuration := -1
& nbsp oldCp := GetConsoleoutputCP
& nbsp SetConsoleoutputCP(1252)
& nbsp allemand := $07 = (LoWord(GetUserDefaultLangID) et $3ff)
fin
initialisation
& nbsp & nbsp init
finalisation
& nbsp SetConsoleoutputCP(oldcp)
{$endif win32}
à la fin.









Crt32


Crt32 : Plusieurs milliers de conseils pour vous faciliter la vie.


Delphi 32 version de l'Pascal CRT unite.
Auteur: FRANK ZIMMER

la mise en Œuvre de Turbo Pascal CRT-Unite pour Win32
Console de sous-systeme
& & & & & __ Faire fichier CRT32.inf & & & & & & & & & & __
filename=Crt32
remplacement=
fileversion=1.0.0127
filedescription=la mise en Œuvre de Turbo Pascal CRT-Unite de Console Win32 sous-systeme
target=Delphi 2.0
le nom de l'auteur=Frank Zimmer
l'auteur [email protected]
autor URL=
l'etat du fichier=freeware
source=
categorie=Divers
& & & & & __ Faire fichier CRT32.int & & & & & & & & & & __
{$APPTYPE CONSOLE}
unite de crt32
{# freeware}
{# version 1.0.0127}
{# Date 18.01.1997}
{# Auteur Frank Zimmer}
{# description
& nbsp Copyright © 1997, Frank Zimmer, [email protected]
& nbsp Version: 1.0.0119
& nbsp Date: 18.01.1997
& nbsp de mise en Œuvre de Turbo Pascal CRT-Unite de Console Win32 sous-systeme
& nbsp testet avec Windows NT 4.0
& nbsp Au Demarrage, vous obtenez l'Accent sur la Console!!!!
& nbsp mise en œuvre maintenant ( *ne sont pas dans l'original Crt-Unite):
& nbsp Procedure et Fonction:
& 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 Retard // utilisez pas de processtime
& nbsp & nbsp & nbsp KeyPressed
& nbsp & nbsp & nbsp ReadKey // utilisez pas de processtime
& nbsp & nbsp & nbsp Sonore // avec Windows NT, vous pouvez utiliser les Variables SoundFrequenz, SoundDuration
& nbsp & nbsp & nbsp NoSound
& nbsp & nbsp & nbsp *TextAttribut // Set TextBackground et TextColor dans le meme temps, utile pour Lastmode
& nbsp & nbsp & nbsp *FlushInputBuffer // vider le Clavier et tous les autres Evenements
& nbsp & nbsp & nbsp *ConsoleEnd // sortie de 'Appuyez sur une touche' et attendre pour la saisie de la cle lorsqu'il n'est pas pipe
& nbsp & nbsp & nbsp Pipe * / / True si la sortie est redirigee vers un tuyau ou un fichier
& nbsp Variables:
& nbsp & nbsp & nbsp WindMin // min. WindowRect
& nbsp & nbsp & nbsp WindMax // max. WindowRect
& nbsp & nbsp & nbsp *ViewMax // max. ConsoleBuffer commencer a (1,1)
& nbsp & nbsp & nbsp TextAttr // Attributs Reels qu'en changeant avec cette Routines
& nbsp & nbsp & nbsp LastMode // Attributs uniquement en changeant avec cette Routines
& nbsp & nbsp & nbsp *SoundFrequenz // avec Windows NT votre pourrait utiliser ces Variables
& nbsp & nbsp & nbsp *SoundDuration // combien de temps les cloches de l'enceinte -1 jusqu'a la ??, par defaut = -1
& nbsp & nbsp & nbsp *HConsoleInput // Entree-poignee
& nbsp & nbsp & nbsp *HConsoleOutput // Sortie-poignee
& nbsp & nbsp & nbsp *HConsoleError // l'Erreur-poignee

& nbsp Cette Source est un freeware, avoir du plaisir :-)
& nbsp Histoire
& nbsp & nbsp & nbsp 23.01.97 Son, retard, Page de codes inseres et setfocus pour la console
& nbsp & nbsp & nbsp 24.01.97 Redirige etat
}
interface
utilise windows,les messages
{$ifdef win32}
const
& nbsp & nbsp Noir = 0
& nbsp & nbsp Bleu = 1
& nbsp & nbsp Vert = 2
& nbsp & nbsp Cyan = 3
& nbsp & nbsp Rouge = 4
& nbsp & nbsp Magenta = 5
& nbsp & nbsp Marron = 6
& nbsp & nbsp LightGray = 7
& nbsp & nbsp Gris = 8
& nbsp & nbsp LightBlue = 9
& nbsp & nbsp Vert = 10
& nbsp & nbsp LightCyan = 11
& nbsp & nbsp LightRed = 12
& nbsp & nbsp LightMagenta = 13
& nbsp & nbsp Jaune = 14
& nbsp & nbsp Blanc = 15
& nbsp & nbsp Fonction WhereX: entier
& nbsp & nbsp Fonction WhereY: integer
& nbsp & nbsp procedure ClrEol
& nbsp & nbsp procedure ClrScr
& nbsp & nbsp procedure InsLine
& nbsp & nbsp Procedure DelLine
& nbsp & nbsp Procedure GotoXY(const x,y:integer)
& nbsp & nbsp procedure HighVideo
& nbsp & nbsp procedure LowVideo
& nbsp & nbsp procedure NormVideo
& nbsp & nbsp procedure TextBackground(const Couleur:word)
& nbsp & nbsp procedure TextColor(const Couleur:word)
& nbsp & nbsp procedure TextAttribut(const Couleur,arriere-plan:mot)
& nbsp & nbsp procedure de Retard(const ms:integer)
& nbsp & nbsp fonction KeyPressed:boolean
& nbsp & nbsp fonction ReadKey:Char
& nbsp & nbsp Procedure de Son
& nbsp & nbsp Procedure NoSound
& nbsp & nbsp procedure ConsoleEnd
& nbsp & nbsp procedure FlushInputBuffer
& nbsp & nbsp Fonction de la Pipe: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 : Mot
& nbsp & nbsp LastMode : Mot
& nbsp & nbsp SoundFrequenz :Integer
& nbsp & nbsp SoundDuration : Entier
{$endif win32}
application
& & & & & __ Faire fichier CRT32.pas & & & & & & & & & & __
{$APPTYPE CONSOLE}
unite de crt32
{# freeware}
{# version 1.0.0127}
{# Date 18.01.1997}
{# Auteur Frank Zimmer}
{# description
& nbsp Copyright © 1997, Frank Zimmer, [email protected]
& nbsp Version: 1.0.0119
& nbsp Date: 18.01.1997
& nbsp de mise en Œuvre de Turbo Pascal CRT-Unite de Console Win32 sous-systeme
& nbsp testet avec Windows NT 4.0
& nbsp Au Demarrage, vous obtenez l'Accent sur la Console!!!!
& nbsp ( avec un * ne sont pas dans l'original Crt-Unite):
& nbsp Procedure et Fonction:
& 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 Retard // utilisez pas de processtime
& nbsp & nbsp & nbsp KeyPressed
& nbsp & nbsp & nbsp ReadKey // utilisez pas de processtime
& nbsp & nbsp & nbsp Sonore // avec Windows NT, vous pouvez utiliser les Variables SoundFrequenz, SoundDuration
& nbsp & nbsp & nbsp NoSound
& nbsp & nbsp & nbsp *TextAttribut // Set TextBackground et TextColor dans le meme temps, utile pour Lastmode
& nbsp & nbsp & nbsp *FlushInputBuffer // vider le Clavier et tous les autres Evenements
& nbsp & nbsp & nbsp *ConsoleEnd // sortie de 'Appuyez sur une touche' et attendre pour la saisie de la cle lorsqu'il n'est pas pipe
& nbsp & nbsp & nbsp Pipe * / / True si la sortie est redirigee vers un tuyau ou un fichier
& nbsp Variables:
& nbsp & nbsp & nbsp WindMin // min. WindowRect
& nbsp & nbsp & nbsp WindMax // max. WindowRect
& nbsp & nbsp & nbsp *ViewMax // max. ConsoleBuffer commencer a (1,1)
& nbsp & nbsp & nbsp TextAttr // Attributs Reels qu'en changeant avec cette Routines
& nbsp & nbsp & nbsp LastMode // Attributs uniquement en changeant avec cette Routines
& nbsp & nbsp & nbsp *SoundFrequenz // avec Windows NT votre pourrait utiliser ces Variables
& nbsp & nbsp & nbsp *SoundDuration // combien de temps les cloches de l'enceinte -1 jusqu'a la ??, par defaut = -1
& nbsp & nbsp & nbsp *HConsoleInput // Entree-poignee
& nbsp & nbsp & nbsp *HConsoleOutput // Sortie-poignee
& nbsp & nbsp & nbsp *HConsoleError // l'Erreur-poignee

& nbsp Cette Source est un freeware, amusez-vous :-)
& nbsp Histoire
& nbsp & nbsp & nbsp 18.01.97 la premiere mise en œuvre
& nbsp & nbsp & nbsp 23.01.97 Son, le retard, la page de Codes inseres et setfocus pour la console
& nbsp & nbsp & nbsp 24.01.97 Redirige etat
}
interface
utilise windows,les messages
{$ifdef win32}
const
& nbsp & nbsp Noir = 0
& nbsp & nbsp Bleu = 1
& nbsp & nbsp Vert = 2
& nbsp & nbsp Cyan = 3
& nbsp & nbsp Rouge = 4
& nbsp & nbsp Magenta = 5
& nbsp & nbsp Marron = 6
& nbsp & nbsp LightGray = 7
& nbsp & nbsp Gris = 8
& nbsp & nbsp LightBlue = 9
& nbsp & nbsp Vert = 10
& nbsp & nbsp LightCyan = 11
& nbsp & nbsp LightRed = 12
& nbsp & nbsp LightMagenta = 13
& nbsp & nbsp Jaune = 14
& nbsp & nbsp Blanc = 15
& nbsp & nbsp Fonction WhereX: entier
& nbsp & nbsp Fonction WhereY: integer
& nbsp & nbsp procedure ClrEol
& nbsp & nbsp procedure ClrScr
& nbsp & nbsp procedure InsLine
& nbsp & nbsp Procedure DelLine
& nbsp & nbsp Procedure GotoXY(const x,y:integer)
& nbsp & nbsp procedure HighVideo
& nbsp & nbsp procedure LowVideo
& nbsp & nbsp procedure NormVideo
& nbsp & nbsp procedure TextBackground(const Couleur:word)
& nbsp & nbsp procedure TextColor(const Couleur:word)
& nbsp & nbsp procedure TextAttribut(const Couleur,arriere-plan:mot)

& nbsp & nbsp procedure de Retard(const ms:integer)
& nbsp & nbsp fonction KeyPressed:boolean
& nbsp & nbsp fonction ReadKey:Char
& nbsp & nbsp Procedure de Son
& nbsp & nbsp Procedure NoSound
& nbsp & nbsp procedure ConsoleEnd
& nbsp & nbsp procedure FlushInputBuffer
& nbsp & nbsp Fonction de la Pipe: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 : Mot
& nbsp & nbsp LastMode : Mot
& nbsp & nbsp SoundFrequenz :Integer
& nbsp & nbsp SoundDuration : Entier
{$endif win32}
application
{$ifdef win32}
utilise sysutils
var
& nbsp & nbsp StartAttr:mot
& nbsp & nbsp OldCP:integer
& nbsp & nbsp CrtPipe : Boolean
& nbsp & nbsp allemand : boolean
procedure ClrEol
var tC :tCoord
& nbsp & nbsp Len,Nw: integer
& nbsp & nbsp Rcc : TConsoleScreenBufferInfo
begin
& nbsp & nbsp GetConsoleScreenBufferInfo(HConsoleOutput,rcc)
& nbsp & nbsp len := rcc.dwsize.x-rcc.dwcursorposition.x
& nbsp & nbsp tc.x := rcc.dwcursorposition.x
& nbsp & nbsp tc.y := rcc.dwcursorposition.y
& nbsp & nbsp FillConsoleOutputAttribute(HConsoleOutput,textattr,len,tc,nw)
& nbsp & nbsp FillConsoleOutputCharacter(HConsoleOutput,#32,len,tc,nw)
fin
procedure ClrScr
var tc :tcoord
& nbsp & nbsp nw: integer
& nbsp & nbsp rcc : TConsoleScreenBufferInfo
begin
& nbsp & nbsp getConsoleScreenBufferInfo(HConsoleOutput,rcc)
& nbsp & nbsp tc.x := 0
& nbsp & nbsp tc.y := 0
& nbsp & nbsp FillConsoleOutputAttribute(HConsoleOutput,textattr,rcc.dwsize.x*rcc.dwsize.y,tc,nw)
& nbsp & nbsp FillConsoleOutputCharacter(HConsoleOutput,#32,rcc.dwsize.x*rcc.dwsize.y,tc,nw)
& nbsp & nbsp setConsoleCursorPosition(hconsoleoutput,tc)
fin
Fonction de WhereX: integer
var rcc : TConsoleScreenBufferInfo
begin
& nbsp & nbsp getConsoleScreenBufferInfo(HConsoleOutput,rcc)
& nbsp & nbsp resultat := tcoord(rcc.dwCursorPosition).x 1
fin
Fonction de WhereY: integer
var rcc : TConsoleScreenBufferInfo
begin
& nbsp & nbsp getConsoleScreenBufferInfo(HConsoleOutput,rcc)
& nbsp & nbsp resultat := tcoord(rcc.dwCursorPosition).y 1
fin
Procedure GotoXY(const x,y:entier)
var coord :tcoord
begin
& nbsp & nbsp coord.x := x-1
& nbsp & nbsp coord.y := y-1
& nbsp & nbsp setConsoleCursorPosition(hconsoleoutput,coord)
fin
procedure InsLine
var
& nbsp rcc : TConsoleScreenBufferInfo
& nbsp ssr:tsmallrect
& nbsp coord :tcoord
& nbsp ci :tcharinfo
& nbsp nw:integer
begin
& nbsp & nbsp getConsoleScreenBufferInfo(HConsoleOutput,rcc)
& nbsp & nbsp coord := rcc.dwCursorPosition
& nbsp & nbsp ssr.a gauche := 0
& nbsp & nbsp ssr.haut := coord.y
& nbsp & nbsp ssr.droit := rcc.srwindow.droite
& nbsp & nbsp ssr.en bas := rcc.srwindow.bas
& nbsp & nbsp ci.asciichar := #32
& nbsp & nbsp ci.attributs := rcc.wattributes
& nbsp & nbsp coord.x := 0
& nbsp & nbsp coord.y := coord.y 1
& nbsp & nbsp ScrollConsoleScreenBuffer(HconsoleOutput,ssr,neant,coord,ci)
& nbsp & nbsp coord.y := coord.y-1
& nbsp & nbsp FillConsoleOutputAttribute(HConsoleOutput,textattr,rcc.dwsize.x*rcc.dwsize.y,coord,nw)
fin
procedure DelLine
var
& nbsp rcc : TConsoleScreenBufferInfo
& nbsp ssr:tsmallrect
& nbsp coord :tcoord
& nbsp ci :tcharinfo
& nbsp nw:integer
begin
& nbsp & nbsp getConsoleScreenBufferInfo(HConsoleOutput,rcc)
& nbsp & nbsp coord := rcc.dwCursorPosition
& nbsp & nbsp ssr.a gauche := 0
& nbsp & nbsp ssr.haut := coord.y 1
& nbsp & nbsp ssr.droit := rcc.srwindow.droite
& nbsp & nbsp ssr.en bas := rcc.srwindow.bas
& nbsp & nbsp ci.asciichar := #32
& nbsp & nbsp ci.attributs := rcc.wattributes
& nbsp & nbsp coord.x := 0
& nbsp & nbsp coord.y := coord.y
& nbsp & nbsp ScrollConsoleScreenBuffer(HconsoleOutput,ssr,neant,coord,ci)
& nbsp & nbsp FillConsoleOutputAttribute(HConsoleOutput,textattr,rcc.dwsize.x*rcc.dwsize.y,coord,nw)
fin
procedure TextBackground(const Couleur:word)
begin
& nbsp & nbsp LastMode := TextAttr
& nbsp & nbsp textattr := (couleur shl 4) ou (textattr et $f)
& nbsp & nbsp SetConsoleTextAttribute(hconsoleoutput,textattr)
fin
procedure TextColor(const Couleur:word)
begin
& nbsp & nbsp LastMode := TextAttr
& nbsp & nbsp textattr := (couleur et $f) ou (textattr et $f0)
& nbsp & nbsp SetConsoleTextAttribute(hconsoleoutput,textattr)
fin
procedure TextAttribut(const Couleur,arriere-plan:mot)
begin
& nbsp & nbsp LastMode := TextAttr
& nbsp & nbsp textattr := (couleur et $f) ou en arriere-plan (shl 4)
& nbsp & nbsp SetConsoleTextAttribute(hconsoleoutput,textattr)
fin
procedure HighVideo
begin
& nbsp & nbsp LastMode := TextAttr
& nbsp & nbsp textattr := textattr ou $8
& nbsp & nbsp SetConsoleTextAttribute(hconsoleoutput,textattr)
fin
procedure LowVideo
begin
& nbsp & nbsp LastMode := TextAttr
& nbsp & nbsp textattr := textattr et $f7
& nbsp & nbsp SetConsoleTextAttribute(hconsoleoutput,textattr)
fin
procedure NormVideo
begin
& nbsp & nbsp LastMode := TextAttr
& nbsp & nbsp textattr := startAttr
& nbsp & nbsp SetConsoleTextAttribute(hconsoleoutput,textattr)
fin
procedure FlushInputBuffer
begin
& nbsp & nbsp FlushConsoleInputBuffer(hconsoleinput)
fin
fonction de keypressed:boolean
var NumberOfEvents:integer
begin
& nbsp & nbsp GetNumberOfConsoleInputEvents(hconsoleinput,NumberOfEvents)
& nbsp & nbsp resultat := NumberOfEvents > 0
fin
fonction de ReadKey: Char
var
& nbsp & nbsp NumRead: Integer
& nbsp & nbsp InputRec: TInputRecord
begin
& nbsp & nbsp alors que pas ReadConsoleInput(HConsoleInput,
& ! & ! & ! & ! & ! & n sp & ! & ! & ! & ! & ! & ! & ! & ! & ! & ! & ! & ! & ! & ! & ! & ! & ! & ! & ! & ! & ! & ! & nbsp InputRec,
& ! & ! & ! & ! & ! & ! & ! & ! & ! & ! & ! & ! & ! & ! & ! & ! & ! & ! & ! & ! & ! & ! & ! & ! & ! & ! & ! & ! & nbsp 1,
& ! & ! & ! & ! & ! & ! & ! & ! & ! & ! & ! & ! & ! & ! & ! & ! & ! & ! & ! & ! & ! & ! & ! & ! & ! & ! & ! & ! & nbsp NumRead) ou
& ! & ! & ! & ! & ! & ! & ! & ! & ! & ! & nbsp (InputRec.EventType <> KEY_EVENT) ne
& nbsp & nbsp Resultat := InputRec.KeyEvent.AsciiChar
fin
procedure de retard(const ms:entier)
begin
& nbsp & nbsp sleep(ms)
fin
Procedure
begin
& nbsp & nbsp windows.bip(SoundFrequenz,soundduration)
fin
Procedure de NoSound
begin
& nbsp & nbsp windows.bip(soundfrequenz,0)
fin
procedure ConsoleEnd
begin
& nbsp & nbsp si isconsole et pas crtpipe puis
& nbsp & nbsp commencer
& ! & ! & ! & nbsp si wherex > 1 then writeln
& ! & ! & ! & nbsp textcolor(vert)
& ! & ! & ! & nbsp setfocus(fonction getcurrentprocess)
& ! & ! & ! & nbsp si l'allemand alors ecrire('Bitte eine Goût drücken!')
& ! & ! & ! & ! & ! & ! & ! & ! & ! & ! & ! & ! & ! & nbsp else write('Appuyez sur une touche!')
& ! & ! & ! & nbsp normvideo
& ! & ! & ! & nbsp FlushInputBuffer
& ! & ! & ! & nbsp ReadKey
& ! & ! & ! & nbsp FlushInputBuffer
& nbsp & nbsp fin
fin
fonction de Tuyau:boolean
begin
& nbsp & nbsp resultat := crtpipe
fin
procedure init
var
& nbsp & nbsp rcc : 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,rcc)
& nbsp commencer
& nbsp & nbsp & nbsp TextAttr := rcc.wAttributes
& nbsp & nbsp & nbsp StartAttr := rcc.wAttributes
& nbsp & nbsp & nbsp lastmode := rcc.wAttributes
& nbsp & nbsp & nbsp tc.x := rcc.srwindow.gauche 1
& nbsp & nbsp & nbsp tc.y := rcc.srwindow.top 1
& nbsp & nbsp & nbsp windmin := tc
& nbsp & nbsp & nbsp ViewMax := rcc.dwsize
& nbsp & nbsp & nbsp tc.x := rcc.srwindow.droit 1
& nbsp & nbsp & nbsp tc.y := rcc.srwindow.bas 1
& nbsp & nbsp & nbsp windmax := tc
& nbsp & nbsp & nbsp crtpipe := false
& nbsp fin d'autre crtpipe := true
& nbsp SoundFrequenz := 1000
& nbsp SoundDuration := -1
& nbsp oldCp := GetConsoleoutputCP
& nbsp SetConsoleoutputCP(1252)
& nbsp allemand := $07 = (LoWord(GetUserDefaultLangID) et $3ff)
fin
initialisation
& nbsp & nbsp init
finalisation
& nbsp SetConsoleoutputCP(oldcp)
{$endif win32}
a la fin.


Crt32

Crt32 : Plusieurs milliers de conseils pour vous faciliter la vie.
Recommander aux amis
  • gplus
  • pinterest

Messages récents

Commentaire

Laisser un commentaire

évaluation