EnotVM

Информация о пользователе

Привет, Гость! Войдите или зарегистрируйтесь.

Вы здесь » EnotVM » Тестовый форум » 08 БИТ

08 БИТ

Страница:   1 2 3 4 … 9  
Ответить

Сообщений 11 страница 20 из 81

1

08 БИТ

0

11

Переходите на новую версию Gmail
Надежно, быстро и удобно
ОТКРЫТЬ
ансіаск
Ярослав Шевченко
кому: я
4 дня назадПодробнее...
function AnsiToPseudoAscii(const s: string): string;
var
  i: Integer;
  c: Byte;
begin
  Result := '';
  for i := 1 to Length(s) do
  begin
    c := Ord(s[i]);
    case c of
      192..223: Result := Result + Chr(65 + (c - 192) mod 32);  { А-Я → A-Z }
      224..255: Result := Result + Chr(97 + (c - 224) mod 32);  { а-я → a-z }
      168, 184, 175, 191: Result := Result + Chr(105);          { І і Ї ї → i }
      165, 181:           Result := Result + Chr(101);          { Є є → e }
      170, 186:           Result := Result + Chr(103);          { Ґ ґ → g }
    else
      Result := Result + Chr(c);  { залишити як є }
    end;
  end;
end;

function PseudoAsciiToAnsi(const s: string): string;
var
  i: Integer;
  c: Byte;
begin
  Result := '';
  for i := 1 to Length(s) do
  begin
    c := Ord(s[i]);
    case c of
      65..90:  Result := Result + Chr(192 + (c - 65));  { A-Z → А-Я }
      97..122: Result := Result + Chr(224 + (c - 97));  { a-z → а-я }
      105:     Result := Result + Chr(184);             { i → і (мала) }
      101:     Result := Result + Chr(181);             { e → є (мала) }
      103:     Result := Result + Chr(186);             { g → ґ (мала) }
    else
      Result := Result + Chr(c);  { без змін }
    end;
  end;
end;

0

12

Переходите на новую версию Gmail
Надежно, быстро и удобно
ОТКРЫТЬ
відправ ШІ
Ярослав Шевченко
кому: я
4 дня назадПодробнее...
function AnsiToPseudoAscii(const s: string): string;
var
  i: Integer;
  c: Byte;
begin
  Result := '';
  for i := 1 to Length(s) do
  begin
    c := Ord(s[i]);
    case c of
      192..223: Result := Result + Chr(65 + (c - 192) mod 32);  { À-ß > A-Z }
      224..255: Result := Result + Chr(97 + (c - 224) mod 32);  { à-ÿ > a-z }
      168, 184, 175, 191: Result := Result + Chr(105);          { І і ¯ ¿ > i }
      165, 181:           Result := Result + Chr(101);          { Є є > e }
      170, 186:           Result := Result + Chr(103);          { Ґ ґ > g }
    else
      Result := Result + Chr(c);  { çàëèøèòè ÿê є }
    end;
  end;
end;

function PseudoAsciiToAnsi(const s: string): string;
var
  i: Integer;
  c: Byte;
begin
  Result := '';
  for i := 1 to Length(s) do
  begin
    c := Ord(s[i]);
    case c of
      65..90:  Result := Result + Chr(192 + (c - 65));  { A-Z > À-ß }
      97..122: Result := Result + Chr(224 + (c - 97));  { a-z > à-ÿ }
//      105:     Result := Result + Chr(184);             { i > і (ìàëà) }
//      101:     Result := Result + Chr(181);             { e > є (ìàëà) }
//      103:     Result := Result + Chr(186);             { g > ґ (ìàëà) }
    else
      Result := Result + Chr(c);  { áåç çìіí }
    end;
  end;
end;

Твої функціі це біс знає що!
function AnsiToPseudoAscii(const s: string): string;
в дельфі 7 в консольному режимі працює невірно

а
function PseudoAsciiToAnsi(const s: string): string;
взагалі не компілюються
бо строки
      105:     Result := Result + Chr(184);             { i > і (ìàëà) }
      101:     Result := Result + Chr(181);             { e > є (ìàëà) }
      103:     Result := Result + Chr(186);             { g > ґ (ìàëà) }
для case c of це дублікати

0

13

Переходите на новую версию Gmail
Надежно, быстро и удобно
ОТКРЫТЬ
(без темы)
Ярослав Шевченко
кому: я
4 дня назадПодробнее...
function AnsiToPseudoAscii(const s: string): string;
var
  i: Integer;
  c: Byte;
begin
  Result := '';
  for i := 1 to Length(s) do
  begin
    c := Ord(s[i]);
    case c of
      192..223: Result := Result + Chr(65 + (c - 192));  // А-Я → A-Z
      224..255: Result := Result + Chr(97 + (c - 224));  // а-я → a-z
      168: Result := Result + Chr(105); // І → i
      184: Result := Result + Chr(105); // і → i
      175: Result := Result + Chr(73);  // Ї → I
      191: Result := Result + Chr(105); // ї → i
      165: Result := Result + Chr(69);  // Є → E
      181: Result := Result + Chr(101); // є → e
      170: Result := Result + Chr(71);  // Ґ → G
      186: Result := Result + Chr(103); // ґ → g
    else
      Result := Result + Chr(c);
    end;
  end;
