Arsip

Archive for Januari, 2010

Mencari waktu sholat

Januari 13, 2010 Tinggalkan komentar
  1. Mencari tahu nama waktu sholat

Pada tip yang unik ini anda akan dapat mengetahui nama-nama waktu sholat berdasarkan waktu tertentu, berikut ini contoh kodenya.

Function  NamaWktSholat( Jam : TDateTime ): String ;

var

iWkt, menit, detik, sdetk : Word ;

begin

decodeTime(Jam, iwkt, menit, detik, sdetk);

if ((iWkt>=1) And (Iwkt<=4)) then result:=’Shubuh’ else

if ((iWkt>=4) And (Iwkt<=5)) then result:=’Shubuh’ else

if ((iWkt>=6) And (Iwkt<=10)) then result:=’Dhuha’ else

if ((iWkt>=12) And (Iwkt<=13)) then result:=’Dzuhur’ else

if ((iWkt>=15) And (Iwkt<=16)) then result:=’Ashar’ else

if (iWkt=18) then result:=’Maghrib’ else

if ((iWkt>=19) And (Iwkt<=23)) then result:=’Isya’ else

if ((iWkt>=23) And (Iwkt<=24)) then result:=’Tahajud’ else

result:=’Bukan waktu sholat’;

end;

procedure TForm1.Button1Click(Sender: TObject);

begin

ShowMessage(‘Sekarang waktu sholat ‘+NamaWktSholat(Now));

end;

Gbr. Nama waktu sholat

Mencari teks

Januari 13, 2010 Tinggalkan komentar
  1. Mengecek suatu teks dari sebuah kalimat.

Berikut ini sedikit kode yang bisa saya sumbangkan untuk mencari teks dalam sebuah kalimat atau sebuah paragraph tanpa menggunakan komponen FindDialog.

Pertama-tama buatlah applikasi baru, ukuran, font dan yang lainnya terserah anda yang jelas form itu harus terdiri dari sebuah komponen Edit, Button dan Memo. Kira-kira form yang dibuat akan seperti ini.

Gbr. Form saat design time

Setelah itu masukan kode dibawah ini.

implementation

{$R *.dfm}

function CekTeks(s,  teks : String ): Boolean ;

var

i, ia : Integer ;

begin

result:=false;

for i:=1 to length(teks) do

begin

for ia:=1 to  length(teks) do

begin

if (Uppercase(copy(teks, i, ia)))=Uppercase(s) then

begin

result:=true;

break;

end;

end;

end;

end;

procedure TForm1.Button1Click(Sender: TObject);

begin

If Cekteks(Edit1.Text, Memo1.Text) then

