
24.12.2013, 22:19
|
Прохожий
|
|
Регистрация: 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.
Спасибо огромное просто не могу реализовать никак.
|