Навигация
Главная
Поиск
Форум
FAQ's
Ссылки
Карта сайта
Чат программистов

Статьи
-Delphi
-C/C++
-Turbo Pascal
-Assembler
-Java/JS
-PHP
-Perl
-DHTML
-Prolog
-GPSS
-Сайтостроительство
-CMS: PHP Fusion
-Инвестирование

Файлы
-Для программистов
-Компонеты для Delphi
-Исходники на Delphi
-Исходники на C/C++
-Книги по Delphi
-Книги по С/С++
-Книги по JAVA/JS
-Книги по Basic/VB/.NET
-Книги по PHP/MySQL
-Книги по Assembler
-PHP Fusion MOD'ы
-by Kest
Professional Download System
Реклама
Услуги

Автоматическое добавление статей на сайты на Wordpress, Joomla, DLE
Заказать продвижение сайта
Программа для рисования блок-схем
Инженерный калькулятор онлайн
Таблица сложения онлайн
Популярные статьи
OpenGL и Delphi... 65535
Форум на вашем ... 65535
21 ошибка прогр... 65535
HACK F.A.Q 65535
Бип из системно... 65535
Гостевая книга ... 65535
Invision Power ... 65535
Пример работы с... 65535
Содержание сайт... 65535
ТЕХНОЛОГИИ ДОСТ... 65535
Организация зап... 65535
Вызов хранимых ... 65535
Создание отчето... 65535
Имитационное мо... 65535
Программируемая... 65535
Эмулятор микроп... 65535
Подключение Mic... 65535
Создание потоко... 65535
Приложение «Про... 65535
Оператор выбора... 65535
Реклама
Сейчас на сайте
Гостей: 11
На сайте нет зарегистрированных пользователей

Пользователей: 13,372
новичок: vausoz
Новости
Реклама
Выполняем курсовые и лабораторные по разным языкам программирования
Подробнее - курсовые и лабораторные на заказ
Delphi, Turbo Pascal, Assembler, C, C++, C#, Visual Basic, Java, GPSS, Prolog, 3D MAX, Компас 3D
Заказать программу для Windows Mobile, Symbian

моделирование процесса поступления заявок в ЭВМ на GPSS + Пояснительная ...
Движение шарика в эллиптическои параболоиде на Delphi [OpenGL] + Блок схемы
База данных студентов на Delphi (файл записей) + Блок схемы

Метод обратного размещения элементов
Проект на Delphi 7:


unit UnitReturnAllocation;

interface

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, Menus, Grids, StdCtrls, ExtCtrls;



type
TFormReturnAllocation = class(TForm)
SGC: TStringGrid;
MainMenu: TMainMenu;
NFile: TMenuItem;
FileOpen: TMenuItem;
FileSave: TMenuItem;
N1: TMenuItem;
FileExit: TMenuItem;
Data: TMenuItem;
DataClear: TMenuItem;
DataCalculate: TMenuItem;
N2: TMenuItem;
SGD: TStringGrid;
OpenDialog: TOpenDialog;
SaveDialog: TSaveDialog;
SGR: TStringGrid;
Label1: TLabel;
EditL1: TLabeledEdit;
EditL2: TLabeledEdit;
CountElem: TMenuItem;
Label2: TLabel;
Label3: TLabel;
procedure DataClearClick(Sender: TObject);
procedure FileOpenClick(Sender: TObject);
procedure FileSaveClick(Sender: TObject);
procedure DataCalculateClick(Sender: TObject);
procedure FormShow(Sender: TObject);
procedure FileExitClick(Sender: TObject);
procedure CountElemClick(Sender: TObject);

private
{ Private declarations }
public
{ Public declarations }
end;

Const
MaxN = 50; //Максимальное число элементов

type
TVector = Record
M : Array[1..MaxN] of Word; // Элементы строки
S : Word; // Сумма элементов строки
Num : Word; // Первоначальный номер элемента
End;
TArray = Array[1..MaxN] of TVector;
var
FormReturnAllocation: TFormReturnAllocation;
C, D : TArray; //Массивы данных
N : Word; //Число элементов на плате


