Форум программистов
 

Восстановите пароль или Зарегистрируйтесь на форуме, о проблемах и с заказом рекламы пишите сюда - alarforum@yandex.ru, проверяйте папку спам!

Вернуться   Форум программистов > Delphi программирование > Общие вопросы Delphi
Регистрация

Восстановить пароль
Повторная активизация e-mail

Купить рекламу на форуме - 42 тыс руб за месяц

Ответ
 
Опции темы Поиск в этой теме
Старый 15.04.2009, 11:25   #1
Дмитрий Н.
 
Регистрация: 22.02.2009
Сообщений: 7
По умолчанию Доработка программы

Прошу помочь в таком вопросе? Мне надо оформить три "внутренней" сортировки в делфи, где выбиралось бы каким методом сортировать, + надо чтобы показывало в StringGrid разноцветными цветами какие элементы меняются местами.!!!!Прошу помочь в этом вопросе!!!!
""""""""""""""""""""""""""""""""""" "{Шейкер сортировка}
procedure ShakerSort(n:Integer);
Var
j,k,l,r,item:Integer;
begin
l:=2;
r:=n;
k:=n;
repeat
for j:=r downto l do
if a[j-1]>a[j] then
begin
item:=a[j-1];
a[j-1]:=a[j];
a[j]:=item;
k:=j;
end;
l:=k+1;
for j:=l to r do
if a[j-1]>a[j] then
begin
item:=a[j-1];
a[j-1]:=a[j];
a[j]:=item;
k:=j;
end;
r:=k-1;
until l>r;
end;
""""""""""""""""""""""""""""""""""" ""{Сортировка Шелла}
procedure ShellSort(n:Integer);
Const h:Array[1..4] of Integer=(8,4,2,1); {h - массив смещений}
Var
i,j,l,r,w,x:Integer;
begin
for r:=1 to 4 do
begin
l:=h[r];
w:=-l; {"s" - место барьера}
for i:=l+1 to n do {выбираем элемент из входной сортируемой группы}
begin
x:=a[i];
j:=i-l; {"j"-индекс элемента сортируемой группы}
if w=0 then w:=-l;
w:=w+1;
a[w]:=x; {... устанавливаем величину барьера }
while x<a[j] do
begin
a[j+l]:=a[j]; {сдвигаем элементы внутри сортируемой группы}
j:=j-l;
end;
a[j+l]:=x; {вставка элемента}
end;
end;
end;
""""""""""""""""""""""""""""""""""" """"{Пирамидальная сортировка}
»procedure SortHeep(n:Integer);
Var
x,l,r,m:Integer;
procedure Sift; {Просеивание элементов}
Var
i,j :Integer;
flag:Boolean;
begin
i:=l;
j:=2*i;
x:=a[i];
flag:=True; {Досрочный выход из цикла}
while (j<=r)and(flag) do
begin
if (j<r)and(a[j]<=a[j+1]) then j:=j+1;
if x>a[j] then flag:=False
else
begin
a[i]:=a[j];
i:=j;
j:=2*i;
end;
end;
a[i]:=x;
end; {Конец Sift}
begin {Построение пирамиды}
l:=(n div 2)+1;
r:=n;
while l>1 do
begin
l:=l-1;
Sift;
end;
while r>l do {Просеивание x}
begin
x:=a[l];
a[l]:=a[r];
a[r]:=x; {a[r] - верхний элемент пирамиды}
r:=r-1;
Sift;
end;
end;
Дмитрий Н. вне форума Ответить с цитированием
Старый 15.04.2009, 13:04   #2
Скандербег
Форумчанин
 
Регистрация: 04.04.2009
Сообщений: 438
По умолчанию

Выбрать способ сортировки не сложно, а проблема в том, что сортировки даже заметного количества элементов происходят быстро и заметить что там в сетке меняется невозможно. Один выход - замедлить процесс сортировки в сотни раз.
У самого то идеи есть? Как цветом показывать перемещение элементов?
И сколько элементов в массиве? С какого индекса начинается массив?
При общепринятом начальном индексе (0 или 1) в методе "Шелла" есть проблемы (в строке a[w] := x; при первой итерации выход за диапазон индексов массива - Rang check error, т.к. w = -7).
Скандербег вне форума Ответить с цитированием
Старый 15.04.2009, 13:49   #3
Дмитрий Н.
 
