Delphi 32 versjonen av Pascal CRT unit.Contributor: FRANK ZIMMERImplementation av Turbo Pascal CRT-Unit for Win32Console Subsystem_________________ Gjør fil CRT32.inf ________________________________filename=Crt32replacements=fileversion=1.0.0127filedescription=Implementation av Turbo Pascal CRT-Unit for Win32 Console Subsystemtarget = Delphi 2.0author name = Frank Zimmerauthor [email protected] URL = file status = freewarefull source = category = Diverse _________________ Gjør fil CRT32.int ________________________________ {$ APPTYPE CONSOLE} enhet crt32 {# freeware} {# versjon 1.0.0127} {# Dato 18.01.1997} {# Forfatter Frank Zimmer} {# beskrivelse Copyright © 1997 Frank Zimmer, [email protected] Versjon: 1.0.0119 Dato: 18.01. 1997 en implementering av Turbo Pascal CRT-Unit for Win32 Console Subsystem Testet med Windows NT 4.0 ved oppstart får du Focus til konsoll !!!! implemention nå (* er ikke i den opprinnelige CRT-Unit): Fremgangsmåte og funksjon: ClrScr ClrEol WhereX WhereY GotoXY InsLine DelLine HighVideo LowVideo NormVideo TextBackground textcolor Delay //bruker ingen processtime KeyPressed ReadKey //bruker ingen processtime Sound //med Windows NT din kunne bruke variabler SoundFrequenz, SoundDuration nosound * TextAttribut //Set TextBackground og textcolor samtidig, //nyttig for Lastmode * FlushInputBuffer Skyll Tastatur og alle andre hendelser * ConsoleEnd //produksjon på "Trykk en tast" og vente på nøkkelen inngang når ikke rør * Pipe //Sann når produksjonen er omdirigert til et rør eller en fil Variabler: WindMin //min. WindowRect WindMax //maks. WindowRect * ViewMax //maks. ConsoleBuffer begynner på (1,1); TextAttr //Faktiske attributter bare ved å endre på med denne Rutiner LastMode //Siste attributter bare ved å endre denne Rutiner * SoundFrequenz //med Windows NT din kunne bruke THISE Variabler * SoundDuration //hvor lenge bjeller høyttaleren -1 til ??, standard = -1 * HConsoleInput //Input-håndtak; * HConsoleOutput //Output-håndtak; * HConsoleError //Feil-håndtak; Denne kilden er freeware, ha det gøy :-) History 23.01.97 Sound, delay, Kodeside satt inn og SetFocus til konsollen 24.01.97 Omdirigert status} interfaceuses vinduer, meldinger, {$ ifdef win32} konst Svart = 0; Blå = 1; Grønn = 2; Cyan = 3; Rød = 4; Magenta = 5; Brown = 6; LightGray = 7; Darkgray = 8; Light = 9; Lys grønn = 10; LightCyan = 11; LightRed = 12; LightMagenta = 13; Gul = 14; Hvit = 15; Funksjon WhereX: integer; Funksjon WhereY: integer; prosedyre ClrEol; prosedyre ClrScr; prosedyre InsLine; Prosedyre DelLine; Prosedyre GotoXY (konst x, y: integer); prosedyre HighVideo; prosedyre LowVideo; prosedyre NormVideo; Prosedyren TextBackground (konst Farge: ord); Prosedyren textcolor (konst Farge: ord); Prosedyren TextAttribut (konst Color, Bakgrunn: ord); Prosedyren Delay (const ms: heltall); funksjon KeyPressed: boolean; funksjon ReadKey: Char; Prosedyre Sound; Prosedyre nosound; prosedyre ConsoleEnd; prosedyre FlushInputBuffer; Funksjon Pipe: boolean; Var HConsoleInput: thandle; HConsoleOutput: thandle; HConsoleError: Thandle; WindMin: tcoord; WindMax: tcoord; ViewMax: tcoord; TextAttr: Word; LastMode: Word; SoundFrequenz: Integer; SoundDuration: Integer; {$ endif win32} implementering _________________ Gjør fil CRT32.pas ________________________________ {$ APPTYPE CONSOLE} enhet crt32 {# freeware} {# versjon 1.0.0127} {# Dato 18.01.1997} {# Forfatter Frank Zimmer} {# beskrivelse Copyright © 1997 Frank Zimmer, [email protected] Versjon: 1.0.0119 Dato: 18.01.1997 en Implementering av Turbo Pascal CRT-Unit for Win32 Console Subsystem Testet med Windows NT 4.0 ved oppstart får du fokus til konsoll! !!! (Med * er ikke i den opprinnelige CRT-Unit): Fremgangsmåte og funksjon: ClrScr ClrEol WhereX WhereY GotoXY InsLine DelLine HighVideo LowVideo NormVideo TextBackground textcolor Delay //bruker ingen processtime KeyPressed ReadKey //bruker ingen processtime Sound //med Windows NT din kunne bruke variabler SoundFrequenz, SoundDuration nosound * TextAttribut //Set TextBackground og textcolor samtidig, //nyttig for Lastmode * FlushInputBuffer Skyll Tastatur og alle andre hendelser * ConsoleEnd //produksjon på "Trykk en tast" og vente på viktige innspill når ikke rør * Pipe //Sann når produksjonen er omdirigert til et rør eller en fil Variabler: WindMin //min. WindowRect WindMax //maks. WindowRect * ViewMax //maks. ConsoleBuffer begynner på (1,1); TextAttr //Faktiske attributter bare ved å endre på med denne Rutiner LastMode //Siste attributter bare ved å endre denne Rutiner * SoundFrequenz //med Windows NT din kan bruke disse variablene * SoundDuration //hvor lenge bjeller høyttaleren -1 til ??, standard = -1 * HConsoleInput //Input-håndtak; * HConsoleOutput //Output-håndtak; * HConsoleError //Feil-håndtak; Denne kilden er freeware, ha det gøy :-) History 18.01.97 den første gjennomføringen 23.01.97 Sound, delay, Kodeside satt inn og SetFocus til konsollen 24.01.97 Omdirigert status} interfaceuses vinduer, meldinger, {$ ifdef win32} const Svart = 0; Blå = 1; Grønn = 2; Cyan = 3; Rød = 4; Magenta = 5; Brown = 6; LightGray = 7; Darkgray = 8; Light = 9; Lys grønn = 10; LightCyan = 11; LightRed = 12; LightMagenta = 13; Gul = 14; Hvit = 15; Funksjon WhereX: integer; Funksjon WhereY: integer; prosedyre ClrEol; prosedyre ClrScr; prosedyre InsLine; Prosedyre DelLine; Prosedyre GotoXY (konst x, y: integer); prosedyre HighVideo; prosedyre LowVideo; prosedyre NormVideo; Prosedyren TextBackground (konst Farge: ord); Prosedyren textcolor (konst Farge: ord); Prosedyren TextAttribut (konst Color, Bakgrunn: ord); Prosedyren Delay (const ms: heltall); funksjon KeyPressed: boolean; funksjon ReadKey: Char; Prosedyre Sound; Prosedyre nosound; prosedyre ConsoleEnd; prosedyre FlushInputBuffer; Funksjon Pipe: boolean; Var HConsoleInput: tHandle; HConsoleOutput: thandle; HConsoleError: Thandle; WindMin: tcoord; WindMax: tcoord; ViewMax: tcoord; TextAttr: Word; LastMode: Word; SoundFrequenz: Integer; SoundDuration: Integer; {$ endif win32} implementering {$ ifdef win32} bruker sysutils; Var StartAttr: ord; OldCP: integer; CrtPipe: Boolean; Tysk: boolean; prosedyre ClrEol; Var tC: tCoord; Len, Nw: integer; CBI: TConsoleScreenBufferInfo; begynne GetConsoleScreenBufferInfo (HConsoleOutput, CBI); len: = cbi.dwsize.x-cbi.dwcursorposition.x; tc.x: = cbi.dwcursorposition.x; tc.y: = cbi.dwcursorposition.y; FillConsoleOutputAttribute (HConsoleOutput, textattr, len, tc, nw); FillConsoleOutputCharacter (HConsoleOutput, # 32, len, tc, nw); ende; prosedyre ClrScr; Var tc: tcoord; nw: integer; CBI: TConsoleScreenBufferInfo; begynne getConsoleScreenBufferInfo (HConsoleOutput, CBI); tc.x: = 0; tc.y: = 0; FillConsoleOutputAttribute (HConsoleOutput, textattr, cbi.dwsize.x * cbi.dwsize.y, tc, nw); FillConsoleOutputCharacter (HConsoleOutput, # 32, cbi.dwsize.x * cbi.dwsize.y, tc, nw); setConsoleCursorPosition (hconsoleoutput, tc); ende; Funksjon WhereX: integer; Var CBI: TConsoleScreenBufferInfo; begynne getConsoleScreenBufferInfo (HConsoleOutput, CBI); Resultatet: = tcoord (cbi.dwCursorPosition) .x + 1end; Funksjon WhereY: integer; Var CBI: TConsoleScreenBufferInfo; begynne getConsoleScreenBufferInfo (HConsoleOutput, CBI); Resultatet: = tcoord (cbi.dwCursorPosition) .Y + 1end; Prosedyre GotoXY (konst x, y: integer); Var coord: tcoord; begynne coord.x: = x-1; coord.y: = y-1; setConsoleCursorPosition (hconsoleoutput, koord); ende; prosedyre InsLine; Var CBI: TConsoleScreenBufferInfo; SSR: tsmallrect; coord: tcoord; ci: tcharinfo; nw: integer; begynne getConsoleScreenBufferInfo (HConsoleOutput, CBI); coord: = cbi.dwCursorPosition; ssr.left: = 0; ssr.top: = coord.y; ssr.right: = cbi.srwindow.right; ssr.bottom: = cbi.srwindow.bottom; ci.asciichar: = # 32; ci.attributes: = cbi.wattributes; coord.x: = 0; coord.y: = coord.y + 1; ScrollConsoleScreenBuffer (HconsoleOutput, SSR, nil, coord, ci); coord.y: = coord.y-1; FillConsoleOutputAttribute (HConsoleOutput, textattr, cbi.dwsize.x * cbi.dwsize.y, coord, nw); ende; prosedyre DelLine; Var CBI: TConsoleScreenBufferInfo; SSR: tsmallrect; coord: tcoord; ci: tcharinfo; nw: integer; begynne getConsoleScreenBufferInfo (HConsoleOutput, CBI); coord: = cbi.dwCursorPosition; ssr.left: = 0; ssr.top: = coord.y + 1; ssr.right: = cbi.srwindow.right; ssr.bottom: = cbi.srwindow.bottom; ci.asciichar: = # 32; ci.attributes: = cbi.wattributes; coord.x: = 0; coord.y: = coord.y; ScrollConsoleScreenBuffer (HconsoleOutput, SSR, nil, coord, ci); FillConsoleOutputAttribute (HConsoleOutput, textattr, cbi.dwsize.x * cbi.dwsize.y, coord, nw); ende; prosedyre TextBackground (konst Farge: ord); begynne LastMode: = TextAttr; textattr: = (farge SHL 4) eller (textattr og $ f); SetConsoleTextAttribute (hconsoleoutput, textattr); ende; prosedyre textcolor (konst Farge: ord); begynne LastMode: = TextAttr; textattr: = (farge og $ f) eller (textattr og $ f0); SetConsoleTextAttribute (hconsoleoutput, textattr); ende; prosedyre TextAttribut (konst Color, Bakgrunn: ord); begynne LastMode: = TextAttr; textattr: = (farge og $ f) eller (Bakgrunn SHL 4); SetConsoleTextAttribute (hconsoleoutput, textattr); ende; prosedyre HighVideo; begynne LastMode: = TextAttr; textattr: = textattr eller $ 8; SetConsoleTextAttribute (hconsoleoutput, textattr); ende; prosedyre LowVideo; begynne LastMode: = TextAttr; textattr: = textattr og $ f7; SetConsoleTextAttribute (hconsoleoutput, textattr); ende; prosedyre NormVideo; begynne LastMode: = TextAttr; textattr: = startAttr; SetConsoleTextAttribute (hconsoleoutput, textattr); ende; prosedyre FlushInputBuffer; begynne FlushConsoleInputBuffer (hconsoleinput) ende, funksjons keypressed: boolean; Var NumberOfEvents: integer; begynne GetNumberOfConsoleInputEvents (hconsoleinput, NumberOfEvents); Resultatet: = NumberOfEvents > 0; ende; funksjon ReadKey: Char; Var NumRead: Integer; InputRec: TInputRecord; begynne mens ikke ReadConsoleInput (HConsoleInput, InputRec, 1, NumRead) eller (InputRec.EventType < > KEY_EVENT) gjøre; Resultat: = InputRec.KeyEvent.AsciiCharend; prosedyre forsinkelse (const ms: integer); begynne søvn (ms); ende; Prosedyre Sound, begynner windows.beep (SoundFrequenz, soundduration); ende; Prosedyre nosound; begynne windows.beep (soundfrequenz , 0); ende; prosedyre ConsoleEnd; begynne hvis isconsole og ikke crtpipe deretter begynne hvis wherex > 1 da writeln; textcolor (grønn); SetFocus (GetCurrentProcess); hvis tysk deretter skrive ('Bitte eine Taste drucken!') else write ('Trykk en tast!'); normvideo; FlushInputBuffer; ReadKey; FlushInputBuffer; end, end, funksjon Pipe: boolean, begynner resultat: = crtpipe; ende; prosedyre init; Var CBI: TConsoleScreenBufferInfo; tc: tcoord; begynne SetActiveWindow (0); HConsoleInput: = GetStdHandle (STD_InPUT_HANDLE); HConsoleOutput: = GetStdHandle (STD_OUTPUT_HANDLE); HConsoleError: = GetStdHandle (STD_Error_HANDLE); hvis getConsoleScreenBufferInfo (HConsoleOutput, CBI), og start TextAttr: = cbi.wAttributes; StartAttr: = cbi.wAttributes; lastmode: = cbi.wAttributes; tc.x: = cbi.srwindow.left + 1; tc.y: = cbi.srwindow.top + 1; windmin: = tc; ViewMax: = cbi.dwsize; tc.x: = cbi.srwindow.right + 1; tc.y: = cbi.srwindow.bottom + 1; windmax: = tc; crtpipe: = false; ende annet crtpipe: = true; SoundFrequenz: = tusen; SoundDuration: = -1; oldCp: = GetConsoleoutputCP; SetConsoleoutputCP (1252); tysk: = $ 07 = (LoWord (GetUserDefaultLangID) og $ 3ff); ende; initialisering init, sluttbehandling SetConsoleoutputCP (oldcp) {$ endif win32} end
.