Графическое решение задач линейного программирования

finally

LResourceStream.Free;

end;

end;

procedure TMainForm.tbScaleChange(Sender: TObject);

begin

Repaint;

end;

procedure TMainForm.FormResize(Sender: TObject);

begin

FPaintBuffer.Width := PaintBox.Width;

FPaintBuffer.Height := PaintBox.Height;

FWidthdiv2 := FPaintBuffer.Width div 2;

FHeightdiv2 := FPaintBuffer.Height div 2;

end;

function TMainForm.GetGraphScale: Double;

begin

Result := FGraphScale + (tbScale.Position - 25) / (25 / FGraphScale);

end;

procedure TMainForm.FormDestroy(Sender: TObject);

begin

FPaintBuffer.Free;

end;

end.

unit AboutFormUnit;

interface

uses

Windows, SysUtils, Classes, Graphics, Forms, Controls, StdCtrls,

Buttons, ExtCtrls, ShellApi;

type

TAboutForm = class(TForm)

Panel1: TPanel;

ProgramIcon: TImage;

ProductName: TLabel;

OKButton: TButton;

Label1: TLabel;

Bevel1: TBevel;

Label2: TLabel;

Memo1: TMemo;

procedure AuthorEmailLabelClick(Sender: TObject);

procedure ProgramHomepageLabelClick(Sender: TObject);

procedure Label4Click(Sender: TObject);

private

{ Private declarations }

public

{ Public declarations }

end;

implementation

{$R *.dfm}

procedure TAboutForm.AuthorEmailLabelClick(Sender: TObject);

begin

ShellExecute(0, 'open', PChar('mailto: ' + AuthorEmailLabel.Caption), nil, nil, SW_SHOW);

end;

procedure TAboutForm.Label4Click(Sender: TObject);

begin

ShellExecute(0, 'open', PChar(Label4.Caption), nil, nil, SW_SHOW);

end;

procedure TAboutForm.ProgramHomepageLabelClick(Sender: TObject);

begin

ShellExecute(0, 'open', PChar(ProgramHomepageLabel.Caption), nil, nil, SW_SHOW);

end;

end.

unit NewTaskFormUnit;

interface

uses

Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,

Dialogs, StdCtrls, Grids, Contnrs, MSimplexMath, ExtCtrls;

type

TNewTaskForm = class(TForm)

MatrixNGrid: TStringGrid;

VectorbGrid: TStringGrid;

OKButton: TButton;

CancelButton: TButton;

VectorCGrid: TStringGrid;

Label1: TLabel;

Label2: TLabel;

Label3: TLabel;

Bevel1: TBevel;

cbTaskType: TComboBox;

xiLabel: TLabel;

procedure FormShow(Sender: TObject);

procedure VectorbGridDrawCell(Sender: TObject; ACol, ARow: Integer;

Rect: TRect; State: TGridDrawState);

procedure MatrixNGridDrawCell(Sender: TObject; ACol, ARow: Integer;

Rect: TRect; State: TGridDrawState);

procedure VectorCGridDrawCell(Sender: TObject; ACol, ARow: Integer;

Rect: TRect; State: TGridDrawState);

procedure OKButtonClick(Sender: TObject);

procedure FormCreate(Sender: TObject);

procedure FormDestroy(Sender: TObject);

private

FN: Integer;

FM: Integer;

// Матрица коэффициентов ограничений

FNMatrix: TMatrix;

// Вектор коэффициентов свободных членов

FVectorb: TVector;

// Вектор коэффициентов целевой функции

FVectorc: TVector;

FSigns: TObjectList;

function GetSign(Index: Integer): Integer;

function GetSignStr(Index: Integer): string;

public

property N: Integer read FN write FN;

property M: Integer read FM write FM;

property Sign[Index: Integer]: Integer read GetSign;

property SignStr[Index: Integer]: string read GetSignStr;

property Vectorb: TVector read FVectorb write FVectorb;

property Vectorc: TVector read FVectorc write FVectorc;

property NMatrix: TMatrix read FNMatrix write FNMatrix;

end;

implementation

{$R *.dfm}

function ValidateDecimalSeparator(AFloatStr: string): string;

var

LDotPos: Integer;

begin

Result := AFloatStr;

LDotPos := Pos('.', Result);

while LDotPos > 0 do

begin

Result[LDotPos] := ',';

LDotPos := Pos('.', Result);

end;

end;

procedure InitStringGrid(AStringGrid: TStringGrid);

var

i, j: Integer;

begin

for i := 0 to AStringGrid.ColCount - 1 do

for j := 0 to AStringGrid.RowCount - 1 do

begin

AStringGrid.Cells[i, j] := '0';

end;

end;

function GetMatrix(AStringGrid: TStringGrid): TMatrix;

