Недавно добавленные исходники

•  TDictionary Custom Sort  3 227

•  Fast Watermark Sources  2 992

•  3D Designer  4 751

•  Sik Screen Capture  3 259

•  Patch Maker  3 469

•  Айболит (remote control)  3 530

•  ListBox Drag & Drop  2 904

•  Доска для игры Реверси  80 799

•  Графические эффекты  3 843

•  Рисование по маске  3 172

•  Перетаскивание изображений  2 544

•  Canvas Drawing  2 674

•  Рисование Луны  2 501

•  Поворот изображения  2 094

•  Рисование стержней  2 121

•  Paint on Shape  1 525

•  Генератор кроссвордов  2 183

•  Головоломка Paletto  1 731

•  Теорема Монжа об окружностях  2 159

•  Пазл Numbrix  1 649

•  Заборы и коммивояжеры  2 017

•  Игра HIP  1 262

•  Игра Go (Го)  1 201

•  Симулятор лифта  1 426

•  Программа укладки плитки  1 179

•  Генератор лабиринта  1 512

•  Проверка числового ввода  1 297

•  HEX View  1 466

•  Физический маятник  1 322

•  Задача коммивояжера  1 357

 
скрыть


Delphi FAQ - Часто задаваемые вопросы

| Базы данных | Графика и Игры | Интернет и Сети | Компоненты и Классы | Мультимедиа |
| ОС и Железо | Программа и Интерфейс | Рабочий стол | Синтаксис | Технологии | Файловая система |



Delphi Sources

Освобождение памяти



unit MemMan;

interface

var
  GetMemCount, FreeMemCount,
    ReallocMemCount: Integer;

implementation

uses
  Windows, SysUtils;

var
  OldMemMgr: TMemoryManager;

function NewGetMem(Size: Integer): Pointer;
begin
  Inc(GetMemCount);
  Result := OldMemMgr.GetMem(Size);
end;

function NewFreeMem(P: Pointer): Integer;
begin
  Inc(FreeMemCount);
  Result := OldMemMgr.FreeMem(P);
end;

function NewReallocMem(P: Pointer; Size: Integer): Pointer;
begin
  Inc(ReallocMemCount);
  Result := OldMemMgr.ReallocMem(P, Size);
end;

const
  NewMemMgr: TMemoryManager = (
    GetMem: NewGetMem;
    FreeMem: NewFreeMem;
    ReallocMem: NewReallocMem);

initialization
  GetMemoryManager(OldMemMgr);
  SetMemoryManager(NewMemMgr);

finalization
  SetMemoryManager(OldMemMgr);
  if (GetMemCount - FreeMemCount) <> 0 then
    MessageBox(0, pChar(
      'Objects left: ' + IntToStr(GetMemCount - FreeMemCount)),
      'MemManager', mb_ok);
end.
unit MemForm;

interface

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

type
  TForm1 = class(TForm)
    BtnRefresh1: TButton;
    BtnCreateNil: TButton;
    BtnCreateOwner: TButton;
    BtnGetMem: TButton;
    LblResult: TLabel;
    Btn100Strings: TButton;
    Bevel1: TBevel;
    BtnRefresh2: TButton;
    procedure BtnRefresh1Click(Sender: TObject);
    procedure BtnCreateNilClick(Sender: TObject);
    procedure BtnCreateOwnerClick(Sender: TObject);
    procedure BtnGetMemClick(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure Btn100StringsClick(Sender: TObject);
    procedure BtnRefresh2Click(Sender: TObject);
  public
    procedure Refresh;
    procedure Refresh2;
  end;

var
  Form1: TForm1;

implementation

uses MemMan;

{$R *.DFM}

procedure TForm1.Refresh;
begin
  LblResult.Caption :=
    'Allocated: ' + IntToStr(GetMemCount) + #13 +
    'Free: ' + IntToStr(FreeMemCount) + #13 +
    'Existing: ' +
    IntToStr(GetMemCount - FreeMemCount) + #13 +
    'Re-allocated: ' + IntToStr(ReallocMemCount);
end;

procedure TForm1.Refresh2;
begin
  LblResult.Caption := Format(
    'Allocated: %d'#13'Free: %d'#13'Existing: %d'#13'Re-allocated %d'      ,
    [GetMemCount, FreeMemCount,
    GetMemCount - FreeMemCount, ReallocMemCount]);
end;

procedure TForm1.BtnRefresh1Click(Sender: TObject);
begin
  Refresh;
end;

procedure TForm1.BtnCreateNilClick(Sender: TObject);
begin
  TButton.Create(nil);
  Refresh;
end;

procedure TForm1.BtnCreateOwnerClick(Sender: TObject);
begin
  TButton.Create(self);
  Refresh;
end;

procedure TForm1.BtnGetMemClick(Sender: TObject);
var
  P: Pointer;
begin
  GetMem(P, 100);
  Integer(P^) := 0;
  Refresh;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  Refresh;
end;

procedure TForm1.Btn100StringsClick(Sender: TObject);
var
  s1, s2: string;
  I: Integer;
begin
  s1 := 'hi';
  s2 := Btn100Strings.Caption;
  for I := 1 to 100 do
    s1 := s1 + ': hello world';
  Btn100Strings.Caption := s1;
  s1 := s2;
  Btn100Strings.Caption := s1;
  Refresh;
end;

procedure TForm1.BtnRefresh2Click(Sender: TObject);
begin
  Refresh2;
end;

end.
Скачать весь проект







Copyright © 2004-2024 "Delphi Sources" by BrokenByte Software. Delphi World FAQ

Группа ВКонтакте