Показать сообщение отдельно
  #18  
Старый 24.12.2013, 22:19
Deman1986 Deman1986 вне форума
Прохожий
 
Регистрация: 03.11.2013
Сообщения: 32
Версия Delphi: Delphi 7
Репутация: 10
По умолчанию

Форумчане преподаватель принял классы и я сделал реализацию (программную), подскажите пожалуйста по классу TRam вот весь код:
Код:
unit MeineClasse;
interface
uses
SysUnits;

type
TPage = class(TObject)
private
	FNumber: integer;
	FPriznak: Boolean;
	public
Constructor Create (const Number: integer; Priznak: boolean);
	function GetNumber: integer;
	procedure SetNumber (const Value: integer);
	function GetPriznak: boolean;
	procedure SetPriznak (const Value: boolean);
end;

TElement=class(TObject)
private
	FMemory: TPage;
	FNext: TElement; 
public
	constructor Create (const Memory: TPage);
	destructor Destroy; override;
	function GetNext: TElement; 
	procedure SetNext (const Value: TElement);
	function GetMemory: TPage;
end;

TSegment = class(TObject)
private
	FFirst: TPage;
	FNum: integer;
	public
	constructor Create (const Num: integer);
	destructor Destroy; override;
	function GetFirst: TSegment;
	function GetNum: integer;
	procedure SetNum (const Value: integer);
	procedure AddTPage (const Page: TPage);
	procedure DelFirst: TPage;
	procedure ClearAll;
end;

TRam = class(TObject)
private
	FRam: Array of  TSegment;
	FCount: integer;
public
	constructor Create (ACount: integer);
	destructor Destroy; override;
	procedure SetCount (ACount: integer);
	function AddSegment (const Segment: TSegment): integer;
	function DelSegment (TSegment: integer): integer;
	function BinarySearch (const Values: array of TSegment; const Item: integer;
  	out FoundIndex: Integer): Boolean;
Procedure SaveFile (const FileName: string);
	Procedure LoadFile (const FileName: string);
function WinInfo(Root_Key: HKEY; Key_Open, Key_Read: string): string;
	procedure Reset;
end;

implementation
//******************TPage************************************************
constructor TPage.Create (const Number: integer; Priznak: boolean);
begin
inherited Create;	// при создании сразу инициализируем поля объекта
FNumber := Number;
FPriznak:= Boolean;
end;
function TPage.GetNumber:  integer;
begin
Result :=  FPriznak;
end;
function TPage.GetPriznak:  boolean;
begin
Result := FPriznak;
end;
procedure TPage.SetNumber (const Value: integer);
begin
FName := Value;
end;
procedure TPage.SetPriznak (const Value: boolean);
begin
FPriznak := Value;
end;
//*****************TElement**********************************************
constructor TElement.Create (const Memory: TPage);
begin
inherited Create;
FNext := nil;
FMemory := Page;
end;
destructor TElement.Destroy;
begin
FPage.Free;
Inherited Destroy;
end;
function TElement.GetNext: TElement;
begin;
Result := FNext;
end;
function TElement.GetMemory: TPage;
begin
Result := FPage;
end;
procedure TElement.SetNext (const Value: TElement);
begin
FNext := Value;
end;
//*************TSegment**************************************************
constructor TSegment.Create (const Num: integer);
begin
inherited Create;
FFirst := TPage;
FNum := nil;
end;
destructor TSegment.Destroy;
begin
Clear;
Inherited Destroy;
end;
procedure AddTPage (const Page: TPage);
var
New: TElement;
begin
New := TElement.Create(Page); // Создаём новый элемент, присваиваем его переменной New 
New.SetNext(FFirst); // Ссылка на следующий элемент = голова стека
FFirst := New; // Голова стека = новый элемент
end;
procedure TSegment.ClearAll;
var
Temp: TElement;
begin
while Assigned(FFirst) do // Пока голова стека не nul, то
begin
Temp := FFirst; // Временный элемент = голова стека
FFirst := FFirst.GetNext; // Голова стека = следующий элемент
Temp.Free; // Уничтожаем временный элемент (цикл проходит по стеку и при каждой итерации удаляет элемент)
end;
FFirst := nil;
end;
function TSegment.GetFirst: TSegment;
begin
Result := FFirst;
end;
function TSegment.GetNum: integer;
begin
Result := FNum;
end;
procedure TSegment.DelFirst: TPage;
var
Temp: TElement;
begin
Result:=nil;
if not Assigned(FFirst) then Exit; // Если голова стека = nul, то выходим из процедуры
Temp := FFirst; // Временный элемент = голова стека
FFirst := FFirst.GetNext; // Голова стека = следующий элемент
Result := Temp;
Temp.Free;
end;
procedure TSegment.SetNum (const Value: integer);
begin
FNum := Value;
end;

