5.1 delphi

unit MainUnit;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
  Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.Menus, Vcl.StdCtrls;

type
  TMainForm = class(TForm)
    Head: TLabel;
    Create: TButton;
    Add: TButton;
    Delete: TButton;
    Show: TButton;
    MainMenu1: TMainMenu;
    PopupMenu1: TPopupMenu;
    N1: TMenuItem;
    N2: TMenuItem;
    N3: TMenuItem;
    N4: TMenuItem;
    N5: TMenuItem;
    OpenDialog1: TOpenDialog;
    SaveDialog1: TSaveDialog;
    procedure N3Click(Sender: TObject);
    procedure N2Click(Sender: TObject);
    procedure AddClick(Sender: TObject);
    procedure DeleteClick(Sender: TObject);
    procedure ShowClick(Sender: TObject);
    procedure CreateClick(Sender: TObject);
    procedure N4Click(Sender: TObject);
    procedure N5Click(Sender: TObject);
    procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

type
    PNode = ^TNode;
    TNode = record
        Data : String;
        Next : PNode;
    end;

    TQueue = record
        Head, Tail : PNode;
    end;
var
    MainForm: TMainForm;
    Queue : TQueue;
    Path, Result : String;
    IsFileOpen : Boolean;

implementation

uses Add, Show, Create;

{$R *.dfm}



function DeleteFirstElement(var Queue: TQueue): String;
var
    Node: PNode;
begin
    Node := Queue.Head;
    Queue.Head := Queue.Head.Next;
    DeleteFirstElement := Node.Data;
    Dispose(Node);
end;

procedure TMainForm.AddClick(Sender: TObject);
begin
    AddNode.ShowModal;
end;

procedure TMainForm.CreateClick(Sender: TObject);
Var
    MsgResult : Integer;
begin
    If Queue.Head = nil then
        CreateQueue.ShowModal
    else
    begin
        MsgResult := MessageDlg ('Создать новую очередь (старая не сохранится)?', mtConfirmation, [mbYes, mbNo], 0);
        If MsgResult = mrYes then
        begin
            CreateQueue.ShowModal;
        end;
    end;
end;

procedure TMainForm.DeleteClick(Sender: TObject);
Var
    NodeForDelete, Info : String;
    MsgResult : Integer;
    IsEmpty : Boolean;
begin
    IsEmpty := False;
    if Queue.Head = nil then
    Begin
        Application.MessageBox('Очередь пуста.', 'Информация', 0);
        IsEmpty := True;
    End;

    If Not(IsEmpty) then
    Begin
        MsgResult := MessageDlg ('Удалить элемент?', mtConfirmation, [mbYes, mbNo], 0);
        If MsgResult = mrYes then
        begin
            NodeForDelete := DeleteFirstElement(Queue);
            Info := 'Элемент "' + NodeForDelete + '" удалён.';
            Application.MessageBox(PWideChar(Info), 'Удаление элемента', 0);
        end;
    End;
end;

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

procedure TMainForm.N2Click(Sender: TObject);
begin
    Application.MessageBox('Очередь - это структура данных, в которой элементы добавляются в конец очереди и удаляются из начала очереди.', 'Инструкция', 0);
end;

procedure TMainForm.N3Click(Sender: TObject);
begin
    Application.MessageBox('Арефин Владислав гр.251004', 'Разработ4ик', 0);
end;

procedure TMainForm.ShowClick(Sender: TObject);
begin
    If Queue.Head <> nil then
    Begin
        ShowQueue.ShowModal;
    End
    else
    begin
        Application.MessageBox('Очередь пуста.', 'Информация', 0);
    end;
end;


Function Open (): String;
Begin
    With MainForm 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 MainForm Do
    Begin
        If SaveDialog1.Execute Then
        Begin
            Path := SaveDialog1.FileName;
            IsFileOpen := True;
        End
        Else
            IsFileOpen := False;
    End;
    Save := Path;
End;

Function GetString(Var FileOutput: TextFile): String;
Stdcall;
External 'My1stLib.dll';

type
    TStr = Array of String;

function SeparateString (Str : String) : TStr;
Stdcall;
External 'My1stLib.dll';


procedure TMainForm.N4Click(Sender: TObject);
Var
    FileInput : TextFile;
    StrWithNodes : String;
    Arr : TStr;
    I : Integer;
    NewNode, Node: PNode;
begin
    IsFileOpen := False;
    Path := Open();
    AssignFile(FileInput, Path);
    Reset(FileInput);
    If (IsFileOpen) then
        StrWithNodes := GetString(FileInput);
    CloseFile(FileInput);
    If (StrWithNodes <> '') then
    Begin
        Arr := SeparateString(StrWithNodes);
        I := 0;
        If Queue.Head <> nil then
            While (Queue.Head <> nil) Do
            Begin
                Node := Queue.Head;
                Queue.Head := Queue.Head.Next;
                Dispose(Node);
            End;

        While (I <> High(Arr)) Do
        begin
            New(NewNode);
            NewNode^.Data := Arr[I];
            NewNode^.Next := nil;
            if Queue.Head = nil then
                Queue.Head := NewNode
            else
                Queue.Tail.Next := NewNode;
            Queue.Tail := NewNode;
            Inc(I);
        end;
        Application.MessageBox('Готово!', 'Информация', 0);
    End;
end;


procedure TMainForm.N5Click(Sender: TObject);
Var
    FileOutput: TextFile;
    IsCorrect : Boolean;
    CurrNode : PNode;
begin
    If Queue.Head = nil then
    begin
        Application.MessageBox('Очередь пуста.', 'Информация', 0);
        exit
    end;
    Result := '';
    IsCorrect := True;
    Path := Save();
    If (IsFileOpen) Then
    Begin
        CurrNode := Queue.Head;
        While (CurrNode <> nil) Do
        Begin
            Result := Result + CurrNode.Data + ' ';
            CurrNode := CurrNode.Next;
        End;

        try
            AssignFile(FileOutput, Path);
            Rewrite(FileOutput);
            Write(FileOutput, Result);
            CloseFile(FileOutput);
        except
            IsCorrect := False;
            Application.MessageBox('Запись в файл не удалась.', 'Ошибка', MB_ICONSTOP);
        end;

        If IsCorrect then
        Begin
            Application.MessageBox('Запись файла выполнена успешно.', 'Результат', 0);
        End;
    End;
end;


end.

-------------------------------------------------------------------------------
library My1stLib;
uses
  System.SysUtils,
  System.Classes;

{$R *.res}

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

type
    TStr = Array of String;

function SeparateString (Str : String) : TStr; stdcall;
Var
    StrArr : TStr;
    I, K : Integer;
    Flag : Boolean;
Begin
    K := 0;
    SetLength(StrArr, (Str.Length div 2) + 1);
    For I := 0 To Str.Length div 2 do
        StrArr[i] := '';
    I := 1;
    While I <= Str.Length Do
    begin
        Flag := True;
        While (Str[I] <> ' ') and (I <= Str.Length) Do
        Begin
            StrArr[K] := StrArr[K] + Str[I];
            Inc(I);
            Flag := False;
        End;
        If Not(Flag) then
            Inc(K);
        If Flag then
            Inc(I);
    end;
    I := 1;
    K := 0;
    While Str[I] <> '' Do
    Begin
        If Str[I] = ' ' then
            Inc(K);
        Inc(I);
    End;
    SetLength(StrArr, K + 2);
    Result := StrArr;
End;

Exports GetString, SeparateString;

end.

-------------------------------------------------------------------------------
unit Create;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
  Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.Grids, Vcl.StdCtrls, Vcl.Menus;

