Главная страница
    Top.Mail.Ru    Яндекс.Метрика
Форум: "Начинающим";
Текущий архив: 2013.03.22;
Скачать: [xml.tar.bz2];

Вниз

Нужно сделать трассировку   Найти похожие ветки 

 
Рома   (2012-01-16 23:28) [0]

Люди помогите сделать трассировку этой программы

unit Main;

interface

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

type
 TMainForm = class(TForm)
   XSizeEdit: TEdit;
   StatusBar: TStatusBar;
   SizeLabel: TLabel;
   TextLabel: TLabel;
   TextEdit: TEdit;
   Cliche: TStringGrid;
   Table: TStringGrid;
   XUpDown: TUpDown;
   XPManifest: TXPManifest;
   CryptButton: TButton;
   DecryptButton: TButton;
   ClicheLabel: TLabel;
   LatticeLabel: TLabel;
   CloseButton: TButton;
   DecryptText: TEdit;
   ResetButton: TButton;
   XLabel: TLabel;
   YSizeEdit: TEdit;
   YUpDown: TUpDown;
   MaxLabel: TLabel;
   Speed: TTrackBar;
   DecryptLabel: TLabel;
   SpeedLabel: TLabel;
   procedure XUpDownClick(Sender: TObject; Button: TUDBtnType);
   procedure CloseButtonClick(Sender: TObject);
   procedure CryptButtonClick(Sender: TObject);
   procedure ResetButtonClick(Sender: TObject);
   procedure ClicheDrawCell(Sender: TObject; ACol, ARow: Integer;
     Rect: TRect; State: TGridDrawState);
   procedure FormCreate(Sender: TObject);
   procedure TableDrawCell(Sender: TObject; ACol, ARow: Integer;
     Rect: TRect; State: TGridDrawState);
   procedure DecryptButtonClick(Sender: TObject);
 end;

var
 MainForm: TMainForm;
 ClicheMatrix:array of array of Boolean;
 TableMatrix:array of array of Char;
 xSize,ySize,AnimatePos,ClichePosX:Byte;

implementation

{$R *.dfm}

procedure TMainForm.CloseButtonClick(Sender: TObject);
begin
 Close;
end;

procedure TMainForm.FormCreate(Sender: TObject);
begin
 ResetButtonClick(nil);
end;

procedure TMainForm.XUpDownClick(Sender: TObject; Button: TUDBtnType);
begin
 ResetButtonClick(nil);
end;

procedure TMainForm.ResetButtonClick(Sender: TObject);
var
 i,j:Integer;
begin
 AnimatePos:=0;
 ClichePosX:=0;
 xSize:=XUpDown.Position;
 ySize:=YUpDown.Position;
 Cliche.ColCount:=xSize;
 Cliche.RowCount:=ySize;
 Table.ColCount:=xSize;
 Table.RowCount:=ySize;

 MaxLabel.Caption:="Максимум "+IntToStr(xSize*ySize)+" символов, всего "+IntToStr(Length(TextEdit.Text))+" символов";

 SetLength(ClicheMatrix,xSize);
 SetLength(TableMatrix,xSize);
 for i:=0 to xSize-1 do
 begin
   SetLength(ClicheMatrix[i],ySize);
   SetLength(TableMatrix[i],ySize);
   for j:=0 to ySize-1 do
   begin
     ClicheMatrix[i][j]:=False;
     TableMatrix[i][j]:=#0;
   end;
 end;
 
 DecryptText.Text:="";
 Cliche.Repaint;
 Table.Repaint;
end;

procedure GetCoords(Position,MaxX,MaxY,x,y:Integer;var dx,dy:Integer);
begin
 case Position of
 1:begin
     dx:=x;
     dy:=y;
   end;
 2:begin
     dx:=x;
     dy:=MaxY-y-1;
   end;
 3:begin
     dx:=MaxX-x-1;
     dy:=y;
   end;
 4:begin
     dx:=MaxX-x-1;
     dy:=MaxY-y-1;
   end;
 end;
end;

procedure TMainForm.CryptButtonClick(Sender: TObject);
var
 i,a,m,c,x,y,dx,dy:Integer;
 Text:String;
 b:Boolean;
 Coords:array of TPoint;
 t:TPoint;