//////////////////////////////////////////////////////////////////////
//// Процедуры обработки данных
//////////////////////////////////////////////////////////////////////
// Суммирует элементы строк массива и записывает суммы в специальный элемент
// записи
//Параметры:
//Arr - тип TArray - передается по ссылке
// обрабатываемый массив

Procedure CalculateLinesSum(Var Arr : TArray);

//Производит сортировку переданного массива по возрастанию или убыванию
//значения суммы строки
//Параметры:
//Arr - тип TArray - передается по ссылке
// обрабатываемый массив
//Direction - тип Boolean - передается по значению
// True - по возрастанию, False - по убыванию

Procedure SortArrayByLineSum(Var Arr : TArray; Direction : boolean = True);

// Вычисляет число L по переданным массивам
//Параметры:
//C, D - тип TArray - передаются по значению
// массивы по данным которых вычисляется оценка L
//Возвращаемое значение:
// Оценка L, тип double

Function CalculateL(C, D : TArray) : Double;

////////////////////////////////////////////////////////////////////
//// Интерфейсные процедуры и функции
////////////////////////////////////////////////////////////////////
//Прорисовка заголовков строк и столбцов
//Параметры:
// MaxCount - тип Word
// - число столбцов и строк
// Obj - тип TStringGrid, нулевые строки и столбцы заполняются цифрами
// от 1 до MaxCount

Procedure DrawColumnHeaders(MaxDimension : Word; Var Obj : TStringGrid);

//Отображает результат размещения в таблице SG по данным из
//массивов Arr1 и Arr2

Procedure LoadResult(Arr1, Arr2 : TArray; Var SG : TStringGrid);



////////////////////////////////////////////////////////////////////
//// Процедуры преобразования данных массивов и таблиц формы
////////////////////////////////////////////////////////////////////

//Обновляет массив по таблице StringGrid
//с проверкой корректности введенных данных;
//некорректные данные заменяются нулями
//Параметры:
// SG - тип TStringGrid
// - таблица с данными, которые ввел пользователь
// Arr - тип TArray
// - массив, в который будут загружены корректные данные

Procedure StringGridToArray(SG : TStringGrid; Var Arr : TArray);

//Обновляет таблицу SG из массива Arr
//Параметры:
// SG - тип TStringGrid
// - таблица с данными, которые отображаются пользователю
// Arr - тип TArray
// - массив, из который будут загружены данные

Procedure ReloadStringGrid(Var SG : TStringGrid; Arr : TArray);

implementation

{$R *.dfm}

//////////////////////////////////////////////////////////////////////
//// Процедуры обработки данных

// Суммирует элементы строк массива и записывает суммы в специальный элемент
// записи
//Параметры:
//Arr - тип TArray - передается по ссылке
// обрабатываемый массив

Procedure CalculateLinesSum(Var Arr : TArray);
Var S : Word;
i,j : word;
Begin
// перебор по строкам
For i := 1 To N-1 do
begin
// инициализация накопителя суммы
S := 0;
// перебор элементов вектора
For j := 1 to N-1 do
S := S + Arr[i].M[j]; // накопление суммы
// присвоение суммы соотв. элементу записи
Arr[i].S := S;
end;
End;

//Производит сортировку переданного массива по возрастанию или убыванию
//значения суммы строки
//Параметры:
//Arr - тип TArray - передается по ссылке
// обрабатываемый массив
//Direction - тип Boolean - передается по значению
// True - по возрастанию, False - по убыванию

