xD

unit MainUnit;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
  Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.ExtCtrls, Vcl.Imaging.pngimage,
  Vcl.StdCtrls, Vcl.Imaging.jpeg, FMX.Media, Vcl.Menus;

type
  TWelcomeWindow = class(TForm)
    Logo: TImage;
    SendButton: TButton;
    GetButton: TButton;
    Label1: TLabel;
    ExtendedInfo: TPopupMenu;
    Info: TMainMenu;
    N1: TMenuItem;
    N2: TMenuItem;
    procedure SendButtonClick(Sender: TObject);
    procedure GetButtonClick(Sender: TObject);
  private
    { Private declarations }
  public
    Mic: TAudioCaptureDevice;
  end;

var
  WelcomeWindow: TWelcomeWindow;

implementation

uses SendWindow, GetWindow;

{$R *.dfm}

procedure TWelcomeWindow.GetButtonClick(Sender: TObject);
begin
    GetParcel.ShowModal;
end;

procedure TWelcomeWindow.SendButtonClick(Sender: TObject);
begin
    SendParcel.ShowModal;
end;

end.
=================================================================
unit SendWindow;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
  Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls, Bass, Vcl.Menus,
  Vcl.Imaging.jpeg, Vcl.ExtCtrls, Vcl.ComCtrls;

type
  TSendParcel = class(TForm)
    InputEdit: TEdit;
    VarOfChose: TComboBox;
    InfoLabel: TLabel;
    TextLabel: TLabel;
    OpenDialog1: TOpenDialog;
    GoButton: TButton;
    Logo: TImage;
    Info: TMainMenu;
    ExtendedInfo: TPopupMenu;
    N1: TMenuItem;
    N2: TMenuItem;
    N3: TMenuItem;
    N4: TMenuItem;
    SaveDialog1: TSaveDialog;
    ProgressBar: TProgressBar;
    procedure VarOfChoseChange(Sender: TObject);
    procedure GoButtonClick(Sender: TObject);
    procedure InputEditChange(Sender: TObject);
    procedure InputEditKeyPress(Sender: TObject; var Key: Char);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  SendParcel: TSendParcel;
  Path: String;

implementation

{$R *.dfm}

uses MainUnit;


procedure TSendParcel.FormClose(Sender: TObject; var Action: TCloseAction);
begin
    InputEdit.Visible := False;
    TextLabel.Visible := False;
    GoButton.Visible := False;
    GoButton.Enabled := False;
    ProgressBar.Visible := False;
    VarOFChose.ItemIndex := -1;
end;

procedure PlaySound (Frequancy : Cardinal);
Const
    Duration = 400;
begin
   Winapi.Windows.Beep(Frequancy, Duration);
end;

procedure TSendParcel.GoButtonClick(Sender: TObject);
var
    DataLength, I, MinAsciiCode, Gap, Proc: Integer;
    Data : String;
Const
    MIN_FREQ = 1000;
    STEP = 20;
begin
    Data := InputEdit.Text;
    DataLength := Length(InputEdit.Text);
    MinAsciiCode := Ord(Data[1]);
    For I := Low(Data) to High(Data) - 1 Do
    begin
        If Ord(Data[I+1]) < Ord(Data[I]) then
            MinAsciiCode := Ord(Data[I+1]);
    end;
    ProgressBar.Visible := True;
    For I := Low(Data) to High(Data) Do
    begin
        Gap := Ord(Data[I]) - MinAsciiCode;
        PlaySound(1000 + STEP * Gap);
        Proc := ((I * 100) div DataLength - 1);
        ProgressBar.Position := Proc;
        Application.ProcessMessages;
    end;
    ProgressBar.Position := 100;
end;


procedure TSendParcel.InputEditChange(Sender: TObject);
begin
    If Length(InputEdit.Text) > 0 then
        GoButton.Enabled := True
    else
        GoButton.Enabled := False;
end;

procedure TSendParcel.InputEditKeyPress(Sender: TObject; var Key: Char);
begin
    If (Key = #13) and (GoButton.Enabled) then
        GoButton.Click
end;

procedure TSendParcel.VarOfChoseChange(Sender: TObject);
Const
    STR_INPUT = 0;
    IMAGE_INPUT = 1;
begin
    if VarOFChose.ItemIndex = STR_INPUT then
    begin
        InputEdit.Visible := True;
        TextLabel.Visible := True;
        GoButton.Visible := True;
    end;
    if VarOFChose.ItemIndex = IMAGE_INPUT then
    begin
         MessageBox(SendParcel.Handle, Pchar('Дорогой пользователь, функция передачи картинок будет реализована в ближайшем будущем. Спасибо за понимание.'), 'Извинения', MB_ICONINFORMATION);
         VarOfChose.ItemIndex := -1;
    end;
end;

end.
=========================================================
unit GetWindow;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
  Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls, MMSystem,
  Vcl.Imaging.pngimage, Vcl.ExtCtrls, Vcl.Menus, MainUnit, Bass, BassEnc, BassEnc_MP3;

type
  TGetParcel = class(TForm)
    RecordButton: TButton;
    StopRecordButton: TButton;
    Logo: TImage;
    ShowResultsButton: TButton;
    MainMenu1: TMainMenu;
    PopupMenu1: TPopupMenu;
    ResultEdit: TEdit;
    PlayButton: TButton;
    procedure FormDestroy(Sender: TObject);
    procedure RecordButtonClick(Sender: TObject);
    procedure StopRecordButtonClick(Sender: TObject);
    procedure PlayButtonClick(Sender: TObject);
    procedure ShowResultsButtonClick(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  GetParcel: TGetParcel;
  Channel: HRECORD;

implementation

{$R *.dfm}


function RecordingCallback(Handle: HRECORD; buffer: Pointer; length: DWORD; user: Pointer): boolean; stdcall;
begin
    Result := True;
end;

procedure ListenSurrounding ();
var
    IsCorrect : Boolean;
begin
    IsCorrect := False;
    if BassEncMP3_IsAvailable and BASS_IsAvailable then
       IsCorrect := True
    else
        MessageBox(GetParcel.Handle, Pchar('Что-то пошло неверным образом..'), 'Извинения', MB_ICONSTOP);
    If IsCorrect then
    begin
        if not BASS_RecordInit(-1) then
            ShowMessage('Cannot start default recording device!')
        else
        begin
            Channel:= BASS_RecordStart(44100, 2, 0, @RecordingCallback, nil);
            if Channel = 0 then
                ShowMessage('Couldn''t start recording!')
            else
            begin
                BASS_Encode_MP3_StartFile(Channel, '', BASS_ENCODE_AUTOFREE or BASS_UNICODE, PChar('запись.mp3'));
            end;
        end;
    end;
end;

procedure TGetParcel.PlayButtonClick(Sender: TObject);
begin
    BASS_ChannelPlay(Channel,True);
end;

procedure TGetParcel.RecordButtonClick(Sender: TObject);
begin
    ListenSurrounding();
    StopRecordButton.Enabled := True;
end;

procedure TGetParcel.ShowResultsButtonClick(Sender: TObject);
begin
    ResultEdit.Visible := True;
    ResultEdit.Text := 'Привет мир';
end;

procedure TGetParcel.StopRecordButtonClick(Sender: TObject);
begin
    BASS_ChannelStop(Channel);
    BASS_RecordFree;
    PlayButton.Enabled := True;
    ShowResultsButton.Enabled := True;
    RecordButton.Caption := 'Повторить прослушивание';
end;

procedure TGetParcel.FormClose(Sender: TObject; var Action: TCloseAction);
begin
    StopRecordButton.Enabled := False;
    PlayButton.Enabled := False;
    ShowResultsButton.Enabled := False;
    ResultEdit.Visible := False;
    ResultEdit.Text := '';
end;

procedure TGetParcel.FormDestroy(Sender: TObject);
begin
    BASS_RecordFree;
    BASS_Free;
end;

end.