Jumat, 16 Januari 2009

CONTOH LATIHAN GRAFIKA

interface

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

type
Tprak9 = class(TForm)
Timer1: TTimer;
ScrollBar1: TScrollBar;
ScrollBar2: TScrollBar;
procedure titik3d( x,yyy,zzz:integer;w:tcolor);
procedure putarsmbx(x,y,z:integer;w:tcolor);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure FormCreate(Sender: TObject);
procedure Button1Click(Sender: TObject);
procedure Timer1Timer(Sender: TObject);
Continue reading »
Nov 06
prak 9 grafika komputer
Asisten Gua, Prak Grafika Komputer No Comments »

prak 9

unit grafika9;

interface

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

type
Tprak9 = class(TForm)
Timer1: TTimer;
ScrollBar1: TScrollBar;
ScrollBar2: TScrollBar;
procedure titik3d( x,yyy,zzz:integer;w:tcolor);
procedure putarsmbx(x,y,z:integer;w:tcolor);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure FormCreate(Sender: TObject);
procedure Button1Click(Sender: TObject);
procedure Timer1Timer(Sender: TObject);
Continue reading »
Nov 06
prak 8 grafika komputer
Asisten Gua, Prak Grafika Komputer No Comments »

prak 8

membuat bola

unit grafika8;

interface

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

type
Tprak8 = class(TForm)
Button1: TButton;
ScrollBar1: TScrollBar;
ScrollBar2: TScrollBar;
Edit1: TEdit;
Edit2: TEdit;
Edit3: TEdit;
Edit4: TEdit;
Label1: TLabel;
Label2: TLabel;
Label3: TLabel;
Label4: TLabel;
Button2: TButton;
procedure xyztoxy( x,y,z : real; var xx,yy : real);
procedure bola(x0,y0,z0,r : integer);
procedure FormCreate(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
Continue reading »
Nov 06
prak 7 grafika komputer
Asisten Gua, Prak Grafika Komputer No Comments »

prak 7

unit grafika7;

interface

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

type
Tprak7 = class(TForm)
Image1: TImage;
Timer1: TTimer;
procedure FormCreate(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure Timer1Timer(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;

Continue reading »
Nov 06
prak 6 grafika komputer
Asisten Gua, Prak Grafika Komputer No Comments »

prak 6

membuat garis membentuk pola tertentu

unit grafika6;

interface

uses
SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
Forms, Dialogs, ExtCtrls, Buttons, Menus, StdCtrls, AppEvnts;

{ Taratruga grafica, orientamento in gradi,orientamento in radianti,
ascissa,ordinata,passo }

type Tarta = record
A: real;
R: real;
X: real;
Y: real;
P: real;
end;

{ Parametri di scambio per la curva di Sierpinski,
la piĆ¹ complicata della serie}

type SierpN = record
a1:array [1..5] of integer;
a2:array [1..5] of integer;
a3:array [1..5] of integer;
a4:array [1..5] of integer;
end;
type SierpM = array [1..5, 1..4] of real;

type
Tprak6 = class(TForm)
MainMenu1: TMainMenu;
Image1: TImage;
Menu1: TMenuItem;
Exit1: TMenuItem;
Fraktal1: TMenuItem;
Koch1: TMenuItem;
Peano1: TMenuItem;
Warna1: TMenuItem;
Merah1: TMenuItem;
Hijau1: TMenuItem;
Biru1: TMenuItem;
resolusi1: TMenuItem;
N640×4801: TMenuItem;
N800×6001: TMenuItem;
procedure Peano1Click(Sender: TObject);
procedure Koch1Click(Sender: TObject);
procedure N640×4801Click(Sender: TObject);
procedure N800×6001Click(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure Merah1Click(Sender: TObject);
procedure Hijau1Click(Sender: TObject);
procedure Biru1Click(Sender: TObject);
procedure Exit1Click(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
private
{ Private declarations }

public
{ Public declarations }
end;

var
prak6: Tprak6;
T: Tarta;
xT,yT:integer;

implementation

uses Unit2;

{$R *.dfm}

procedure Cancella;
begin
prak6.Image1.Canvas.Pen.Style := psSolid;
prak6.Image1.Canvas.Brush.Color:=RGB(0,0,0);
prak6.Image1.Canvas.FillRect(Rect(0,0,prak6.ClientWidth,prak6.ClientHeight));
end;

procedure CambiaRisoluzione(rx,ry: integer);
var Bitmap: TBitmap;

begin
{bloccamento della finestra e dell’immagine}
prak6.Constraints.MaxHeight:=ry+46;
prak6.Constraints.MinHeight:=ry+46;
prak6.Constraints.MaxWidth:=rx+8;
prak6.Constraints.MinWidth:=rx+8;
prak6.ClientHeight:=ry;
prak6.ClientWidth:=rx;
prak6.Image1.Height:=ry;
prak6.Image1.Width:=rx;
{dimensiona la bitmap per il salvataggio}
Bitmap := TBitmap.Create;
Bitmap.Width := rx;
Bitmap.Height := ry;
prak6.Image1.Picture.Bitmap := Bitmap;
Bitmap.Free;
Cancella;
end;

{assegna il colore con un gradino finale}
function AssegnaColore(spessAtt,spessIni:integer):integer;
var colore:integer;
begin
colore:=120-spessAtt*(128 div spessIni);
if colore<0 spessatt ="1" col="0" col="1" col="10" col="11" col="100" col="101" col="110" col="111">0 then Peano(k - 1);
Asinistra;
indietro;
if k>0 then Peano(k - 1);
Adestra;
indietro;
if k>0 then Peano(k - 1);
Adestra;
indietro;
if k>0 then Peano(k - 1);
Adestra;
indietro;
if k>0 then Peano(k - 1);
Asinistra;
indietro;
if k>0 then Peano(k - 1);
Asinistra;
indietro;
if k>0 then Peano(k - 1);
Asinistra;
indietro;
if k>0 then Peano(k - 1);
Adestra;
indietro;
if k>0 then Peano(k - 1);
end;

procedure Tprak6.Peano1Click(Sender: TObject);
var
colore,spessore,r,s,x,y:integer;

begin

{selezione parametri iniziali della tartaruga e della linea}
IF prak6.N640×4801.Checked then
begin T.X:=505; T.Y:=422; r:=1; T.P:=26; s:=64; end;
IF prak6.N800×6001.Checked then
begin T.X:=640; T.Y:=540; r:=1; T.P:=33; s:=64; end;

x:=realtoint(T.X);
y:=realtoint(T.Y);
Cancella;

for spessore:=s downto 1 do
begin
colore:=AssegnaColore(spessore,s);

prak6.Image1.Canvas.MoveTo(x, y);
prak6.Image1.Canvas.Pen.Width := spessore;
SelezioneColore(colore);

Application.ProcessMessages;

{ chiamata procedura ricorsiva}
T.A:=45;
T.X:=x;
T.Y:=y;
indietro;
Peano(r);
end;

end;

{procedura ricorsiva}
procedure Koch(k:integer) ;

begin
if k>0 then
begin
Koch(k-1);
avanti;
sinistra(60);
end;
if k>0 then
begin
Koch(k-1);
avanti;
destra(120);
end;
if k>0 then
begin
Koch(k-1);
avanti;
sinistra(60);
end;
if k>0 then
begin
Koch(k-1);
end;

end;

procedure Tprak6.Koch1Click(Sender: TObject);
var
colore,spessore,i,r,s,x,y:integer;

begin
{selezione parametri iniziali della tartaruga}
IF prak6.N640×4801.Checked then
begin T.X:=165; T.Y:=155; r:=3; T.P:=11; s:=128; end;
IF prak6.N800×6001.Checked then
begin T.X:=206; T.Y:=185; r:=3; T.P:=14; s:=128; end;

x:=realtoint(T.X);
y:=realtoint(T.Y);
Cancella;

for spessore:=s downto 1 do
begin
colore:=AssegnaColore(spessore,s);
prak6.Image1.Canvas.MoveTo(x, y);
prak6.Image1.Canvas.Pen.Width := spessore;
SelezioneColore(colore);
Application.ProcessMessages;

{ chiamata procedura ricorsiva}
T.A:=0;
T.X:=x;
T.Y:=y;
{tre lati}
for i:=1 to 3 do
begin
Koch(r);
avanti;
destra(120)
end;

end;

end;

procedure Tprak6.N640×4801Click(Sender: TObject);
begin
prak6.N640×4801.Checked := True;
prak6.N800×6001.Checked := False;

CambiaRisoluzione(640,480);
end;

procedure Tprak6.N800×6001Click(Sender: TObject);
begin
prak6.N640×4801.Checked := False;
prak6.N800×6001.Checked := True;

CambiaRisoluzione(800,600);
end;

procedure Tprak6.FormCreate(Sender: TObject);
begin
prak6.Position := podesktopcenter;
prak6.hijau1.Checked := true;
prak6.N640×4801.Checked := true;
CambiaRisoluzione(640,480);
end;

procedure Tprak6.Merah1Click(Sender: TObject);
begin
prak6.merah1.Checked := not(prak6.merah1.Checked );
end;

procedure Tprak6.Hijau1Click(Sender: TObject);
begin
prak6.hijau1.Checked := not(prak6.hijau1.Checked );
end;

procedure Tprak6.Biru1Click(Sender: TObject);
begin
prak6.biru1.Checked := not(prak6.biru1.Checked );
end;

procedure Tprak6.Exit1Click(Sender: TObject);
begin
prak6.Hide;
menuku.show;
end;

procedure Tprak6.FormClose(Sender: TObject; var Action: TCloseAction);
begin
prak6.Hide;
menuku.show;
end;

end.
Nov 06
prak 5 grafika komputer
Asisten Gua, Prak Grafika Komputer No Comments »

prak 5

membuat gambar berjalan

unit grafika5;

interface

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

type
Tprak5 = class(TForm)
Image1: TImage;
Button1: TButton;
Button2: TButton;
Timer1: TTimer;
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure Timer1Timer(Sender: TObject);
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;

var
prak5: Tprak5;

implementation

uses Unit2;

{$R *.dfm}

procedure Tprak5.FormClose(Sender: TObject; var Action: TCloseAction);
begin
menuku.show;
prak5.Hide;
end;

procedure Tprak5.Timer1Timer(Sender: TObject);
begin
//38 -107
if image1.Left = 376 then image1.Left := -107;
image1.Left := image1.Left + 1;

end;

procedure Tprak5.Button1Click(Sender: TObject);
begin
timer1.Enabled := true;
end;

procedure Tprak5.Button2Click(Sender: TObject);
begin
timer1.Enabled := false;
end;

end.
Nov 06
prak 4 grafika komputer
Asisten Gua, Prak Grafika Komputer No Comments »

prak 4

membuat gradiasi warna pada label

unit grafika4;

interface

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

type
Tprak4 = class(TForm)
Label2: TLabel;
Label1: TLabel;
Label3: TLabel;
BitBtn1: TBitBtn;
BitBtn2: TBitBtn;
Shape1: TShape;
Shape2: TShape;
ColorDialog1: TColorDialog;
ColorDialog2: TColorDialog;
procedure warnai;
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure Label2Click(Sender: TObject);
procedure Label1Click(Sender: TObject);
procedure Label3Click(Sender: TObject);
procedure BitBtn1Click(Sender: TObject);
procedure BitBtn2Click(Sender: TObject);
private
{ Private declarations }
warnasumber,warnatarget : Tcolor;
rs,gs,bs,rt,gt,bt : byte;
tulisan : Tlabel;
war : integer;
public
{ Public declarations }
end;

var
prak4: Tprak4;

implementation

uses Unit2;

{$R *.dfm}

procedure Tprak4.warnai;
var
awb,akb,brs,awk,akk,klm : integer;
warna,www : Tcolor;
dtr,tamr,dtg,tamg,dtb,tamb : real;
r,g,b : byte;

begin
awb := tulisan.Top;
akb := awb + tulisan.Height;
awk := tulisan.Left;
akk := awk + tulisan.Width;
warna := canvas.pixels[awk,awb-1];
// canvas.rectangle(awk,awb,akk,akb);
tamr := 0;
dtr := (rt-rs)/tulisan.Width;

tamg := 0;
dtg := (gt-gs)/tulisan.Width;

tamb := 0;
dtb := (bt-bs)/tulisan.Width;

r := rs; g := gs; b := bs;

for klm :=awk to akk do

begin
www := rgb(r,g,b);
for brs := awb to akb do

begin
if canvas.Pixels[klm,brs]<>warna then
canvas.pixels[klm,brs]:=www;
end;

tamr := tamr + dtr ;
tamg := tamg + dtg ;
tamb := tamb + dtb ;
r := round(rs + tamr);
g := round(gs + tamg);
b := round(bs + tamb);
end;
end;

procedure Tprak4.FormClose(Sender: TObject; var Action: TCloseAction);
begin
prak4.Hide;
menuku.show;
end;

procedure Tprak4.Label2Click(Sender: TObject);
begin
tulisan := label2;
warnai;
end;

procedure Tprak4.Label1Click(Sender: TObject);
begin
tulisan := label1;
warnai;
end;

procedure Tprak4.Label3Click(Sender: TObject);
begin
tulisan := label3;
warnai;
end;

procedure Tprak4.BitBtn1Click(Sender: TObject);
begin
colordialog1.Execute;
warnasumber := colordialog1.color;
shape1.Brush.Color := colordialog1.Color;
rs := getrvalue(colordialog1.color);
gs := getgvalue(colordialog1.color);
bs := getbvalue(colordialog1.color);
//warnai;
end;

procedure Tprak4.BitBtn2Click(Sender: TObject);
begin
colordialog2.Execute;
warnatarget := colordialog2.color;
shape2.Brush.Color := colordialog2.Color;
rt := getrvalue(colordialog2.color);
gt := getgvalue(colordialog2.color);
bt := getbvalue(colordialog2.color);
//warnai;
end;

end.
Nov 06
prak 3 grafika
Asisten Gua, Prak Grafika Komputer No Comments »

prak 3

membuat segi n garis

unit grafika3;

interface

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

type
Tprak3 = class(TForm)
Timer1: TTimer;
ScrollBar1: TScrollBar;
Label1: TLabel;
procedure segiN(x0,y0,R,N,d : integer);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure FormCreate(Sender: TObject);
procedure Timer1Timer(Sender: TObject);
private
{ Private declarations }
d : integer;
public
{ Public declarations }
end;

var
prak3: Tprak3;

implementation

uses Unit2;

{$R *.dfm}

procedure Tprak3.segiN(x0,y0,R,N,d : integer);
var di,der : real;
x1,y1,x2,y2,i : integer;
begin
der := pi/180;
di := 360/N;
x1 := round(x0 + r*cos((di + d) * der));
y1 := round(y0 + r*sin((di + d) * der));
canvas.MoveTo(x1,y1);

for i := 2 to N +1 do
begin
x2 := round(x0 + r*cos((i*di+d) * der));
y2 := round(y0 + r*sin((i*di + d)* der));
canvas.LineTo(x2,y2);
end;
end;

procedure Tprak3.FormClose(Sender: TObject; var Action: TCloseAction);
begin
menuku.show;
prak3.Hide;
end;

procedure Tprak3.FormCreate(Sender: TObject);
begin
prak3.Position := podesktopcenter;
end;

procedure Tprak3.Timer1Timer(Sender: TObject);
begin
canvas.Pen.Color := clblue;
segiN(150,150,100,7,d);
d := d + ScrollBar1.position;
if d > 360 then d := d - 360;
canvas.Pen.Color := clgreen;
segiN(150,150,100,3,d);
end;

end.

Tidak ada komentar: