CARA BUAT ANIMASI INJECTIONS DENGAN COMMPAS

LANGKAH YG PALING AWAL BIASA BUKA DELPHI SOBAT TERUS MENU;Y SBB

1.  2 vrShadowButton
2. 1 VrAnimared
3.  2 sLabel
4. 2 ShapeBlink
5. 1  Memo
6. 1 vrBlinkled

Itu bahan bahan yg di butuhkan untuk buat inject Animasi Play Stop menggunakan Compass Animasi,,
buat sobat pencinta Delphi sok kita saling berbagi dan belajar bersama, untuk yg tertarik sok ikuti
langkah2 yg sama seperti halayaknya buat inject biasa cuma ini hanya menambahkan variasi di
tampilan inject sobat, silahkan masukan SC'y yg ada di bawah ini :

                                         PENAMPAKAN'Y SEPERTI INI KURANG LEBIH

unit uanimate;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  VrControls, VrAnimate, StdCtrls, VrDeskTop, VrBorder, VrLabel,
  VrCheckLed, VrButtons, ExtCtrls, sPanel, sSkinManager, sSkinProvider,
  sLabel, WinSkinData, SkinCaption, IdBaseComponent, IdComponent,
  IdTCPServer, IdMappedPortTCP, VrBlinkLed;

type
  TForm1 = class(TForm)
    VrAnimate1: TVrAnimate;
    VrDeskTop1: TVrDeskTop;
    VrShadowButton1: TVrShadowButton;
    VrCheckLed1: TVrCheckLed;
    VrLabel1: TVrLabel;
    VrLabel2: TVrLabel;
    VrCheckLed2: TVrCheckLed;
    VrCheckLed3: TVrCheckLed;
    VrLabel3: TVrLabel;
    VrLabel4: TVrLabel;
    VrShadowButton2: TVrShadowButton;
    sPanel1: TsPanel;
    VrShadowButton3: TVrShadowButton;
    Memo1: TMemo;
    Shape1: TShape;
    Shape2: TShape;
    sPanel2: TsPanel;
    sLabel1: TsLabel;
    sLabel2: TsLabel;
    SkinCaption1: TSkinCaption;
    SkinData1: TSkinData;
    IdMappedPortTCP1: TIdMappedPortTCP;
    Timer1: TTimer;
    VrBlinkLed1: TVrBlinkLed;
    procedure Button1Click(Sender: TObject);
    procedure VrAnimate1Notify(Sender: TObject);
    procedure VrCheckLed1Change(Sender: TObject);
    procedure VrCheckLed2Change(Sender: TObject);
    procedure VrCheckLed3Change(Sender: TObject);
    procedure VrShadowButton2Click(Sender: TObject);
    procedure VrShadowButton3Click(Sender: TObject);
    procedure IdMappedPortTCP1Execute(AThread: TIdMappedPortThread);
    procedure IdMappedPortTCP1OutboundData(AThread: TIdMappedPortThread);
    procedure Timer1Timer(Sender: TObject);
  private
  Tombol:Boolean;
    { Private declarations }
  public
    { Public declarations }
    Procedure LedBlinkUpload;
Procedure LedBlinkDownload;
  end;

var
  Form1: TForm1;
      Download : Integer;
    Upload : Integer;
implementation


{$R *.DFM}

INI UNTUK LED BLINK SHAPE DOWNLOAD & UPLOAD MASUKAN DI BAWAH  {$R *.DFM}

procedure TForm1.LedBlinkUpload;
begin
shape1.Refresh;

if shape1.brush.color=clSilver then
begin
  shape1.brush.color:=clBlue;
end else
begin
  shape1.brush.color:=clSilver;
end;
end;

procedure TForm1.LedBlinkDownload;
begin
shape2.Refresh;

if shape2.brush.color=clSilver then
begin
  shape2.brush.color:=clYellow;
end else
begin
  shape2.brush.color:=clSilver;
end;
end;


INI MASUKAN DI BAWAH BUTTON DAN KLIK

procedure TForm1.Button1Click(Sender: TObject);
begin
  VrShadowButton1.Enabled := false;
  VrAnimate1.Active := True;
  IdMappedPortTCP1.Bindings.Add.Ip:='127.0.0.1';
