21 May 2007

MEMBUAT PROGRAM SUARA PADA BUTTON

Semoga berhasil... Jika ada masalah kirim email ke : putu_dalungcity@yahoo.co.id
Nama : Abryan Tata Pangarsa
Web : abryantp.blogspot.com
Sourcecode [ Membuat program suara pada button ] :
unit Abryan;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls, MMSystem;
type
TForm1 = class(TForm)
Button1: TButton;
procedure FormCreate(Sender: TObject);
private
{ Private declarations }
procedure WndProc(var Message : TMessage); override;
public
{ Public declarations }
end;
var
Form1: TForm1;
FSoundFile : String;
implementation
{$R *.DFM}
procedure TForm1.WndProc(var Message : TMessage);
begin
if Message.LParam = Longint(Button1) then
begin
if (Message.Msg = CM_MOUSELEAVE) then
sndPlaySound(nil, snd_Async or snd_NoDefault);
if (Message.Msg = CM_MOUSEENTER) then
sndPlaySound(pchar(FSoundFile), snd_Async or snd_NoDefault);
end;
inherited WndProc(Message);
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
FSoundFile := 'C:\Windows\Media\windows xp startup.wav';
end;
end.

MEMBUAT PROGRAM FORM TIAP 1 DETIK SEMAKIN BESAR

Semoga berhasil... Jika ada masalah kirim email ke : putu_dalungcity@yahoo.co.id
Nama : Abryan Tata Pangarsa
Web : abryantp.blogspot.com
Pada komponen timer, pada properties :
Timer1 Interval = 1000
Timer2 Interval = 2000
Timer3 Interval = 3000
Timer4 Interval = 4000
Timer5 Interval = 5000
Timer6 Interval = 6000
Sourcecode [ Membuat program form 1 detik semakin besar ] :
unit Abryan;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, ExtCtrls;
type
TForm1 = class(TForm)
Timer1: TTimer;
Timer2: TTimer;
Timer3: TTimer;
Timer4: TTimer;
Timer5: TTimer;
Timer6: TTimer;
procedure Timer1Timer(Sender: TObject);
procedure Timer2Timer(Sender: TObject);
procedure Timer3Timer(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure Timer4Timer(Sender: TObject);
procedure Timer5Timer(Sender: TObject);
procedure Timer6Timer(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
procedure TForm1.FormCreate(Sender: TObject);
begin
form1.Color:=clWhite;
form1.Width:=100;
form1.Height:=100;
end;
procedure TForm1.Timer1Timer(Sender: TObject);
begin
form1.Color:=clRed;
form1.Height:= 200;
form1.Width:= 200;
end;
procedure TForm1.Timer2Timer(Sender: TObject);
begin
form1.Color:=clYellow;
timer1.Enabled:=false;
form1.Height:= 300;
form1.Width:= 300;
end;
procedure TForm1.Timer3Timer(Sender: TObject);
begin
form1.Color:=clGreen;
timer1.Enabled:=false;
timer2.Enabled:=false;
form1.Height:= 400;
form1.Width:= 400;
end;
procedure TForm1.Timer4Timer(Sender: TObject);
begin
form1.Color:=clFuchsia;
timer1.Enabled:=false;
timer2.Enabled:=false;
timer3.Enabled:=false;
form1.Height:= 500;
form1.Width:= 500;
end;
procedure TForm1.Timer5Timer(Sender: TObject);
begin
form1.Color:=clBlue;
timer1.Enabled:=false;
timer2.Enabled:=false;
timer3.Enabled:=false;
timer4.Enabled:=false;
form1.Height:= 600;
form1.Width:= 600;
end;
procedure TForm1.Timer6Timer(Sender: TObject);
begin
form1.Close;
end;
end.

MEMBUAT PROGRAM MENEMUKAN FORM

Semoga berhasil... Jika ada masalah kirim email ke : putu_dalungcity@yahoo.co.id
Nama : Abryan Tata Pangarsa
Web : abryantp.blogspot.com
Buat 2 Form
Sourcecode [ Membuat program menemukan form ] :
Untuk Form1 :
unit Abryan;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, ComCtrls, XPMan;
type
TForm1 = class(TForm)
ProgressBar1: TProgressBar;
Button1: TButton;
XPManifest1: TXPManifest;
procedure FormCreate(Sender: TObject);
procedure Button1Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
uses uAbryan;
{$R *.dfm}
procedure TForm1.FormCreate(Sender: TObject);
begin
form1.Caption:='Pencarian form';
button1.Caption:='Cari form';
form1.Position:=poDesktopCenter;
form1.BorderStyle:= bsDialog;
end;
procedure TForm1.Button1Click(Sender: TObject);
var baris,nilai:integer;
begin
baris:=150000;
ProgressBar1.Max:=baris;
ProgressBar1.Min:=0;
for nilai:= 1 to baris do
ProgressBar1.Position:= nilai;
form2.ShowModal;
end;
end.
Untuk Form2 :
unit uAbryan;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, XPMan;
type
TForm2 = class(TForm)
Button1: TButton;
XPManifest1: TXPManifest;
procedure FormCreate(Sender: TObject);
procedure Button1Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form2: TForm2;
implementation
{$R *.dfm}
procedure TForm2.FormCreate(Sender: TObject);
begin
form2.Width:= 300;
form2.Height:= 300;
form2.Position:=poDesktopCenter;
button1.Caption:='close';
form2.Caption:='Form lain sudah ditemukan';
end;
procedure TForm2.Button1Click(Sender: TObject);
begin
close;
end;
end.

MEMBUAT PROGRAM CEK WAKTU WINDOWS

Semoga berhasil... Jika ada masalah kirim email ke : putu_dalungcity@yahoo.co.id
Nama : Abryan Tata Pangarsa
Web : abryantp.blogspot.com
Sourcecode [ Membuat program cek waktu windows ] :
unit Abryan;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, XPMan;
type
TForm1 = class(TForm)
Label1: TLabel;
Label2: TLabel;
XPManifest1: TXPManifest;
Button1: TButton;
procedure Button1Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
function UpTime: string;
const
ticksperday : integer = 1000 * 60 * 60 * 24;
ticksperhour : integer = 1000 * 60 * 60;
ticksperminute : integer = 1000 * 60;
tickspersecond : integer = 1000;
var
t : longword;
d, h, m, s : integer;
begin
t := GetTickCount;
d := t div ticksperday;
dec(t, d * ticksperday);
h := t div ticksperhour;
dec(t, h * ticksperhour);
m := t div ticksperminute;
dec(t, m * ticksperminute);
s := t div tickspersecond;
Result := 'Uptime: '+IntToStr(d)+ ' Hari '+IntToStr(h)+ ' Jam '+IntToStr(m)+' Menit '+IntToStr(s)+' Detik';
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
Label1.Caption:=UpTime;
end;
end.

MEMBUAT PROGRAM OPEN FILE GAMBAR

Semoga berhasil... Jika ada masalah kirim email ke : putu_dalungcity@yahoo.co.id
Nama : Abryan Tata Pangarsa
Web : abryantp.blogspot.com
Sourcecode [ Membuat program open file gambar ] :
unit Abryan;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, Grids, StdCtrls, ExtCtrls, ExtDlgs, Menus;
type
TForm1 = class(TForm)
MainMenu1: TMainMenu;
File1: TMenuItem;
Open1: TMenuItem;
Stretch1: TMenuItem;
N1: TMenuItem;
Exit1: TMenuItem;
OpenPictureDialog1: TOpenPictureDialog;
Image1: TImage;
procedure Exit1Click(Sender: TObject);
procedure Open1Click(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure Stretch1Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
bentang : Boolean ;
implementation
{$R *.dfm}
procedure TForm1.Exit1Click(Sender: TObject);
begin
Application.Terminate ;
end;
procedure TForm1.Open1Click(Sender: TObject);
begin
if (OpenPictureDialog1.Execute = True) then
begin
Image1.Picture.LoadFromFile(OpenPictureDialog1.FileName );
HorzScrollBar.Range := Image1.Width ;
VertScrollBar.Range := Image1.Height ;
end;
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
bentang := False ;
end;
procedure TForm1.Stretch1Click(Sender: TObject);
begin
bentang := not bentang ;
if bentang then
begin
Stretch1.Checked := True;
HorzScrollBar.Range := 0 ;
VertScrollBar.Range := 0;
end
else
begin
Stretch1.Checked := False;
HorzScrollBar.Range := Image1.Width ;
VertScrollBar.Range := Image1.Height ;
end;
Image1.Stretch := bentang ;
end;
end.

MEMBUAT PROGRAM FONT

Semoga berhasil... Jika ada masalah kirim email ke : putu_dalungcity@yahoo.co.id
Nama : Abryan Tata Pangarsa
Web : abryantp.blogspot.com
Membuat color :
Pada Tab Additional pilih ColorBox
Membuat pilihan ukuran :
Klik ComboBox, pada properties Double klik Items :
Masukan angka :
8
10
12
14
18
24
Membuat Pilihan Style :
Klik ComboBox, pada properties Double klik Items :
Masukan huruf :
Regular
Bold
Italic
Underline
Strikeout
Sourcecode [ Membuat program font ] :
unit Abryan;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, XPMan, ExtCtrls, jpeg, ActnMan, ActnColorMaps;
type
TForm1 = class(TForm)
ComboBox2: TComboBox;
ComboBox3: TComboBox;
XPManifest1: TXPManifest;
Label1: TLabel;
Label2: TLabel;
Label4: TLabel;
Label3: TLabel;
ColorBox1: TColorBox;
procedure ComboBox2Change(Sender: TObject);
procedure ComboBox3Change(Sender: TObject);
procedure ComboBox4Change(Sender: TObject);
procedure ColorBox1Change(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
procedure TForm1.ComboBox2Change(Sender: TObject);
begin
case ComboBox2.ItemIndex of
0:label3.Font.Size :=8;
1:label3.Font.Size :=10;
2:label3.Font.Size :=12;
3:label3.Font.Size :=14;
4:label3.Font.Size :=18;
5:label3.Font.Size :=24;
end;
end;
procedure TForm1.ComboBox3Change(Sender: TObject);
begin
case ComboBox3.ItemIndex of
0:label3.Font.Style :=[];
1:label3.Font.Style :=[fsbold];
2:label3.Font.Style :=[fsitalic];
3:label3.Font.Style :=[fsunderline];
4:label3.Font.Style :=[fsstrikeout];
end;
end;
procedure TForm1.ComboBox4Change(Sender: TObject);
begin
label3.Font.Name;
end;
procedure TForm1.ColorBox1Change(Sender: TObject);
begin
label3.Font.Color :=ColorBox1.Selected ;
end;
end.

MEMBUAT PROGRAM GAMES

Semoga berhasil... Jika ada masalah kirim email ke : putu_dalungcity@yahoo.co.id
Nama : Abryan Tata Pangarsa
Web : abryantp.blogspot.com
Pada Button1, properties pada Visible True
Pada Button 2 sampai 13, properties pada Visible False
Sourcecode [ Membuat program games ] :
unit Abryan;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, Buttons, ExtCtrls;
type
TForm1 = class(TForm)
Button1: TButton;
Button2: TButton;
Button3: TButton;
Button4: TButton;
Button5: TButton;
Button6: TButton;
Button7: TButton;
Button8: TButton;
Button9: TButton;
Button10: TButton;
Button11: TButton;
Button12: TButton;
Button13: TButton;
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
procedure Button3Click(Sender: TObject);
procedure Button4Click(Sender: TObject);
procedure Button5Click(Sender: TObject);
procedure Button6Click(Sender: TObject);
procedure Button7Click(Sender: TObject);
procedure Button8Click(Sender: TObject);
procedure Button9Click(Sender: TObject);
procedure Button10Click(Sender: TObject);
procedure Button11Click(Sender: TObject);
procedure Button12Click(Sender: TObject);
procedure Button13Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
procedure TForm1.Button1Click(Sender: TObject);
begin
Button1.Visible:=false;
Button2.Visible:=true;
Form1.Color:= clBlack;
end;
procedure TForm1.Button2Click(Sender: TObject);
begin
Button2.Visible:=false;
Button3.Visible:=true;
Form1.Color:= clRed;
end;
procedure TForm1.Button3Click(Sender: TObject);
begin
Button3.Visible:=false;
Button4.Visible:=true;
Form1.Color:= clAqua
end;
procedure TForm1.Button4Click(Sender: TObject);
begin
Button4.Visible:=false;
Button5.Visible:=true;
Form1.Color:= clGreen;
end;
procedure TForm1.Button5Click(Sender: TObject);
begin
Button5.Visible:=false;
Button6.Visible:=true;
Form1.Color:= clWhite;
end;
procedure TForm1.Button6Click(Sender: TObject);
begin
Button6.Visible:=false;
Button7.Visible:=true;
Form1.Color:= clLime;
end;
procedure TForm1.Button7Click(Sender: TObject);
begin
Button7.Visible:=false;
Button8.Visible:=true;
Form1.Color:= clFuchsia;
end;
procedure TForm1.Button8Click(Sender: TObject);
begin
Button8.Visible:=false;
Button9.Visible:=true;
Form1.Color:= clBlue;
end;
procedure TForm1.Button9Click(Sender: TObject);
begin
Button9.Visible:=false;
Button10.Visible:=true;
Form1.Color:= clYellow;
end;
procedure TForm1.Button10Click(Sender: TObject);
begin
Button10.Visible:=false;
Button11.Visible:=true;
Form1.Color:= clSkyBlue;
end;
procedure TForm1.Button11Click(Sender: TObject);
begin
Button11.Visible:=false;
Button12.Visible:=true;
Form1.Color:= clSilver;
end;
procedure TForm1.Button12Click(Sender: TObject);
begin
Button12.Visible:=false;
Button13.Visible:=true;
Form1.Color:= clPurple;
end;
procedure TForm1.Button13Click(Sender: TObject);
begin
Button13.Visible:=false;
Application.MessageBox('Thankz Bro...!!!','Pesan');
Close;
end;
end.

MEMBUAT PROGRAM SHORTCUT

Semoga berhasil... Jika ada masalah kirim email ke : putu_dalungcity@yahoo.co.id
Nama : Abryan Tata Pangarsa
Web : abryantp.blogspot.com
Sourcecode [ Membuat program shortcut ] :
Unit Abryan;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs,shellapi, ExtCtrls, StdCtrls, Menus;
type
TForm1 = class(TForm)
RadioGroup1: TRadioGroup;
Label1: TLabel;
PopupMenu1: TPopupMenu;
Minimize1: TMenuItem;
Exit1: TMenuItem;
N1: TMenuItem;
procedure RadioGroup1Click(Sender: TObject);
procedure Minimize1Click(Sender: TObject);
procedure Exit1Click(Sender: TObject);
procedure FormCreate(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
uses Unit2;
{$R *.dfm}
procedure TForm1.RadioGroup1Click(Sender: TObject);
begin
if RadioGroup1.ItemIndex =0 then
begin
ShellExecute(Handle,'open',pchar('notepad'),nil,nil, SW_SHOWMAXIMIZED);
end
else
if RadioGroup1.ItemIndex =1 then
begin
ShellExecute(Handle,'open',pchar('explorer'),nil,nil, SW_SHOWMAXIMIZED);
end
else
if RadioGroup1.ItemIndex = 2 then
begin
ShellExecute(Handle,'open',pchar('control'),nil,nil, SW_SHOWMAXIMIZED);
end
else
if RadioGroup1.ItemIndex = 3 then
begin
ShellExecute(Handle,'open',pchar('regedit'),nil,nil, SW_SHOWMAXIMIZED);
end
else
if RadioGroup1.ItemIndex = 4 then
begin
ShellExecute(Handle,'open',pchar('dxdiag'),nil,nil, SW_SHOW);
end
else
if RadioGroup1.ItemIndex = 5 then
begin
ShellExecute(Handle,'open',pchar('gpedit.msc'),nil,nil, SW_SHOW);
end
else
if RadioGroup1.ItemIndex = 6 then
begin
ShellExecute(Handle,'open',pchar('msconfig'),nil,nil, SW_SHOW);
end
else
if RadioGroup1.ItemIndex = 7 then
begin
ShellExecute(Handle,'open',pchar('taskmgr'),nil,nil, SW_SHOW);
end ;
end;
procedure TForm1.Minimize1Click(Sender: TObject);
begin
Application.Minimize;
end;
procedure TForm1.Exit1Click(Sender: TObject);
begin
Application.Terminate;
end;
end.

MEMBUAT PROGRAM MENGHITUNG NILAI

Semoga berhasil... Jika ada masalah kirim email ke : putu_dalungcity@yahoo.co.id
Nama : Abryan Tata Pangarsa
Web : abryantp.blogspot.com
Sourcecode [ Membuat program menghitung nilai ] :
unit Abryan;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, ExtCtrls, StdCtrls, Buttons, jpeg, ComCtrls, ActnList;

type
TForm1 = class(TForm)
Image1: TImage;
Label1: TLabel;
Label2: TLabel;
Label3: TLabel;
Label4: TLabel;
Label5: TLabel;
Edit1: TEdit;
Edit2: TEdit;
Edit3: TEdit;
Edit4: TEdit;
ComboBox1: TComboBox;
Memo1: TMemo;
BitBtn2: TBitBtn;
BitBtn3: TBitBtn;
Label6: TLabel;
BitBtn1: TBitBtn;
procedure BitBtn3Click(Sender: TObject);
procedure BitBtn2Click(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure BitBtn1Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
procedure TForm1.BitBtn3Click(Sender: TObject);
var angka:integer;
nilai:string;
begin
Angka:=StrToInt(EDIT4.Text );
if angka>=85 then
begin
nilai:='A';
end
else
if angka>=75 then
begin
nilai:='B';
end
else
if angka>=65 then
begin
nilai:='C';
end
else
if angka>=55 then
begin
nilai:='D';
end
else
begin
nilai:='E';
end;
memo1.Color :=clgradientinactivecaption;
MEMO1.Lines .Clear ;
MEMO1.Lines .ADD('') ;
MEMO1.Lines .ADD(' STMIK STIKOM BALI') ;
MEMO1.Lines .ADD(' Jln.Teuku Umar 222 Dps') ;
MEMO1.Lines .ADD(' ---------------------------------------------------------------------') ;
MEMO1.Lines .ADD('') ;
MEMO1.Lines .ADD(' NIM : '+EDIT1.Text ) ;
MEMO1.Lines .ADD(' Nama : '+EDIT2.Text ) ;
MEMO1.Lines .ADD(' Jurusan : '+combobox1.text ) ;
MEMO1.Lines .ADD(' Mata Kuliah : '+EDIT3.Text ) ;
MEMO1.Lines .ADD(' Nilai Angka : '+EDIT4.Text );
MEMO1.Lines .ADD(' Nilai Huruf : '+String (nilai));
MEMO1.Lines .ADD('') ;
memo1.Lines .add(' Software by Abryan');
end;
procedure TForm1.BitBtn2Click(Sender: TObject);
begin
Edit1.Clear;
Edit2.Clear;
Edit3.Clear;
Edit4.Clear;
memo1.Clear ;
memo1.Color :=clwindow;
memo1.Lines .add(' Tugas1 Pemograman Visual 1');
memo1.Lines .add(' Software by Abryan');
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
memo1.Clear ;
memo1.Lines .add(' Tugas1 Pemograman Visual 1');
memo1.Lines .add(' Software by Abryan');
end;
procedure TForm1.BitBtn1Click(Sender: TObject);
begin
close;
end;
end.

MEMBUAT PROGRAM NOTEPAD

Semoga berhasil... Jika ada masalah kirim email ke : putu_dalungcity@yahoo.co.id
Nama : Abryan Tata Pangarsa
Web : abryantp.blogspot.com
Sourcecode [ Membuat program notepad ] :
unit Abryan;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, Buttons, Menus, ExtCtrls, ComCtrls, XPMan;
type
TForm1 = class(TForm)
Memo1: TMemo;
OpenDialog1: TOpenDialog;
SaveDialog1: TSaveDialog;
MainMenu1: TMainMenu;
File1: TMenuItem;
Open1: TMenuItem;
Save1: TMenuItem;
Exit1: TMenuItem;
Edit1: TMenuItem;
Paste1: TMenuItem;
Copy1: TMenuItem;
Cut1: TMenuItem;
N4: TMenuItem;
N1: TMenuItem;
Clearall1: TMenuItem;
Font1: TMenuItem;
New1: TMenuItem;
Delete1: TMenuItem;
N2: TMenuItem;
Undo1: TMenuItem;
N3: TMenuItem;
XPManifest1: TXPManifest;
Font2: TMenuItem;
FontDialog1: TFontDialog;
View1: TMenuItem;
FullScreen1: TMenuItem;
NormalScreen1: TMenuItem;
N5: TMenuItem;
Minimize1: TMenuItem;
DateTime1: TMenuItem;
DateTimePicker1: TDateTimePicker;
Timer1: TTimer;
N6: TMenuItem;
procedure Save1Click(Sender: TObject);
procedure Open1Click(Sender: TObject);
procedure Exit1Click(Sender: TObject);
procedure Cut1Click(Sender: TObject);
procedure Copy1Click(Sender: TObject);
procedure Paste1Click(Sender: TObject);
procedure Clearall1Click(Sender: TObject);
procedure New1Click(Sender: TObject);
procedure Delete1Click(Sender: TObject);
procedure Undo1Click(Sender: TObject);
procedure Font2Click(Sender: TObject);
procedure FullScreen1Click(Sender: TObject);
procedure NormalScreen1Click(Sender: TObject);
procedure Minimize1Click(Sender: TObject);
procedure DateTime1Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
procedure TForm1.Save1Click(Sender: TObject);
begin
if SaveDialog1.Execute then
Memo1.Lines.SaveToFile(SaveDialog1.FileName);
end;
procedure TForm1.Open1Click(Sender: TObject);
begin
if OpenDialog1.Execute then
Memo1.Lines.LoadFromFile(OpenDialog1.FileName );
end;
procedure TForm1.Exit1Click(Sender: TObject);
begin
Application.Terminate ;
end;
procedure TForm1.Cut1Click(Sender: TObject);
begin
Memo1.CutToClipboard ;
end;
procedure TForm1.Copy1Click(Sender: TObject);
begin
Memo1.CopyToClipboard;
end;
procedure TForm1.Paste1Click(Sender: TObject);
begin
Memo1.PasteFromClipboard ;
end;
procedure TForm1.Clearall1Click(Sender: TObject);
begin
Memo1.SelectAll ;
end;
procedure TForm1.New1Click(Sender: TObject);
begin
Memo1.Clear;
end;
procedure TForm1.Delete1Click(Sender: TObject);
begin
Memo1 .ClearSelection ;
end;
procedure TForm1.Undo1Click(Sender: TObject);
begin
Memo1.Undo ;
end;
procedure TForm1.Font2Click(Sender: TObject);
begin
if FontDialog1.Execute then
begin
FontDialog1.Font:=FontDialog1.Font;
end;
memo1.Font:= FontDialog1.Font;
end;
procedure TForm1.FullScreen1Click(Sender: TObject);
begin
Form1.WindowState:=wsMaximized;
memo1.Height:=MaxListSize;
Memo1.Width:=MaxListSize;
end;
procedure TForm1.NormalScreen1Click(Sender: TObject);
begin
Form1.WindowState:=wsNormal;
Memo1.Height:=531;
Memo1.Width:=778;
end;
procedure TForm1.Minimize1Click(Sender: TObject);
begin
Application.Minimize;
end;
procedure TForm1.DateTime1Click(Sender: TObject);
begin
Timer1.Interval:=1000;
Memo1.Lines.Add(TimeToStr(time));
Memo1.Lines.Add(DateToStr(Date));
end;
end.

MEMBUAT PROGRAM SPLASH SCREEN

Semoga berhasil... Jika ada masalah kirim email ke : putu_dalungcity@yahoo.co.id
Nama : Abryan Tata Pangarsa
Web : abryantp.blogspot.com
Buat 2 Form
Sourcecode [ Membuat program splash screen ] :
Untuk Form1 :
unit Abryan;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, ComCtrls, ExtCtrls;
type
TForm1 = class(TForm)
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
end.
Untuk Form2 :
unit Abryan;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, ExtCtrls, jpeg;
type
TFrmsplash = class(TForm)
Timer1: TTimer;
Image1: TImage;
procedure TmMainTimerTimer(Sender: TObject);
procedure Image1Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Frmsplash: TFrmsplash;
implementation
{$R *.dfm}
procedure TFrmsplash.TmMainTimerTimer(Sender: TObject);
begin
Timer1.Enabled := False ;
End;
end.
Untuk Project :
program Abryan;
uses
Forms,
Abryan in 'Abryan.pas' {Form1},
Abryan in 'Abryan.pas' {Form2};
{$R *.res}
begin
Form2 := TForm2.Create(Application);
Form2.Show;
Form2.Update;
while form2.Timer1.Enabled do
Application.ProcessMessages;
Application.Initialize;
Application.CreateForm(TForm1, Form1);
Form2.Hide;
Form2.Free;
Application.Run;
end.

MEMBUAT PROGRAM TULISAN BERGERAK

Semoga berhasil... Jika ada masalah kirim email ke : putu_dalungcity@yahoo.co.id
Nama : Abryan Tata Pangarsa
Web : abryantp.blogspot.com
Sourcecode [ Membuat program tulisan bergerak ] :
unit Abryan;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, ExtCtrls;
type
TForm1 = class(TForm)
Timer1: TTimer;
Label1: TLabel;
Timer2: TTimer;
Label2: TLabel;
procedure Timer1Timer(Sender: TObject);
procedure Timer2Timer(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
procedure TForm1.Timer1Timer(Sender: TObject);
VAR LOGO : STRING;
P:INTEGER;
begin
LOGO:= Label1.Caption;
P:= LENGTH(LOGO);
LOGO:= COPY(LOGO,P-1,1)+ COPY(LOGO,1,P-1);
label1.Caption :=LOGO;
end;
procedure TForm1.Timer2Timer(Sender: TObject);
VAR LOGO : STRING;
P:INTEGER;
begin
LOGO:= Label2.Caption;
P:= LENGTH(LOGO);
LOGO:=COPY(LOGO,2,P-1)+ COPY(LOGO,1,1);
label2.Caption :=LOGO;
end;
end.

Shoutbox

 

Recent Posts

Recent Comments

Followers

Copyright © 2009 Fresh Themes Gallery | NdyTeeN. All Rights Reserved. Powered by Blogger and Distributed by Blogtemplate4u .