Monthly Archiv: March, 2013

Membuat effect RGB pada gambar menggunakan delphi

Langsung aja ya ..
Berikut ini contoh aplikasi untuk merubah intensitas warna (RGB) pada sebuah gambar bitmap (bmp/jpg).
Klik Load Picture untuk memuat gambar dari file (jpg/bmp) yang akan di proses.

Setelah itu atur Trackbar (Red, Green, Blue) sesuai keinginan sehingga akan memperoleh hasil seperti gambar berikut.

Untuk mengembalikan gambar pada warna asli kita cukup menekan Reset.
Untuk menyimpan hasilnya Klik Save Picture.

Berikut ini kode selengkapnya ..

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ComCtrls, jpeg, ExtCtrls, StdCtrls, ExtDlgs;

type
  TForm1 = class(TForm)
    tbRed: TTrackBar;
    imgFoto: TImage;
    btLoad: TButton;
    tbGreen: TTrackBar;
    tbBlue: TTrackBar;
    btReset: TButton;
    opd: TOpenPictureDialog;
    Label1: TLabel;
    Label2: TLabel;
    Label3: TLabel;
    Label4: TLabel;
    Panel1: TPanel;
    btSave: TButton;
    SavePictureDialog1: TSavePictureDialog;
    procedure TrackBarAllChange(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure btLoadClick(Sender: TObject);
    procedure btResetClick(Sender: TObject);
    procedure btSaveClick(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;
  bAsli: TBitmap;
  bEffect: TBitmap;

implementation

{$R *.dfm}

procedure TForm1.btLoadClick(Sender: TObject);
begin
     if opd.Execute then
     begin
          imgFoto.Picture.LoadFromFile(opd.FileName);
          bAsli.Assign(imgFoto.Picture.Graphic);
          bAsli.PixelFormat:=pf24bit;
          bEffect.Assign(bAsli);
          tbRed.Enabled:=True;
          tbGreen.Enabled:=True;
          tbBlue.Enabled:=True;
          btSave.Enabled:=True;
     end else
     begin
          imgFoto.Picture:=nil;
          tbRed.Enabled:=False;
          tbGreen.Enabled:=False;
          tbBlue.Enabled:=False;
          btSave.Enabled:=False;
     end;
end;

procedure TForm1.btResetClick(Sender: TObject);
begin
     tbRed.Position:=tbRed.Max;
     tbGreen.Position:=tbGreen.Max;
     tbBlue.Position:=tbBlue.Max;
end;

procedure TForm1.btSaveClick(Sender: TObject);
var
   jpg: TJPEGImage;
begin
     if SavePictureDialog1.Execute then
     begin
          jpg:=TJPEGImage.Create;
          jpg.Assign(imgFoto.Picture.Graphic);
          jpg.SaveToFile(SavePictureDialog1.FileName);
          jpg.Free;
          ShowMessage('Done');
     end;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
     bAsli:=TBitmap.Create;
     bEffect:=TBitmap.Create;
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
     bAsli.Free;
     bEffect.Free;
end;

procedure TForm1.TrackBarAllChange(Sender: TObject);
var
   x,y: Integer;
   baAsli,baEffect: PByteArray;
begin
     for y:=0 to bEffect.Height-1 do
     begin
          baAsli:=bAsli.ScanLine[y];
          baEffect:=bEffect.ScanLine[y];
          for x:=0 to bEffect.Width-1 do
          begin
               baEffect[x*3]:=Trunc(baAsli[x*3]*tbBlue.Position/tbBlue.Max);
               baEffect[x*3+1]:=Trunc(baAsli[x*3+1]*tbGreen.Position/tbGreen.Max);
               baEffect[x*3+2]:=Trunc(baAsli[x*3+2]*tbRed.Position/tbRed.Max);
          end;
     end;
     imgFoto.Picture.Bitmap.Assign(bEffect);
end;

end.

Contoh aplikasi dapat didownload di https://www.box.com/s/u18279aflcnb4pc2lysk

Kode sederhana membuat tampilan Bitmap menjadi negatif

Berikut ini contoh kode sederhana untuk merubah tampilan gambar bitmap menjadi menjadi negatif.

Klik Load Image untuk memuat gambar dari file (jpg/bmp) dan Klik Invert untuk membalik tampilannya.

Kodenya cukup singkat cuman beberapa baris

procedure TForm1.Button1Click(Sender: TObject);
begin
     if OpenPictureDialog1.Execute then
     begin
          Image1.Picture.LoadFromFile(OpenPictureDialog1.FileName);
          Button2.Enabled:=True;
     end else
     begin
          Image1.Picture:=nil;
          Button2.Enabled:=False;
     end;
end;

procedure TForm1.Button2Click(Sender: TObject);
var
   b: TBitmap;
   x,y: Integer;
   ba: PByteArray;
begin
     b:=TBitmap.Create;
     b.Assign(Image1.Picture.Graphic);
     b.PixelFormat:=pf24bit;
     for y:=0 to b.Height-1 do
     begin
          ba:=b.ScanLine[y];
          for x:=0 to b.Width*3-1 do
              ba[x]:=255-ba[x];
     end;
     Image2.Picture.Bitmap.Assign(b);
     b.Free;
end;

Contoh aplikasi selengkapnya bisa di download di …
https://www.box.com/s/rnvjn3jgfeqaj6qyogf2

Memperbaiki “bug” TDataSetInsert (ActionList)

Pada komponen ActionList telah disediakan banyak sekali action Standard yang akan sangat membantu dalam pemrograman delphi tanpa harus menulis code lagi secara manual.

Fungi-fungsi standar seperti File, Edit, Dataset dan lain-lain sudah tersedia kita tinggal pake, jika dikehendaki kita hanya perlu mengganti Caption dan iconnya saja.

Dalam prakteknya action standard yang telah disediakan ada kalanya tidak sesuai atau kurang mewakili kebutuhan kita.

Setelah pada bahasan sebelumnya kita Menambahkan dialog konfirmasi pada TDataSetDelete, kali kita akan memperbaiki “bug” yang ada pada TDataSetInsert.

Pada TDataSetInsert yang asli (contoh kasus menggunakan Delphi 2006), dia tetap aktif setelah kita melakukan Insert atau Edit. Hal ini cukup mengganggu kenyamanan manakala setelah user melakukan Insert/Edit belum selesai kemudian tanpa sengaja menekan button insert lagi, akibatnya data yang belum lengkap akan tersimpan, hal ini bisa jadi masalah jika ada persyaratan semua field harus lengkap sebelum tersimpan.

Berikut ini contoh kodenya …

uses Windows, Messages, SysUtils, Variants, Classes, Graphics,
  Controls, Forms, Dialogs, StdCtrls, ExtCtrls, DBCtrls,
  Grids, DBGrids, DB, DBActns, ActnList;

type
  // Tambahkan ini ...
  TDataSetInsert = class(DBActns.TDataSetInsert)
    procedure UpdateTarget(Target: TObject); override;
  end;
  // Sampai sini .. Tekan Ctrl+Shift C untuk menulis codenya
  TForm1 = class(TForm)

...

...

...

{ TDataSetInsert }
procedure TDataSetInsert.UpdateTarget(Target: TObject);
begin
  with GetDataSet(Target) do
    Enabled := Active and CanModify and (State=dsBrowse);
end;

Semoga bermanfaat

Kapan menggunakan Open dan kapan mengunakan ExecSQL

Kapan menggunakan Open dan kapan mengunakan ExecSQL, hal ini sebenarnya merupakan aturan dasar dalam pemakaian komponen query, namun masih banyak delphier (khususnya pemula) yang sepertinya masih kurang faham penggunaan Open/ExecSQL.

Sering kali Open dan ExecSQL di kerjakan bersama2 dalam satu query sehingga mengakibatkan error atau hasil yang tidak sesuai harapan.

Kunci dasarnya sebenarnya mudah kok ..

Kalo script SQLnya mengandung kata-kata SELECT maka perintah yang boleh digunakan selanjutnya adalah ..

Open;
Append;
Insert;
Edit;
Post;
Delete;
Next;
Prev;
First;
Last;
Close;

Kalo script SQLnya mengandung kata-kata selain SELECT, yaitu INSERT, UPDATE, DELETE, EXECUTE PROCEDURE dan lain-lain maka perintah selanjutnya adalah ..

ExecSQL, yang lain tidak boleh dipergunakan.

Contoh (1):

Query.SQL.Text:='SELECT ID,"Nama" FROM DATA';
Query.Open; => (Query.Open; = Query.Active:=True;)
Query.Append;
Query.FieldByName('ID').AsInteger:=1;
Query.FieldByName('Nama').AsString:='Imam';
Query.Post;

Contoh (2):

Query.SQL.Text:='INSERT INTO DATA(ID,"Nama") VALUES(:P1,:P2)';
Query.Prepare;
Query.ParamByName('ID').AsInteger:=1;
Query.ParamByName('Nama').AsString:='Imam';
Query.ExecSQL;

setelah ExecSQL tidak boleh ada perintah Open dan lain-lain yang seperti digunakan pada contoh 1

LEBIH PENTING LAGI JANGAN GUNAKAN SATU KOMPONEN QUERY DIPAKAI GANTIAN OPEN DAN EXECSQL

Semoga bermanfaat

Tips Optimasi agar loading IDE delphi lebih cepat, ringan dan nyaman dipakai

Salah satu yang membuat kita “kerasan” menggunakan delphi karena didukung beragam paket VCL (komponen) bawaan maupun tambahan yang dibuat oleh pihak ketiga.

Saat ini ada ratusan bahkan ribuan komponen bagus yang dibuat untuk delphi baik yang gratis maupun berbayar.

Semakin hari semakin banyak saja komponen bagus yang membuat kita “ngiler” untuk memasang di delphi kita.

Dengan semakin banyak komponen yang kita pasang konsekuensinya lambat laun akan membuat loading delphi menjadi berat karena membutuhkan lebih banyak resource.

Untuk meringgankan beban delphi, salah satu jalan yang kita tempuh adalah dengan mengurangi sebagian paket komponen, diinstall sebagian aja yang saat ini dibutuhkan.

Namun cara ini agak merepotkan bila mana kita sedang mengerjakan banyak proyek yang menggunakan macam2 komponen berbeda.

Saat mengerjakan proyek A, install paket A,B,C.
Saat mengerjakan proyek B, install paket A,B,E,F.
Saat mengerjakan proyek C, install pake layout model lama.

Ada solusi untuk masalah diatas yaitu memanggil IDE delphi dengan menggunakan konfigurasi yang berbeda (kita bisa membuat 2 atau lebih shortcut untuk ini).

Caranya kita copy shortcut yang ada menjadi beberapa sesuai kebutuhan lalu kita edit parameternya.

misalnya ..
Shortcut asli pada Delphi XE

“C:\Program Files\Embarcadero\RAD Studio\8.0\bin\bds.exe” -pDelphi

kita buat beberapa shortcut misalnya ..

“C:\Program Files\Embarcadero\RAD Studio\8.0\bin\bds.exe” -pDelphi -rPaketA
“C:\Program Files\Embarcadero\RAD Studio\8.0\bin\bds.exe” -pDelphi -rPaketB
“C:\Program Files\Embarcadero\RAD Studio\8.0\bin\bds.exe” -pDelphi -rPaketC

selanjutnya kita panggil masing2 shortcut dan lakukan kustomisasi, misalnya paket apa aja yg diinstall, layoutnya gimana dan setting lainnya.

Dengan membuat berberapa konfigurasi seperti diatas maka loading IDE delphi akan lebih cepat dan ringan karena tidak semua paket dimuat ke memory dan kita tidak perlu bolak/balik bongkar pasang paket.

Semoga bermanfaat

Unit khusus (Library) untuk cek koneksi database Client Server

Pada Aplikasi yang menggunakan database berbasis Client Server, banyak hal yang menyebabkan gagalnya koneksi, antara lain server mati dan gangguan jaringan.

Biasanya untuk mengantisipasi hal tersebut kita menggunakan jurus try .. except .. end seperti contoh dibawah ini :

try
   IBDatabase1.Open;
except
      ShowMessage('Koneksi gagal');
end;

tetapi salah satu kekurangan cara tersebut adalah menampilkan pesan kesalahan terlalu lama, bahkan hingga aplikasi client menjadi not responding.
hal ini tidak baik mengingat kecepatan merupakan salah satu hal terpenting dalam koneksi client server.

Menyikapi hal tersebut diatas, semoga library kecil yang kami buat ini dapat membantu menjadi sebuah solusi yang dapat melakukan pemeriksaan kesiapan server dengan lebih cepat sebelum kita benar-benar melakukan koneksi ke database.

Library ini lumayan kecil (cuman sekitar 19KB) dan mendukung untuk pemeriksaan server Interbase, Firebird, MySQL, PostgreSQL, SQLServer dan Oracle.

Library beserta unit deklarasinya dapat di download secara gratis di ..

https://app.box.com/s/hy0g5mhghpry6z6ljnbs

Isi unit cek_remote_unit ..

unit cek_remote_unit;

(*
  Cek Remote Utilities
  Unit untuk mengecek database Client Server
  mendukung Interbase, Firebird, MySQL, PostgreSQL, SQLServer, Oracle
  ditulis oleh : Imam Chalimi Muslim, Maret 2013
  http://www.facebook.com/imam.chalimi
  http://www.facebook.com/groups/delphi.interbase

  catatan:
  Unit ini membutuhkan file cek_remote.dll
  copykan file cek_remote.dll satu folder dengan aplikasinya
  atau copykan ke c:\windows\system32

  Revisi terakhir 7 Maret 2013
 *)

interface

uses
    Windows;

type
    TServerPort = (spInterbase, spMySQL, spPostgreSQL, spSQLServer,
                   spIB3051, spIB3052, spIB3053, spOracle);

function CekRemoteServer(IPAdress:string='127.0.0.1';ServerPort:TServerPort=spInterbase):Boolean; stdcall;
         external 'cek_remote.dll';
function CekRemoteInterbase(IPAdress:string='127.0.0.1'):Boolean; stdcall;
         external 'cek_remote.dll';
function CekRemoteMySQL(IPAdress:string='127.0.0.1'):Boolean; stdcall;
         external 'cek_remote.dll';
function CekRemotePostgreSQL(IPAdress:string='127.0.0.1'):Boolean; stdcall;
         external 'cek_remote.dll';
function CekRemoteSQLServer(IPAdress:string='127.0.0.1'):Boolean; stdcall;
         external 'cek_remote.dll';
function CekRemoteOracle(IPAdress:string='127.0.0.1'):Boolean; stdcall;
         external 'cek_remote.dll';


implementation

end.

Contoh penggunaan …

procedure TForm1.Button1Click(Sender: TObject);
begin
     if not CekRemoteInterbase('192.168.0.1') then
     begin
          ShowMessage('Koneksi gagal');
          Exit;
     end;
     try
        IBDatabase1.Open;
     except
           ShowMessage('Database tidak dapat dibuka');
     end;
end;

fungsi-fungsi yang tersedia ..
CekRemoteServer … contoh  CekRemoteServer(‘192.168.0.1’,spInterbase);
CekRemoteInterbase … contoh  CekRemoteInterbase(‘192.168.0.1’);
CekRemoteMySQL … contoh  CekRemoteSQLServer(‘192.168.0.1’);
CekRemotePostgreSQL … contoh  CekRemoteSQLServer(‘192.168.0.1’);
CekRemoteSQLServer … contoh  CekRemoteSQLServer(‘192.168.0.1’);
CekRemoteOracle … contoh CekRemoteOracle(‘192.168.0.1’);

selain itu juga dapat digunakan untuk memeriksa port interbase non standard 3051-3053.

Semoga bermanfaat