begin
 ResetButtonClick(nil);
 CryptButton.Enabled:=False;

 Text:=TextEdit.Text;
 m:=Length(Text);
 if m>xSize*ySize then
 begin
   MessageBox(Handle,"Слишком длинный текст - увеличьте матрицу!","Ошибка",MB_ICONWARNING);
   CryptButton.Enabled:=True;
   Exit;
 end;
 a:=Ceil(m/4);
 for i:=1 to a*4-m do Text:=Text+" ";

 c:=0;
 repeat
   Randomize;
   x:=Random(xSize);
   y:=Random(ySize);
   b:=True;
   for i:=1 to 4 do
   begin
     GetCoords(i,xSize,ySize,x,y,dx,dy);
     if ClicheMatrix[dx][dy] then
     begin
       b:=False;
       Break
     end;
   end;
   if b then
   begin
     ClicheMatrix[x][y]:=True;
     Inc(c);
   end;
 until c=a;
 Cliche.Repaint;

 for i:=1 to 4 do
 begin
   SetLength(Coords,a);
   c:=0;
   for y:=0 to ySize-1 do
   for x:=0 to xSize-1 do if (c<a) and ClicheMatrix[x][y] then
   begin
     GetCoords(i,xSize,ySize,x,y,dx,dy);
     Coords[c].X:=dx;
     Coords[c].Y:=dy;
     Inc(c);
   end;

   for x:=1 to a-1 do
   for y:=a-1 downto x do
   if (Coords[y-1].Y>Coords[y].Y) or ((Coords[y-1].Y=Coords[y].Y) and (Coords[y-1].X>Coords[y].X)) then
   begin
     t:=Coords[y-1];
     Coords[y-1]:=Coords[y];
     Coords[y]:=t;
   end;

   for x:=0 to a-1 do TableMatrix[Coords[x].X][Coords[x].Y]:=Text[a*(i-1)+x+1];
 end;

 for y:=0 to ySize-1 do
 for x:=0 to xSize-1 do if TableMatrix[x][y]=#0 then
 begin
   Randomize;
   c:=192+Random(65);
   if c=256 then c:=32;
   TableMatrix[x][y]:=Char(c);
 end;
 Table.Repaint;
 CryptButton.Enabled:=True;
end;

procedure TMainForm.ClicheDrawCell(Sender: TObject; ACol, ARow: Integer;
 Rect: TRect; State: TGridDrawState);
var
 Color:TColor;
 ShiftX:Integer;
begin
 Color:=clBlack;
 if Length(ClicheMatrix)>0 then
 begin
   ShiftX:=ACol-ClichePosX;
   if ((ShiftX>=0) and ClicheMatrix[ShiftX][ARow]) or (ClichePosX>ACol) then Color:=clWhite;
 end;
 Cliche.Canvas.Brush.Color:=Color;
 Cliche.Canvas.FillRect(Rect);
end;

procedure TMainForm.TableDrawCell(Sender: TObject; ACol, ARow: Integer;
 Rect: TRect; State: TGridDrawState);
var
 Color:TColor;
 c:Char;
 s:array[0..1] of Char;
 dx,dy:Integer;
 ShiftX:Integer;
begin
 Color:=clWhite;
 if AnimatePos>0 then
 begin
   Color:=clBlack;
   ShiftX:=xSize-ClichePosX+ACol;
   if (ShiftX>=0) and (ShiftX<xSize) then
   begin
     GetCoords(AnimatePos,xSize,ySize,ShiftX,ARow,dx,dy);
     if ClicheMatrix[dx][dy] then Color:=clWhite;
   end;
   if (ACol>=ClichePosX) then Color:=clWhite;
 end;

 Table.Canvas.Brush.Color:=Color;
 Table.Canvas.FillRect(Rect);
 if Length(TableMatrix)>0 then
 begin
   c:=TableMatrix[ACol][ARow];
   if c<>#0 then ExtTextOut(Table.Canvas.Handle,Rect.Left+(Rect.Right-Rect.Left-Table.Canvas.TextWidth(c)) div 2,Rect.Top+2,ETO_OPAQUE or ETO_CLIPPED,@Rect,StrPCopy(s,c),1,nil);
 end;
