Recent

« previous next »
Pages: [1]

Author Topic: RGB Plasma  (Read 936 times)

Gigatron

  • Full Member
  • ***
  • Posts: 244
  • Amiga Rulez !!
RGB Plasma
« on: April 20, 2025, 08:47:37 am »
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][+][-]
  1. unit Unit1;
  2.  
  3. {$mode objfpc}{$H+}
  4.  
  5. interface
  6.  
  7. uses
  8.   Classes, SysUtils, Forms, Controls, Graphics, Dialogs, ExtCtrls, Spin,
  9.   StdCtrls, BGRAVirtualScreen, BGRABitmap, BGRABitmapTypes, Math;
  10.  
  11. type
  12.  
  13.   { TForm1 }
  14.  
  15.   TForm1 = class(TForm)
  16.     BGRAVirtualScreen1: TBGRAVirtualScreen;
  17.     Panel1: TPanel;
  18.     Green2_Spin: TSpinEdit;
  19.     Blue3_Spin: TSpinEdit;
  20.     Title_label: TLabel;
  21.     Red1_Spin: TSpinEdit;
  22.     Timer1: TTimer;
  23.  
  24.     procedure BGRAVirtualScreen1Redraw(Sender: TObject; Bitmap: TBGRABitmap);
  25.     procedure FormCreate(Sender: TObject);
  26.     procedure Timer1Timer(Sender: TObject);
  27.   private
  28.  
  29.   public
  30.  
  31.   end;
  32.  
  33. var
  34.   Form1: TForm1;
  35.   LOffset,red1,green2,blue3 : integer;
  36.  
  37.   Line_dir : Integer;
  38.   img : TBGRABitmap;
  39.   cnt : single;
  40.   YOffset,YOffset2,YOffset3 : integer;
  41.   cop1,cop2,cop3 : TBGRABitmap;
  42.  
  43. implementation
  44.  
  45. {$R *.lfm}
  46.  
  47. procedure copper_bar(Bitmap: TBGRABitmap; xpos,y: Integer; baseR, baseG, baseB: Byte);
  48. var
  49.   i: Integer;
  50.   r, g, b: Byte;
  51.   y1, y2: Integer;
  52. begin
  53.   // couleur on monte madame de 0 à 255!
  54.   for i := 0 to 15 do
  55.   begin
  56.     r := Min(baseR * i div 15, 255);
  57.     g := Min(baseG * i div 15, 255);
  58.     b := Min(baseB * i div 15, 255);
  59.     y1 := y + i * 2;
  60.     y2 := y1 + 4;
  61.     bitmap.FillRect(xpos, y1*8, xpos+8, y2*16, BGRA(r, g, b,130), dmSet);
  62.   end;
  63.  
  64.   for i := 0 to 14 do
  65.   begin
  66.     r := Max(baseR - (baseR * (i + 1) div 15), 0);
  67.     g := Max(baseG - (baseG * (i + 1) div 15), 0);
  68.     b := Max(baseB - (baseB * (i + 1) div 15), 0);
  69.     y1 := y + 34 + i * 2;
  70.     y2 := y1 + 2;
  71.     Bitmap.FillRect(xpos, y1*8, xpos+8, y2*16, BGRA(r, g, b,130), dmSet);
  72.   end;
  73. end;
  74.  
  75. procedure copper_line(Bitmap: TBGRABitmap; y,PosY,Sz: Integer; baseR, baseG, baseB: Byte);
  76. var
  77.   i: Integer;
  78.   r, g, b: Byte;
  79.   x1   : Integer;
  80. begin
  81.  
  82.   // couleur on monte madame de 0 à 255!
  83.   for i := 0 to 15 do
  84.   begin
  85.     r := Min(baseR * i div 15, 255);
  86.     g := Min(baseG * i div 15, 255);
  87.     b := Min(baseB * i div 15, 255);
  88.     x1 := y + i * 2;
  89.     Bitmap.FillRect(x1*8, PosY, Bitmap.Width, PosY+Sz, BGRA(r, g, b), dmSet);
  90.   end;
  91.  
  92.   // milieu ligne
  93.   r := baseR;
  94.   g := baseG;
  95.   b := baseB;
  96.   x1 := y + 32;
  97.   Bitmap.FillRect(x1*8, PosY, Bitmap.Width, PosY+Sz, BGRA(r, g, b), dmSet);
  98.  
  99.   // couleur on descend
  100.   for i := 0 to 14 do
  101.   begin
  102.     r := Max(baseR - (baseR * (i + 1) div 15), 0);
  103.     g := Max(baseG - (baseG * (i + 1) div 15), 0);
  104.     b := Max(baseB - (baseB * (i + 1) div 15), 0);
  105.     x1 := y + 34 + i * 2;
  106.     Bitmap.FillRect(x1*8, PosY, Bitmap.Width, PosY+Sz, BGRA(r, g, b), dmSet);
  107.   end;
  108. end;
  109.  
  110. { TForm1 }
  111.  
  112. procedure TForm1.FormCreate(Sender: TObject);
  113. begin
  114.  
  115.   cop1 := TBGRABitmap.Create(680,520);
  116.   cop2 := TBGRABitmap.Create(680,520);
  117.   cop3 := TBGRABitmap.Create(680,520);
  118.   cnt := 0;
  119.  
  120. end;
  121.  
  122. procedure TForm1.BGRAVirtualScreen1Redraw(Sender: TObject; Bitmap: TBGRABitmap);
  123. var
  124.   i : Integer;
  125. begin
  126.  
  127.     for i:=0 to 182 do
  128.     begin
  129.         YOffset  := Round(Sin((cnt + Time + i) * 0.02) * 10);
  130.         YOffset2 := Round(Sin((cnt + Time - i) * 0.05) * 10);
  131.         YOffset3 := Round(Sin((cnt - Time + i) * 0.07) * 10);
  132.  
  133.         copper_bar(cop1, i * 4,  YOffset,  red1, 0,0);
  134.         copper_bar(cop2, i * 4,  YOffset2, 0, green2,0);
  135.         copper_bar(cop3, i * 4,  YOffset3, 0, 0,blue3);
  136.     end;
  137.                bitmap.PutImage(0,0,cop1,dmxor);
  138.                bitmap.PutImage(0,0,cop2,dmxor);
  139.                bitmap.PutImage(0,0,cop3,dmxor);
  140.  
  141. end;
  142.  
  143. procedure TForm1.Timer1Timer(Sender: TObject);
  144. begin
  145.  
  146.     red1   := Red1_Spin.Value;
  147.     green2 := Green2_Spin.Value;
  148.     blue3  := Blue3_Spin.Value;
  149.     cnt := cnt + 1.2;
  150.  
  151.     BGRAVirtualScreen1.RedrawBitmap;
  152. end;
  153.  
  154. end.
  155.  
« Last Edit: April 20, 2025, 06:49:17 pm by Gigatron »
Logged
Sub Quantum Technology ! Gigatron 68000 Colmar France;

Gigatron

  • Full Member
  • ***
  • Posts: 244
  • Amiga Rulez !!
Re: RGB Plasma
« Reply #1 on: April 20, 2025, 08:47:12 pm »
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][+][-]
  1. unit Unit1;
  2.  
  3. {$mode objfpc}{$H+}
  4.  
  5. interface
  6.  
  7. uses
  8.   Classes, SysUtils, Forms, Controls, Graphics, Dialogs, ExtCtrls, Spin,
  9.   StdCtrls, BGRAVirtualScreen, BGRABitmap, BGRABitmapTypes, Math;
  10.  
  11. type
  12.  
  13.   { TForm1 }
  14.  
  15.   TForm1 = class(TForm)
  16.     BGRAVirtualScreen1: TBGRAVirtualScreen;
  17.     Panel1: TPanel;
  18.     Green2_Spin: TSpinEdit;
  19.     Blue3_Spin: TSpinEdit;
  20.     Title_label: TLabel;
  21.     Red1_Spin: TSpinEdit;
  22.     Timer1: TTimer;
  23.     procedure BGRAVirtualScreen1Redraw(Sender: TObject; Bitmap: TBGRABitmap);
  24.     procedure FormCreate(Sender: TObject);
  25.     procedure Timer1Timer(Sender: TObject);
  26.   private
  27.  
  28.   public
  29.  
  30.   end;
  31.  
  32. var
  33.   Form1: TForm1;
  34.   red1,green2,blue3 : integer;
  35.   cnt : single;
  36.   XOffset: integer;
  37.  
  38. implementation
  39.  
  40. {$R *.lfm}
  41.  
  42. procedure copper_bar(Bitmap: TBGRABitmap; x, ypos: Integer; baseR, baseG, baseB: Byte);
  43. var
  44.   i: Integer;
  45.   r, g, b: Byte;
  46.   x1, x2: Integer;
  47. begin
  48.  
  49.   for i := 0 to 15 do
  50.   begin
  51.     r := Min(baseR * i div 15, 255);
  52.     g := Min(baseG * i div 15, 255);
  53.     b := Min(baseB * i div 15, 255);
  54.     x1 := x + i * 2;
  55.     x2 := x1 + 4;
  56.     Bitmap.FillRect(x1, ypos, x2 + 2, ypos + 450, BGRA(r, g, b, 130), dmSet);
  57.   end;
  58.  
  59.   for i := 0 to 14 do
  60.   begin
  61.     r := Max(baseR - (baseR * (i + 1) div 15), 0);
  62.     g := Max(baseG - (baseG * (i + 1) div 15), 0);
  63.     b := Max(baseB - (baseB * (i + 1) div 15), 0);
  64.     x1 := x + 34 + i * 2;
  65.     x2 := x1 + 2;
  66.     Bitmap.FillRect(x1, ypos, x2 + 2, ypos + 450, BGRA(r, g, b, 130), dmSet);
  67.   end;
  68. end;
  69.  
  70. { TForm1 }
  71.  
  72. procedure TForm1.FormCreate(Sender: TObject);
  73. begin
  74.   cnt := 0;
  75. end;
  76.  
  77. procedure TForm1.BGRAVirtualScreen1Redraw(Sender: TObject; Bitmap: TBGRABitmap);
  78. var
  79.   i : Integer;
  80. begin
  81.  
  82.     for i:=0 to 30 do
  83.     begin
  84.         XOffset := Round(Sin((i * 0.1) + cnt * 0.1) * 240);
  85.         copper_bar(bitmap, 140 + i*6 + XOffset, 140+i*8, red1, green2, blue3);
  86.         copper_bar(bitmap, 160 + i*6 - XOffset, 140+i*8, red1, green2, blue3);
  87.     end;
  88. end;
  89.  
  90. procedure TForm1.Timer1Timer(Sender: TObject);
  91. begin
  92.     red1   := Red1_Spin.Value;
  93.     green2 := Green2_Spin.Value;
  94.     blue3  := Blue3_Spin.Value;
  95.     cnt := cnt + 0.4;
  96.     BGRAVirtualScreen1.RedrawBitmap;
  97. end;
  98.  
  99. end.