Procedure SortArrayByLineSum(Var Arr : TArray; Direction : boolean = True);
Var i, t : Word; // вспомогательные переменные
A : TVector; // Аккумулятор
Begin
If Direction
Then
For t := 2 to N-1 Do
For i:=t to N-1 Do
Begin
// сравниваем сумму строки с суммой предыдущей строки
// если сумма больше, то меняем строки местами
If Arr[i].S < Arr[i-1].S
Then
Begin
A := Arr[i];
Arr[i] := Arr[i-1];
Arr[i-1] := A;
End;
End
Else
For t := N-1 DownTo 2 Do
For i := N-1 DownTo 2 Do
Begin
// сравниваем сумму строки с суммой предыдущей строки
// если сумма больше, то меняем строки местами

If Arr[i].S > Arr[i-1].S
Then
Begin
A := Arr[i];
Arr[i] := Arr[i-1];
Arr[i-1] := A;
End;
End;
End; // Procerure SortArrayByLineSum

// Вычисляет число L по переданным массивам
//Параметры:
//C, D - тип TArray - передаются по значению
// массивы по данным которых вычисляется оценка L
//Возвращаемое значение:
// Оценка L, тип double

Function CalculateL(C, D : TArray) : Double;
var Sum : Extended; //Переменная для накопления суммы
i,j : word; //Итераторы циклов
Begin
// инициализация суммы
Sum := 0;
// циклы перебора элементов
For i := 1 to N-1 do
For j := 1 to N-1 do
Sum := Sum + C[i].M[j] * D[i].M[j];
//Вычисляем 1/2 от суммы согласно алгоритму
Sum := 0.5 * Sum;
//Возврат вычисленного значения
CalculateL := Sum;
End; // Function CalculateL


////////////////////////////////////////////////////////////////////
//// Интерфейсные процедуры и функции

//Прорисовка заголовков строк и столбцов
//Параметры:
// MaxCount - тип Word
// - число столбцов и строк
// Obj - тип TStringGrid, нулевые строки и столбцы заполняются цифрами
// от 1 до MaxCount

Procedure DrawColumnHeaders(MaxDimension : Word; Var Obj : TStringGrid);
Var i : Word; //итератор цикла
Begin
//Проверить, является ли переданный объект
//таблицей результата
If Obj.ColCount = 2
Then //Переданный объект является таблицей результата
begin
Obj.Cells[0,0] := 'Элемент';
Obj.Cells[1,0] := 'Позиция';
Obj.RowCount := MaxDimension;
Obj.FixedRows := 1;
//Obj.RowCount := MaxDimension;
end
Else //Переданный объект является таблицей данных
Begin
Obj.ColCount := MaxDimension;
Obj.RowCount := MaxDimension;
Obj.FixedCols := 1;
Obj.FixedRows := 1;
For i := 1 to N-1 Do
begin
//заполнение значениями
Obj.Cells[0, i] := IntToStr(i);
Obj.Cells[i, 0] := IntToStr(i);
end;
End;
End; // Procedure DrawColumnHeaders

//Отображает результат размещения в таблице SG по данным из
//массивов Arr1 и Arr2
Procedure LoadResult(Arr1, Arr2 : TArray; Var SG : TStringGrid);
Var
i : Word; //итератор цикла
Begin
For i := 1 To N-1 Do
Begin
SG.Cells[0, i] := IntToStr(Arr1[i].Num);
SG.Cells[1, i] := IntToStr(Arr2[i].Num);
End;
End; //Procedure LoadResult


///////////////////////////////////////////////////////////////////////
//// Обработка событий формы

//Обработка события отображения формы

procedure TFormReturnAllocation.FormShow(Sender: TObject);
Var Num : Integer;
begin
// Инициализируем файловые диалоги
OpenDialog.InitialDir := Copy(ParamStr(0), 0, Length(Application.ExeName));
SaveDialog.InitialDir := Copy(ParamStr(0), 0, Length(Application.ExeName));
// Задание начального количества элементов
N := 5;
// Заполнение таблиц нулями
DataClearClick(Sender);
//Установка заголовков таблиц
DrawColumnHeaders(N, SGC);
DrawColumnHeaders(N, SGD);
DrawColumnHeaders(N, SGR);
end;