end;

function PseudoAsciiToAnsi(const s: string): string;
var
  i: Integer;
  c: Byte;
begin
  Result := '';
  for i := 1 to Length(s) do
  begin
    c := Ord(s[i]);
    case c of
      65..90:  Result := Result + Chr(192 + (c - 65));  // A-Z → А-Я
      97..122: Result := Result + Chr(224 + (c - 97));  // a-z → а-я
      else case c of
        105: Result := Result + Chr(184);  // i → і
        69:  Result := Result + Chr(165);  // E → Є
        101: Result := Result + Chr(181); // e → є
        71:  Result := Result + Chr(170); // G → Ґ
        103: Result := Result + Chr(186); // g → ґ
        73:  Result := Result + Chr(175); // I → Ї
      else
        Result := Result + Chr(c);
      end;
    end;
  end;
end;

0

14

Переходите на новую версию Gmail
Надежно, быстро и удобно
ОТКРЫТЬ
ансі
Ярослав Шевченко
function AnsiToPseudoAscii(const s: string): string; var i: Integer; c: Byte; begin Result := ''; for i := 1 to Length(s) do begin c := Ord(s[i]); ...
Ярослав Шевченко
ось що я у себе знайшов два файли Tabl_ANSI_0-255.txt Tabl_ASC_0-255.txt а ти можеш функції написати відповідно їм сб, 19 апр. 2025 г. в 14:50, Яро...
Ярослав Шевченко
ну ось дивись що мені на ось таку программу в дельфі7 виводить на екран по цьому ти зможе зробити функції переводу Анси в аск2 program p1; {$APPTYP...
Ярослав Шевченко
кому: я
4 дня назадПодробнее...
function AnsiToPseudoAscii(const s: string): string;
var
  i: Integer;
  c: Byte;
begin
  Result := '';
  for i := 1 to Length(s) do
  begin
    c := Ord(s[i]);
    case c of
      // Кирилиця велика
      $C0..$DF: Result := Result + Chr(c - $C0 + Ord('A'));
      // Кирилиця мала
      $E0..$FF: Result := Result + Chr(c - $E0 + Ord('a'));
      // Специфічні українські
      $A8, $B8: Result := Result + 'i'; // І, і
      $AF: Result := Result + 'I'; // Ї
      $BF: Result := Result + 'i'; // ї
      $A5: Result := Result + 'E'; // Є
      $B5: Result := Result + 'e'; // є
      $AA: Result := Result + 'G'; // Ґ
      $BA: Result := Result + 'g'; // ґ
    else
      Result := Result + s[i]; // Інші без змін
    end;
  end;
end;

суббота, 19 апреля 2025 г. пользователь Ярослав Шевченко <dm7148620@gmail.com> написал:

0

15

Переходите на новую версию Gmail
Надежно, быстро и удобно
ОТКРЫТЬ
ансі15:40
Ярослав Шевченко
function AnsiToPseudoAscii(const s: string): string; var i: Integer; c: Byte; begin Result := ''; for i := 1 to Length(s) do begin c := Ord(s[i]); ...
Ярослав Шевченко
кому: я
4 дня назадПодробнее...
{*}Function AnsiToAscChar(ch:char):char;{преобразование символа из Ansi в Asc}
var c:Cardinal;
begin  c:=ord(ch); case c of
192..239:begin c:=c-64;end; 240..255:begin c:=c-16;end;
166:c:=124;{¦}    168:c:=240;{Ё} 184:c:=241;{ё}   170:c:=242;{Є}186:c:=243;{є}
178:{І}c:=246;{і}179:c:=247 ;
175:c:=244;{Ї}191:c:=245;{ї}
end; AnsiToAscChar:=chr(c);end; exports AnsiToAscChar;
{*}Function AnsiToAscString(s:string):String; var LengthS,c:Cardinal;
begin LengthS:=Length(S); If LengthS>0 then
begin For c:=1 to LengthS do s[c]:= AnsiToAscChar(s[c]); AnsiToAscString:=s; end; end;

сб, 19 апр. 2025 г. в 15:45, Ярослав Шевченко <dm7148620@gmail.com>:

0

16

Переходите на новую версию Gmail
Надежно, быстро и удобно
ОТКРЫТЬ
моя фінкція від ші
Ярослав Шевченко
{*}Function AscToAnsiChar(ch: char): char; {перетворення символа з псевдо-ASCII в ANSI} var c: Cardinal; begin c := Ord(ch); case c of 128..175: c ...
Ярослав Шевченко
Ось в цьому модулі, процедури і функції (абстракції як ти називаєш) якого в майбутньому будутьв case of емулятору. Це тільки частина команд які пра...
Ярослав Шевченко
От дивись такий момент: Кожна команда буде мати різну адресацію до пам*яті хочу зробити ось так case PC of ... 1: Mov(Adr1Byte,Adr1Byte); {для одно...
Ярослав Шевченко
пн, 21 апр. 2025 г. в 08:05, Ярослав Шевченко <dm7148620@gmail.com>:
Ярослав Шевченко
кому: я
2 дня назадПодробнее...
const
  ADDR_1BYTE = 0;
  ADDR_2BYTE = 1;
  ADDR_4BYTE = 2;
  ADDR_INVALID = 3;

function GetAddrMode(InfoByte: Byte): Byte;
begin
  Result := (InfoByte and $C0) shr 6;
end;

procedure DecodeAddress(var PC: LongInt; Memory: array of Byte; out Addr: LongWord);
var
  Mode: Byte;
begin
  Mode := GetAddrMode(Memory[PC]);
  Inc(PC);
  case Mode of
    ADDR_1BYTE: begin
      Addr := Memory[PC];
      Inc(PC, 1);
    end;
    ADDR_2BYTE: begin
      Addr := Memory[PC] or (Memory[PC + 1] shl 8);
      Inc(PC, 2);
    end;
    ADDR_4BYTE: begin
      Addr := Memory[PC] or (Memory[PC + 1] shl 8) or (Memory[PC + 2] shl 16) or (Memory[PC + 3] shl 24);
      Inc(PC, 4);
    end;
  else
    raise Exception.Create('Invalid addressing mode');
  end;
end;

0

17

Переходите на новую версию Gmail
Надежно, быстро и удобно
ОТКРЫТЬ
моя фінкція від ші
Ярослав Шевченко
кому: я
4 дня назадПодробнее...
{*}Function AscToAnsiChar(ch: char): char; {перетворення символа з псевдо-ASCII в ANSI}
var c: Cardinal;
begin
  c := Ord(ch);
  case c of
    128..175: c := c + 64;       // назад з діапазону 128–175
    224..239: c := c + 16;       // назад з 224–239

    124: c := 166;               // |
    240: c := 168;               // Ё
    241: c := 184;               // ё
    242: c := 170;               // Є
    243: c := 186;               // є
    244: c := 175;               // Ї
    245: c := 191;               // ї
    246: c := 178;               // І
    247: c := 179;               // і
  end;
  AscToAnsiChar := Chr(c);
end;

{*}Function AscToAnsiString(s: string): string;
var
  LengthS, c: Cardinal;
begin
  LengthS := Length(s);
  if LengthS > 0 then
  begin
    for c := 1 to LengthS do
      s[c] := AscToAnsiChar(s[c]);
    AscToAnsiString := s;
  end
  else
    AscToAnsiString := '';
end;

суббота, 19 апреля 2025 г. пользователь Ярослав Шевченко <dm7148620@gmail.com> написал:
{*}Function AnsiToAscChar(ch:char):char;{преобразование символа из Ansi в Asc}
var c:Cardinal;
begin  c:=ord(ch); case c of
192..239:begin c:=c-64;end; 240..255:begin c:=c-16;end;
166:c:=124;{¦}    168:c:=240;{Ё} 184:c:=241;{ё}   170:c:=242;{Є}186:c:=243;{є}
178:{І}c:=246;{і}179:c:=247 ;
175:c:=244;{Ї}191:c:=245;{ї}
end; AnsiToAscChar:=chr(c);end; exports AnsiToAscChar;
{*}Function AnsiToAscString(s:string):String; var LengthS,c:Cardinal;
begin LengthS:=Length(S); If LengthS>0 then
begin For c:=1 to LengthS do s[c]:= AnsiToAscChar(s[c]); AnsiToAscString:=s; end; end;

сб, 19 апр. 2025 г. в 15:45, Ярослав Шевченко <dm7148620@gmail.com>:
function AnsiToPseudoAscii(const s: string): string;
var
  i: Integer;
  c: Byte;
begin
  Result := '';
  for i := 1 to Length(s) do
  begin
    c := Ord(s[i]);
    case c of
      // Кирилиця велика
      $C0..$DF: Result := Result + Chr(c - $C0 + Ord('A'));
      // Кирилиця мала
      $E0..$FF: Result := Result + Chr(c - $E0 + Ord('a'));
      // Специфічні українські
      $A8, $B8: Result := Result + 'i'; // І, і
      $AF:     Result := Result + 'I'; // Ї
      $BF:     Result := Result + 'i'; // ї
      $A5:     Result := Result + 'E'; // Є
      $B5:     Result := Result + 'e'; // є
      $AA:     Result := Result + 'G'; // Ґ
      $BA:     Result := Result + 'g'; // ґ
    else
      Result := Result + s[i]; // Інші без змін
    end;
  end;
end;

Ярослав Шевченко
кому: я
3 дня назадПодробнее...
Ось в цьому модулі, процедури і функції (абстракції як ти називаєш) якого в майбутньому
будутьв case of емулятору.
Це тільки частина команд які працюють з байтами. Ті ж самі команди будуть для ворда
та кардиналом, (можливо й для інт64 теж). поки вони без case of, в режимі тестування.
Пам*ять Емулятора виглядає так:
RAM:array[0..(SizeRAMBytes-1)]of Byte;
RAMw:array[0..((SizeRAMBytes div 2)-1)]of word absolute RAM;
RAMc:array[0..((SizeRAMBytes div 4)-1)]of Cardinal absolute RAM;
тобто абсолютована типами "одна на  одну".
Ще поки не все є в interface.
Інше думаю не суть важливо.
Проаналізуй та скажи, чого тут явно, ну от зовсім явно не вистачає.
І загальний опис зроби.
Заздалегідь. дякую! :-)

unit uByte;

interface
uses uTypes;
Procedure VarByte(Var Bt:TByteEM);overload;
Procedure VarByte(Var Bt:TByteEM; Value:byte);overload;

procedure R(var Rg1:TByteEM;var Rg2:TByteEM);overload;
{+}
procedure P(var Rg1:TByteEM;var Rg2:TByteEM;var Rg3:TByteEM);overload;
procedure P(var Rg1:TByteEM;var Rg2:TByteEM;Value:byte);overload;

implementation
uses uLabel,Dialogs;

Procedure VarByte_(Var Bt:TByteEM);
begin
BeginAdrFreeByte;{налуштування першої вільної позиції для Byte }
SetBitArray(CountBeginAdrFreeByte,True);{зарезервована пам*ять, що розмічена}
Bt.LabelDataEM.LabelEM.Marked:=True;{Була розмічена LABELA, LABELP1,LABELP2 і т.д. , True - ТАК}
Bt.LabelDataEM.LabelEM.AddrOfMark:=CountBeginAdrFreeByte;// адреса початкова якщо маркована, тобто Marked=True}
end;

Procedure VarByte(Var Bt:TByteEM);overload;
begin
  If Bt.LabelDataEM.LabelEM.Marked=False {не була розмічена} then
Begin InitByte(Bt);VarByte_(Bt);
Bt.Value:=RAM[Bt.LabelDataEM.LabelEM.AddrOfMark];
end else  {ShowMessage('Повторна розмітка в VarByte');}end;

Procedure VarByte(Var Bt:TByteEM; Value:byte);overload;begin
  If Bt.LabelDataEM.LabelEM.Marked=False {не була розмічена} then
Begin InitByte(Bt);VarByte_(Bt);
RAM[Bt.LabelDataEM.LabelEM.AddrOfMark]:=Value;Bt.Value:=Value;
end else  {ShowMessage('Повторна розмітка в VarByte');}end;

procedure Used(var Rg1:TByteEM);overload;begin Rg1.LabelDataEM.LabelEM.Used:=True;end;{ставить мітку що використовується}
procedure Synhro(var Rg1:TByteEM);overload;begin Rg1.Value:=RAM[Rg1.LabelDataEM.LabelEM.AddrOfMark];end;{синхронізує з РАМ}
procedure UsedAndSynhro(var Rg1:TByteEM);overload;begin Rg1.LabelDataEM.LabelEM.Used:=True;Rg1.Value:=RAM[Rg1.LabelDataEM.LabelEM.AddrOfMark];end;
{=}
procedure R(var Rg1:TByteEM;var Rg2:TByteEM);overload;begin VarByte(Rg1);VarByte(Rg2);
RAM[Rg1.LabelDataEM.LabelEM.AddrOfMark]:=RAM[Rg2.LabelDataEM.LabelEM.AddrOfMark];
UsedAndSynhro(Rg1);UsedAndSynhro(Rg2);end;
procedure R(var Rg1:TByteEM;Value:byte);overload;begin VarByte(Rg1);
RAM[Rg1.LabelDataEM.LabelEM.AddrOfMark]:=Value;UsedAndSynhro(Rg1);end;
{Rg1:=RAM[Rg2]}
procedure Rmem(var Rg1:TByteEM;var Rg2:TByteEM);overload;begin VarByte(Rg1);VarByte(Rg2);
RAM[Rg1.LabelDataEM.LabelEM.AddrOfMark]:=RAM[RAM[Rg2.LabelDataEM.LabelEM.AddrOfMark]];
UsedAndSynhro(Rg1);UsedAndSynhro(Rg2);end;
{RAM[Rg1]:=Rg2]}
procedure memR(var Rg1:TByteEM;var Rg2:TByteEM);overload;begin VarByte(Rg1);VarByte(Rg2);
RAM[RAM[Rg1.LabelDataEM.LabelEM.AddrOfMark]]:=RAM[RAM[Rg2.LabelDataEM.LabelEM.AddrOfMark]];
UsedAndSynhro(Rg1);UsedAndSynhro(Rg2);end;
{+}
procedure P(var Rg1:TByteEM;var Rg2:TByteEM;var Rg3:TByteEM);overload;begin VarByte(Rg1);VarByte(Rg2);VarByte(Rg3);
RAM[Rg1.LabelDataEM.LabelEM.AddrOfMark]:=(RAM[Rg2.LabelDataEM.LabelEM.AddrOfMark]+RAM[Rg3.LabelDataEM.LabelEM.AddrOfMark]);
UsedAndSynhro(Rg1);UsedAndSynhro(Rg2);UsedAndSynhro(Rg3);end;
procedure P(var Rg1:TByteEM;var Rg2:TByteEM;Value:byte);overload;begin VarByte(Rg1);VarByte(Rg2);
RAM[Rg1.LabelDataEM.LabelEM.AddrOfMark]:=(RAM[Rg2.LabelDataEM.LabelEM.AddrOfMark]+Value);
UsedAndSynhro(Rg1);UsedAndSynhro(Rg2);end;
{-}
procedure M(var Rg1:TByteEM;var Rg2:TByteEM;var Rg3:TByteEM);overload;begin VarByte(Rg1);VarByte(Rg2);VarByte(Rg3);
RAM[Rg1.LabelDataEM.LabelEM.AddrOfMark]:=(RAM[Rg2.LabelDataEM.LabelEM.AddrOfMark]-RAM[Rg3.LabelDataEM.LabelEM.AddrOfMark]);
UsedAndSynhro(Rg1);UsedAndSynhro(Rg2);UsedAndSynhro(Rg3);end;
procedure M(var Rg1:TByteEM;var Rg2:TByteEM;Value:byte);overload;begin VarByte(Rg1);VarByte(Rg2);
RAM[Rg1.LabelDataEM.LabelEM.AddrOfMark]:=(RAM[Rg2.LabelDataEM.LabelEM.AddrOfMark]-Value);
UsedAndSynhro(Rg1);UsedAndSynhro(Rg2);end;
{AND}
procedure AND_(var Rg1:TByteEM;var Rg2:TByteEM;var Rg3:TByteEM);overload;begin VarByte(Rg1);VarByte(Rg2);VarByte(Rg3);
RAM[Rg1.LabelDataEM.LabelEM.AddrOfMark]:=(RAM[Rg2.LabelDataEM.LabelEM.AddrOfMark]AND RAM[Rg3.LabelDataEM.LabelEM.AddrOfMark]);
UsedAndSynhro(Rg1);UsedAndSynhro(Rg2);UsedAndSynhro(Rg3);end;
procedure AND_(var Rg1:TByteEM;var Rg2:TByteEM;Value:byte);overload;begin VarByte(Rg1);VarByte(Rg2);
RAM[Rg1.LabelDataEM.LabelEM.AddrOfMark]:=(RAM[Rg2.LabelDataEM.LabelEM.AddrOfMark]AND Value);
UsedAndSynhro(Rg1);UsedAndSynhro(Rg2);end;
{XOR}
procedure XOR_(var Rg1:TByteEM;var Rg2:TByteEM;var Rg3:TByteEM);overload;begin VarByte(Rg1);VarByte(Rg2);VarByte(Rg3);
RAM[Rg1.LabelDataEM.LabelEM.AddrOfMark]:=(RAM[Rg2.LabelDataEM.LabelEM.AddrOfMark]XOR RAM[Rg3.LabelDataEM.LabelEM.AddrOfMark]);
UsedAndSynhro(Rg1);UsedAndSynhro(Rg2);UsedAndSynhro(Rg3);end;
procedure XOR_(var Rg1:TByteEM;var Rg2:TByteEM;Value:byte);overload;begin VarByte(Rg1);VarByte(Rg2);
RAM[Rg1.LabelDataEM.LabelEM.AddrOfMark]:=(RAM[Rg2.LabelDataEM.LabelEM.AddrOfMark]XOR Value);
UsedAndSynhro(Rg1);UsedAndSynhro(Rg2);end;
{OR}
procedure OR_(var Rg1:TByteEM;var Rg2:TByteEM;var Rg3:TByteEM);overload;begin VarByte(Rg1);VarByte(Rg2);VarByte(Rg3);
RAM[Rg1.LabelDataEM.LabelEM.AddrOfMark]:=(RAM[Rg2.LabelDataEM.LabelEM.AddrOfMark]OR RAM[Rg3.LabelDataEM.LabelEM.AddrOfMark]);
UsedAndSynhro(Rg1);UsedAndSynhro(Rg2);UsedAndSynhro(Rg3);end;
procedure OR_(var Rg1:TByteEM;var Rg2:TByteEM;Value:byte);overload;begin VarByte(Rg1);VarByte(Rg2);
RAM[Rg1.LabelDataEM.LabelEM.AddrOfMark]:=(RAM[Rg2.LabelDataEM.LabelEM.AddrOfMark]OR Value);
UsedAndSynhro(Rg1);UsedAndSynhro(Rg2);end;

