«
»

MemoryStream LIMIT untuk BLOB Field (Image / Picture)

Pada tulisan saya sebelumnya tentang MemoryStream untuk BLOB Field, tidak terdapat batasan jumlah penampung memory yang digunakan, dan tergantung dari RecordCount pada komponen TDataSet atau turunannya. Jika record (RecordCount) menjadi sangat besar nilainya, maka memory yang digunakan juga akan semakin besar.., dan tentunya ini menjadi kurang bagus.. 😉

Dengan membatasi jumlah penampung memory secukupnya, menurut saya akan jadi lebih baik, misalnya saja dibatasi untuk menampung sebanyak 25 record atau 100 record, atau mungkin 500 record …. sesuaikan dengan kebutuhan, yang penting jangan terlalu besar tetapi tidak terlalu kecil ..

Berikut ini Code yang sama dengan tulisan sebelumnya, tetapi sudah saya modifikasi untuk penggunaan batasan memorinya…

unit Unit1;

{ $id kifmesoft @06/06/2006 }

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls,
  Forms, Dialogs, Grids, DBGrids, Db, DBTables, ExtCtrls,
  StdCtrls, Buttons, ExtDlgs, DBCtrls, DBClient;

type
  TForm1 = class(TForm)
    Query2: TQuery;
    DataSource1: TDataSource;
    DBGrid1: TDBGrid;
    bt_add: TBitBtn;
    bt_update: TBitBtn;
    bt_clear: TBitBtn;
    Label3: TLabel;
    Label1: TLabel;
    OpenPictureDialog1: TOpenPictureDialog;
    Panel1: TPanel;
    Query1: TQuery;
    Image1: TImage;
    bt_delete: TBitBtn;
    bt_refresh: TBitBtn;
    procedure FormCreate(Sender: TObject);
    procedure FormClose(Sender: TObject;
                 var Action: TCloseAction);
    procedure Query1AfterScroll(DataSet: TDataSet);
    procedure bt_addClick(Sender: TObject);
    procedure bt_updateClick(Sender: TObject);
    procedure bt_deleteClick(Sender: TObject);
    procedure Query1AfterRefresh(DataSet: TDataSet);
    procedure bt_clearClick(Sender: TObject);
    procedure bt_refreshClick(Sender: TObject);
  private
    { Private declarations }
    Procedure OpenQuery;
    Procedure LoadGraphic(Picture: TPicture;
                    Stream: TStream);
    Procedure FetchGraphic(Idx, kode: Integer);
    Procedure SetLimit(DataSet: TDataSet);
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.DFM}

Uses kifMemoryStream, Jpeg;

Const
  Limit = 25;  // **>>> LIMIT <<<**

Var
  kms: TkifMemoryStream;
  kode: TList;
  DatabaseName: String;
  StartIndex: Integer;

procedure TForm1.FormCreate(Sender: TObject);
begin
  kms:= TkifMemoryStream.Create;
  kode:= TList.Create;
  DatabaseName:= ExtractFileDir(ParamStr(0));
  Query1.DatabaseName:= DatabaseName;
  Query2.DatabaseName:= DatabaseName;
  OpenQuery;
end;

procedure TForm1.FormClose(Sender: TObject;
               var Action: TCloseAction);
begin
  kode.Free;
  kms.Free;
end;

procedure TForm1.OpenQuery;
Var
  dne: TDataSetNotifyEvent;
begin
  kms.Clear;
  kode.Clear;

  dne:= Query1.AfterScroll;
  Query1.AfterScroll:= Nil;

  Query1.Close;
  Query1.SQL.Clear;
  Query1.SQL.Add(
   'SELECT KODE, NAMA, GAMBAR_SIG FROM tb_gambar;');
  Query1.Open;
  Query1.FieldByName('GAMBAR_SIG').Visible:= False;

  kode.Count:= Limit;
  kms.Count:= kode.Count;
  FillChar(kode.List^, SizeOf(Pointer) * kode.Count, 0);
  StartIndex:= Query1.RecNo;

  Query1.AfterScroll:= dne;
  Query1.First;
end;

Procedure TForm1.LoadGraphic(Picture: TPicture;
               Stream: TStream);
Var
  g: TGraphic;
  id: Word;
Begin
  g:= Nil;
  Stream.Position:= 0;
  Stream.Read(id, SizeOf(id));
  If Stream.Size > 1 Then
    Case id Of
      $0000: g:= TIcon.Create;
      $4D42: g:= TBitmap.Create;
      $CDD7: g:= TMetafile.Create;
      $D8FF: g:= TJPEGImage.Create;
    End;
  Stream.Position:= 0;
  If Assigned(g) Then
    g.LoadFromStream(Stream);
  Picture.Assign(g);
  g.Free;
End;

Procedure TForm1.FetchGraphic(Idx, kode: Integer);
Begin
  Query2.Close;
  Query2.SQL.Clear;
  Query2.SQL.Add(Format(
   'SELECT GAMBAR_SIG,GAMBAR FROM tb_gambar WHERE KODE=%d;',
          [kode]));
  Query2.Open;

  If Query2.RecordCount > 0 Then
  Begin
    kms.ActiveMemory:= Idx;
    kms.ID[Idx]:= Query2.FieldByName(
             'GAMBAR_SIG').AsInteger;
    kms.Size:= TBlobField(Query2.FieldByName(
             'GAMBAR')).BlobSize;
    Move(TBlobField(Query2.FieldByName('GAMBAR')).Value[1],
       kms.Memory[Idx]^, kms.Size);
    LoadGraphic(Image1.Picture, kms);
  End;

  Query2.Close;
