Знающие ребята по Delphi 7. Помогите

winter credo · 11.06.2025

У меня уже до слез. Сижу пытаюсь исправить курсовой проект который я защищал, нахождение угла между прямыми. То что мне сказали исправить я просто не вывожу. Кто разбирается прошу помощи у вас. Если можете в отдельном мессенджере связаться со мной,буду только за
tg @lotan_aqua

sn0w · 12.06.2025

winter credo сказал(а):

нахождение угла между прямыми.

Реализация программы на Delphi 7, которая позволяет вводить координаты двух прямых, вычислять угол между ними, а также сохранять и загружать координаты из файла. Дополнительные функции, как проверка ввода, обработка ошибок, логирование.

Исходный код:

Код:

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ExtCtrls, Math, IOUtils, SysUtils, Math;

type
  TForm1 = class(TForm)
    EditX1: TEdit; // Поле ввода для координаты X первой точки первой прямой
    EditY1: TEdit; // Поле ввода для координаты Y первой точки первой прямой
    EditX2: TEdit; // Поле ввода для координаты X второй точки первой прямой
    EditY2: TEdit; // Поле ввода для координаты Y второй точки первой прямой
    EditX3: TEdit; // Поле ввода для координаты X первой точки второй прямой
    EditY3: TEdit; // Поле ввода для координаты Y первой точки второй прямой
    EditX4: TEdit; // Поле ввода для координаты X второй точки второй прямой
    EditY4: TEdit; // Поле ввода для координаты Y второй точки второй прямой
    ButtonCalculate: TButton; // Кнопка для расчета угла между прямыми
    LabelResult: TLabel; // Метка для отображения результата
    PaintBox: TPaintBox; // Поле для рисования прямых и угла
    Panel1: TPanel; // Панель для размещения элементов управления
    ButtonLoad: TButton; // Кнопка для загрузки координат из файла
    ButtonSave: TButton; // Кнопка для сохранения координат в файл
    ColorDialog1: TColorDialog; // Диалог выбора цвета
    OpenDialog1: TOpenDialog; // Диалог открытия файла
    SaveDialog1: TSaveDialog; // Диалог сохранения файла
    procedure ButtonCalculateClick(Sender: TObject); // Обработчик нажатия кнопки расчета
    procedure PaintBoxPaint(Sender: TObject); // Обработчик перерисовки PaintBox
    procedure ButtonLoadClick(Sender: TObject); // Обработчик нажатия кнопки загрузки
    procedure ButtonSaveClick(Sender: TObject); // Обработчик нажатия кнопки сохранения
    procedure FormCreate(Sender: TObject); // Обработчик создания формы
    procedure PaintBoxMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer); // Обработчик движения мыши в PaintBox
    procedure PaintBoxMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); // Обработчик нажатия мыши в PaintBox
    procedure PaintBoxMouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); // Обработчик отпускания мыши в PaintBox
  private
    { Private declarations }
    function AngleBetweenLines(X1, Y1, X2, Y2, X3, Y3, X4, Y4: Double): Double; // Функция для вычисления угла между двумя прямыми
    procedure DrawLinesAndAngle; // Процедура для рисования прямых и угла между ними
    function FindIntersection(X1, Y1, X2, Y2, X3, Y3, X4, Y4: Double; var IntersectX, IntersectY: Double): Boolean; // Функция для нахождения точки пересечения двух прямых
    procedure LogMessage(const Msg: string); // Процедура для логирования сообщений
    procedure SaveCoordinatesToFile(const FileName: string); // Процедура для сохранения координат в файл
    procedure LoadCoordinatesFromFile(const FileName: string); // Процедура для загрузки координат из файла
    procedure UpdateUI; // Процедура для обновления пользовательского интерфейса
    procedure ChangeLineColor(Sender: TObject); // Процедура для изменения цвета прямых
    procedure ChangePointColor(Sender: TObject); // Процедура для изменения цвета точки пересечения
    procedure CalculateDistance(X1, Y1, X2, Y2: Double): Double; // Функция для вычисления расстояния между двумя точками
    procedure CalculateMidPoint(X1, Y1, X2, Y2: Double; var MidX, MidY: Double); // Функция для вычисления середины отрезка
    procedure ValidateInput(var X1, Y1, X2, Y2, X3, Y3, X4, Y4: Double); // Процедура для валидации ввода координат
  public
    { Public declarations }
    LineColor1, LineColor2, PointColor: TColor; // Цвета для прямых и точки пересечения
    IsDragging: Boolean; // Флаг, указывающий, перетаскивается ли точка
    DragStartX, DragStartY, DragOffsetX, DragOffsetY: Integer; // Координаты и смещения для перетаскивания
    SelectedPoint: Integer; // Номер выбранной точки для перетаскивания
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

