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;*.wmfGIF Image (*.gif)*.gifJPEG Image F' +
'ile (*.jpg)*.jpgJPEG Image File (*.jpeg)*.jpegBitmaps (*.bmp' +
')*.bmpIcons (*.ico)*.icoEnhanced Metafiles (*.emf)*.emfMet' +
'afiles (*.wmf)*.wmfTest (*.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 = <
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>
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 = <
item
Name = 'Kode'
Attributes = [paNullable]
DataType = ftString
NumericScale = 255
Precision = 255
Size = 50
Value = '1'
end>
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 = <>
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.
Tidak ada komentar:
Posting Komentar