var

i, j: Integer;

begin

SetLength(Result, AStringGrid.RowCount, AStringGrid.ColCount);

for i := 0 to AStringGrid.RowCount - 1 do

begin

for j := 0 to AStringGrid.ColCount - 1 do

begin

Result[i, j] := StrToFloat(ValidateDecimalSeparator(AStringGrid.Cells[j, i]));

end;

end;

end;

function GetVector(AStringGrid: TStringGrid): TVector;

var

i: Integer;

begin

if AStringGrid.RowCount = 1 then

begin

SetLength(Result, AStringGrid.ColCount);

for i := 0 to AStringGrid.ColCount - 1 do

begin

Result[i] := StrToFloat(ValidateDecimalSeparator(AStringGrid.Cells[i, 0]));

end;

end

else

begin

SetLength(Result, AStringGrid.RowCount);

for i := 0 to AStringGrid.RowCount - 1 do

begin

Result[i] := StrToFloat(ValidateDecimalSeparator((AStringGrid.Cells[0, i])));

end;

end;

end;

procedure AdjustStringGrid(AStringGrid: TStringGrid);

var

i: Integer;

LWidth: Integer;

LHeight: Integer;

begin

LWidth := 0;

for i := 0 to AStringGrid.ColCount - 1 do

begin

LWidth := LWidth + AStringGrid.ColWidths[i];

end;

LHeight := 0;

for i := 0 to AStringGrid.RowCount - 1 do

begin

LHeight := LHeight + AStringGrid.RowHeights[i];

end;

AStringGrid.Width := LWidth + AStringGrid.ColCount + 1;

AStringGrid.Height := LHeight + AStringGrid.RowCount + 1;

end;

procedure TNewTaskForm.FormCreate(Sender: TObject);

begin

FSigns := TObjectList.Create;

end;

procedure TNewTaskForm.FormDestroy(Sender: TObject);

begin

FSigns.Free;

end;

procedure TNewTaskForm.FormShow(Sender: TObject);

var

i: Integer;

LLeft: Integer;

LComboBox: TComboBox;

begin

MatrixNGrid.RowCount := FM;

MatrixNGrid.ColCount := FN;

InitStringGrid(MatrixNGrid);

AdjustStringGrid(MatrixNGrid);

VectorbGrid.RowCount := FM;

InitStringGrid(VectorbGrid);

AdjustStringGrid(VectorbGrid);

VectorCGrid.ColCount := FN;

InitStringGrid(VectorCGrid);

AdjustStringGrid(VectorCGrid);

for i := 0 to FM - 1 do

begin

LComboBox := TComboBox.Create(Self);

LComboBox.Parent := Self;

LComboBox.Style := csDropDownList;

LComboBox.AddItem('=', nil);

LComboBox.AddItem('>=', nil);

LComboBox.AddItem('<=', nil);

LComboBox.ItemIndex := 0;

LComboBox.Width := 50;

LLeft := MatrixNGrid.Left + MatrixNGrid.Width + 25;

LComboBox.Left := LLeft;

LComboBox.Top := MatrixNGrid.Top + (i * LComboBox.Height);

FSigns.Add(LComboBox);

end;

for i := 0 to MatrixNGrid.RowCount - 1 do

begin

MatrixNGrid.RowHeights[i] := TComboBox(FSigns.Items[i]).Height - 1;

end;

AdjustStringGrid(MatrixNGrid);

for i := 0 to VectorbGrid.RowCount - 1 do

begin

VectorbGrid.RowHeights[i] := TComboBox(FSigns.Items[i]).Height - 1;

end;

AdjustStringGrid(VectorbGrid);

for i := 0 to VectorCGrid.RowCount - 1 do

begin

VectorCGrid.RowHeights[i] := TComboBox(FSigns.Items[i]).Height - 1;

end;

AdjustStringGrid(VectorCGrid);

VectorbGrid.Left := LLeft + 70;

Label3.Top := MatrixNGrid.Top + MatrixNGrid.Height + 15;

VectorCGrid.Top := Label3.Top + Label3.Height + 5;

Label2.Left := VectorbGrid.Left;

xiLabel.Top := VectorCGrid.Top + VectorCGrid.Height + 10;

Bevel1.Top := VectorCGrid.Top + VectorCGrid.Height + 30;

Bevel1.Width := CancelButton.Left + CancelButton.Width - Bevel1.Left;

Width := VectorbGrid.Left + VectorbGrid.Width + 100;

ClientHeight := Bevel1.Top + Bevel1.Height + OKButton.Height + 20;

end;

function TNewTaskForm.GetSign(Index: Integer): Integer;

begin

Result := TComboBox(FSigns.Items[Index]).ItemIndex;

