Paster Fob
А у Вас системная кодировка консоли какая?
Модератор: Модераторы
Максим писал(а):Проверяйте кодировку файла исходного кода (должна быть UTF-8). Правая кнопка мыши -> Параметры файла -> Кодировка.Директив типа {$CODEPAGE UTF8} и вызовов SetConsoleCP(); в программе быть НЕ должно.Если проблема не решится, выкладывайте полный тестовый проект, демонстрирующий её.
Vadim писал(а):А у Вас системная кодировка консоли какая?
Paster Fob писал(а):Об этом по подробнее.
Uses Windows;
Begin
WriteLn(GetConsoleCP);
WriteLn(GetConsoleOutputCP);
End.
Vadim писал(а):Paster Fob писал(а):Об этом по подробнее.
- Код: Выделить всё
Uses Windows;
Begin
WriteLn(GetConsoleCP);
WriteLn(GetConsoleOutputCP);
End.
Что выдаёт?
Vadim писал(а):Вот мой пример:
1. Открываю Lazarus;
2. "Создать проект... -> Консольное приложение";
3. На открывшемся тексте шаблона программы щёлкаю правой кнопкой мышки и выбираю в меню "Параметры файла -> Кодировка -> CP866";
4. Пишу в программе что надо с WriteLn\readLn;
5. Запускаю.
Всё пучком.
Vadim писал(а):У Вас в консоли системная кодировка СР1251. Ставьте её.
Paster Fob писал(а):где ставить?
Vadim писал(а):В окне текста программы нажимаете правую кнопку мыши, выбираете в меню... и так далее, я уже описывал.
program Ren_filter;
{$mode objfpc}{$H+}
uses crt, dos, renxfiltrus;
var infil,outfil: text;
q: string; {q - без разницы}
begin
q:=xfil_ruslazdos('Шишки падали в лесу',true); {<-проход через фильтр №1, true-вывести на экран, false-не выводить на экран}
q:=xfil_rusDosTxt(q,false); {<-проход через фильтр №2}
xfil_ruslazdos('Начало записи',true); {<-Работает как Write('');}
assign(outfil,'C:\ren.txt'); {<-начало вывода в файл, после фильтра}
rewrite(outfil);
writeln(outfil,q);
close(outfil);
xfil_ruslazdos('Конец записи',true);
xfil_ruslazdos('Начало чтения',true);
assign(infil,'C:\ren.txt'); {<-начало чтения с файла, после записи}
reset(infil);
readln(infil,q);
close(infil);
xfil_ruslazdos('Конец чтения',true);
xfil_rusTxtDos(q,true); {<-проход через фильтр №3}
readln;
end.
unit renxfiltrus;
{$mode objfpc}{$H+}
interface
uses Classes, SysUtils, crt, dos;
function xfil_rusLazDos(xfiltrLazDos: string; n: bytebool): string;
function xfil_rusDosTxt(xfiltrDosTxt: string; n: bytebool): string;
function xfil_rusTxtDos(xfiltrTxtDos: string; n: bytebool): string;
implementation
function xfil_rusLazDos(xfiltrLazDos: string; n: bytebool): string;
var w: array[0..65] of string[3] = ('А','Б','В','Г','Д','Е','Ё','Ж','З','И',
'Й','К','Л','М','Н','О','П','Р','С','Т','У','Ф','Х','Ц','Ч','Ш','Щ',
'Ъ','Ы','Ь','Э','Ю','Я','а','б','в','г','д','е','ж','з','и','й','к',
'л','м','н','о','п','ё','р','с','т','у','ф','х','ц','ч','ш','щ','ъ',
'ы','ь','э','ю','я');
e: array[0..65] of byte = (128,129,130,131,132,133,240,134,135,136,137,138,
139,140,141,142,143,144,145,146,147,148,149,150,151,152,153,154,155,
156,157,158,159,160,161,162,163,164,165,166,167,168,169,170,171,172,
173,174,175,241,224,225,226,227,228,229,230,231,232,233,234,235,236,
237,238,239);
r: byte;
q: string[3];
a,s,d,f: char;
z,x,c,v: integer;
b: string;
begin
r:=0;
z:=1;
b:=xfiltrLazDos;
xfiltrLazDos:='';
while z<=length(b) do
begin
x:=1;
a:=b[z];
c:=z+1;
s:=b[c];
q:=a+s;
if a=chr(208) then
begin
for r:=0 to 48 do if q=w[r] then d:=chr(e[r]);
x:=2;
end;
if a=chr(209) then
begin
for r:=49 to 65 do if q=w[r] then d:=chr(e[r]);
x:=2
end;
if a=chr(226) then
begin
v:=z+2;
f:=b[v];
q:=a+s+f;
if q='№' then d:=chr(252);
x:=3
end;
if a<chr(127) then d:=a;
xfiltrLazDos:=xfiltrLazDos+d;
xfil_rusLazDos:=xfiltrLazDos;
inc(z,x);
end;
if n=true then write(xfiltrLazDos);
end;
function xfil_rusDosTxt(xfiltrDosTxt: string; n: bytebool): string;
var a: char;
z,x: integer;
b: string;
begin
z:=1;
b:=xfiltrDosTxt;
xfiltrDosTxt:='';
while z<=length(b) do
begin
a:=b[z];
if a>chr(127) then
begin
x:=ord(a);
if x=252 then x:=121;
if x=240 then x:=104;
if x=241 then x:=120;
if x<=175 then a:=chr(ord(x)+64);
if x>=176 then a:=chr(ord(x)+16);
end;
xfiltrDosTxt:=xfiltrDosTxt+a;
xfil_rusDosTxt:=xfiltrDosTxt;
inc(z);
end;
if n=true then write(xfiltrDosTxt);
end;
function xfil_rusTxtDos(xfiltrTxtDos: string; n: bytebool): string;
var a: char;
z,x: integer;
b: string;
begin
z:=1;
b:=xfiltrTxtDos;
xfiltrTxtDos:='';
while z<=length(b) do
begin
a:=b[z];
if a>chr(127) then
begin
x:=ord(a);
if x=168 then x:=256;
if x=184 then x:=257;
if x=185 then x:=268;
if x>=192 then a:=chr(ord(x)-64);
if x>=240 then a:=chr(ord(x)-16);
end;
xfiltrTxtDos:=xfiltrTxtDos+a;
xfil_rusTxtDos:=xfiltrTxtDos;
inc(z);
end;
if n=true then write(xfiltrTxtDos);
end;
end.
Paster Fob писал(а):Поменял Lazarus v1.0 на Lazarus v1.0.2 и...о чудо,всё заработало!
Vadim писал(а):Ситуация знакомая.В Lazarus почему-то финальная версия всегда работает хуже, чем тестовая, т.е. пересобираемая каждый день. Исключений я ещё не видел.
Vadim писал(а):Ситуация знакомая.В Lazarus почему-то финальная версия всегда работает хуже, чем тестовая, т.е. пересобираемая каждый день. Исключений я ещё не видел.
Сейчас этот форум просматривают: Google [Bot] и гости: 246