procedure not_(var Rg1:TByteEM); Begin
RAM[Rg1.LabelDataEM.LabelEM.AddrOfMark]:=(not(RAM[Rg1.LabelDataEM.LabelEM.AddrOfMark]));
UsedAndSynhro(Rg1);
end;

{shl}
procedure shl_(var Rg1:TByteEM;var Rg2:TByteEM;var Rg3:TByteEM);overload;begin VarByte(Rg1);VarByte(Rg2);VarByte(Rg3);
RAM[Rg1.LabelDataEM.LabelEM.AddrOfMark]:=(RAM[Rg2.LabelDataEM.LabelEM.AddrOfMark]shl RAM[Rg3.LabelDataEM.LabelEM.AddrOfMark]);
UsedAndSynhro(Rg1);UsedAndSynhro(Rg2);UsedAndSynhro(Rg3);end;
procedure shl_(var Rg1:TByteEM;var Rg2:TByteEM;Value:byte);overload;begin VarByte(Rg1);VarByte(Rg2);
RAM[Rg1.LabelDataEM.LabelEM.AddrOfMark]:=(RAM[Rg2.LabelDataEM.LabelEM.AddrOfMark]shl Value);
UsedAndSynhro(Rg1);UsedAndSynhro(Rg2);end;

{shr}
procedure shr_(var Rg1:TByteEM;var Rg2:TByteEM;var Rg3:TByteEM);overload;begin VarByte(Rg1);VarByte(Rg2);VarByte(Rg3);
RAM[Rg1.LabelDataEM.LabelEM.AddrOfMark]:=(RAM[Rg2.LabelDataEM.LabelEM.AddrOfMark]shr RAM[Rg3.LabelDataEM.LabelEM.AddrOfMark]);
UsedAndSynhro(Rg1);UsedAndSynhro(Rg2);UsedAndSynhro(Rg3);end;
procedure shr_(var Rg1:TByteEM;var Rg2:TByteEM;Value:byte);overload;begin VarByte(Rg1);VarByte(Rg2);
RAM[Rg1.LabelDataEM.LabelEM.AddrOfMark]:=(RAM[Rg2.LabelDataEM.LabelEM.AddrOfMark]shr Value);
UsedAndSynhro(Rg1);UsedAndSynhro(Rg2);end;

