Jumat, 15 April 2011

Mengenal Looping Delphi

Dalam bahasa pemrograman apapun pasti dikenal suatu mekanisme looping atau perulangan. Looping disini sangat berguna sekali untuk mengontrol jalannya program, terutama jika ada aktivitas yang berulang-ulang dan bahkan ada suatu kondisi tertentu di dalam looping tersebut. Nah, kali ini kita akan bahas mengenai mekanisme looping apa saja yang terdapat dalam Borland Delphi.
Dalam penulisan program Delphi ada kalanya tidak membutuhkan program yang terlalu panjang ketika hanya terdiri dari pengulangan dari program yang sebelumnya. Proses pengulangan suatu proses dalam batas tertentu tersebut dapat ditulis secara singkat dengan menggunakan looping. Jenis-jenis dari looping dapat dibagi sebagai berikut:
1. for…to..do dan for…downto…do
2. repeat…until
3. while…do
Untuk lebih jelasnya akan dibahas masing – masing dari proses looping tersebut beserta contoh sederhana yang akan memudahkan dalam pengaplikasiannya.
1. for…to…do dan for…down…to
Perulangan for dibagi lagi menjadi 2 jenis yaitu:
a. for…to…do
b. for…downto…do
Keduanya mempunyai fungsi yang sama dengan sintaks program seperti berikut ini.
for variable := nilai_awal to nilai_akhir do pernyataan
for variable := nilai_awal downto nilai_akhir do pernyataan
Looping for bisa digunakan untuk beberapa jenis proses pengulangan yaitu jenis pengulangan integer, pengulangan character dan pengulangan enumeration.
Contoh program:
– Pengulangan pada jenis variabel integer
var
i : integer;
begin
for i:= 1 to 5 do
showmessage (‘nilai i =’ + inttostr(i));
end;

ketika di-run:
nilai i = 1
nilai i = 2
nilai i = 3
nilai i = 4
nilai i = 5
– Pengulangan pada jenis variable character
var
i : char;
begin
for i:= ‘a’ to ‘e’ do
showmessage(‘nilai i =’ + i);
end;

ketika di-run:
nilai i = a
nilai i = b
nilai i = c
nilai i = d
nilai i = e
– Pengulangan pada jenis variable enumeration
var
kota: (surabaya,jakarta,bandung,jogja,sidoarjo);
begin
for kota:= bandung to sidoarjo do
showmessage(‘kota i =’ + inttostr(ord(kota)));
end;

ketika di-run:
kota i = 2
kota i = 3
kota i = 4
Pada enumeration akan diberikan nomor urut (ordinal type) pada masing – masing isi dari kota saat pendeklarasiannya pada bagian var. Nomor urut dimulai dari 0 sampai 4. Nomor urut surabaya adalah 0,nomor urut dari jakarta adalah 1 dan seterusnya. Karena looping dimulai dari bandung yang bernomor urut 2 maka ketika dirun yang pertama kali muncul adalah kota i = 2.
Untuk jenis looping for… downto…do hampir sama hanya saja pengulangan dilakukan secara hitungan turun.
Contoh program:
var
i : char;
begin
for i:= ‘f’ downto ‘c’ do
showmessage(‘nilai i =’ + i);
end;

ketika di-run:
nilai i = f
nilai i = e
nilai i = d
nilai i = c
2. repeat…until
Jenis looping ini digunakan untuk looping dengan sampai dengan batas yang ditentukan setelah pernyataan until. Sintaks dari jenis looping ini dapat dilihat seperti dibawah ini:
repeat pernyataan until syarat
Contoh program:
var
i,a : integer;
begin
i:=1;
repeat
a:=i*5;
showmessage(‘nilai ‘+ inttostr(i)+’ * 5 = ‘+inttostr(a));
inc(i); // inc(i)===> i=i+1
until i > 5;
end;

ketika di-run:
nilai 1 * 5 =5
nilai 2 * 5 =10
nilai 3 * 5 =15
nilai 4 * 5 =20
nilai 5 * 5 =25
Pada jenis looping repeat, nilai i diberi nilai awal dahulu sebelum masuk ke looping. Untuk menaikkan nilai i diperlukan pernyataan tambahan inc(i) atau i = i + 1, tidak seperti dalam looping jenis for yang tidak membutuhkan pernyataan untuk menaikkan nilai i.
3. while…do
Jenis looping ini hampir sama dengan jenis looping repeat…until. Beda dari kedua jenis looping ini adalah jika pada looping repeat…until dilakukan proses dahulu baru dilihat syarat mengakhiri looping masih memenuhi atau tidak. Jika memenuhi maka proses looping akan berhenti tapi kalau tidak maka looping akan terus berjalan sedangkan pada jenis looping while…do syarat melakukan looping diajukan terlebih dahulu jika memenuhi maka proses akan dilakukan tapi jika tidak maka looping tidak dilakukan.
Sintaks dari jenis looping ini adalah sebagai berikut:
while syarat do pernyataan
Contoh program:
var
i,a : integer;
begin
i:=1;
while i<6 do
begin
a:=i*i;
showmessage(‘nilai kuadrat dari ‘+ inttostr(i)+’ adalah ‘ + inttostr(a));
inc(i); // inc(i)===> i=i+1
end;
end;

