Форум: "Основная";
Поиск по всему сайту: delphimaster.net;
Текущий архив: 2002.04.15;
Скачать: [xml.tar.bz2];




Вниз

Ламерский вопрос 


...   (2002-04-03 16:05) [0]

Простите за такой тупой вопрос, но:

Как обрабатывать нажатия клавиш в Turbo Pascal-е??
К примеру, чтоб при нажатии Esc выполнилася процедура abcde

Если можно маленький примерчик...



PVOzerski   (2002-04-03 16:07) [1]

uses
crt;
.....
if readkey=#27 then
abcde;



Song   (2002-04-03 16:33) [2]

KeyPressed



JibSkeart   (2002-04-03 16:44) [3]

а мона и так if port[$60]=1 then ... то бишь если нажали ESC
то ...



Бурундук   (2002-04-03 16:48) [4]

Когда-то давно написал вспомогательный модуль для
работы с клавиатурой:

{**********************************************************
* *
* Unit Keys for Dos *
* version 2.38 *
* Las modification 17.02.98 *
* *
***********************************************************}
unit Keys;
interface
uses Crt;
const

{------ keys -----------}
NormalKey = False;
ScanKey = True;

keyEsc = #27;
keyEnter = #13;
keyZero = #0;

{------------- Int Key Codes------}

{--------normal keys---------------}
kcEsc = 27;
kcEnter = 13;
kcNil = 0;
kcZero = 0;
kcClear = 0;
kcTab = 9;
kcSpace = 32;
kcBkSpace = 8;
{-----------------------}
kcCtrlA = 1;
kcCtrlB = 2;
kcCtrlC = 3;
kcCtrlD = 4;
kcCtrlE = 5;
kcCtrlF = 6;
kcCtrlG = 7;
kcCtrlH = 8;
kcCtrlI = 9;
kcCtrlJ = 10;
kcCtrlK = 11;
kcCtrlL = 12;
kcCtrlM = 13;
kcCtrlN = 14;
kcCtrlO = 15;
kcCtrlP = 16;
kcCtrlQ = 17;
kcCtrlR = 18;
kcCtrlS = 19;
kcCtrlT = 20;
kcCtrlU = 21;
kcCtrlV = 22;
kcCtrlW = 23;
kcCtrlX = 24;
kcCtrlY = 25;
kcCtrlZ = 26;

kcCtrlEnter = 10;
kcCtrl3 = -3;
kcCtrl6 = 30;
kcCtrlMinus = 31;
kcCtrlSlash = 28;
kcCtrlBackSpace = 127;
{-----------------------}


{---- scan code --------}

kcShiftTab = -15;

kcArrowRight = -77; kcRight = -77;
kcArrowLeft = -75; kcLeft = -75;
kcArrowUp = -72; kcUp = -72;
kcArrowDown = -80; kcDown = -80;
kcHome = -71;
kcEnd = -79;
kcPgUp = -73;
kcPgDn = -81;
{-----------------------}
kcCtrlArrowRight = -116; kcCtrlRight = -116;
kcCtrlArrowLeft = -115; kcCtrlLeft = -115;
{-----------------------}
kcIns = -82;
kcDel = -83;

kcF1 = -59;
kcF2 = -60;
kcF3 = -61;
kcF4 = -62;
kcF5 = -63;
kcF6 = -64;
kcF7 = -65;
kcF8 = -66;
kcF9 = -67;
kcF10 = -68;
{-----------------------}
kcCtrlF1 = -94;
kcCtrlF2 = -95;
kcCtrlF3 = -96;
kcCtrlF4 = -97;
kcCtrlF5 = -98;
kcCtrlF6 = -99;
kcCtrlF7 = -100;
kcCtrlF8 = -101;
kcCtrlF9 = -102;
kcCtrlF10 = -103;
{-----------------------}
kcAltF1 = -104;
kcAltF2 = -105;
kcAltF3 = -106;
kcAltF4 = -107;
kcAltF5 = -108;
kcAltF6 = -109;
kcAltF7 = -110;
kcAltF8 = -111;
kcAltF9 = -112;
kcAltF10 = -113;
{-----------------------}
kcShiftF1 = -84;
kcShiftF2 = -85;
kcShiftF3 = -86;
kcShiftF4 = -87;
kcShiftF5 = -88;
kcShiftF6 = -89;
kcShiftF7 = -90;
kcShiftF8 = -91;
kcShiftF9 = -92;
kcShiftF10 = -93;
{-----------------------}
kcAltA = -30;
kcAltB = -48;
kcAltC = -46;
kcAltD = -32;
kcAltE = -18;
kcAltF = -33;
kcAltG = -34;
kcAltH = -35;
kcAltI = -23;
kcAltJ = -36;
kcAltK = -37;
kcAltL = -38;
kcAltM = -50;
kcAltN = -49;
kcAltO = -24;
kcAltP = -25;
kcAltQ = -16;
kcAltR = -19;
kcAltS = -31;
kcAltT = -20;
kcAltU = -22;
kcAltV = -47;
kcAltW = -17;
kcAltX = -45;
kcAltY = -21;
kcAltZ = -44;

kcAlt1 = -120;
kcAlt2 = -121;
kcAlt3 = -122;
kcAlt4 = -123;
kcAlt5 = -124;
kcAlt6 = -125;
kcAlt7 = -126;
kcAlt8 = -127;
kcAlt9 = -128;
kcAlt0 = -129;
kcAltMinus = -130;
kcAltPlus = -131;

{-----------------------}

type
TSetOfChar = set of Char;

PKey = ^TKey;
TKey = object
Scan: Boolean;
Value: Char;
Throu: Boolean;
constructor Init(ACode: Integer);
procedure SetEqual(AKey: TKey);
procedure SendCode(ACode: Integer);
procedure SendChar(AValue: Char);

procedure Get;
function Pressed: Boolean;

function FirstChar: Char;

function Code: Integer;
function Is(ACode: Integer): Boolean;
function IsChar(AValue: Char): Boolean;

function IsClear: Boolean;
function IsEsc: Boolean;
function IsEnter: Boolean;

function IsNumber: Boolean;
function IsSpec: Boolean;
function IsLetter: Boolean;
function IsText: Boolean;
function IsIn(SetOfChar: TSetOfChar): Boolean;
function IsEqual(AKey: TKey): Boolean;

function UpIsEqual(AKey: TKey): Boolean;
function UpIs(AValue: Char): Boolean;
function UpIsIn(SetOfChar: TSetOfChar): Boolean;

procedure Unget;
procedure Clear;

destructor Done;
end;





Бурундук   (2002-04-03 16:48) [5]

var
theKey: TKey;

implementation
{----- TKey methods ----}

constructor TKey.Init(ACode: Integer);
begin
Scan := ACode<0;
Value := Char(Abs(ACode));
Throu := False;
end;

procedure TKey.Get;
begin
if Throu then
Throu := False
else
begin
Scan := False;
Value := ReadKey;
if Value = keyZero then
begin
Scan := True;
Value := ReadKey;
end;
end;
end;

procedure TKey.SetEqual(AKey: TKey);
begin
Scan := AKey.Scan;
Value := AKey.Value;
end;

procedure TKey.SendCode(ACode: Integer);
begin
Init(ACode);
Unget;
end;

procedure TKey.SendChar(AValue: Char);
begin
Value := AValue;
Scan := False;
Unget;
end;


function TKey.Pressed: Boolean;
begin
if KeyPressed or Throu then
begin
Pressed := True;
if not Throu then
begin
Scan := False;
Value := ReadKey;
if Value = keyZero then
begin
Scan := True;
Value := ReadKey;
end;
end else Throu := False;
end
else
Pressed := False;
end;

function TKey.FirstChar: Char;
begin
if Scan = NormalKey then
FirstChar := Value
else
FirstChar := keyZero;
end;

function TKey.Code: Integer;
begin
if Scan then
Code := - Ord(Value)
else
Code := Ord(Value);
end;

{-------------Comparison------------------}

function TKey.Is(ACode: Integer): Boolean;
begin
if ( (ACode<0)=Scan ) and ( Ord(Value)=Abs(ACode)) then
Is := True
else
Is := False;
end;

