RGB Plasma
lazarus / 39-Graphics

----------------------------------------------------------------------
Gigatron · 2025-04-20 06:47

Hi,

After reading again Amiga Copper doc, i tryed to make a rgb Plasma
like the copper + blitter for
sinus control. Merge the copperbars with Bgra Xor blend mode;
This is how obtain 4096 colors on Amiga

The result is not 100% the same as expected , you can try to improve
it :

Code: Pascal  [Select][+][-]window.onload = function(){var x1 =
document.getElementById("main_content_section"); if (x1) { var x =
document.getElementsByClassName("geshi");for (var i = 0; i unit
Unit1; {$mode objfpc}{$H+} interface uses  Classes, SysUtils, Forms,
Controls, Graphics, Dialogs, ExtCtrls, Spin,  StdCtrls,
BGRAVirtualScreen, BGRABitmap, BGRABitmapTypes, Math; type   { TForm1
}   TForm1 = class(TForm)    BGRAVirtualScreen1: TBGRAVirtualScreen; 
 Panel1: TPanel;    Green2_Spin: TSpinEdit;    Blue3_Spin: TSpinEdit; 
  Title_label: TLabel;    Red1_Spin: TSpinEdit;    Timer1: TTimer;   
procedure BGRAVirtualScreen1Redraw(Sender: TObject; Bitmap:
TBGRABitmap);    procedure FormCreate(Sender: TObject);    procedure
Timer1Timer(Sender: TObject);  private   public   end; var  Form1:
TForm1;  LOffset,red1,green2,blue3 : integer;   Line_dir : Integer; 
img : TBGRABitmap;  cnt : single;  YOffset,YOffset2,YOffset3 :
integer;  cop1,cop2,cop3 : TBGRABitmap; implementation {$R
*.lfm} procedure copper_bar(Bitmap: TBGRABitmap; xpos,y: Integer;
baseR, baseG, baseB: Byte);var  i: Integer;  r, g, b: Byte;  y1, y2:
Integer;begin  // couleur on monte madame de 0 à 255!  for i := 0 to
15 do  begin    r := Min(baseR * i div 15, 255);    g := Min(baseG * i
div 15, 255);    b := Min(baseB * i div 15, 255);    y1 := y + i * 2; 
  y2 := y1 + 4;    bitmap.FillRect(xpos, y1*8, xpos+8, y2*16, BGRA(r,
g, b,130), dmSet);  end;   for i := 0 to 14 do  begin    r :=
Max(baseR - (baseR * (i + 1) div 15), 0);    g := Max(baseG - (baseG *
(i + 1) div 15), 0);    b := Max(baseB - (baseB * (i + 1) div 15),
0);    y1 := y + 34 + i * 2;    y2 := y1 + 2;    Bitmap.FillRect(xpos,
y1*8, xpos+8, y2*16, BGRA(r, g, b,130), dmSet);  end;end; procedure
copper_line(Bitmap: TBGRABitmap; y,PosY,Sz: Integer; baseR, baseG,
baseB: Byte);var  i: Integer;  r, g, b: Byte;  x1   : Integer;begin  
// couleur on monte madame de 0 à 255!  for i := 0 to 15 do  begin   
r := Min(baseR * i div 15, 255);    g := Min(baseG * i div 15, 255); 
 b := Min(baseB * i div 15, 255);    x1 := y + i * 2;   
Bitmap.FillRect(x1*8, PosY, Bitmap.Width, PosY+Sz, BGRA(r, g, b),
dmSet);  end;   // milieu ligne  r := baseR;  g := baseG;  b :=
baseB;  x1 := y + 32;  Bitmap.FillRect(x1*8, PosY, Bitmap.Width,
PosY+Sz, BGRA(r, g, b), dmSet);   // couleur on descend  for i := 0 to
14 do  begin    r := Max(baseR - (baseR * (i + 1) div 15), 0);    g :=
Max(baseG - (baseG * (i + 1) div 15), 0);    b := Max(baseB - (baseB *
(i + 1) div 15), 0);    x1 := y + 34 + i * 2;    Bitmap.FillRect(x1*8,
PosY, Bitmap.Width, PosY+Sz, BGRA(r, g, b), dmSet);  end;end; { TForm1
} procedure TForm1.FormCreate(Sender: TObject);begin   cop1 :=
TBGRABitmap.Create(680,520);  cop2 := TBGRABitmap.Create(680,520); 
cop3 := TBGRABitmap.Create(680,520);  cnt := 0; end; procedure
TForm1.BGRAVirtualScreen1Redraw(Sender: TObject; Bitmap:
TBGRABitmap);var  i : Integer;begin     for i:=0 to 182 do    begin  
    YOffset  := Round(Sin((cnt + Time + i) * 0.02) * 10);       
YOffset2 := Round(Sin((cnt + Time - i) * 0.05) * 10);        YOffset3
:= Round(Sin((cnt - Time + i) * 0.07) * 10);         copper_bar(cop1,
i * 4,  YOffset,  red1, 0,0);        copper_bar(cop2, i * 4,
 YOffset2, 0, green2,0);        copper_bar(cop3, i * 4,  YOffset3, 0,
0,blue3);    end;               bitmap.PutImage(0,0,cop1,dmxor);     
        bitmap.PutImage(0,0,cop2,dmxor);             
 bitmap.PutImage(0,0,cop3,dmxor); end; procedure
TForm1.Timer1Timer(Sender: TObject);begin     red1   :=
Red1_Spin.Value;    green2 := Green2_Spin.Value;    blue3  :=
Blue3_Spin.Value;    cnt := cnt + 1.2;    
BGRAVirtualScreen1.RedrawBitmap;end; end.

----------------------------------------------------------------------
Gigatron · 2025-04-20 18:47

Hi,

If we go further, we can make a nice effect like the main demo of
Angels Copper, but just the vertical copper bars in 100 lines of code;

MOVE, WAIT and SKIP,  3 commands doing those fx with amiga !!! 7.14
mhz


https://youtu.be/h3FLdtkToBU?si=0ycoR4s5fpukJqVw&t=100

Code: Pascal  [Select][+][-]window.onload = function(){var x1 =
document.getElementById("main_content_section"); if (x1) { var x =
document.getElementsByClassName("geshi");for (var i = 0; i unit
Unit1; {$mode objfpc}{$H+} interface uses  Classes, SysUtils, Forms,
Controls, Graphics, Dialogs, ExtCtrls, Spin,  StdCtrls,
BGRAVirtualScreen, BGRABitmap, BGRABitmapTypes, Math; type   { TForm1
}   TForm1 = class(TForm)    BGRAVirtualScreen1: TBGRAVirtualScreen; 
 Panel1: TPanel;    Green2_Spin: TSpinEdit;    Blue3_Spin: TSpinEdit; 
  Title_label: TLabel;    Red1_Spin: TSpinEdit;    Timer1: TTimer;   
procedure BGRAVirtualScreen1Redraw(Sender: TObject; Bitmap:
TBGRABitmap);    procedure FormCreate(Sender: TObject);    procedure
Timer1Timer(Sender: TObject);  private   public   end; var  Form1:
TForm1;  red1,green2,blue3 : integer;  cnt : single;  XOffset:
integer; implementation {$R *.lfm} procedure copper_bar(Bitmap:
TBGRABitmap; x, ypos: Integer; baseR, baseG, baseB: Byte);var  i:
Integer;  r, g, b: Byte;  x1, x2: Integer;begin   for i := 0 to 15 do 
begin    r := Min(baseR * i div 15, 255);    g := Min(baseG * i div
15, 255);    b := Min(baseB * i div 15, 255);    x1 := x + i * 2;   
x2 := x1 + 4;    Bitmap.FillRect(x1, ypos, x2 + 2, ypos + 450, BGRA(r,
g, b, 130), dmSet);  end;   for i := 0 to 14 do  begin    r :=
Max(baseR - (baseR * (i + 1) div 15), 0);    g := Max(baseG - (baseG *
(i + 1) div 15), 0);    b := Max(baseB - (baseB * (i + 1) div 15),
0);    x1 := x + 34 + i * 2;    x2 := x1 + 2;    Bitmap.FillRect(x1,
ypos, x2 + 2, ypos + 450, BGRA(r, g, b, 130), dmSet);  end;end; {
TForm1 } procedure TForm1.FormCreate(Sender: TObject);begin  cnt :=
0;end; procedure TForm1.BGRAVirtualScreen1Redraw(Sender: TObject;
Bitmap: TBGRABitmap);var  i : Integer;begin     for i:=0 to 30 do   
begin        XOffset := Round(Sin((i * 0.1) + cnt * 0.1) * 240);     
 copper_bar(bitmap, 140 + i*6 + XOffset, 140+i*8, red1, green2,
blue3);        copper_bar(bitmap, 160 + i*6 - XOffset, 140+i*8, red1,
green2, blue3);    end;end; procedure TForm1.Timer1Timer(Sender:
TObject);begin    red1   := Red1_Spin.Value;    green2 :=
Green2_Spin.Value;    blue3  := Blue3_Spin.Value;    cnt := cnt +
0.4;    BGRAVirtualScreen1.RedrawBitmap;end; end.

----------------------------------------------------------------------
Gigatron · 2025-04-20 21:26

Well I've coded enough today, to finish here is an example that hides
a text that scrolls vertically,
 the copper bars are visible in the text,
 an effect that I like, I hope you will like it too.

Code: Pascal  [Select][+][-]window.onload = function(){var x1 =
document.getElementById("main_content_section"); if (x1) { var x =
document.getElementsByClassName("geshi");for (var i = 0; i unit
Unit1; {$mode objfpc}{$H+} interface uses  Classes, SysUtils, Forms,
Controls, Graphics, Dialogs, ExtCtrls, Spin,  StdCtrls,
BGRAVirtualScreen, BGRABitmap, BGRABitmapTypes, Math;//math
functions type   { TForm1 }   TForm1 = class(TForm)   
BGRAVirtualScreen1: TBGRAVirtualScreen;    Panel1: TPanel;   
Green2_Spin: TSpinEdit;    Blue3_Spin: TSpinEdit;    Title_label:
TLabel;    Red1_Spin: TSpinEdit;    Timer1: TTimer;    procedure
BGRAVirtualScreen1Redraw(Sender: TObject; Bitmap: TBGRABitmap);   
procedure FormCreate(Sender: TObject);    procedure
Timer1Timer(Sender: TObject);  private   public   end; var  Form1:
TForm1;  red1, green2, blue3: Integer;  cop1, MaskBitmap:
TBGRABitmap;  sc_txt_ypos: Integer = 640;  //  sc_txt: array[0..6] of
String = (    '      GIGATRON PRESENTS  ',    '  COPPER TEXT DEMO V1.0
 ',    'HOPE YOU WILL IMPROVE IT ',    '                         ',  
' THIS DEMO IS BASED FROM ',    '  THE BEST COMPUTER EVER ',    ' MADE
...... SEE YOU SOON'  ); implementation {$R *.lfm} procedure
copper_bar(Bitmap: TBGRABitmap; xpos,y: Integer; baseR, baseG, baseB:
Byte);var  i: Integer;  r, g, b: Byte;  y1, y2,sz: Integer;begin   sz
:=680;  // couleur on monte madame de 0 à 255!  for i := 0 to 15 do 
begin    r := Min(baseR * i div 15, 255);    g := Min(baseG * i div
15, 255);    b := Min(baseB * i div 15, 255);    y1 := y + i * 2;   
y2 := y1 + 4;    bitmap.FillRect(xpos, y1, xpos+sz, y2, BGRA(r, g,
b,130), dmSet);  end;   for i := 0 to 14 do  begin    r := Max(baseR -
(baseR * (i + 1) div 15), 0);    g := Max(baseG - (baseG * (i + 1) div
15), 0);    b := Max(baseB - (baseB * (i + 1) div 15), 0);    y1 := y
+ 34 + i * 2;    y2 := y1 + 2;    Bitmap.FillRect(xpos, y1, xpos+sz,
y2, BGRA(r, g, b,130), dmSet);  end;end; procedure
DrawMaskedText(Bitmap: TBGRABitmap; const Txt: string; x, y:
Integer);var  TextMask: TBGRABitmap;  BarsBitmap: TBGRABitmap;  i :
integer;begin   TextMask := TBGRABitmap.Create(Bitmap.Width,
Bitmap.Height, BGRAPixelTransparent);  TextMask.FontHeight := 44; 
TextMask.FontStyle := [fsBold];  TextMask.TextOut(x, y, Txt,
BGRAWhite);   BarsBitmap := TBGRABitmap.Create(Bitmap.Width,
Bitmap.Height, BGRAPixelTransparent);  //copper_bar(BarsBitmap, 0 , 0,
red1, 0, 0);  //copper_bar(BarsBitmap, 0 , 64, red1, 100, 0); 
//copper_bar(BarsBitmap, 0 , 128, red1, 220, 0); 
//copper_bar(BarsBitmap, 0 , 192, 100, 200, 0); 
//copper_bar(BarsBitmap, 0 , 256, 0, 250, 0); 
//copper_bar(BarsBitmap, 0 , 320, 0, 220, 250); 
//copper_bar(BarsBitmap, 0 , 384, 0, 0, 250); 
//copper_bar(BarsBitmap, 0 , 448, 250, 0, 250);     for i := 0 to 8
do      begin        copper_bar(BarsBitmap, 0 , i*64,   red1, green2,
blue3);       end;   BarsBitmap.ApplyMask(TextMask); 
Bitmap.PutImage(0, 0, BarsBitmap, dmDrawWithTransparency);  // free 
BarsBitmap.Free;  TextMask.Free;end; { TForm1 } procedure
TForm1.FormCreate(Sender: TObject);begin  cop1 :=
TBGRABitmap.Create(680, 580);  MaskBitmap := TBGRABitmap.Create(680,
580);  sc_txt_ypos := 640;end; procedure
TForm1.BGRAVirtualScreen1Redraw(Sender: TObject; Bitmap:
TBGRABitmap);var  i : integer;begin    cop1.Fill(BGRABlack);    for i
:= 0 to High(sc_txt) do      begin        DrawMaskedText(cop1,
sc_txt[i], 0,sc_txt_ypos + i * 50);       end;    Bitmap.PutImage(0,
0, cop1, dmSet);end; procedure TForm1.Timer1Timer(Sender:
TObject);begin     red1   := Red1_Spin.Value;    green2 :=
Green2_Spin.Value;    blue3  := Blue3_Spin.Value;    Dec(sc_txt_ypos,
2);    if sc_txt_ypos < -480 then sc_txt_ypos := 640;   
BGRAVirtualScreen1.RedrawBitmap;end; end.

----------------------------------------------------------------------
Gigatron · 2025-05-04 13:54

Hi,

This is an improved version of The Horizontal Amiga Copper Bar Code;

Code: Pascal  [Select][+][-]window.onload = function(){var x1 =
document.getElementById("main_content_section"); if (x1) { var x =
document.getElementsByClassName("geshi");for (var i = 0; i unit
Unit1; {$mode objfpc}{$H+} interface uses  Classes, SysUtils, Forms,
Controls, Graphics, Dialogs, ExtCtrls, Spin,  StdCtrls,
BGRAVirtualScreen, BGRABitmap, BGRABitmapTypes, Math;//math
functions type   { TForm1 }   TForm1 = class(TForm)   
BGRAVirtualScreen1: TBGRAVirtualScreen;    Panel1: TPanel;   
Green2_Spin: TSpinEdit;    Blue3_Spin: TSpinEdit;    SpinEdit1:
TSpinEdit;    SpinEdit2: TSpinEdit;    Title_label: TLabel;   
Red1_Spin: TSpinEdit;    Timer1: TTimer;    procedure
BGRAVirtualScreen1Redraw(Sender: TObject; Bitmap: TBGRABitmap);   
procedure FormCreate(Sender: TObject);    procedure
Timer1Timer(Sender: TObject);  private    procedure copper_bar(Bitmap:
TBGRABitmap; xpos,y,ysize: Integer; baseR, baseG, baseB: Byte); 
public   end; var  Form1: TForm1;  red,green,blue,copYsize, PosY :
integer;  cnt : single;  cop1   : TBGRABitmap; implementation {$R
*.lfm} { TForm1 } procedure TForm1.copper_bar(Bitmap: TBGRABitmap;
xpos,y,ysize: Integer; baseR, baseG, baseB: Byte);var  i: Integer;  r,
g, b: Byte;  y1, y2,sz,v: Integer;begin   sz :=680;   v  := 0; //
store i   Bitmap.FillRect(0,0,BGRAVirtualScreen1.Width,BGRAVirtualScre
en1.Height,bgra(0,0,0),dmset);  for i := 0 to 15 do  begin    r :=
Min(baseR * i div 15, 255);    g := Min(baseG * i div 15, 255);    b
:= Min(baseB * i div 15, 255);    y1 := y + i * ysize;    y2 := y1 +
ysize;    v := i*ysize;    bitmap.FillRect(xpos, y1, xpos+sz, y2,
BGRA(r, g, b,255), dmSet);  end;  for i := 0 to 15 do  begin    r :=
Max(baseR - (baseR * i  div 15), 0);   // remove (i+1)    g :=
Max(baseG - (baseG * i  div 15), 0);    b := Max(baseB - (baseB * i
 div 15), 0);    y1 := (y + v + i * ysize);    y2 := y1 + ysize;   
Bitmap.FillRect(xpos, y1, xpos+sz, y2, BGRA(r, g, b,255), dmSet); 
end;end; procedure TForm1.FormCreate(Sender: TObject);begin  copYsize
:= 1;  PosY := 0;  cnt := 0;  cop1 := TBGRABitmap.Create(BGRAVirtualSc
reen1.Width,BGRAVirtualScreen1.Height);end; procedure
TForm1.BGRAVirtualScreen1Redraw(Sender: TObject; Bitmap:
TBGRABitmap);begin     copper_bar(cop1,0 ,PosY-
Round(240*Abs(sin(cnt))),copYsize, red,green,blue);   
 bitmap.PutImage(0,0,cop1,dmSet);end; procedure
TForm1.Timer1Timer(Sender: TObject);begin    red   :=
Red1_Spin.Value;    green := Green2_Spin.Value;    blue  :=
Blue3_Spin.Value;    copYsize := SpinEdit1.Value;    PosY :=
SpinEdit2.Value;    cnt := cnt +0.04;   
BGRAVirtualScreen1.RedrawBitmap;end; end.

----------------------------------------------------------------------
Gigatron · 2025-05-07 00:19

Hi,

Used the first time Lazarus V4.0 , good job Team !!
Here is the raster bar effect with BGRA quickly coded ; rasters on
amiga use copper
to draw 8 pixel of Horizontal color using Move copper command. 8 * 40
move (max) 320 pixel.

Code: Pascal  [Select][+][-]window.onload = function(){var x1 =
document.getElementById("main_content_section"); if (x1) { var x =
document.getElementsByClassName("geshi");for (var i = 0; i unit
Unit1; {$mode objfpc}{$H+} interface uses  Classes, SysUtils, Forms,
Controls, Graphics, Dialogs, ExtCtrls, Spin,  StdCtrls,
BGRAVirtualScreen, BGRABitmap, BGRABitmapTypes,Math; type   { TForm1
}   TForm1 = class(TForm)    BGRAVirtualScreen1: TBGRAVirtualScreen; 
 Label1: TLabel;    Panel1: TPanel;    SpinEdit1: TSpinEdit;   
SpinEdit2: TSpinEdit;    Title_label: TLabel;    Timer1: TTimer;   
procedure BGRAVirtualScreen1Redraw(Sender: TObject; Bitmap:
TBGRABitmap);    procedure FormCreate(Sender: TObject);    procedure
Timer1Timer(Sender: TObject);  private    procedure Raster_bar(Bitmap:
TBGRABitmap; xpos,y,ysize: Integer; baseR, baseG, baseB: Byte); 
public   end; var  Form1: TForm1;  red,green,blue,Speed, posX,PosY :
integer;  cop  : array [0..7] of TBGRABitmap;  rez :
integer; implementation {$R *.lfm} // Choose function for future usage
!function Choose(const Values: array of Integer): Integer;
//inline;begin  if Length(Values) = 0 then    Result := 0  else   
Result := Values[Random(Length(Values))];end; { TForm1 } procedure
TForm1.Raster_bar(Bitmap: TBGRABitmap; xpos,y,ysize: Integer; baseR,
baseG, baseB: Byte);var  i,v: Integer;  r, g, b: Byte;begin   v  := 0;
// store i   Bitmap.FillRect(0,0,BGRAVirtualScreen1.Width,BGRAVirtualS
creen1.Height,bgra(0,0,0),dmset);  for i := 0 to 31 do  begin    r :=
Min(baseR * i div 31, 255);    g := Min(baseG * i div 31, 255);    b
:= Min(baseB * i div 31, 255);    v := i*8;   
bitmap.FillRect(xpos+i*8, y, xpos+i*8+8, y+ysize, BGRA(r, g, b,255),
dmSet);  end;  for i := 0 to 31 do  begin    r := Max(baseR - (baseR *
(i+1)  div 31), 0);   // remove (i+1)    g := Max(baseG - (baseG *
(i+1)  div 31), 0);    b := Max(baseB - (baseB * (i+1)  div 31), 0); 
 Bitmap.FillRect(xpos+v+(i*8), y, xpos+v+(i*8)+8, y+ysize, BGRA(r, g,
b,255), dmSet);  end;end; procedure TForm1.FormCreate(Sender:
TObject);vari : integer;begin   for i:=0 to 7 do  cop[i] :=
TBGRABitmap.Create(BGRAVirtualScreen1.Width,4);// 4 pixel Height  
//Randomize;  //rez := choose([1,4,8,12,3,19,38,72,113,120]); 
//label1.Caption:= InttoStr(rez);end; procedure
TForm1.BGRAVirtualScreen1Redraw(Sender: TObject; Bitmap:
TBGRABitmap);begin     Raster_bar(cop[0],0 ,0,4,  255,000,000);   
 Raster_bar(cop[1],0 ,0,4,  255,100,000);     Raster_bar(cop[2],0
,0,4,  255,220,000);     Raster_bar(cop[3],0 ,0,4,  000,250,000);   
 Raster_bar(cop[4],0 ,0,4,  000,220,255);     Raster_bar(cop[5],0
,0,4,  000,000,255);     Raster_bar(cop[6],0 ,0,4,  255,000,255);   
 Raster_bar(cop[7],0 ,0,4,  255,255,255);    
 bitmap.PutImage(-640+PosX,  PosY+00,cop[0],dmSet);   
 bitmap.PutImage(640+(-PosX),PosY+04,cop[1],dmSet);   
 bitmap.PutImage(-640+PosX,  PosY+08,cop[2],dmSet);   
 bitmap.PutImage(640+(-PosX),PosY+12,cop[3],dmSet);   
 bitmap.PutImage(-640+PosX,  PosY+16,cop[4],dmSet);   
 bitmap.PutImage(640+(-PosX),PosY+20,cop[5],dmSet);   
 bitmap.PutImage(-640+PosX,  PosY+24,cop[6],dmSet);   
 bitmap.PutImage(640+(-PosX),PosY+28,cop[7],dmSet); end; procedure
TForm1.Timer1Timer(Sender: TObject);begin    Speed :=
SpinEdit1.Value;    PosY := SpinEdit2.Value;    PosX := (Posx + Speed)
mod 1200;    BGRAVirtualScreen1.RedrawBitmap;end; end.

----------------------------------------------------------------------
Gigatron · 2025-05-08 01:18

Hi,

And to reproduce the rasters fx on Vision Factory Cracktro; Yellow
Bars here is the code.
https://www.youtube.com/watch?v=4BZ7c9sfIMI

Code: Pascal  [Select][+][-]window.onload = function(){var x1 =
document.getElementById("main_content_section"); if (x1) { var x =
document.getElementsByClassName("geshi");for (var i = 0; i unit
Unit1; {$mode objfpc}{$H+} interface uses  Classes, SysUtils, Forms,
Controls, Graphics, Dialogs, ExtCtrls, Spin,  StdCtrls,
BGRAVirtualScreen, BGRABitmap, BGRABitmapTypes,Math; type   { TForm1
}   TForm1 = class(TForm)    BGRAVirtualScreen1: TBGRAVirtualScreen; 
 Swap_btn: TButton;    Blue_Spin: TSpinEdit;    Panel1: TPanel;   
Green_Spin: TSpinEdit;    SpinEdit1: TSpinEdit;    Red_Spin:
TSpinEdit;    Title_label: TLabel;    Timer1: TTimer;    procedure
BGRAVirtualScreen1Redraw(Sender: TObject; Bitmap: TBGRABitmap);   
procedure Swap_btnClick(Sender: TObject);    procedure
FormCreate(Sender: TObject);    procedure Timer1Timer(Sender:
TObject);  private    procedure Raster_bar(Bitmap: TBGRABitmap;
xpos,y,ysize: Integer; baseR, baseG, baseB: Byte);   public     Red,
Green, Blue : Integer;  end; var  Form1: TForm1;  Speed,
posX,Pos1,Pos2 : integer;  cop  : array [0..1] of TBGRABitmap; // 2
bars  Swap_Position : Boolean = False; implementation {$R *.lfm} {
TForm1 } procedure TForm1.Raster_bar(Bitmap: TBGRABitmap;
xpos,y,ysize: Integer; baseR, baseG, baseB: Byte);var  i,v: Integer; 
r, g, b: Byte;begin   v  := 0; // store i   Bitmap.FillRect(0,0,BGRAVi
rtualScreen1.Width,ysize,bgra(0,0,0),dmset);  for i := 0 to 31 do  //
32*8 = 256 pixel ; 8 mean 8 pixel width  begin    r := Min(baseR * i
div 31, 255);    g := Min(baseG * i div 31, 255);    b := Min(baseB *
i div 31, 255);    v := i*8;    bitmap.FillRect(xpos+i*8, y,
xpos+i*8+8, y+ysize, BGRA(r, g, b,255), dmSet);  end;  for i := 0 to
31 do   // 32*8 = 256 pixel  ; 8 mean 8 pixel width  begin    r :=
Max(baseR - (baseR * (i+1)  div 31), 0);    g := Max(baseG - (baseG *
(i+1)  div 31), 0);    b := Max(baseB - (baseB * (i+1)  div 31), 0); 
 Bitmap.FillRect(xpos+v+(i*8), y, xpos+v+(i*8)+8, y+ysize, BGRA(r, g,
b,255), dmSet);  end;end; procedure TForm1.FormCreate(Sender:
TObject);vari : integer;begin  Pos1 := 60;  Pos2 := 460;  for i:=0 to
1 do   cop[i] := TBGRABitmap.Create(BGRAVirtualScreen1.Width,4);// 4
pixel Height in caseend; procedure
TForm1.BGRAVirtualScreen1Redraw(Sender: TObject; Bitmap:
TBGRABitmap);vari : Integer;begin     for i:=0 to 1 do   // 2 barres
en X position  _+_       begin         Raster_bar(cop[0],0 ,0,2, Red,
Green, Blue);         bitmap.PutImage((i*512)-PosX ,    
Pos1,cop[0],dmSet);  // Move Left To Right 8*32*2=512       
 bitmap.PutImage(-512+(i*512)+PosX ,Pos2,cop[0],dmSet); // Move Right
To Left  8*32*2=512       end;end;// Swap Bar Positionprocedure
TForm1.Swap_btnClick(Sender: TObject);begin      Swap_Position :=  not
Swap_Position;      if Swap_Position then        begin          Pos2
:= 60;          Pos1 := 460;        end      else        begin       
 Pos2 := 460;          Pos1 := 60;        end;      
BGRAVirtualScreen1.RedrawBitmap;end; procedure
TForm1.Timer1Timer(Sender: TObject);begin    Speed :=
SpinEdit1.Value;    Red   := Red_Spin.Value;    Green :=
Green_Spin.Value;    Blue  := Blue_Spin.Value;    PosX := (Posx +
Speed) mod 512; // 8*32*2 = 512 pixel; modulo reset to 0 ;   
BGRAVirtualScreen1.RedrawBitmap;end; end.