function TForm1.AngleBetweenLines(X1, Y1, X2, Y2, X3, Y3, X4, Y4: Double): Double;
var
  dx1, dy1, dx2, dy2: Double;
  dotProduct, magnitude1, magnitude2, cosineAngle: Double;
begin
  // Находим векторные координаты для каждой прямой
  dx1 := X2 - X1;
  dy1 := Y2 - Y1;
  dx2 := X4 - X3;
  dy2 := Y4 - Y3;

  // Проверяем, параллельны ли прямые
  if (dx1 * dy2 = dx2 * dy1) and (dx1 * dy2 <> -dx2 * dy1) then
  begin
    ShowMessage('Прямые параллельны.');
    Result := 0;
    Exit;
  end;

  // Вычисляем скалярное произведение векторов
  dotProduct := dx1 * dx2 + dy1 * dy2;

  // Вычисляем величины векторов
  magnitude1 := Sqrt(dx1 * dx1 + dy1 * dy1);
  magnitude2 := Sqrt(dx2 * dx2 + dy2 * dy2);

  // Вычисляем косинус угла между векторами
  cosineAngle := dotProduct / (magnitude1 * magnitude2);

  // Ограничиваем значение косинуса в диапазоне [-1, 1]
  if cosineAngle < -1 then
    cosineAngle := -1
  else if cosineAngle > 1 then
    cosineAngle := 1;

  // Возвращаем угол в радианах
  Result := ArcCos(cosineAngle);
end;

function TForm1.FindIntersection(X1, Y1, X2, Y2, X3, Y3, X4, Y4: Double; var IntersectX, IntersectY: Double): Boolean;
var
  denominator, numeratorX, numeratorY: Double;
begin
  denominator := (X1 - X2) * (Y3 - Y4) - (Y1 - Y2) * (X3 - X4);
  if denominator = 0 then
  begin
    Result := False;
    Exit;
  end;

  numeratorX := (X1 * Y2 - Y1 * X2) * (X3 - X4) - (X1 - X2) * (X3 * Y4 - Y3 * X4);
  numeratorY := (X1 * Y2 - Y1 * X2) * (Y3 - Y4) - (Y1 - Y2) * (X3 * Y4 - Y3 * X4);

  IntersectX := numeratorX / denominator;
  IntersectY := numeratorY / denominator;

  Result := True;
end;

procedure TForm1.LogMessage(const Msg: string);
begin
  // Логируем сообщение в файл
  TStringList *F := TStringList.Create;
  try
    F.LoadFromFile('log.txt');
    F.Add(Msg);
    F.SaveToFile('log.txt');
  finally
    F.Free;
  end;
end;

procedure TForm1.SaveCoordinatesToFile(const FileName: string);
var
  FileStream: TFileStream;
  Writer: TWriter;
begin
  FileStream := TFileStream.Create(FileName, fmCreate);
  try
    Writer := TWriter.Create(FileStream);
    try
      Writer.Write(EditX1.Text);
      Writer.Write(EditY1.Text);
      Writer.Write(EditX2.Text);
      Writer.Write(EditY2.Text);
      Writer.Write(EditX3.Text);
      Writer.Write(EditY3.Text);
      Writer.Write(EditX4.Text);
      Writer.Write(EditY4.Text);
    finally
      Writer.Free;
    end;
  finally
    FileStream.Free;
  end;
end;

procedure TForm1.LoadCoordinatesFromFile(const FileName: string);
var
  FileStream: TFileStream;
  Reader: TReader;
begin
  FileStream := TFileStream.Create(FileName, fmOpenRead);
  try
    Reader := TReader.Create(FileStream);
    try
      EditX1.Text := Reader.ReadString;
      EditY1.Text := Reader.ReadString;
      EditX2.Text := Reader.ReadString;
      EditY2.Text := Reader.ReadString;
      EditX3.Text := Reader.ReadString;
      EditY3.Text := Reader.ReadString;
      EditX4.Text := Reader.ReadString;
      EditY4.Text := Reader.ReadString;
    finally
      Reader.Free;
    end;
  finally
    FileStream.Free;
  end;
  UpdateUI;
end;

procedure TForm1.UpdateUI;
begin
  DrawLinesAndAngle;
end;