{CMP}Procedure Cmp(var Rg1:TByteEM;var Rg2:TByteEM);overload; begin Used(Rg1);
if RAM[Rg1.LabelDataEM.LabelEM.AddrOfMark] = RAM[Rg2.LabelDataEM.LabelEM.AddrOfMark]
then RAM[adrPZ]:=1 else RAM[adrPZ]:=0;{Z - признак нулевого результата: 1-нулевой результат,0-ненулевой результат. }
if RAM[Rg1.LabelDataEM.LabelEM.AddrOfMark] < RAM[Rg2.LabelDataEM.LabelEM.AddrOfMark]
then RAM[adrPS]:=1 else RAM[adrPS]:=0;end;{S - знак результата: 1-результат отрицательный,0-результат положительный. Фактически это содержимое старшего разряда результата.}
{CMPZ}Procedure CmpZ(var Rg1:TByteEM;var Rg2:TByteEM);overload;begin Used(Rg1);
if RAM[Rg1.LabelDataEM.LabelEM.AddrOfMark] = RAM[Rg2.LabelDataEM.LabelEM.AddrOfMark]
then RAM[adrPZ]:=1 else RAM[adrPZ]:=0;end;{Z - признак нулевого результата: 1-нулевой результат,0-ненулевой результат. }
{CMPS}Procedure CmpS(var Rg1:TByteEM;var Rg2:TByteEM);overload;begin Used(Rg1);
if RAM[Rg1.LabelDataEM.LabelEM.AddrOfMark] < RAM[Rg2.LabelDataEM.LabelEM.AddrOfMark]
then RAM[adrPS]:=1 else RAM[adrPS]:=0;end;{S - знак результата: 1-результат отрицательный,0-результат положительный. Фактически это содержимое старшего разряда результата.}

{CMP}Procedure Cmp(var Rg1:TByteEM;Value:byte);overload;begin Used(Rg1);
if RAM[Rg1.LabelDataEM.LabelEM.AddrOfMark] = Value then RAM[adrPZ]:=1 else RAM[adrPZ]:=0;{Z - признак нулевого результата: 1-нулевой результат,0-ненулевой результат. }
if RAM[Rg1.LabelDataEM.LabelEM.AddrOfMark] < Value then RAM[adrPS]:=1 else RAM[adrPS]:=0;end;{S - знак результата: 1-результат отрицательный,0-результат положительный. Фактически это содержимое старшего разряда результата.}
{CMPZ}Procedure CmpZ(var Rg1:TByteEM;Value:byte);overload;begin Used(Rg1);
if RAM[Rg1.LabelDataEM.LabelEM.AddrOfMark] = Value then RAM[adrPZ]:=1 else RAM[adrPZ]:=0;end;{Z - признак нулевого результата: 1-нулевой результат,0-ненулевой результат. }
{CMPS}Procedure CmpS(var Rg1:TByteEM;Value:byte);overload;begin Used(Rg1);
if RAM[Rg1.LabelDataEM.LabelEM.AddrOfMark] < Value then RAM[adrPS]:=1 else RAM[adrPS]:=0;end;{S - знак результата: 1-результат отрицательный,0-результат положительный. Фактически это содержимое старшего разряда результата.}

Function GotoUn0:Boolean;begin    if RAM[adrPZ] = 1 then begin Result:=true end else Result:=false;{P}end;
Function GotoUnNot0:Boolean;begin if RAM[adrPZ] = 0 then begin Result:=true end else Result:=false;{P}end;
Function GotoUnM:Boolean;begin if RAM[adrPS] = 1 then begin Result:=true end else Result:=false;{P}end;
Function GotoUnP:Boolean;begin if RAM[adrPS] = 0 then begin Result:=true end else Result:=false;{P}end;

Function CallUn0:Boolean;begin    if RAM[adrPZ] = 1 then begin Result:=true end else Result:=false;{P}end;
Function CallUnNot0:Boolean;begin if RAM[adrPZ] = 0 then begin Result:=true end else Result:=false;{P}end;
Function CallUnM:Boolean;begin if RAM[adrPS] = 1 then begin Result:=true end else Result:=false;{P}end;
Function CallUnP:Boolean;begin if RAM[adrPS] = 0 then begin Result:=true end else Result:=false;{P}end;

Function RetUn0:Boolean;begin    if RAM[adrPZ] = 1 then begin Result:=true end else Result:=false;{P}end;
Function RetUnNot0:Boolean;begin if RAM[adrPZ] = 0 then begin Result:=true end else Result:=false;{P}end;
Function RetUnM:Boolean;begin if RAM[adrPS] = 1 then begin Result:=true end else Result:=false;{P}end;
Function RetUnP:Boolean;begin if RAM[adrPS] = 0 then begin Result:=true end else Result:=false;{P}end;

