VPF::Стандартные Memo, edit, button, timer - Форум программистов

Pakshin A. S.

Дата 16.8.2005, 10:03 (ссылка)

(нет голосов)

Загрузка ...

Эксперт

Профиль
Группа: Участник Клуба
Сообщений: 5056
Регистрация: 16.2.2003

Репутация: 21
Всего: 61

Поправочка на описание множества: вместо круглых скобок должны стоять квадратные...
Добавлено @ 10:06
Добавление в функцию GetNo():
В конце ее тела нуно добавить inc(Result), т. е. будем иметь:

Код


function GetNo(c: char):integer;
var
 i:char;
begin
 Result:=0;
 i:='а';
 while i < c do
  begin
   if i in sogl
    then
     inc(Result);
   i:=succ(i);
  end;
 inc(Result); // Вот это
end;

Добавлено @ 10:07
Если в описание множества вместо согласных кинуть гласные, то код будет работать и для гласных... если в описание множества кинуть вообще все буквы, то код будет работать как тот, что был ранее (со всеми буквами)...

Pakshin A. S.

Дата 16.8.2005, 11:32 (ссылка)

(нет голосов)

Загрузка ...

Эксперт

Профиль
Группа: Участник Клуба
Сообщений: 5056
Регистрация: 16.2.2003

Репутация: 21
Всего: 61

Еще вариант:

Код


type
 CodesL = 36; // Скока тама у нас букв в алфавите?
 Code = string[2];

const
 Codes: array [1..CodesL] of Code = ('ая', 'кп', {и т. п.})

function CodeChar(c: char):char;
var
 i:integer;
 b:boolean;
begin
 i:=1;
 b:=false;
 while (i <= CodesL) and (not b) do
  begin
   b:=Copy(Codes[i], 1, 1) = c;
   inc(i);
  end;
 if b
  then
   Result:=Copy(Codes[i-1], 2, 1);
end;

fucntion DeCodeChar(c: char):char;
var
 i:integer;
 b:boolean;
begin
 i:=1;
 b:=false;
 while (i <= CodesL) and (not b) do
  begin
   b:=Copy(Codes[i], 2, 1) = c;
   inc(i);
  end;
 if b
  then
   Result:=Copy(Codes[i-1], 1, 1);
end;

Пример юзания:

Код


var
 c:char;
begin
 c:='a';
 ShowMessage(c);
 c:=CodeChar(c);
 ShowMessage(c);
 c:=DeCodeChar(c);
 ShowMessage(c);
end;

Итого можно в абсолютно произвольном порядке делать пары, где первый символ - символ, который кодируется, а второй символ - код, в который переходит символ...

Если символ должен оставаться без изменения, то мы пишем пару "аа", а если нам нужно превратить символ "а" в другой символ, то пишем пару "ак".

vovan430

Дата 16.8.2005, 11:33 (ссылка)

(нет голосов)

Загрузка ...

Шустрый

Профиль
Группа: Участник
Сообщений: 70
Регистрация: 13.8.2005
Где: Иркутская обл. г. Тайшет

Репутация: нет
Всего: нет

как сделать чтоб заменялись только согласные по алгоритму
б - щ
в - ш
г - ч
д - ц
ж - х
з - ф
к - т
л - с
м - р
н - п

А гласные оставались неизменными. С 2-мя Memo и с Button как в первом случае где а на я б на ю и т.д smile

Pakshin A. S.

Дата 16.8.2005, 11:35 (ссылка)

(нет голосов)

Загрузка ...

Эксперт

Профиль
Группа: Участник Клуба
Сообщений: 5056
Регистрация: 16.2.2003

Репутация: 21
Всего: 61

Цитата(vovan430 @ 16.8.2005, 12:33)

Смотри пост от 16.8.2005, 12:32 по Москве
Добавлено @ 11:36
Все вышеизложенное применяется с первым способом вместо формулы...

vovan430

Дата 16.8.2005, 11:56 (ссылка)

(нет голосов)

Загрузка ...

Шустрый

Цитата(Pakshin @ 16.8.2005, 11:35)

Цитата(vovan430 @ 16.8.2005, 12:33)

И куда этот вышеизложенный код вставлять?

Код


type
 CodesL = 36; // Скока тама у нас букв в алфавите?
 Code = string[2];

const
 Codes: array [1..CodesL] of Code = ('ая', 'кп', {и т. п.})

