Rabu, 19 Desember 2012

Contoh Jam Sederhana dari Borland Delphi 7

Semoga dilihat orang hahahahahaha.........

Ane nyobak nulis hasil ilmu pemograman yang ane dapet.... hasilnya lucu lihat nie gambarnya...


 Caranya gini dah pada punya Borland Delphi 7 kan yah udah sediain... :
- cumak Timer1 doang kok....

perti gambar ini :



trus kamu tinggal masuk ke menu code ..... ya pada form klick 2 kali langsung masuk...
lihat gambarnya :



trus blok semua codenya dan hapus lalu tinggal ganti dengan ini, scipt dibawah ini :

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ExtCtrls;
const
RadiusJam = 250;
RadiusMenit = 350;
RadiusDetik = 400;
type
  TForm1 = class(TForm)
    Timer1: TTimer;
    procedure FormCreate(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);
    procedure FormShow(Sender: TObject);
    procedure FormPaint(Sender: TObject);
    procedure FormResize(Sender: TObject);
   
  private
   Jam : word;
   Menit : word;
   Detik : word;
    Procedure AppActive(Sender: TObject);

    procedure GambarJarumJam (i,j : word);
    procedure GambarJarumMenit (i : word);
    procedure GambarJarumDetik (i : word);

    procedure GambarJam (pertama : boolean);
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.FormCreate(Sender: TObject);
begin
 Jam := 0;
 Menit := 0;
 Detik := 0;
 Application.OnActivate := AppActive;
end;

procedure TForm1.Timer1Timer(Sender: TObject);
begin
GambarJam(false);
end;

procedure TForm1.AppActive(sender:Tobject);
begin
Invalidate;
end;
procedure TForm1.GambarJarumJam(i,j :word);
var
buffer : real;
begin
//memilih pen yang sesuai
Canvas.Pen.Color := clFuchsia;
Canvas.Pen.Width := 20;
//menghitung lokasi ujung jarum
buffer := Pi * (i / 6 + j / 360);
//menggambar jarum
Canvas.MoveTo(0,0);
Canvas.LineTo(
  round(RadiusJam * sin (buffer)),
  round(RadiusJam * cos (buffer)));
end;
procedure TForm1.GambarJarumMenit(i:word);
var
buffer : real;
begin
//memilih pen yang sesuai
Canvas.Pen.Color := clLime;
Canvas.Pen.Width := 10;
//menghitung lokasi ujung jarum
buffer := Pi * i / 30;
//menggambar jarum
Canvas.MoveTo(0,0);
Canvas.LineTo(
  round(RadiusMenit * sin (buffer)),
  round(RadiusMenit * cos (buffer)));
  end;

procedure TForm1.GambarJarumDetik(i:word);
var
buffer : real;
begin
//memilih pen yang sesuai
Canvas.Pen.Color := clWhite;
Canvas.Pen.Width := 1;
//menghitung lokasi ujung jarum
buffer := Pi * i / 30;
//menggambar jarum
Canvas.MoveTo(0,0);
Canvas.LineTo(
  round(RadiusDetik * sin (buffer)),
  round(RadiusDetik * cos (buffer)));
end;
procedure TForm1.GambarJam(pertama:boolean);
var
jamX,
MenitX,
DetikX,
MiliDetikX  : Word;
rect        : TRect;
dc          : HDC;
begin
  //mengambil jam sistem
  DecodeTime(Now, JamX, MenitX, DetikX, MiliDetikX);
  //menggambar jarum detik
  if (Detik<>DetikX) or Pertama then
  begin
    //memilih mode pemetaan yang sesuai
    rect := GetClientRect;
    dc   := Canvas.Handle;

    SetMapMode(dc, MM_ISOTROPIC);

    SetViewportOrgEx(
      dc, rect.Right div 2, rect.Bottom div 2, nil );
    SetWindowExtEx(dc, 1000, -1000, nil);
    SetViewportExtEx(
      dc, rect.Right, rect.Bottom, nil);

    Canvas.Pen.Mode := pmXor;

    if (not pertama) then
    GambarJarumDetik(Detik);
    GambarJarumDetik(DetikX);
    Detik :=DetikX;
  end;
  if (Menit<>MenitX) or Pertama then
  begin
    //menggambar jarum menit
    if (not Pertama) then
    GambarJarumMenit(Menit);
    GambarJarumMenit(MenitX);

    //menggambar jarum jam
    if (not Pertama) then
    GambarJarumJam(Jam, Menit);
    GambarJarumJam(JamX, MenitX);
    Menit := MenitX;
    Jam   := JamX;
  end;
end;

procedure TForm1.FormShow(Sender: TObject);
begin
Timer1.Enabled := true;
Timer1.Interval := 100;
end;

procedure TForm1.FormPaint(Sender: TObject);
begin
  //menggambar bingkai jam
  Canvas.Pen.Color    := clBlack;
  Canvas.Pen.Width    := 1;
  Canvas.Pen.Mode     := pmCopy;
  Canvas.Brush.Color  := clWhite;
  Canvas.Brush.Style  := bsSolid;
  Canvas.Ellipse(0, 0, ClientWidth, ClientHeight);

  //menggambar jarum jam
  GambarJam(true);
end;

procedure TForm1.FormResize(Sender: TObject);
begin
Refresh;
end;

end.



ok2... selamat2.....
jika copy pase erorr... edit manual aja pada menu codenya.....





Tidak ada komentar:

Posting Komentar