end;

procedure TMainForm.DecryptButtonClick(Sender: TObject);
var
 i,x,y,dx,dy:Integer;
begin
 DecryptButton.Enabled:=False;
 DecryptText.Text:="";

 AnimatePos:=1;
 for i:=0 to xSize do
 begin
   ClichePosX:=i;
   Cliche.Repaint;
   Table.Repaint;
   Application.ProcessMessages;
   Sleep(50*Speed.Position);
 end;

 for i:=1 to 4 do
 begin
   AnimatePos:=i;
   Cliche.Repaint;
   Table.Repaint;
   Application.ProcessMessages;
   Sleep(200*Speed.Position);
   for y:=0 to ySize-1 do
   for x:=0 to xSize-1 do
   begin
     GetCoords(i,xSize,ySize,x,y,dx,dy);
     if ClicheMatrix[dx][dy] then
     begin
       DecryptText.Text:=DecryptText.Text+TableMatrix[x][y];
       Application.ProcessMessages;
       Sleep(5*Speed.Position);
     end;
   end;
   Application.ProcessMessages;
   Sleep(200*Speed.Position);
 end;

 DecryptText.Text:=Trim(DecryptText.Text);

 AnimatePos:=1;
 for i:=xSize downto 0 do
 begin
   ClichePosX:=i;
   if ClichePosX=0 then AnimatePos:=0;
   Cliche.Repaint;
   Table.Repaint;
   if ClichePosX>0 then
   begin
     Application.ProcessMessages;
     Sleep(50*Speed.Position);
   end;
 end;
 DecryptButton.Enabled:=True;
end;

end.


 
Самуилыч   (2012-01-16 23:34) [1]

А в чем проблема-то? Дебаггер не работает?


 
Сергей М. ©   (2012-01-16 23:38) [2]

Начнем с того КОМУ нужно) ..


 
Рома   (2012-01-16 23:52) [3]

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


 
Рома   (2012-01-17 00:00) [4]

а какой дебаггер лучше будет для Делфи???


 
Сергей М. ©   (2012-01-17 00:01) [5]


> препод сказала что нужно доделать, т.е. добавить трассировку


Ну а что ж ты молчал-то в тряпочку когда она говорила про енту самую "трассировку"?)
Нужно было тут же и с просить чего она изволит поиметь из-под тебя) ..


 
Jeer ©   (2012-01-17 00:02) [6]


> но препод сказала что нужно доделать, т.е. добавить трассировку.


Вот тут - подробнее. Что ты и она под этим понимаете и как это вам представляется ?


 
Сергей М. ©   (2012-01-17 00:04) [7]


> какой дебаггер лучше будет для Делфи?


Дебаггер он точно не для преподши твоей - он тебе нужен)
А ей, видимо, нужно чтобы работа какой-то ключевой часть алгоритма была запротоколирована в том или ином виде)


 
Плохиш ©   (2012-01-17 00:07) [8]

Представленный дерьмокод является курсовой? 8-O
Это даже на каблуху для доярок не тянет...


 
Сергей М. ©   (2012-01-17 00:08) [9]


> Jeer ©   (17.01.12 00:02) [6]


Там, похоже, был разговор слепого с глухим - преподша старой турбопаскальной закваски возжелала какие-нить WriteLn"ы в телах циклов, дабы студень наглядно продемонстрировал что код он не сдул и хоть сколь-либо понимает что в коде творится)


 
Рома   (2012-01-17 00:16) [10]

Просто подскажите как правильно сделать. Преподша молодая, много не требует, до кода ей пофиг, главное чтоб работал. Эту прогу я скачал с www.delphisources.ru Работает вроде. Кстати прога эта, шифрование методом поворотной решетки. Мне бы какую-нибудь трассировку сделать.


 
Рома   (2012-01-17 00:17) [11]


> Сергей М. ©

прям в точку)


 
Рома   (2012-01-17 00:26) [12]

Ну хоть что нибудь посоветуйте!!!


 
Inovet ©   (2012-01-17 00:30) [13]

Добавь TMemo и выводи в него.


 
Рома   (2012-01-17 00:33) [14]