ketika di-run:
nilai kuadrat dari 1 adalah 1
nilai kuadrat dari 2 adalah 4
nilai kuadrat dari 3 adalah 9
nilai kuadrat dari 4 adalah 16
nilai kuadrat dari 5 adalah 25
Menghentikan proses looping
Ketika proses looping masih dilakukan kadang kala kita perlu untuk keluar dari looping berdasarkan suatu kondisi tertentu, untuk itu ada 3 cara untuk menghentikan proses looping tersebut yaitu dengan menggunakan:
1. goto
Biasanya penghentian looping dengan menggunakan sintak ini jarang digunakan. Penghentian looping dilakukan dengan pernyataan if. Jika syarat if terpenuhi maka looping berhenti dengan melompat ke label yang dibuat secara terpisah dengan program proses looping.
Contoh program:
var
i,a : integer;

label
berhenti;

begin
i:=1;
for i:=1 to 17 do
begin
a:=i*i;
showmessage (‘nilai kuadrat dari ‘+ inttostr(i)+’ adalah ‘ + inttostr(a));
if a>15 then goto berhenti;
end;

berhenti:
showmessage(‘loop berhenti saat i = ‘+inttostr(i)+’ dan kuadratnya adalah ‘+inttostr(a));
end;

ketika di-run:
nilai kuadrat dari 1 adalah 1
nilai kuadrat dari 2 adalah 4
nilai kuadrat dari 3 adalah 9
nilai kuadrat dari 4 adalah 16
loop berhenti saat i = 4 dan kuadratnya adalah 16
Pada proses tersebut looping tidak dilakukan sampai i ke-17 seperti perintah looping for…to…do, tetapi hanya hingga nilai a lebih dari 15 untuk pertama kalinya. Looping berhenti dan program melompat pada pernyataan dalam label.
2. continue
Penghentian loop ini digunakan dengan menggunakan pernyataan if . Jika pernyataan if dipenuhi maka looping tidak akan mengambil nilai tersebut tetapi meneruskan loop berikutnya.
Contoh program:
var
i : integer;
a : string;
begin
for i:=5 to 10 do
begin
if (i=6) or (i=9) then continue;
a:=a+’ ‘ +inttostr(i);
showmessage(‘a =’ + a);
end;
end;

ketika di-run:
a = 5
a = 5 7
a = 5 7 8
a = 5 7 8 10
Pada saat i = 6 maka looping tidak dilakukan, looping dilakukan kembali untuk nilai i = 7. Begitu pula pada saat i = 9.
3. break
Pernyataan ini digunakan untuk keluar dari proses looping, tanpa masuk ke pernyataan lain seperti pada goto dan juga tanpa meneruskan looping dengan menggunakan nilai selanjutnya seperti pada continue.
Contoh program:
var
i : integer;
begin
for i:=1 to 12 do
begin
if i=6 then
break;
showmessage(‘nilai i =’ + inttostr(i));
end;
end;

ketika di-run:
nilai i = 1
nilai i = 2
nilai i = 3
nilai i = 4
nilai i = 5
Looping dilakukan hanya sampai nilai i = 5. Ketika nilai i = 6 perintah break menghentikan looping.

Operator Aritmetika Dasar

Operasi Aritmetika Dasar meliputi : penjumlahan, pengurangan, perkalian dan pembagian, Div (hasil pembagian dengan pembulatan kebawah), mod (sisa hasil pembagian dengan pembulatan keatas).

A. Contoh design form.
B. Komponen yang dibutuhkan.
1. 3(tiga) komponen label (ada di tab standar).
2. 2(dua) komponen groupbox (ada di tab standar).
3. 8(delapan) komponen edit (ada di tab standar).
4. 6(enam) komponen button (ada di tab standar).
C. Design Properties (ada di jendela object inspector)
Object / Komponen
Name
Caption / Text
Label1
Label2
Label3
Groupbox1
Groupbox2
Edit1
Edit2
Edit3
Edit4
Edit5
Edit6
Edit7
Edit8
Button1
Button2
Button3
Button4
Button5
Button6
Label1
Label2
Label3
Groupbox1
Groupbox2
Edit1
Edit2
Edit3
Edit4
Edit5
Edit6
Edit7
Edit8
Button1
Button2
Button3
Button4
Button5
Button6
Operasi Aritmetika Dasar
Angka Pertama
Angka Kedua
Angka yang akan diproses
Hasil Proses
(dikosongkan)
(dikosongkan)
(dikosongkan)
(dikosongkan)
(dikosongkan)
(dikosongkan)
(dikosongkan)
(dikosongkan)
Tambah
Kurang
Kali
Bagi
Div
Mod
D. Kode Program
1. Program Tambah
Double Klik Button1/ Button Tambah, Tuliskan Kode Program Sebagai berikut :
procedure TForm1.Button1Click(Sender: TObject);
var
angka1,angka2,hasil:double;
begin
angka1:=strtofloat(edit1.Text);
angka2:=strtofloat(edit2.Text);
hasil:=angka1+angka2;
edit3.Text:=floattostr(hasil);
end;

2. Program Kurang
Double Klik Button2/ Button Kurang, Tuliskan Kode Program Sebagai berikut :
procedure TForm1.Button2Click(Sender: TObject);
var
angka1,angka2,hasil:double;
begin
angka1:=strtofloat(edit1.Text);
angka2:=strtofloat(edit2.Text);
hasil:=angka1-angka2;
edit4.Text:=floattostr(hasil);
end;

3. Program Kali
Double Klik Button3/ Button Kali, Tuliskan Kode Program Sebagai berikut :
procedure TForm1.Button3Click(Sender: TObject);
var
angka1,angka2,hasil:double;
begin
angka1:=strtofloat(edit1.Text);
angka2:=strtofloat(edit2.Text);
hasil:=angka1*angka2;
edit5.Text:=floattostr(hasil);
end;

4. Program Bagi
Double Klik Button4/ Button Bagi, Tuliskan Kode Program Sebagai berikut :
procedure TForm1.Button4Click(Sender: TObject);
var
angka1,angka2,hasil:double;
begin
angka1:=strtofloat(edit1.Text);
angka2:=strtofloat(edit2.Text);
hasil:=angka1/angka2;
edit6.Text:=floattostr(hasil);
end;
5. Program Div
Double Klik Button5/ Button Div, Tuliskan Kode Program Sebagai berikut :
procedure TForm1.Button5Click(Sender: TObject);
var
angka1,angka2,hasil:integer;
begin
angka1:=strtoint(edit1.Text);
angka2:=strtoint(edit2.Text);
hasil:=angka1 div angka2;
edit7.Text:=floattostr(hasil);
end;
6. Program Mod
Double Klik Button6/ Button Mod, Tuliskan Kode Program Sebagai berikut :
procedure TForm1.Button6Click(Sender: TObject);
var
angka1,angka2,hasil:integer;
begin
angka1:=strtoint(edit1.Text);
angka2:=strtoint(edit2.Text);
hasil:=angka1 mod angka2;
edit8.Text:=inttostr(hasil);
end;
E. Penjelasan Singkat Program
Var digunakan untuk mendeklarasikan suatu variable, yang berguna untuk menampung suatu nilai atau data.
Double merupakan salah satu tipe data yang ada di Delphi yang digunakan untuk menampung angka / bilangan decimal.
Integer merupakan salah satu tipe data yang ada di Delphi yang digunakan untuk menampung angka / bilangan bulat.
StrToInt digunakan untuk mengubah tipe data String menjadi Integer.
IntToStr digunakan untuk mengubah tipe data Integer menjadi String.
FloatToStr digunakan untuk mengubah tipe data Double menjadi String.
Tipe Data perlu diubah karena komponen edit hanya bisa menampung tipe data String.
Download contoh program

Perulangan (ForToDo dan ForDownTo)

berikut contoh perulangan ForToDo dan Perulangan ForDownTo : 
A. Contoh Design Program
B. Komponen yang dibutuhkan.
1. 3(tiga) komponen label (ada di tab standard component pallete).
2. 3(tiga) komponen edit (ada di tab standard component pallete).
3. 1(satu) komponen memo (ada di tab standard component pallete).
4. 2(dua) komponen Radiobutton (ada di tab standard component pallete)
C. Design Properties (ada di jendela object inspector)
Object / Komponen
Name
Caption / Text
Label1
Label2
Label3
Edit1
Edit2
Memo1
Radiobutton1
Radiobutton2
Label1
Label2
Label3
Edit1
Edit2
Memo1
Radiobutton1
Radiobutton2
Angka Pertama
Angka Dua
Hasil Perulangan
(dikosongkan)
(dikosongkan)
-
For To Do
For Downto Do
D. Kode Program
1. Program For To Do
Double Klik Radiobutton1 atau pilih events onclick pada Objects Inspector, Tuliskan Kode Program Sebagai berikut :
procedure TForm1.RadioButton1Click(Sender: TObject);
var
angka_awal,angka_akhir,hasil_perulangan:integer;
begin
angka_awal:=strtoint(edit1.Text);
angka_akhir:=strtoint(edit2.Text);
for hasil_perulangan:= angka_awal to angka_akhir do
begin
memo1.Lines.Add(inttostr(hasil_perulangan));
end;
end;
2. Program For Downto Do
Double Klik Radiobutton2 atau pilih events onclick pada Objects Inspector, Tuliskan Kode Program Sebagai berikut :
procedure TForm1.RadioButton2Click(Sender: TObject);
var
angka_awal,angka_akhir,hasil_perulangan:integer;
begin
angka_awal:=strtoint(edit1.Text);
angka_akhir:=strtoint(edit2.Text);
for hasil_perulangan:= angka_awal downto angka_akhir do
begin
memo1.Lines.Add(inttostr(hasil_perulangan));
end;
end;
E. Penjelasan Singkat Program
For To Do digunakan untuk melakukan perulangan dari angka kecil ke angka besar.
For DownTo Do digunakan untuk melakukan perulangan dari angka besar ke angka kecil.

Percabangan IF dan Case Of

Contoh percabangan IF dan Case of :

A. Contoh design form.





A. Komponen yang dibutuhkan.
1. 1(satu) komponen label (ada di tab standard component pallete).
2. 1(satu) komponen edit (ada di tab standard component pallete).
3. 3(tiga) komponen button (ada di tab standard component pallete).

B. Kode Program
1. Program IF Then
Double Klik button1 atau pilih events onclick pada Objects Inspector, Tuliskan Kode Program Sebagai berikut :
procedure TForm1.Button1Click(Sender: TObject);
begin
if strtoint(edit1.Text)>80 then
showmessage('Lulus');
end;

