Форум программистов
 

Восстановите пароль или Зарегистрируйтесь на форуме, о проблемах и с заказом рекламы пишите сюда - alarforum@yandex.ru, проверяйте папку спам!

Вернуться   Форум программистов > IT форум > Помощь студентам
Регистрация

Восстановить пароль
Повторная активизация e-mail

Купить рекламу на форуме - 42 тыс руб за месяц

Ответ
 
Опции темы Поиск в этой теме
Старый 25.03.2007, 23:16   #1
HAMMAN
Пользователь
 
Аватар для HAMMAN
 
Регистрация: 09.01.2007
Сообщений: 92
Восклицание Перевод с Паскаля на Дельфи!.

Помогите перебить программу на Паскале под Дельфи!.
Данная программа Азбука Морзе!.

uses crt;
const
morse : array [128..159] of string[4]=('.- ','-...','.---','--. ',
'-.. ','. ','...-','--..',
'.. ','.---','-.- ','.-..',
'-- ','-. ','--- ','.--.',
'.-. ','... ','- ','..- ',
'..-.','....','-.-.','---.',
'----','--.-','-..-','-.--',
'-..-','..-.','..--','.-.-'
);
Tone=100;
L1=50;
L2=100;
L3=50;
L4=100;
L5=150;
Var
mes:String;
sim:String[4];
znak:String[1];
i,j:Integer;
Begin
ClrScr;
Writeln('***’Телеграф***');
Writeln('Введите сообщение');
Writeln('Используя только большие буквы');
Write(' ');
Readln(mes);
for i:=1 to Length(mes) do
Begin
if (mes[i]>='А')and(mes[i] <='Я') then
Begin
sim:=morse[ord(mes[i])];
j:=1;
repeat
if (sim[j]='-')or(sim[j]='.') then
Begin
Write(sim[j]);
sound(10000);
case sim[j] of
'.':Delay(10000);
'.':Delay(10000);
'-':Delay(10000);
'-':Delay(10000);
end;
NoSound;
Delay(10000);
Delay(10000);
end;
j:=j+1;
until ((sim[j]=' ') or (j>4));
delay(1000);
end
else
if mes[i]=' ' then
Begin
Write(' ');
Delay(10000);
end;
end;
Writeln;
Writeln('‘Сообщение передано!. ');
Writeln('Для завершения нажмите Enter');
REadln;

end.
HAMMAN вне форума Ответить с цитированием
Старый 26.03.2007, 10:17   #2
Гришас
 
Регистрация: 14.03.2007
Сообщений: 9
По умолчанию

А в чем проблема? Создаешь форму, вместо writeln'ов три капшена(TCaption) вместо readln Edit. Кидаешь кнопку. В обработчик события OnClick - свою программу. Вместо последних writeln'ов еще один капшен или messagedlg. Синтаксис узнай в Helpe. Сообщение выводи в еще одном Edit'е.Все.
Возможности компьютера ограничены интеллектом программиста.
Гришас вне форума Ответить с цитированием
Старый 29.03.2007, 22:10   #3
HAMMAN
Пользователь
 
Аватар для HAMMAN
 
Регистрация: 09.01.2007
Сообщений: 92
По умолчанию

Чтоөто вроде я сделал, а она всё равно не работает!.
Подскажите, где там ошибки?.

var
Form1: TForm1;
mes:String; {сообщение}
sim:String[4]; {символ в кодировке Морзе - последоваиельность точек и тире}
znak:String[1]; {"передаваемый" знак - тире или точка }
i,j:Integer; {номер символа и знака}
sound,delay:Integer;
implementation

{$R *.dfm}

procedure TForm1.Button1Click(Sender: TObject);
const
morse : array [128..159] of string[4]=('.- ','-...','.---','--. ',{А,Б,В,Г}
'-.. ','. ','...-','--..',{Д,Е,Ж,З}
'.. ','.---','-.- ','.-..',{И,Й,К,Л}
'-- ','-. ','--- ','.--.',{М,Н,О,П}
'.-. ','... ','- ','..- ',{Р,С,Т,У}
'..-.','....','-.-.','---.',{Ф,Х,Ц,Ч}
'----','--.-','-..-','-.--',{Ш,Щ,Ъ,Ы}
'-..-','..-.','..--','.-.-'{Ь,Э,Ю,Я}
);
{параметры передачи}
Tone=100; {частота сигнала (гц)}
L1=50; {длительность(мс) "точки"}
L2=100; {длительность(мс) "тире"}
L3=50; {пауза (мс) между точками и тире одной буквы}
L4=100; {пауза (мс) между буквами}
L5=150; {пауза (мс) между словами}
begin
Edit1.Text:=' ';
Edit2.Text:='mes';
for i:=1 to Length(mes) do
Begin
if (mes[i]>='А')and(mes[i] <='Я') then
Begin

