Процедура выбора наилучшей альтернативы
procedure TForm1.BitBtn1Click(Sender: TObject);
var i,k,j,n,idxMax : integer;
max,z:real;
str : string;
begin
if stringgrid1.Cells[1,1]='' then
begin
showmessage('Введите данные');
exit;
end;
max := -99999999;
idxMax := 1;
for j := 1 to StringGrid1.RowCount-1 do
begin
z:=0;
for i := 1 to StringGrid1.ColCount-1 do
z := z + StrToFloat(stringgrid3.cells[i,1])*(StrToFloat(stringgrid1.cells[i,j]) - StrToFloat(stringgrid2.cells[i,1]));
if z>max then
begin
max := z;
idxMax := j;
end;
end;
if max >=0 then
label4.Caption := 'A' +IntToStr(idxMax)
else
label4.Caption := 'нет'
end;
изменение размеров массива (добавление крнитериев) при изменении полей Edit2
procedure TForm1.Change_size(Sender: TObject);
var i:integer;
begin
if Edit1.Text='' then exit;
Stringgrid1.ColCount:=strtoint(Edit1.Text)+1;
for i:=1 to strtoint(Edit1.Text)+1 do
begin
Stringgrid1.Cells[i,0]:='k'+inttostr(i);
end;
Stringgrid2.ColCount:=strtoint(Edit1.Text)+1;
for i:=1 to strtoint(Edit1.Text)+1 do
begin
Stringgrid2.Cells[i,0]:='k'+inttostr(i);
end;
Stringgrid3.ColCount:=strtoint(Edit1.Text)+1;
for i:=1 to strtoint(Edit1.Text)+1 do
begin
Stringgrid3.Cells[i,0]:='k'+inttostr(i);
end;
end;
Блок схема
изменение размеров массива (добавление альтернатив) при изменении поля Edit1
procedure TForm1.Change_size2(Sender: TObject);
var i:integer;
begin
if Edit2.Text='' then exit;
Stringgrid1.RowCount:=strtoint(Edit2.Text)+1;
for i:=1 to strtoint(Edit2.Text)+1 do
begin
Stringgrid1.Cells[0,i]:='a'+inttostr(i);
end;
end;
Подготовка массива с учетом значений по умолчанию
procedure TForm1.CCreate__(Sender: TObject);
var i:integer;
begin
Stringgrid1.ColCount:=strtoint(Edit1.Text)+1;
for i:=1 to strtoint(Edit2.Text)+1 do
begin
Stringgrid1.Cells[0,i]:='a'+inttostr(i);
end;
Stringgrid1.ColCount:=strtoint(Edit1.Text)+1;
for i:=1 to strtoint(Edit1.Text)+1 do
begin
Stringgrid1.Cells[i,0]:='k'+inttostr(i);
end;
Stringgrid2.ColCount:=strtoint(Edit1.Text)+1;
for i:=1 to strtoint(Edit1.Text)+1 do
begin
Stringgrid2.Cells[i,0]:='k'+inttostr(i);
end;
Stringgrid3.ColCount:=strtoint(Edit1.Text)+1;
for i:=1 to strtoint(Edit1.Text)+1 do
begin
Stringgrid3.Cells[i,0]:='k'+inttostr(i);
end;
end;
Закрытие программы
procedure TForm1.N2Click(Sender: TObject);
begin
close;
end;
Сохранение результатов
procedure TForm1.N4Click(Sender: TObject);
var s:tstrings;
begin
s:=tstringlist.Create;
s.Add(label4.Caption);
if label4.Caption<>'' then
s.SaveToFile('result.txt')
else
showmessage('Now results');
end;
Исходный текст
Unit1.pas
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, Grids, Buttons, Menus, ComCtrls, ExtDlgs;
type
TForm1 = class(TForm)
StringGrid1: TStringGrid;
Edit1: TEdit;
Edit2: TEdit;
Label1: TLabel;
StringGrid2: TStringGrid;
Label2: TLabel;
Label3: TLabel;
StringGrid3: TStringGrid;
BitBtn1: TBitBtn;
Label4: TLabel;
MainMenu1: TMainMenu;
N1: TMenuItem;
N2: TMenuItem;
N3: TMenuItem;
StatusBar1: TStatusBar;
N4: TMenuItem;
procedure Change_size(Sender: TObject);
procedure Change_size2(Sender: TObject);
procedure BitBtn1Click(Sender: TObject);
procedure CCreate__(Sender: TObject);
procedure N2Click(Sender: TObject);
procedure N4Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
const n=100;
s=100;
var
Form1: TForm1;
X: array[1..s] of real;
A: array[1..n] of real;
implementation
{$R *.dfm}
procedure TForm1.Change_size(Sender: TObject);
var i:integer;
begin
if Edit1.Text='' then exit;
Stringgrid1.ColCount:=strtoint(Edit1.Text)+1;
for i:=1 to strtoint(Edit1.Text)+1 do
begin
Stringgrid1.Cells[i,0]:='k'+inttostr(i);
end;
Stringgrid2.ColCount:=strtoint(Edit1.Text)+1;
for i:=1 to strtoint(Edit1.Text)+1 do
begin
Stringgrid2.Cells[i,0]:='k'+inttostr(i);
end;
Stringgrid3.ColCount:=strtoint(Edit1.Text)+1;
for i:=1 to strtoint(Edit1.Text)+1 do
begin
Stringgrid3.Cells[i,0]:='k'+inttostr(i);
end;
end;
procedure TForm1.Change_size2(Sender: TObject);
var i:integer;
begin
if Edit2.Text='' then exit;
Stringgrid1.RowCount:=strtoint(Edit2.Text)+1;
for i:=1 to strtoint(Edit2.Text)+1 do
begin
Stringgrid1.Cells[0,i]:='a'+inttostr(i);
end;
end;
procedure TForm1.BitBtn1Click(Sender: TObject);
var i,k,j,n,idxMax : integer;
max,z:real;
str : string;
begin
if stringgrid1.Cells[1,1]='' then
begin
showmessage('Введите данные');
exit;
end;
max := -99999999;
idxMax := 1;
for j := 1 to StringGrid1.RowCount-1 do
begin
z:=0;
for i := 1 to StringGrid1.ColCount-1 do
z := z + StrToFloat(stringgrid3.cells[i,1])*(StrToFloat(stringgrid1.cells[i,j]) - StrToFloat(stringgrid2.cells[i,1]));
if z>max then
begin
max := z;
idxMax := j;
end;
end;
if max >=0 then
label4.Caption := 'Наилучшей альтернативой является: A' +IntToStr(idxMax)
else
label4.Caption := 'Наилучшей альтернативы НЕТ'
end;
procedure TForm1.CCreate__(Sender: TObject);
var i:integer;
begin
Stringgrid1.ColCount:=strtoint(Edit1.Text)+1;
for i:=1 to strtoint(Edit2.Text)+1 do
begin
Stringgrid1.Cells[0,i]:='a'+inttostr(i);
end;
Stringgrid1.ColCount:=strtoint(Edit1.Text)+1;
for i:=1 to strtoint(Edit1.Text)+1 do
begin
Stringgrid1.Cells[i,0]:='k'+inttostr(i);
end;
Stringgrid2.ColCount:=strtoint(Edit1.Text)+1;
for i:=1 to strtoint(Edit1.Text)+1 do
begin
Stringgrid2.Cells[i,0]:='k'+inttostr(i);
end;
Stringgrid3.ColCount:=strtoint(Edit1.Text)+1;
for i:=1 to strtoint(Edit1.Text)+1 do
begin
Stringgrid3.Cells[i,0]:='k'+inttostr(i);
end;
end;
procedure TForm1.N2Click(Sender: TObject);
begin
close;
end;
procedure TForm1.N4Click(Sender: TObject);
var s:tstrings;
begin
s:=tstringlist.Create;
s.Add(label4.Caption);
if label4.Caption<>'' then
s.SaveToFile('result.txt')
else
showmessage('Нет результата');
end;
end.
Unit1.dfm
object Form1: TForm1
Left = 307
Top = 82
BorderIcons = [biSystemMenu, biMinimize]
BorderStyle = bsSingle
Caption = #1042#1099#1073#1086#1088' '#1085#1072#1080#1083#1091#1095#1096#1080#1093' '#1072#1083#1100#1090#1077#1088#1085#1072#1090#1080#1074' '#1089' '#1080#1089#1087#1086#1083#1100#1079#1086#1074#1072#1085#1080#1077#1084' '#1084#1077#1090#1086#1076#1086#1074' '#1086#1087#1090#1080#1084#1080#1079#1072#1094#1080#1080
ClientHeight = 438
ClientWidth = 507
Color = clBtnFace
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'MS Sans Serif'
Font.Style = []
Menu = MainMenu1
OldCreateOrder = False
OnCreate = CCreate__
PixelsPerInch = 96
TextHeight = 13
object Label1: TLabel
Left = 8
Top = 32
Width = 152
Height = 13
Caption = #1040#1083#1100#1090#1077#1088#1085#1072#1090#1080#1074#1099'/'#1050#1088#1080#1090#1077#1088#1080#1080':'
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'MS Sans Serif'
Font.Style = [fsBold]
ParentFont = False
end
object Label2: TLabel
Left = 8
Top = 224
Width = 238
Height = 13
Caption = #1074#1077#1082#1090#1086#1088' '#1087#1086#1088#1086#1075#1086#1074#1099#1093' '#1079#1085#1072#1095#1077#1085#1080#1081' '#1082#1088#1080#1090#1077#1088#1080#1077#1074':'
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'MS Sans Serif'
Font.Style = [fsBold]
ParentFont = False
end
object Label3: TLabel
Left = 8
Top = 312
Width = 173
Height = 13
Caption = #1074#1077#1082#1090#1086#1088' '#1074#1072#1078#1085#1086#1089#1090#1080' '#1082#1088#1080#1090#1077#1088#1080#1077#1074':'
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'MS Sans Serif'
Font.Style = [fsBold]
ParentFont = False
end
object Label4: TLabel
Left = 8
Top = 400
Width = 5
Height = 16
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -13
Font.Name = 'MS Sans Serif'
Font.Style = [fsBold]
ParentFont = False
end
object StringGrid1: TStringGrid
Left = 8
Top = 48
Width = 481
Height = 169
ColCount = 3
RowCount = 3
Options = [goFixedVertLine, goFixedHorzLine, goVertLine, goHorzLine, goRangeSelect, goEditing]
TabOrder = 0
end
object Edit1: TEdit
Left = 72
Top = 8
Width = 49
Height = 21
TabOrder = 1
Text = '2'
OnChange = Change_size
end
object Edit2: TEdit
Left = 8
Top = 8
Width = 49
Height = 21
TabOrder = 2
Text = '2'
OnChange = Change_size2
end
object StringGrid2: TStringGrid
Left = 8
Top = 240
Width = 481
Height = 65
ColCount = 3
RowCount = 2
Options = [goFixedVertLine, goFixedHorzLine, goVertLine, goHorzLine, goRangeSelect, goEditing]
TabOrder = 3
end
object StringGrid3: TStringGrid
Left = 8
Top = 328
Width = 481
Height = 65
ColCount = 3
RowCount = 2
Options = [goFixedVertLine, goFixedHorzLine, goVertLine, goHorzLine, goRangeSelect, goEditing]
TabOrder = 4
ColWidths = (
64
64
64)
end
object BitBtn1: TBitBtn
Left = 240
Top = 8
Width = 129
Height = 25
Caption = #1056#1072#1089#1089#1095#1080#1090#1072#1090#1100
Font.Charset = RUSSIAN_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'Verdana'
Font.Style = [fsBold, fsUnderline]
ParentFont = False
TabOrder = 5
OnClick = BitBtn1Click
end
object StatusBar1: TStatusBar
Left = 0
Top = 419
Width = 507
Height = 19
Panels = <>
end
object MainMenu1: TMainMenu
Left = 360
Top = 24
object N1: TMenuItem
Caption = #1060#1072#1081#1083
object N4: TMenuItem
Caption = #1057#1086#1093#1088#1072#1085#1080#1090#1100' '#1088#1077#1079#1091#1083#1100#1090#1072#1090#1099
OnClick = N4Click
end
object N3: TMenuItem
Caption = '-'
end
object N2: TMenuItem
Caption = #1042#1099#1093#1086#1076
OnClick = N2Click
end
end
end
end
|
Главная
Каталог файлов
