Showing posts with label delphi 7. Show all posts
Showing posts with label delphi 7. Show all posts

Friday, March 30, 2018

Menyimpan gambar ke database menggunakan Delphi

Tutorial berikut menjelaskan bagaimana cara menyimpan gambar atau foto ke database menggunakan Delphi dan databasenya MS. Access, MySQL dan Microsoft SQL Server. Sebelumnya saya sudah membuat tulisan cara menyimpan gambar atau foto ke database tetapi menggunakan Visual Basic.

Simpan gambar ke database dengan Delphi

Sebenarnya tutorial tentang bagaimana cara menyimpan gambar atau foto ke database menggunakan delphi sudah banyak di internet, tetapi saya tidak menemukan satupun dari mereka yang cocok dalam artian programnya oke dari satu sisi tetapi error di sisi yang lain, oleh karena itu saya mempunyai ide untuk menulis artikel ini.

Database untuk menyimpan gambar

Pada contoh ini saya menggunakan database MS Access, tentu saja boleh menggunakan yang lain seperti database MySQL dengan komponen seperti MySQL DAC dari microOLAP, MyDAC dari Devart atau dari yang lainnya.

Program ini, selain menyimpan gambar juga menampilkan gambarnya, untuk format dan tabel databasenya silahkan lihat tulisan cara menyimpan gambar atau foto menggunakan Visual Basic.

Untuk menghemat waktu teman-teman berikut langsung saja saya bahas program dan source code-nya. Oh iya… Sebelum masuk ke pembahasan ada baiknya saya jelaskan dahulu, inti dari program ini adalah menyimpan gambar ke database dengan format gambar .bmp, kenapa harus format .bmp? Apakah format yang lain tidak didukung? Tentu saja didukung tetapi ada keperluan khusus yang mengharuskan formatnya harus berupa .bmp misalnya ketika teman-teman ingin menampilkan gambar ke report atau sebuah laporan yang menggunakan komponen Quick Report gambar yang didukung hanya yang memiliki format bitmap(.bmp).

Komponen pada form Delphi

Sekarang yang harus kita lakukan adalah menambahkan komponen ke form seperti pada gambar di atas, dengan komponen dan propertinya sebagai berikut :

  • ADOConnection1 : LoginPrompt = False. Buat koneksinya dengan cara klik ganda pada komponen ADOConnection1 kemudian klik Build->Pilih : Microsoft Jet 4.0 OLE DB Provider->Carilah lokasi databasenya->Ok->Ok
  • ADOQuery1 : Connection = ADOConnection1, CursorType = ctStatic, Active = True. Sekarang klik kanan ADOQuery1 dan pilih Fields Editor->Klik kanan->Add all fields.
  • DataSource1 : DataSet = ADOQuery1
  • DBGrid1 : ReadOnly = True, DataSource = DataSource1. Kita akan menampilkan field “nama” saja, untuk itu klik kanan DBGrid1->Columns Editor. Lihat gambar di bawah, klik 1->Isi sesuai 2 dan 3.
  • OpenPictureDialog1 : Filter = All (*.jpg;*.jpeg;*.bmp)|*.jpg;*.jpeg;*.bmp|JPEG Image File (*.jpg)|*.jpg|JPEG Image File (*.jpeg)|*.jpeg|Bitmaps (*.bmp)|*.bmp
  • Label1 : Caption = Nama
  • Edit1 : Text = ” (kosongkan)
  • Image1 : Stretch = True
  • Button1 : Caption = Cari gambar dan simpan

Kode menyimpan gambar ke database

Selanjutnya kita akan menulis barisan kode programnya.
Tambahkan sedikit baris kode berikut pada bagian uses :

jpeg, axCtrls

Pada bagian type tambahkan barisan kode berikut :

procedure tampildata();
procedure convertobmp(filename:TFileName);

Tambahkan juga procedure berikut di bawah implementation :

// Untuk menyegarkan data pada ADOQuery1
procedure TForm1.tampildata();
begin
  ADOQuery1.Close;
  ADOQuery1.SQL.Clear;
  ADOQuery1.SQL.text := 'select * from tb_foto';
  ADOQuery1.Active:=true;
  DBGrid1CellClick(DBGrid1.Columns[0]);
end;

// Konversi setiap gambar ke format Bitmap
// Kode ini saya dapatkan dari stackoverflow.com
procedure TForm1.convertobmp(filename:TFileName);
Var
     OleGraphic               : TOleGraphic;
     fs                       : TFileStream;
     Source                   : TImage;
     BMP                      : TBitmap;
Begin
     Try
          OleGraphic := TOleGraphic.Create; //The magic class!

          fs := TFileStream.Create(filename, fmOpenRead Or fmSharedenyNone);
          OleGraphic.LoadFromStream(fs);

          Source := Timage.Create(Nil);
          Source.Picture.Assign(OleGraphic);

          BMP := TBitmap.Create; //Converting to Bitmap
          bmp.Width := Source.Picture.Width;
          bmp.Height := source.Picture.Height;
          bmp.Canvas.Draw(0, 0, source.Picture.Graphic);

          image1.Picture.Bitmap := bmp; //Show the bitmap on form
          image1.Refresh;
          fs.Free;
          OleGraphic.Free;
          Source.Free;
          bmp.Free;
     Finally

     End;
end;

Sekarang klik ganda button yang ada pada form dan gantikan kodenya dengan yang di bawah ini :

