[BASSON XVI]

знаю есть била или ещё что мне кото-то говорил !!! Моно спомошью ёе коды кнопок вычислять!!!

Скрытый текст (вы должны войти под своим логином или зарегистрироваться и иметь 5 сообщение(ий)):

У вас нет прав, чтобы видеть скрытый текст, содержащийся здесь.

вот написал не весть что не работает!!! А хотелось что б работало!!! Посмотрите !!!

program Canwas;
uses CRT;
var
  s2, keyaction, tecla : integer;
  buf3, s1  : string; 
  tscreen : string;
  clicked : integer;
//-------------------------------------------------------
begin 

buf3 := 'My name is Denis!! ';
tscreen := buf3;
write(tscreen);
tecla := GetKeyPressed;
if tecla = ke_key1 then begin s2:=1; s1:=IntegertoString(s2); write(s1); end;
if tecla = ke_key2 then begin s2:=2; s1:=IntegertoString(s2); write(s1); end;
if tecla = ke_key3 then begin s2:=3; s1:=IntegertoString(s2); write(s1); end;
if tecla = ke_key4 then begin s2:=4; s1:=IntegertoString(s2); write(s1); end;
if tecla = ke_key5 then begin s2:=5; s1:=IntegertoString(s2); write(s1); end;
if tecla = ke_key6 then begin s2:=6; s1:=IntegertoString(s2); write(s1); end;
if tecla = ke_key7 then begin s2:=7; s1:=IntegertoString(s2); write(s1); end;
if tecla = ke_key8 then begin s2:=8; s1:=IntegertoString(s2); write(s1); end;
if tecla = ke_key9 then begin s2:=9; s1:=IntegertoString(s2); write(s1); end;
repeat 
   keyaction:= keyToAction(getKeypressed);
until keyaction<>GA_NONE;
if (keyToAction(GetKeyPressed)=GA_FIRE) then halt; 
delay(900000);
end.

А вот сама библа CRT

 
unit CRT;
// эмуляция текстового дисплея
interface
var
 Wrap : boolean; // признак переноса слов при достижении правого края экрана
 MaxLine : integer; // количество строк
 
procedure ClrScr; // оистка экрана
procedure SetBkColor(R,G,B : integer); // устанавливает цвет фона всего экрана
procedure SetFontColor(R,G,B : integer);// устанавливает цвет текста на всем экране
procedure write(s : string); // аналог write 
procedure writeln(s : string); // аналог writeln
procedure waitkey(Key : integer) ; // ожидает нажатия на указанную кнопку
procedure waitanykey; // ожидает нажатия на любую кнопку
procedure InitCRT; // инициализация системы вывода (надо вызывать после изменения размера шрифта
implementation
type
 ColorRec = record
 R,G,B : integer;
 end;
 
var
 Screen : array[0..99] of string; // виртуальные строки дисплея
 CurLine : integer; // текущая строка
 CurX : integer; // текущая позиция в строке
 BkColor : ColorRec;
 FColor : ColorRec;
 LineH : integer; // высота строки
 
procedure SetC(C : ColorRec);
begin
 SetColor(C.R, C.G, C.B);
end;
procedure ClearScreen;
var
 i : integer;
begin
 for i := 0 to MaxLine do Screen[i] := '';
end;
 
procedure RedrawScreen; // отрисовка всего текста
var
 i, y : integer;
begin
 SetC(BkColor);
 fillrect(0,0,GetWidth, GetHeight);
 SetC(FColor);
 y := 0;
 for i := 0 to CurLine do begin
  DrawText(Screen[i],0,y);
  y := y + LineH;
 end;
 repaint;
end;
 
procedure ClrScr; // оистка экрана
begin
 CurLine := 0;
 CurX := 0;
 ClearScreen;
 RedrawScreen;
end;
procedure SetBkColor(R,G,B : integer); // устанавливает цвет фона
begin
 BkColor.R := R;
 BkColor.G := G;
 BkColor.B := B;
end;
procedure SetFontColor(R,G,B : integer);// устанавливает цвет текста
begin
 FColor.R := R;
 FColor.G := G;
 FColor.B := B;
end;
procedure ScrollUp;
var
 i : integer;
begin
 for i := 1 to MaxLine do Screen[i-1] := Screen[i];
 Screen[MaxLine] := '';
 CurLine := MaxLine;
end;
procedure NextLine;
begin
 CurLine := CurLine + 1;
 if CurLine > MaxLine then ScrollUp;
 CurX := 0;
end;
procedure AddLine(s : string);
begin
 Screen[CurLine] := Screen[CurLine] + s;
 CurX := GetStringWidth(Screen[CurLine]);
end;
function GetToken(s : string; num : integer): string; // возвращает слово номер num из строки
var
 s1 : string;
 ch : char;
 i : integer;
begin
 ch := getChar(s,num);
 if ch = chr(0)
  then s1 := ''
  else s1 := ''+ch;
 GetToken := s1;
end;
procedure write(s : string); // аналог write 
var
 s1,s2, s3 : string;
 i : integer;
 lsp : integer;
 done : boolean;
begin
 if Wrap then begin // если включен перенос
  while s <> '' do begin
   s1 := '';
   i := 0;
   repeat
    s3 := GetToken(s,i);
    s1 := s1 + s3;
    i := i + 1;
    s2 := copy(s,i,length(s));
   until ((GetStringWidth(s1)+CurX) > GetWidth) or (s2 = '') or (s1 = '');
   if s2 <> '' then begin
    i := i -1;
    s1 := copy(s1,0,length(s1)-1);
    s2 := copy(s,i,length(s));
   end;
   AddLine(s1);
   if s2 <> '' then NextLine;
   s := s2;
  end;
 end
 else AddLine(s); // если перенос выключен
 RedrawScreen; // выводим все
end;
procedure writeln(s : string); // аналог writeln
begin
 write(s);
 NextLine;
end;
procedure waitkey(Key : integer) ; // ожидает нажатия на указанную кнопку
begin
 repeat
  delay(100);
 until GetKeyPressed = Key;
end;
procedure waitanykey; // ожидает нажатия на любую кнопку
begin
 repeat
  delay(100);
 until GetKeyPressed <> KE_NONE;
end;
procedure InitCRT;
begin
 LineH := GetStringHeight('S');
 MaxLine := GetHeight / LineH;
 if MaxLine > 100 then MaxLine := 100;
 if MaxLine < 0 then MaxLine := 1;
 MaxLine := MaxLine - 1;
 Clrscr;
 SetBkColor(255,255,255);
 SetFontColor(0,0,0);
end;
initialization
 Wrap := true;
 InitCRT;
end.