///////////////////////////////////////////////////////////////////////////
//// Процедуры преобразования данных массивов и таблиц формы

//Обновляет массив по таблице StringGrid
//с проверкой корректности введенных данных;
//некорректные данные заменяются нулями
//Параметры:
// SG - тип TStringGrid
// - таблица с данными, которые ввел пользователь
// Arr - тип TArray
// - массив, в который будут загружены корректные данные

Procedure StringGridToArray(SG : TStringGrid; Var Arr : TArray);
Var
i,j : Integer; // Итераторы циклов
NumInt : Integer; // Вспомогательная переменная для попытки преобразования
// строки в целое
Begin
For i:=1 to N-1 do
Begin
For j:=1 to N-1 do // Проверка правильности введенных данных
If TryStrToInt(SG.Cells[j,i], NumInt)
Then
Arr[i].M[j] := NumInt
Else
Arr[i].M[j] := 0;
Arr[i].Num := 0;
End;
End; //Procedure StringGridToArray

//Обновляет таблицу SG из массива Arr
//Параметры:
// SG - тип TStringGrid
// - таблица с данными, которые отображаются пользователю
// Arr - тип TArray
// - массив, из который будут загружены данные

Procedure ReloadStringGrid(Var SG : TStringGrid; Arr : TArray);
Var
i,j : Word; //Вспомогательные переменные циклов
Begin
For i:=1 to N-1 do
For j:=1 to N-1 do
SG.Cells[j,i] := IntToStr(Arr[i].M[j]);
End; //Procedure ReloadStringGrid





//////////////////////////////////////////////////////////////////////////
//// Обработка событий главного меню

// Меню: Файл - Открыть
// Производится выбор открываемого файла с данными,
// проверка соответствия размерности данных в файле
// и размерности N в массив и обновление StringGrid

procedure TFormReturnAllocation.FileOpenClick(Sender: TObject);
Var F : File Of Word; // Файловая переменная
FileName : String; // Путь к открыаемому файлу
i,j : Word; //Переменные итераторы циклов
NewN : Word; //Переменная размерности файла
Num : Word; //Вспомогат. для загрузки числа из файла

begin

// Открываем диалог выбора файла
If OpenDialog.Execute Then
Begin
//Берем путь к имени файла
FileName := OpenDialog.FileName;
//Направляем файловую переменную на файл
AssignFile(F, FileName);
//Открываем файл для чтения
Try //попытка
Reset(F);
Except
MessageDlg('Ошибка чтения из файла!', mtError, [mbOK], 0);
//Выход из процедуры
Exit;
End; // Try
//Считываем размерность из файла
Read(F, NewN);
//Проверяем соответствует ли размерность файла и текущая размерность
//в программе
If N = NewN Then
begin
//Если соответствует, то загружаем данные из файла
For i := 1 To N-1 do
For j := 1 To N-1 do
Begin
Try
Read(F, Num);
Except
MessageDlg('Ошибка чтения файла. Операция прервана.', mtError, [mbOK], 0);
exit;
End;
C[i].M[j] := Num;
End;
For i := 1 To N-1 do
For j := 1 To N-1 do
Begin
Try
Read(F, Num);
Except
MessageDlg('Ошибка чтения файла. Операция прервана.', mtError, [mbOK], 0);
exit;
End;
D[i].M[j] := Num;
End;
//Обновление отображения данных в StringGrid
ReloadStringGrid(SGC, C);
ReloadStringGrid(SGD, D);
//Пересчет сумм строк по загруженным данным
CalculateLinesSum(C);
CalculateLinesSum(D);
end
else
If MessageDlg('Количество элементов из файла отличается от текущего числа элементов. Загрузить данные из файла?', mtConfirmation, [mbYes, mbNo], 0) = mrYes
Then
Begin
//Присвоение значения N записанного в файле
N := NewN;
//Перерисовать интерфейсные объекты
DrawColumnHeaders(N, SGC);
DrawColumnHeaders(N, SGD);
DrawColumnHeaders(N, SGR);
//Чтение данных из файла
For i := 1 To N-1 do
For j := 1 To N-1 do
Begin
Try
Read(F, Num);
Except
MessageDlg('Ошибка чтения файла. Операция прервана.', mtError, [mbOK], 0);
exit;
End;
C[i].M[j] := Num;
End;
For i := 1 To N-1 do
For j := 1 To N-1 do
Begin
Try
Read(F, Num);
Except
MessageDlg('Ошибка чтения файла. Операция прервана.', mtError, [mbOK], 0);
exit;
End;
D[i].M[j] := Num;
End;
//обновление отображаемых данных
ReloadStringGrid(SGC, C);
ReloadStringGrid(SGD, D);
//Пересчет сумм строк по загруженным данным
CalculateLinesSum(C);
CalculateLinesSum(D);
End;

