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

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

Вернуться   Форум программистов > IT форум > Помощь студентам
Регистрация

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

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

Ответ
 
Опции темы Поиск в этой теме
Старый 05.06.2009, 20:15   #1
yulika-ya
 
Регистрация: 27.05.2009
Сообщений: 3
По умолчанию Помогите пожалуйста с Delphi

Нам по курсовой задали написать код Хэминга, Хаффмана, СRC, Зива-Лемпеля. Я скачала первые 3. но ничего в коде не понимаю.Может кто мог бы помочь разобраться? Кто хорошо знает Delphi. Я бы вам выслала код, а вы бы подписали, что есть, что. Либо еще как-нибудь. Либо у вас есть такие программы? Пожалуйста, помогите. Сама пытаюсь разобраться, но без чьей-либо помощи вряд ли получится. Пожалуйста!!!
yulika-ya вне форума Ответить с цитированием
Старый 05.06.2009, 20:22   #2
Utkin
Старожил
 
Аватар для Utkin
 
Регистрация: 04.02.2009
Сообщений: 17,351
По умолчанию

Почему бы Вам не выложить код на форуме? Это значительно ускорит решение Вашей проблемы.
Маньяк-самоучка
Utkin появился в результате деления на нуль.
Осторожно! Альтернативная логика
Utkin вне форума Ответить с цитированием
Старый 05.06.2009, 20:44   #3
yulika-ya
 
Регистрация: 27.05.2009
Сообщений: 3
По умолчанию

В коде 13700 символов, а можно только 5000
yulika-ya вне форума Ответить с цитированием
Старый 05.06.2009, 20:47   #4
yulika-ya
 
Регистрация: 27.05.2009
Сообщений: 3
По умолчанию

Вот начало Это Хаффмана
Код:
unit Unit1;

{$H+}

interface

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