end;

function TNewTaskForm.GetSignStr(Index: Integer): string;

begin

case Sign[Index] of

0: Result := '=';

1: Result := '>=';

2: Result := '<=';

end;

end;

procedure TNewTaskForm.MatrixNGridDrawCell(Sender: TObject; ACol, ARow: Integer; Rect: TRect; State: TGridDrawState);

begin

if Sender = ActiveControl then

Exit;

if not (gdSelected in State) then

Exit;

with Sender as TStringGrid do

begin

Canvas.Brush.Color := Color;

Canvas.Font.Color := Font.Color;

Canvas.TextRect(Rect, Rect.Left + 2, Rect.Top + 2,

Cells[ACol, ARow]);

end;

end;

procedure TNewTaskForm.OKButtonClick(Sender: TObject);

var

i: Integer;

LCanonicalForm: Boolean;

begin

LCanonicalForm := True;

for i:= 0 to FM - 1 do

begin

if TComboBox(FSigns.Items[i]).ItemIndex > 0 then

begin

LCanonicalForm := False;

end;

end;

FNMatrix := GetMatrix(MatrixNGrid);

FVectorb := GetVector(VectorbGrid);

FVectorc := GetVector(VectorcGrid);

if not LCanonicalForm then

begin

for i := 0 to FM - 1 do

begin

case TComboBox(FSigns.Items[i]).ItemIndex of

1: begin

Inc(FN);

SetLength(FVectorc, FN);

FVectorc[FN - 1] := 0;

SetLength(FNMatrix, FM, FN);

FNMatrix[i, FN - 1] := - 1;

end;

end;

end;

end;

ModalResult := mrOk;

end;

procedure TNewTaskForm.VectorbGridDrawCell(Sender: TObject; ACol, ARow: Integer; Rect: TRect; State: TGridDrawState);

begin

if Sender = ActiveControl then

Exit;

if not (gdSelected in State) then

Exit;

with Sender as TStringGrid do

begin

Canvas.Brush.Color := Color;

Canvas.Font.Color := Font.Color;

Canvas.TextRect(Rect, Rect.Left + 2, Rect.Top + 2,

Cells[ACol, ARow]);

end;

end;

procedure TNewTaskForm.VectorCGridDrawCell(Sender: TObject; ACol, ARow: Integer; Rect: TRect; State: TGridDrawState);

begin

if Sender = ActiveControl then

Exit;

if not (gdSelected in State) then

Exit;

with Sender as TStringGrid do

begin

Canvas.Brush.Color := Color;

Canvas.Font.Color := Font.Color;

Canvas.TextRect(Rect, Rect.Left + 2, Rect.Top + 2,

Cells[ACol, ARow]);

end;

end;

end.

unit TaskSizeFormUnit;

interface

uses

Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,

Dialogs, StdCtrls, Spin, Buttons;

const

STR_WRONG_NUMBER_RANGE = 'Число должно быть в диапазоне: 1..10';

STR_WRONG_NUMBER_FORMAT = 'Неправильный формат числа!';

type

TTaskSizeForm = class(TForm)

NLabel: TLabel;

MLabel: TLabel;

OkBitBtn: TBitBtn;

GroupBox: TGroupBox;

CancelBitBtn: TBitBtn;

seM: TSpinEdit;

procedure FormShow(Sender: TObject);

procedure OkBitBtnClick(Sender: TObject);

private

FM: Integer; // Кол-во ограничений

function GetM: Integer;

public

property M: Integer read GetM;

end;

implementation

{$R *.dfm}

procedure TTaskSizeForm.FormShow(Sender: TObject);

begin

if OkBitBtn.CanFocus then

begin

OkBitBtn.SetFocus;

end;

end;

function TTaskSizeForm.GetM: Integer;

begin

Result := FM;

end;

procedure TTaskSizeForm.OkBitBtnClick(Sender: TObject);

var

LValue: Integer;

begin

try

LValue := StrToInt(seM.Text);

if (LValue < 1) or (LValue > 10) then

begin

MessageDlg(STR_WRONG_NUMBER_RANGE, mtError, [mbOK], 0);

end else

begin

FM := LValue;

ModalResult := mrOk;

end;

except

MessageDlg(STR_WRONG_NUMBER_FORMAT, mtError, [mbOK], 0);

end;

end;

end.

информация безопасность программа модуль

Приложение Б

Формы программы

1) Главная форма (рисунок 6).

Рисунок 6 - Главная форма

2) Окно задания размера новой таблицы (рисунок 7).



Рисунок 7 - Окно задания размера новой таблицы

3) Окно заполнения таблицы данными (рисунок 8).

Рисунок 8 - Окно заполнения таблицы данными

Размещено на Allbest.ru