Навигация
Главная
Поиск
Форум
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
HACK F.A.Q 65535
Бип из системно... 65535
Гостевая книга ... 65535
Invision Power ... 65535
Пример работы с... 65535
Содержание сайт... 65535
Организация зап... 65535
Вызов хранимых ... 65535
Создание отчето... 65535
Программируемая... 65535
Эмулятор микроп... 65535
Подключение Mic... 65535
Создание потоко... 65535
Приложение «Про... 65535
Оператор выбора... 65535
Модуль Forms 65409
ТЕХНОЛОГИИ ДОСТ... 62301
Имитационное мо... 57989
Реклама
Сейчас на сайте
Гостей: 7
На сайте нет зарегистрированных пользователей

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

Моделирование интернет кафе на GPSS + Отчет
Игра Sokoban на Delphi + Блок схемы
Моделирование работы узла коммутации сообщений на GPSS + Пояснительная з...

Реклама



Подписывайся на YouTube канал о программировании, что бы не пропустить новые видео!

ПОДПИСЫВАЙСЯ на канал о программировании
Метод обратного размещения элементов
Проект на 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 22:17:04 · 1 Комментариев · 7977 Прочтений · Для печати

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


Комментарии
Skrip November 11 2010 07: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...
Шаблон для новост...

Случайные загрузки
Программирование ...
Иллюстрированный ...
MxProtector
ИНТЕРНЕТ ПРОГРАММ...
PRNDbgrid
Counter [Исходник...
EMSQuickImport
База данных фильм...
С. Г. Горнаков - ...
Abbrevia
Создание меню на ...
SendSMS для PHP-F...
DateEdit
Программирование ...
XPmenu
Srinilist
MP3 Архив v.2.0
Основы Delphi
Редактор анимаций
Формирование отче...

Топ загрузок
Приложение Клие... 100471
Delphi 7 Enterp... 87432
Converter AMR<-... 20080
GPSS World Stud... 13063
Borland C++Buil... 11922
Borland Delphi ... 8631
Turbo Pascal fo... 7041
Visual Studio 2... 5000
Калькулятор [Ис... 4853
FreeSMS v1.3.1 3543
Случайные статьи
Глава 18. Страт...
Структура
Подробнее об экспо...
Типы raw
Разработать прикл...
Как сделать URL по...
Константы системны...
Раскрутка, путем р...
Определение нештат...
Русские новинки
Программа печатает...
Сохранение изображ...
Видео – залог успе...
узлами и что сеанс...
Шаблоны и обобщенн...
Персептрону. Пробл...
основное имя польз...
Функция MessageBox...
Модель данных XFor...
Создание объектов,...
6.11. Вычисление ...
Professional
Геометрические фигуры
Guide Plus+
Это и есть ПАР
Статистика



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


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