Posted by : rynsuji.blogspot.com Minggu, 30 November 2014

PROGRAM VIEW PHOTOS

Program ini di buat menggunakan Delphi 7. Program ini adalah tentang view photos, disini saya akan menerapkannya pada pemrograman delphi. Sebenarnya program ini sangat sederhana karena cara kerja dari program ini adalah dengan kita melihat foto dan akan muncul pilihan ketika kita klik kanan pada foto tersebut. Pilihan yang tampil ketika di klik kanan adalah change, clear, dan save. Ketika kita klik change maka kita akan mengganti foto sesuai yang kita inginkan, ketika kita klik clear maka foto tersebut akan hilang dan ketika kita klik save maka foto tersebut akan kita save ke direcroti yang kita inginkan. Program ini menggunakan label, speedbutton, timer, mainmenu, panel, popupmenu, openpicturedialog, savedialog, dan image. Berikut source codenya;

a. Source code form menu

unit MNU;

interface

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, Menus, ExtCtrls, StdCtrls;

type
Tmnnn = class(TForm)
MainMenu1: TMainMenu;
VIEW1: TMenuItem;
ABOUT1: TMenuItem;
EXIT1: TMenuItem;
Image1: TMenuItem;
Timer1: TTimer;
Label1: TLabel;
procedure Image1Click(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure Timer1Timer(Sender: TObject);
procedure ABOUT1Click(Sender: TObject);
procedure EXIT1Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;

var
mnnn: Tmnnn;
a:string;

implementation

uses gambar, about;

{$R *.dfm}

procedure Tmnnn.Image1Click(Sender: TObject);
begin
gbr.show;
end;

procedure Tmnnn.FormCreate(Sender: TObject);
begin
a:='Riyan Susilo Adji ';
end;

procedure Tmnnn.Timer1Timer(Sender: TObject);
var
i: Integer;
begin
Application.Title := a;
mnnn.Caption := a;
for i := 1 to (length(a) - 1) do
a[i] := Application.Title[i + 1];
a[Length(a)] := Application.Title[1];
end;

procedure Tmnnn.ABOUT1Click(Sender: TObject);
begin
About3.show;
end;

procedure Tmnnn.EXIT1Click(Sender: TObject);
begin
if(application.MessageBox('Yakin akan keluar dari program','Konfirmasi',MB_YesNo or MB_ICONQUESTION)=ID_Yes ) then
begin
application.Terminate;
end
end;

end.

b. Source code form view photos

unit gambar;

interface

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, ExtCtrls, ExtDlgs, StdCtrls, jpeg, Buttons, Menus;

type
Tgbr = class(TForm)
Panel1: TPanel;
Image1: TImage;
OpenPictureDialog1: TOpenPictureDialog;
SpeedButton1: TSpeedButton;
Timer1: TTimer;
Timer2: TTimer;
Panel2: TPanel;
Label1: TLabel;
Panel3: TPanel;
Image2: TImage;
PopupMenu1: TPopupMenu;
Change1: TMenuItem;
Clear1: TMenuItem;
PopupMenu2: TPopupMenu;
Change2: TMenuItem;
Clear2: TMenuItem;
OpenPictureDialog2: TOpenPictureDialog;
SaveDialog1: TSaveDialog;
SaveDialog2: TSaveDialog;
Save_2: TMenuItem;
Save_1: TMenuItem;
procedure SpeedButton1Click(Sender: TObject);
procedure Timer1Timer(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure Timer2Timer(Sender: TObject);
procedure Change1Click(Sender: TObject);
procedure Clear1Click(Sender: TObject);
procedure Change2Click(Sender: TObject);
procedure Clear2Click(Sender: TObject);
procedure Save_1Click(Sender: TObject);
procedure Save_2Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;

var
gbr: Tgbr;
strfile,a,namafile:string;

implementation

{$R *.dfm}
//richedit.1.cuttoclipboard
procedure Tgbr.SpeedButton1Click(Sender: TObject);
begin
close
end;

procedure Tgbr.Timer1Timer(Sender: TObject);
var
i: Integer;
begin
Application.Title := a;
gbr.Caption := a;
for i := 1 to (length(a) - 1) do
a[i] := Application.Title[i + 1];
a[Length(a)] := Application.Title[1];
end;

procedure Tgbr.FormCreate(Sender: TObject);
begin
a:='Riyan Susilo Adji ';
end;

procedure Tgbr.Timer2Timer(Sender: TObject);
begin
if label1.Visible = true then label1.visible := false
else label1.Visible:=true;
end;

procedure Tgbr.Change1Click(Sender: TObject);
var
strfile:string;
begin
if (openpicturedialog1.Execute) then
begin
strfile:=openpicturedialog1.FileName;
image1.Picture.LoadFromFile(strfile);
end;
end;

procedure Tgbr.Clear1Click(Sender: TObject);
begin
image1.Picture:=nil;
end;

procedure Tgbr.Change2Click(Sender: TObject);
var
strfile:string;
begin
if (openpicturedialog2.Execute) then
begin
strfile:=openpicturedialog2.FileName;
image2.Picture.LoadFromFile(strfile);
end;
end;

procedure Tgbr.Clear2Click(Sender: TObject);
begin
image2.Picture:=nil;
end;

procedure Tgbr.Save_1Click(Sender: TObject);
begin
if SaveDialog1.Execute then
begin
NamaFile := SaveDialog1.FileName;
image1.picture.SaveToFile(namafile);
ShowMessage('Berhasil disimpan!');
end;
end;

procedure Tgbr.Save_2Click(Sender: TObject);
begin
if SaveDialog2.Execute then
begin
NamaFile := SaveDialog2.FileName;
image2.picture.SaveToFile(namafile);
ShowMessage('Berhasil disimpan!');
end;
end;

end.

Berikut tampilan outputnya :