End;

Procedure TForm1.SetLimit(DataSet: TDataSet);
Begin
  If DataSet.RecordCount < 1 Then Exit;
  If DataSet.RecNo < StartIndex Then
  Begin
    If DataSet.RecNo >= (Limit Div 2) Then
      StartIndex:= (DataSet.RecNo - (Limit Div 2)) + 1
    Else StartIndex:= DataSet.RecNo;
  End
  Else If DataSet.RecNo >= (StartIndex + Limit) Then
   StartIndex:= (DataSet.RecNo - (Limit Div 2)) + 1;
End;

procedure TForm1.Query1AfterScroll(DataSet: TDataSet);
begin
  If (Not DataSet.Active) Or (DataSet.RecordCount < 1) Or
     (DataSet.State <> dsBrowse) Then Exit;

  SetLimit(DataSet);
  If Integer(kode.List^[DataSet.RecNo - StartIndex]) <>
     DataSet.FieldByName('KODE').AsInteger Then
  Begin  // *** New Record (Image)
  Integer(kode.List^[DataSet.RecNo - StartIndex]):=
     DataSet.FieldByName('KODE').AsInteger;
  FetchGraphic(DataSet.RecNo - StartIndex,
     DataSet.FieldByName('KODE').AsInteger);
  End
  Else If kms.ID[DataSet.RecNo - StartIndex] <>
      DataSet.FieldByName('GAMBAR_SIG').AsInteger Then
  // *** Reload image
  FetchGraphic(DataSet.RecNo - StartIndex,
      DataSet.FieldByName('KODE').AsInteger)
  Else
  Begin
    kms.ActiveMemory:= DataSet.RecNo - StartIndex;
    LoadGraphic(Image1.Picture, kms);
  End;
end;

procedure TForm1.Query1AfterRefresh(DataSet: TDataSet);
begin
  SetLimit(DataSet);
end;

procedure TForm1.bt_addClick(Sender: TObject);
begin
  If Not OpenPictureDialog1.Execute Then Exit;
  Query2.SQL.Clear;
  Query2.SQL.Add('INSERT INTO tb_gambar');
  Query2.SQL.Add('  (NAMA, GAMBAR_SIG, GAMBAR)');
  Query2.SQL.Add('VALUES (:NAMA, 0, :GAMBAR);');
  Query2.ParamByName('NAMA').AsString:=
   ExtractFileName(OpenPictureDialog1.FileName);
  Query2.ParamByName('GAMBAR').LoadFromFile(
   OpenPictureDialog1.FileName, ftBlob);
  Query2.ExecSQL;

  Query1.Refresh;
  // *** anggapan yg mudah bahwa record terbaru
  // *** ada di posisi terakhir, meskipun kurang tepat.. :)
  Query1.Last;
end;

procedure TForm1.bt_updateClick(Sender: TObject);
begin
  If Query1.RecordCount < 1 Then
  Begin
    bt_addClick(Nil);
    Exit;
  End;
  If Not OpenPictureDialog1.Execute Then Exit;
  Query2.SQL.Clear;
  Query2.SQL.Add('UPDATE tb_gambar');
  Query2.SQL.Add(
   'SET NAMA=:NAMA,GAMBAR_SIG=GAMBAR_SIG+1,GAMBAR=:GAMBAR');
  Query2.SQL.Add(Format('WHERE KODE = %d;',
   [Query1.FieldByName('KODE').AsInteger]));
  Query2.ParamByName('NAMA').AsString:=
   ExtractFileName(OpenPictureDialog1.FileName);
  Query2.ParamByName('GAMBAR').LoadFromFile(
   OpenPictureDialog1.FileName, ftBlob);
  Query2.ExecSQL;

  bt_refreshClick(Nil);
end;

procedure TForm1.bt_clearClick(Sender: TObject);
begin
  Query2.SQL.Clear;
  Query2.SQL.Add('UPDATE tb_gambar');
  Query2.SQL.Add(
   'SET GAMBAR_SIG = GAMBAR_SIG + 1, GAMBAR = NULL');
  Query2.SQL.Add(Format('WHERE KODE = %d;',
   [Query1.FieldByName('KODE').AsInteger]));
  Query2.ExecSQL;

  bt_refreshClick(Nil);
end;

procedure TForm1.bt_deleteClick(Sender: TObject);
begin
  If Query1.RecordCount < 1 Then Exit;
  Query2.SQL.Clear;
  Query2.SQL.Add('DELETE FROM tb_gambar');
  Query2.SQL.Add(Format('WHERE KODE = %d;',
   [Query1.FieldByName('KODE').AsInteger]));
  Query2.ExecSQL;

  bt_refreshClick(Nil);
end;

procedure TForm1.bt_refreshClick(Sender: TObject);
begin
  Query1.Refresh;
  Query1.AfterScroll(Query1);
end;

end.
Syntax Highlighted with http://delphi-id.org/syntax

This entry was posted on July 4, 2006 at 3:25 am and is filed under Delphi. You can follow any responses to this entry through the RSS 2.0 feed. You can leave a response, or trackback from your own site.

Leave a comment