« Last Edit: April 20, 2025, 08:50:11 pm by Gigatron »
Logged
Sub Quantum Technology ! Gigatron 68000 Colmar France;

Gigatron

  • Full Member
  • ***
  • Posts: 244
  • Amiga Rulez !!
Re: RGB Plasma
« Reply #2 on: April 20, 2025, 11:26:28 pm »
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][+][-]
  1. unit Unit1;
  2.  
  3. {$mode objfpc}{$H+}
  4.  
  5. interface
  6.  
  7. uses
  8.   Classes, SysUtils, Forms, Controls, Graphics, Dialogs, ExtCtrls, Spin,
  9.   StdCtrls, BGRAVirtualScreen, BGRABitmap, BGRABitmapTypes, Math;//math functions
  10.  
  11. type
  12.  
  13.   { TForm1 }
  14.  
  15.   TForm1 = class(TForm)
  16.     BGRAVirtualScreen1: TBGRAVirtualScreen;
  17.     Panel1: TPanel;
  18.     Green2_Spin: TSpinEdit;
  19.     Blue3_Spin: TSpinEdit;
  20.     Title_label: TLabel;
  21.     Red1_Spin: TSpinEdit;
  22.     Timer1: TTimer;
  23.     procedure BGRAVirtualScreen1Redraw(Sender: TObject; Bitmap: TBGRABitmap);
  24.     procedure FormCreate(Sender: TObject);
  25.     procedure Timer1Timer(Sender: TObject);
  26.   private
  27.  
  28.   public
  29.  
  30.   end;
  31.  
  32. var
  33.   Form1: TForm1;
  34.   red1, green2, blue3: Integer;
  35.   cop1, MaskBitmap: TBGRABitmap;
  36.   sc_txt_ypos: Integer = 640;  //
  37.   sc_txt: array[0..6] of String = (
  38.     '      GIGATRON PRESENTS  ',
  39.     '  COPPER TEXT DEMO V1.0  ',
  40.     'HOPE YOU WILL IMPROVE IT ',
  41.     '                         ',
  42.     ' THIS DEMO IS BASED FROM ',
  43.     '  THE BEST COMPUTER EVER ',
  44.     ' MADE ...... SEE YOU SOON'
  45.   );
  46.  
  47. implementation
  48.  
  49. {$R *.lfm}
  50.  
  51. procedure copper_bar(Bitmap: TBGRABitmap; xpos,y: Integer; baseR, baseG, baseB: Byte);
  52. var
  53.   i: Integer;
  54.   r, g, b: Byte;
  55.   y1, y2,sz: Integer;
  56. begin
  57.    sz :=680;
  58.   // couleur on monte madame de 0 à 255!
  59.   for i := 0 to 15 do
  60.   begin
  61.     r := Min(baseR * i div 15, 255);
  62.     g := Min(baseG * i div 15, 255);
  63.     b := Min(baseB * i div 15, 255);
  64.     y1 := y + i * 2;
  65.     y2 := y1 + 4;
  66.     bitmap.FillRect(xpos, y1, xpos+sz, y2, BGRA(r, g, b,130), dmSet);
  67.   end;
  68.  
  69.   for i := 0 to 14 do
  70.   begin
  71.     r := Max(baseR - (baseR * (i + 1) div 15), 0);
  72.     g := Max(baseG - (baseG * (i + 1) div 15), 0);
  73.     b := Max(baseB - (baseB * (i + 1) div 15), 0);
  74.     y1 := y + 34 + i * 2;
  75.     y2 := y1 + 2;
  76.     Bitmap.FillRect(xpos, y1, xpos+sz, y2, BGRA(r, g, b,130), dmSet);
  77.   end;
  78. end;
  79.  
  80. procedure DrawMaskedText(Bitmap: TBGRABitmap; const Txt: string; x, y: Integer);
  81. var
  82.   TextMask: TBGRABitmap;
  83.   BarsBitmap: TBGRABitmap;
  84.   i : integer;
  85. begin
  86.  
  87.   TextMask := TBGRABitmap.Create(Bitmap.Width, Bitmap.Height, BGRAPixelTransparent);
  88.   TextMask.FontHeight := 44;
  89.   TextMask.FontStyle := [fsBold];
  90.   TextMask.TextOut(x, y, Txt, BGRAWhite);
  91.  
  92.   BarsBitmap := TBGRABitmap.Create(Bitmap.Width, Bitmap.Height, BGRAPixelTransparent);
  93.   //copper_bar(BarsBitmap, 0 , 0, red1, 0, 0);
  94.   //copper_bar(BarsBitmap, 0 , 64, red1, 100, 0);
  95.   //copper_bar(BarsBitmap, 0 , 128, red1, 220, 0);
  96.   //copper_bar(BarsBitmap, 0 , 192, 100, 200, 0);
  97.   //copper_bar(BarsBitmap, 0 , 256, 0, 250, 0);
  98.   //copper_bar(BarsBitmap, 0 , 320, 0, 220, 250);
  99.   //copper_bar(BarsBitmap, 0 , 384, 0, 0, 250);
  100.   //copper_bar(BarsBitmap, 0 , 448, 250, 0, 250);
  101.  
  102.     for i := 0 to 8 do
  103.       begin
  104.         copper_bar(BarsBitmap, 0 , i*64,   red1, green2, blue3);
  105.        end;
  106.  
  107.   BarsBitmap.ApplyMask(TextMask);
  108.   Bitmap.PutImage(0, 0, BarsBitmap, dmDrawWithTransparency);
  109.   // free
  110.   BarsBitmap.Free;
  111.   TextMask.Free;
  112. end;
  113.  
  114. { TForm1 }
  115.  
  116. procedure TForm1.FormCreate(Sender: TObject);
  117. begin
  118.   cop1 := TBGRABitmap.Create(680, 580);
  119.   MaskBitmap := TBGRABitmap.Create(680, 580);
  120.   sc_txt_ypos := 640;
  121. end;
  122.  
  123. procedure TForm1.BGRAVirtualScreen1Redraw(Sender: TObject; Bitmap: TBGRABitmap);
  124. var
  125.   i : integer;
  126. begin
  127.     cop1.Fill(BGRABlack);
  128.     for i := 0 to High(sc_txt) do
  129.       begin
  130.         DrawMaskedText(cop1, sc_txt[i], 0,sc_txt_ypos + i * 50);
  131.        end;
  132.     Bitmap.PutImage(0, 0, cop1, dmSet);
  133. end;
  134.  
  135. procedure TForm1.Timer1Timer(Sender: TObject);
  136. begin
  137.  
  138.     red1   := Red1_Spin.Value;
  139.     green2 := Green2_Spin.Value;
  140.     blue3  := Blue3_Spin.Value;
  141.     Dec(sc_txt_ypos, 2);
  142.     if sc_txt_ypos < -480 then sc_txt_ypos := 640;
  143.     BGRAVirtualScreen1.RedrawBitmap;
  144. end;
  145.  
  146. end.