{определим код очередной буквы (ф-я ORD) сообщения
и получим из таблицы кодировки соответсвующий
элемент массива - последовательность точек и тире }

sim:=morse[ord(mes[i])];
j:=1;
repeat
if (sim[j]='-')or(sim[j]='.') then
Begin
Edit2.Text:=(sim[j]);
sound(10000);
case sim[j] of
'.':Delay(10000);
'.':Delay(10000);
'-':Delay(10000);
'-':Delay(10000);
end;
NoSound;
Delay(10000);
Delay(10000);
end;
j:=j+1;
until ((sim[j]=' ') or (j>4));
delay(1000); {пауза между буквами}
end
else
if mes[i]=' ' then {пробел между словами}
Begin
Edit2.Text:=' '; {пробел между словами сообщения}
Delay(10000);
end;
end;
Label4.Caption:='Сообщение передано';
Label5.Caption:='Для завершения работы с программой нажмите','<Enter>');
end.
end;

end.
HAMMAN вне форума Ответить с цитированием
Старый 29.03.2007, 23:35   #4
mihali4
*
Старожил
 
Регистрация: 22.11.2006
Сообщений: 9,201
По умолчанию

Вот что получилось у меня (только что проверил, работает на ура):
(кое-что выкинул...)

procedure TForm1.Button6Click(Sender: TObject);
const
morse : array [192..223] of string[4]=('.- ','-...','.---','--. ',{А,Б,В,Г}
'-.. ','. ','...-','--..',{Д,Е,Ж,З}
'.. ','.---','-.- ','.-..',{И,Й,К,Л}
'-- ','-. ','--- ','.--.',{М,Н,О,П}
'.-. ','... ','- ','..- ',{Р,С,Т,У}
'..-.','....','-.-.','---.',{Ф,Х,Ц,Ч}
'----','--.-','-..-','-.--',{Ш,Щ,Ъ,Ы}
'-..-','..-.','..--','.-.-'{Ь,Э,Ю,Я}
);
{параметры передачи}
Tone=1000; {частота сигнала (гц)}
L1=200; {длительность(мс) "точки"}
L2=500; {длительность(мс) "тире"}
L3=500; {пауза (мс) между точками и тире одной буквы}
L4=1000; {пауза (мс) между буквами}
L5=1500; {пауза (мс) между словами}
var mes,sim: string;
i,j,dl: integer;
begin
Edit1.Text:=' ';
mes:=Edit2.Text;
for i:=1 to Length(mes) do
Begin
if (mes[i]>='А')and(mes[i] <='Я') then
Begin

{определим код очередной буквы (ф-я ORD) сообщения
и получим из таблицы кодировки соответсвующий
элемент массива - последовательность точек и тире }

sim:=morse[Ord(mes[i])];
for j:=1 to 4 do
begin
dl:=0; //длительность звукового сигнала
case sim[j] of
'-': dl:=L2; //длительность тире
'.': dl:=L1; //длительность точки
end;
if dl>0 then
Windows.Beep(Tone,dl);
Sleep(L3); // пауза между точками, тире, пробелами
end;
Sleep(L4); {пауза между буквами}
end
else
if mes[i]=' ' then {пробел между словами}
Sleep(L5);
end;
end;
mihali4 вне форума Ответить с цитированием
Старый 30.03.2007, 08:07   #5
HAMMAN
Пользователь
 
Аватар для HAMMAN
 
Регистрация: 09.01.2007
Сообщений: 92
По умолчанию

Спасибо она вроде работает, но можно еще добавить, чтобы она помимо сигнала выдавала ещё и эти самые "тире -точки",например В Edit2
и ещё - программа зависает при запуске и озвучка идёт непрерывно!.Можно ли сделать так чтобы озвучка проходила только один раз?.
HAMMAN вне форума Ответить с цитированием
Старый 30.03.2007, 14:23   #6
mihali4
*
Старожил
 
Регистрация: 22.11.2006
Сообщений: 9,201
По умолчанию

Цитата:
Сообщение от HAMMAN Посмотреть сообщение
Спасибо она вроде работает, но можно еще добавить, чтобы она помимо сигнала выдавала ещё и эти самые "тире -точки",например В Edit2
и ещё - программа зависает при запуске и озвучка идёт непрерывно!.Можно ли сделать так чтобы озвучка проходила только один раз?.
Я не знаю, чему там "виснуть".
Мне нравится даже, только в таком темпе:
procedure TForm1.Button6Click(Sender: TObject);
const
morse : array [192..223] of string[4]=('.- ','-...','.---','--. ',{А,Б,В,Г}
'-.. ','. ','...-','--..',{Д,Е,Ж,З}
'.. ','.---','-.- ','.-..',{И,Й,К,Л}
'-- ','-. ','--- ','.--.',{М,Н,О,П}
'.-. ','... ','- ','..- ',{Р,С,Т,У}
'..-.','....','-.-.','---.',{Ф,Х,Ц,Ч}
'----','--.-','-..-','-.--',{Ш,Щ,Ъ,Ы}
'-..-','..-.','..--','.-.-'{Ь,Э,Ю,Я}
);
{параметры передачи}
Tone=800; {частота сигнала (гц)}
L1=50; {длительность(мс) "точки"}
L2=100; {длительность(мс) "тире"}
L3=50; {пауза (мс) между точками и тире одной буквы}
L4=150; {пауза (мс) между буквами}
L5=200; {пауза (мс) между словами}
var mes,sim: string;
i,j,dl: integer;
begin
Edit2.SetFocus;
mes:=AnsiUpperCase(Edit2.Text);
for i:=1 to Length(mes) do
Begin
if (mes[i]>='А')and(mes[i] <='Я') then
Begin
Edit2.SelStart:=i-1;
Edit2.SelLength:=1;
{определим код очередной буквы (ф-я ORD) сообщения
и получим из таблицы кодировки соответсвующий
элемент массива - последовательность точек и тире }
sim:=morse[Ord(mes[i])];
Edit1.Text:=sim;
Application.ProcessMessages;
for j:=1 to 4 do
begin
dl:=0; //длительность звукового сигнала
case sim[j] of
'-': dl:=L2; //длительность тире
'.': dl:=L1; //длительность точки
end;
if dl>0 then
Windows.Beep(Tone,dl);
Sleep(L3); // пауза между точками, тире, пробелами
end;
Sleep(L4); {пауза между буквами}
end
else
if mes[i]=' ' then {пробел между словами}
Sleep(L5);
end;
Edit2.SelStart:=0;
Edit2.SelLength:=0;
Application.ProcessMessages;
end;

В Edit1 - обозначение букливицы в азбуке Морзе, в Edit2 - показывает озвучиваемую в данный момент букливицу...
mihali4 вне форума Ответить с цитированием
Старый 31.03.2007, 23:13   #7
HAMMAN
Пользователь
 
Аватар для HAMMAN
 
Регистрация: 09.01.2007
Сообщений: 92
По умолчанию

СПАСИБО ВАМ!.ПРОГРАММА РАБОТАЕТ!!!
HAMMAN вне форума Ответить с цитированием
Старый 01.04.2007, 11:05   #8
zetrix
Delphi/C++/C#
Участник клуба
 
Аватар для zetrix
 
Регистрация: 29.10.2006
Сообщений: 1,972
По умолчанию

Раньше как-то не думал... Интересная прога
Я чтоб услышать результат 10 минут провозился с подключением внутреннего динамика (вилки небыло)
zetrix вне форума Ответить с цитированием
Старый 07.05.2010, 20:57   #9
tinka13
Новичок
Джуниор
 
Регистрация: 07.05.2010
Сообщений: 2
По умолчанию Помогите пожалуйста! Перевести с Паскали или Делфи на С# программу азбука морзе

Помогите пожалуйста! Перевести с Паскали или Делфи на С# программу азбука морзе
tinka13 вне форума Ответить с цитированием
Старый 17.01.2012, 23:49   #10
Varis777
Новичок
Джуниор
 
Регистрация: 17.01.2012
Сообщений: 1
По умолчанию