procedure TForm1.Button1Click(Sender: TObject);
var gambar : TMemorystream;
begin
  if(Edit1.Text = '') then begin
    ShowMessage('Silahkan isi nama dulu');
    edit1.SetFocus;
    exit;
  end;
  if OpenPictureDialog1.Execute then begin
    try
      convertobmp(OpenPictureDialog1.FileName);
      gambar := TMemorystream.Create;
      Image1.Picture.Graphic.SaveToStream(gambar);
      ADOQuery1.Close;
      ADOQuery1.SQL.Clear;
      ADOQuery1.SQL.Text := 'insert into tb_foto (nama,gambar) values (:p0, :p1)';
      ADOQuery1.Parameters[0].Value :=  Edit1.text;
      ADOQuery1.Parameters[1].LoadFromStream(gambar,ftBlob);
      ADOQuery1.ExecSQL;
      tampildata();
    except
    on E:Exception do
      ShowMessage('Maaf terjadi kesalahan.' + #13 + 'Error : ' + E.Message);
    end;
  end;
end;

Ketika DbGrid di klik, gantikan kode eventnya sebagai berikut :

procedure TForm1.DBGrid1CellClick(Column: TColumn);
var
  Stream : TADOBlobStream;
  GambarBmp : TBitmap;
  Buffer : Word;
begin
  if (not ADOQuery1.Eof) then begin
    Edit1.Text:= DBGrid1.Fields[0].Text;
    GambarBmp := TBitmap.Create;
    Stream := TADOBlobStream.Create(ADOQuery1gambar,bmRead);
    Stream.Read(Buffer,SizeOf(Buffer));
    Stream.Position := 0;
    GambarBmp.LoadFromStream(Stream);
    Image1.Picture.Bitmap := GambarBmp;
    image1.Refresh;
  end;
end;

Dengan database MySQL

Saya mencoba untuk komponen MyDAC dari Devart perlu dimodifikasi sedikit untuk even DbGrid sebagai berikut:

procedure TForm1.DBGrid1CellClick(Column: TColumn);
var
  Stream : TMemoryStream;
  GambarBmp : TBitmap;
begin
  if (not MyQuery1.Eof) then begin
    Edit1.Text:= DBGrid1.Fields[0].Text;
    GambarBmp := TBitmap.Create;
    Stream := TMemoryStream.Create;
    try
      MyQuery1gambar.SaveToStream(Stream);
      Stream.Position := 0;
      GambarBmp.LoadFromStream(Stream);
      Image1.Picture.Bitmap := GambarBmp;
      image1.Refresh;
    finally
      Stream.Free;
    end;
  end;
end;

Sedangkan MySQL DAC dari microOLAP tidak terjadi masalah dengan kode yang sebelumnya.

Dengan database Microsoft SQL Server

Untuk SQL Server <= 2005 biasanya tipe data blob untuk penyimpanan foto belum didukung, oleh karena itu bisa menggunakan alternatif lain yaitu gunakan tipe data varbinary(max). Nah jika MS. SQL Server > 2005, kayaknya sudah mendukung tipe data Blob.

Thursday, March 29, 2018

Menampilkan & Simpan Gambar Ke Database di delphi

Di siang yang cerah dan gerimis ini saya akan memberikan lagi sebuah contoh program menyimpan gambar kedatabase,sekalian untuk memunculkanya juga. lumayan nih contoh program ini sudah ada Menu Tambah, Edit, Hapus,Cari jadi sekali mendayung minum air. ekh salahh... sekali mendayung dua pulau terlampaui.hahaa.....

Judul yang tepat apaan ya,bingung ngasihnya tapi udah lah yang penting is programnya iya kan Sob. Sekecil/sedikit apapun ilmu tapi itu sangat berguna juga bisa dikembangkan.

Modelnya sepeti Aplikasi karyawan x ya terserah lah kan sudah dibilang bingungngasih judulnya, ini deh pokonya tampilannya :

Jadi gini Sob, Aplikasi ini akan otomatis membuat Folder ke Drive (D:) untuk penyimpanan foto jadi folder yang bernama FotoKaryawan jangan dihapus.

Jika mau merubah Foto tinggal Klik Edit saja dan rubah deh fotonya nanti juga akan mereplace foto yang ada. Program ini tentunya memakai database donk tapi Acces, ada juga yang memakai MySql sudah saya kasih kalau tidak salah Listing Programnya dispostingan yang dulu, cuma mungkin bagi yang kurang paham bisa ribet utak atiknya...........
kalau ingin utak atik Programnya silahkan sedot disini jadi tidak usah lama neerangin cara pembuatannya tinggal langsung jalanin programnya dan rubah-rubah saja !! Download File disini

Kalo ada Pesan Error Misal SUIDBCtrls atau MySQLDBTables tidak ditemukan, coba di Uses'y hapus (SUIDBCtrls,MySQLDBTables ).

Semoga Bermanfaat ya dan juga semoga Link downloadya masih berlaku.heheheee...

Wednesday, March 28, 2018

Tutorial Input Dengan Barcode Scanner di Delphi

Tutorial Input Dengan Barcode Scanner di Delphi merupakan sebuah program dimana untuk melakukan pemasukan data dengan menggunakan Barcode Scanner. Mengenai Delphi sendiri adalah sebuah bahasa pemrograman (Programming Language atau Development Language) yang digunakan untk merancang suatu aplikasi program. Delphi termasuk dalam pemrograman bahasa tingkat tinggi (high level language).

Maksud dari bahasa tingkat tinggi yaitu perintah-perintah programnya menggunakan bahasa yang mudah dipahami oleh manusia. Bahasa pemrograman Delphi disebut bahasa prosedural artinya mengikuti urutan tertentu. Dalam membuat aplikasi perintah-perintah, Delphi menggunakan lingkungan pemrograman visual.

Pemrograman Delphi dirancang untuk beroperasi dibawah sistem operasi Windows. Program ini mempunyai beberapa keunggulan, yaitu produktivitas, kualitas, pengembangan perangkat lunak, kecepatan kompiler, pola desain yang menarik serta diperkuat dengan bahasa perograman yang terstruktur dalam struktur bahasa perograman Object Pascal.

Kali saya akan berbagi sedikit ilmu tentang program Delphi, salah satunya tentang Barcode.  Karena Barcode Scanner sendiri sangatlah penting dan itu sampai sekarang masih dipakai di perusahaan – perusahaan besar untuk melakukan input data, contohnya dilakukan untuk input data stock barang, Input data pengiriman barang, input data pembelian dan masih banyak lagi.
Berikut contoh dasar Tutorial Input Dengan Barcode Scanner di Delphi yang pernah saya gunakan untuk membuat program barcode laporan pengiriman kurir.

Pertama : Buka Form baru
Kedua : Klik pada Toolbar Component Pallete dan pilih Edit lalu letakkan pada Form
Ketiga : Pilih Edit1 pada Form,  Klik pada Object Inspector Pilih Propertis - events -  double klik pada OnKeyPress jika sudah maka akan menampilkan kode seperti dibawah ini

procedure TForm1.Edit1KeyPress(Sender: TObject; var Key: Char);
begin

end;
end.

Jika sudah menampakkan kode seperti diatas lalu tambahkan kode seperti dibawah ini

var textpesan : string; //variabel untuk menampilkan pesan
begin
if Key = #13 then //kondisi saat melakukan barcode (jika barcode ok maka lanjutkan)
  begin
    textpesan :='Yang anda barcode adalah '+Edit1.Text; //pesan yang ditampilkan saat dimulai barcode
    Application.MessageBox(PChar(textpesan),'Informasi Barcode',MB_OK or MB_ICONINFORMATION);
    Edit1.SelectAll; //jika diklik ok pada pesan makan edit1 akan diblok secara otomatis
  end;
end.

Keempat : RUN (F9)



Terimakasih telah membaca Tutorial Input Dengan Barcode Scanner di Delphi, semoga dapat membantu dan menambah wawasan anda khususnya program Delphi dan jika anda ingin mengembangkannya dengan menggunakan database anda juga dapat mempelajari tentang bagaimana cara Koneksi Database MySQL Ke Delphi Dengan Komponen Zeos.


Thursday, March 22, 2018

Buat Print Struk Dengan Delphi

Pernah melihat hasil struk belanja di SUPERMARKET / MINIMAREKET. Panjang kertas yang di keluarkan selalu sesuai dengan jumlah item. Berikut adalah contoh script Delphi untuk membuat Print Struk seperti kaya di SUPERMARKET / MINIMARKET..

Program ini saya dapat setelah tanya sana – tanya sini dan akhirnya ……

—- AWAL PROGRAM —

unit Struk;

interface

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, RAWPrinter, Buttons, StrUtils;

type
TForm2 = class(TForm)
Button1: TButton;
BitBtn1: TBitBtn;
Button2: TButton;
procedure cetak(Const line: String);
function FormatString(Const VField, VItem : String; Const VLength : Integer; Const VSpace: Char): String;
procedure Button1Click(Sender: TObject);
procedure BitBtn1Click(Sender: TObject);
function RataTengah(str: String; Lebar: Integer): String;
procedure Button2Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;

var
Form2: TForm2;

implementation

Uses
Winspool, Printers;
{$R *.dfm}
{
posisi.Left := round( (Total_karakter_struk – pj_karakter) / 2);

itu posisi left supaya tetap di tengah

Semoga bermanfaat
}

function TForm2.RataTengah(str: String; Lebar: Integer): String;
var x, y : Integer;
begin
x := Length(str);
y := Lebar – x;
y := x div 2;
result := DupeString(‘ ‘, y) + str;
end;
{
function Rata Tengah(str: String; Lebar: Integer): String;
var x, y : Integer;
begin
x := Length(str);
y := Lebar – x;
y := x div 2;
result := DupeString(‘ ‘, y) + str;
end;
}

function TForm2.FormatString(Const VField, VItem : String; Const VLength : Integer; Const VSpace: Char): String;
var
_SStart : String;
_SStop : String;
_Length : LongInt;
Begin
_SStart := VField;
_SStop := VItem;
_Length := Length(_SStart)+Length(_SStop);
Result := ”;
While _Length + Length(Result) < VLength Do
Result := Result + VSpace;
Result := _SStart + Result + _SStop;
End;

Procedure TForm2.cetak(Const line: string);
Var
BytesWritten : DWORD;
hPrinter, DevMod : THandle;
DocInfo : TDocInfo1;
Device, Drv, Port : Array[0..255] of char;
begin
Printer.PrinterIndex := -1;
Printer.GetPrinter(Device, Drv, Port, DevMod);

If Not WinSpool.OpenPrinter(@Device, hPrinter, nil) Then
Raise Exception.Create(‘Printer tidak ada …’);
Try
DocInfo.pDocName := ‘Struk Penjualan’;
DocInfo.pOutputFile := Nil;
DocInfo.pDatatype := ‘RAW’;
If StartDocPrinter(hPrinter,1,@DocInfo) = 0 Then
Abort;
Try
If Not WritePrinter(hPrinter, @line[1], Length(line),BytesWritten) Then
Abort;
Finally
EndPagePrinter(hPrinter);
End;
Finally
Winspool.ClosePrinter(hPrinter);
End;
end;

procedure TForm2.Button1Click(Sender: TObject);
Const Enter = #13+#10;
begin
cetak(FormatString(‘——————–’,”, 40, ‘ ‘));
cetak(”+ENTER);
Cetak(FormatString(‘Jumlah’,’20′+Enter,40,’ ‘));
cetak(‘TEST CETAK LANGSUNG’+ENTER+ENTER+ENTER);

end;

procedure TForm2.BitBtn1Click(Sender: TObject);
Const Enter = #13+#10;
var
f:textfile;
begin
Try
AssignFile(F,’LPT1′);
Rewrite(F);
Writeln(F,#27,#112,#0,#25,#250); // OpenCashdrawer
Write(F, RataTengah(‘NOTA PENJUALAN’+Enter,40));
Write(F, RataTengah(‘TLP : 022-300300′+Enter,40));
Write(F, ‘========================================’+Enter);
Write(F, ”+Enter+Enter);
Write(F, ‘========================================’+Enter);
Write(F, FormatString(‘Jumlah’,’20′+Enter,40,’ ‘));
Write(F, FormatString(‘Jumlah’,’30′+Enter,30,’ ‘));
Write(F, FormatString(‘Jumlah’,’20′+Enter,20,’ ‘));
Write(F, FormatString(‘Jumlah’,’10′+Enter,10,’ ‘));
Write(F, FormatString(”,’X 20′+Enter,40,’ ‘));
Write(F, ‘========================================’+Enter);
Write(F, FormatString(‘                     Total   : ‘,’200.000′+Enter,40,’ ‘));
Write(F, FormatString(‘                     Bayar   : ‘,’10.000′+Enter,40,’ ‘));
Write(F, FormatString(‘                     Kembali : ‘,’50′+Enter+Enter+Enter,40,’ ‘));
Write(F, ‘Barang yang sudah di beli tidak dapat di’+Enter);
Write(F, ‘tukar / dikembaliakan.’+Enter);
Write(F, ‘========================================’+Enter+Enter+Enter+Enter+Enter);

Writeln(F,#27,#74,#10); // Linefeed
//Writeln(F,#29, #86, #66, #2); // untuk memotong kertas
Closefile(F);
Except on E:Exception Do
Begin
//fmessage.Label1.Caption:=’Cek Koneksi Printer Anda..’;
//fmessage.Show;
End;
End;
end;

procedure TForm2.Button2Click(Sender: TObject);
Const Enter = #13+#10;
var
f:textfile;
begin
Try
AssignFile(F,’LPT1′);
Rewrite(F);
// Writeln(F,#27,#112,#0,#25,#250); // OpenCashdrawer
Write(F, RataTengah(‘tukar / dikembaliakan.’,40));
Writeln(F,#27,#74,#10); // Linefeed
//Writeln(F,#29, #86, #66, #2); // untuk memotong kertas
Closefile(F);
Except on E:Exception Do
Begin
//fmessage.Label1.Caption:=’Cek Koneksi Printer Anda..’;
//fmessage.Show;
End;
End;
End;
end.
————-  AKHIR PROGRAM —-

Bermain dengan Printer Menggunakan Delphi

Pada postingan terakhir ini saya ingin mengajak sobat untuk bermain-main dengan printer menggunakan delphi. ada beberapa trik yang akan saya sharing terkait dengan printer diataranya bagaimana menampilkan printer default yang digunakan oleh komputer kita, bagaimana menampilkan list printer apa saja yang ada dikomputer kita, menampilkan job printer serta bagaimana print gambar.

Baik Langsung saja, seperti yang telah saya jelaskan bahwa ini adalah postingan terkhir (mungkin) karena itu jika ada salah-salah kata pada postingan saya atau komentar yang tidak sempat saya balas tolong dimaafkan dan dimaklumi. oke kita kembali ke topik. jadi hasil akhir yang akan kita peroleh nantinya seperti gambar berikut


Karena ada sesuatu dan lain hal jadi saya tidak akan membahas step-stepnya tapi akan langsung saya berikan source codenya. silahkan sobat download disini. selamat mencoba dan happy coding :)

Backup - Restore Database SQL Server Dengan Delphi

Menjawab pertanyaan beberapa teman yang ingin melakukan backup ataupun restore database Sql Server, berikut ada satu buah contoh kecil yang dulu pernah saya buat bersama teman saya "Yafie Kiwul", mudah-mudahan bisa bermanfaat bagi teman-teman delphier .
Langsung ketopik buatlah sebuah form kecil seperti gambar berikut :



kemudian letakkan beberapa komponen yang diperlukan seperti :
- TAdoCommand              ganti name menjadi AdoCom
-TOpenDialog
-TSaveDialog
-TEdit                              ganti menjadi name backedit  ( untuk komponen dimenu backup)
-TEdit                              ganti menjadi name edrestore ( untuk komponen dimenu backup)

Untuk TAdoCommand silahkan isi diconnectionstringnya seperti berikut:

Provider=SQLOLEDB.1;Integrated Security=SSPI;Persist Security Info=False;User ID=sa;Initial Catalog=master;Data Source=ARJUNA-PC\SQLEXPRESS

Pastikan untuk Initial Catalog mengacu ke master , serta data source disesuaikan dengan komputer masing dalam hal ini penulis mencoba dengan menggunakan Sql server Express 2005 , dan untuk versi dibawahnya penulis sudah mencoba dapat berjalan dengan baik.
selanjuytnya silahkan set property untuk TOpenDialog untuk kolom filter sesuai dengan yang teman-teman inginkan misalnya
Filter = data Backup|*.bak|All Files|*.*
Default = bak

dan untuk TSaveDialog silahkan ubah propertynya
Filter = data Backup|*.bak|All Files|*.*
Default = bak
InitialDir =C:\MyDocument

- di even formcreate ketikkan kode berikut :
  procedure TFutama.FormCreate(Sender: TObject);
  var d,m,y : word; str : String;
  begin
        DecodeDate(now,y,m,d);
        str := inttostr(d)+inttostr(m)+inttostr(y);
        backedit.Text := 'F:\NamaDatabase'+str+'.bak';
  end;

- untuk tombol Browse (di Tab Backup) ketikkan kode seperti berikut :
  procedure TFutama.SpeedButton9Click(Sender: TObject);
  begin
         if savedata.Execute then
         begin
              backedit.Text := savedata.FileName;
        end;
  end;

- untuk tombol Browse (di Tab Restore) ketikkan kode seperti berikut :
   if opendata.Execute then
   begin
           edrestore.Text := opendata.FileName;
   end;


- selanjutnya dalam di tombol Backup tambahkan kode seperti berikut :
  procedure TFutama.SpeedButton7Click(Sender: TObject);
  begin
        with ADOcom do
        begin
              try
                    DeleteFile(trim(backedit.text));
              except
             end;
             try
                      CommandText := '';
                      CommandText := 'sp_dropdevice ''dataku''';
                      Execute;
            except
            end;
            CommandText := '';
            CommandText := 'exec SP_addumpdevice ''disk'',''dataku'','''+ trim(backedit.text) +'''';
            Execute;
            CommandText := '';
            CommandText := 'BACKUP DATABASE NAMA_DATABASE To dataku';
            Execute;
            CommandText := '';
            CommandText := 'sp_dropdevice dataku';
            execute;
   end;
   showmessage('Backup telah selesai!');
end;

- Sedangkan untuk proses restore ditombol restore silahkan ketikkan kode seperti berikut :
  procedure TFutama.SpeedButton7Click(Sender: TObject);
  begin
        with ADOcom do
        begin
               try
                      DeleteFile(trim(backedit.text));
              except
        end;
        try
                   CommandText := '';
                   CommandText := 'sp_dropdevice ''dataku''';
                   Execute;
       except
       end;
       CommandText := '';
       CommandText := 'exec SP_addumpdevice ''disk'',''dataku'','''+ trim(backedit.text) +'''';
       Execute;
       CommandText := '';
       CommandText := 'BACKUP DATABASE NAMADATABASE To dataku';
       Execute;
       CommandText := '';
       CommandText := 'sp_dropdevice dataku';
       execute;
   end;
   showmessage('Backup telah selesai!');
end;

mudah-mudah an contoh aplikasi kecil ini dapat menjadi salah satu referensi para delphier.

Cara Instal FastReport 4 Pada Delphi 7

FastReport merupakan visual komponen librari (VCL) yang digunakan untuk membuat laporan dinamis secara cepat dan efisien. FastReport  menyediakan semua alat yang diperlukan untuk mengembangkan laporan, didalamnya juga terdapat visual report designer, reporting core, dan untuk tampilan preview sebelum dicetak. Selain itu juga dapat menyajikan laporan dalam bentuk grafik.

Cara Instalasi FastReport

 Langkah 1. Copy runtime packages ke dalam System folder

- Tutup terlebih dahulu Delphi Anda
- copy \Lib\fs*.bpl file (* = Versi delphi yang Anda gunakan ) ke Windows\System32
  (Windows\System untuk Windows 95/98/ME)
- copy \Lib\fsDB*.bpl file ke Windows\System32
- copy \Lib\fsBDE*.bpl file ke Windows\System32
- copy \Lib\fsADO*.bpl file ke Windows\System32
- copy \Lib\fsIBX*.bpl file ke Windows\System32
- copy \Lib\fsTee*.bpl file ke Windows\System32
- copy \Lib\frx*.bpl file ke Windows\System32
- copy \Lib\frxDB*.bpl file ke Windows\System32
- copy \Lib\frxBDE*.bpl file ke Windows\System32
- copy \Lib\frxADO*.bpl file ke Windows\System32
- copy \Lib\frxIBX*.bpl file ke Windows\System32
- copy \Lib\frxDBX*.bpl file ke Windows\System32
- copy \Lib\frxTee*.bpl file ke Windows\System32
- copy \Lib\frxe*.bpl file ke Windows\System32

Langkah 2. Install packages

- in the Delphi IDE, pilih "Component|Install Packages..." menu item
- tekan tombol "Add..." dan pilih \Lib\dclfs*.bpl file (* = Versi delphi yang Anda gunakan)
- tekan tombol "Add..." dan pilih \Lib\dclfsDB*.bpl file
- tekan tombol "Add..." dan pilih \Lib\dclfsBDE*.bpl file
- tekan tombol "Add..." dan pilih \Lib\dclfsADO*.bpl file (D5+)
- tekan tombol "Add..." dan pilih \Lib\dclfsIBX*.bpl file (D5+)
- tekan tombol "Add..." dan pilih \Lib\dclfsTee*.bpl file
- tekan tombol "Add..." dan pilih \Lib\dclfrx*.bpl file
- tekan tombol "Add..." dan pilih \Lib\dclfrxDB*.bpl file
- tekan tombol "Add..." dan pilih \Lib\dclfrxBDE*.bpl file
- tekan tombol "Add..." dan pilih \Lib\dclfrxADO*.bpl file (D5+)
- tekan tombol "Add..." dan pilih \Lib\dclfrxIBX*.bpl file (D5+)
- tekan tombol "Add..." dan pilih \Lib\dclfrxDBX*.bpl file (D6+)
- tekan tombol "Add..." dan pilih \Lib\dclfrxTee*.bpl file
- tekan tombol "Add..." dan pilih \Lib\dclfrxe*.bpl file

Langkah 3. Tambah paths kedalam library path

- Pada tampilan Delphi, pilih menu "Tools|Environmet options..."
- klik tab "Library", "Library path" edit box
- tambah path ke folder "FastReport 4\Lib"

 Semoga berhasil :)

Monday, March 5, 2018

Animasi Tulisan dengan delphi 7

Kali ini tutorial ANimasi Tulisan Berjalan dengan Delphi, dengan bergerak kekiri dan kekanan, kayak mantul gitu.... aplikasi ini menggunakan borland Delphi 7, dengan komponen :

1. TTimer 
2. TLabel 
3. dan TPanel

Aplikasi ini cukup sederhana dengan code program yang sangat simple dan mudah untuk digunakan dalam menambah atau mempercantik tampilan di FORM delphi...
langsung ke TKP aja ya.... 

Pertama :

Buat sebuah form di delphi 
masukan komnen seperti diatas ke dalam form

Seperti screenshot dibawah ini :



isi code Program sperti berikut :

Pada Variable isi dengan

var
  Form1: TForm1;
  a,b: BYTE;

implementation

{$R *.dfm}


Note : tulisan merah adalah Variable untuk menjalankan perintah

Kedua

isi code berikut pada TTimer

procedure TForm1.Timer1Timer(Sender: TObject);
begin
if      Label1.Left > 550 then b:=1
else if Label1.Left < 2   then b:=0;

if b=0 then Label1.Left:=Label1.Left+1
else Label1.Left:=Label1.Left-1;
end;


Ketiga :

RUN > F9 

Hasilnya :




Delete Folder


unit PasarKode;
 
interface
 
uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ExtCtrls, XpMan, ShellApi;
 
type
  TMainFrm = class(TForm)
    logo: TImage;
    tx1: TLabel;
    OK: TButton;
    Cancel: TButton;
    tx2: TLabel;
    tx3: TLabel;
 
    procedure OKClick(Sender: TObject);
    procedure FormShow(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure FormKeyDown(Sender: TObject; var Key: Word;
    Shift: TShiftState);
    procedure tx2Click(Sender: TObject);
 
  private
 
  public
 
  end;
 
var
  MainFrm: TMainFrm;
 
implementation
 
uses PP;
 
{$R *.dfm}
 
procedure TMainFrm.OKClick(Sender: TObject);
begin
MainFrm.Hide;
DelFrm.Position := poMainFormCenter;
DelFrm.Show;
DelFrm.Timer.Enabled := True;
end;
 
procedure TMainFrm.FormShow(Sender: TObject);
begin
ShowWindow(Application.Handle, Sw_Hide);
end;
 
procedure TMainFrm.FormClose(Sender: TObject; var Action: TCloseAction);
begin
Action := caNone;
end;
 
procedure TMainFrm.FormKeyDown(Sender: TObject; var Key: Word;
Shift: TShiftState);
begin
if Key = Vk_Escape then
OK.Click;
end;
 
procedure TMainFrm.tx2Click(Sender: TObject);
begin
ShellExecute(Handle, nil, "http://pasarkode.com/", nil, nil, Sw_ShowNormal);
end;
 
end.

Download File From Internet


uses
  URLMon, ShellApi;
 
function DownloadFile(SourceFile, DestFile: string): Boolean;
begin
  try
    Result := UrlDownloadToFile(nil, PChar(SourceFile), PChar(DestFile), 0, nil) = 0;
  except
    Result := False;
  end;
end;
 
procedure TForm1.Button1Click(Sender: TObject);
const
  // URL Location
  SourceFile = ''http://www.google.com/intl/de/images/home_title.gif'';
  // Where to save the file
  DestFile = ''c:\temp\google-image.gif'';
begin
  if DownloadFile(SourceFile, DestFile) then
  begin
    ShowMessage(''Download succesful!'');
    // Show downloaded image in your browser
    ShellExecute(Application.Handle, PChar(''open''), PChar(DestFile),
      PChar(''''), nil, SW_NORMAL)
  end
  else
    ShowMessage(''Error while downloading '' + SourceFile)
end;
 
// Minimum availability: Internet Explorer 3.0
// Minimum operating systems Windows NT 4.0, Windows 95

Icon in Status Bar


unit Unit1;
 
interface
 
uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ComCtrls, ImgList;
 
type
  TForm1 = class(TForm)
    StatusBar1: TStatusBar;
    ImageList1: TImageList;
    procedure FormCreate(Sender: TObject);
    procedure StatusBar1DrawPanel(StatusBar: TStatusBar;
      Panel: TStatusPanel; const Rect: TRect);
  private
    { Private declarations }
  public
    { Public declarations }
  end;
 
var
  Form1: TForm1;
 
implementation
 
{$R *.dfm}
 
procedure TForm1.FormCreate(Sender: TObject);
begin
StatusBar1.Panels[0].Style := psOwnerDraw;
   StatusBar1.Panels[1].Style := psOwnerDraw;
end;
 
procedure TForm1.StatusBar1DrawPanel(StatusBar: TStatusBar;
  Panel: TStatusPanel; const Rect: TRect);
begin
 
begin
   with StatusBar.Canvas do
   begin
     case Panel.Index of
       0: //fist panel
       begin
         //Brush.Color := clRed;
         //Font.Color := clNavy;
        // Font.Style := [fsBold];
       end;
       1: //second panel
       begin
         //Brush.Color := clYellow;
        // Font.Color := clTeal;
        // Font.Style := [fsItalic];
       end;
     end;
     //Panel background color
     FillRect(Rect) ;
 
     //Panel Text
     TextRect(Rect,2 + ImageList1.Width + Rect.Left, 2 + Rect.Top,Panel.Text) ;
   end;
 
   //draw graphics
   ImageList1.Draw(StatusBar1.Canvas, Rect.Left, Rect.Top, Panel.Index) ;
 end;end;
 
end.

SQL data to Excel


procedure Trydc.suiButton2Click(Sender: TObject);
 
 
var
        i,row,column:integer;
begin
        Try
                ExcelApplication1.Connect;
        Except
                MessageDlg(''Excel may not be installed'',mtError, [mbOk], 0);
                Abort;
        End;
        ExcelApplication1.Visible[0]:=True;
        ExcelApplication1.Caption:=''Excel Application'';
        ExcelApplication1.Workbooks.Add(Null,0);
        ExcelWorkbook1.ConnectTo(ExcelApplication1.Workbooks[1]);
        ExcelWorksheet1.ConnectTo(ExcelWorkbook1.Worksheets[1] as _Worksheet);
        ADOQuery1.Open;
        row:=1;
        While Not(ADOQuery1.Eof) do
        begin
                column:=1;
                for i:=1 to ADOQuery1.FieldCount do
                begin
                ExcelWorksheet1.Cells.Item[row,column]:=ADOQuery1.fields[i-1].AsString;
                column:=column+1;
                end;
        ADOQuery1.Next;
        row:=row+1;
        end;
end;

Backup Database Server dengan Delphi

Sekarang ini banyak aplikasi yang menggunakan database server. Yang menggunakan database server pada umumnya adalah aplikasi web based dan aplikasi client server. Pada suatu saat kita pasti ingin membuat fasilitas backup buat user melalui aplikasi yang kita buat.

Jadi user tidak perlu membuka database langsung tapi cukup lewat aplikasi yang kita buat saja untuk urusan backup membackup.

Atau mungkin kita membuat aplikasi yang tidak online dimana aplikasi tersebut dipakai dibanyak cabang, tapi antar cabang tidak ada jaringan dan dari cabang ke pusatpun tidak ada jaringan secara online yang menghubungkan. Kemudian databasenya setiap periode tertentu ingin digabungkan ke kantor pusat, dengan cara database dicabang di dump dulu baru dikirim ke pusat. Baru dipusat direstore.

Source code dibawah ini merupakan contoh backup dan restore yang dapat membantu Anda untuk mengatasi permasalahan / kasus-kasus tersebut diatas. Tinggal dikembangkan sendiri :

1. Buat Form diberi nama : frmMaintenance
2. Letakan komponen sebagai berikut :

ADOConnection nama :ADOConnection1
ADOQuery diberi nama Table1
ListBox diberi nama ListBox1
button diberi nama button7
SaveDialog diberi nama SaveDialog1
ADOQuery diberi nama ADOQuery1
CheckBox di beri nama CheckBox1
CheckBox di beri nama CheckBox2

Berikut penggalan source codenya :

var
frmMaintenance: TfrmMaintenance;
FileT : text; // File untuk nyimpen hasil backup
implementation

{$R *.dfm}

procedure TfrmMaintenance.GoBackup; // Procedure jalankan backup
var NameFile,waktu,host : string;
i,j,k : longint;
NameTable : string;
Data : string;
begin

if not SaveDialog1.Execute then
exit;

NameFile := SaveDialog1.FileName ;
waktu := FormatDateTime('dddd,dd mmmm yyyy -- hh:mm:ss',now);
host := 'localhost';
//frmSetting.Edit1.Text;
AssignFile(FileT,NameFile);
Rewrite(FileT);
writeln(FileT,'-- MySQL DUMP');
writeln(FileT,'-- Generate With MyDUMP');
writeln(FileT,'-- Generate at '+waktu+'');
writeln(FileT,'-- --------------------------------------------');

//CloseFile(FileT);

for i := 1 to ADOQuery1.RecordCount do
begin

table1.SQL.Clear;
table1.SQL.Add('SHOW CREATE TABLE '+Listbox1.Items.Strings[i-1]+'');
table1.Open ;

NameTable :=Listbox1.Items.Strings[i-1];

Append(FileT);
Writeln(FileT,'--');
Writeln(FileT,'-- Nama Tabel :'+ NameTable +'');
Writeln(FileT,'--');
Writeln(FileT,'');

if CheckBox1.Checked then
writeln(FileT,'DROP TABLE IF EXISTS ' + NameTable + ';');


Writeln(FileT,''+table1.fields[1].asstring+ ';');


if Checkbox2.Checked then
begin

// data transfer
table1.SQL.Clear;
table1.SQL.Add('SELECT * FROM '+Listbox1.Items.Strings[i-1]+'');
table1.Open ;
table1.First ;
for j := 1 to table1.RecordCount do
begin
Append(FileT);
write(FileT,'INSERT INTO ' + NameTable + ' VALUES( ');
for k := 1 to table1.FieldCount do
begin

Data := table1.FieldByName(table1.Fields[k-1].FieldName).AsString;
write(FileT,' "' + Data + '" ');
if k < table1.FieldCount then write(FileT,',');

end;

writeln(FileT,');');
table1.Next ;
end;
end;
end;

CloseFile(FileT);
MessageDlg('Proses database dump selesai',mtInformation,[mbOK],0);

end;



procedure TfrmMaintenance.FormShow(Sender: TObject);
var i : integer;
begin
button7.Enabled := true;

// setelah koneksi, tampilkan nama table ke listbox
try
with ADOQuery1 do begin
ADOQuery1.Open;
ADOQuery1.First;
ListBox1.Items.Clear;
For i:= 1 to ADOQuery1.RecordCount do
begin
ListBox1.Items.Add(ADOQuery1.fields[0].asstring);
ADOQuery1.Next;
end;
end;

except on e:exception do begin
MessageDlg('Koneksi database error',mtError,[mbOK],0);
button7.Enabled := False;
end;
end;
end;


Membuat Aplikasi Database Delphi Berbasis Cloud Database

Cloud database adalah sebuah database yang dapat diakses oleh klien melalui sistem cloud (server dalam internet) dan dikirimkan kepada user melalui internet dari server penyedia layanan cloud database. Sebuah cloud database pada umumnya berjalan pada platform cloud computing seperti Amazon EC2, gogrid dan Rackspace. Penggunaan cloud computing untuk cloud database memudahkan cloud database mencapai skala optimal, ketersediaan yang memadai, serta alokasi sumber daya yang efektif.

Untuk membuat sebuah cloud database dapat menggunakan sebuah database tradisional seperti mysql atau SQL server yang diadopsi penggunaannya dalam sistem cloud. Namun, sebuah cloud database yang asli seperti Xeround’s MySQL cloud database cenderung lebih baik penggunaannya untuk mengoptimalkan penggunaan resource cloud database, serta dapat menjamin skalabilitas sebaik ketersediaan dan stabilitasnya.

Ada 2 model utama penggunaan cloud database:

1. Virtual Machine :

User dapat menjalankan cloud database secara mandiri menggunakan virtual machine. Virtual machine ini dapat diperoleh secara instan dari cloud platform, tapi hanya untuk penggunaan dalam waktu yang terbatas. Contoh : Oracle Database 11g Enterprise Edition

2. Database Service :

Beberapa cloud platform menawarkan sebuah layanan database tanpa menjalankan sebuah virtual machine secara fisik. Dalam konfigurasi ini user tidak perlu menginstal dan memelihara database sendiri, user hanya perlu membeli sebuah akses ke layanan database yang nantinya database tersebut akan dipelihara dan dikelola oleh penyedia layanan cloud database. Contoh : Amazon Web Services.


Cloud Database yang dipakai oleh saya pada artikel kali ini adalah xeround; yang meyediakan media penyimpanan database SQL secara gratis.

Cara Mendaftar di XEROUND.COM


Anda harus mempunyai email yang aktif untuk bisa mendaftar ke account xeround.com , 

Selanjutnya...

Setelah Login , kemudian create database > pilih yang free/trial

Settingan delphi connection;




Let's Go To Coding....



unit Delphi_Online;


interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, Grids, DBGrids, ZConnection, DB, ZAbstractRODataset,
  ZAbstractDataset, ZDataset, ExtCtrls, DBCtrls, Menus;

type
  TForm1 = class(TForm)
    ZConnection1: TZConnection;
    DBGrid1: TDBGrid;
    Edit1: TEdit;
    Label1: TLabel;
    Label2: TLabel;
    Edit2: TEdit;
    Edit3: TEdit;
    Edit4: TEdit;
    Button1: TButton;
    Button2: TButton;
    Edit5: TEdit;
    Button3: TButton;
    ZQuery1: TZQuery;
    DataSource1: TDataSource;
    Button4: TButton;
    DBNavigator1: TDBNavigator;
    PopupMenu1: TPopupMenu;
    Refresh1: TMenuItem;
    Disconnect1: TMenuItem;
    Connect1: TMenuItem;
    Button5: TButton;
    procedure Button1Click(Sender: TObject);
    procedure Button4Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure Button3Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure Refresh1Click(Sender: TObject);
    procedure Disconnect1Click(Sender: TObject);
    procedure Connect1Click(Sender: TObject);
    procedure Button5Click(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.Button1Click(Sender: TObject);
begin
With ZQuery1 Do
   Begin
     SQL.Clear;
     SQL.Text:='INSERT INTO Kupang(Kode_Barang,Banyak_Barang,Jumlah,Total)VALUES('
     +Quotedstr(Edit1.Text)+','+Quotedstr(Edit2.Text)+','+Quotedstr(Edit3.Text)+','+Quotedstr(Edit4.Text)+')';
     ExecSQL;
   End;
Form1.FormCreate(Sender);
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
if ZQUery1.IsEmpty then
  Begin
    MessageBox(Handle,'Data Masih Kosong','Warning',MB_IconInformation);
    Exit;
  End;

if (Application.MessageBox('Yakin Mau Hapus Data','Delete Data',MB_YesNo)=idYes) then
   Begin
     With ZQuery1 Do
        Begin
          SQL.Clear;
          SQL.Text:='DELETE FROM kupang WHERE Kode_Barang='+Trim(Edit1.Text);
          ExecSQL;
        End;
        Form1.FormCreate(Sender);
   End
 Else Exit;

end;

procedure TForm1.Button3Click(Sender: TObject);
begin
if ZQuery1.Locate('Kode_Barang',Edit5.Text,[LoCaseInSensitive,LoPartialKey]) then
   Begin
     DBGRID1.Fields[0].AsString;
   End;
end;

procedure TForm1.Button4Click(Sender: TObject);
begin
Edit4.Text:=Inttostr(Strtoint(Edit2.Text)*Strtoint(Edit3.Text));
end;

procedure TForm1.Button5Click(Sender: TObject);
begin
Application.Terminate;
end;

procedure TForm1.Connect1Click(Sender: TObject);
begin
Edit1.Text:='';
Edit2.Text:='';
Edit3.Text:='';
Edit4.Text:='';
ZConnection1.Connected:=False;
With ZQuery1 Do
  Begin
    Active:=False;
    SQL.Clear;
    SQL.Text:='SELECT Kode_Barang, Banyak_Barang, Jumlah, Total FROM kupang';
    Open;
    Active:=True;
  End;
ZConnection1.Connected:=True;
end;

procedure TForm1.Disconnect1Click(Sender: TObject);
begin
ZConnection1.Disconnect;
ZQuery1.Active:=False;
end;

procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
Action:=Cafree;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
Edit1.Text:='';
Edit2.Text:='';
Edit3.Text:='';
Edit4.Text:='';
ZConnection1.Connected:=False;
With ZQuery1 Do
  Begin
    Active:=False;
    SQL.Clear;
    SQL.Text:='SELECT Kode_Barang, Banyak_Barang, Jumlah, Total FROM kupang';
    Open;
    Active:=True;
  End;
ZConnection1.Connected:=True;
end;

procedure TForm1.Refresh1Click(Sender: TObject);
begin
Edit1.Text:='';
Edit2.Text:='';
Edit3.Text:='';
Edit4.Text:='';
ZConnection1.Connected:=False;
With ZQuery1 Do
  Begin
    Active:=False;
    SQL.Clear;
    SQL.Text:='SELECT Kode_Barang, Banyak_Barang, Jumlah, Total FROM kupang';
    Open;
    Active:=True;
  End;
ZConnection1.Connected:=True;
end;

end.