Ой блин, забыл сказать, трассировку мне надо сделать не в проге, а в распечатываемом виде, на листах в курсовой.


 
Рома   (2012-01-17 00:57) [15]

Тогда помогите пошагово объяснить эту программу!!! Пожалуйста!!!!!!!!!


 
Германн ©   (2012-01-17 01:05) [16]


> Тогда помогите пошагово объяснить эту программу

Поздно.


 
Рома   (2012-01-17 01:09) [17]


> Германн ©

В каком смысле???


 
Рома   (2012-01-17 01:23) [18]

Пожалуйста, объясните пошагово программу(в кратце)!!!!!!!!!!


 
Германн ©   (2012-01-17 01:47) [19]


> Рома   (17.01.12 01:23) [18]
>
> Пожалуйста, объясните пошагово программу(в кратце)

Даже "вкратце" уже поздно. Результат всё равно будет нулевой!
Где ж ты был раньше?
Так и тянет вспомнить дедушку Крылова. :)

P.S.
Чисто теоретически. Можешь попробовать спросить помощи там, где скачал сей код. Т.е. на http://forum.sources.ru/index.php?showforum=9.
Но крайне маловероятно, что в такое время суток там кто-нибудь захочет объяснять что-то "с нуля".


 
Рома   (2012-01-17 01:57) [20]

Объяснять даже не надо, просто хотя бы комментарии к процедурам, где и что мы делаем и все!!!!


 
Германн ©   (2012-01-17 02:07) [21]


> Рома   (17.01.12 01:57) [20]
>
> Объяснять даже не надо, просто хотя бы комментарии к процедурам,
>  где и что мы делаем и все!!!!
>

А кто собственно "Мы". Т.е. те мы, которые "мы делаем"? Ты не сделал ничего. Я вообще не имею отношения к данному коду. Как и все прочие на этом форуме.
Нормальные комментарии к этому коду "не глядя"  может дать только автор сего кода. Очевидно преподша не так глупа, как вы думаете. :)


 
Германн ©   (2012-01-17 02:11) [22]


> Плохиш ©   (17.01.12 00:07) [8]
>
> Представленный дерьмокод является курсовой? 8-O


> Кстати прога эта, шифрование методом поворотной решетки.

Дык я и говорю, что "Доцент, конечно дурак, но аппаратура при нём!"


 
Рома   (2012-01-17 02:17) [23]

И на этом спасибо!


 
Ega23 ©   (2012-01-17 02:19) [24]


> Ну хоть что нибудь посоветуйте!!!


Попроси маму объяснить, как правильно подшиваться. Будешь иметь на КМБ преимущество.


 
Рома   (2012-01-17 02:27) [25]


> Ega23 ©

По своему опыту знаете???


 
Рома   (2012-01-17 02:30) [26]

Ладно, прорвусь... И не из таких ситуаций выкручивался... Всем большое спасибо!!!


 
Ega23 ©   (2012-01-17 02:44) [27]


> По своему опыту знаете???


Само-собой, старший сержант запаса всё-таки... :)


 
Германн ©   (2012-01-17 02:51) [28]


> Рома   (17.01.12 02:30) [26]
>
> Ладно, прорвусь... И не из таких ситуаций выкручивался..
> .

Удачи! Прорвёшься - значит наш!


 
sniknik ©   (2012-01-17 07:57) [29]

> значит наш!
вот уж нет, наш, это когда программирование сам сделал, а "прорвался" через философию например...


 
Омлет ©   (2012-01-17 08:04) [30]

Еще один будущий менеджер.


 
Dimka Maslov ©   (2012-01-17 10:34) [31]


> Еще один будущий менеджер.


Мне недавно рассказывали про аспиранта, который собирается считать ядрёные реакторы, не зная при этом как выглядит график функции синуса, буква тау, не говоря уже о том, чтобы от этой функции по дэ-тау взять интеграл. Так что менеджер по продажам - не самый страшный зверь.


 
Омлет ©   (2012-01-17 11:07) [32]


> Dimka Maslov ©   (17.01.12 10:34) [31]

Не удивительно, учитывая как у нас относятся к науке: http://science.compulenta.ru/655389/


 
Anatoly Podgoretsky ©   (2012-01-17 11:07) [33]


> Удачи! Прорвёшься - значит наш!

Какой наш, мы с армией уже закончили.


 
Ega23 ©   (2012-01-17 11:29) [34]


> Не удивительно, учитывая как у нас относятся к науке

Там основная проблема в выравнивании зарплат и попиле грантов. То, что его с Курчатником "объединяют" - это, в целом, не так уж и плохо. А вот тем, кто на доильном аппарате сидит, то, что денежные темы будут пересмотрены - как серпом по причиндалам.
Если в Дубне в ОИЯИ стесняются в открытую пилить, всё-таки международный институт и гранты PAC распределяет (и контролирует), то в ИТЭФ-е с этим сложнее.
Это всё опять же со слов бати, если есть желающие, могу позже комментарии предоставить.


 
Inovet ©   (2012-01-17 11:36) [35]

> [34] Ega23 ©   (17.01.12 11:29)
> Это всё опять же со слов бати, если есть желающие, могу
> позже комментарии предоставить.

Интересно бы было. Только где-то в "Прочее" была ветка про физику, если ещё не ушла в архив, в ней наверное будет лучше.


 
Inovet ©   (2012-01-17 11:50) [36]

> [35] Inovet ©   (17.01.12 11:36)
> в "Прочее" была ветка про физику

http://delphimaster.net/view/15-1316779880/


 
Dimka Maslov ©   (2012-01-17 12:00) [37]


> Омлет ©   (17.01.12 11:07) [32]


Физика — самая тёмная из наук. Всё время что-то ищут, денег просят, а толку — ноль. В лучшем случае через пару десятков лет. То ли дело юриспруденция, приносит быстрый и чистый доход практически сразу. Там даже можно свалить падение некоего предмета на провокацию империалистической военщины.


 
Рома   (2012-02-08 22:52) [38]

Ха... Прорвался!!! С армией потом разберусь, еще будет время...


 
Сергей М. ©   (2012-02-09 09:23) [39]


> Рома   (08.02.12 22:52) [38]


А мы тебя уже отпели)
Зля что ли мы тут скупые мужские слезы роняли ?)
Нет уж, давай-ка собирай вещмешок и брей макушку)..


 
Anatoly Podgoretsky ©   (2012-02-09 11:39) [40]

Конечно будет, но ты готовься.



Страницы: 1 2 вся ветка

Форум: "Начинающим";
Текущий архив: 2013.03.22;
Скачать: [xml.tar.bz2];

Наверх




Память: 0.62 MB
Время: 0.104 c
15-1338377064
Handle
2012-05-30 15:24
2013.03.22
проектирование БД интернет-магазина


15-1328733003
Юрий
2012-02-09 00:30
2013.03.22
С днем рождения ! 9 февраля 2012 четверг


6-1264750451
Pavel
2010-01-29 10:34
2013.03.22
Многопоточность в Indy


15-1349123402
Юрий
2012-10-02 00:30
2013.03.22
С днем рождения ! 2 октября 2012 вторник


6-1262861262
__Алексей__
2010-01-07 13:47
2013.03.22
Глюки ARP-кеша и получение MAC существующих хостов





Afrikaans Albanian Arabic Armenian Azerbaijani Basque Belarusian Bulgarian Catalan Chinese (Simplified) Chinese (Traditional) Croatian Czech Danish Dutch English Estonian Filipino Finnish French
Galician Georgian German Greek Haitian Creole Hebrew Hindi Hungarian Icelandic Indonesian Irish Italian Japanese Korean Latvian Lithuanian Macedonian Malay Maltese Norwegian
Persian Polish Portuguese Romanian Russian Serbian Slovak Slovenian Spanish Swahili Swedish Thai Turkish Ukrainian Urdu Vietnamese Welsh Yiddish Bengali Bosnian
Cebuano Esperanto Gujarati Hausa Hmong Igbo Javanese Kannada Khmer Lao Latin Maori Marathi Mongolian Nepali Punjabi Somali Tamil Telugu Yoruba
Zulu
Английский Французский Немецкий Итальянский Португальский Русский Испанский