type
  TCreateQueue = class(TForm)
    Grid: TStringGrid;
    Instruction: TLabel;
    MainMenu1: TMainMenu;
    N1: TMenuItem;
    procedure N1Click(Sender: TObject);
    procedure GridKeyPress(Sender: TObject; var Key: Char);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  CreateQueue: TCreateQueue;

implementation
uses MainUnit;

{$R *.dfm}

procedure TCreateQueue.GridKeyPress(Sender: TObject; var Key: Char);
var
    NewNode: PNode;
    I : Integer;
begin
    If Key = '+' then
        Grid.ColCount := Grid.ColCount + 5;
    If Key = #13 then
    begin
        I := 0;
        While (I <> Grid.ColCount) Do
        begin
            If (Grid.Cells[I, 0] <> '') then
            begin
                New(NewNode);
                NewNode^.Data := Grid.Cells[I, 0];
                NewNode^.Next := nil;
                if Queue.Head = nil then
                    Queue.Head := NewNode
                else
                    Queue.Tail.Next := NewNode;
                 Queue.Tail := NewNode;
            end;
            Inc(I);
        end;
        Application.MessageBox('Готово!', 'Информация', 0);
        CreateQueue.Close;
    end;
end;

procedure TCreateQueue.N1Click(Sender: TObject);
begin
    Application.MessageBox('Нажмите Enter, если вы завершили ввод.'+ #13#10 +'Нажмите "+", чтобы добавить еще 5 ячеек для ввода (по умолчанию их 10). Пустые ячейки будут просто проигнорированы.', 'Справка', 0);
end;

end.
-------------------------------------------------------------------------------
unit Show;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
  Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.Grids;

type
  TShowQueue = class(TForm)
    Output: TStringGrid;
    procedure FormActivate(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  ShowQueue: TShowQueue;

implementation

{$R *.dfm}

uses MainUnit;



procedure TShowQueue.FormActivate(Sender: TObject);
Var
    CurrNode : PNode;
    I : Integer;
begin
    Output.Cells[0, 0] := '';
    Output.ColCount := 1;

    CurrNode := Queue.Head;
    I := 0;
    While (CurrNode <> nil) Do
    Begin
        Output.Cells[I, 0] := CurrNode.Data;
        CurrNode := CurrNode.Next;
        Output.ColCount := Output.ColCount + 1;
        Inc(I);
    End;
    Output.ColCount := Output.ColCount - 1;
end;


end.
-------------------------------------------------------------------------------
unit Add;

interface

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

type
  TAddNode = class(TForm)
    Data: TEdit;
    Meeting: TLabel;
    Panel1: TPanel;
    procedure DataKeyPress(Sender: TObject; var Key: Char);
    procedure FormShow(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  AddNode: TAddNode;

implementation

{$R *.dfm}
Uses MainUnit;


procedure AddNewElement (var Queue : TQueue; Data : String);
Var
    NewNode : PNode;
Begin
    New(NewNode);
    NewNode.Data := Data;
    NewNode.Next := nil;
    if Queue.Head = nil then
        Queue.Head := NewNode
    else
        Queue.Tail.Next := NewNode;
    Queue.Tail := NewNode;
End;

procedure TAddNode.DataKeyPress(Sender: TObject; var Key: Char);
Var
    MsgResult : Integer;
begin
    If (Key = #13) and (Data.Text <> '') then
    begin
        // здесь было бы славно убрать звук
        MsgResult := MessageDlg ('Вы хотите добавить "' +  Data.Text +'" в очередь?', mtConfirmation, [mbYes, mbNo], 0);
        If MsgResult = mrYes then
        begin
            AddNewElement(Queue, Data.Text);
            AddNode.Close;
        end;
        Data.Text := '';
    end;
end;

procedure TAddNode.FormShow(Sender: TObject);
begin
    Panel1.SetFocus; // это костыль для того, чтобы убрать фокус с Edit. Но мне он не нравится.
end;

end.