Gradasi Warna dan Animasi sederhana

Pernah bermain-main dengan Color dan Canvas ? .. ya, tidak sulit. Berikut ini adalah contoh sederhana dari penggunaan Color, Canvas, StretchDraw, dan gradasi warna

gradasi1 Gambar disamping adalah contoh gradasi dua buah warna (hitam dan merah) yang prosesnya dilakukan pada dua buah buffer Bitmap. Gradasi hitam dengan merah dilakukan pada sebuah buffer bitmap dan gradasi merah dengan hitam (kebalikan yang pertama) dilakukan pada buffer bitmap sisanya, kemudian kedua buffer bitmap tersebut digambarkan ke Canvas. Terlihat bahwa gradasinya muncul di tengah warna hitam.

Untuk membuat warna merah tersebut bergerak kekiri dan kekanan kita bisa menggunakan StretchDraw yang intervalnya dapat dapat dilakukan dengan mudah menggunakan komponen Timer.

Unit1.pas

unit Unit1;

interface

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

type
  TForm1 = class(TForm)
    Button1: TButton;
    Timer1: TTimer;
    Panel1: TPanel;
    Image1: TImage;
    procedure Button1Click(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure FormClose(Sender: TObject;
                 var Action: TCloseAction);
  private
    { Private declarations }
    bmL, bmR: TBitmap;
    LR, LL: Integer;
    blast: Boolean;
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.DFM}

procedure TForm1.FormCreate(Sender: TObject);
begin
  bmL:= TBitmap.Create;
  bmR:= TBitmap.Create;
  LR:= -1;
end;

procedure TForm1.FormClose(Sender: TObject;
               var Action: TCloseAction);
begin
  bmL.Free;
  bmR.Free;
end;

Procedure Grad2Warna(kiri, kanan: TColor; canvas: TCanvas);
Var
  c, x, y: Integer;
  step: Integer;
  warna: TColor;
Begin
  c:= (Canvas.ClipRect.Right + 1) - Canvas.ClipRect.Left;
  For x:= 0 To c - 1 Do
  Begin
    step:= MulDiv(255, x, c);

    warna:= RGB(
      GetRValue(kiri) +
      MulDiv(step, GetRValue(kanan) -
      GetRValue(kiri), 255),
      GetGValue(kiri) +
      MulDiv(step, GetGValue(kanan) -
      GetGValue(kiri), 255),
      GetBValue(kiri) +
      MulDiv(step, GetBValue(kanan) -
      GetBValue(kiri), 255));

    For y:= Canvas.ClipRect.Top To Canvas.ClipRect.Bottom Do
      Canvas.Pixels[Canvas.ClipRect.Left + x, y]:= warna;
  End;
End;

procedure TForm1.Button1Click(Sender: TObject);
Var
  RLR, RLL: TRect;
begin
  Timer1.Enabled:= Not Timer1.Enabled;
  If (Not Timer1.Enabled) Or (LR >= 0) Then Exit;

  bmL.Width:= ((Image1.Canvas.ClipRect.Right + 1) -
         Image1.Canvas.ClipRect.Left) Div 2;
  bmL.Height:= (Image1.Canvas.ClipRect.Bottom + 1) -
         Image1.Canvas.ClipRect.Top;
  bmR.Width:= bmL.Width;
  bmR.Height:= bmL.Height;

  Grad2Warna(clBlack, clRed, bmL.Canvas);
  Grad2Warna(clRed, clBlack, bmR.Canvas);

  LR:= bmL.Width;
  LL:= LR;
  RLL:= Image1.Canvas.ClipRect;
  RLR:= Image1.Canvas.ClipRect;

  RLL.Right:= LR;
  RLR.Left:= LL;
  Image1.Canvas.StretchDraw(RLL, bmL);
  Image1.Canvas.StretchDraw(RLR, bmR);
end;

procedure TForm1.Timer1Timer(Sender: TObject);
Var
  RLR, RLL: TRect;
begin
  If LR <= 0 Then
    blast:= False
  Else If LR >= bmL.Width Then
    blast:= True;
  If blast Then
  Begin
    Dec(LR);
    Inc(LL);
  End
  Else
  Begin
    Inc(LR);
    Dec(LL);
  End;

  RLL:= Image1.Canvas.ClipRect;
  RLR:= Image1.Canvas.ClipRect;

  RLL.Right:= LR;
  RLR.Left:= LL;

  Image1.Canvas.StretchDraw(RLL, bmL);
  Image1.Canvas.StretchDraw(RLR, bmR);
