Cara Membuat Auto Hide Kotak Komentar Blog Kita

Cara Membuat Auto Hide Kotak Komentar Blog-Selamat pagi sobat blogger,tahukan sobat tentang auto hide kotak komentar?pastinya sudah tidak asing lagi ditelinga sobat blogger yang sudah lama malang melintang didunia blogger.Cara ini banyak diterapkan oleh para blogger salah satunya saya,tp tidak di KumpulanProgram karena untuk mengantisipasi loading blog yang bagi saya sudah terlalu berat.Kita kembali ke topik utama sob,cara membuat auto hide kotak komentar atau membuat show hide komentar caranya cukup mudah,langkahnya hanya menambahkan kode java script dibawah ini yang nantinya akan berfungsi sebagai perintah untuk menyebunyikan kotak komentar blog.

Btw sudah berbulan-bulan saya vacum didunia blogger,entah kenapa rasa malas untuk menulis masih hinggap didiri saya,semoga saja mulai sa'at ini saya bisa wembali menuis untuk berbagi dengan sobat.

Cara Membuat Auto Hide Kotak Komentar Blog.Mari mluncur kwe TKP sob,..........

1.Login ke blogger

2.Opsi lainya>>Template>>Edit HTML>>Lanjutkan(centang Expand Template Widget)

3.cari kode </head> dan copas kode dibawah ini kemudian taruh diatas kode </head> tadi.

<script src='http://ajax.googleapis.com/ajax/libs/jquery/1.7.1/jquery.min.js' type='text/javascript'/>
<script type='text/javascript'>
//<![CDATA[
var panelSelector = '#comments',
openPanelText = "Lihat Komentar",
closePanelText = "Sembunyikan Komentar",
slideDownPanelSpeed = 800,
slideUpPanelSpeed = 300;
//]]></script>
<script type='text/javascript'>
</script>
<script src='http://kumpulanpemograman.googlecode.com/files/show-hide.js' type='text/javascript'/>

4.Setelah itu cari kode ]]></b:skin> setelah itu taruh kode dibawah ini diatas kode ]]></b:skin>

a.openpanel {display:block;width:100%;height:40px;padding:0px 0px;text-align:center;font-weight:bold;line-height:30px;background:#ffffff; url()repeat-x;-webkit-transition: all .15s ease-in-out;-webkit-transform-origin: 50% 1px;position:relative;
}a.openpanel em {width:0px;height:0px;display:block;position:absolute;top:15px; right:15px;border:6px solid transparent;border-top-color:white;
}a.openpanel.active {background-color:#ffffff;}a.openpanel.active em {top:6px;border color:#222222;
}div.paneline {height:0px;-webkit-transition: all .15s ease-in-out;-webkit-transform-origin: 50% 1px;}div.hompiPanel {padding:10px 20px 20px;margin:0px 0px !important;}

5.PRATINJAU dulu sob,X aja ada yang salah,klo udah sukses simpan template.

Sekian dulu artikel Cara Membuat Auto Hide Kotak Komentar Blog.Komentar ditunggu dibawah..hehehehe

Kumpulan Program Delphi 7 For U All

Dalam Article Ini Saya Akan Share Dalam Bentuk PDF .
Article Yang Saya Buat Ini Banyak Dari File Tetangga Termasuk Senior Kita Yaitu
ILMUKOMPUTER
karena ILMU komputer Termasuk WEBSITE yang sangat Bermanfaaat Untuk Dikunjungi
Dan Itu Sangat Lah Berguna Bagi Kita Anak Programmer.
Untuk Lebih Lanjut Kita Lanjut Aja Ke Article
dibawah Ini..






Langsung Saja OK

1. File Pertama Yaitu Membuat Aplikasi Sederhana

 Read File Here ==> Program Aplikasi Sederhana

2. File Pertama Yaitu Membuat Form Biodata

 Read File Here ==> Membuat Form Biodata

3. File Pertama Yaitu Tutorial Program Aplikasi

 Read File Here ==> Tutorial Program Aplikasi

4. File Pertama Yaitu Memasukkan file Flash Ke Delphi 7

 Read File Here ==> Memasukkan file Flash Ke Delphi 7

5. File Pertama Yaitu Membuat Animasi Mata dengan Borland Delphi 7.0

 Read File Here ==> Membuat Animasi Mata dengan Borland Delphi 7.0

6. File Pertama Yaitu Membuat Login Form Dengan Borland Delphi dan Basis Data Microsoft Access

 Read File Here ==> Membuat Login Form Dengan Borland Delphi dan Basis Data Microsoft Access

7. File Pertama Yaitu Membuat Form Gaji Karyawan dengan Delphi 7

 Read File Here ==> Membuat Form Gaji Karyawan dengan Delphi 7

8. File Pertama Yaitu Program untuk Capture Foto dengan Webcam menggunakan
Delphi 7.0

 Read File Here ==> Program untuk Capture Foto dengan Webcam menggunakan Delphi 7.0