function CodeChar(c: char):char;
var
 i:integer;
 b:boolean;
begin
 i:=1;
 b:=false;
 while (i <= CodesL) and (not b) do
  begin
   b:=Copy(Codes[i], 1, 1) = c;
   inc(i);
  end;
 if b
  then
   Result:=Copy(Codes[i-1], 2, 1);
end;

fucntion DeCodeChar(c: char):char;
var
 i:integer;
 b:boolean;
begin
 i:=1;
 b:=false;
 while (i <= CodesL) and (not b) do
  begin
   b:=Copy(Codes[i], 2, 1) = c;
   inc(i);
  end;
 if b
  then
   Result:=Copy(Codes[i-1], 1, 1);
end;

Куда это?

Код


var
 c:char;
begin
 c:='a';
 ShowMessage(c);
 c:=CodeChar(c);
 ShowMessage(c);
 c:=DeCodeChar(c);
 ShowMessage(c);
end;

А это куда?
Добавлено @ 11:57
И Кда эти коды вставлять в button или куда ? Не могу понять.

Pakshin A. S.

Дата 16.8.2005, 12:04 (ссылка)

(нет голосов)

Загрузка ...

Эксперт

Профиль
Группа: Участник Клуба
Сообщений: 5056
Регистрация: 16.2.2003

Репутация: 21
Всего: 61

Вот:

Код



implementation

<...>

type
 CodesL = 36; // Скока тама у нас букв в алфавите?
 Code = string[2];

const
 Codes: array [1..CodesL] of Code = ('ая', 'кп', {и т. п.})

function CodeChar(c: char):char;
var
 i:integer;
 b:boolean;
begin
 i:=1;
 b:=false;
 while (i <= CodesL) and (not b) do
  begin
   b:=Copy(Codes[i], 1, 1) = c;
   inc(i);
  end;
 if b
  then
   Result:=Copy(Codes[i-1], 2, 1);
end;

fucntion DeCodeChar(c: char):char;
var
 i:integer;
 b:boolean;
begin
 i:=1;
 b:=false;
 while (i <= CodesL) and (not b) do
  begin
   b:=Copy(Codes[i], 2, 1) = c;
   inc(i);
  end;
 if b
  then
   Result:=Copy(Codes[i-1], 1, 1);
end;

procedure TForm1.Button1Click(Sender: TObject);
var
 i:integer;
begin
 for i:=1 to Length(Memo1.Text) do
  if Memo1.Text[i] in ['а'..'я']
   then
    Memo2.Text:=Memo2.Text + CodeChar(Memo1.Text[i])
   else
    Memo2.Text:=Memo2.Text + Memo1.Text[i]
end;

<...>

end.

Понятно?

vovan430

Дата 16.8.2005, 12:11 (ссылка)

(нет голосов)

Загрузка ...

Шустрый

А ты у себя проверил? программу. У меня выдаёт ошибку на ; после 36
CodesL = 36; // Скока тама у нас букв в алфавите?

Это сообщение отредактировал(а) vovan430 - 16.8.2005, 12:13

Pakshin A. S.

Дата 16.8.2005, 12:13 (ссылка)

(нет голосов)

Загрузка ...

Эксперт

Профиль
Группа: Участник Клуба
Сообщений: 5056
Регистрация: 16.2.2003

Репутация: 21
Всего: 61

Цитата(vovan430 @ 16.8.2005, 13:11)

У меня выдаёт ошибку на ; после 36

дай код
Добавлено @ 12:15
тьфу... эту хрень в констуту нужно было поставить... убери из типов и сунь в описание констнт перед описанием массива...

vovan430

Дата 16.8.2005, 12:42 (ссылка)

(нет голосов)

Загрузка ...

Шустрый

Такая тема получилась

Код


unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls;

type
  TForm1 = class(TForm)
    Memo1: TMemo;
    Memo2: TMemo;
    Button1: TButton;
    procedure Button1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

type

 Code = string[2];

const
 Codes: array [1..CodesL] of Code = ('ая', 'кп',)
 CodesL = 36; // Скока тама у нас букв в алфавите?
function CodeChar(c: char):char;
var
 i:integer;
 b:boolean;