Logged
Sub Quantum Technology ! Gigatron 68000 Colmar France;

Gigatron

  • Full Member
  • ***
  • Posts: 244
  • Amiga Rulez !!
Re: RGB Plasma
« Reply #3 on: May 04, 2025, 03:54:55 pm »
Hi,

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

Code: Pascal  [Select][+][-]
  1. unit Unit1;
  2.  
  3. {$mode objfpc}{$H+}
  4.  
  5. interface
  6.  
  7. uses
  8.   Classes, SysUtils, Forms, Controls, Graphics, Dialogs, ExtCtrls, Spin,
  9.   StdCtrls, BGRAVirtualScreen, BGRABitmap, BGRABitmapTypes, Math;//math functions
  10.  
  11. type
  12.  
  13.   { TForm1 }
  14.  
  15.   TForm1 = class(TForm)
  16.     BGRAVirtualScreen1: TBGRAVirtualScreen;
  17.     Panel1: TPanel;
  18.     Green2_Spin: TSpinEdit;
  19.     Blue3_Spin: TSpinEdit;
  20.     SpinEdit1: TSpinEdit;
  21.     SpinEdit2: TSpinEdit;
  22.     Title_label: TLabel;
  23.     Red1_Spin: TSpinEdit;
  24.     Timer1: TTimer;
  25.     procedure BGRAVirtualScreen1Redraw(Sender: TObject; Bitmap: TBGRABitmap);
  26.     procedure FormCreate(Sender: TObject);
  27.     procedure Timer1Timer(Sender: TObject);
  28.   private
  29.     procedure copper_bar(Bitmap: TBGRABitmap; xpos,y,ysize: Integer; baseR, baseG, baseB: Byte);
  30.   public
  31.  
  32.   end;
  33.  
  34. var
  35.   Form1: TForm1;
  36.   red,green,blue,copYsize, PosY : integer;
  37.   cnt : single;
  38.   cop1   : TBGRABitmap;
  39.  
  40. implementation
  41.  
  42. {$R *.lfm}
  43.  
  44. { TForm1 }
  45.  
  46. procedure TForm1.copper_bar(Bitmap: TBGRABitmap; xpos,y,ysize: Integer; baseR, baseG, baseB: Byte);
  47. var
  48.   i: Integer;
  49.   r, g, b: Byte;
  50.   y1, y2,sz,v: Integer;
  51. begin
  52.    sz :=680;
  53.    v  := 0; // store i
  54.    Bitmap.FillRect(0,0,BGRAVirtualScreen1.Width,BGRAVirtualScreen1.Height,bgra(0,0,0),dmset);
  55.   for i := 0 to 15 do
  56.   begin
  57.     r := Min(baseR * i div 15, 255);
  58.     g := Min(baseG * i div 15, 255);
  59.     b := Min(baseB * i div 15, 255);
  60.     y1 := y + i * ysize;
  61.     y2 := y1 + ysize;
  62.     v := i*ysize;
  63.     bitmap.FillRect(xpos, y1, xpos+sz, y2, BGRA(r, g, b,255), dmSet);
  64.   end;
  65.   for i := 0 to 15 do
  66.   begin
  67.     r := Max(baseR - (baseR * i  div 15), 0);   // remove (i+1)
  68.     g := Max(baseG - (baseG * i  div 15), 0);
  69.     b := Max(baseB - (baseB * i  div 15), 0);
  70.     y1 := (y + v + i * ysize);
  71.     y2 := y1 + ysize;
  72.     Bitmap.FillRect(xpos, y1, xpos+sz, y2, BGRA(r, g, b,255), dmSet);
  73.   end;
  74. end;
  75.  
  76. procedure TForm1.FormCreate(Sender: TObject);
  77. begin
  78.   copYsize := 1;
  79.   PosY := 0;
  80.   cnt := 0;
  81.   cop1 := TBGRABitmap.Create(BGRAVirtualScreen1.Width,BGRAVirtualScreen1.Height);
  82. end;
  83.  
  84. procedure TForm1.BGRAVirtualScreen1Redraw(Sender: TObject; Bitmap: TBGRABitmap);
  85. begin
  86.      copper_bar(cop1,0 ,PosY-Round(240*Abs(sin(cnt))),copYsize, red,green,blue);
  87.      bitmap.PutImage(0,0,cop1,dmSet);
  88. end;
  89.  
  90. procedure TForm1.Timer1Timer(Sender: TObject);
  91. begin
  92.     red   := Red1_Spin.Value;
  93.     green := Green2_Spin.Value;
  94.     blue  := Blue3_Spin.Value;
  95.     copYsize := SpinEdit1.Value;
  96.     PosY := SpinEdit2.Value;
  97.     cnt := cnt +0.04;
  98.     BGRAVirtualScreen1.RedrawBitmap;
  99. end;
  100.  
  101. end.
  102.  
