Что-то типо такого, стандартными срадствами:
memento mori
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;