//*****************TRam*************************************************
function TRam.AddSegment (const Segment: TSegment): integer;
var
i, j: integer;
begin
…….
function TRam.BinarySearch (const Values: array of TSegment; const Item: integer; out FoundIndex: Integer): boolean;
var
  L, H: Integer;
  mid, Index, Count : Integer;
begin
  Index := Low(Values);
  Count := Length(Values);
 
  if (Index < Low(Values)) or ((Index > High(Values)) and (Count > 0))
    or (Index + Count - 1 > High(Values)) or (Count < 0)
    or (Index + Count < 0) then
    raise Exception.Create('Argument out of range');
 
  Result := False;
 
  if Count = 0 then
  begin
    FoundIndex := Index;
    Exit;
  end;
 
  L := Index;
  H := Index + Count - 1;
  while L <= H do
  begin
    mid := L + (H - L) shr 1;
    if Values[mid] < Item then
      L := mid + 1
    else
    begin
      H := mid - 1;
      if Values[mid] = Item then
        Result := True;
    end;
  end;
  FoundIndex := L;
end;
function WinInfo(Root_Key: HKEY; Key_Open, Key_Read: string): string;
var
registry: TRegistry;
begin
// если WinNT, открываем другой ключ
If ((GetVersion and $80000000)=0) and (Key_Open=WinVers) then
Key_Open := `SOFTWARE\Microsoft\Windows NT\CurrentVersion`;
Registry := TRegistry.Create;
Try
Registry.RootKey := Root_Key;
Registry.OpenKey (Key_Open, False);
Result := Registry.ReadString (Key_Read);
Finally
Registry.Free;
end;
// если ничего не найдено, выводим «невозможно определить»
If Result <> EmptyStr then Result := Key_read+`: `+Result else Result := Key_read+`: невозможно определить`;
end;
function TRam.DelSegment (TSegment: integer): integer;
….
constructor TRam.Create (ACount: integer);
begin
P := nil;
count :=0;
SetCount (ACount);
end;
procedure TRam.SetCount (ACount: integer);
var
np : PArray;
begin
if count = ACount then
exit;
(память не была выделена)
If p = nil then
begin
(новое кол-во элементов в массиве равно 0)
If ACount <= 0 then
begin
count := 0;
end;
(новое кол-во элементов в массиве больше 0)
else
begin
(выделение памяти)
GetMem (p, ACount * sizeof(integer));
(обнуление данных)
fillchar (p^, ACount * sizeof(integer),0);
count := ACount;
end;
end;
else
begin
(новое кол-во элементов в массиве равно 0)
If Acount <=0 then
begin
(освобождение памяти)
FreeMem (p, count * sizeof(integer));
count := 0;
end;
else
begin
(выделение памяти)
GetMem (np, ACount * sizeof(integer));
(требуется увеличить кол-во элементов)
If ACount > count then
begin
(перемещение старых данных в новое место)
move (p^, np^, count * sizeof(integer));
(обнуление новых элементов массива)
fillchar (np^[count], (ACount-count) * sizeof(integer), 0);
end
else
begin
(перемещение старых данных на новое место)
move (p^, np^, count * sizeof(integer));
(обнуление новых элементов массива)
fillchar (np^[count], (ACount-count) * sizeof(integer), 0);
end
else
begin
(перемещение части старых данных на новое место)
move (p^, np^, ACount * sizeof(integer));
end;
(освобождение старо памяти)
FreeMem (p, count * sizeof(integer));
p := np;
count := ACount;
end;
end;
end; 
procedure TRam.Reset;
begin
fillchar (p^, count * sizeof(integer), 0);
end;
destructor TRam.Destroy;
begin
SetCount(0);
end;
procedure TRam.LoadFile (const FileName: string);
……..
procedure TRam.SaveFile (const FileName: string);
var
f: TextFile;
i: integer;
Element: TElement;
begin
AssignFile(f, FileName);
Rewrite (f);
for i := 0 to GetCount -1 do // цикл прохода по структуре и сохранения элементов в файл
begin
Writeln(f,FRam[i].GetNum);
Element := FRam[i].GetFirst;
While Assigned(Element) do
begin
Writeln(f,………)
Element := Element.GetNext;
end;
Writeln(f);
end;
CloseFile(f);
end;
end.  
Спасибо огромное просто не могу реализовать никак.
Ответить с цитированием