Logged
Sub Quantum Technology ! Gigatron 68000 Colmar France;

Gigatron

  • Full Member
  • ***
  • Posts: 244
  • Amiga Rulez !!
Re: RGB Plasma
« Reply #4 on: May 07, 2025, 02:19:51 am »
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][+][-]
  1. unit Unit1;
  2.  
  3. {$mode objfpc}{$H+}
  4.  
  5. interface
  6.  
  7. uses
  8.   Classes, SysUtils, Forms, Controls, Graphics, Dialogs, ExtCtrls, Spin,
  9.   StdCtrls, BGRAVirtualScreen, BGRABitmap, BGRABitmapTypes,Math;
  10.  
  11. type
  12.  
  13.   { TForm1 }
  14.  
  15.   TForm1 = class(TForm)
  16.     BGRAVirtualScreen1: TBGRAVirtualScreen;
  17.     Label1: TLabel;
  18.     Panel1: TPanel;
  19.     SpinEdit1: TSpinEdit;
  20.     SpinEdit2: TSpinEdit;
  21.     Title_label: TLabel;
  22.     Timer1: TTimer;
  23.     procedure BGRAVirtualScreen1Redraw(Sender: TObject; Bitmap: TBGRABitmap);
  24.     procedure FormCreate(Sender: TObject);
  25.     procedure Timer1Timer(Sender: TObject);
  26.   private
  27.     procedure Raster_bar(Bitmap: TBGRABitmap; xpos,y,ysize: Integer; baseR, baseG, baseB: Byte);
  28.   public
  29.  
  30.   end;
  31.  
  32. var
  33.   Form1: TForm1;
  34.   red,green,blue,Speed, posX,PosY : integer;
  35.   cop  : array [0..7] of TBGRABitmap;
  36.   rez : integer;
  37.  
  38. implementation
  39.  
  40. {$R *.lfm}
  41.  
  42. // Choose function for future usage !
  43. function Choose(const Values: array of Integer): Integer; //inline;
  44. begin
  45.   if Length(Values) = 0 then
  46.     Result := 0
  47.   else
  48.     Result := Values[Random(Length(Values))];
  49. end;
  50.  
  51. { TForm1 }
  52.  
  53. procedure TForm1.Raster_bar(Bitmap: TBGRABitmap; xpos,y,ysize: Integer; baseR, baseG, baseB: Byte);
  54. var
  55.   i,v: Integer;
  56.   r, g, b: Byte;
  57. begin
  58.    v  := 0; // store i
  59.    Bitmap.FillRect(0,0,BGRAVirtualScreen1.Width,BGRAVirtualScreen1.Height,bgra(0,0,0),dmset);
  60.   for i := 0 to 31 do
  61.   begin
  62.     r := Min(baseR * i div 31, 255);
  63.     g := Min(baseG * i div 31, 255);
  64.     b := Min(baseB * i div 31, 255);
  65.     v := i*8;
  66.     bitmap.FillRect(xpos+i*8, y, xpos+i*8+8, y+ysize, BGRA(r, g, b,255), dmSet);
  67.   end;
  68.   for i := 0 to 31 do
  69.   begin
  70.     r := Max(baseR - (baseR * (i+1)  div 31), 0);   // remove (i+1)
  71.     g := Max(baseG - (baseG * (i+1)  div 31), 0);
  72.     b := Max(baseB - (baseB * (i+1)  div 31), 0);
  73.     Bitmap.FillRect(xpos+v+(i*8), y, xpos+v+(i*8)+8, y+ysize, BGRA(r, g, b,255), dmSet);
  74.   end;
  75. end;
  76.  
  77. procedure TForm1.FormCreate(Sender: TObject);
  78. var
  79. i : integer;
  80. begin
  81.  
  82.   for i:=0 to 7 do
  83.   cop[i] := TBGRABitmap.Create(BGRAVirtualScreen1.Width,4);// 4 pixel Height
  84.  
  85.   //Randomize;
  86.   //rez := choose([1,4,8,12,3,19,38,72,113,120]);
  87.   //label1.Caption:= InttoStr(rez);
  88. end;
  89.  
  90. procedure TForm1.BGRAVirtualScreen1Redraw(Sender: TObject; Bitmap: TBGRABitmap);
  91. begin
  92.      Raster_bar(cop[0],0 ,0,4,  255,000,000);
  93.      Raster_bar(cop[1],0 ,0,4,  255,100,000);
  94.      Raster_bar(cop[2],0 ,0,4,  255,220,000);
  95.      Raster_bar(cop[3],0 ,0,4,  000,250,000);
  96.      Raster_bar(cop[4],0 ,0,4,  000,220,255);
  97.      Raster_bar(cop[5],0 ,0,4,  000,000,255);
  98.      Raster_bar(cop[6],0 ,0,4,  255,000,255);
  99.      Raster_bar(cop[7],0 ,0,4,  255,255,255);
  100.  
  101.      bitmap.PutImage(-640+PosX,  PosY+00,cop[0],dmSet);
  102.      bitmap.PutImage(640+(-PosX),PosY+04,cop[1],dmSet);
  103.      bitmap.PutImage(-640+PosX,  PosY+08,cop[2],dmSet);
  104.      bitmap.PutImage(640+(-PosX),PosY+12,cop[3],dmSet);
  105.      bitmap.PutImage(-640+PosX,  PosY+16,cop[4],dmSet);
  106.      bitmap.PutImage(640+(-PosX),PosY+20,cop[5],dmSet);
  107.      bitmap.PutImage(-640+PosX,  PosY+24,cop[6],dmSet);
  108.      bitmap.PutImage(640+(-PosX),PosY+28,cop[7],dmSet);
  109.  
  110. end;
  111.  
  112. procedure TForm1.Timer1Timer(Sender: TObject);
  113. begin
  114.     Speed := SpinEdit1.Value;
  115.     PosY := SpinEdit2.Value;
  116.     PosX := (Posx + Speed) mod 1200;
  117.     BGRAVirtualScreen1.RedrawBitmap;
  118. end;
  119.  
  120. end.