// Очистим индексы
For i := 1 to N-1 do
Begin
C[i].Num := 0;
D[i].Num := 0;
End;

//Закрыть файл
CloseFile(F);
end; // If OpenDialog.Execute
end;

// Меню Файл - Сохранить
procedure TFormReturnAllocation.FileSaveClick(Sender: TObject);
Var F : File Of Word; // Файловая переменная
FileName : String; //Путь к файлу
i, j : Word; //Вспомогательные переменные циклов
Num : Word; //Переменная для перегрузки значений
N1 : Word; //Вспомогательная переменная
begin
//Обновить массивы по таблицам StringGrid
StringGridToArray(SGC, C);
StringGridToArray(SGD, D);

//Открытие диалога сохранения файла
If SaveDialog.Execute Then
Begin
//Берем путь и имя файла
FileName := SaveDialog.FileName;
Try //Попытка
//Связываем файловую переменную с файлом
AssignFile(F, FileName);
//Перезаписываем файл
Rewrite(F);
Except //Исключение
MessageDlg('Ошибка записи в файл!', mtError, [mbOK], 0);
end; //Конец попытки
//Запись размерности в файл
N1 := N;
Write(F, N1);
//Запись данных массивов в файл
For i := 1 To N-1 do
For j := 1 To N-1 do
Begin
Num := C[i].M[j];
Write(F, Num);
End;
For i := 1 To N-1 do
For j := 1 To N-1 do
Begin
Num := D[i].M[j];
Write(F, Num) ;
End;
//Закрыть файл
CloseFile(F);
End
end; //procedure TFormReturnAllocation.FileSaveClick

//
// Очищает данные в интерфейсных таблицах

procedure TFormReturnAllocation.DataClearClick(Sender: TObject);
Var i,j : Word;
begin
For i := 1 to N-1 do
Begin
For j := 1 to N-1 do
begin
SGC.Cells[i,j] := '0';
SGD.Cells[i,j] := '0';
end;
SGR.Cells[0,i] := '';
SGR.Cells[1,i] := '';
End;
end; // Procedure


// Меню Данные - Обработать
procedure TFormReturnAllocation.DataCalculateClick(Sender: TObject);
Var i,j : word; //Переменные циклов
L : Extended; //Значение L

begin

// Проверка правильности введенных данных
//и загрузка данных в массивы
StringGridToArray(SGC, C);
StringGridToArray(SGD, D);
// вычисление L1
L := CalculateL(C, D);
//Вывод L1 на экран
EditL1.Text := FloatToStr(L);
// запись первоначальных номеров векторов в соотв. элементы записей
For i := 1 to N-1 do
Begin
C[i].Num := i;
D[i].Num := i;
End;

//Перерасчет сумм строк по данным
CalculateLinesSum(C);
CalculateLinesSum(D);

//Сортируем строки массива C по возрастанию сумм строк
SortArrayByLineSum(C);
//Сортируем строки массива D по убыванию сумм строк
SortArrayByLineSum(D, False);
//Обновление отображения в таблицах StringGrid
ReloadStringGrid(SGC, C);
ReloadStringGrid(SGD, D);