ShowMessage(‘Kata “‘+edit1.Text+'” terdapat pada Memo1’) else

ShowMessage(‘Kata “‘+edit1.Text+'” tidak terdapat pada Memo1’);

end;

Pada program ini anda diminta untuk menuliskan kata pada komponen Edit1, kemudian apabila anda menekan button1 maka program kan mencari keberadaan teks Edit1 pada Memo1. Fungsi ini akan menghasilkan true apabila teks yang anda maksud ada pada Memo1 dan kebalikannya apabila tidak ada.

Teks yang anda input tidak terikat pada huruf besar atau kecil.

Gbr. Hasil pencarian kata nilai

Invert teks

Januari 13, 2010 Tinggalkan komentar

Tutorial berikut ini akan berguna apabila anda ingin membalikan huruf-huruf dari sebuah teks. Coba fungsi dibawah ini.

function  InvertTeks( Teks : String ): String ;

var

i : Integer ;

s : String ;

begin

for i:=Length(Teks) downTo 1 do

begin

s:=s+copy(teks, i, 1);

end;

result:=s;

end;

procedure TForm1.Button1Click(Sender: TObject);

begin

Form1.Caption:=InvertTeks(form1.Caption);

end;

Gbr. Caption form1 yang belum dan yang sudah diInvert

Conversi dari warna ke String

Januari 13, 2010 Tinggalkan komentar

Fungsi ini sangat berguna ketika anda sedang membuat halaman web yang didalamnya penuh dengan warna warni teks atau sedang membuat table web yang berwarna, dengan fungsi ini sebuah warna akan diubah nilainya menjadi format warna yang terbaca oleh web browser.

Dibawah ini adalah kode lengkapnya :

Function Tform1.ClrToString( vColor ) : String ;

begin

Result := IntToHex(GetRValue(v.Color),2) +

IntToHex(GetGValue(v.Color),2) +

IntToHex(GetBValue(vColor),2);

End;

Contoh penggunaan :

procedure TForm1.Button1Click(Sender: TObject);

begin

ShowMessage( ClrToString(Form1.color));

End;

Sebenarnya ada juga fungsi ColorToString yang sudah termasuk dalam program Delphi, namun tentu saja fungsi ini tidak akan terbaca pada web browser.

Untuk membandingkannya coba kode berikut ini :

procedure TForm1.Button1Click(Sender: TObject);

begin

showMessage(‘Warna System      : ‘ +ColorToString(Form1.Color)+#10+#13+

‘Warna untuk web : ‘ + ClrToString(Form1.Color);

End;

Gbr. Contoh perbandingan pengambilan string warna

Spirograph

Januari 12, 2010 1 komentar

Spirograph merupakan sebuah karya seni yang memerlukan tingkat ketelitian yang tinggi dalam menggambarnya ( khususnya apabila digambar manual ). Apabila anda ingat masa sekolah SD dulu banyak tukang mainan yang menjual penggaris dengan tiga atau empat lubang besar, kemudian untuk menggambarkannya anda harus memutarkan salah satu roda gigi yang sudah tersedia didalamnya.

Yach itulah sepintas tentang spirograph. Kini Anda pun dapat mencoba membuat kodenya , Berikut ini adalah kode untuk membuat spirograph :

Procedure TForm1.Spirograph( O_Besar, O_Kecil, TitikSpiro, Putaran : integer );

var

centerSm , centerBig : Tpoint;

Bhand : integer ;

sudut, derajat, DerPerMove : real;

KelKecil, KelBesar : Real ;

i, titikX, TitikY : integer ;

putar : Integer ;

begin

// buat perhitungan awal

kelBesar:=O_Besar*pi;

kelKecil:=O_Kecil*pi;

sudut:=( 360 / kelBesar )*kelKecil;

derajat:=sudut / 360 ;

centerBig.X:=O_Besar div 2;

centerBig.Y:=O_besar div 2;

BHand:=(O_besar div 2)-(O_Kecil div 2);

DerPerMove:=0;

putar:=360 * putaran;

Image1.Picture.Bitmap.Width:=O_Besar;

Image1.Picture.Bitmap.Height:=O_besar;

// Proses gambar

with Image1.Picture.Bitmap.Canvas DO

Begin

MoveTo(CenterBig.X, centerBig.y-(Bhand+titikSpiro));

for i:=0 to putar do

begin

// tentukan titik pusat lingkaran kecil

CenterSm.X:=Trunc(centerBig.X+Bhand* cos(((i*derajat)-90)*pi /180));

centerSm.Y:=trunc(Centerbig.Y+Bhand* Sin(((i*derajat)-90)*pi / 180));

// tentukan titik gambar

titikX:=Trunc(CenterSM.X+titikSpiro* cos(((360-i) – 90)*pi / 180));

TitikY:=Trunc(centerSm.Y+TitikSpiro* Sin(((360-i )- 90)*pi / 180));

lineto(titikX, Titiky);

moveto(Titikx, Titiky);

DerPermove:=DerPerMove+derajat;

If (DerPermove>=360) then DerPermove:=derpermove-360 else      derpermove:=derPerMove;

end;

end;

end;

Gbr. Spirograph

Contoh penggunaan kode.

procedure TForm1.Button1Click(Sender: TObject);

begin

Spirograph(300, 80, 40, 30);

end;

Keterangan :

300 adalah nilai diameter besar

80 adalah Nilai diameter kecil

40 adalah Nilai titik spiro ( Jarak antara titik pusat lingkaran kecil ke titik spiro)

30 adalah jumlah putaran diameter kecil untuk mengelilingi diameter besar.

Diusahakan agar nilai titik spiro tidak lebih besar dari nilai jari-jari lingkaran kecil,

Kategori:Graphics Tag:

MATRIX

Januari 12, 2010 1 komentar

Siapa yang tak kenal dengan film Matrix, dengan effect tampilan angka yang menakjubkan membuat penonton betah dibuatnya.

Yup, disini saya akan coba untuk menerapkan efek matrix tersebut kedalam gambar tentunya pake sedikit koding Delphi.

procedure MatrixEffect( vFont : TFont; Green : Boolean  );

var

FntH, FntWid : integer ;

w, h : Integer ;

fntColor : TColor ;

warna : LongInt ;

Rgbgreen, r, g, b : byte ;

ImgTemp : TImage ;

I : integer ;

begin

FntH:=Trunc(vFont.Size * 1.8) ;

FntWid:=Trunc(vFont.Size * 1.2);

try

Screen.Cursor:=crHourglass;

ImgTemp:=timage.Create(self);

with Imgtemp.Picture.Bitmap do

begin

Height:=image1.Picture.Bitmap.Height;

Width:=image1.Picture.Bitmap.Width;

Canvas.Brush.Color:=clBlack;

canvas.FillRect(imgtemp.Canvas.ClipRect);

end;

with Image1.Picture.Bitmap do

begin

for w:=0 to ( width div FntWid )do

begin

for h:=0 to (Height div FntH ) do

begin

warna:=ColorToRgb(canvas.Pixels[(w*FntWid), (h*FntH)]);

r:=getRValue(warna);

g:=getGValue(warna);

b:=getBValue(warna);

RgbGreen:=( r + g  + b  ) div 3;

if green then FntColor:=Rgb(0,RgbGreen,0) else

FntColor:=Rgb(r, g, b);

with ImgTemp.Picture.Bitmap.Canvas do

begin

i:=Random(9);

Brush.Color := clBlack;

Font.Name := vFont.Name;

Font.Style := [];

Font.Color := FntColor;

Font.Size := vFont.Size;

TextOut((w*FntWid), (h*FntH), IntToStr(i));

end;

end;

end;

end;

finally

image1.Picture:=ImgTemp.Picture;

ImgTemp.Free;

Screen.Cursor:=crDefault;

end;

end;

Kategori:Graphics Tag:

Noise

Januari 12, 2010 Tinggalkan komentar

Untuk membuat gambar menjadi seperti gambar semut ( pada televisi jaman dulu ) sangatlah mudah, kita hanya tinggal mengganti sedikit koding pada baris-baris terakhir dari procedure-procedure yang sudah ada. Contoh kode yang diganti  adalah seperti kode dibawah ini :

(lihat coding untuk grayscale di blog ini)

Canvas.Pixels[w,h]:=RGB( R, G, B );

Menjadi

Canvas.Pixels[ Random(w) , Random (h) ]:=RGB( R, G, B );

Dengan menambahkan fungsi Random ini maka program akan menyimpan secara acak pixel baru pada canvas.