Save Load Image Database di Delphi #221

andrypein.net : Dengan advanced technique ini aing kasih tutorial bagaimana Save load image database di delphi.

Berawal dari percobaan ngesave image dengan extensi .jpg atau .bmp ke dalam database dan bisa dilakukan.

Nah tantangan selanjutnya bagaimana dengan semua tipe gambar yang common (.png .gif .jpg .bmp)?

Dengan modal ngaskus, ane open thread disana dan bertanya pada master-master delphi waktu itu dan akhirnya aing experimen sendiri ngoding dengan clue yang diberi tau oleh master disana.

Fixed juga ini aplikasi dan cara bagaimana load save image ke databes, simak gan!

Untuk bahan-bahannya ane memakai Zeos sebagai Koneksi ke DB (Contoh di post ini ane memakai db SQLite) lanjut dengan DBNavigator, DataSource, ZTable, ZConnection, 2 TButton,and 1 TImage.

Untuk perkodingan pertama-tama tambahkan konstanta ini terlebih dulu.

const
  MinGraphicSize = 44;

* Lalu tambahkan uses uses yang diperlukan untuk koding mulai dari :

uses
  JPEG,PNGIMage,GIFImage,consts;

* Ada 2 function untuk melakukannya, bebas mau pilih yang mana yg pasti it works, btw aing pake fungsi yang nomer 2.

//Fungsi Pertama

function FindGraphicClass(const Buffer; const BufferSize: Int64;
  out GraphicClass: TGraphicClass): Boolean; overload;
var
  LongWords: array[Byte] of LongWord absolute Buffer;
  Words: array[Byte] of Word absolute Buffer;
begin
  GraphicClass := nil;
  Result := False;
  if BufferSize < MinGraphicSize then Exit;
  case Words[0] of
    $4D42: GraphicClass := TBitmap;
    $D8FF: GraphicClass := TJPEGImage;
    $4949: if Words[1] = $002A then GraphicClass := TWicImage; //i.e., TIFF
    $4D4D: if Words[1] = $2A00 then GraphicClass := TWicImage; //i.e., TIFF
  else
    if Int64(Buffer) = $A1A0A0D474E5089 then
      GraphicClass := TPNGImage
    else if LongWords[0] = $9AC6CDD7 then
      GraphicClass := TMetafile
    else if (LongWords[0] = 1) and (LongWords[10] = $464D4520) then
      GraphicClass := TMetafile
    else if StrLComp(PAnsiChar(@Buffer), 'GIF', 3) = 0 then
      GraphicClass := TGIFImage
    else if Words[1] = 1 then
      GraphicClass := TIcon;
  end;
  Result := (GraphicClass <> nil);
end;

//Fungsi Kedua

function FindGraphicClass(Stream: TStream;
  out GraphicClass: TGraphicClass): Boolean; overload;
var
  Buffer: PByte;
  CurPos: Int64;
  BytesRead: Integer;
begin
  if Stream is TCustomMemoryStream then
  begin
    Buffer := TCustomMemoryStream(Stream).Memory;
    CurPos := Stream.Position;
    Inc(Buffer, CurPos);
    Result := FindGraphicClass(Buffer^, Stream.Size - CurPos, GraphicClass);
    Exit;
  end;
  GetMem(Buffer, MinGraphicSize);
  try
    BytesRead := Stream.Read(Buffer^, MinGraphicSize);
    Stream.Seek(-BytesRead, soCurrent);
    Result := FindGraphicClass(Buffer^, BytesRead, GraphicClass);
  finally
    FreeMem(Buffer);
  end;
end;

* Lalu masukan kode procedure untuk load Image dari DB nya.

procedure LoadPictureFromBlobField(Field: TBlobField; Dest: TPicture);
var
  Graphic: TGraphic;
  GraphicClass: TGraphicClass;
  Stream: TMemoryStream;