type
  TForm1 = class(TForm)
    Button1: TButton;
    OpenDialog1: TOpenDialog;
    SG1: TStringGrid;
    Button2: TButton;
    StringGrid1: TStringGrid;
    Button3: TButton;
    SaveDialog1: TSaveDialog;
    procedure Button1Click(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure FormCreate(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure Button3Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

TStr = string[20];
TKey = string[1];
TStack = array[0..65000] of TKey;

TPElSp = ^TElSp;
TElSp = record
  key: byte;
  cnt: cardinal;
  next: TPElSp;
  end;

TPArNode = ^TArNode;
TArNode = record
  value: real;
  kod: TKey;
  left: TPArNode;
  right: TPArNode;
  parent: TPArNode;
  symb: byte;
  end;

TTree = record
  key: byte;
  cnt: cardinal;
  huff: TStr;
  n0: extended;
  deep: boolean;
  st_tree: TPArNode;
  end;

TArTree = array of TTree;

TFileRec = record
  key: byte;
  kod: byte;
  size_kod: byte;
  end;

TGetFile = record
  key: byte;
  kod: string[16];
  size_kod: byte;
  end;

TArFRec = array of TGetFile;

var
  stack: TStack;
  PBS: integer;
  Form1: TForm1;
  head_lsp: TPElSp;
  f, fo: file;
  size, tmpi, cnti: byte;
  a, atmp: TArTree;
  n: int64;
  head_tree: TPArNode;
  okk: boolean;
implementation

{$R *.dfm}

procedure Push(key: TKey);
begin
 stack[PBS]:= key;
 inc(PBS);
end;

procedure Pop(var key: TKey);
begin
 dec(PBS);
 key:= stack[PBS];
end;

procedure AddEl(var start: TPElSp; PNew: TPElSp);
var
 WP: TPElSp;
begin
 PNew^.next:= nil;
 if start = nil then start:= PNew
 else
  begin
  WP:= start;
  while WP^.next <> nil do
   WP:= WP^.next;
  WP^.next:= PNew;
end;
end;

function FindEl(start: TPElSp; key: byte; var FindPoint: TPElSp): boolean;
begin
 if start = nil then
 begin
  result:= false;
  exit;
 end;
 result:= false;
 FindPoint:= start;
 while (FindPoint <> nil) and (FindPoint^.key <> key) do
  begin
  findpoint:= findpoint^.next;
  end;
  if (findpoint <> nil) then result:= true;
end;

function FindElMax(start: TPElSp; var FindPoint: TPElSp): boolean;
var
 PrevPoint: TPElSp;
begin
 if start = nil then
 begin
  result:= false;
  exit;
 end;
 FindPoint:= start;
 PrevPoint:= start^.next;
 while (PrevPoint <> nil) do
  begin
  if PrevPoint^.cnt > FindPoint^.cnt then
   FindPoint:= PrevPoint;
  Prevpoint:= PrevPoint^.next;
  end;
  result:= true;
end;

procedure DelEl(var start: TPElSp; key: byte);
var
PrevPoint, WPoint: TPElSp;
begin
if start = nil then exit;
 prevpoint:= nil;
 wpoint:= start;
 while (wpoint <> nil) and (wpoint^.key <> key) do
 begin
  prevpoint:= wpoint;
  wpoint:= wpoint^.next;
 end;
 if (wpoint = nil) or (wpoint^.key > ord(key)) then
 exit;
 if prevpoint = nil then
  start:= start^.next
 else
  prevpoint^.next:= wpoint^.next;
  Dispose(Wpoint);
end;

procedure DelSp(var head: TPElSp);
var
 w: TPElSp;
begin
  if head = nil then exit;
  while (head <> nil) do
  begin
  w:= head;
  head:= head^.next;
  Dispose(w);
  end;
end;

function FindMin(a: TArTree; size: integer): integer;
var
 z, i: integer; min: extended; ok: boolean;
begin
 ok:= false;
 for z:= size-1 downto 0 do
 begin
  if a[z].deep <> true then
  begin
  min:= a[z].n0;
  result:= z;
  ok:= true;
  i:= z-1;
  end;
  if ok = true then
   break;
 end;
  for z:= i downto 0 do
   if (a[z].n0 < min) and (a[z].deep <> true) then
   begin
    min:= a[z].n0;
    result:= z;
   end;
end;

function StrBToInt(bin: string): byte;
var
i: integer; v: byte;
begin
  v:= 0;
  result:= 0;
  for i:=length(bin) downto 1 do
  begin
    result:= result + StrToInt(bin[i]) * StrToInt(FloatToStr(exp(ln(2)*v)));
    inc(v);
  end;
end;

Последний раз редактировалось MaTBeu; 05.06.2009 в 21:35.
yulika-ya вне форума Ответить с цитированием
Старый 05.06.2009, 20:59   #5
Utkin
Старожил
 
Аватар для Utkin
 
Регистрация: 04.02.2009
Сообщений: 17,351
По умолчанию

Вы можете разместить код в другом месте, здесь же можно указать ссылку на Ваш код.
И второе, не сваливайте все в кучу. Первое что необходимо запомнить: разбивайте каждую задачу на подзадачи. Выкладывайте частями, каждый алгоритм в отдельности.
Маньяк-самоучка
Utkin появился в результате деления на нуль.
Осторожно! Альтернативная логика
Utkin вне форума Ответить с цитированием
Ответ


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



Похожие темы
Тема Автор Раздел Ответов Последнее сообщение
Помогите пожалуйста (Delphi) Alex Dreamer Помощь студентам 3 08.05.2009 15:33
Помогите пожалуйста с лабораторной на Delphi Nastroenie_ Помощь студентам 12 25.03.2009 23:20
Помогите, пожалуйста, с задачей в Delphi! Jagoda_Malina Помощь студентам 1 07.11.2008 00:47
Помогите пожалуйста в Delphi. carbon383 Помощь студентам 0 03.06.2008 02:30