//Отобразить результат размещения в таблице SGК
LoadResult(C, D, SGR);

//Вычислить L после применения метода обр.размещения
L := CalculateL(C, D);
// Показать L
EditL2.Text := FloatToStr(L);
end; // меню Данные - Обработать

// Меню файл/Выход
procedure TFormReturnAllocation.FileExitClick(Sender: TObject);
begin
Close;
end;

//Меню Данные/Количество элементов
procedure TFormReturnAllocation.CountElemClick(Sender: TObject);
Var Num : Integer;
begin
//Ввод числа элементов
Repeat
TryStrToInt(InputBox('Ввод числа элементов','Число элементов:',IntToStr(N-1)), Num);
Until (Num>2) AND (Num<=MaxN);
N := Num+1;
DrawColumnHeaders(N, SGC);
DrawColumnHeaders(N, SGD);
DrawColumnHeaders(N, SGR);
end;

end. //Конец модуля
Опубликовал Kest January 02 2009 19:17:04 · 1 Комментариев · 9695 Прочтений · Для печати

• Не нашли ответ на свой вопрос? Тогда задайте вопрос в комментариях или на форуме! •


Комментарии
Skrip November 11 2010 04:32:02
Вот программку бы еще вообще было б супер ))
Добавить комментарий
Имя:



smiley smiley smiley smiley smiley smiley smiley smiley smiley
Запретить смайлики в комментариях

Введите проверочный код:* =
Рейтинги
Рейтинг доступен только для пользователей.

Пожалуйста, залогиньтесь или зарегистрируйтесь для голосования.

Нет данных для оценки.
Гость
Имя

Пароль



Вы не зарегистрированны?
Нажмите здесь для регистрации.

Забыли пароль?
Запросите новый здесь.
Поделиться ссылкой
Фолловь меня в Твиттере! • Смотрите канал о путешествияхКак приготовить мидии в тайланде?
Загрузки
Новые загрузки
iChat v.7.0 Final...
iComm v.6.1 - выв...
Visual Studio 200...
CodeGear RAD Stud...
Шаблон для новост...

Случайные загрузки
Программирование ...
Пятнашки и крести...
Основы программир...
Советы от Даниилы...
В.Понамарев - COM...
Trojan [Исходник ...
PDJ_Anima
Blib [Исходник на...
Delphi 7 Enterpri...
Последнее загруж...
Время загрузки ...
Таймер и секундомер
Программирование ...
Swing. Эффектные...
Задача о 8ми ладьях
C# в кратком изло...
Создание Web-сайт...
Ics
Краснов М. - Open...
Мод "проверочный ...

Топ загрузок
Приложение Клие... 100793
Delphi 7 Enterp... 98030
Converter AMR<-... 20298
GPSS World Stud... 17060
Borland C++Buil... 14244
Borland Delphi ... 10376
Turbo Pascal fo... 7392
Калькулятор [Ис... 6082
Visual Studio 2... 5232
Microsoft SQL S... 3674
Случайные статьи
KIMPIS
иллюстрации проект...
Решения к главе 7
ПОКРЫВАЮЩИЕ ИНДЕКСЫ
Мумие алтайское
Что нужно для отпр...
Инструменты для ра...
Инструкция по сбор...
Запись сообщения в...
Игровые аппараты в...
Создание пользоват...
Лицензия Creative ...
Системные вызовы и...
Каталог алгоритмов
Поддержка модемов ...
Масла Meguin
Азартные игры Gmsd...
Выбор технологии
Блоки работы с при...
Часто критически в...
Батуты в СПб попры...
Джет казино
7.2. Поиск в лаб...
Основные принципы ...
При этом не имеет ...
Статистика



Друзья сайта
Программы, игры


Полезно
В какую объединенную сеть входит классовая сеть? Суммирование маршрутов Занимают ли таблицы память маршрутизатора?