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

Вниз

Радикальное решение.   Найти похожие ветки 

← →
DiamondShark ©   (2004-12-09 14:09) [0]

Субж вопросов типа: "А почему у меня в консоли кракозябры и как с ними бороться".


unit conio;

interface

implementation

uses
 Windows;

// To avoid importing SysUtils
const
 fmClosed = $D7B0;
 fmInput  = $D7B1;
 fmOutput = $D7B2;
 fmInOut  = $D7B3;

type
 PTextBuf = ^TTextBuf;
 TTextBuf = array[0..127] of Char;
 TTextRec = packed record
   Handle: Integer;
   Mode: Integer;
   BufSize: Cardinal;
   BufPos: Cardinal;
   BufEnd: Cardinal;
   BufPtr: PChar;
   OpenFunc: Pointer;
   InOutFunc: Pointer;
   FlushFunc: Pointer;
   CloseFunc: Pointer;
   case integer of
     0: (OldOpenFunc, OldInOutFunc, OldFlushFunc, OldCloseFunc: Pointer);
     1: (
       UserData: array[1..32] of Byte;
       Name: array[0..259] of Char;
       Buffer: TTextBuf);
 end;

 TTextFunc = function(var F: TTextRec): Integer;

function InOutFunc(var F: TTextRec): Integer;
begin
 case F.Mode of
   fmOutput: begin
     AnsiToOemBuff(F.BufPtr, F.BufPtr, F.BufPos);
     Result := TTextFunc(F.OldInOutFunc)(F);
   end;
   fmInput: begin
     Result := TTextFunc(F.OldInOutFunc)(F);
     if F.BufEnd > 0 then
       OemToAnsiBuff(F.BufPtr, F.BufPtr, F.BufEnd);
   end;
 else
   Result := TTextFunc(F.OldFlushFunc)(F);
 end;
end;

function FlushFunc(var F: TTextRec): Integer;
begin
 case F.Mode of
   fmOutput: begin
     AnsiToOemBuff(F.BufPtr, F.BufPtr, F.BufPos);
     Result := TTextFunc(F.OldFlushFunc)(F);
   end;
 else
   Result := TTextFunc(F.OldFlushFunc)(F);
 end;
end;

function OpenFunc(var F: TTextRec): Integer;
begin
 Result := TTextFunc(F.OldOpenFunc)(F);
 with F do
   begin
     OldInOutFunc := InOutFunc;
     OldFlushFunc := FlushFunc;
     OldCloseFunc := CloseFunc;
     InOutFunc := @conio.InOutFunc;
     FlushFunc := @conio.FlushFunc;
   end;
end;

procedure InitConsoleIO;
begin
 with TTextRec(Output) do
   begin
     OldOpenFunc := OpenFunc;
     OpenFunc := @conio.OpenFunc;
   end;
 with TTextRec(Input) do
   begin
     OldOpenFunc := OpenFunc;
     OpenFunc := @conio.OpenFunc;
   end;
end;

initialization
 InitConsoleIO;

end.


Для побеждения кракозябров просто прописать первым в uses проекта.

---

← →
}|{yk ©   (2004-12-09 15:38) [1]

А CP866-U это сработает?

---

← →
DiamondShark ©   (2004-12-09 16:04) [2]

> }|{yk ©   (09.12.04 15:38) [1]
> А CP866-U это сработает?

Если именно она в твоей ОС страница OEM, то да.

---

← →
jack128 ©   (2004-12-09 17:02) [3]

не мог ты прояснить, чем отличаются TTextRec.BufPos от BufEnd? У меня получалось, что они всегда равны

---

← →
DiamondShark ©   (2004-12-09 17:24) [4]

> jack128 ©   (09.12.04 17:02) [3]

BufPos -- текущая позиция в буфере внутри write/writeln.
BufEnd -- текущая позиция буфере внутри драйвера.
Т.е. BufPos -- входной параметр драйвера, BufEnd -- выходной.

А то, что они равны -- побочный эффект внутренней реализации write/read и нас не трогает.

---

Страницы: 1 вся ветка

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

Наверх

Память: 0.45 MB
Время: 0.038 c