Код:
var
i,j,q,k,w,maxel,minel,n,m,fl:integer; //i,j,q,k,w-индексы циклов,  maxel,minel-максимальный и минимальный элемент в строке, n,m-размерность матрицы,fl- флаг
a:array[1..100,1..100]of integer;  //выделяем память под массив
begin
  writeln('Введите размерность nxm');
  readln(n,m);
  randomize;
  for i:=1 to n do
   begin
    for j:=1 to m do
     begin
     read(a[i,j]);
      {a[i,j]:=random (10); }
     end;
   end;
//вывод матрицы
 for i:=1 to n do
   begin
    for j:=1 to m do
     begin
        write(a[i,j],'  ');
     end;
     writeln;
   end;


for i:=1 to n do  //НАЧАЛО ГЛАВНОГО ЦИКЛА

 begin

  //находим в строке максимальный и минимальный элемент
   maxel:=-101;
    minel:=101;
    //в цикле ищем максимальный и минимальный элемент в строке i
    /////////
 for j:=1 to m do
   begin
   if (a[i,j]>maxel) then
     begin
      maxel:=a[i,j];
     end;
      if (a[i,j]<minel) then
     begin
      minel:=a[i,j];
     end;
  end;
  writeln;
  ////////////////////////
  //для максимального(ных) элемента(ов)  в строке  проверяем минимальный(ые) ли он(и) в столбце
  //на данный момент имеем максимальный и минимальный элемент с текущей строке
  
  //пошли по элементам этой строки и ищем элементы,равные максимальному
  for k:=i to i do
    begin
   for q:=1 to m do
     begin
     
       if a[k,q]=maxel then //если нашли равный элемент(будет включаться и сам максимальный)то проверяем минимальный(ые)ли он(они) в столбце(ах)
         begin
         
                for w:= 1 to n do //перебираем строки в столбце,где находится максимальный элеменет(или равный ему)
                  begin
                  fl:=0;  //поднимаем флаг
                  
                   if (a[w,q]< maxel) then //если найдется с столбце элемент меньше нашего(по условию максимальный
                   //элемент в строке должен быть минимальным в столбце)то выходим из цикла и пойдем искать дальше элементы
                   //в текщей строке, равные максимальному.
                    begin
                      fl:=0;
                      break;
                    end
                   else  //если не нашлось в столбце элемента меньше максимального в строке тио поднимаем флаг
                     begin
                        fl:=1;
                     end;
                  end;
                  if (fl=1) then   //если флаг остался поднятым то   выводим эту координату,она будет седловой точкой
                      begin
                       writeln('[',k,'; ',q,']');
                      end;
                  
         end;
     end;
   end;


//здесь то же самое что и при поиске максимального ,
//только ищем элементы равные минимальному и если найдем,то проверяем максимальные ли они столбце
   for k:=i to i do
    begin
   for q:=1 to m do
     begin
       if a[k,q]=minel then
         begin
            for w:= 1 to n do
             begin
             fl:=0;
                if (a[w,q]> minel) then
                    begin
                      fl:=0;
                      break;
                    end
                else
                   begin
                        fl:=1;
                   end;
             end;
             if (fl=1) then
                  begin
                       writeln('[',k,'; ',q,']');
                  end;
         end;
     end;
   end;


end;//КОНЕЦ ГЛАВНОГО ЦИКЛА
writeln('\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\');

end.


___________
Код нужно оформлять по правилам:
тегом [CODE]..[/СODE] (это кнопочка с решёточкой #)
Не забывайте об этом!
Модератор.

Последний раз редактировалось Serge_Bliznykov; 18.01.2012 в 11:19.
Varis777 вне форума Ответить с цитированием
Ответ


Купить рекламу на форуме - 42 тыс руб за месяц



Похожие темы
Тема Автор Раздел Ответов Последнее сообщение
Перевод из Паскаля в Делфи Родион Общие вопросы Delphi 2 28.08.2008 16:52
Русификация паскаля Exact Паскаль, Turbo Pascal, PascalABC.NET 7 21.03.2008 14:15
Знатоки Паскаля ХЕЛП!!!! cornholio Помощь студентам 7 09.12.2007 11:38
Настройка паскаля Snake_ua Паскаль, Turbo Pascal, PascalABC.NET 7 18.10.2007 17:56
перенос с паскаля на си Ядовитый Общие вопросы C/C++ 2 29.06.2007 13:17