Регистрация: 22.02.2009
Сообщений: 7
По умолчанию

Ну глянь я кое-что сделал вот только надо чтобы вместо "+++" закрашивало разными цветами!!!!
Дмитрий Н. вне форума Ответить с цитированием
Старый 15.04.2009, 13:49   #4
Дмитрий Н.
 
Регистрация: 22.02.2009
Сообщений: 7
По умолчанию

unit Unit1;

interface

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

type
TForm1 = class(TForm)
Button1: TButton;
StringGrid1: TStringGrid;
procedure Button1Click(Sender: TObject);
procedure StringGrid1DrawCell(Sender: TObject; ACol, ARow: Integer;
Rect: TRect; State: TGridDrawState);
private
{ Private declarations }
public
{ Public declarations }
end;

var
Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.Button1Click(Sender: TObject);
var min,i,n,j,t,k:integer;
a,prev:array[1..100] of integer;
zam:array[1..2] of integer;
begin
prev[1]:=0;
n:=8; //size of array
Randomize;
for i:=1 to n do a[i]:=random(500)+random(300); //filling array

for i := 1 to n do //start sorting
begin
min := i;
for j := i + 1 to n do
if a[min] > a[j] then
min := j;
t := a[i];
a[i] := a[min];
a[min] := t;

//вывод шага:
for j:=1 to n do
stringgrid1.Cells[j,i]:=inttostr(a[j]); //colls,rows
sleep(500);
form1.Refresh;


if prev[1]<>0 then begin
k:=1;
for j:=1 to n do begin
if prev[j]<>a[j] then begin //zam[k]:=j; inc(k); end;
stringgrid1.Cells[j,i]:=stringgrid1.Cells[j,i]+'+++' ;
//stringgrid1.Cells[j,i] - ячейка, которую надо закрасить
end;
end;
//вставить: zam[1],zam[2] - это индексы ячеек, которые необходимо закрасить
end;
prev:=a;
end;
end;

procedure TForm1.StringGrid1DrawCell(Sender: TObject; ACol, ARow: Integer;
Rect: TRect; State: TGridDrawState);
begin

if (gdFocused in state) then
stringgrid1.Canvas.FillRect(rect);
{stringgrid1.Canvas.Brush.Color := clBlack; }
end;

end.
Дмитрий Н. вне форума Ответить с цитированием
Старый 15.04.2009, 15:08   #5
Скандербег
Форумчанин
 
Регистрация: 04.04.2009
Сообщений: 438
По умолчанию

Код:
procedure TForm1.Button1Click(Sender: TObject);
...
      for j:=1 to n do begin
        if prev[j]<>a[j] then begin //zam[k]:=j; inc(k); end;
//          SG.Cells[j,i] := SG.Cells[j,i] + '+++' ;
          SG.Objects[j, i] := TObject(1); //"метка", по которой раскрашиваем ячейку
...
end;

procedure TForm1.StringGrid1DrawCell(Sender: TObject; ACol, ARow: Integer;
               Rect: TRect; State: TGridDrawState);
var R : TRect;
begin
  R := Rect;
  OffsetRect(R, 0, 2);
  if Integer(StringGrid1.Objects[ACol, ARow]) = 1 then
    StringGrid1.Canvas.Brush.Color := clLime
  else
    StringGrid1.Canvas.Brush.Color := clWhite;
  StringGrid1.Canvas.FillRect(Rect);
  DrawText(StringGrid1.Canvas.Handle, PChar(StringGrid1.Cells[ACol, ARow]), -1, R, DT_LEFT);
end;
Значение свойства таблицы DefaultDrawing должно быть False.
Скандербег вне форума Ответить с цитированием
Старый 15.04.2009, 20:17   #6
Дмитрий Н.
 
Регистрация: 22.02.2009
Сообщений: 7
Радость

Ограмное спасибо!!!
Дмитрий Н. вне форума Ответить с цитированием
Ответ


Купить рекламу на форуме - 42 тыс руб за месяц



Похожие темы
Тема Автор Раздел Ответов Последнее сообщение
Доработка программы калькулятора в генераторе программ YACC gumz Помощь студентам 2 28.12.2008 01:29
Доработка функции Черничный Работа с сетью в Delphi 6 01.08.2008 15:51
доработка алгоритма... Sota Помощь студентам 2 13.06.2008 15:45
Доработка программы... barmaJIei Фриланс 1 24.04.2008 21:23