begin
  Graphic := nil;
  Stream := TMemoryStream.Create;
  try
    Field.SaveToStream(Stream);
    if Stream.Size = 0 then
    begin
      Dest.Assign(nil);
      Exit;
    end;
    if not FindGraphicClass(Stream.Memory^, Stream.Size, GraphicClass) then
      raise EInvalidGraphic.Create(SInvalidImage);
    Graphic := GraphicClass.Create;
    Stream.Position := 0;
    Graphic.LoadFromStream(Stream);
    Dest.Assign(Graphic);
  finally
    Stream.Free;
    Graphic.Free;
  end;
end;

Cukup sampai disana aja sih sebenernya, improvisasi selanjutnya adalah tentang koneksi nya, program saya pake database sqlite dam sukses load save macam gambar tanpa error.

Ini penting yaitu jika memakai konektor lain, misal zeos, ado dll jngan lupa si table nya di add all field agar ketauan tar mana yang tipe nya BLOB, ini berlaku untuk semua jenis database yang akan dipakai.

type
  TForm1 = class(TForm)
    Image1: TImage;
    BitBtn1: TBitBtn;
    BitBtn2: TBitBtn;
    ZConnection1: TZConnection; //Koneksi memakai zeos
    ZTable1: TZTable;
    opd: TOpenPictureDialog;
    spd: TSavePictureDialog;
    DataSource1: TDataSource;
    ZTable1image: TBlobField; //Setelah di Add All Field
    DBNavigator1: TDBNavigator;
    procedure FormCreate(Sender: TObject);
    procedure ZConnection1AfterConnect(Sender: TObject);
    procedure DataSource1DataChange(Sender: TObject; Field: TField);
    procedure BitBtn1Click(Sender: TObject);
    procedure BitBtn2Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

* Next lanjut, tambahkan komponen TImage nya, openpicturedialog, savepicturedialog dan 2 tombol

Sekarang kita ke pengaturan koneksi (khusus untuk database SQLite) yang lainnya tinggal menyesuaikan sesuai database yang dipakai dan komponen konektor yang diinstal di IDE, pertama kita ke form create.

procedure TForm1.FormCreate(Sender: TObject);
begin
  ZConnection1.LibraryLocation:=extractfilepath(application.ExeName)+'sqlite3.dll';
  spd.InitialDir:=getcurrentdir; //spd untuk save picture dialog
  ZConnection1.Database:=extractfilepath(application.ExeName)+'tes.db';
  ZConnection1.Connect;
end;

lalu ke connection after connect

procedure TForm1.ZConnection1AfterConnect(Sender: TObject);
begin
  ZTable1.TableName:='poto';
  ZTable1.Open;
end;

lalu ke data source on Change

procedure TForm1.DataSource1DataChange(Sender: TObject; Field: TField);
begin
  image1.Picture:=nil;
  LoadPictureFromBlobField(ZTAble1Image, image1.Picture)
  //sesuaikan dengan nama tabel yang setelah di add all field 
end;

Dan ini untuk tombol browse and save si gambar.

procedure TForm1.BitBtn2Click(Sender: TObject);
begin
  opd.Execute(); //od untuk opendialog
  ZTable1.Append;
  ZTable1Image.LoadFromFile(opd.FileName);
  ZTable1.Post;
end;

Terakhir untuk tombol save to file.

procedure TForm1.Button2Click(Sender: TObject);
begin
  if spd.Execute then
    if FileExists(spd.FileName) then
      raise Exception.Create('file already exists')
    else
      image1.Picture.SaveToFile(spd.FileName);
end;

Last event saat form close.

procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  unitable1.Close;
  uniconnection1.Disconnect;
end;

Jika pusing, sudah disediakan kolom komentar ko untuk bertanya, atau revisi atau apa problem solving atau protes karena tutornya kurang lengkap, silahkan bebas.

Liat gan ini berhasil :

Janlup donlod apps save load image database di delphi nya untuk referensi teman-teman semua.

Download

*AFK