end;

end.
Syntax Highlighted with http://delphi-id.org/syntax

Unit1.dfm

object Form1: TForm1
  Left = 192
  Top = 107
  BorderIcons = [biSystemMenu, biMinimize]
  BorderStyle = bsSingle
  Caption = 'Gradasi / Animasi'
  ClientHeight = 119
  ClientWidth = 271
  Color = clBtnFace
  Font.Charset = DEFAULT_CHARSET
  Font.Color = clWindowText
  Font.Height = -11
  Font.Name = 'MS Sans Serif'
  Font.Style = []
  OldCreateOrder = False
  Position = poDesktopCenter
  OnClose = FormClose
  OnCreate = FormCreate
  PixelsPerInch = 96
  TextHeight = 13
  object Button1: TButton
    Left = 15
    Top = 78
    Width = 238
    Height = 25
    Caption = 'Start / Stop'
    Font.Charset = DEFAULT_CHARSET
    Font.Color = clWindowText
    Font.Height = -11
    Font.Name = 'Arial'
    Font.Style = [fsBold]
    ParentFont = False
    TabOrder = 0
    OnClick = Button1Click
  end
  object Panel1: TPanel
    Left = 15
    Top = 15
    Width = 238
    Height = 55
    BevelOuter = bvNone
    BorderStyle = bsSingle
    TabOrder = 1
    object Image1: TImage
      Left = 0
      Top = 0
      Width = 234
      Height = 51
      Align = alClient
    end
  end
  object Timer1: TTimer
    Enabled = False
    Interval = 10
    OnTimer = Timer1Timer
    Left = 216
    Top = 24
  end
end
Syntax Highlighted with http://delphi-id.org/syntax

gradasi2 Gambar disamping adalah variasi lainnya, yang dapat bergerak juga seperti wiper yang buat ngelap-ngelap kaca mobil dikala hujan itu lohh.. :)

Buffer yang digunakan juga masih sama dengan contoh pada gambar diatas, tetapi pada contoh ini ada penambahan bagian StretchDraw di bagian tengah, tentu dengan step yang sama dengan bagian yang bergerak kekiri dan kekanan. Jadi intinya buffer tersebut hanya digambar berulang kali saja ;)

Unit1.pas

unit Unit1;

interface

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

type
  TForm1 = class(TForm)
    Button1: TButton;
    Timer1: TTimer;
    Panel1: TPanel;
    Image1: TImage;
    procedure Button1Click(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure FormClose(Sender: TObject;
                var Action: TCloseAction);
  private
    { Private declarations }
    bmL, bmR: TBitmap;
    LR, LL: Integer;
    blast: Boolean;
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.DFM}

procedure TForm1.FormCreate(Sender: TObject);
begin
  bmL:= TBitmap.Create;
  bmR:= TBitmap.Create;
  LR:= -1;
end;

procedure TForm1.FormClose(Sender: TObject;
               var Action: TCloseAction);
begin
  bmL.Free;
  bmR.Free;
end;

Procedure Grad2Warna(kiri, kanan: TColor; canvas: TCanvas);
Var
  c, x, y: Integer;
  step: Integer;
  warna: TColor;
Begin
  c:= (Canvas.ClipRect.Right + 1) - Canvas.ClipRect.Left;
  For x:= 0 To c - 1 Do
  Begin
    step:= MulDiv(255, x, c);

    warna:= RGB(
      GetRValue(kiri) +
      MulDiv(step, GetRValue(kanan) -
      GetRValue(kiri), 255),
      GetGValue(kiri) +
      MulDiv(step, GetGValue(kanan) -
      GetGValue(kiri), 255),
      GetBValue(kiri) +
      MulDiv(step, GetBValue(kanan) -
      GetBValue(kiri), 255));

    For y:= Canvas.ClipRect.Top To Canvas.ClipRect.Bottom Do
      Canvas.Pixels[Canvas.ClipRect.Left + x, y]:= warna;
  End;
End;

procedure TForm1.Button1Click(Sender: TObject);
Var
  RLR, RLL: TRect;
