курса4

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,  ShellApi, Vcl.Menus;

type
  TWelcomeWindow = class(TForm)
    Logo: TImage;
    SendButton: TButton;
    GetButton: TButton;
    Info: TMainMenu;
    N1: TMenuItem;
    N2: TMenuItem;
    Telegram: TImage;
    GitHub: TImage;
    VK: TImage;
    LinkedIn: TImage;
    procedure SendButtonClick(Sender: TObject);
    procedure GetButtonClick(Sender: TObject);
    procedure N1Click(Sender: TObject);
    procedure N2Click(Sender: TObject);
    procedure TelegramClick(Sender: TObject);
    procedure VKClick(Sender: TObject);
    procedure GitHubClick(Sender: TObject);
    procedure LinkedInClick(Sender: TObject);
    procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
  private
    { Private declarations }
  public
  end;

var
  WelcomeWindow: TWelcomeWindow;

implementation

uses SendWindow, GetWindow;

{$R *.dfm}

procedure TWelcomeWindow.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
begin
  CanClose := Application.MessageBox('Вы действительно хотите выйти?', 'Выход', MB_YESNO + MB_ICONQUESTION) = ID_YES;
end;

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

procedure TWelcomeWindow.TelegramClick(Sender: TObject);
begin
    ShellExecute(Handle, 'open', 'https://t.me/kirks_wah_wah', Nil, Nil, SW_SHOW);
end;

procedure TWelcomeWindow.VKClick(Sender: TObject);
begin
    ShellExecute(Handle, 'open', 'https://vk.com/cortad810', Nil, Nil, SW_SHOW);
end;

procedure TWelcomeWindow.GitHubClick(Sender: TObject);
begin
    ShellExecute(Handle, 'open', 'https://github.com/Vladislav8653', Nil, Nil, SW_SHOW);
end;

procedure TWelcomeWindow.LinkedInClick(Sender: TObject);
begin
    ShellExecute(Handle, 'open', 'https://www.linkedin.com/in/alex-melnikov-691a67257/', Nil, Nil, SW_SHOW);
end;

procedure TWelcomeWindow.N1Click(Sender: TObject);
Const
    STR1 = 'Здравствуйте, дорогой пользователь. Эта программа передает информацию (текст) с одного ПК на другой (другие).';
    STR2 = 'Для того, чтобы использовать Ваш компьютер как приёмник, нажмите кнопку "получить".';
    STR3 = 'Для того, чтобы использовать Ваш компьютер как передатчик, нажмите кнопку "передать"';
    A = #13#10;
begin
    Application.MessageBox(STR1 + A + STR2 + A + STR3, 'Помощь', 0);
end;

procedure TWelcomeWindow.N2Click(Sender: TObject);
begin
    Application.MessageBox('Арефин Владислав гр.251004', 'Разрабочик', 0);
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;
    GoBinaryButton: TButton;
    PSLabel: TLabel;
    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);
    procedure N2Click(Sender: TObject);
    procedure N4Click(Sender: TObject);
    procedure N3Click(Sender: TObject);
    procedure GoBinaryButtonClick(Sender: TObject);
    procedure CreateListOfSound (Data : String);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

type
    PList = ^TNode;
    TNode = record
        Next : PList;
        Data : Integer;
    end;

    PNode = ^TTreeNode;
    TTreeNode = record
        ch: Char;
        freq: Integer;
        left, right: PNode;
    end;

    TPriorityQueue = record
        nodes: array of PNode;
        count: Integer;
    end;

    TCharFrequency = record
        ch: Char;
        freq: Integer;
    end;

    THuffmanCode = record
        codeMap: array [Char] of string;
  end;

var
  SendParcel: TSendParcel;
  Path, Data : String;
  List : PList;
  IsFileOpen : Boolean;

implementation

{$R *.dfm}

uses MainUnit, GetWindow;

procedure InitializePriorityQueue(var pq: TPriorityQueue);
begin
    SetLength(pq.nodes, 256);
    pq.count := 0;
end;

procedure Enqueue(var pq: TPriorityQueue; node: PNode);
var
    i: Integer;
begin
    i := pq.count;
    while (i > 0) and (node.freq < pq.nodes[i - 1].freq) do
    begin
        pq.nodes[i] := pq.nodes[i - 1];
        Dec(i);
    end;
    pq.nodes[i] := node;
    Inc(pq.count);
end;

function Dequeue(var pq: TPriorityQueue): PNode;
begin
    if pq.count > 0 then
    begin
        Result := pq.nodes[0];
        Dec(pq.count);
        Move(pq.nodes[1], pq.nodes[0], pq.count * SizeOf(PNode));
    end
    else
        Result := nil;
end;

procedure BuildHuffmanTree(const text: string; var root: PNode);
var
    freq: array [Char] of Integer;
    ch: Char;
    i: Integer;
    node: PNode;
    pq: TPriorityQueue;
begin
    for ch := Low(Char) to High(Char) do
        freq[ch] := 0;

    for i := 1 to Length(text) do
        Inc(freq[text[i]]);

    InitializePriorityQueue(pq);

    for ch := Low(Char) to High(Char) do
    begin
        if freq[ch] > 0 then
        begin
            New(node);
            node.ch := ch;
            node.freq := freq[ch];
            node.left := nil;
            node.right := nil;
            Enqueue(pq, node);
        end;
    end;

    while pq.count > 1 do
    begin
        New(node);
        node.left := Dequeue(pq);
        node.right := Dequeue(pq);
        node.freq := node.left.freq + node.right.freq;
        Enqueue(pq, node);
    end;

    root := Dequeue(pq);
end;

procedure EncodeData(node: PNode; const str: string; var huffmanCode: THuffmanCode);
begin
    if node = nil then
        Exit;

    if (node^.left = nil) and (node^.right = nil) then
        huffmanCode.codeMap[node^.ch] := str
    else
    begin
        EncodeData(node^.left, str + '0', huffmanCode);
        EncodeData(node^.right, str + '1', huffmanCode);
    end;
end;

procedure DecodeData(node: PNode; var index: Integer; const sb: string);
begin
    if node = nil then
        Exit;
    if (node^.left = nil) and (node^.right = nil) then
    begin
        Write(node^.ch);
        Exit;
    end;
    Inc(index);
    if sb[index] = '0' then
        DecodeData(node^.left, index, sb)
    else
        DecodeData(node^.right, index, sb);
end;

procedure FreeTree(node: PNode);
begin
    if node = nil then
        Exit;
    FreeTree(node^.left);
    FreeTree(node^.right);
    Dispose(node);
end;

function CreateHuffmanTree(const text: string) : String;
var
    root: PNode;
    huffmanCode: THuffmanCode;
    sb: TStringBuilder;
    i, index: Integer;
    ch: Char;
    StrForSpeaker, BinaryStr : String;
begin
    if text = '' then
        Exit;
    BuildHuffmanTree(text, root);
    FillChar(huffmanCode, SizeOf(huffmanCode), 0);
    EncodeData(root, '', huffmanCode);
    for ch := Low(Char) to High(Char) do
    begin
        if huffmanCode.codeMap[ch] <> '' then
        begin
            StrForSpeaker := StrForSpeaker + ch + huffmanCode.codeMap[ch];
        end;
    end;
    sb := TStringBuilder.Create;
    for i := 1 to Length(text) do
        sb.Append(huffmanCode.codeMap[text[i]]);
    BinaryStr := sb.ToString;
    FreeTree(root);
    sb.Free;
    CreateHuffmanTree := (StrForSpeaker + '~' +BinaryStr);
end;

procedure AddinList(var List: PList; Freq: Integer);
var
    NewItem, Head: PList;
begin
    New(NewItem);
    NewItem^.Data := Freq;
    NewItem^.Next := nil;
    if List = nil then
        List := NewItem
    else
    begin
        Head := List;
        while Head^.Next <> nil do
            Head := Head^.Next;
        Head^.Next := NewItem;
    end;
end;

procedure DeleteList(var List: PList);
var
    CurrentNode, NextNode: PList;
begin
    CurrentNode := List;
    while CurrentNode <> nil do
    begin
        NextNode := CurrentNode^.Next;
        Dispose(CurrentNode);
        CurrentNode := NextNode;
    end;
    List := nil;
end;

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

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

procedure BinaryBeep(Str : String);
Var
    I : Integer;
Const
    ZERO = 400;
    ONE = 7000;
begin
    For I := Low(Str) To High(Str) Do
    begin
        If Str[I] = '1' then
            AddinList(List, ONE)
        else
            AddinList(List, ZERO);
    end;
end;

procedure TSendParcel.GoBinaryButtonClick(Sender: TObject);
Var
    Huffman, BinaryPart : String;
    I, Proc, DataLength, Counter: Integer;
    Element : AnsiChar;
    Repeats : Set of Char;
begin
    Data := InputEdit.Text;
    If Length(Data) > 4 then
    begin
        For I := Low(Data) to High(Data) Do
        begin
            If not(Data[I] in Repeats) then
            begin
                Element := AnsiChar(Data[I]);
                Include(Repeats, Element);
                Inc(Counter);
                If Counter > 4 then
                begin
                    GoBinaryButton.Enabled := False;
                    exit;
                end;
            end;
        end;
    end;
    Huffman := CreateHuffmanTree(Data);
    For I := Low(Huffman) to High(Huffman) Do
    begin
        If Huffman[I] = '~' then
        begin
            BinaryPart := Copy(Huffman, I + 1, (Length(Huffman) - I + 1));
            Huffman := Copy(Huffman, 1, (I - 1)) ;
            break;
        end;
    end;
    CreateListOfSound(Huffman);
    BinaryBeep(BinaryPart);
    ProgressBar.Visible := True;
    I := 0;
    DataLength := Length(Data);
    while List <> nil do
    begin
        PlaySound(List^.Data);
        List := List^.Next;
        Proc := ((I * 100) div DataLength - 1);
        ProgressBar.Position := Proc;
        Application.ProcessMessages;
        Inc(I);
    end;
    ProgressBar.Position := 100;
end;

procedure TSendParcel.CreateListOfSound (Data : String);
var
    BaseAsciiCode, Gap, I: Integer;
    IsEnNow : Boolean;
Const
    MIN_FREQ = 500;
    STEP = 50;
    MIN_ASCII_EN = 32;
    MAX_ASCII_EN = 125;
    MIN_ASCII_RU = 1040;
    MAX_ASCII_RU = 1103;
    RU_SIGN = 6000;
    EN_SIGN = 7000;
begin
    IsEnNow := False;
    DeleteList(List);
    For I := Low(Data) to High(Data) Do
    begin
        If (Ord(Data[I]) >= MIN_ASCII_EN) and (Ord(Data[I]) <= MAX_ASCII_EN) then
        begin
            If not(IsEnNow) then
                AddinList(List, EN_SIGN);
            Gap := Ord(Data[I]) - MIN_ASCII_EN;
            AddinList(List, MIN_FREQ + STEP * Gap);
            IsEnNow := True;
        end;
        If (Ord(Data[I]) >= MIN_ASCII_RU) and (Ord(Data[I]) <= MAX_ASCII_RU) then
        begin
             If IsEnNow then
                AddinList(List, RU_SIGN);
            Gap := Ord(Data[I]) - MIN_ASCII_RU;
            AddinList(List, MIN_FREQ + STEP * Gap);
            IsEnNow := False;
        end;
    end;
end;

procedure TSendParcel.GoButtonClick(Sender: TObject);
var
    DataLength, I, Proc : Integer;
begin
    Data := InputEdit.Text;
    DataLength := Length(InputEdit.Text);
    CreateListOfSound(Data);
    ProgressBar.Visible := True;
    I := 0;
    while List <> nil do
    begin
        PlaySound(List^.Data);
        List := List^.Next;
        Proc := ((I * 100) div DataLength - 1);
        ProgressBar.Position := Proc;
        Application.ProcessMessages;
        Inc(I);
    end;
    ProgressBar.Position := 100;
end;

procedure TSendParcel.InputEditChange(Sender: TObject);
var
    Repeats : Set of Char;
    I, Counter: Integer;
    Element : AnsiChar;
begin
    Repeats := [];
    Data := InputEdit.Text;
    If Length(Data) > 0 then
    begin
        GoButton.Enabled := True;
        GoBinaryButton.Enabled := True;
        PSLabel.Visible := True;
        N3.Enabled := True;
    end
    else
    begin
        GoButton.Enabled := False;
        GoBinaryButton.Enabled := False;
        PSLabel.Visible := False;
        N3.Enabled := False;
    end;
    ProgressBar.Position := 0;
    Counter := 0;
    If Length(Data) > 4 then
    begin
        For I := Low(Data) to High(Data) Do
        begin
            If not(Data[I] in Repeats) then
            begin
                Element := AnsiChar(Data[I]);
                Include(Repeats, Element);
                Inc(Counter);
                If Counter > 4 then
                begin
                    GoBinaryButton.Enabled := False;
                    break;
                end;
            end;
        end;
    end;
end;

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

function Open (): String;
Begin
    With SendParcel Do
    Begin
        If OpenDialog1.Execute Then
        Begin
            Path := OpenDialog1.Filename;
            IsFileOpen := True;
        End
        Else
            IsFileOpen := False;
    End;
    Open := Path;
End;

function Save (): String;
Begin
    With SendParcel Do
    Begin
        SaveDialog1.Title := 'Сохранить текст';
        SaveDialog1.Filter := 'txt|*.txt';
        If SaveDialog1.Execute Then
        Begin
            Path := SaveDialog1.Filename;
            IsFileOpen := True;
        End
        Else
            IsFileOpen := False;
    End;
    Save := Path;
End;

function GetString(Var FileOutput: TextFile): String;
Var
    IsRight : Boolean;
    Str : String;
Begin
    IsRight := True;
    Try
        Readln(FileOutput, Str);
        Str := Trim (Str);
    Except
        IsRight := False;
    End;
    If IsRight then
    Begin
        GetString := Str;
    End;
End;

procedure TSendParcel.N2Click(Sender: TObject);
Var
    FileInput : TextFile;
    PlayData : String;
begin
    OpenDialog1.Title := 'Выбрать текст';
    OpenDialog1.Filter := 'txt|*.txt';
    IsFileOpen := False;
    Path := Open();
    AssignFile(FileInput, Path);
    Reset(FileInput);
    If (IsFileOpen) then
        PlayData := GetString(FileInput);
    CloseFile(FileInput);
    If (PlayData <> '') then
    Begin
        VarOfChose.ItemIndex := 0;
        InputEdit.Text := PlayData;
        InputEdit.Visible := True;
        TextLabel.Visible := True;
        GoButton.Visible := True;
        GoBinaryButton.Visible := True;
        PSLabel.Visible := True;
    End;
end;

procedure TSendParcel.N3Click(Sender: TObject);
Var
    FileOutput: TextFile;
    IsCorrect : Boolean;
begin
    IsCorrect := True;
    Path := Save();
    If (IsFileOpen) Then
    Begin
        try
            AssignFile(FileOutput, Path);
            Rewrite(FileOutput);
            Write(FileOutput, Data);
        except
            IsCorrect := False;
            Application.MessageBox('Запись в файл не удалась.', 'Ошибка', MB_ICONSTOP);
        end;
        if IsCorrect then
        Begin
            Application.MessageBox('Запись файла выполнена успешно.', 'Результат', 0);
            CloseFile(FileOutput);
        End;
    End;
end;

procedure TSendParcel.N4Click(Sender: TObject);
Const
    STR1 = 'Выберите, какой тип данных вы хотите передать с помощью звуковых волн.';
    STR2 = 'Для этого кликните на серенькое окошко справа от строки и снизу от фотографии.';
    STR3 = 'P.S. Передача фотографий пока не доступна.';
    A = #13#10;
begin
    Application.MessageBox(STR1 + A + STR2 + A + STR3, 'Помощь', 0);
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;
        GoBinaryButton.Visible := True;
        N2.Enabled := True;
    end;
    if VarOFChose.ItemIndex = IMAGE_INPUT then
    begin
         MessageBox(SendParcel.Handle, Pchar('Дорогой пользователь, функция передачи картинок будет реализована в ближайшем будущем. Спасибо за понимание.'), 'Извинения', MB_ICONINFORMATION);
         VarOfChose.ItemIndex := -1;
         N2.Enabled := False;
         N3.Enabled := False;
    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,
  Vcl.Imaging.pngimage, Vcl.ExtCtrls, MainUnit, Bass, BassEnc, BassEnc_MP3,
  Vcl.ComCtrls, Vcl.Menus, Vcl.MPlayer;


type
  TFft = array [0 .. 1023] of Single;

  TGetParcel = class(TForm)
    RecordButton: TButton;
    StopRecordButton: TButton;
    Logo: TImage;
    ShowResultsButton: TButton;
    ResultEdit: TEdit;
    PlayButton: TButton;
    OpenDialog: TOpenDialog;
    SaveDialog: TSaveDialog;
    MainMenu: TMainMenu;
    PopupMenu: TPopupMenu;
    N1: TMenuItem;
    N2: TMenuItem;
    N3: TMenuItem;
    N4: TMenuItem;
    Timer: TTimer;
    IndicateGraph: TPaintBox;
    MediaPlayer: TMediaPlayer;
    Procedure Draw(HWND: THandle; DrawData: TFft; X, Y: Integer);
    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);
    procedure N4Click(Sender: TObject);
    procedure N2Click(Sender: TObject);
    procedure TimerTimer(Sender: TObject);
    procedure IndicateGraphPaint(Sender: TObject);
    procedure N3Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
  private
    { Private declarations }
  public
    { Public declarations }
  end;
var
  GetParcel: TGetParcel;
  Channel: HRECORD;
   // визуализация
  DrawPeaks: array [0 .. 164] of Longint;
  DrawFallOff: array [0 .. 164] of Longint;
   // конец
  WasSMTHPlayed, IsRecording : Boolean;

implementation

{$R *.dfm}
uses SendWindow;

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
            Application.MessageBox('Не получается получить доступ к записывающему устройству.', 'Ошибка', MB_ICONSTOP)
        else
        begin
            Channel:= BASS_RecordStart(44100, 2, 0, @RecordingCallback, nil);
            if Channel = 0 then
                Application.MessageBox('Невозможно начать запись.', 'Ошибка', MB_ICONSTOP)
            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
    MediaPlayer.FileName:= ('запись.mp3');
    MediaPlayer.Open;
    MediaPlayer.Play;
    WasSMTHPlayed := True;
end;

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

procedure TGetParcel.ShowResultsButtonClick(Sender: TObject);
begin
    ResultEdit.Visible := True;
    ResultEdit.Text := Data; // к сожалению, так
end;

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

procedure TGetParcel.TimerTimer(Sender: TObject);
var
    FFTFata: TFft;
begin
    BASS_ChannelGetData(Channel, @FFTFata, BASS_DATA_FFT1024);
    Draw(IndicateGraph.Canvas.Handle, FFTFata, 0, -5);
end;

procedure TGetParcel.FormClose(Sender: TObject; var Action: TCloseAction);
begin
    StopRecordButton.Enabled := False;
    PlayButton.Enabled := False;
    ShowResultsButton.Enabled := False;
    ResultEdit.Visible := False;
    ResultEdit.Text := '';
    RecordButton.Caption := 'Прослушать окружение';
    N4.Enabled := False;
    If WasSMTHPlayed then
        MediaPlayer.Stop;
end;

procedure TGetParcel.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
begin
    If IsRecording then
    begin
        CanClose := False;
        Application.MessageBox('Пожалуйста, завершите запись, прежде чем выйти.', 'Ошибка', MB_ICONSTOP);
    end;
end;

procedure TGetParcel.FormCreate(Sender: TObject);
begin
    WasSMTHPlayed := False;
end;

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

procedure TGetParcel.IndicateGraphPaint(Sender: TObject);
begin
    IndicateGraph.Canvas.Pen.Color := clBlack;
    IndicateGraph.Canvas.Brush.Color := clWhite;
    IndicateGraph.Canvas.Rectangle(0, 0, IndicateGraph.Width,
    IndicateGraph.Height);
end;

procedure TGetParcel.N2Click(Sender: TObject);
var
    ChannelFile : File of HRECORD;
Const
    STR1 = 'Дорогой пользователь, пока считывание дескриптора канала с файла не имеет смысла, так как он не используется(ввиду нерабочей функции приема информации). Знайте, что Вы все сделали верно и логика сработала правильно, просто не ожидайте дальнейших действий.';
begin
    AssignFile(ChannelFile, Path);
    OpenDialog.Title := 'Выбрать дескриптор канала';
    OpenDialog.Filter := 'channel|*.channel';
    If(OpenDialog.Execute) Then
    Begin
        try
            Path := OpenDialog.FileName;
            Reset(ChannelFile, Path);
            While(Not(Eof(ChannelFile))) Do
            Begin
                Read(ChannelFile, Channel);
            End;
        except
             MessageBox(GetParcel.Handle, Pchar('Чтение файла не удалось.'), 'Извинения', MB_ICONSTOP);
        end;
        CloseFile(ChannelFile);
        //PlayButton.Enabled := True;
        //ShowResultsButton.Enabled := True;
        Application.MessageBox(STR1, 'Успех', 0);
    End;
end;

procedure TGetParcel.N3Click(Sender: TObject);
Const
    STR1 = 'Чтобы начать прослушивать окружение, нажмите кнопку "Прослушать окружение".';
    STR2 = 'Чтобы закончить прослушивать окружение, нажмите кнопку "Закончить слушать".';
    STR3 = 'По нажатию кнопки "Результат" поле под картинкой будет заполнено раскодированной из звука информацией*.';
    STR4 = '* - раскодирование информации не работает. Информация в поле соответствует последней закодированной. К сожалению, это главная проблема этой программы и головная боль разработчика.';
    A = #13#10;
begin
    Application.MessageBox(STR1 + A + STR2 + A + STR3 + A + A + A + STR4, 'Помощь', 0);
end;

procedure TGetParcel.N4Click(Sender: TObject);
var
    ChannelFile : File of HRECORD;
    Str : String;
begin
    SaveDialog.Title := 'Сохранить дескриптор канала';
    SaveDialog.Filter := 'channel|*.channel';
    If (SaveDialog.Execute) then
    Begin
        Path := SaveDialog.FileName;
        Str := ExtractFileExt(Path);
        If(Str = '') Then
            Path := Path + '.channel';
        Rewrite(ChannelFile, Path);
        Seek(ChannelFile, 0);
        Truncate(ChannelFile);
        Write(ChannelFile, Channel);
        CloseFile(ChannelFile);
        Application.MessageBox('Готово!', 'Успех', 0);
    End;
end;


procedure TGetParcel.Draw(HWND: THandle; DrawData:TFft; X, Y: Integer);
var
  I, YPos: Longint;
  YVal: Single;
begin
    IndicateGraph.Canvas.Pen.Color := clBlack;
    IndicateGraph.Canvas.Brush.Color := clWhite;
    IndicateGraph.Canvas.Rectangle(0, 0, IndicateGraph.Width, IndicateGraph.Height);
    IndicateGraph.Canvas.Pen.Color := clRed;
    for I := 0 to 163 do
    begin
        YVal := Abs(DrawData[I]);
        YPos := Trunc((YVal) * 500);
        if YPos > IndicateGraph.Height then
            YPos := IndicateGraph.Height;
        if YPos >= DrawPeaks[I] then
            DrawPeaks[I] := YPos
        else
            DrawPeaks[I] := DrawPeaks[I] - 1;
        if YPos >= DrawFallOff[I] then
            DrawFallOff[I] := YPos
        else
            DrawFallOff[I] := DrawFallOff[I] - 3;
        IndicateGraph.Canvas.Pen.Color := clBlue;
        IndicateGraph.Canvas.MoveTo(X + I * (3 + 1), Y + IndicateGraph.Height - DrawPeaks[I]);
        IndicateGraph.Canvas.LineTo(X + I * (3 + 1) + 3, Y + IndicateGraph.Height - DrawPeaks[I]);
        IndicateGraph.Canvas.Pen.Color := clRed;
        IndicateGraph.Canvas.Brush.Color := clRed;
        IndicateGraph.Canvas.Rectangle(X + I * (3 + 1), Y + IndicateGraph.Height - DrawFallOff[I], X + I * (3 + 1) + 3, Y + IndicateGraph.Height);
      end;
end;
end.