Азбука морзе

[Pasha_Sh]

unit Unit1;

interface

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

type
  TForm1 = class(TForm)
    Button1: TButton;
    Button2: TButton;
    Button3: TButton;
    Gen1: TGen;
    Edit1: TEdit;
    Edit2: TEdit;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure Button3Click(Sender: TObject);
    procedure Edit1Change(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;
   const letters= 'ÿàáâãäåæçèéêëìíîïðñòóôõö÷øùûüýþ1234567890,.;:?¹\"@()!-';
      codes: array[0..53]of string =('.-','-...','.--','--.','-..','.','...-','--..','..','.---',
                                     '-.-','.-..','--','-.','---','.--.','.-.','...','-','..-',
                                     '..-.','....','-.-.','---.','----','--.-','-.--','-..-','..-..','..--',
                                     '.-.-',
                                     '.----','..---','...--','....-','.....','-....','--...','---..','----.','-----',
                                     '.-.-.-','......','-.-.-','---...','..--..','-..-.','.-..-.','.----.','-.--.-','--..--','-.--.-','--..--',
                                     '-....-'
                                     );
var
  Form1: TForm1;
  str: string;

implementation

{$R *.dfm}


procedure TForm1.Button3Click(Sender: TObject);
var
i:integer;
begin
for i:=1 to length(str) do begin
if str[i]='.' then begin gen1.Duration:=50;  gen1.PlayADSR end;
if str[i]='-' then begin gen1.Duration:=350; gen1.PlayADSR end;
if str[i]=' ' then sleep(350);

end;
end;
procedure TForm1.Edit1Change(Sender: TObject);
var i,n: integer;
begin
if edit1.Text<>'' then begin
str:= '';
for i:=0 to length(edit1.Text) do begin
n:= pos(lowercase(edit1.Text[i]),letters);
if n<>0 then str:= str + codes[n-1] + ' '
end;
edit2.Text:=str;
end;
end;
end.

Вроде как всё работает, но траблы с проигрыванием звука, он совсем не такой, который нужен.
Помогите исправить пожалуйста.

P.S. gen компонент, для выведения звука.

[Xardas]

Возможно, звук не успевает проигрываться, как уже начинается следующая итерация цикла. Нужно дать возможность звуку проиграться до конца перед началом следующего шага цикла

[Pasha_Sh]

Куда меньше? это какой-то не звук уже получается
может есть другие компоненты этому подобные?
или лучше с динамика на мат плате звук проигрывать?

[Xardas]

Вы меня, наверное, не поняли...

...
for i:=1 to length(str) do begin
if str[i]='.' then begin gen1.Duration:=50;  gen1.PlayADSR end;
....

В то время пока проигрывается звук, начинает выполняться следующая итерация цикла, то есть получается, что звуки друг на друга как бы накладываются... Попробуйте после gen1.PlayADSR выставить задержку и посмотрите результат

[Pasha_Sh]

Сообщение от Xardas

Вы меня, наверное, не поняли...

...
for i:=1 to length(str) do begin
if str[i]='.' then begin gen1.Duration:=50;  gen1.PlayADSR end;
....

В то время пока проигрывается звук, начинает выполняться следующая итерация цикла, то есть получается, что звуки друг на друга как бы накладываются... Попробуйте после gen1.PlayADSR выставить задержку и посмотрите результат

Спасибо большое, работает.
Вопрос, как это всё сделать без ф-и sleep, ато программа зависает, как то не очень так

[phomm]

Можно сделать так

for i := 1 to 10 do 
begin
  sleep(10);
  application.processmessages;
end;

это будет аналогично sleep(100) но без зависаний

[Pasha_Sh]

Сообщение от phomm

Можно сделать так

for i := 1 to 10 do 
begin
  sleep(10);
  application.processmessages;
end;

это будет аналогично sleep(100) но без зависаний

не катит

[raxp]

...а что ж вы TC не спросите автора утилиты, откуда сдерт код ? А автор пишет: "...пишите, задавайте вопросы."

Ок, добавляем таймер, чуть меняем последовательность, метод воспроизведения и частоту:

var i: integer = 0;

procedure TForm1.Image1Click(Sender: TObject);
begin
 TIMER1.Enabled:= TRUE
end;

procedure TForm1.Timer1Timer(Sender: TObject);
begin
 gen1.ResetAM;
 gen1.Prepare;
 gen1.Frequency:= 500;

 INC(I); if i> length(slovo) then begin
   timer1.Enabled:= false;
   i:= 0
 end;

 if slovo[i]= '.' then begin gen1.Duration:=100;  gen1.Play end;
 if slovo[i]= '-' then begin gen1.Duration:= timer1.Interval; gen1.Play end
end;

[Pasha_Sh]

Сообщение от raxp

...а что ж вы TC не спросите автора утилиты, откуда сдерт код ? А автор пишет: "...пишите, задавайте вопросы."

Ок, добавляем таймер, чуть меняем последовательность, метод воспроизведения и частоту:

var i: integer = 0;

procedure TForm1.Image1Click(Sender: TObject);
begin
 TIMER1.Enabled:= TRUE
end;

procedure TForm1.Timer1Timer(Sender: TObject);
begin
 gen1.ResetAM;
 gen1.Prepare;
 gen1.Frequency:= 500;

 INC(I); if i> length(slovo) then begin
   timer1.Enabled:= false;
   i:= 0
 end;

 if slovo[i]= '.' then begin gen1.Duration:=100;  gen1.Play end;
 if slovo[i]= '-' then b]egin gen1.Duration:= timer1.Interval; gen1.Play end
end;

Код нашел через яндекс, ненужное себе я выкинул. Если это Ваш, то спасибо. Вам! И простите.