Take A Rest For A moment!: Oktober 2008

Ingin menyimpan beberapa file gambar dengan tipe berbeda-beda serta ingin menampilkan kembali merupakan keinginan kita dalam menghadapi database yang table-nya digunakan untuk menyimpan gambar. Untuk menggunakan TImage yang sudah disediakan oleh Delphi, ternyata belum bisa menanggapi programmer untuk digunakan secara mudah. Jadi kita harus mengakali dengan menggunakan teknik. Untuk lebih detailnya, silahkan anda baca artikel berikut….

Database yang digunakan pada contoh kali ini adalah database MS SQL Server.
Teman-teman bisa langsung pelajari dari contoh kode program berikut dibawah ini.
Kode Program untuk Form

unit UMain;
interface

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, ExtCtrls, ExtDlgs, JPEG, DBCtrls;

type
TMain = class(TForm)
GambarAmbil: TImage;
TombolBuat: TButton;
TombolSimpan: TButton;
TombolTampil: TButton;
Label1: TLabel;
Bevel1: TBevel;
Kode: TEdit;
Label2: TLabel;
OpenPictureDialog1: TOpenPictureDialog;
Label3: TLabel;
GambarTampil: TImage;
procedure GambarAmbilClick(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;

var
Main: TMain;

implementation

uses UModule;

{$R *.dfm}

procedure TMain.GambarAmbilClick(Sender: TObject);
begin
with OpenPictureDialog1 do
begin

if Execute then
begin

GambarAmbil.Picture.LoadFromFile(FileName);

end;

end;
end;

end.

Kode Program untuk data module

unit UModule;

interface

uses
SysUtils, Classes, DB, ADODB, ActnList, JPEG;

type
TDataModule4 = class(TDataModule)
Connection: TADOConnection;
QSimpan: TADOQuery;
QTampil: TADOQuery;
QBuatTabel: TADOQuery;
ActionList1: TActionList;
PSimpan: TAction;
PSimpanPopUp: TAction;
PTampil: TAction;
PTampilPopUp: TAction;
PBuatTabel: TAction;
PBuatTabelPopUp: TAction;
QTampilGambar: TBlobField;
DSQTampil: TDataSource;
procedure PSimpanExecute(Sender: TObject);
procedure PSimpanPopUpExecute(Sender: TObject);
procedure DataModuleCreate(Sender: TObject);
procedure PTampilExecute(Sender: TObject);
procedure PTampilPopUpExecute(Sender: TObject);
procedure PBuatTabelExecute(Sender: TObject);
procedure PBuatTabelPopUpExecute(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;

var
DataModule4: TDataModule4;

implementation

uses UMain;

{$R *.dfm}

procedure TDataModule4.DataModuleCreate(Sender: TObject);
begin

with Main do
begin

TombolBuat .Action := PBuatTabelPopUp;
TombolSimpan.Action := PSimpanPopUp;
TombolTampil.Action := PTampilPopUp;

end;

end;

procedure TDataModule4.PBuatTabelExecute(Sender: TObject);
begin

with QBuatTabel do
ExecSQL;

end;

procedure TDataModule4.PBuatTabelPopUpExecute(Sender: TObject);
begin

PBuatTabel.Execute;

end;

procedure TDataModule4.PSimpanExecute(Sender: TObject);
var
Foto : TMemorystream;
begin

Foto := TMemorystream.Create;

with Main do
begin

GambarAmbil.Picture.Graphic.SaveToStream(Foto);

with QSimpan do
begin

Parameters[0].Value := Kode.Text;
Parameters[1].LoadFromStream(Foto,ftBlob);
ExecSQL;

end;

end;

end;

procedure TDataModule4.PSimpanPopUpExecute(Sender: TObject);
begin

PSimpan.Execute;

end;

procedure TDataModule4.PTampilExecute(Sender: TObject);
var
bS : TADOBlobStream;
Pic : TJpegImage;
Foto : TMemorystream;
begin

Foto := TMemorystream.Create;

with Main do
begin

with QTampil do
begin

Parameters[0].Value := Kode.Text;
Close;
Open;

bS := TADOBlobStream.Create(QTampilGambar, bmRead);
try
Pic:=TJpegImage.Create;
try
Pic.LoadFromStream(bS);
GambarTampil.Picture.Graphic:=Pic;
finally
Pic.Free;
end;
finally
bS.Free
end;

end;

end;

end;

procedure TDataModule4.PTampilPopUpExecute(Sender: TObject);
begin

PTampil.Execute;

end;

end.

Desain form untuk Form

object Main: TMain
Left = 0
Top = 0
Caption = ‘Created by Eko Indriyawan’
ClientHeight = 292
ClientWidth = 554
Color = clBtnFace
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = ‘Tahoma’
Font.Style = []
OldCreateOrder = False
PixelsPerInch = 96
TextHeight = 13
object Label3: TLabel
Left = 32
Top = 138
Width = 137
Height = 13
Caption = ‘Klik disini untuk ambil gambar’
end
object GambarAmbil: TImage
Left = 8
Top = 8
Width = 185
Height = 273
Center = True
OnClick = GambarAmbilClick
end
object Label1: TLabel
Left = 200
Top = 16
Width = 153
Height = 52
Caption =
‘Untuk tahap awal, silahkan anda buat tabel terlebih dahulu pada ‘ +
‘database Master dengan menekan tombol Buat Tabel’
WordWrap = True
end
object Bevel1: TBevel
Left = 200
Top = 71
Width = 152
Height = 1
Shape = bsTopLine
end
object Label2: TLabel
Left = 200
Top = 208
Width = 24
Height = 13
Caption = ‘Kode’
end
object GambarTampil: TImage
Left = 360
Top = 8
Width = 185
Height = 273
Center = True
OnClick = GambarAmbilClick
end
object TombolBuat: TButton
Left = 278
Top = 75
Width = 75
Height = 25
Caption = ‘Buat Tabel’
TabOrder = 0
end
object TombolSimpan: TButton
Left = 200
Top = 248
Width = 75
Height = 25
Caption = ‘Simpan’
TabOrder = 1
end
object TombolTampil: TButton
Left = 280
Top = 248
Width = 75
Height = 25
Caption = ‘Tampilkan’
TabOrder = 2
end
object Kode: TEdit
Left = 200
Top = 224
Width = 153
Height = 21
TabOrder = 3
end
object OpenPictureDialog1: TOpenPictureDialog
Filter =
‘All (*.gif;*.jpg;*.jpeg;*.bmp;*.ico;*.emf;*.wmf)|*.gif;*.jpg;*.j’ +
‘peg;*.bmp;*.ico;*.emf;*.wmf|GIF Image (*.gif)|*.gif|JPEG Image F’ +
‘ile (*.jpg)|*.jpg|JPEG Image File (*.jpeg)|*.jpeg|Bitmaps (*.bmp’ +
‘)|*.bmp|Icons (*.ico)|*.ico|Enhanced Metafiles (*.emf)|*.emf|Met’ +
‘afiles (*.wmf)|*.wmf|Test (*.test)|*.test’
Options = [ofHideReadOnly, ofExtensionDifferent, ofEnableSizing]
Left = 160
Top = 16
end
end

Desain form untuk data module

object DataModule4: TDataModule4
OldCreateOrder = False
OnCreate = DataModuleCreate
Height = 200
Width = 400
object Connection: TADOConnection
Connected = True
ConnectionString =
‘Provider=SQLOLEDB.1;Password=123456;Persist Security Info=True;U’ +
’ser ID=sa;Initial Catalog=master’
Provider = ‘SQLOLEDB.1′
Left = 56
Top = 24
end
object QSimpan: TADOQuery
Connection = Connection
Parameters = &amp;amp;amp;amp;lt;
item
Name = ‘Kode’
Attributes = [paNullable]
DataType = ftString
NumericScale = 255
Precision = 255
Size = 50
Value = Null
end
item
Name = ‘Gambar’
Attributes = [paNullable, paLong]
DataType = ftVarBytes
NumericScale = 255
Precision = 255
Size = 2147483647
Value = Null
end&amp;amp;amp;amp;gt;
SQL.Strings = (
‘INSERT INTO [Tabel Contoh]’
#9#9′(’
#9#9′Kode,’
#9#9′Gambar’
#9#9′)’
‘VALUES’#9#9′(’
#9#9′ :Kode, ‘
#9#9′ :Gambar ‘
#9#9′)’)
Left = 128
Top = 72
end
object QTampil: TADOQuery
Connection = Connection
CursorType = ctStatic
Parameters = &amp;amp;amp;amp;lt;
item
Name = ‘Kode’
Attributes = [paNullable]
DataType = ftString
NumericScale = 255
Precision = 255
Size = 50
Value = ‘1′
end&amp;amp;amp;amp;gt;
SQL.Strings = (
‘SELECT’#9#9′Gambar’
‘FROM’#9#9′[Tabel Contoh]’
‘WHERE’#9#9′Kode = :Kode’)
Left = 128
Top = 128
object QTampilGambar: TBlobField
FieldName = ‘Gambar’
end
end
object QBuatTabel: TADOQuery
Connection = Connection
Parameters = &amp;amp;amp;amp;lt;&amp;amp;amp;amp;gt;
SQL.Strings = (
‘USE [master]’
‘’
‘SET ANSI_NULLS ON’
‘’
‘SET QUOTED_IDENTIFIER ON’
‘’
‘SET ANSI_PADDING ON’
‘’
‘CREATE TABLE [dbo].[Tabel Contoh](’
#9′[No] [numeric](18, 0) IDENTITY(1,1) NOT NULL,’
#9′[Kode] [varchar](50) COLLATE Latin1_General_CI_AI NULL,’
#9′[Gambar] [image] NULL’
‘) ON [PRIMARY] TEXTIMAGE_ON [PRIMARY]’
‘’
‘SET ANSI_PADDING OFF’)
Left = 56
Top = 72
end
object ActionList1: TActionList
Left = 344
Top = 8
object PBuatTabel: TAction
OnExecute = PBuatTabelExecute
end
object PBuatTabelPopUp: TAction
Caption = ‘Buat Tabel’
OnExecute = PBuatTabelPopUpExecute
end
object PSimpan: TAction
OnExecute = PSimpanExecute
end
object PSimpanPopUp: TAction
Caption = ‘Simpan’
OnExecute = PSimpanPopUpExecute
end
object PTampil: TAction
OnExecute = PTampilExecute
end
object PTampilPopUp: TAction
Caption = ‘Tampilkan’
OnExecute = PTampilPopUpExecute
end
end
object DSQTampil: TDataSource
DataSet = QTampil
Left = 184
Top = 128
end
end

Semoga contoh program diatas bisa bermanfaat. Untuk mendownload contoh program anda bisa download dilink berikut
disini untuk lebih detai Klik disini

Take A Rest For A moment!

Menyimpan dan Menampilkan Gambar pada MS SQL Server

Ringtone Area