9. File Pertama Yaitu Membuat Dialog KILLER dengan DELPHI 7

 Read File Here ==> Membuat Dialog KILLER dengan DELPHI 7

10. File Pertama Yaitu Menggunakan grafik / chart pada Borland Delphi 7

 Read File Here ==> Menggunakan grafik / chart pada Borland Delphi 7

Thanks For Read Article Here.....

copyright@ILMUKOMPUTER And Evi_WidyAstuti

PROGRAM MENGHITUNG LUAS SEGITIGA DENGAN DELPHI 7

Program berikut ini mempergunakan rumus matematika untuk menghitung luas sebuah segitiga ( 0.5 X alas X tinggi ). Dari rumus tersebut kita bisa membuat sebuah program sederhana.
Langka-langka untuk membuat programnya adalah sebagai berikut :

1. Buatlah sebuah Form seperti yang terlihat pada gambar 1 dibawah ini.

Gambar 1. Form Tampilan

2. Kemudian Doble Click pada tombol Proses dan ketikan Code dibawah ini pada bidang Code editor seperti yang terlihat pada gambar 2 .

procedure TForm1.Button1Click(Sender: TObject);
var A,T,L:real; 
begin 
A:=STRTOFLOAT(EDIT1.TEXT); 
T:=STRTOFLOAT(EDIT2.TEXT); 
L:=0.5*A*T; 
EDIT3.Text:=FLOATTOSTR(L); 
end;

Gambar 2. Bidang Code Editor

3. Setelah selesai memasuakan code tersebut pada bidang code editor, kemudia anda jalankan program tersebut dengan cara clik tombol Run yang terdapat pada panel bagian kiri atas yang berwana hijau. Atau dengan menekan f9 pada keyboard.

PROGRAM KALKULATOR SEDERHANA DENGAN DELPHI 7

Dengan menggunakan Delphi 7 kita juga bias membuat sebuh calculator sederhana,

Langka-langkanya adalah sebagi berikut :

1.Buatlah sebuah Form seperti yang terlihat pada gambar 11 dibawa ini.

  Pada program berikut ini kita akan menggunakan empat buah botton, tiga buah

  edit dan satu label. Ubah Caption botton pada properties sesuai dengan yang

  kita inginkan, hapus edit pada properties-text dang anti label dengan hasil

  perhitungan.

Gambar 11. Form Menu

2.Doble Clik tombol Tamba dan masukan code dibawah ini pada bidang code editor.

procedure TForm1.Button1Click(Sender: TObject);
var A,B,C:INTEGER;
begin
A:=STRTOINT(EDIT1.TEXT);
B:=STRTOINT(EDIT2.TEXT);
C:=A+B;
EDIT3.Text:=INTTOSTR(C)
end;

Note : Untuk C pada tombol Kurang codenya menjadi C:=A-B;
       Pada tombol Kali codenya menjadi C:=A*B;
       Sedangkan  pada tombol Bagi codenya menjadi C:=A div B;

Program Transaksi Sederhana dengan Borland Delphi 7

Komponen yang digunakan :

- Komponen Standart : Panel, Edit, Label, Memo, Button
Listing Program :
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, ExtCtrls;

type
TForm1 = class(TForm)
Panel1: TPanel;
Panel2: TPanel;
GroupBox1: TGroupBox;
GroupBox2: TGroupBox;
GroupBox3: TGroupBox;
GroupBox4: TGroupBox;
ComboBox1: TComboBox;
ComboBox2: TComboBox;
ComboBox3: TComboBox;

Edit1: TEdit;
Edit2: TEdit;
Edit3: TEdit;
Edit4: TEdit;
Edit5: TEdit;
Edit6: TEdit;
Memo1: TMemo;
Memo2: TMemo;
Memo3: TMemo;
Button1: TButton;
Button2: TButton;
Button3: TButton;
Button4: TButton;
Label1: TLabel;
Label2: TLabel;
Label3: TLabel;
Label4: TLabel;
Memo4: TMemo;
Memo5: TMemo;
Edit7: TEdit;
Memo6: TMemo;
Timer1: TTimer;
Label5: TLabel;
Label6: TLabel;
Label7: TLabel;
procedure FormCreate(Sender: TObject);
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
procedure Button3Click(Sender: TObject);
procedure Button4Click(Sender: TObject);
procedure ComboBox1Change(Sender: TObject);
procedure ComboBox2Change(Sender: TObject);
procedure ComboBox3Change(Sender: TObject);
procedure Timer1Timer(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;

var
Form1: TForm1;
var harga1,harga2,harga3,tot1,tot2,tot3,total,diskon,uang,bayar,kembali: currency;
jml1,jml2,jml3:integer;

implementation

{$R *.dfm}

procedure TForm1.FormCreate(Sender: TObject);
begin
ComboBox1.Text:=’ -Pilih-’;
ComboBox2.Text:=’ -Pilih-’;
ComboBox3.Text:=’ -Pilih-’;
Edit1.Clear;
Edit2.Clear;
Edit3.Clear;
Edit4.Clear;
Edit5.Clear;
Edit6.Clear;
Edit7.Clear;
Memo1.Clear;
Memo2.Clear;
Memo3.Clear;
Memo4.Clear;
Memo5.Clear;
Memo6.Clear;
Button2.Visible:=false;
Button3.Visible:=false;
Button4.Visible:=false;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
harga1:=StrToCurr(Edit1.Text);
harga2:=StrToCurr(Edit2.Text);
harga3:=StrToCurr(Edit3.Text);
jml1:=StrToInt(Edit4.Text);
jml2:=StrToInt(Edit5.Text);
jml3:=StrToInt(Edit6.Text);
tot1:=harga1*jml1;
tot2:=harga2*jml2;
tot3:=harga3*jml3;
Memo1.Text:=CurrToStr(tot1);
Memo2.Text:=CurrToStr(tot2);
Memo3.Text:=CurrToStr(tot3);
total:=tot1+tot2+tot3;
Memo4.Text:=CurrToStr(total);
Button2.Visible:=True;
Button3.Visible:=True;
Button4.Visible:=True;

total:=StrToCurr(Memo4.Text);
if total>=2000000 then
diskon:=100000
else diskon:=50000;
Memo5.Text:=CurrToStr(diskon);
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
uang:=StrToCurr(Edit7.Text);
bayar:=total-diskon;
kembali:=uang-bayar;
Memo6.Text:=CurrToStr(kembali);
end;

procedure TForm1.Button3Click(Sender: TObject);
begin
ComboBox1.Text:=’ -Pilih-’;
ComboBox2.Text:=’ -Pilih-’;
ComboBox3.Text:=’ -Pilih-’;
Edit1.Clear;
Edit2.Clear;
Edit3.Clear;
Edit4.Clear;
Edit5.Clear;
Edit6.Clear;
Edit7.Clear;
Memo1.Clear;
Memo2.Clear;
Memo3.Clear;
Memo4.Clear;
Memo5.Clear;
Memo6.Clear;
Button2.Visible:=false;
Button3.Visible:=false;
Button4.Visible:=false;
end;

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

procedure TForm1.ComboBox1Change(Sender: TObject);
begin
if ComboBox1.ItemIndex=0 then
harga1:=2000000
else if ComboBox1.ItemIndex=1 then
harga1:=1000000
else if ComboBox1.ItemIndex=2 then
harga1:=500000;

Edit1.Text:=CurrToStr(harga1);
end;
procedure TForm1.ComboBox2Change(Sender: TObject);
begin
if ComboBox2.ItemIndex=0 then
harga2:=200000
else if ComboBox2.ItemIndex=1 then
harga2:=100000
else if ComboBox2.ItemIndex=2 then
harga2:=50000;


Edit2.Text:=CurrToStr(harga2);
end;

procedure TForm1.ComboBox3Change(Sender: TObject);
begin
if ComboBox3.ItemIndex=0 then
harga3:=250000
else if ComboBox3.ItemIndex=1 then
harga3:=150000
else if ComboBox3.ItemIndex=2 then
harga3:=100000;


Edit3.Text:=CurrToStr(harga3);
end;
procedure TForm1.Timer1Timer(Sender: TObject);
begin
Label7.Caption:=TimeToStr(now);
Label6.Caption:=DateToStr(now);
end;
end.

Program Menyusun Rentang Nilai Code !!!

Program Menyusun_Rentang_Nilai;
Uses Wincrt;
Var i,tot,n:integer;
Begin
Write('Masukkan Jumlah Rentang Nilai: ');Readln(n);
For i:= 1 to n do
Begin
if (i mod 3 = 0) then
Begin
tot:=tot-i;
write('-',i);
End
else
Begin
tot:=tot+i;
if (i=1) then
write(i)
else
write('+',i);
End;
End;
Writeln;
Writeln('Total Rentang Nilai: ',tot);
End.

Contoh Program Pisahkan Rekursif

Program Pisahkan_Rekursif;
Uses Wincrt;
Procedure pisah(x,y:integer);
Begin
Writeln(x,'<--->',y);
if x<y then
begin
pisah(x,(x+y) div 2);
pisah((x+y) div 2+1,y);
end;
End;
Begin
pisah(5,10);
End.

Contoh Program TLQueue

Program Queue;
Uses Wincrt;
Type antrian = ^node; {Program QUEUE menggunakan Record}
node = Record
isi : String[10];
next : antrian; End;
Var dpn, blk, baru : antrian;
x,y : String[10];
i : integer;

Function IsEmpty: boolean; {Fungsi digunakan untuk menge-cek apakah antrian kosong ato tidak}
Begin {Meng-cek apakah node Depan dan Belakang Kosong atau tidak??}
IsEmpty := (dpn=nil) and (blk=nil);
End;

Procedure Cetak; {Cetak Antrian secara FIFO(First In First Out)}
Var bantu : antrian;
Begin
writeln; write(' Hasil Cetak Data = ');
If not(IsEmpty) then {Cek dulu apakah kosong atau tidak}
Begin
bantu := dpn; {Variabel bantu untuk tambahan, apabila bantu tidak kosong, maka diCETAK}
While bantu <> nil do {antrian maju dan diulangi sampai variabel bantu kosong isinya}
Begin
write(bantu^.isi:5);
bantu := bantu^.next;
End;
End
Else write('Antrian KOSONG, Tidak Ada Yang Bisa Dicetak !!');
writeln;
write(' == Modifikasi Data QUEUE==');
End;

Procedure Buat; {Prosedur untuk membuat antrian/menambah antrian di belakang}
Var baru : antrian;
Begin
new(baru);
baru^.isi := x;
baru^.next := nil;
If IsEmpty then {Apabila Antrian kosong maka buat baru di antrian tersebut}
Begin {Jika tidak, maka buat baru setelah antrian tersebut}
dpn := baru;
blk := baru;
End
Else Begin
blk^.next := baru;
blk := baru;
End;
End;

Function Cari(x : String): boolean; {Fungsi pencarian data "X" di antrian}
Var ada : boolean; bantu : antrian;
Begin
ada := false;
bantu := dpn;
Repeat {Pengulangan cek pada tiap node apakah "x" ada di dalamnya?? Jika tidak maka lanjut ke node selanjutnya}
If (bantu^.isi = x) then ada := true {sampai ada=TRUE atau tidak ada sama sekali}
Else bantu := bantu^.next;
Until ada or (bantu = nil);
cari := ada;
End;

Procedure TambahBlk; {Tambah Belakang sebenarnya hanya menggunakan prosedur Buat}
Begin
writeln;
write('Masukkan Data Yang Akan Ditambahkan Dibelakang Data = '); readln(x);
Buat;
End;

Procedure AmbilDpn; {Prosedur mengambil depan untuk menjadi data "x"}
Var bantu : antrian;{Akan tetapi, tidak dilakukan apapun terhadap data ini??}
Begin
writeln;
write(' Elemen Terdepan Data Adalah = '); write(dpn^.isi);
write('Tekan ENTER utk Ambil Data Tersebut = '); readln;
baru := dpn;
If not(isEmpty) then
Begin
dpn := dpn^.next;
baru := nil;
End
Else write('antrian kosong');
End;

Procedure HapusDpn; {Prosedur untuk menhapus data terdepan}
Var bantu : antrian;
Begin
If not (isEmpty) then
Begin
dpn := dpn^.next;
If dpn=nil then blk := nil;
End
Else write('antrian kosong');
End;

Procedure HapusBlk; {Prosedur untuk menghapus data belakang}
Var bantu, baru : antrian;
Begin
bantu := dpn;
If not (isEmpty) then
Begin
While bantu^.next^.next <> nil do bantu := bantu^.next;
new(baru);
baru := bantu^.next;
bantu^.next := nil;
baru := nil;
End
Else write('antrian kosong');
End;

Procedure HapusX; {Prosedur untuk menghapus data "X"}
Var bantu, hapus : antrian;
Begin
bantu := dpn;
new(hapus);
If cari(x)=true then
Begin
hapus := bantu^.next;
bantu^.next := hapus^.next;
hapus := nil;
End
Else bantu := bantu^.next;
End;

Procedure SisipDpn; {Prosedur untuk Sisip Depan, tetapi belum berhasil sampai saat ini}
Var baru, bantu : antrian;
Begin
bantu := dpn;
While bantu^.next <> nil do
Begin
If bantu^.next^.isi = x then
Begin
new(baru);
baru^.isi := y;
baru^.next := bantu^.next;
bantu^.next := baru;
End;
bantu := bantu^.next;
End;
End;

Procedure SisipBlk; {Prosedur untuk Sisip BElakang, tetapi belum berhasil sampai saat ini}
Var bantu, baru : antrian;
Begin
bantu := dpn;
While bantu^.next <> nil do
Begin
If bantu^.isi=x then
Begin
new(baru);
baru^.isi := y;
baru^.next := bantu^.next;
bantu^.next := baru;
End;
bantu := bantu^.next;
End;
End;

Procedure Identitas; {Prosedur Identitas akan muncul pada program}
Begin
gotoXY(10, 1); write('Program "Q U E U E"');
gotoXY(10, 2); write('Muchamad Dachlan Zaim (M0507028)');
gotoXY(10, 3); write('Ilmu Komputer 2007');
gotoXY(10, 4); write('Tanggal 20 Mei 2008, 18.00 WIB');
gotoXY(6, 5); write('== Modifikasi Data QUEUE==');
End;

Procedure Menu; {Prosedur untuk menampilkan semuanya, termasuk menu utama juga !!!}
Var pil,lagi : char;
Begin
clrscr;
Identitas;
Cetak;
gotoXY(30,10); write('"== Modifikasi Data QUEUE=="');
gotoXY(10,12); write('a. Input Awal');
gotoXY(10,13); write('b. Cari Data X');
gotoXY(10,14); write('c. Tambah Data di Belakang/ Enqueue');
gotoXY(10,15); write('d. Ambil Data Teratas dan Simpan di X');
gotoXY(10,16); write('e. Hapus Data Terdepan');
gotoXY(10,17); write('f. Hapus Data Belakang');
gotoXY(10,18); write('g. Hapus Data X');
gotoXY(10,19); write('h. Sisip Data di Depan');
gotoXY(10,20); write('i. Sisip Data di Belakang');
gotoXY(10,21); write('j. Keluar');

Repeat
gotoXY(40,23); Clreol; write('Pilihan anda (a-j) = '); readln(pil);

CASE upcase(pil) OF
'A' : Begin
lagi := 'Y';
clrscr;
gotoXY(10,5); write('=== Daftar Makanan "RestoRUN" ===');writeln;
While upcase(lagi)='Y' do
Begin
write(' Nama Makanan = '); readln(x);writeln;
buat;
repeat
write(' Ada lagi (Y/T) ? '); readln(lagi);writeln;
until upcase(lagi) in['Y','T']
End;
cetak; readln; menu;
End;
'B' : Begin
clrscr;
gotoXY(25,6); write('Makanan Apa Yang anda Cari = '); readln(x);
If not(isEmpty) then
Begin
cari(x);
If (cari(x)=true) then
Begin
gotoXY(25,10); write('Makanan "',x,'" Tersedia Dalam Daftar Makanan ');
End
Else Begin
gotoXY(25,10); write('Makanan "',x,'" Tidak Tersedia Di Daftar Makanan');
End;
End
Else write('antrian kosong');
cetak; readln; menu;
End;
'C' : Begin tambahblk; cetak; readln; menu; end;
'D' : Begin ambildpn; cetak; readln; menu; end;
'E' : Begin writeln; write('Tekan ENTER Untuk Hapus Depan... '); readln; hapusdpn; cetak; readln; menu;End;
'F' : Begin writeln; write('Tekan ENTER Untuk Hapus Belakang...'); readln; hapusblk; cetak; readln; menu;End;
'G' : Begin
write(' Data Yang Akan Dihapus = '); readln(x);
hapusX; cetak; readln; menu;
End;
'H' : Begin
write(' Data Yang Akan Disisipkan = '); readln(y); writeln;
write(' Disisip Didepan Data = '); readln(x);
If cari(x)=true then sisipdpn;
cetak; readln; menu;
End;
'I' : Begin
write(' Data Yang Akan Disisipkan = '); readln(y); writeln;
write(' Disisip Dibelakang Data = '); readln(x);
If cari(x)=true then sisipblk;
cetak; readln; menu;
End;
'J' : donewincrt;
End;
Until upcase(pil) in['A'..'J'];
End;

{----MAIN PROGRAM----}

Begin
screensize.x := 95;
screensize.y := 400;
menu;
End.{AKHIR PROGRAM UTAMA}

Program Heap sort algorithm

(** Heap sort algorithm.
*
* Author: Paulo Roma
* Date: 22/04/2008.
* http://en.wikipedia.org/wiki/Heapsort
* http://www2.hawaii.edu/~copley/665/HSApplet.html
*)

program Heap_Sort;

type SArray = array of integer;
var Asize: integer;
var A: SArray;
var i: integer;

(** swap.
*
* Swaps two given values.
*
* @param a,b values to be swaped.
*)

procedure swap ( var a, b: integer );
var temp: integer;
begin
temp := a;
a := b;
b := temp;
end;

(** siftDown.
*
* Sifts downward to establish the heap property.
*
* @param A array.
* @param start heap root.
* @param end_ represents the limit of how far down the heap to sift.
*)

procedure siftDown ( var A: SArray; start, end_: integer );
var root, child: integer;
begin
root := start;

// While the root has at least one child
while ( root * 2 + 1 <= end_ ) do begin 
child := root * 2 + 1; // left child
// If the child has a sibling and
// the child's value is less than its sibling's
if ( child < end_ ) and ( A[child] < A[child + 1] ) then
child := child + 1; // point to the right child instead
if ( A[root] < A[child] ) then begin // out of max-heap order
swap ( A[root], A[child] );
root := child; // repeat to continue sifting down the child
end
else
break;
end;
end;

(** heapify.
*
* Builds a heap from the bottom up.
*
* The heapify function can be thought of as building a
* heap from the bottom up, successively sifting downward
* to establish the heap property.
*
* @param A array.
* @param count number of elements in A.
*)

procedure heapify ( var A: SArray; count: integer );
var start: integer;
begin
// start is assigned the index in A of the last parent node
start := (count - 1) div 2;

while ( start >= 0 ) do begin
// sift down the node at start index to the proper place,
// such that all nodes below the start index are in heap order
siftDown (A, start, count-1);
start := start - 1;
// after sifting down the root all nodes/elements are in heap order
end;
end;

(** heapSort.
*
* Sorts A=(A0, A1, ..., An) into nondecreasing order of keys.
* This algorithm has a worst case computational time of O(n log n).
* Not stable.
*
* Heapsort primarily competes with quicksort,
* another very efficient, general purpose, and
* nearly-in-place, comparison-based sort algorithm.
*
* Heapsort inserts the input list elements into a heap data structure.
* The largest value (in a max-heap) or the smallest value
* (in a min-heap) are extracted until none remain,
* the values being extracted in sorted order.
* The heap's invariant is preserved after each
* extraction, so the only cost is that of extraction.
*
* During extraction, the only space required is that needed to store
* the heap. In order to achieve constant space overhead, the heap
* is stored in the part of the input array that has not yet been sorted.
* (The structure of this heap is described at Binary heap:
* Heap implementation.)
*
* Heapsort uses two heap operations: insertion and root deletion.
* Each extraction places an element in the last empty location of
* the array. The remaining prefix of the array stores the
* unsorted elements.
*
* @param A array to be sorted.
* @param n number of elements to be sorted.
*)

procedure heapSort( var A: SArray; n: integer );
var end_: integer;
begin
// first place A in max-heap order
heapify ( A, n );

end_ := n - 1;
while ( end_ > 0 ) do begin
// swap the root (maximum value) of the heap
// with the last element of the heap
swap( A[end_], A[0]);
// decrease the size of the heap by one,
// so that the previous max value
// will stay in its proper placement
end_ := end_ - 1;
// put the heap back in max-heap order
siftDown (A, 0, end_);
end;
end;

begin
write ( 'Enter number of elements: ' );
read ( Asize );
// alocate an array from 0 to Asize-1
// the array index is always zero-based
SetLength ( A, Asize );
// generate the seed
randomize;
// fill A with random numbers in the range [0..99]
for i := 0 to Asize-1 do
A[i] := random (100);

// print original array
for i := 0 to Asize-1 do begin
write (A[i]); write (' ');
end;
writeln;

// sort
heapSort ( A, Asize );

// print sorted array
for i := 0 to Asize-1 do begin
write (A[i]); write (' ');
end;
writeln;
end.

Program Insertion Sort

program insertion(input,output);
const
MAX = 10;
var
a : array[1..MAX] of integer;
i, n : integer;

procedure insertion_sort;
var
i, pos : integer;
value : integer;
done : boolean;
begin
for i := 2 to n do
begin

value := a[i];
pos := i;
done := false;
while not done do
begin
if pos <= 1 then
done := true
else if value >= a[pos-1] then
done := true
else
begin
a[pos] := a[pos-1];
pos := pos-1
end
end; {while}

a[pos] := value;

end {for}
end;

begin { main }
writeln('How many number would you like to sort (max=',MAX:2,') ?');
readln(n);

writeln('Enter in ',n:1,' numbers:');
for i := 1 to n do
read(a[i]);

insertion_sort;

for i := 1 to n do
write(a[i]:1,' ');
writeln
end.

Program Tree

PROGRAM Tree (Input, Output);
{Written by Jason John Schwarz with Turbo Pascal v6.0.
Purpose: A demonstration binary tree.}

USES CRT;

TYPE
Point = ^Node;
Node = RECORD
Data : REAL;
Left : Point;
Right : Point;
END;{Node}

VAR
Root : Point;

PROCEDURE Initialize;
BEGIN
Root:=NIL;
END;{Initialize}

PROCEDURE Create (Data : REAL);
BEGIN
NEW(Root);
Root^.Data:=Data;
Root^.Left:=NIL;
Root^.Right:=NIL;
END;{Create}

PROCEDURE AddNode (Data :REAL; Root : Point);
VAR
Temp : Point;
BEGIN
NEW(Temp);
IF Data>=Root^.Data THEN Root^.Right:=Temp;
IF Data=Root^.Data) THEN
IF Root^.Right<>NIL THEN Add(Data,Root^.Right)
ELSE AddNode(Data,Root);
IF (Data<>NIL THEN Add(Data,Root^.Left)
ELSE AddNode(Data,Root);
END;{Root=NIL}
END;{Add}

PROCEDURE InOrder (Root : Point);
BEGIN
IF Root <> NIL THEN BEGIN
InOrder(Root^.Left);
WRITELN(Root^.Data);
InOrder(Root^.Right);
END;{Root<>NIL}
END;{InOrder}

PROCEDURE PreOrder (Root : Point);
BEGIN
IF Root <> NIL THEN BEGIN
WRITELN(Root^.Data);
PreOrder(Root^.Left);
PreOrder(Root^.Right);
END;{Root<>NIL}
END;{PreOrder}

PROCEDURE PostOrder (Root : Point);
BEGIN
IF Root<>NIL THEN BEGIN
PostOrder(Root^.Left);
PostOrder(Root^.Right);
WRITELN(Root^.Data);
END;{Root<>NIL}
END;{PostOrder}

PROCEDURE GetData;
VAR Data : REAL;
BEGIN
WRITE(Output,'What is the new number?');
READLN(Input,Data);
Add(Data,Root);
END;{GetData}

PROCEDURE Loop;
VAR
Choice : CHAR;
BEGIN
REPEAT
Choice:=CHR(0);
GetData;
CLRSCR;
WRITELN(Output,'InOrder Tree:');
InOrder(Root);
WRITELN(Output,'PostOrder Tree:');
PostOrder(Root);
WRITELN(Output,'PreOrder Tree:');
PreOrder(Root);
WRITE(Output,'Do you wish to add another number?');
READLN(Input,Choice);
UNTIL Choice IN ['N','n'];
END;{Loop}

BEGIN
Initialize;
Loop;
END.

Program Max1 Max2 Code !!!

Program Max1_Max2;

Uses Wincrt;
Var
x: array[1..100] of integer;
i,n,max,sec: integer;
Begin
Write('Masukkan Jumlah Data: ');readln(n);
for i := 1 to n do
begin
x[i]:=random(18);
write(x[i],' ');
{readln(x[i]);}
end;
max:=x[1];
sec:=0;
for i := 1 to n do
begin
if (x[i]>max) then
begin
if (sec<max) then
sec:=max;
max:=x[i];
end;
if (max>x[i]) and (sec<x[i]) then sec:=x[i];
end;
writeln;
writeln('Max= ',max);

writeln('Second= ',sec);
End.

Program matrik

Program matrik;
uses wincrt;
type data = array[1..10,1..10] of integer;
var matrikI,matrikII : data;
baris,kolom,pil : integer;
procedure isimatrik;
var i,j : integer;
begin
writeln('Penentuan ORDO MATRIK I');
write('Masukan banyak baris matrik I = ');readln(baris);
write('Masukan banyak kolom matrik I = ');readln(kolom);
for i:=1 to baris do
for j:=1 to kolom do
begin
gotoxy(j*10,i*5);
readln(matrikI[i,j]);
end;
clrscr;
writeln('Penentuan ORDO MATRIK II');
write('Masukan banyak baris matrik II = ');readln(baris);
write('Masukan banyak kolom matrik II = ');readln(kolom);
for i:=1 to baris do
for j:=1 to kolom do
begin
gotoxy(j*10,i*5);
readln(matrikII[i,j]);
end;
end;

procedure jumlahmatrik(m1,m2 : data);
var hasil : data;
i,j : integer;
begin
for i:=1 to baris do
for j:=1 to kolom do
begin
hasil[i,j]:=m1[i,j]+m2[i,j];
end;
clrscr;
writeln('Hasil Penjumlahan MATRIK');
for i:=1 to baris do
for j:=1 to kolom do
begin
gotoxy(j*10,i*5);
write(hasil[i,j]);
end;
end;
procedure kurangmatrik(m1,m2 : data);
var hasil : data;
i,j : integer;
begin
for i:=1 to baris do
for j:=1 to kolom do
begin
hasil[i,j]:=m1[i,j]-m2[i,j];
end;
clrscr;
writeln('Hasil Penjumlahan MATRIK');
for i:=1 to baris do
for j:=1 to kolom do
begin
gotoxy(j*10,i*5);
write(hasil[i,j]);
end;
end;
procedure kalimatrik(m1,m2 : data);
var hasil : data;
i,j,z : integer;
begin
for i:=1 to baris do
for j:=1 to kolom do
begin
hasil[i,j]:=0;
for z:=1 to baris do
hasil[i,j]:=hasil[i,j]+m1[i,z]*m2[z,j];
end;
clrscr;
writeln('Hasil Penjumlahan MATRIK');
for i:=1 to baris do
for j:=1 to kolom do
begin
gotoxy(j*10,i*5);
write(hasil[i,j]);
end;
end;

begin
writeln(' M E N U');
writeln('(1) Penjumlahan Matrik');
writeln('(2) Pengurangan Matrik');
writeln('(3) Perkalian Matrik');
write('Pilihan = ');readln(pil);
clrscr;
case pil of
1 : begin
isimatrik;
jumlahmatrik(matrikI,matrikII);
end;
2 : begin
isimatrik;
kurangmatrik(matrikI,matrikII);
end;
3 : begin
isimatrik;
kalimatrik(matrikI,matrikII);
end;
end;
end.

Program Menyusun Kali Matrik Code !!!

Program Menyusun_Kali_Matrik;

Uses Wincrt;
Var i,j,n:integer;
Begin
Write('Masukkan Jumlah Perkalian: ');Readln(n);
Write('*':5);
For i:= 1 to n do
Write(i:5);
Writeln;
For i:= 1 to n do
Begin
Write(i:5);
For j:= 1 to n do
write(i*j:5);
Writeln;
End;
End.

Program Menghitung Suku

Program Menghitung_Suku;
Uses Wincrt;
Var tot,suku:real;
i:integer;
Begin
tot:=0;
suku:=2;
While tot <= 3.9999 Do
Begin
tot:=tot+suku;
i:=i+1;
suku:=suku/2;
End;
writeln(i);
End.

Contoh Script Program Acckerman

Program Acckerman;
Uses Wincrt;
Function ACC(m,n:integer):integer;
Begin
if m=0 then
begin
ACC:=n+1;
Write(n+1,' ');
end
else if n=0 then
begin
ACC:=ACC(m-1,1);
Writeln(ACC(m-1,1),' ');
end
else
begin
ACC:=ACC(m-1,ACC(m,n-1));
Writeln(ACC(m-1,ACC(m,n-1)),' ');
end;
End;
Begin
Writeln(ACC(2,1));
End.

Program Indeks Larik

Program Indeks_Larik;
Uses Wincrt;
Var
x : Array [1..100] of Integer;
i,n : Integer;
Ul : Char;
Procedure CekIndeks(m: integer);
Var t: Integer;
Begin
Writeln;
Write('Nomor Indeks > Total Nilai Larik Sebelumnya Adalah: ');
t:=0;
For i := 1 to m-1 do
Begin
t:=t+x[i];
if x[i+1]>t then
Write(i+1,' ');
End;
End;
Begin
Repeat
ClrScr;
Writeln('Program Menentukan Indeks Larik');
Writeln('===============================');
Writeln;
Write('Jumlah Data : ');Readln(n);
Writeln;
For i := 1 to n do
Begin
Write('Data Ke-',i,': ');Readln(x[i]);
End;
CekIndeks(n);
Writeln;Writeln;
Write('Mau Coba Lagi [Y/T]: ');Readln(Ul);
Until Upcase(Ul)<>'Y';
End.

Program Urut Pecahan

Program Urut_Pecahan;
Uses Wincrt;
Var pmb,pny : array [1..10] of integer;
i,j,n : integer;
Procedure Urut(x : integer);
Var t1,t2 : integer;
Begin
For i := 1 to x-1 do
For j := i+1 to x do
Begin
if ((pmb[i]/pny[i])>(pmb[j]/pny[j])) then
Begin
t1:=pmb[i];
t2:=pny[i];
pmb[i]:=pmb[j];
pny[i]:=pny[j];
pmb[j]:=t1;
pny[j]:=t2;
End;
End;
End;
Begin
Gotoxy(30,1);Write('Program Urut Pecahan');
Gotoxy(30,2);Write('====================');
Gotoxy(1,4);Write('Jumlah Data Pecahan: ');Readln(n);
For i := 1 to n do
Begin
Gotoxy(1,5+i);Write('Input Pecahan ke-',i,' : ');Readln(pmb[i]);
Gotoxy(24,5+i);Write('/ ');Readln(pny[i]);
End;
Urut(n);
Writeln;
Writeln('Hasilnya: ');
For i := 1 to n do
Writeln(pmb[i],'/',pny[i]);
End.

Contoh Program Tukar Nilai

Turbo Pascal Logo

Program Tukar Nilai

Program Tukar_Nilai;
Uses WinCrt;
Type Larik = Array [1..100] of Integer;
Var
A,B : Larik;
i,x,m : Byte;
Procedure Tukar;
Var T:Integer;
Begin
x:=0;
For i := 1 to m do
Begin
T:=A[i];
A[i]:=B[i];
B[i]:=T;
Gotoxy(15+x,6);Write(A[i]);
Gotoxy(15+x,7);Write(B[i]);
x:=x+2;
End;
End;
Procedure Input;
Var x:Byte;
Begin
Randomize;
x:=0;
For i := 1 to m do
Begin
A[i]:=Random(10);
B[i]:=Random(10);
Gotoxy(15+x,12);Write(A[i]);
Gotoxy(15+x,13);Write(B[i]);
x:=x+2;
End;
End;
Begin
Gotoxy(21,1);Write('Program Menukar Nilai Larik A & B');
Gotoxy(21,2);Write('=================================');
Gotoxy(1,4);Write('Jumlah Data : ');Readln(m);
Gotoxy(5,6);Write('Nilai A:');
Gotoxy(5,7);Write('Nilai B:');
Input;
Gotoxy(1,9);Write('Setelah Di Tukar');
Gotoxy(1,10);Write('================');
Gotoxy(5,12);Write('Nilai A:');

Gotoxy(5,13);Write('Nilai B:');
Tukar;
End.

Program Prosedur reference

Program Prosedur_reference;
Uses Wincrt;
Var a,b,c : Integer;
Procedure Coba(x,y:integer; var z:integer);
Begin
x:=x+1;
y:=y+1;
z:=x+y;
End;
Begin

a:=2;b:=3;c:=0;
Coba(a,b,c);
Writeln('a = ',a);
Writeln('b = ',b);
Writeln('c = ',c);
End.

Program Prosedur aktual

Program Prosedur_aktual;
Uses Wincrt;
Var Y:char;
m:byte;
Procedure Tampil(x:char;n:byte);
Var i:integer;
Begin
for i := 1 to n do
Write(x);
Writeln;
End;
Begin
Tampil('+',8);
Tampil('*',10);
Tampil('A',5);
Y:='B';
m:=11;
Tampil(Y,m);
End.