asal-asal AJA...: April 2011

Jumat, 15 April 2011

Contoh Koneksi Delphi ke Sql Server 2000

untuk teman-teman yang ingin tau gimana cara koneksi delphi ke sql...
ni da di kasih link download untuk contoh kasusnya...
silahkan ja di klik disini

Kamis, 14 April 2011

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

Rabu, 13 April 2011

PROGRAM PERKALIAN AND PENJUMLAHAN DENGAN STRINGGRID

unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, XPMan, StdCtrls, Grids;
type
TForm1 = class(TForm)
    StringGrid1: TStringGrid;
    Button1: TButton;
    Button2: TButton;
    XPManifest1: TXPManifest;
    procedure FormPaint(Sender: TObject);
    procedure FormResize(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
private
    { Private declarations }
public
    { Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.dfm}

//Untuk animasi form
procedure TForm1.FormPaint(Sender: TObject);
Var i : integer;
begin
For i := 1 to 5000 Do
Begin
Canvas.Pen.Color := clBlue;
Canvas.Pen.Style := psDashDot;
Canvas.MoveTo(ClientWidth div 2, ClientHeight div 2);
Canvas.LineTo(random(ClientWidth),random(ClientHeight));
end;
end;

//pemanggilan animasi form
procedure TForm1.FormResize(Sender: TObject);
begin
Invalidate;
end;

procedure TForm1.FormCreate(Sender: TObject);
var i,kolom,baris :integer;
begin
for kolom:=1 to 10 do
StringGrid1.Cells[kolom,0] := IntToStr(kolom);

for baris:=1 to 10 do
StringGrid1.Cells[0,baris] := IntToStr(baris);

end;

procedure TForm1.Button1Click(Sender: TObject);
var kolom,baris:integer;
begin
StringGrid1.Cells [0,0]:=' + ';

for kolom :=1 to 10 do
for baris := 1 to 10 do
StringGrid1.Cells [kolom,baris]:= IntToStr(kolom+baris);

end;

procedure TForm1.Button2Click(Sender: TObject);
var kolom,baris:integer;
begin
StringGrid1.Cells [0,0]:=' * ';
for kolom :=1 to 10 do
for baris := 1 to 10 do
StringGrid1.Cells [kolom,baris]:= IntToStr(kolom*baris);
end;

end.

thank's...

Selamat Mencoba...

Senin, 11 April 2011

Membuat PopUpMenu

Bagi temen-temen yang belum pernah menggunakan object "TPopupMenu" mungkin sedikit bingung
tentang bagaimana cara menggunakannya. Kemudian bagi yang sekedar sudah tahu pasti tidak tahu
cara menggunakan "TPopupMenu" secara mudah dan efektif serta tidak bertele-tele ketika aplikasi
sudah dibangun secara kompleks.
Untuk informasi secara detail tentang bagaimana menggunakan "TPopupMenu" secara tepat, silahkan anda baca artikel ini secara detail.

TPopUpMenu memiliki peran yang sangat penting dalam melakukan proses eksekusi prosedur, fungsi atau juga untuk berpindah ke tampilan menu yang lain.

Apabila didalam program aplikasi kita ditambahkan TPopUpMenu, maka hal ini akan membuat program aplikasi yang kita buat akan terkesan menjadi lebih profesional dan lebih elegan. Kenapa dimikian, sebab dengan adanya TPopUpMenu akan semakin memudahkan kita dalam mengoperasikan program.
Syukur-syukur apabila anda juga bisa mengaitkannya dengan TAction yang sudah termanage juga shortcut-shortcutnya. Hal ini akan semakin membuat program aplikasi yang kita buat menjadi lebih user friendly.

Baiklah, disini kita akan bahas satu per satu, untuk TAction dan shortcut sudah kita bahasa sebelumnya dan sekarang kita akan membahas mengenai TPopUpMenu.

Langsung saja kita akan membuat program aplikasi, untuk itu silahkan anda ikuti langkah-langkah berikut ini dengan pelan-pelan.

1. Apabila anda belum membuka program Delphi, sebaiknya anda buka terlebih dahulu.
2. Setelah itu, silahkan anda buat program aplikasi baru dan berikan nama projectnya Project1
3. Simpan difolder yang aman.
4. Sekarang silahkan anda tambahkan Object-object seperti disebutkan dibawah ini.

1. ActionList1 : TActionList;
2. PopupMenu1 : TPopupMenu;
3. Button1 : TButton;
4. Bevel1 : TBevel;
5. StaticText1 : TStaticText;

5. Kemudian silahkan anda atur desain form-nya seperti terlihat dibawah ini.

1. ....
2. ....
3. object Form1: TForm1
4. Left = 219
5. Top = 150
6. Width = 432
7. Height = 208
8. Caption = 'www.hEnDr13.blogspot.com by Hendrie haryanto'
9. Color = clWhite
10. Font.Charset = DEFAULT_CHARSET
11. Font.Color = clWindowText
12. Font.Height = -11
13. Font.Name = 'MS Sans Serif'
14. Font.Style = []
15. OldCreateOrder = False
16. PixelsPerInch = 96
17. TextHeight = 13
18. object Bevel1: TBevel
19. Left = 4
20. Top = 140
21. Width = 416
22. Height = 1
23. Shape = bsTopLine
24. end
25. object Button1: TButton
26. Left = 345
27. Top = 144
28. Width = 75
29. Height = 25
30. Caption = 'Keluar'
31. TabOrder = 0
32. end
33. object StaticText1: TStaticText
34. Left = 8
35. Top = 8
36. Width = 291
37. Height = 17
38. Caption = 'Silahkan anda klik kanan form ini untuk menampilkan PopUp'
39. TabOrder = 1
40. end
41. object ActionList1: TActionList
42. Left = 328
43. Top = 56
44. end
45. object PopupMenu1: TPopupMenu
46. Left = 360
47. Top = 56
48. end
49. end
50. ....
51. ....

6. Selanjutnya kita akan membuat TAction didalam TActionList. Untuk membuat TAction sangatlah mudah, namun demikian silahkan anda ikuti langkah-langkah dibawah ini dengan teliti.

- Pilih TActionList
- Klik 2x TActionList
- Tunggu beberapa saat hingga muncul kotak dialog.
- Tekan tombol "Ins" pada keyboard anda
- Fungsi dari tombol "Ins" ini adalah untuk membuat TAction baru.
- Apabila sudah terbentuk TAction baru dengan nama TAction1, setting propertiesnya seperti berikut ini.

Name = Action_Close
Caption = Keluar

- Sekarang silahkan anda tekan tombol "Ins" sekali lagi untuk membuat TAction baru. dan Setting propertiesnya seperti ditunjukkan dibawah ini:

Name = Action_Info
Caption = Informasi

7. Jika sudah selesai membuat TAction, sekarang anda dapat melanjutkan dengan memberikan kode program di masing-masing TAction yang sudah anda buat.
8. Untuk yang pertama silahkan anda pilih "Action_Close"
9. Silahkan anda isikan kode program didalam event "OnExecute" seperti ditunjukkan pada potongan kode program dibawah ini.

1. ....
2. ....
3. procedure TForm1.Action_CloseExecute(Sender: TObject);
4. begin
5.
6. case MessageDlg('Apakah anda yakin akan keluar dari program aplikasi ini',mtConfirmation,[mbYes,mbNo],0) of
7. mrYes:
8. begin
9.
10. Application.Terminate;
11.
12. end;
13. mrNo:
14. begin
15.
16. // abaikan
17.
18. end;
19. end;
20.
21. end;
22. ....
23. ....

10. Kemudian silahkan anda pilih TAction "Action_Info"
11. Silahkan anda isikan potongan kode program dibawah ini pada event OnExecute.

1. ....
2. ....
3. procedure TForm1.Action_InfoExecute(Sender: TObject);
4. begin
5.
6. MessageDlg('Anda sedang belajar membuat TPopUpMenu',mtInformation,[mbOK],0);
7.
8. end;
9. ....
10. ....

12. Sekarang saatnya menggunakan TAction untuk dipasang di object-object yang membutuhkan TAction
13. Untuk tahap awal kita pilih object "Button1"

Object "Button1" ini dari form terlihat memiliki Caption "Keluar", sehingga tujuannya adalah untuk
membantu operator keluar dari program aplikasi. Jadi ketika ditekan tombol ini, maka program aplikasi
nanti akan ditutup.

14. Selanjutnya silahkan anda tampilkan "object inspector" dengan cara menekan tombol F11
15. Setelah itu, silahkan anda pilih tab "Properties"
16. Pilih properties "Action"
17. Isikan nilai pada properties "Action" dengan nilai "Action_Close"
18. Apabila sudah selesai, silahkan anda pilih object "PopUpMenu1"
19. Klik 2x object tersebut
20. Tunggu beberapa saat hingga muncul desain PopUp
21. Ditampilan itu akan dimuncukan TMenuItem yang belum ada namanya ""
22. Sekarang silahkan pilih TMenuItem tersebut
23. Kemudian silahkan anda tampilkan object inspector dengan menekan tombol F11
24. Lanjutkan dengan memilih properties "Action"
25. Isikan nama TAction pada properties "Action" dengan "Action_Info"
26. Tunggu beberapa saat dan secara otomatis TMenuItem yang status Unnamed tadi berubah menjadi "Informasi1"
27. Kemudian diwaktu yang bersamaan akan terbentuk TMenuItem baru dengan status "".
28. Setelah itu, silahkan anda berikan caption "-" / hanya tanda strip 1 aja
29. Tujuannya adalah untuk memberikan tanda batas untuk TMenuItem yang satu dengan yang lain
30. Jika sudah anda tentukan caption dengan tanda "-", maka akan terbentuk TMenuItem baru lagi dengan status "".
31. Sekarang silahkan anda lanjutkan dengan memilih TMenuItem yang tersebut
32. Tampilkan object inspector dengan cara menekan tombol F11
33. Isikan properties "Action" dengan "Action_Close"
34. Untuk tahap selanjutnya, silahkan anda pilih Form1
35. Tampilkan object inspector dengan menekan tombol F11
36. Pilih properties "PopUpMenu" dan isikan nilainya dengan "PopupMenu1"
37. Apabila sudah anda lakukan semua proses diatas, sekarang silahkan anda lanjutkan langkahnya untuk mengcompile dan menjalan program aplikasi dengan cara menekan tombol F9.
38. Tunggu beberapa saat hingga program aplikasi siap untuk dioperasikan
39. Setelah itu, silahkan anda coba klik kanan Form-nya
40. Jika berhasil, maka akan muncul PopUp dengan 2 item.
41. Pilih Item Informasi untuk menampilkan pesan Informasi
42. Dan pilih Item Keluar untuk keluar dari program aplikasi.
43. Untuk keluar anda juga bisa menekan tombol Keluar.
44. Disini perlu anda ketahui bahwa pada object Action_Close dan Button1 memiliki TAction yang sama ,sehingga dapat dikatakan satu TAction bisa dipakai secara bersama-sama.
45. Mudah bukan buat TPopUpMenu.

Semoga artikel ini bisa bermanfaat buat temen-temen yang baru belajar.

salam,,,

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.

Menampilkan Dua Baris Pesan pada Messagebox di Delphi

Terkadang kita ingin agar teks dalam sebuah messagebox atau message dialog dalam aplikasi kita menjadi beberapa baris karena teks yang akan kita tampilkan cukup panjang dan kurang indah jika pesan tersebut ditempatkan dalam satu baris.

Berikut ini adalah cara menampilkan teks dua baris pada messagebox di Delphi :



application.MessageBox('Ini  adalah baris pertama pesan'+chr(10)+

'Ini adalah baris kedua  pesan','Informasi',mb_ok)

Minggu, 10 April 2011

Pelatihan Delphi Untuk Pemula

Sumber: Lab Elka
Bahasa: Indonesia

Buku berbahasa indonesia ini memang tidak membahas keseluruhan tentang delphi. Tapi cukup bermanfaat
bagi anda yang ingin mempelajarinya, di buku ini juga membahas tentang pengaksesan port serial menggunakan
bahasa assembly. Cukup keren!.

bisa diambil disini

36 Jam Belajar Komputer Delphi 7

Penulis: Ir. Inge Martina

Borland Delphi merupakan bahasa yang berbasis Object Pascal dari Borland. Selain itu, Delphi memberikan
fasilitas pembuatan aplikasi baik berbasis visual maupun konsol. Delphi merupakan pilihan dalam pembuatan aplikasi visual
karena memberikan produktifitas yang tinggi. Delphi 7 memberikan fasilitas untuk dua platform, yaitu Windows dan Linux.

E-book 36 Jam Belajar Komputer Delphi 7 ini dibuat agar Anda dapat mempelajari, memahami, mencoba dan melatih penggunaan fasilitas-fasilitas
Delphi 7 secara mudah dan cepat sesuai dengan kebutuhan. Namun, saya hanya bisa memberikan versi pendeknya saja alias review nya.
Tetapi patut juga untuk anda downlaod.

Mencium Bau Rumput Bisa Hilangkan Stres

Rumput segar yang baru dipotong melepaskan senyawa kimia yang bila terhirup akan membuat rileks dan gembira. Itulah sebabnya, mencium aroma rumput dan tumbuhan ketika sedang berjalan di taman atau pegunungan akan membuat kita merasa nyaman.

Hal ini diungkapkan oleh para peneliti dari University of Queensland, Brisbane, Australia. Senyawa kimia yang terkandung dalam aroma rumput selain bisa meredakan ketegangan juga berfungsi mencegah penurunan kemampuan mental pada saat usia lanjut.

Ilmuwan mengklaim bahwa aroma yang dilepaskan rumput bekerja langsung pada otak. Terutama mempengaruhi bagian otak bernama amygdala dan hippocampus yang berhubungan dengan emosi dan daya ingat.

"Kedua area ini bertanggung jawab dalam respons pertahanan dan sistem endokrin, yang mengontrol pelepasan hormon stres seperti corticosteroid," kata Dr Nick Lavidis, seperti dikutip dari Science Alert, Kamis (3/9/2009).

Oleh karenanya, penelitian yang memakan waktu hingga tujuh tahun ini kemudian menciptakan parfum dengan aroma rumput yang baru dipangkas untuk membantu melepaskan stres dan meningkatkan daya ingat.

Lavidis kemudian menjelaskan bahwa stres terbagi dalam dua kategori. Pertama, stres ketika seseorang akan melakukan sesuatu atau saat seseorang harus berusaha sebaik mungkin demi mendapatkan hasil terbaik. Namun menurut Lavidis, stres ini disebut sebagai bentuk stres yang baik.

Sementara stres kategori kedua merupakan stres parah yang bisa memicu tingginya tekanan darah, sifat pelupa, dan melemahkan sistem kekebalan tubuh.

"Stres jenis ini bisa merusak hippocampus dengan mengurangi hubungan antara sel-sel yang berkomunikasi sehingga berdampak pada hilangnya ingatan," kata Lavidis.

Untuk itu, Lavidis menyarankan agar orang yang terkena stres ini menghirup senyawa kimia yang dilepaskan oleh rumput segar atau pepohonan yang rindang.

sumber : http://www.ganool.com

Fungsi Terbilang

Untuk accounting biasanya butuh fungsi terbilang ini. Konsepnya sederhana mengubah angka menjadi kata-kata.

Berikut contoh penggunaannya:

Sedangkan fungsinya sendiri sbb:

function fTerbilang(Num:Real):String;
const
Angka: array[0..19] of String[15]
= ('','Satu ','Dua ','Tiga ','Empat ','Lima ','Enam ','Tujuh ',
'Delapan ','Sembilan ','Sepuluh ','Sebelas ','Duabelas ',
'Tigabelas ','Empatbelas ','Limabelas ','Enambelas ',
'Tujuhbelas ','Delapanbelas ','Sembilanbelas ');
var
One, Two, Tri, Hitung,
V1, V2, V3, VBelas, VGabung, Err: Integer;
S, Satu, Dua, Tiga, Belas, Gabung, Kata : String;

begin
if Num=0 then
Kata:='Nol '
else begin
Str(Num:15:2,S);
One:=1; Two:=2; Tri:=3; Hitung:=1; Kata:='';
while Hitung < 5 do begin
Satu:=Copy(S,One,1);
Dua:=Copy(S,Two,1);
Tiga:=Copy(S,Tri,1);
Gabung:=Satu+Dua+Tiga;

Val(Satu,V1,Err);
if V1=1 then
Kata:=Kata+'Seratus ';
if V1>1 then
Kata:=Kata+Angka[V1]+'Ratus ';

Val(Dua,V2,Err);
Val(Tiga,V3,Err);
if V2=1 then begin
Belas:=Dua+Tiga;
Val(Belas,VBelas,Err);
Kata:=Kata+Angka[VBelas];
end else begin
if V2>1 then
Kata:=Kata+Angka[V2]+'Puluh '+Angka[V3]
else begin
if (V2=0)and(V3>0) then begin
if ((Hitung=3)and(Gabung='001'))or
((Hitung=3)and(Gabung=' 1')) then
Kata:=Kata+'Seribu '
else
Kata:=Kata+Angka[V3];
end;
end;
end;

Val(Gabung, VGabung, Err);
if (Hitung=1)and(VGabung>0) then
Kata:=Kata+'Milyar ';
if (Hitung=2)and(VGabung>0) then
Kata:=Kata+'Juta ';
if (Hitung=3)and(VGabung>0) then begin
if (Gabung='001')or(Gabung=' 1') then
Kata:=Kata+''
else
Kata:=Kata+'Ribu ';
end;
Inc(Hitung);
Inc(One,3);
Inc(Two,3);
Inc(Tri,3);
end;
end;
Result:= Kata;
end;

Fungsi ini di dapat dari buku DBase III+, kemudian saya sesuaikan dengan Bahasa Pascal.

Download full source code disini

sumber : http://delphi-resource.com

Animasi Form Saat Run

Prosedur untuk menampilkan dan menutup form menggunakan animasi.
procedure brAnimasiTivi(FForm:TForm; Muncul:Boolean);
var
i,j,k,l:Integer;
hs : array [0..600] of hrgn;
begin
j:=0;i:=0;l:=0;
//--- Muncul
if Muncul then begin
for k:=0 to 599 do begin
if (j+2<(FForm.Height div 2)) then begin j:=j+2; if j>(FForm.height div 2) then i:=FForm.width;
hs[k]:=CreateRectRgn(i,j,FForm.width-i,FForm.height-j);
end else if (i+6<(FForm.Height div 2)) then begin j:=j+2; if j>(FForm.height div 2) then
i:=FForm.width;
hs[k]:=CreateRectRgn(i,j,FForm.width-i,FForm.height-j);
end else if (i+6
i:=i+8;
hs[k]:=CreateRectRgn(i,j,FForm.width-i,FForm.height-j);
end else begin
l:=k;
break;
end;//if
end;//for
for i:=0 to l do begin
SetWindowRgn(FForm.handle,hs[i],true);
sleep(5);
end;
SetWindowRgn(FForm.handle,CreateRectRgn(0,0,0,0),true);
end;//if
end;

Berikut contoh penggunaannya:
procedure TfmAnim.FormCreate(Sender: TObject);
begin
brAnimasiTivi(Self, True);
end;

Klik disini Klik disini untuk download demonya.

Klik disini untuk download full source code-nya.

sumber : http://delphi-resource.com/?p=130

Contoh Percabangan

code program :

unit UPEMBAYARAN;

interface

uses

Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,

Dialogs, StdCtrls, ExtCtrls, jpeg, XPMan;

type

TForm1 = class(TForm)

Panel3: TPanel;

Label1: TLabel;

Label2: TLabel;

Label3: TLabel;

Label4: TLabel;

Label5: TLabel;

Label6: TLabel;

Label7: TLabel;

Label8: TLabel;

Label9: TLabel;

Label10: TLabel;

Panel1: TPanel;

EDTHARGA: TEdit;

EDTDISCOUNT: TEdit;

EDTJLHTIKET: TEdit;

EDTTOTALBAYAR: TEdit;

cbojenisbus: TComboBox;

cbotujuan: TComboBox;

cbojenispenumpang: TComboBox;

Button1: TButton;

Button2: TButton;

Button3: TButton;

Panel2: TPanel;

XPManifest1: TXPManifest;

Image1: TImage;

Timer1: TTimer;

procedure Button3Click(Sender: TObject);

procedure Button2Click(Sender: TObject);

procedure FormCreate(Sender: TObject);

procedure cbotujuanChange(Sender: TObject);

procedure cbojenispenumpangChange(Sender: TObject);

procedure Button1Click(Sender: TObject);

procedure Timer1Timer(Sender: TObject);

{ Private declarations }

public

{ Public declarations }

end;

var

Form1: TForm1;

jenispenumpang,jlhtiket :integer;

Discount:real;

totalbayar:REAL;

hargatiket:REAL;

B:string;

implementation

uses StrUtils;

{$R *.dfm}

procedure TForm1.Button3Click(Sender: TObject);

begin

APPLICATION.Terminate ;

end;

procedure TForm1.Button2Click(Sender: TObject);

begin

cbojenisbus.Text :='';

cbojenispenumpang.Text:='';

cbotujuan.Text:='';

EDTHARGA.Text:='';

EDTTOTALBAYAR.Text:='';

EDTJLHTIKET.Text:='';

EDTDISCOUNT.Text:='';

end;

procedure TForm1.FormCreate(Sender: TObject);

begin

cbojenisbus.Items.Add('EKONOMI');

cbojenisbus.Items.Add('AC');

cbojenispenumpang.Items.Add('ANAK-ANAK');

cbojenispenumpang.Items.Add('DEWASA');

cbotujuan.Items.Add('TEBING TINGGI') ;

cbotujuan.Items.Add('SEI RAMPAH') ;

cbotujuan.Items.Add('LUBUK PAKAM') ;

cbotujuan.Items.Add('TANJUNG MORAWA');

cbotujuan.Items.Add('MEDAN');

B:=' Pemabayaran Tiket Bus '; //text berjalan pada label1

end;

procedure TForm1.cbotujuanChange(Sender: TObject);

begin

if (cbojenisbus.ItemIndex =0) and

(cbotujuan.ItemIndex =0) then

begin

EDTHARGA.Text:='5000' ;

end

else

if (cbojenisbus.ItemIndex =0) and

(cbotujuan.ItemIndex =1) then

begin

EDTHARGA.Text:='7000' ;

end

else

if (cbojenisbus.ItemIndex =0) and

(cbotujuan.ItemIndex =2) then

begin

EDTHARGA.Text:='9000' ;

end

else

if (cbojenisbus.ItemIndex =0) and

(cbotujuan.ItemIndex =3) then

begin

EDTHARGA.Text:='10000' ;

end

else

if (cbojenisbus.ItemIndex =0) and

(cbotujuan.ItemIndex =4) then

begin

EDTHARGA.Text:='13000' ;

end

else