begin
 i:=1;
 b:=false;
 while (i <= CodesL) and (not b) do
  begin
   b:=Copy(Codes[i], 1, 1) = c;
   inc(i);
  end;
 if b
  then
   Result:=Copy(Codes[i-1], 2, 1);
end;

fucntion DeCodeChar(c: char):char;
var
 i:integer;
 b:boolean;
begin
 i:=1;
 b:=false;
 while (i <= CodesL) and (not b) do
  begin
   b:=Copy(Codes[i], 2, 1) = c;
   inc(i);
  end;
 if b
  then
   Result:=Copy(Codes[i-1], 1, 1);
end;


procedure TForm1.Button1Click(Sender: TObject);
begin
var
 i:integer;
begin
 for i:=1 to Length(Memo1.Text) do
  if Memo1.Text[i] in ['а'..'я']
   then
    Memo2.Text:=Memo2.Text + CodeChar(Memo1.Text[i])
   else
    Memo2.Text:=Memo2.Text + Memo1.Text[i]
end;

end;

end.

Но не работает опять теперь ошибка
Codes: array [1..CodesL] of Code = ('ая', 'кп',)

Pakshin A. S.

Дата 16.8.2005, 12:53 (ссылка)

(нет голосов)

Загрузка ...

Эксперт

Профиль
Группа: Участник Клуба
Сообщений: 5056
Регистрация: 16.2.2003

Репутация: 21
Всего: 61

vovan430
Ты только вчера начал программировать? И еще внимательней читай, что я пишу...

Код


const
 CodesL = 36; 
 Codes: array [1..CodesL] of Code = {Я за тебя не собираюсь писать все пары для кода... сам пиши}('ая', 'кп',)

Romikgy

Дата 16.8.2005, 13:34 (ссылка)

(нет голосов)

Загрузка ...

Любитель-программер

Профиль
Группа: Участник Клуба
Сообщений: 7326
Регистрация: 11.5.2005
Где: Porto Franco Odes sa

Репутация: 26
Всего: 146

А полный список букв в буквы можно увидеть???

--------------------

Владение русской орфографией это как владение кунг-фу — истинные мастера не применяют его без надобности.

Pakshin A. S.

Дата 16.8.2005, 14:03 (ссылка)

(нет голосов)

Загрузка ...

Эксперт

Профиль
Группа: Участник Клуба
Сообщений: 5056
Регистрация: 16.2.2003

Репутация: 21
Всего: 61

Цитата(Romikgy @ 16.8.2005, 14:34)

А полный список букв в буквы можно увидеть???

К кому вопрос?

Вот.. делать нефига было... составил произвольный код

Код


CodesL = 32;
Codes: array [1..CodesL] of Code = (
'йю',
'цб',
'уь',
'кт',
'еи',
'нм',
'гс',
'шч',
'щя',
'зэ',
'хж',
'ъд',
'фл',
'ыо',
'вр',
'ап'
'па',
'рв',
'оы',
'лф',
'дъ',
'жх',
'эз',
'щя',
'шч',
'гс',
'нм',
'еи',
'кт',
'уь',
'цб',
'йю',
);

Romikgy

Дата 16.8.2005, 14:13 (ссылка)

(нет голосов)

Загрузка ...

Любитель-программер

Профиль
Группа: Участник Клуба
Сообщений: 7326
Регистрация: 11.5.2005
Где: Porto Franco Odes sa

Репутация: 26
Всего: 146

Цитата(Pakshin @ 16.8.2005, 14:03)

К кому вопрос?

К автору темы!!!

--------------------

Владение русской орфографией это как владение кунг-фу — истинные мастера не применяют его без надобности.

vovan430

Дата 16.8.2005, 15:10 (ссылка)

(нет голосов)

Загрузка ...

Шустрый

А теперь ошибка сдесь

Код


 Result:=Copy(Codes[i-1], 2, 1);

После ;

Pakshin A. S.

Дата 16.8.2005, 15:45 (ссылка)

(нет голосов)

Загрузка ...

Эксперт

Профиль
Группа: Участник Клуба
Сообщений: 5056
Регистрация: 16.2.2003

Репутация: 21
Всего: 61

Код


   Result:=Copy(Codes[i-1], 2, 1)[1];

Также и во второй функции...

0 Пользователей читают эту тему (0 Гостей и 0 Скрытых Пользователей)
0 Пользователей:
« Предыдущая тема \| Delphi: Общие вопросы \| Следующая тема »