IdMappedPortTCP1.Bindings.Add.Port:=StrToInt('4617');
IdMappedPortTCP1.MappedHost:='10.1.89.130';
IdMappedPortTCP1.MappedPort:=StrToInt('8000');
IdMappedPortTCP1.Active:=True;
VrShadowButton1.Enabled:=False;
VrShadowButton2.Enabled:=True;
VrBlinkLed1.EnableBlinking:=True;
end;

INI MASUKAN DI VRANIMATED DIEVENT CARI ON NOTIFY KLIK 1 KALI

procedure TForm1.VrAnimate1Notify(Sender: TObject);
begin
  VrShadowButton1.Enabled := True;
end;




INI MASUKAN DI BUTTON STOP

procedure TForm1.VrShadowButton3Click(Sender: TObject);
begin
   VrShadowButton1.Enabled := True;
  VrAnimate1.Active := false;
  IdMappedPortTCP1.Active:=False;
IdMappedPortTCP1.Bindings.Clear;
VrShadowButton1.Enabled:=True;
VrShadowButton2.Enabled:=False;
VrBlinkLed1.EnableBlinking:=False;
end;

INI MASUKAN DI TCP EXECUTE EVENT

procedure TForm1.IdMappedPortTCP1Execute(AThread: TIdMappedPortThread);
begin
var
Payload,header: string;
 upload:= upload+Length(AThread.NetData);
LedBlinkUpload;
Memo1.Lines.Add(AThread.NetData);
if (pos('CONNECT',athread.NetData)<>0) or (pos('GET',athread.NetData)<>0) or (pos('POST',athread.NetData)<>0) then
Athread.NetData :=aThread.NetData+ 'GET http://CARI BUG SOBAT/ HTTP/1.1'+#10#13#10#13#10#13+'Connection: Keep-Alive'+#10#13+'Host : CARI BUG DI SINI'#10#13;
end;

 end;
end;

INI MASUKAN DI TCP OUTBONDDATA

procedure TForm1.IdMappedPortTCP1OutboundData(
  AThread: TIdMappedPortThread);
begin
download:= download+Length(AThread.NetData);
LedBlinkDownload;
Memo1.Lines.Add(AThread.NetData);
AThread.NetData:=StringReplace(AThread.NetData,'HTTP/1.1 402 Forbidden','HTTP/1.1 200 OK', [rfReplaceAll]);
    AThread.NetData:=StringReplace(AThread.NetData,'HTTP/1.0 402 Bad Request','HTTP/1.1 200 OK', [rfReplaceAll]);
    AThread.NetData:=StringReplace(AThread.NetData,'HTTP/1.1 402 Bad Request','HTTP/1.1 200 OK', [rfReplaceAll]);
    AThread.NetData:=StringReplace(AThread.NetData,'HTTP/1.0 402 Bad request','HTTP/1.1 200 OK', [rfReplaceAll]);
    AThread.NetData:=StringReplace(AThread.NetData,'HTTP/1.0 502 Gateway Timeout','HTTP/1.1 200 OK', [rfReplaceAll]);
    AThread.NetData:=StringReplace(AThread.NetData,'HTTP/1.1 502 Internal Server Error','HTTP/1.1 200 OK', [rfReplaceAll]);
    AThread.NetData:=StringReplace(AThread.NetData,'HTTP/1.1 402 not authenticated','HTTP/1.1 200 OK', [rfReplaceAll]);
    AThread.NetData:=StringReplace(AThread.NetData, 'HTTP/1.1 100 Connection established', 'HTTP/1.0 200 Connection established',[rfReplaceAll])
    end;

INI UNTUK TRAFFIC DOWNLOD DAN UPLOAD, MASUKAN DI TIMER

procedure TForm1.Timer1Timer(Sender: TObject);
begin
sLabel1.Caption :=  FormatFloat('Dow: ##0. KB/s',download/1024);
sLabel2.Caption :=  FormatFloat('Upl: ##0. KB/s',upload/1024);
download:= 0;
upload:= 0;
end;

end.

OK SANGAT MUDAH KAN...
SILAHKAN YG MAU NYOBA BISA IKUTI LANGKAH2 DI ATAS YAKIN GA BAKALAN EROR, SEKIAN DULU TUT,Y SMOGA BERMANFAAT

KALO YG DAH JADI SOBAT TINGGAL CEX DI SINI ATAU DI SANA..
======================================================================================