function TKey.IsChar(AValue: Char): Boolean;
begin
if (Scan = NormalKey) and(Value = AValue) then
IsChar := True
else
IsChar := False;
end;

function TKey.IsClear: Boolean;
begin
if (Scan = NormalKey) and(Value = keyZero) then
IsClear := True
else
IsClear := False;
end;

{-----------------}

function TKey.IsNumber: Boolean;
begin
if (not Scan)and(Value in["1","2","3","4","5","6","7","8","9","0",".","-"]) then
IsNumber := True
else
IsNumber := False;
end;

function TKey.IsSpec: Boolean;
begin
if (not Scan)and(Ord(Value) < 32) then
IsSpec := True
else
IsSpec := False;
end;

function TKey.IsText: Boolean;
begin
if (not Scan)and(Ord(Value)>=32)and(Ord(Value)<128) then
IsText := True
else
IsText := False;
end;

function TKey.IsLetter: Boolean;
var
O: Byte;
begin
O := Ord(Value);
if (not Scan)and
( ( (O >= 65)and(O <= 90 ) )
or ( (O >= 97)and(O <= 122) ) ) then
IsLetter := True
else
IsLetter := False;
end;

{--------------------}

function TKey.IsIn(SetOfChar: TSetOfChar): Boolean;
begin
if (not Scan)and(Value in SetOfChar) then
IsIn := True
else
IsIn := False;
end;

function TKey.IsEsc: Boolean;
begin
if not Scan and (Value = keyEsc) then
IsEsc := True
else
IsEsc := False;
end;

function TKey.IsEnter: Boolean;
begin
if not Scan and (Value = keyEnter) then
IsEnter := True
else
IsEnter := False;
end;

function TKey.IsEqual(AKey: TKey): Boolean;
begin
if (Scan = AKey.Scan)and(Value = AKey.Value) then
IsEqual := True
else
IsEqual := False;
end;

destructor TKey.Done;
begin
end;

{--------------------------------------}

function TKey.UpIs(AValue: Char): Boolean;
begin
if (Scan = NormalKey)and( Upcase(Value) = Upcase(AValue)) then
UpIs := True
else
UpIs := False;
end;

function TKey.UpIsIn(SetOfChar: TSetOfChar): Boolean;
begin
if (not Scan)and(UpCase(Value) in SetOfChar) then
UpIsIn := True
else
UpIsIn := False;
end;

function TKey.UpIsEqual(AKey: TKey): Boolean;
begin
if (Scan = AKey.Scan)and(Upcase(Value) = Upcase(AKey.Value)) then
UpIsEqual := True
else
UpIsEqual := False;
end;

procedure TKey.Unget;
begin
Throu := True;
end;

procedure TKey.Clear;
begin
{Throu := False;}
Init(kcClear);
end;


end.



Бурундук   (2002-04-03 16:51) [6]

Работать с ним так:

repeat
if theKey.Pressed then {или theKey.Get;}
begin
if theKey.Is(kcAltF3) then {};
if theKey.IsChar("P") then {};
if theKey.IsEnter then {};
...
end;
until theKey.Is(kcAltX); {theKey.IsEsc}



Alibaba   (2002-04-03 17:13) [7]

2 Бурундук
да... куда смотрит модератор...
хорошо что вы, коллега, не пишете больших програм. :)




Форум: "Основная";
Поиск по всему сайту: delphimaster.net;
Текущий архив: 2002.04.15;
Скачать: [xml.tar.bz2];




Наверх





Память: 0.75 MB
Время: 0.017 c
14-46507          --Reporter--          2002-03-07 21:16  2002.04.15  
Как переустановить шрифт Arial?


3-46261           Delphin2              2002-03-25 08:36  2002.04.15  
Базы данных


3-46286           Vitek                 2002-03-26 12:43  2002.04.15  
Database Desktop


4-46546           avk                   2002-02-13 21:40  2002.04.15  
kill process


1-46418           Nestor                2002-04-02 18:04  2002.04.15  
InstallShield