//RAMc:array[0..((SizeRAMBytes div 4)-1)]of Cardinal;
{Push}Procedure Push(var Rg1:TByteEM);overload;begin RAMc[adrSP]:=RAMc[adrSP]-1; RAMc[RAMc[adrSP]]:=RAM[Rg1.LabelDataEM.LabelEM.AddrOfMark];end;
{Push}Procedure Push(Value:byte);overload;begin RAMc[adrSP]:=RAMc[adrSP]-1; RAMc[RAMc[adrSP]]:=Value;end;

{Pop}Procedure Pop(var Rg1:TByteEM);overload;begin RAM[Rg1.LabelDataEM.LabelEM.AddrOfMark]:=(RAMc[adrSP] and $FF);RAMc[adrSP]:=RAMc[adrSP]+1; end;

//procedure goto_(Adr1:Byte);begin MyRAM[adrRgPC]:=Adr1; end;

end.


сб, 19 апр. 2025 г. в 16:25, Ярослав Шевченко <dm7148620@gmail.com>:
Ярослав Шевченко
кому: я
2 дня назадПодробнее...
От дивись такий момент:
Кожна команда буде мати різну адресацію до пам*яті
хочу зробити ось так
case PC of ...
1: Mov(Adr1Byte,Adr1Byte); {для однобайтиних адресів 0..255}
2: case (PC+1) of
         1:Mov(Adr1Word,Adr1Word); {для двубайтиних адресів 0..65535}
         2:Mov(Adr1Byte3,AdrByte3); {для трибайтних адресів 0..16777215}
         3:Mov(Adr1DWord,AdrDWord); {для чотирьохбайтних  адресів 0..4294967296}
         end; {case of}
....
end; {case of}         
Чи є сенс так робити ? Чим меньше адресація тим швидше буде виклик.
Може які адресації викинути ? наприклад 1байт та 3 байти ?

вс, 20 апр. 2025 г. в 22:43, Ярослав Шевченко <dm7148620@gmail.com>:
Ярослав Шевченко
кому: я
2 дня назадПодробнее...

пн, 21 апр. 2025 г. в 08:05, Ярослав Шевченко <dm7148620@gmail.com>:
!.txt
Ярослав Шевченко
кому: я
2 дня назадПодробнее...
const
  ADDR_1BYTE = 0;
  ADDR_2BYTE = 1;
  ADDR_4BYTE = 2;
  ADDR_INVALID = 3;

function GetAddrMode(InfoByte: Byte): Byte;
begin
  Result := (InfoByte and $C0) shr 6;
end;

procedure DecodeAddress(var PC: LongInt; Memory: array of Byte; out Addr: LongWord);
var
  Mode: Byte;
begin
  Mode := GetAddrMode(Memory[PC]);
  Inc(PC);
  case Mode of
    ADDR_1BYTE: begin
      Addr := Memory[PC];
      Inc(PC, 1);
    end;
    ADDR_2BYTE: begin
      Addr := Memory[PC] or (Memory[PC + 1] shl 8);
      Inc(PC, 2);
    end;
    ADDR_4BYTE: begin
      Addr := Memory[PC] or (Memory[PC + 1] shl 8) or (Memory[PC + 2] shl 16) or (Memory[PC + 3] shl 24);
      Inc(PC, 4);
    end;
  else
    raise Exception.Create('Invalid addressing mode');
  end;
end;

0

18

Переходите на новую версию Gmail
Надежно, быстро и удобно
ОТКРЫТЬ
(без темы)
Ярослав Шевченко
кому: я
20 часов назадПодробнее...
uses CRT;

begin
  ClrScr;
  TextColor(White);
  GotoXY(1,1); Write(#218); for i := 2 to 78 do Write(#196); Write(#191);
  for i := 2 to 24 do begin
    GotoXY(1,i); Write(#179);
    GotoXY(80,i); Write(#179);
  end;
  GotoXY(1,25); Write(#192); for i := 2 to 78 do Write(#196); Write(#217);
end.

0

19

Переходите на новую версию Gmail
Надежно, быстро и удобно
ОТКРЫТЬ
(без темы)
Ярослав Шевченко
кому: я
19 часов назадПодробнее...
uses CRT;

var
  x: Integer;
begin
  ClrScr;
  x := 1;
  while not KeyPressed do
  begin
    GotoXY(x, 10);
    Write('*');
    Delay(100);
    GotoXY(x, 10);
    Write(' ');
    Inc(x);
    if x > 80 then x := 1;
  end;
end.






uses CRT;

var
  i: Integer;
begin
  ClrScr;
  for i := 1 to 20 do
  begin
    TextColor(Random(15)+1);
    GotoXY(10, 10);
    Write('Hello from console!');
    Delay(100);
  end;
end.



uses CRT;

var
  x: Integer;
  ch: Char;
begin
  ClrScr;
  x := 40;
  repeat
    GotoXY(x, 12);
    Write('^');
    ch := ReadKey;
    GotoXY(x, 12);
    Write(' ');
    case ch of
      #75: Dec(x); // ←
      #77: Inc(x); // →
    end;
  until ch = #27; // ESC для виходу
end.



uses CRT;

var
  x, y: Integer;
begin
  ClrScr;
  for y := 1 to 25 do
    for x := 1 to 80 do
    begin
      GotoXY(x, y);
      Write(Char(Random(94) + 33)); // символи від ! до ~
      Delay(1);
    end;
end.



uses CRT;

var
  i: Integer;
begin
  ClrScr;
  Randomize;
  for i := 1 to 100 do
  begin
    GotoXY(Random(80)+1, Random(25)+1);
    TextColor(Random(15)+1);
    Write(IntToHex(Random(256), 2));
    Delay(50);
  end;
end.








Ярослав Шевченко
кому: я
5 часов назадПодробнее...

вт, 22 апр. 2025 г. в 23:30, Ярослав Шевченко <dm7148620@gmail.com>:
!.txt

0

20

  • Автор: 44е

О, старий добрий **консольний режим у Delphi 7** — то майже як DOS, але в костюмі з Windows NT. Ось список основних функцій і можливостей, які ти можеш використати:

---

### **1. Вивід тексту**
- `Write()` / `Writeln()` — класика, як у Turbo Pascal. 
- Можна писати українською, якщо кодова сторінка дозволяє (про це нижче).

---

### **2. Введення**
- `Read()` / `Readln()` — для читання з клавіатури. 
- Також можна опитувати натискання клавіш через `ReadKey` (через `crt` або WinAPI).

---

### **3. Керування кольорами (через WinAPI)**
Можна змінювати кольори тексту та фону в консолі:

код:

 
 
```pascal
SetConsoleTextAttribute(GetStdHandle(STD_OUTPUT_HANDLE), FOREGROUND_GREEN or BACKGROUND_BLUE);
```

---

### **4. Керування курсором**
- `SetConsoleCursorPosition()` — переміщення курсора по екрану. 
- `GetConsoleCursorInfo()` / `SetConsoleCursorInfo()` — зміна вигляду курсора.

---

### **5. Очищення екрану**
- Прямої `ClrScr` немає (як у TP), але можна зробити вручну через WinAPI — залити весь буфер пробілами.

---

### **6. Обробка клавіш (без Enter)**
- `ReadConsoleInput()` або `GetAsyncKeyState()` — для ловлі клавіш. 
- Можна зробити повноцінну систему типу меню чи навіть клавіатурну панель.

---

### **7. Робота з українськими літерами**
- Встановити кодову сторінку:
 
код:

 
 
```pascal
SetConsoleOutputCP(866); // або 1251 — що треба
SetConsoleCP(866);
```

- А потім спокійно писати `"Привіт, світе!"`

---

### **8. Робота з псевдографікою**
- Використовуються символи ASCII (від 176 до 219, наприклад). 
- Можна будувати рамки, віконця, меню — усе як у доброму Borland'і.

---

### **9. Робота з мишею**
- Через WinAPI (так, можна!), опитування `ReadConsoleInput` на події миші. 
- Можна ловити клацання, положення і навіть коліщатко.

---

### **10. Динамічне оновлення екрана (типу real-time)**
- Через `GotoXY()`-подібну поведінку і перерисовку елементів. 
- Підходить для створення інтерфейсів, навіть псевдо-анімацій.

---

Якщо хочеш, я можу накидати тобі **готові процедури** типу `GotoXY`, `TextColor`, `DrawBox`, `WaitKey`, `MouseClick` — свій такий "CRT-лайт" модуль під Windows-консоль.

Не забудь написати "дяка"

0

Ответить
Страница:   1 2 3 4 … 9  

Быстрый ответ

Напишите ваше сообщение и нажмите «Отправить»


Вы здесь » EnotVM » Тестовый форум » 08 БИТ