procedure TForm1.ChangeLineColor(Sender: TObject);
begin
  if Sender = ButtonCalculate then
    ColorDialog1.Color := LineColor1
  else if Sender = ButtonLoad then
    ColorDialog1.Color := LineColor2;
  if ColorDialog1.Execute then
  begin
    if Sender = ButtonCalculate then
      LineColor1 := ColorDialog1.Color
    else if Sender = ButtonLoad then
      LineColor2 := ColorDialog1.Color;
    UpdateUI;
  end;
end;

procedure TForm1.ChangePointColor(Sender: TObject);
begin
  if ColorDialog1.Execute then
  begin
    PointColor := ColorDialog1.Color;
    UpdateUI;
  end;
end;

procedure TForm1.DrawLinesAndAngle;
var
  X1, Y1, X2, Y2, X3, Y3, X4, Y4, IntersectX, IntersectY: Double;
  angle: Double;
  canvas: TCanvas;
begin
  canvas := PaintBox.Canvas;
  canvas.Brush.Color := clWhite;
  canvas.FillRect(Rect(0, 0, PaintBox.Width, PaintBox.Height));

  // Считываем и валидируем координаты из полей ввода
  ValidateInput(X1, Y1, X2, Y2, X3, Y3, X4, Y4);

  // Рисуем первую прямую
  canvas.Pen.Color := LineColor1;
  canvas.MoveTo(X1, Y1);
  canvas.LineTo(X2, Y2);

  // Рисуем вторую прямую
  canvas.Pen.Color := LineColor2;
  canvas.MoveTo(X3, Y3);
  canvas.LineTo(X4, Y4);

  // Находим точку пересечения
  if FindIntersection(X1, Y1, X2, Y2, X3, Y3, X4, Y4, IntersectX, IntersectY) then
  begin
    // Рисуем точку пересечения
    canvas.Pen.Color := PointColor;
    canvas.Ellipse(IntersectX - 2, IntersectY - 2, IntersectX + 2, IntersectY + 2);

    // Вычисляем угол между прямыми
    angle := AngleBetweenLines(X1, Y1, X2, Y2, X3, Y3, X4, Y4);

    // Преобразуем угол в градусы
    angle := angle * 180 / Pi;

    // Отображаем результат
    LabelResult.Caption := 'Угол между прямыми: ' + FloatToStr(angle) + ' градусов';

    // Рисуем угол
    canvas.Pen.Color := clBlack;
    canvas.MoveTo(IntersectX, IntersectY);
    canvas.LineTo(IntersectX + 50 * Cos(angle), IntersectY + 50 * Sin(angle));
  end
  else
  begin
    LabelResult.Caption := 'Прямые не пересекаются.';
  end;
end;

procedure TForm1.ButtonCalculateClick(Sender: TObject);
begin
  DrawLinesAndAngle;
end;

procedure TForm1.PaintBoxPaint(Sender: TObject);
begin
  DrawLinesAndAngle;
end;

procedure TForm1.ButtonLoadClick(Sender: TObject);
begin
  if OpenDialog1.Execute then
    LoadCoordinatesFromFile(OpenDialog1.FileName);
end;

procedure TForm1.ButtonSaveClick(Sender: TObject);
begin
  if SaveDialog1.Execute then
    SaveCoordinatesToFile(SaveDialog1.FileName);
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  LineColor1 := clBlue;
  LineColor2 := clRed;
  PointColor := clGreen;
  IsDragging := False;
  SelectedPoint := 0;
end;

procedure TForm1.PaintBoxMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
begin
  if IsDragging then
  begin
    case SelectedPoint of
      1: begin
          EditX1.Text := IntToStr(X - DragOffsetX);
          EditY1.Text := IntToStr(Y - DragOffsetY);
        end;
      2: begin
          EditX2.Text := IntToStr(X - DragOffsetX);
          EditY2.Text := IntToStr(Y - DragOffsetY);
        end;
      3: begin
          EditX3.Text := IntToStr(X - DragOffsetX);
          EditY3.Text := IntToStr(Y - DragOffsetY);
        end;
      4: begin
          EditX4.Text := IntToStr(X - DragOffsetX);
          EditY4.Text := IntToStr(Y - DragOffsetY);
        end;
    end;
    UpdateUI;
  end;
end;

procedure TForm1.PaintBoxMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
  if Button = mbLeft then
  begin
    IsDragging := True;
    DragStartX := X;
    DragStartY := Y;
    if Abs(X - StrToInt(EditX1.Text)) <= 5 and Abs(Y - StrToInt(EditY1.Text)) <= 5 then
      SelectedPoint := 1
    else if Abs(X - StrToInt(EditX2.Text)) <= 5 and Abs(Y - StrToInt(EditY2.Text)) <= 5 then
      SelectedPoint := 2
    else if Abs(X - StrToInt(EditX3.Text)) <= 5 and Abs(Y - StrToInt(EditY3.Text)) <= 5 then
      SelectedPoint := 3
    else if Abs(X - StrToInt(EditX4.Text)) <= 5 and Abs(Y - StrToInt(EditY4.Text)) <= 5 then
      SelectedPoint := 4
    else
      SelectedPoint := 0;
  end;
end;

procedure TForm1.PaintBoxMouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
  if Button = mbLeft then
  begin
    IsDragging := False;
    case SelectedPoint of
      1: DragOffsetX := X - DragStartX;
      2: DragOffsetX := X - DragStartX;
      3: DragOffsetX := X - DragStartX;
      4: DragOffsetX := X - DragStartX;
    end;
  end;
end;

procedure TForm1.CalculateDistance(X1, Y1, X2, Y2: Double): Double;
begin
  Result := Sqrt(Sqr(X2 - X1) + Sqr(Y2 - Y1));
end;

procedure TForm1.CalculateMidPoint(X1, Y1, X2, Y2: Double; var MidX, MidY: Double);
begin
  MidX := (X1 + X2) / 2;
  MidY := (Y1 + Y2) / 2;
end;

procedure TForm1.ValidateInput(var X1, Y1, X2, Y2, X3, Y3, X4, Y4: Double);
begin
  try
    X1 := StrToFloat(EditX1.Text);
    Y1 := StrToFloat(EditY1.Text);
    X2 := StrToFloat(EditX2.Text);
    Y2 := StrToFloat(EditY2.Text);
    X3 := StrToFloat(EditX3.Text);
    X4 := StrToFloat(EditX4.Text);
    Y3 := StrToFloat(EditY3.Text);
    Y4 := StrToFloat(EditY4.Text);
  except
    on E: Exception do
    begin
      ShowMessage('Ошибка: ' + E.Message);
      Exit;
    end;
  end;
end;

end.

rand · 14.06.2025

Покажи исходник здесь, посмотрю.

Quake3 · 14.06.2025

winter credo сказал(а):

То что мне сказали исправить я просто не вывожу

Вы форумом не ошиблись? какие курсовые? Идите на киберфорум или фриланс. Чтобы вам помогли здесь, надо представить код, т.е. личные наработки, и показать что не получается. А "сделайте за меня" - это в комерц!

Я лично всегда готов подсказать новичкам, кроме 1 категории - студентов, которые нихрена не знают, не понимают, и при этом учаться, занимая чье-то место. А потом такие вот и пишут дырявые сайты и проги, которые жрут 1гиг оперативки, или сидят на хлебном месте где-то в госухе.

shrekushka · 15.06.2025

Quake3 сказал(а):

Я лично всегда готов подсказать новичкам, кроме 1 категории - студентов, которые нихрена не знают, не понимают, и при этом учаться, занимая чье-то место. А потом такие вот и пишут дырявые сайты и проги, которые жрут 1гиг оперативки, или сидят на хлебном месте где-то в госухе.

Quake3 сказал(а):

А "сделайте за меня" - это в комерц!

winter credo · 19.06.2025

да уж,обосрали с ног до головы,интересно причем тут фриланс и гос места). проблема нашего общества в том что они сначала бьют рогами в забор потом думают
учимся - занимаем чужие места)

Quake3 сказал(а):

Вы форумом не ошиблись? какие курсовые? Идите на киберфорум или фриланс. Чтобы вам помогли здесь, надо представить код, т.е. личные наработки, и показать что не получается. А "сделайте за меня" - это в комерц!

Я лично всегда готов подсказать новичкам, кроме 1 категории - студентов, которые нихрена не знают, не понимают, и при этом учаться, занимая чье-то место. А потом такие вот и пишут дырявые сайты и проги, которые жрут 1гиг оперативки, или сидят на хлебном месте где-то в госухе.

waahoo · 19.06.2025

winter credo сказал(а):

учимся - занимаем чужие места)

Учиться, это значит скидывать свои наработки на осмотр и просить совета. А когда:

winter credo сказал(а):

мне сказали исправить я просто не вывожу

Получайте, что получили, Вы занимаете чужое место.

winter credo · 19.06.2025

waahoo сказал(а):

Учиться, это значит скидывать свои наработки на осмотр и просить совета. А когда:

Получайте, что получили, Вы занимаете чужое место.

<3 люблю вас честно

Знающие ребята по Delphi 7. Помогите

winter credo

CD-диск

sn0w

floppy-диск

rand

CooL-Lamer

Quake3

TPU unit

shrekushka

(L1) cache

winter credo

CD-диск

waahoo

ворчливый дед

winter credo

CD-диск