Logged
Sub Quantum Technology ! Gigatron 68000 Colmar France;

Gigatron

  • Full Member
  • ***
  • Posts: 244
  • Amiga Rulez !!
Re: RGB Plasma
« Reply #5 on: May 08, 2025, 03:18:52 am »
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][+][-]
  1. unit Unit1;
  2.  
  3. {$mode objfpc}{$H+}
  4.  
  5. interface
  6.  
  7. uses
  8.   Classes, SysUtils, Forms, Controls, Graphics, Dialogs, ExtCtrls, Spin,
  9.   StdCtrls, BGRAVirtualScreen, BGRABitmap, BGRABitmapTypes,Math;
  10.  
  11. type
  12.  
  13.   { TForm1 }
  14.  
  15.   TForm1 = class(TForm)
  16.     BGRAVirtualScreen1: TBGRAVirtualScreen;
  17.     Swap_btn: TButton;
  18.     Blue_Spin: TSpinEdit;
  19.     Panel1: TPanel;
  20.     Green_Spin: TSpinEdit;
  21.     SpinEdit1: TSpinEdit;
  22.     Red_Spin: TSpinEdit;
  23.     Title_label: TLabel;
  24.     Timer1: TTimer;
  25.     procedure BGRAVirtualScreen1Redraw(Sender: TObject; Bitmap: TBGRABitmap);
  26.     procedure Swap_btnClick(Sender: TObject);
  27.     procedure FormCreate(Sender: TObject);
  28.     procedure Timer1Timer(Sender: TObject);
  29.   private
  30.     procedure Raster_bar(Bitmap: TBGRABitmap; xpos,y,ysize: Integer; baseR, baseG, baseB: Byte);
  31.  
  32.   public
  33.      Red, Green, Blue : Integer;
  34.   end;
  35.  
  36. var
  37.   Form1: TForm1;
  38.   Speed, posX,Pos1,Pos2 : integer;
  39.   cop  : array [0..1] of TBGRABitmap; // 2 bars
  40.   Swap_Position : Boolean = False;
  41.  
  42. implementation
  43.  
  44. {$R *.lfm}
  45.  
  46. { TForm1 }
  47.  
  48. procedure TForm1.Raster_bar(Bitmap: TBGRABitmap; xpos,y,ysize: Integer; baseR, baseG, baseB: Byte);
  49. var
  50.   i,v: Integer;
  51.   r, g, b: Byte;
  52. begin
  53.    v  := 0; // store i
  54.    Bitmap.FillRect(0,0,BGRAVirtualScreen1.Width,ysize,bgra(0,0,0),dmset);
  55.   for i := 0 to 31 do  // 32*8 = 256 pixel ; 8 mean 8 pixel width
  56.   begin
  57.     r := Min(baseR * i div 31, 255);
  58.     g := Min(baseG * i div 31, 255);
  59.     b := Min(baseB * i div 31, 255);
  60.     v := i*8;
  61.     bitmap.FillRect(xpos+i*8, y, xpos+i*8+8, y+ysize, BGRA(r, g, b,255), dmSet);
  62.   end;
  63.   for i := 0 to 31 do   // 32*8 = 256 pixel  ; 8 mean 8 pixel width
  64.   begin
  65.     r := Max(baseR - (baseR * (i+1)  div 31), 0);
  66.     g := Max(baseG - (baseG * (i+1)  div 31), 0);
  67.     b := Max(baseB - (baseB * (i+1)  div 31), 0);
  68.     Bitmap.FillRect(xpos+v+(i*8), y, xpos+v+(i*8)+8, y+ysize, BGRA(r, g, b,255), dmSet);
  69.   end;
  70. end;
  71.  
  72. procedure TForm1.FormCreate(Sender: TObject);
  73. var
  74. i : integer;
  75. begin
  76.   Pos1 := 60;
  77.   Pos2 := 460;
  78.   for i:=0 to 1 do
  79.    cop[i] := TBGRABitmap.Create(BGRAVirtualScreen1.Width,4);// 4 pixel Height in case
  80. end;
  81.  
  82. procedure TForm1.BGRAVirtualScreen1Redraw(Sender: TObject; Bitmap: TBGRABitmap);
  83. var
  84. i : Integer;
  85. begin
  86.      for i:=0 to 1 do   // 2 barres en X position  _+_
  87.        begin
  88.          Raster_bar(cop[0],0 ,0,2, Red, Green, Blue);
  89.          bitmap.PutImage((i*512)-PosX ,     Pos1,cop[0],dmSet);  // Move Left To Right 8*32*2=512
  90.          bitmap.PutImage(-512+(i*512)+PosX ,Pos2,cop[0],dmSet); // Move Right To Left  8*32*2=512
  91.        end;
  92. end;
  93. // Swap Bar Position
  94. procedure TForm1.Swap_btnClick(Sender: TObject);
  95. begin
  96.       Swap_Position :=  not Swap_Position;
  97.       if Swap_Position then
  98.         begin
  99.           Pos2 := 60;
  100.           Pos1 := 460;
  101.         end
  102.       else
  103.         begin
  104.           Pos2 := 460;
  105.           Pos1 := 60;
  106.         end;
  107.  
  108.       BGRAVirtualScreen1.RedrawBitmap;
  109. end;
  110.  
  111. procedure TForm1.Timer1Timer(Sender: TObject);
  112. begin
  113.     Speed := SpinEdit1.Value;
  114.     Red   := Red_Spin.Value;
  115.     Green := Green_Spin.Value;
  116.     Blue  := Blue_Spin.Value;
  117.     PosX := (Posx + Speed) mod 512; // 8*32*2 = 512 pixel; modulo reset to 0 ;
  118.     BGRAVirtualScreen1.RedrawBitmap;
  119. end;
  120.  
  121. end.
Logged
Sub Quantum Technology ! Gigatron 68000 Colmar France;
Pages: [1]
« previous next »
 

TinyPortal © 2005-2018