Программируемая логика и ЦОС

procedure LoadKurve;
var
  ms1, ms2: TMemoryStream;
begin
  KurvePoints.Clear;
  // if GESPC_GrafikForm = nil then exit;
  ms1 := TMemoryStream.Create;
  try
    ms2 := TMemoryStream.Create;
    try
      DBModule.LoadStreamAusBlob(ms1); // Stream aus DB lesen
      ms1.Seek(0, soFromBeginning); // ms1.Position:=0;
      DecompressStream(ms1, ms2);
      if ms2.Size > 0 then
        KurvePoints.LoadFromMemoryStream(ms2); // Kurve aus Stream lesen
    finally
      ms2.Free;
    end;
  finally
    ms1.Free;
  end;
end;

procedure SaveKurve;
var
  ms1, ms2: TMemoryStream;
begin
  with GESPC_GrafikForm do
  begin
    ms1 := TMemoryStream.Create;
    try
      ms2 := TMemoryStream.Create;
      try
        DoppeltePunkteEntfernen;             // Ќова¤ ф-ци¤, убирающа¤ избыточные дублирующиес¤ точки
        KurvePoints.SaveToMemoryStream(ms1); // Kurve in Stream speichern
        CompressStream(ms1, ms2);
        // ShowMessage(Format('Stream Compression Rate: %d %%', [round(100 / ms1.Size * ms2.Size)]));
        DBModule.SaveStreamInBlob(ms2); // ms2
        // raise Exception.Create('In TGESPC_GrafikForm.SaveKurve ist ein Fehler: SimpleDataSet.ApplyUpdates');
      finally
        ms2.Free;
      end;
    finally
      ms1.Free;
    end;
  end;
end;


procedure CompressStream(inpStream, outStream: TStream);
var
  InpBuf, OutBuf: Pointer;
  InpBytes, OutBytes: integer;
begin
  InpBuf := nil;
  OutBuf := nil;
  try
    GetMem(InpBuf, inpStream.Size);
    inpStream.Position := 0;
    InpBytes := inpStream.Read(InpBuf^, inpStream.Size);
    CompressBuf(InpBuf, InpBytes, OutBuf, OutBytes);
    outStream.Write(OutBuf^, OutBytes);
  finally
    if InpBuf <> nil then
      FreeMem(InpBuf);
    if OutBuf <> nil then
      FreeMem(OutBuf);
  end;
end;

procedure DecompressStream(inpStream, outStream: TStream);
var
  InpBuf, OutBuf: Pointer;
  OutBytes, sz: integer;
begin
  InpBuf := nil;
  OutBuf := nil;
  sz := inpStream.Size - inpStream.Position;
  if sz > 0 then
    try
      GetMem(InpBuf, sz);
      inpStream.Read(InpBuf^, sz);
      DecompressBuf(InpBuf, sz, 0, OutBuf, OutBytes);
      outStream.Write(OutBuf^, OutBytes);
    finally
      if InpBuf <> nil then
        FreeMem(InpBuf);
      if OutBuf <> nil then
        FreeMem(OutBuf);
    end;
  outStream.Position := 0;
end;

end.

////////////////////////////////////////////////////////////////////////////
unit PointsUtils;

interface

uses Windows, SysUtils, Classes;

type
  TPoints = class
  private
    FList: TList;
    procedure SetItems(Index: Integer; const Value: TPoint);
    function GetItems(Index: Integer): TPoint;
    function GetCount: Integer;
  public
    constructor Create();
    destructor Destroy; override;
    function Add(X, Y: Integer): Integer; overload;
    function Add(APoint: TPoint): Integer; overload;
    property Count: Integer read GetCount;
    property Items[Index: Integer]: TPoint read GetItems write SetItems; default;
    procedure Clear;
    procedure SaveToStream(AStream: TStream);
    procedure SaveToFile(AFileName: string);
    procedure LoadFromStream(AStream: TStream);
    procedure LoadFromFile(AFileName: string);
    procedure LoadFromMemoryStream(var MStream: TMemoryStream);
    procedure SaveToMemoryStream(var MStream: TMemoryStream);
  end;

implementation

type
  PPoint = ^TPoint;

function TPoints.Add(X, Y: Integer): Integer;
var
  Pt: TPoint;
begin
  Pt.X := X;
  Pt.Y := Y;
  Result := Add(Pt)
end;

function TPoints.Add(APoint: TPoint): Integer;
var
  NewPt: PPoint;
begin
  GetMem(NewPt, SizeOf(TPoint));
  NewPt^ := APoint;
  Result := FList.Add(NewPt)
end;

procedure TPoints.Clear;
var
  I: Integer;
begin
  for I := Count - 1 downto 0 do
    FreeMem(FList[I]);
  FList.Clear;
end;

constructor TPoints.Create;
begin
  inherited;
  FList := TList.Create;
end;

destructor TPoints.Destroy;
begin
  Clear;
  FList.Free;
  inherited;
end;

function TPoints.GetCount: Integer;
begin
  Result := FList.Count;
end;

function TPoints.GetItems(Index: Integer): TPoint;
begin
  Result := PPoint(FList[Index])^
end;

procedure TPoints.SetItems(Index: Integer; const Value: TPoint);
begin
  PPoint(FList[Index])^ := Value
end;

procedure TPoints.LoadFromFile(AFileName: string);
var
  Fs: TFileStream;
begin
  Fs := TFileStream.Create(AFileName, fmOpenRead);
  try
    LoadFromStream(Fs);
  finally
    Fs.Free;
  end;
end;

procedure TPoints.LoadFromStream(AStream: TStream);
var
  I, Cnt: Integer;
  Pt: TPoint;
begin
  Clear;
  AStream.Read(Cnt, SizeOf(Cnt));
  for I := 0 to Cnt - 1 do
  begin
    AStream.Read(Pt, SizeOf(Pt));
    Add(Pt)
  end;
end;

procedure TPoints.SaveToFile(AFileName: string);
var
  Fs: TFileStream;
begin
  Fs := TFileStream.Create(AFileName, fmCreate);
  try
    SaveToStream(Fs);
  finally
    Fs.Free;
  end;
end;

procedure TPoints.SaveToStream(AStream: TStream);
var
  I: Integer;
  Pt: TPoint;
  Cnt: Integer;
begin
  Cnt := Count;
  AStream.Write(Cnt, SizeOf(Cnt));
  for I := 0 to Count - 1 do
  begin
    Pt := Self[I];
    AStream.Write(Pt, SizeOf(TPoint));
  end;
end;

procedure TPoints.SaveToMemoryStream(var MStream: TMemoryStream);
var
  I, Cnt: Integer;
  Pt: TPoint;
begin
  Cnt := Count;
  MStream.Clear;
  MStream.Seek(0, soFromBeginning);
  MStream.Write(Cnt, SizeOf(Cnt));
  for I := 0 to Count - 1 do
  begin
    Pt := Self[I];
    MStream.Write(Pt, SizeOf(TPoint));
  end;
end;

procedure TPoints.LoadFromMemoryStream(var MStream: TMemoryStream);
var
  I, Cnt: Integer;
  Pt: TPoint;
begin
  Clear;
  MStream.Seek(0, soFromBeginning);
  MStream.Read(Cnt, SizeOf(Cnt));
  for I := 0 to Cnt - 1 do
  begin
    MStream.Read(Pt, SizeOf(Pt));
    Add(Pt)
  end;
end;

end.

////////////////////////////////////////////////////////////////////////////





Procedure TDBModule.LoadStreamAusBlob(var ms: TMemoryStream; ID: integer = 0);
var
  BlobStream: TStream;
begin
  BlobStream := tDaten.CreateBlobStream(tDaten.FieldByName('KurveStream'), bmRead);
  ms.CopyFrom(BlobStream, BlobStream.Size);
  BlobStream.Free;
end;

procedure TDBModule.SaveStreamInBlob(var ms: TMemoryStream);
var
  BlobStream: TStream;
begin
  ms.Seek(0, soFromBeginning); // inStream.Position := 0;
  tDaten.Edit;
  try
    BlobStream := tDaten.CreateBlobStream(tDaten.FieldByName('KurveStream'), bmWrite);
    BlobStream.CopyFrom(ms, ms.Size);
    BlobStream.Free;
    tDaten.FieldByName('Grafik').AsBoolean := True;
    tDaten.Post;
  except
    tDaten.Cancel;
    raise;
  end;
end;