begin
  Timer1.Enabled:= Not Timer1.Enabled;
  If (Not Timer1.Enabled) Or (LR >= 0) Then Exit;

  bmL.Width:= ((Image1.Canvas.ClipRect.Right + 1) -
         Image1.Canvas.ClipRect.Left) Div 2;
  bmL.Height:= (Image1.Canvas.ClipRect.Bottom + 1) -
         Image1.Canvas.ClipRect.Top;
  bmR.Width:= bmL.Width;
  bmR.Height:= bmL.Height;

  Grad2Warna(clBlack, clRed, bmL.Canvas);
  Grad2Warna(clRed, clBlack, bmR.Canvas);

  LR:= bmL.Width;
  LL:= LR;
  RLL:= Image1.Canvas.ClipRect;
  RLR:= Image1.Canvas.ClipRect;

  RLL.Right:= LR;
  RLR.Left:= LL;
  Image1.Canvas.StretchDraw(RLL, bmL);
  Image1.Canvas.StretchDraw(RLR, bmR);
end;

procedure TForm1.Timer1Timer(Sender: TObject);
Var
  RLR, RLL: TRect;
  MLR, MLL: TRect;
begin
  If LR <= 0 Then
    blast:= False
  Else If LR >= bmL.Width Then
    blast:= True;
  If blast Then
  Begin
    Dec(LR);
    Inc(LL);
  End
  Else
  Begin
    Inc(LR);
    Dec(LL);
  End;

  RLL:= Image1.Canvas.ClipRect;
  RLR:= Image1.Canvas.ClipRect;

  MLL:= Image1.Canvas.ClipRect;
  MLR:= Image1.Canvas.ClipRect;

  RLL.Right:= LR;
  RLR.Left:= LL;

  Image1.Canvas.StretchDraw(RLL, bmL);
  Image1.Canvas.StretchDraw(RLR, bmR);

  { **** new **** }

  MLL.Left:= LR;
  MLL.Right:= bmL.Width;
  MLR.Right:= LL;
  MLR.Left:= bmL.Width;

  Image1.Canvas.StretchDraw(MLL, bmR);
  Image1.Canvas.StretchDraw(MLR, bmL);
end;

end.
Syntax Highlighted with http://delphi-id.org/syntax

Unit1.dfm

object Form1: TForm1
  Left = 192
  Top = 107
  BorderIcons = [biSystemMenu, biMinimize]
  BorderStyle = bsSingle
  Caption = 'Gradasi / Animasi'
  ClientHeight = 119
  ClientWidth = 271
  Color = clBtnFace
  Font.Charset = DEFAULT_CHARSET
  Font.Color = clWindowText
  Font.Height = -11
  Font.Name = 'MS Sans Serif'
  Font.Style = []
  OldCreateOrder = False
  Position = poDesktopCenter
  OnClose = FormClose
  OnCreate = FormCreate
  PixelsPerInch = 96
  TextHeight = 13
  object Button1: TButton
    Left = 15
    Top = 78
    Width = 238
    Height = 25
    Caption = 'Start / Stop'
    Font.Charset = DEFAULT_CHARSET
    Font.Color = clWindowText
    Font.Height = -11
    Font.Name = 'Arial'
    Font.Style = [fsBold]
    ParentFont = False
    TabOrder = 0
    OnClick = Button1Click
  end
  object Panel1: TPanel
    Left = 15
    Top = 15
    Width = 238
    Height = 55
    BevelOuter = bvNone
    BorderStyle = bsSingle
    TabOrder = 1
    object Image1: TImage
      Left = 0
      Top = 0
      Width = 234
      Height = 51
      Align = alClient
    end
  end
  object Timer1: TTimer
    Enabled = False
    Interval = 10
    OnTimer = Timer1Timer
    Left = 216
    Top = 24
  end
end
Syntax Highlighted with http://delphi-id.org/syntax
About these ads

3 Responses to “Gradasi Warna dan Animasi sederhana”

  1. M Nizar Maulana Says:

    kalo bisa perbanyak dong syntax animasi delphinya…………..!

  2. saiia Says:

    kurang lengkap niiiiiiiiiiiiiiiiiihhhhhhhhhhhhhhhhhh

  3. kangmahfudz Says:

    gak faham mas.

Leave a Reply

Fill in your details below or click an icon to log in:

WordPress.com Logo

You are commenting using your WordPress.com account. Log Out / Change )

Twitter picture

You are commenting using your Twitter account. Log Out / Change )

Facebook photo

You are commenting using your Facebook account. Log Out / Change )

Google+ photo

You are commenting using your Google+ account. Log Out / Change )

Connecting to %s


Follow

Get every new post delivered to your Inbox.

%d bloggers like this: