IT yang lagi Galau

APA YANG TERJADI HARI INI...?

Radio Online

KABAR TEKNOLOGI TERAKHIR

Game Dengan Delphi 7

kali ini kita akan coba membuat game dengan delphi, game tersebuat adalah roller coaster.
pertama, buatlah form hingga seperti di bawah :
lalu copy kan listing di bawah kedalam kotak code :

unit U_RCoaster6;



interface

uses

  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  ExtCtrls, StdCtrls, ComCtrls, Grids, u_Splines, U_CoasterB, Menus,
  mmsystem, Spin, jpeg;

type
  TForm1 = class(TForm)
    PageControl: TPageControl;
    TrackPage: TTabSheet;
    CartPage: TTabSheet;
    Runpage: TTabSheet;
    FrictionBar: TTrackBar;
    Label1: TLabel;
    CartYEdt: TEdit;
    CHeightUD: TUpDown;
    CartXEdt: TEdit;
    CLengthUD: TUpDown;
    Label5: TLabel;
    Label6: TLabel;
    FrictionLbl: TLabel;
    MassEdt: TEdit;
    Label8: TLabel;
    Label9: TLabel;
    Label10: TLabel;
    Label11: TLabel;
    Label13: TLabel;
    Label12: TLabel;
    Label14: TLabel;
    XrptLbl: TLabel;
    YRptLbl: TLabel;
    ThetaCRptLbl: TLabel;
    ACRptLbl: TLabel;
    GCRptLbl: TLabel;
    VCRptLbl: TLabel;
    Label21: TLabel;
    AMinRptLbl: TLabel;
    GMinRptLbl: TLabel;
    VMinRptLbl: TLabel;
    AMaxRptLbl: TLabel;
    GMaxRptLbl: TLabel;
    VMaxRptLbl: TLabel;
    Label28: TLabel;
    Label29: TLabel;
    Label30: TLabel;
    VZeroEdt: TEdit;
    VZeroUD: TUpDown;
    Label15: TLabel;
    Runrptlbl: TLabel;
    DebugPage: TTabSheet;
    TimeloopBox: TCheckBox;
    LoopTimeLbl: TLabel;
    Label18: TLabel;
    Edit3: TEdit;
    MaxflyUD: TUpDown;
    DebugGrid: TStringGrid;
    DebugBox: TCheckBox;
    LoadTrackBtn: TButton;
    SaveTrackBtn: TButton;
    DesignBox: TCheckBox;
    NewTrackBtn: TButton;
    OpenDialog1: TOpenDialog;
    SaveDialog1: TSaveDialog;
    Constrainedbox: TCheckBox;
    PopupMenu1: TPopupMenu;
    Addcontrolpoint1: TMenuItem;
    Deletecontrolpoint1: TMenuItem;
    ThetaMinRptLbl: TLabel;
    ThetaMaxRptLbl: TLabel;
    Image1: TPaintBox;
    SimPage: TTabSheet;
    RunSoundbox: TCheckBox;
    Label2: TLabel;
    PosLbl: TLabel;
    GroupBox1: TGroupBox;
    Label19: TLabel;
    Label20: TLabel;
    GroupBox2: TGroupBox;
    Label22: TLabel;
    Label25: TLabel;
    Label4: TLabel;
    StepSecEdt: TEdit;
    StepsSecUD: TUpDown;
    Label3: TLabel;
    Label7: TLabel;
    FlyCRptLbl: TLabel;
    FlyMinRptLbl: TLabel;
    FlyMaxRptLbl: TLabel;
    XFirstUD: TUpDown;
    YFirstUD: TUpDown;
    XFirstEdt: TEdit;
    YFirstEdt: TEdit;
    FallSoundBox: TCheckBox;
    Edit1: TEdit;
    NbrCartsUD: TUpDown;
    Label16: TLabel;
    TimeScaleEdt: TEdit;
    TimeScaleUD: TUpDown;
    AspectBox: TCheckBox;
    VrXEdt: TEdit;
    VRYEdt: TEdit;
    GravityEdt: TEdit;
    PosLblBox: TCheckBox;
    AboutSheet: TTabSheet;
    Panel1: TPanel;
    ProgramIcon: TImage;
    ProductName: TLabel;
    Version: TLabel;
    Copyright: TLabel;
    Comments: TLabel;
    Panel2: TPanel;
    StartBtn: TButton;
    StopBtn: TButton;
    StepBtn: TButton;
    ResetBtn: TButton;
    Label23: TLabel;
    TrackScaleEdt: TEdit;
    TrackScaleUD: TUpDown;
    Label24: TLabel;
    SkylineEdt: TEdit;
    SkylineUD: TUpDown;
    Label26: TLabel;
    trackScaleBtn: TButton;
    StatusBar2: TStatusBar;
    Button2: TButton;
    Memo1: TMemo;
    procedure FormActivate(Sender: TObject);
    procedure StartBtnClick(Sender: TObject);
    procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
    procedure StopBtnClick(Sender: TObject);
    procedure FrictionBarChange(Sender: TObject);
    procedure StepSecEdtChange(Sender: TObject);
    procedure VZeroEdtChange(Sender: TObject);
    procedure MassEdtChange(Sender: TObject);
    procedure ResetBtnClick(Sender: TObject);
    procedure StepBtnClick(Sender: TObject);
    procedure NewTrackBtnClick(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure DesignBoxClick(Sender: TObject);
    procedure SaveTrackBtnClick(Sender: TObject);
    procedure LoadTrackBtnClick(Sender: TObject);
    procedure ConstrainedboxClick(Sender: TObject);
    procedure CartYEdtChange(Sender: TObject);
    procedure CartXEdtChange(Sender: TObject);
    procedure SoundboxClick(Sender: TObject);
    procedure VredtExit(Sender: TObject);
    procedure VredtKeyPress(Sender: TObject; var Key: Char);
    procedure GravityEdtExit(Sender: TObject);
    {procedure XYFirstUDClick(Sender: TObject; Button: TUDBtnType);}
    procedure SkylineUDClick(Sender: TObject; Button: TUDBtnType);
    procedure XYFirstUDChangingEx(Sender: TObject; var AllowChange: Boolean;
      NewValue: Smallint; Direction: TUpDownDirection);
    procedure NbrCartsUDClick(Sender: TObject; Button: TUDBtnType);
    procedure FormPaint(Sender: TObject);
    procedure TimeScaleEdtChange(Sender: TObject);
    procedure XYFirstEdtChange(Sender: TObject);
    procedure GravityEdtKeyPress(Sender: TObject; var Key: Char);
    procedure PosLblBoxClick(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure FormResize(Sender: TObject);
    procedure trackScaleBtnClick(Sender: TObject);
    procedure Button2Click(Sender: TObject);

  public
    coaster:TCoaster;
    prevtime:float;
    debugrow:integer;
    directory, filename:string;
    paused:boolean;
    vmin,vmax,amin,amax,gmin,gmax,tmin,tmax,hmin,hmax:float;
    ybase:integer;
    procedure updatereportstats;
    procedure LoadCoaster(f:string);
    procedure LoadDisplaysFromCoaster;
    procedure CheckSaveModified;
  end;

var
  Form1: TForm1;

implementation

{$R *.DFM}

uses math;

const
  statfreq:float=0.0;  {update stats every seconds of scale run time}

{******************** Bikin Form ****************}
procedure TForm1.FormCreate(Sender: TObject);
begin
  directory:=extractfilepath(application.exename);
  filename:='default.coaster';
  savedialog1.initialdir:=directory;
  opendialog1.initialdir:=directory;
  randomize;
end;

{************************** TForm1 Diaktifkan ***************}
procedure TForm1.FormActivate(Sender: TObject);
begin
  windowstate:=wsmaximized;
  copyright.caption:='Copyright '+#169+' ';

  coaster:=tCoaster.create(image1);
  If fileexists(directory+filename) then loadcoaster(directory+filename);

  with DebugGrid do {Bikin Tab Debug}
  begin
    cells[0,0]:='Time';
    cells[1,0]:='Xval';
    cells[2,0]:='Yval';
    cells[3,0]:='Theta';
    cells[4,0]:='V';
    cells[5,0]:='Vx';
    cells[6,0]:='Vy';
    cells[7,0]:='a(tang.)';
    cells[8,0]:='a(norm.)';

    cells[9,0]:='g';
    cells[10,0]:='Dist';
    cells[11,0]:='Index';
  end;
  debugrow:=0;
  paused:=false; {Reset Paksa}
  startbtnclick(sender);
end;

{********************** Tombol Mulai ************}
procedure TForm1.StartBtnClick(Sender: TObject);
var
  loopcount, count, count2, freq:int64;
begin
   if not paused then resetbtnclick(sender);

   with pagecontrol do
   if (activepage<>DebugPage) and (activepage<>RunPage)
   then activepage:=RunPage;
   tag:=0;
   debugrow:=0;
   paused:=false;
   designbox.checked:=false;
   coaster.designmode:=false;
   DebugGrid.rowcount:=2;
   Debuggrid.fixedrows:=1;
   queryperformancefrequency(freq);
   queryperformancecounter(count);
   loopcount:=0;
   repeat
     stepbtnclick(sender) ;
     if loopcount mod 10 = 9 {Setiap 10 Step, cek interupt}
     then application.processmessages;
     inc(loopcount);
   until (tag<>0) or  (not coaster.cartready);
   if timeloopbox.checked then
   begin
     queryperformancecounter(count2);
     looptimelbl.caption:=format(' Avg loop time: %6.2n milliseconds',
                                 [(count2-count)/freq/loopcount*1e3]);
   end;
  end;

{********************* Tombol Reset ************}
procedure TForm1.ResetBtnClick(Sender: TObject);
var
  vertex:tVertex;
begin
  tag:=1;
  sleep(100);
  timescaleEdtChange(sender);
  designbox.checked:=false;

  coaster.init(maxflyud.position);  {Ketinggian Maximal}
  (* no need for these updates here?
  frictionbarchange(sender);
  gravityEdtExit(sender);
  stepsecEdtChange(sender);
  SoundBoxClick(sender);
  CartxEdtChange(sender);
  CartyEdtChange(sender);
  VzeroEdtChange(sender);
  MassEdtchange(sender);
  *)
  prevtime:=0;
  coaster.drawcart;
  paused:=false;
  amin:=1e6;   amax:=-1e6;
  vmin:=1e6;   vmax:=-1e6;
  gmin:=1e6;   gmax:=-1e6;
  tmin:=1e6;   tmax:=-1e6;
  hmin:=1e6;   hmax:=-1e6;
  updatereportstats; {zero out previous results}
  with coaster do
  begin
    vertex:=bspline.vertexnr(1);
    XFirstUD.position:=round(100*(vertex.x/width));
    YFirstUD.position:=round(100*(height-vertex.y)/height);
    vertex:=bspline.vertexnr(BSpline.numberofvertices);
    SkylineUD.position:=round(100*Yskyline/height);
    VrXedt.text:=format('%5.1f',[cxmax-cxmin]);
    VryEdt.text:=format('%5.1f',[cymax-cymin]);
  end;
end;

{******************* Tombol Stop *************}
procedure TForm1.StopBtnClick(Sender: TObject);
begin   paused:=true; tag:=1;  {set stop flag} end;

{************************ Tombol Step **************}
procedure TForm1.StepBtnClick(Sender: TObject);
begin
  with coaster do
  if cartready then
  begin
    cartready:=steptime;
    if not cartready then
    begin {cleanup values}
      a:=0;
      v:=0;
      prevtime:=time-statfreq; {Status Terakhir Paksa}
    end;
    UpdateReportStats;
  end
  else  beep;
end;

{****************** Tombol New Track ****************}
procedure TForm1.NewTrackBtnClick(Sender: TObject);
begin
   if coaster.modified then checksavemodified;
   coaster.free;
   coaster:=tCoaster.create(image1);
   LoadDisplaysFromCoaster;
   filename:='New.Coaster';
   designbox.checked:=true;
   coaster.designmode:=true;
   coaster.modified:=true;
end;

{*********************** Tombol Save Track ***********}
procedure TForm1.SaveTrackBtnClick(Sender: TObject);
var
  st:TFilestream;
begin
  savedialog1.initialdir:=directory;
  if filename<>'' then savedialog1.filename:=filename;
  if savedialog1.execute then
  begin
    st:=tfilestream.create(savedialog1.filename,fmCreate);
    coaster.savetoStream(st);
    filename:=extractfilename(savedialog1.filename);
    directory:=extractfilepath(savedialog1.filename);
    st.free;
    loadcoaster(savedialog1.filename);
  end;
end;

{******************** LoadTrackBtnClick *************}
procedure TForm1.LoadTrackBtnClick(Sender: TObject);

begin
  opendialog1.initialdir:=directory;
  if coaster.modified then checksavemodified;
  if opendialog1.execute then loadcoaster(opendialog1.FileName);
end;

procedure TForm1.LoadDisplaysFromCoaster;
  begin
    with coaster do
    begin
      frictionbar.position:=trunc(friction*1000);
      Gravityedt.text:=format('%5.1f',[gravity]);
      if timestep=0 then timestep:=0.1;
      StepssecUD.position:=round(1/timestep);
      CLengthUD.position:=round(cartx);
      CHeightUD.position:=round(carty);
      VZeroUD.position:=trunc(vzero);
      NbrCartsUD.position:=nbrcarts;
      MassEdt.text:=inttostr(trunc(mass));
      constrainedbox.checked:=constrained;
      timescaleUD.position:=round(timescale);
      runsoundbox.checked:=playrunsounds;
      fallsoundbox.checked:=playfallsounds;
    end;
  end;

{********************* UpdateReportStats *********}
procedure TForm1.UpdateReportStats;
var
  n,t:float;
  r:integer;
begin
  with coaster do
  begin
    runrptlbl.caption:=format(' %5.1n ',[time]);
    xrptlbl.caption:=format(' %4.1n ',[xval]);
    yrptlbl.caption:=format(' %4.1n ',[yval]);
    t:=-180/pi*theta;
    thetaCrptlbl.caption:=format(' %5.1n ',[t]);
    acrptlbl.caption:=format(' %5.1n ',[a]);
    gcrptlbl.caption:=format(' %5.1n ',[coaster.g]);
    vcrptlbl.caption:=format(' %5.1n ',[v]);
    n:=max(flyheight,0);
    FlyCrptlbl.caption:=format(' %5.1n ',[n]);
    if ((not onchain) and (rec.x        or (time=0) then
    {update max & min velocity, etc. diplays only while free coaasting}
    begin

      if t>tmax then tmax:=t;
      if t      thetaMinrptlbl.caption:=format(' %5.1n ',[tmin]);
      thetaMaxrptlbl.caption:=format(' %5.1n ',[tmax]);
      n:=a;
      If n>amax then amax:=n;
      if n      aminrptlbl.caption:=format(' %5.1n ',[amin]);
      amaxrptlbl.caption:=format(' %5.1n ',[amax]);

      n:=g;
      if n>gmax then gmax:=n;
      if n      gminrptlbl.caption:=format(' %5.1n ',[gmin]);
      if gmin<-3 then gminrptlbl.color:=clred
      else if gmin<-2 then gminrptlbl.color:=clyellow
      else gminrptlbl.color:=clAqua;
      gmaxrptlbl.caption:=format(' %5.1n ',[gmax]);
      if gmax>6 then gmaxrptlbl.color:=clred
      else if gmax>4.5 then gmaxrptlbl.color:=clyellow
      else gmaxrptlbl.color:=clAqua;

      n:=v;
      if n>vmax then vmax:=n;
      If n      vminrptlbl.caption:=format(' %5.1n ',[vmin]);
      vmaxrptlbl.caption:=format(' %5.1n ',[vmax]);

      n:=max(Flyheight,0);
      if n>hmax then hmax:=n;
      If n      Flyminrptlbl.caption:=format(' %5.1n ',[hmin]);
      Flymaxrptlbl.caption:=format(' %5.1n ',[hmax]);
      prevtime:=time;
    end;
    If debugbox.checked then
    with DebugGrid do
    begin
      inc(debugrow);
      r:=debugrow;
      if r>=rowcount then rowcount:=rowcount+1;
      cells[0,r]:=format('%5.2f',[Time]);
      cells[1,r]:=format('%5.2f',[Xval]);
      cells[2,r]:=format('%5.2f',[Yval]);
      cells[3,r]:=format('%5.2f',[Theta]);
      cells[4,r]:=format('%5.2f',[V]);
      cells[5,r]:=format('%5.2f',[Vx/scale]);
      cells[6,r]:=format('%5.2f',[Vy/scale]);
      cells[7,r]:=format('%5.2f',[a]);
      cells[8,r]:=format('%5.2f', [an/scale]); {a - normal}
      cells[9,r]:=format('%5.2f',[g]);
      cells[10,r]:=format('%5.2f',[distance]);
      cells[11,r]:=format('%5d',[rec.Index]);
      row:=rowcount-1;   {set cursor to last row}
    end;
  end;
end;



{************************** FormCloseQuery *****************}
procedure TForm1.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
{If the coaster has been changed, then give user a chance to save before exiting}
begin
   tag:=1;  {set stopflag}
   if coaster.modified then checksavemodified;
   canclose:=true;
   playsound(nil,0,0);
end;

{******************** CartYEdtChnage **************}
procedure TForm1.CartYEdtChange(Sender: TObject);
begin
  if assigned(coaster) then
  if coaster.carty<>cheightUD.position then
  begin
    coaster.carty:=CheightUD.position;
  end;
end;

{****************** CartXEdtChange ***************}
procedure TForm1.CartXEdtChange(Sender: TObject);
begin
  If assigned(coaster) then
  if coaster.cartx<>clengthUD.position then
  begin
    coaster.cartx:=CLengthUD.position;
  end;
end;

{******************* FrictionBarChange **************}
procedure TForm1.FrictionBarChange(Sender: TObject);
var
  n:float;
begin
  with frictionbar do
  begin
    n:=position/1000;
    if n<>coaster.friction then
    begin
      coaster.setfriction(position/1000);
      {modified:=true;}
    end;
    frictionlbl.caption:=format(' %5.3n ',[position/1000]);
  end;
end;

{******************* GravityFEditExit ************}
procedure TForm1.GravityEdtExit(Sender: TObject);
var n:float;
begin
  n:=StrtoFloat(GravityEdt.text);
  coaster.SetGravity(n);
end;

{******************* MassEdtChange *************}
procedure TForm1.MassEdtChange(Sender: TObject);
var  n:float;
begin
  n:=strtointdef(massedt.text,1000);
  if coaster.mass <> n then
  begin
    coaster.setmass(n);
    {modified:=true;}
  end;
end;

{*********************** StepsSecEdtChange ***********}
procedure TForm1.StepSecEdtChange(Sender: TObject);
var
  n:float;
begin
   If assigned(coaster) then
   begin
     n:=1/stepssecUD.position;
     if stepssecUD.position<>round(1/coaster.timestep) then
     begin
       Coaster.settimestep(n);
       coaster.settimescale(coaster.timescale); {recalc  sleep time}
     end;
   end;
end;

{********************* VZeroEdtChange *************}
procedure TForm1.VZeroEdtChange(Sender: TObject);
var
  n:float;
begin
  if assigned(coaster) then
  begin
    n:=VZeroUD.position;
    if coaster.V<>n then
    begin
      Coaster.VZero:=n;
    end;
  end;
end;

{************** DesignBoxClick *****************}
procedure TForm1.DesignBoxClick(Sender: TObject);
begin
   coaster.designmode:=designbox.checked;
   coaster.drawpoints(100);
end;

{****************** CheckaveModified *********}
procedure TForm1.CheckSaveModified;
var
  r:integer;
begin
  r:=messagedlg('Save current coaster?', mtConfirmation,[mbyes,mbno,mbcancel],0);
  if r=mryes  then SaveTrackBtnClick(self)
  else if r=mrno then coaster.modified:=false;
end;

{************** LoadCoaster *************}
procedure TForm1.LoadCoaster(f:string);
 var
  st:TFilestream;
 begin
    if coaster.modified then checksavemodified;
    st:=tfilestream.create(f,fmopenRead);
    try
      coaster.loadfromstream(st);
      with coaster do
      begin
        directory:=extractfilepath(f);
        filename:=extractfilename(f);
        LoadDisplaysFromCoaster;
      end;
      finally st.free;
    end;
    resetbtnclick(self);
    coaster.modified:=false;
    caption:='Curent Coaster: '+ filename;
    paused:=true;  {just to prevent another reset at start}
 end;

 {**************ContrainedBoxClick ************}
procedure TForm1.ConstrainedboxClick(Sender: TObject);
begin
  If constrainedbox.checked <> coaster.constrained
  then coaster.setconstrained(constrainedbox.checked);
end;

{************************ CoundBoxClick *************}
procedure TForm1.SoundboxClick(Sender: TObject);
{set sound options}
begin
  coaster.playrunsounds:=Runsoundbox.checked;
  coaster.playfallsounds:=Fallsoundbox.checked
end;

{***************** VrFEdtExit ***************}
procedure TForm1.VredtExit(Sender: TObject);
var
  newx,newy:float;
  newcxmax,newcymax:float;
begin
  with coaster do
  if sender=VRXEdt then
  begin
    newx:=Strtofloat(VRXEdt.text);
    if aspectbox.checked
    then newy:=newx/(cxmax-cxmin)*(cymax-cymin)
    else newy:=cymax-cymin;
    newcxmax:=cxmin+newx;
    newcymax:=cymin+newy;
    VRYEdt.text:=format('%5.2f',[newy]);
  end
  else
  if sender=VRYEdt then
  begin
    newy:=Strtofloat(VRyEdt.text);
    if aspectbox.checked
    then newx:=newy/(cymax-cymin)*(cxmax-cxmin)
    else newx:=cxmax-cxmin;
    newcxmax:=cxmin+newx;
    newcymax:=cymin+newy;
    VRXEdt.text:=format('%5.2f',[newx]);
  end;

  with coaster do
  rescale(cxmin,newcxmax,cymin, newcymax,
             xmin,xmax,ymin,ymax);
end;

{*******************VRFEditKeyPress *****************}
procedure TForm1.VredtKeyPress(Sender: TObject; var Key: Char);
begin
  if key=#13 then
  begin
    VredtExit(Sender);
    key:=#00;
  end
  else if not (key in ['0'..'9','.']) then
  begin
   key:=#00;
   messagebeep(MB_ICONEXCLAMATION);
  end;
end;

{********************* TimescaleUDExit *************}
procedure TForm1.TimeScaleEdtChange(Sender: TObject);
begin
  if assigned(coaster) then coaster.Settimescale(TimeScaleUD.position);
end;

{********************XYFirstEdtChange *******************}
procedure TForm1.XYFirstEdtChange(Sender: TObject);
{Check and change coaster starting point}
var
  i:integer;
  dx,dy:float;
  vertex:TVertex;
begin
    if not assigned(coaster) then exit;
    vertex:=coaster.bspline.vertexnr(1);
    dx:=XFirstUD.position*(coaster.width)/100-vertex.x;
    dy:=((100-YFirstUD.position)*(coaster.height))/100-vertex.y;

    with coaster do
    if (xmin+dx>=0) and (xmax+dx<=width) and (ymin+dy>=0) and (ymax+dy<=height)
    then
    begin
      xmin:=xmin+dx;
      xmax:=xmax+dx;
      ymin:=ymin-dy;
      ymax:=ymax-dy;

      for i:=1 to bspline.numberofvertices do
      begin
        vertex:=bspline.vertexnr(i);
        vertex.x:=vertex.x+dx;
        vertex.y:=vertex.y+dy;
        bspline.changevertex(i,vertex.x,vertex.y);
      end;
      resetbtnclick(sender)
    end
    else messagebeep(MB_ICONEXCLAMATION);
 end;

{******************** SkylineUDClick *******************}
procedure TForm1.SkylineUDClick(Sender: TObject; Button: TUDBtnType);
{change skyline}
begin
  Coaster.YSkyline:=round(coaster.height*(SkylineUD.position)/100);
  coaster.invalidate;
end;

{********************* XYFirstUDChangingEx **************}
procedure TForm1.XYFirstUDChangingEx(Sender: TObject;
  var AllowChange: Boolean; NewValue: Smallint;
  Direction: TUpDownDirection);
{Check if start point change is valid}
var
  n:integer;
  d:float;
  vertex:TVertex;
begin
  allowchange:=false;
  vertex:=coaster.bspline.vertexnr(1);
  n:=newvalue;
  with coaster do
  if Sender=XfirstUD then
  begin
    d:=n*width/100-vertex.x;
    if (xmin+d>=0) and (xmax+d<=width)
    then allowchange:=true;
  end
  else if Sender=YFirstUD then
  begin
    d:=-((100-n)*height/100-vertex.y);
    if (ymin+d>=0) and (ymax+d<=height)
    then allowchange:=true;
  end ;
  if not allowchange then beep;
end;

procedure TForm1.NbrCartsUDClick(Sender: TObject; Button: TUDBtnType);
{Set nbr of carts in cart train}
begin
  coaster.nbrcarts:=NbrCartsUD.position;
end;

procedure TForm1.FormPaint(Sender: TObject);
{form will draw automaically handle all painting except for the coaster paintbox -
 call to coaster paint ensures that coaster image is redrawn when necessary}
begin  coaster.paintall(sender); end;

procedure TForm1.GravityEdtKeyPress(Sender: TObject; var Key: Char);
{make sure only valid numbers are entered}
begin
  if key=#13 then
  begin
    GravityEdtExit(sender);
    key:=#00;
  end
  else If not (key in['0'..'9','.']) then
  begin
    key:=#00;
    messagebeep(MB_ICONEXCLAMATION);
  end
end;

procedure TForm1.PosLblBoxClick(Sender: TObject);
{display mouse position in virtual world coordinates when over coaster }
begin  coaster.poslbl.visible:=PosLblBox.checked;  end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  coaster.imagecopy.savetofile('coaster.bmp');
end;

procedure TForm1.FormResize(Sender: TObject);
begin
  pagecontrol.top:=clientheight-statusbar2.height-pagecontrol.height;
  with panel2 do
  begin
    top:= pagecontrol.top;
    left:=self.clientwidth-width;
  end;

  with image1 do
  begin
    height:=pagecontrol.top -10;
    width:=self.clientwidth;
  end;

  if coaster<>nil then
  begin
    loaddisplaysfromcoaster;
    {resetbtnclick(sender);}
  end;
end;

procedure TForm1.trackScaleBtnClick(Sender: TObject);
var n:float;
begin
  if coaster<>nil then
  with coaster do
  begin
    n:=trackscaleud.position/100;
    rescale(cxmin,cxmax,cymin,cymax,
            xmin,xmin+(xmax-xmin)*n,
            ymin,ymin+(ymax-ymin)*n);
    resetbtnclick(sender);
    trackscaleud.position:=100;
  end;
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
  resetbtnclick(sender);
end;

end.


Selamat mencoba ^_^
READMORE
 

Membuat Form Properties Text

seperti yang kita tau, sebuah text di dalam sebuah program word processor mempunyai properti yang kita bisa atur semau kita.. apakan ukurannya, tebal tipisnya maupun warnanya. kali ini kita buat simulasi properti text dengan delphi 7.

pertama buat form seperti di bawah :




kedua, ketikan code pada listing code hingga seperti berikut :

private
    { Private declarations }
  public
    { Public declarations }
  end;
var
  Form1: TForm1;
implementation
{$R *.dfm}
procedure TForm1.FormCreate(Sender: TObject);
begin
  nonaktif;
  bersih;
combobox1.Items:=screen.Fonts;
  combobox1.Text:='-PILIH FONTS-';
  combobox2.Text:='-PILIH SIZE-';
  combobox3.Text:='-PILIH BACK COLOR-';
  combobox4.Text:='-PILIH STYLE-';
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
memo1.Text:=uppercase(Edit1.Text);
end;
procedure TForm1.Button2Click(Sender: TObject);
begin
memo1.Text:=lowercase(Edit1.Text);
end;
procedure TForm1.ComboBox1Change(Sender: TObject);
begin
memo1.Font.Name:=combobox1.Text;
end;
procedure TForm1.ComboBox2Change(Sender: TObject);
begin
memo1.Font.Size:=strtoint(combobox2.Text);
end;
procedure TForm1.ComboBox3Change(Sender: TObject);
begin
if combobox3.Text='Merah' then
  memo1.Color:=clred
  else if combobox3.Text='Biru' then
  memo1.Color:=clblue
  else memo1.Color:=clgreen;
end;
procedure TForm1.ComboBox4Change(Sender: TObject);
begin
if combobox4.Text='Bold' then
  memo1.Font.Style:=memo1.Font.Style+[fsBold]
  else if combobox4.Text='Italic' then
  memo1.Font.Style:=memo1.Font.Style+[fsItalic]
  else if combobox4.Text='Underline' then
  memo1.Font.Style:=memo1.Font.Style+[fsUnderline]
  else if combobox4.Text='StrikeOut' then
  memo1.Font.Style:=memo1.Font.Style+[fsStrikeOut]
  else
  memo1.Font.Style:=memo1.Font.Style-[fsBold,fsItalic,fsUnderline,fsStrikeOut];
end;
procedure TForm1.RadioButton1Click(Sender: TObject);
begin
memo1.Font.Color:=clred;
end;
procedure TForm1.RadioButton2Click(Sender: TObject);
begin
  memo1.Font.Color:=clgreen;
end;
procedure TForm1.RadioButton3Click(Sender: TObject);
begin
memo1.Font.Color:=clyellow;
end;
procedure TForm1.RadioButton4Click(Sender: TObject);
begin
memo1.Font.Color:=clpurple;
end;
procedure TForm1.RadioButton5Click(Sender: TObject);
begin
memo1.Font.Color:=clblack;
end;
procedure TForm1.RadioButton6Click(Sender: TObject);
begin
memo1.Font.Color:=clblue;
end;
tton5Click(Sender: TObject);
begin
application.Terminate;
end;
end.
READMORE
 

Membuat Game Tangkep Pocong dengan Delphi 7

untuk membuat "Game Tangkep Pocong" ini kita membutuhkan beberapa item. yaitu :

1. gambar si pocong (tentunya)
2. sebuah label (caption : SCORE)
3. 2 buah tombol (tombol Start dan tombol stop)

ok, kita mulai saja.

Pertama, desain form hingga membentuk seperti ini


Kedua, masukan kode dibawah :

unit UPocong;

interface

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

type
  TForm1 = class(TForm)
    Label1: TLabel;
    Edit1: TEdit;
    Button1: TButton;
    Button2: TButton;
    Image1: TImage;
    Image2: TImage;
    Image3: TImage;
    Image4: TImage;
    Timer1: TTimer;
    procedure FormCreate(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
  private
    { Private declarations }
  public
     procedure aktif;            //procedure bila sedang aktif
    procedure nonaktif;      //procedure bila sedang tidak aktif
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation


{$R *.dfm}
 procedure tform1.aktif;
begin
Image1.enabled:=True;
Image2.enabled:=True;
Image3.enabled:=True;
Image4.enabled:=True;
Edit1.Enabled:=True;
Button2.enabled:=True;
Image4.Visible:=True;
Timer1.Enabled:=True;
end;

procedure tform1.nonaktif;
begin
Image1.enabled:=false;
Image2.enabled:=false;
Image3.enabled:=false;
Image4.enabled:=false;
Edit1.Enabled:=false;
Button2.enabled:=false;
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
nonaktif;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
aktif;
end;

procedure TForm1.Image1MouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
begin
Image1.left:=Random(Left);
Image1.Top:=Random(top);
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
close;
end;

procedure TForm1.Image2MouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
begin
Image2.left:=Random(Left);
Image2.Top:=Random(top);
end;

procedure TForm1.Image3MouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
begin
Image3.left:=Random(Left);
Image3.Top:=Random(top);
end;

procedure TForm1.Image4MouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
begin
Image4.left:=Random(Left);
Image4.Top:=Random(top);
end;

procedure TForm1.Image1Click(Sender: TObject);
begin
Image1.Visible:=False;
Edit1.text:=IntToStr(strtoint(Edit1.text)+20);
end;

procedure TForm1.Image2Click(Sender: TObject);
begin
Image2.Visible:=False;
Edit1.text:=IntToStr(strtoint(Edit1.text)+20);
end;

procedure TForm1.Image3Click(Sender: TObject);
begin
Image3.Visible:=False;
Edit1.text:=IntToStr(strtoint(Edit1.text)+20);
end;

procedure TForm1.Image4Click(Sender: TObject);
begin
Image4.Visible:=False;
Edit1.text:=IntToStr(strtoint(Edit1.text)+20);
end;

procedure TForm1.Edit1Change(Sender: TObject);
begin
if Edit1.Text='100' then
begin
  nonaktif;
  ShowMessage('anda menang');
end
end;

procedure TForm1.Timer1Timer(Sender: TObject);
begin
aktif;
ShowMessage('Game Over');
end;
end.

dan TARAAAA....!! jadi deh....
kalo masih error... silahkan posting aja disini... nanti tak benerin lagi... hehe
READMORE
 

install ubuntu step by step



Ubuntu 9.04 Jaunty Jackalope adalah versi stabil terbaru keluaran Ubuntu. Tulisan ini untuk membantu para pemula yang akan bermigrasi atau mencoba menggunakan Ubuntu karena sistem operasi lain yang saat ini sedang panas-panasnya diserang virus, sehingga banyak orang yang mencoba melirik untuk menyelesaiakan permsalahan menjengkelkan ini ke Program-program openssource yang tidak kalah handalnya. Dan tulisan ini saya terjemahkan dari tulisan Step by Step Ubuntu 9.04 (Jaunty) Desktop Instalation Guide. Semoga bisa berguna dan mudah dipahami karena dibahas langkah demi langkah dan juga bisa dilakukan pula untuk mesin laptop dan sebagainya.

Pertama jika belum memiliki CD nya silahkan download dahulu ubuntu jaunty .iso image di sini Setelah memiliki file .iso image maka anda perlu untuk membuata bootable CD dari file tersebut untuk booting mesin komputer anda. Bisa dilakukan dengan program pembakar CD di komputer lain.

Pertama setelah booting akan muncul gambar seperti ini (bisa juga ketika melalui Live CD), pilih bahasa kemudian tekan enter.
Pilih “Install Ubuntu” kemudian enter

Step by Step Ubuntu 9.04 (Jaunty Jackalope) Desktop installation guide untuk pemula

Posted by suryaden on Aug 20, 2009 in Ubuntu24 comments

Ubuntu 9.04 Jaunty Jackalope adalah versi stabil terbaru keluaran Ubuntu. Tulisan ini untuk membantu para pemula yang akan bermigrasi atau mencoba menggunakan Ubuntu karena sistem operasi lain yang saat ini sedang panas-panasnya diserang virus, sehingga banyak orang yang mencoba melirik untuk menyelesaiakan permsalahan menjengkelkan ini ke Program-program openssource yang tidak kalah handalnya. Dan tulisan ini saya terjemahkan dari tulisan Step by Step Ubuntu 9.04 (Jaunty) Desktop Instalation Guide. Semoga bisa berguna dan mudah dipahami karena dibahas langkah demi langkah dan juga bisa dilakukan pula untuk mesin laptop dan sebagainya.

Pertama jika belum memiliki CD nya silahkan download dahulu ubuntu jaunty .iso image di sini Setelah memiliki file .iso image maka anda perlu untuk membuata bootable CD dari file tersebut untuk booting mesin komputer anda. Bisa dilakukan dengan program pembakar CD di komputer lain.

Pertama setelah booting akan muncul gambar seperti ini (bisa juga ketika melalui Live CD), pilih bahasa kemudian tekan enter.

Pilih “Install Ubuntu” kemudian enter

Installasi Ubuntu proses loading….

Kemudian pilih bahas installasi, kemudian tekan Forward.

Pilih negara dan propinsi, dalam contoh ini memilih Eropa dan kota London, kemudian tekan Forward, atau maju…

Pilih Keyboard biasanya kalo di Indonesia memakai US Internasional…, tapi dalam contoh memakai Inggris UK, tekan Forward…

Kemudian akan terlihat ruangan dalam hardisk, pilih untuk membuat partisi baru jika belum ada, atau jika dual boot…

Dalam contoh ini memakai VMware, dan menggunakan 8 GB ruang Hardisk…, Untuk Ubuntu ini memakai minimal 6 GB agar lebih aman biasanya…

Juga pastikan membuat partisi untuk Swap minimal setengah Giga bytes.

Selanjutnya isikan nama Username, dan apakah mau login otomatis atau tidak, pilih sesukanya…

Jika paswword anda kurang kuat atau mudah ditebak maka akan muncul tampilan seperti ini

Akan muncul list installasi, kemudian jika sudah yakin maka tekan Install…


belon selese

http://solvewithit.com/2009/08/20/step-by-step-ubuntu-9-04-jaunty-jackalope-desktop-installation-guide%C2%A0untuk-pemula/

READMORE
 

By Request:Membuat Foto Wedding ( Menggabungkan 2 gambar)


Dengan komputer seadanya yang Lemot dan koneksi internet yang lemot juga..saya bikin tutorial ini :(. Terus terang biasanya saya buat tutorial itu di kantor ( Luar jam kerja Tentunya ) dengan komputer yang cepetnya lumayan mantep.. makanya saya males bikin tutorial kalo dirumah.. abis lemot sih.. :D .. Loh kok malah curhat ? *!^$!^!^(


Tutorial ini by request yang diminta seorang temen (pengunjung web ilmuphotoshop.com ini juga). Gambar yang dikirim :


Gambar Pertamax :


wedding1


Gambar kedua :


wedding2


hasilnya mau kayak gini :


wedding10


Cara buat nya :


buka kedua gambar yang masih mentah di atas ..


Kita edit gambar pengantennya :


Seleksi yang warna putih nya dengan Magic wand Tool


kan ada seleksi yang masuk ke dalem tuh.. kita seleksi ulang dalem nya ( yang kena seleksi ) dengan direct selection tool. sambil menekan tombol ALT.. sekarang tampilannya seperti ini :


wedding3


Klik Select > Feather untuk memperhalus seleksi.


wedding4


lalu klik Select > inverse sehingga sekarang yang terseleksi adalah gambar orang nya.


Kita drag (tarik sambil menekan mouse) gambar orang ke gambar bunga..


wedding5


Nanti hasilnya gini :


wedding6


Sekarang atur deh foto nya.. lalu klik kanan Blending OPTION layer 1 atau layer gambar orang , lalu setting seperti ini:


wedding7


Sekarang Klik Eraser tool lalu Klik kanan di layar gambar maka keluar


wedding8


Hardness nya yang gede yaa , sekitar 300 -600 an.


Hapus bagian bawah dan samping layer 1


wedding9


Hasilnya :


wedding10


Selamat Mencobaa…


Fiuuuhhh…







Artikel By Request:Membuat Foto Wedding ( Menggabungkan 2 gambar) ini dipersembahkan oleh Tutorial Photoshop Gratis. Kunjungi Wallpaper, Font, Desktop Theme Gratis Pokoknya Serba Gratis. Baca Juga Kenali dan Kunjungi Objek Wisata di Pandeglang, untuk mengetahui lebih jauh tentang Pandeglang sebagai Objek Wisata yang patut diperhitungkan karena keindahannya.

READMORE