si vous utiliser dans vos codes beaucoup de GetMem/FreeMem cette unité permets d'alouer de mémoire sans etre obliger d'appeler Freemem a la fin
SmartMem.pas
Code : Sélectionner tout - Visualiser dans une fenêtre à part
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
unit SmartMem;
 
interface
 
type
  TMem = packed array of  byte;
  SmartPtr = record
    Ptr      :Pointer;
    Reserved :TMem;
  end;
 
function MEMAlloc(Size:integer;var Anchor:SmartPtr):Pointer;
function MEMGet(Size:integer;var Anchor:SmartPtr):Pointer;
procedure MEMRealloc(var P:Pointer;Size:integer;var Anchor:SmartPtr); overload;
procedure MEMRealloc(Size:integer;var Anchor:SmartPtr);               overload;
procedure MEMFree(var Anchor:SmartPtr);
 
implementation
 
type
   PDynRec= ^TDynRec;
   TDynRec= record
     RC    : Integer;
     Length: integer;
   end;
   PDynAr = ^TDynAr;
   TDynAr = packed record
     Mem   : TDynRec;
     Bytes : array[0..0]of byte;
   end;
const
   DYNOFFSET = SizeOf(TDynRec);
 
function MEMGet(Size:integer;var Anchor:SmartPtr):Pointer;
begin
    MEMFree(Anchor);
    GetMem(PByte(Result),Size + DYNOFFSET);
    with Anchor,PDynAr(Result)^ do
    begin
       Mem.RC     := 1;
       Mem.Length := Size;
       Result     := @Bytes;
       Ptr        := Result;
       Pointer(Reserved):= Result;
    end;
end;
 
function MEMAlloc(Size:integer;var Anchor:SmartPtr):Pointer;
begin
    Result := MEMGet(Size,Anchor);
    FillChar(Pointer(Anchor.Reserved)^,Size,0);
end;
 
procedure MEMRealloc(var P:Pointer;Size:integer;var Anchor:SmartPtr);
begin
    P := Pointer(Anchor.Reserved);
    if Size = 0 then
        MEMFree(Anchor)
    else if P = nil then
        P := MEMGet(Size,Anchor)
    else begin
        Dec(Integer(P),DYNOFFSET);
        ReallocMem(PByte(P),Size + DYNOFFSET);
        with Anchor,PDynAr(P)^ do
        begin
           Mem.Length := Size;
           P          := @Bytes;
           Ptr        := P;
           Pointer(Reserved):= P;
        end;
   end;
end;
 
procedure MEMRealloc(Size:integer;var Anchor:SmartPtr);
begin
    Anchor.Ptr := Pointer(Anchor.Reserved);
    MEMRealloc(Anchor.Ptr,Size,Anchor);
end;
 
procedure MEMFree(var Anchor:SmartPtr);
begin
    if Pointer(Anchor.Reserved) <> nil then
    begin
        Dec(Integer(Anchor.Reserved),DYNOFFSET);
        FreeMem(PByte(Anchor.Reserved));
        Pointer(Anchor.Reserved) := nil;
    end;
end;
 
end.
Exemple
Code : Sélectionner tout - Visualiser dans une fenêtre à part
1
2
3
4
5
6
7
8
9
10
11
12
13
14
var
  M:SmartPtr;
begin
  MEMGet(SizeOf(TBitmapInfoHeader),M);
  with PBitmapInfoHeader(M.Ptr)^ do
  ...
 
var
  M:SmartPtr;
  P:PBitmapInfoHeader;
begin
  P:= MEMGet(SizeOf(TBitmapInfoHeader),M);
  with P^ do
  ...