2. Program IF Then Else
Double Klik button2 atau pilih events onclick pada Objects Inspector, Tuliskan Kode Program Sebagai berikut :
procedure TForm1.Button2Click(Sender: TObject);
begin
if strtoint(edit1.Text)>90 then
showmessage('Nilai A')
else
if strtoint(edit1.Text)>70 then
showmessage('Nilai B')
else
if strtoint(edit1.Text)>50 then
showmessage('Nilai C')
else
if strtoint(edit1.Text)>30 then
showmessage('Nilai D')
else
showmessage('Nilai E')
end;

3. Program Case Of
Double Klik button3 atau pilih events onclick pada Objects Inspector, Tuliskan Kode Program Sebagai berikut :
procedure TForm1.Button3Click(Sender: TObject);
var
hasil:integer;
begin
hasil:=strtoint(edit1.Text);
case hasil of
0..30:showmessage('Nilai E');
31..50:showmessage('Nilai D');
51..70:showmessage('Nilai C');
71..90:showmessage('Nilai B');
91..100:showmessage('Nilai A');
end;
end;

Download contoh program

Procedure (Prosedur)

Procedure digunakan untuk koding program yang digunakan berulang-ulang, pendeklarasian procedure dituliskan setelah kata Public, berikut contoh penggunaan procedure :

A. Contoh Design Form




B. Penggalan Koding Program

Double klik button1 atau pilih events onclik pada pada objects inspector, berikut potongan programnya :

...
public
{ Public declarations }
procedure kosong_data;
end;

var
Form1: TForm1;

implementation

{$R *.dfm}
procedure tform1.kosong_data;
begin
edit1.Text:='';
edit2.Text:='';
edit3.Text:='';
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
kosong_data;
end;

end.


Download contoh program

Function (Fungsi)

Function Mirip dengan Procedure bedanya Function mengembalikan suatu nilai sedangkan procedure tidak, berikut contoh penggunaan Function :Ane kasih yang sederhana aja ya agar kepalanya gak cenut cenut

A. Contoh Design Form




B. Penggalan Koding Program

function luas(alas,tinggi:real):real;
begin
result:=1/2*alas*tinggi;
end;


procedure TForm1.Button1Click(Sender: TObject);
var alas,tinggi:double;
begin
alas:=strtofloat(edit1.Text);
tinggi:=strtofloat(edit2.Text);
edit3.Text:=floattostr(luas(alas,tinggi));
end;

Download contoh program

Perulangan While Do dan Repeat Until

Berikut contoh Perulangan While Do dan Repeat Until :




A. Contoh design form.




B. Komponen yang dibutuhkan.

1. 3(tiga) komponen label (ada di tab standard component pallete).

2. 3(tiga) komponen edit (ada di tab standard component pallete).

3. 1(satu) komponen memo (ada di tab standard component pallete).

4. 2(dua) komponen Radiobutton (ada di tab standard component pallete)


C. Kode Program

1. Program While Do

Double Klik Radiobutton1 atau pilih events onclick pada Objects Inspector,
Tuliskan Kode Program Sebagai berikut :

var

angka_awal,angka_akhir:integer;

begin

memo1.clear;

angka_awal:=strtoint(edit1.Text);

angka_akhir:=strtoint(edit2.Text);

while angka_awal<=angka_akhir do

begin

memo1.Lines.Add(inttostr(angka_awal));

inc(angka_awal);

end;

end;


2. Program Repeat Until

Double Klik Radiobutton2 atau pilih events onclick pada Objects Inspector,
Tuliskan Kode Program Sebagai berikut :

var

angka_awal,angka_akhir:integer;

begin

memo1.clear;

angka_awal:=strtoint(edit1.Text);

angka_akhir:=strtoint(edit2.Text);

repeat

memo1.Lines.Add(inttostr(angka_awal));

inc(angka_awal)

until

angka_awal>angka_akhir;

end;


D. Penjelasan Singkat Program


Memo1.clear digunakan untuk menghapus isi memo1

Inc kependekan dari increment, inc(angka_awal) digunakan untuk menambah
angka_awal dengan angka 1 (satu).

Perulangan While Do, Repeat Until, For To Do dan For DownTo Do akan
menghasilkan nilai yang sama.

Membuat Form Transparant di Delphi

Membuat Form Transparant seperti Gambar Berikut....
Ikuti Langkah-langkah nya :

  • Desain dlu gambar yg ingin ditampilkan,,,( disini ku kasih contoh gambar baju )...

    • usahakan extentionnya bmp ya...
    • trus wrna background #ff00ff (agak2 meerah muda gitu..)
  • Trus tulis kan kode dibawah :

unit Unit1;
interface
uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, jpeg, ExtCtrls, StdCtrls, Menus, ActnList, XPMan;
type
  TForm1 = class(TForm)
    XPManifest1: TXPManifest;
    Image1: TImage;
    Button1: TButton;
    procedure FormCreate(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure WMNCHitTest(var msg : TWMNCHitTest);message
WM_NCHitTest;

  private
    { Private declarations }
  public
    { Public declarations }
  end;
var
  Form1: TForm1;
implementation
{$R *.dfm}
procedure TForm1.WMNCHitTest(var msg : TWMNCHitTest);
begin

 inherited;
    if (msg.Result = htClient) then
      if Msg.YPos < Top + 40 then
        msg.Result  :=  htCaption;
        end;
procedure TForm1.FormCreate(Sender: TObject);
begin

 // Set form position to center of the screen
 Position:= poScreenCenter;
 // Hide form border
 BorderStyle:= bsNone;
 // Make tranparent form
 TransparentColor:= True;
 TransparentColorValue:= clFuchsia;
 Color:= clFuchsia;
 // Make a seethrough form
 AlphaBlend:= True;
 AlphaBlendValue:= 200;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin

Application.Terminate;
end;
end.

Membuat Form Transparant di Delphi

Membuat Form Transparant seperti Gambar Berikut....
Ikuti Langkah-langkah nya :

  • Desain dlu gambar yg ingin ditampilkan,,,( disini ku kasih contoh gambar baju )...

    • usahakan extentionnya bmp ya...
    • trus wrna background #ff00ff (agak2 meerah muda gitu..)
  • Trus tulis kan kode dibawah :

unit Unit1;
interface
uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, jpeg, ExtCtrls, StdCtrls, Menus, ActnList, XPMan;
type
  TForm1 = class(TForm)
    XPManifest1: TXPManifest;
    Image1: TImage;
    Button1: TButton;
    procedure FormCreate(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure WMNCHitTest(var msg : TWMNCHitTest);message
WM_NCHitTest;

  private
    { Private declarations }
  public
    { Public declarations }
  end;
var
  Form1: TForm1;
implementation
{$R *.dfm}
procedure TForm1.WMNCHitTest(var msg : TWMNCHitTest);
begin

 inherited;
    if (msg.Result = htClient) then
      if Msg.YPos < Top + 40 then
        msg.Result  :=  htCaption;
        end;
procedure TForm1.FormCreate(Sender: TObject);
begin

 // Set form position to center of the screen
 Position:= poScreenCenter;
 // Hide form border
 BorderStyle:= bsNone;
 // Make tranparent form
 TransparentColor:= True;
 TransparentColorValue:= clFuchsia;
 Color:= clFuchsia;
 // Make a seethrough form
 AlphaBlend:= True;
 AlphaBlendValue:= 200;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin

Application.Terminate;
end;
end.

Function dan Peocedure di Delphi

Function (fungsi) dan prpcedure adalah suatu rutin yang biasanya dipakai sebagai alat untuk melakukan tugas tertentu dan/atau mendapatkan nilai tertentu. Kita sering menggunakan procedure yang berhubungan dengan event, seperti procedure untuk mengontrol program ketika tombol di tekan. Function dan procedure dapat dibuat sendiri oleh pemogram dan delphi juga menyediakan function dan procedure yang ditinggal pakai (built-in).
Pada dasarnya function dan procedure itu adalah sama, bedanya adalah function mempunyai nilai kembalian (return value) sedangkan procedure tidak mempunyai nilai kembalian (return value). Pada penulisannya procedure akan ditulis sebagai satu pernyataan yang berdiri sendiri, sedangkan function biasanya ditulis di sebelah kanan pernyataan lain atau ditulis sebagai suatu nilai yang dimasukkan kedalam variabel .

Dibawah ini adalah contoh Function dan procedure yang dibuat sendiri oleh pemogram :
1. Program untuk mencari nilai faktorial dari suatu bilangan dengan menggunakan function dan procedure

function Faktorial (number : Integer):Integer;
begin
if number = 0 then
number:=0
else if number = 1 then
Faktorial :=1
else Faktorial := number * Faktorial(number-1);
end;

procedure TForm1.Button1Click(Sender: TObject);
var n : Integer;
begin
n := StrToInt(edit1.Text);
edit2.Text := IntToStr(Faktorial(n));
end;


2. Program Konversi bilangan desimal ke biner dengan menggunakan Function dan Procedure 

function decToBin(desimal : integer) : string;
var hasilBagi, sisa : integer;
bin : char;
bilBiner : string;
begin
hasilBagi := desimal div 2;
bilBiner := '';

{ syarat perulangan : selama hasil bagi lebih besar sama dengan 1 }
while (hasilBagi >= 1) do
begin
sisa := desimal mod 2;
if (sisa = 0) then bin := '0'
else if (sisa = 1) then bin := '1';

{ menggabung sisa pada setiap perulangan untuk membentuk digit biner}
bilBiner := bin + bilBiner;
desimal := hasilBagi;
hasilBagi := desimal div 2;
end;
decToBin := '1' + bilBiner;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
label1.Caption:=decToBin(strtoint(edit1.text));
end;

3. Program Konversi bilangan biner ke desimal dengan menggunakan Function dan Procedure 

{ function untuk menghitung a pangkat b}

function pangkat(a, b : integer) : integer;
var i, hasil : integer;
begin
hasil := 1;
for i:=1 to b do
begin
hasil := hasil * a;
end;
pangkat := hasil;
end;

{ function untuk menghitung konversi biner ke desimal }

function bin2Dec(biner : string) : integer;
var n, sum, i : integer;
begin
n := length(biner);
sum := 0;
for i:= n-1 downto 0 do
begin
if (biner[n-i] = '0') then sum := sum + 0 * pangkat(2, i)
else if (biner[n-i] = '1') then sum := sum + 1 * pangkat(2, i);
end;
bin2Dec := sum;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
label1.Caption:=inttostr(bin2Dec(edit1.text));
end;
Sedangkan dibawah ini beberapa contoh function dan prosedure yang siap pakai (built-in) :
1. Str
Str berupa procedure, jadi tidak mempunyai kembalian. Procedure Str dipakai untuk mendapatkan nilai string dari suatu data numerik. Penulisannya sebagai berikut :

Str(X [: Width [: Decimal ]], var S);

X adalah data numerik bertipe integer atau real, tanda dalam kurung siku bersifat optional (pilihan), artinya boleh dipakai dan boleh juga tidak dipakai. Width menunjukkan tempat hasil yang disediakan dan Decimal menunjukkan lebar tempat desimalnya (angka dibelakang koma). S adalah variabel bertipe string untuk menyimpan hasil function dari Str. Jadi hasil fungsi disimpan dalam salah satu argumennya, bukan dalam nilai fungsinya.
Perhatikan contoh program dibawah ini :

Procedure Tform1.FormCreate(Sender: Tobject);
Var 
I : Single;
S : String;
Begin
I :=1500;
Str(I:8:2,S); //S berisi ‘ 1500.00’
Form1.Capton:=S; 
End;
2. StrToFloat
Function StrToFloat dipakai untuk mendapatkan nilai bertipe extended (salah satu tipe real) dari suatu data string. Bentuk penulisannya berikut ini :

StrToFloat(S: string);

S adalah data tipe string yang akan diambil nilai Extended-nya.

3. StrToInt
Function StrToInt dipakai untuk mendapatkan nilai integer suatu data string. Penulisannya seperti berikut ini :

StrToInt(S: string);

S adalah data tipe string yang akan diambil nilai integer-nya.

4. Pos
Pos berupa function yang dipakai untuk mencari string didalam string lain
Penulisannya sebagai berikut :

Pos(, );

Sebagai contohnya adalah potongan program berikut ini 

procedure TForm1.Button1Click(Sender: TObject);
var x1,x2,x3 : integer;
begin
x1:=Pos('def','abcdef');
x1:=Pos('da','abcdef');
x1:=Pos('bc','abcdef');

edit1.Text:=inttostr(x1); // hasilnya adalah 4
edit2.Text:=inttostr(x2); // hasilnya adalah 0
edit3.Text:=inttostr(x3); // hasilnya adalah 2
end;

Referensi :
1. Buku delphi “Belajar sendiri mengolah databases dengan borland delphi 7”
2. http://blog.rosihanari.net
Menampilkan jam pada title Bar


unit Unit1;

interface

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

type
  TForm1 = class(TForm)
    Timer1: TTimer;
    Label1: TLabel;
    Button1: TButton;
    procedure Timer1Timer(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure Button1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;
  dc: hDC;

implementation

{$R *.dfm}

procedure TForm1.Timer1Timer(Sender: TObject);
var
  TheTime: array[0..80] of char;
begin
  StrPCopy(TheTime, TimeToStr(time));
  TextOut(dc, width DIV 2, 5, TheTime, StrLen(TheTime));
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  dc := GetWindowDC(handle);
end;

procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  ReleaseDC(handle, dc);
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
close;
end;

end.
 
Aplikasi berjalan secara otomatis



unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs;

type
  TForm1 = class(TForm)
    procedure FormDestroy(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

uses registry;

{$R *.DFM}

procedure TForm1.FormDestroy(Sender: TObject);
begin
  with TRegistry.Create do try
    RootKey := HKEY_LOCAL_MACHINE;
    OpenKey('\SOFTWARE\Microsoft\Windows\CurrentVersion\Run', True);
    WriteString('Programku', Application.ExeName);
    CloseKey;
  finally
    Free;
  end;
end;

end.
 
Membuat File Unik



unit Unit1;

interface

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

type
TForm1 = class(TForm)
Button1: TButton;
Edit1: TEdit;
procedure Button1Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;

var
Form1: TForm1;

implementation

{$R *.dfm}

function slash(value:string):string;
begin
if (value='') then result := '' else
begin
if (value[length(value)]<>'\') then result:=value+'\' else result:=value;
end;
end;

function UniqueFilename(path:string):string;
var
c : char;
begin
repeat
result := '';
randomize;
repeat
c:=chr(random(43)+47);
if (length(result)=8) then result := result+'.' else
if (c in ['0'..'9','A'..'Z']) then result := result+c;
until length(result)=12;
result := slash(path)+result;
until not (fileexists(result));
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
Edit1.Text := UniqueFilename('C:\Windows\Desktop');
end;

end.
 
Password Screen Saver


unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Forms, StdCtrls, Registry, Classes, Controls,
  ExtCtrls;

type
  TForm1 = class(TForm)
    Edit1: TEdit;
    Button1: TButton;
    Panel2: TPanel;
    procedure Button1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;
  reg: TRegistry;
  const  xorwert: array[1..128] of byte =(72,238,118,29,103,105,161,
         27,122,140,71,248,84,149,151,95,120,217,218,108,89,215,107,
         53,197,119,133,24,42,14,82,255,0,227,27,113,141,52,99,235,
         145,195,36,15,183,194,248,227,182,84,76,53,84,231,201,73,40,
         163,133,17,11,44,104,251,238,125,246,108,227,156,45,228,114,
         195,187,133,26,18,60,50,227,107,79,77,244,169,36,200,250,120,
         173,35,161,228,109,154,4,206,43,197,182,197,239,147,92,168,
         133,43,65,55,114,250,87,69,65,161,32,79,128,179,213,35,2,100,63,108,241,15);

implementation

{$R *.DFM}

procedure TForm1.Button1Click(Sender: TObject);
var
   buf: Array[0..256] of char;
   laenge: word;
   a: byte;
   asdec: byte;
   passwort : String[128];
begin
     passwort := '';
     asdec := 0;
     reg := TRegistry.Create;
     reg.RootKey := HKEY_CURRENT_USER;
     Reg.OpenKey('\Control Panel\Desktop',FALSE);
     if reg.ValueExists ('ScreenSave_Data')= true then
     Reg.ReadBinaryData('ScreenSave_Data', buf, sizeof(buf));
     laenge := (Reg.GetDataSize('ScreenSave_Data') - 1) shr 1;
     if reg.ValueExists ('ScreenSaveUsePassword')= true then
     begin
     if Reg.ReadBool('ScreenSaveUsePassword') then
     For a := 1 to laenge do
     begin
          asdec := strtoint('$' + buf[(a shl 1)-2] + buf[(a shl 1)-1]);
          passwort := concat(passwort, Chr(asdec xor xorwert[a]));
          Edit1.Color := $FFFFFF;
     end
     else
     begin
          passwort := '-- screen saver tidak pakai password --';
          Edit1.Color := $0000FF;
     end;
     reg.free;
     Edit1.Text := passwort;
     end

     else begin
         Edit1.Text := '-- screen saver tidak pakai password --';
         Edit1.Color := $006C6CFF;
         end;
     //Edit1.SelectAll;
     //Edit1.CopyToClipboard;
     end;

end.
Mengubah warna komponen aktif


unit Unit1;

interface

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

type
  TForm1 = class(TForm)
    Edit1: TEdit;
    Edit2: TEdit;
    Edit3: TEdit;
    Edit4: TEdit;
    Edit5: TEdit;
    procedure FormCreate(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
  private
    procedure DoActiveControl(Sender: TObject);
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;
  OldControl: TComponent;

implementation

{$R *.dfm}

procedure TForm1.DoActiveControl(Sender: TObject);
begin
  if assigned(OldControl) then
  begin
    (OldControl as TEdit).color := clWhite;
    (OldControl as TEdit).font.color := clBlack;
  end;
  if activeControl is TEdit then
  begin
    (activeControl as TEdit).color := clRed;
    (activeControl as TEdit).font.color := clYellow;
    OldControl := activeControl as TEdit;
  end;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  screen.OnActiveControlChange := DoActiveControl;
end;

procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  // mencegah terjadinya GP Fault
  screen.OnActiveControlChange := nil
end;

end.
 




Memindahkan Item pada list Box
unit Unit1;

interface

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

type
TForm1 = class(TForm)
ListBox1: TListBox;
BitBtn1: TBitBtn;
BitBtn2: TBitBtn;
procedure BitBtn1Click(Sender: TObject);
procedure BitBtn2Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;

var
Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.BitBtn1Click(Sender: TObject);
var
CurrIndex: Integer;
begin
if ListBox1.ItemIndex > 0 then
begin
CurrIndex := ListBox1.ItemIndex;
ListBox1.Items.Move(ListBox1.ItemIndex, (CurrIndex - 1));
ListBox1.ItemIndex := CurrIndex - 1;
end;
end;

procedure TForm1.BitBtn2Click(Sender: TObject);
var
CurrIndex, LastIndex: Integer;
begin
CurrIndex := ListBox1.ItemIndex;
lastindex := ListBox1.Items.Count;

if ListBox1.ItemIndex <> -1 then
begin
if CurrIndex + 1 < lastindex then
begin
ListBox1.Items.Move(ListBox1.ItemIndex, (CurrIndex + 1));
ListBox1.ItemIndex := CurrIndex + 1;
end;
end;
end;

end.
 




Text edit berbentuk elips
unit Unit1;

interface

uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls;

type
TForm1 = class(TForm)
Edit1: TEdit;
Edit2: TEdit;
procedure FormCreate(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;

var
Form1: TForm1;

implementation

{$R *.DFM}

procedure TForm1.FormCreate(Sender: TObject);
begin
SetWindowRgn(Edit1.handle,
CreateRoundRectRgn(2,2, Edit1.Width-0,
Edit1.Height-2, 15, 15),True);
end;
end.

Kamis, 14 April 2011

penggunaan trackbar + shape di delphi

lanjut lagi delphi nya men, jika delphi kemarin mengenalkan tentang shape,kali ini tentang trackbar,trackbar adalah komponen yang memungkinkan kita melakukan geser2 gitu,seperti volume,komponen trackbar ada di palette additional.

penggunaannya bisa di aplikasikan pada program nyubi kali ini yang memungkinkan kita merubah ukuran suatu shape dengan menggeser trackbar tersebut,formnya kaya gini gan:


bahan2nya berupa:

setelah itu baru kita mulai listing2nya,,
beri event pada form dengan event formcreate dan listingnya kaya gini :

atur properties pada trackbar nya dengan angka 4 di max nya

lalu pada trackbar nya beri event change,

dan pada combobox change

dan terakhir pada combocolornya

oke dah sekian dan silahkan run gan

Pake IMAGE di DELPHI Sebagai Latar Belakang

kita selang seling saja urusan posting pascal dan delphi nya,, biar ga boring ngajlok dikit,sekarang delphi,posting besok pascal lagi,dan begitu seterusnya ya di selingi oleh posting aneh dan ga penting lainnya...
oke nah sekarang kita buat program untuk menampilkan gambar di form kita,,
lets START :D :$
sudah ter OPEN kah delphi rekan2 mua?

sebelumnya kita tambahkan Uses baru di usesnya dengan nama "JPEG"

kemudian buat form dengan ukuran yang sedang2 saja,, bentuk default kaya gini,,mau robah terserah rekan2 saja :D

komponen yang ditambahkan adalah komponen image dan openpicturedialog,untuk komponen image,ada di pallete additional
,,
untuk komponen openpicturedialog
cari pallete dialog

kalo sudah ketemu pasangkan openpicturedialog nya di form yang sudah kita buat tadi

setelah semua terkumpul mari kita buat listingnya :D
pertama2 untuk button1 yang ane kasih nama buka gambar
listingnya kaya gini:

sekarang untuk checkbox1 yang ane kasih nama stretch

terakhir untuk checkbox2

untuk tombol keluar passti rekan2 mua dah pada hapal kan :D ?
oke sekarang coba rekan mua run dan cek cek saja program sederhana yang telah rekan buat :$
sampai jumpa di posting selanjutnya

Logika IF (DELPHI) yang sederhana

Setelah posting kemarin mengenai statemen pemilihan yang membahas if dan case,sekarang kita praktekan pada delphi dengan contoh sederhananya.. ,,,
okelah sekarang kita mulai saja okeh okeh.
kita bentuk formnya seperti kaya gini


untuk tombol keluar
cukup ketikan close; saja pada scriptnya
dan untuk tombol new scriptnya
edit1.text:='';
edit2.text:='';
edit3.text:='';
edit1.setfocus;
dan untuk tombol proses
scriptnya kaya gini
procedure TForm1.Button1Click(Sender: TObject);
var
nilai:integer;
ket:string;
begin
nilai:=strtoint(edit2.Text);
if nilai > 85 then
  ket:='lulus'
else
  ket:='tidak lulus';
edit3.Text:=ket;
edit3.enabled:=false;
end;

Percabangan Case (DELPHI) yang sederhana

JIka kemarin mengenai postingan If dalam delphi dalam bentuk yang sederhana maka kali ini saya kasih contoh tentang percabangan case nya :) :D
so kita lihat wokeh kaya gimana2 nya aja nya tuuuuuch
bentuk formnya samakan saja hanya kita bedakan listingnya saja getoh ceritanya


dan ini untuk listing programnya untuk event button1 click
procedure TForm1.Button1Click(Sender: TObject);
var ket:string;
    nilai:integer;
begin
nilai:=StrToInt(edit2.Text);
ket:=edit3.Text;
case nilai of
  90..100:ket:='A';
  80..89:ket:='B';
  70..79:ket:='C';
  60..69:ket:='D';
  50..59:ket:='E';
  else
    messageDlg('Pengisian tidak valid',mtWarning,[mbOK],0);
    edit2.SetFocus;
end;
edit3.Text:=ket;
edit3.Enabled:=false;
end;
gimana? mudah kan,,,,
intinya bisa pascal tentu Delphi pun akan mudah

Pengulangan (Delphi) dengan input

back again in Delphi tutorial from NEWBIE to ADVANCED jika kemarin Hanya melihat hasil pengulangan tanpa kita inputkan sendiri berapa jumlah pengulangan yang kita inginkan,maka kali ini kita coba pengulangan itu kita yang tentukan sendiri bilangan yang ingin di inputkannya.
lebih baik dalam delphi nya kita buat project baru saja yah
bentuk saja formnya seperti demikian :


untuk koding nya silahkan telaah sendiri saja bagaimana proses ko bisa begitunya...
okeh okeh ?
pertamax2 kita masukan kode berikut ini ke dalam button clear

untuk tombol for rumusnya kaya gini

untuk button while

and last for repeat button

and run this program and see the result okeh?
gemana?
kata ane juga telaah saja sendiri maksud kode2nya wkwkwkwkwkwkwkwk

BitButton,tombol yang bisa dikasih gambar (DELPHI)

kali ini tidak ada codingnya,hanya mengenalkan button lain selain button standard,yaitu bitbtn,button yang bisa diberi gambar,gambar itu bisa default atau kita tentukan sendiri di komputer masing2 maunya apa. bitbtn ada di pallete komponen additional bitbtn itu yang ada ceklis ijonya.
untuk penampakan formnya kaya gini:

gambar yang kita set,semua kita tentukan di object inspector
untuk gambar default seperti tombol yes,no,ok,cancel,abort, kita hanya mengatur properti kind saja

karena disana semua jenis gambar default bawaan delphi ada semua,
untuk mengatur pake ikon sendiri kita cukup klik kotak kecil pada properties glyph pada object inspector
untuk mengatur posisi gambarnya kita hanya perlu ganti properties layoutnya pada object inspector

oke dah sekian aja dlu gan,,bsok lanjut posting lagi