Навигация
Главная
Поиск
Форум
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
Подключение Mic... 65535
Создание потоко... 65535
Приложение «Про... 65535
Оператор выбора... 65535
Создание отчето... 65056
Модуль Forms 64835
Пример работы с... 63233
ТЕХНОЛОГИИ ДОСТ... 61547
Имитационное мо... 57386
Реклама
Сейчас на сайте
Гостей: 9
На сайте нет зарегистрированных пользователей

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

Моделирование литейного цеха на GPSS + Пояснительная записка
Принадлежит ли точка пересечению двух окружностей на Turbo Pascal + Отче...
Программа тестирования и обучающая программа по математике на Turbo Pasc...

Реклама



Подписывайся на 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 Комментариев · 7932 Прочтений · Для печати

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


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

Случайные загрузки
Алгоритм DES шифр...
Szwavepanel
3D Октаэдр
Delphi. Готовые а...
RSS Feeds
Панель для реклам...
VFW
Dbgridpack
XPATComponents
Ранги для форума
Swat [Исходник на...
Пятнашки и крести...
Abbrevia
Java в примерах -...
AID антивирус
Эффект лампы на р...
PHP/MySQL для нач...
Tenis [Исходник н...
iComm v.6.1 - выв...
Аватары в комме...

Топ загрузок
Приложение Клие... 100466
Delphi 7 Enterp... 86607
Converter AMR<-... 20077
GPSS World Stud... 12632
Borland C++Buil... 11751
Borland Delphi ... 8555
Turbo Pascal fo... 7037
Visual Studio 2... 4998
Калькулятор [Ис... 4759
FreeSMS v1.3.1 3541
Случайные статьи
Дополнительная инф...
Перегрузка операци...
Установка драйверо...
Конфигурация серве...
Создатели Windows ...
Invalid floating-p...
Палитра VGA: управ...
Самоуправление или...
Значения параметро...
Наиболее сложная л...
Преобразование теп...
Для восстановления...
Внедрение технолог...
Шаблон типа regex
memory_object_data...
Плохая функция: ве...
Каналы Ethernet LA...
Глава 15
Подготовка файла a...
Присваивайте назва...
Circular unit refe...
Уничтожение бумаги
Вычислительная сет...
Преобразование тип...
Предварительные св...
Статистика



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


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