Recent

« previous next »
Pages: [1]

Author Topic: Demoscene The Champs Cracktro  (Read 2229 times)

Gigatron

  • Full Member
  • ***
  • Posts: 154
  • Amiga Rulez !!
Demoscene The Champs Cracktro
« on: April 18, 2024, 02:26:07 am »
Hi , late at night i woul like to share one of my new project;

The champs cracktro made wit LP;

In the past i made it with gdscript with Godot ;

https://www.youtube.com/watch?v=8ePm_udSYV4

Code with LP : missing font ... but i am working ;

Code: Pascal  [Select][+][-]
  1. unit Unit1;
  2.  
  3. {$mode objfpc}{$H+}
  4.  
  5. interface
  6.  
  7. uses
  8.   Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, ExtCtrls,
  9.   BGLVirtualScreen, BGRAOpenGL, BGRABitmap,
  10.   BGRABitmapTypes;
  11.  
  12. const
  13.   StarCount = 400;
  14.   MaxSpeed  = 3;
  15.  
  16. type
  17.   TStar = record        //  Stars
  18.     X, Y, Z: Double;
  19.     Speed:   Double;
  20.   end;
  21.  
  22.   { TForm1 }
  23.  
  24.   TForm1 = class(TForm)
  25.     BGLVirtualScr: TBGLVirtualScreen;
  26.     Timer1: TTimer;
  27.     procedure BGLVirtualScrRedraw(Sender: TObject; BGLContext: TBGLContext);
  28.     procedure BGLVirtualScrUnloadTextures(Sender: TObject; BGLContext: TBGLContext);
  29.     procedure FormCreate(Sender: TObject);
  30.     procedure FormShow(Sender: TObject);
  31.     procedure Timer1Timer(Sender: TObject);
  32.  
  33.     private
  34.  
  35.     Stars  : array of TStar;
  36.     a_logo, bg_copper      : IBGLTexture;
  37.     one,nine,eight,eight_2 : IBGLTexture;
  38.  
  39.     private
  40.  
  41.     const cop_col:Array[0..245] of String =('#000066','#000055','#000044','#000033','#000022','#000011','#000011','#000022','#000033',
  42.                                             '#000044','#000055','#000066','#000077','#000088','#000099','#0000aa','#0000bb','#0000cc',
  43.                                             '#0000dd','#0000ee','#0000ff','#1111ff','#2222ff','#3333ff','#4444ff','#5555ff','#6666ff',
  44.                                             '#7777ff','#8888ff','#9999ff','#aaaaff','#bbbbff','#ccccff','#ddddff','#eeeeff','#eeffff',
  45.                                             '#ffffff','#ffffff','#eeffff','#eeeeff','#ddddff','#ccccff','#bbbbff','#aaaaff','#9999ff',
  46.                                             '#8888ff','#7777ff','#6666ff','#5555ff','#4444ff','#3333ff','#2222ff','#1111ff','#0000ff',
  47.                                             '#0000ee','#0000dd','#0000cc','#0000bb','#0000aa','#000099','#000088','#000077','#000066',
  48.                                             '#000055','#000044','#000033','#000022','#000011','#000022','#000033','#000044','#000055',
  49.                                             '#000066','#000077','#000088','#000099','#0000aa','#0000bb','#0000cc','#0000dd','#0000ee',
  50.                                             '#0000ff','#1111ff','#2222ff','#3333ff','#4444ff','#5555ff','#6666ff','#7777ff','#8888ff',
  51.                                             '#9999ff','#aaaaff','#bbbbff','#ccccff','#ddddff','#eeeeff','#eeffff','#ffffff','#ffffff',
  52.                                             '#eeffff','#eeeeff','#ddddff','#ccccff','#bbbbff','#aaaaff','#9999ff','#8888ff','#7777ff',
  53.                                             '#6666ff','#5555ff','#4444ff','#3333ff','#2222ff','#1111ff','#0000ff','#0000ee','#0000dd',
  54.                                             '#0000cc','#0000bb','#0000aa','#000099','#000088','#000077','#000066','#000055','#000044',
  55.                                             '#000033','#000022','#000011','#000011','#000022','#000033','#000044','#000055','#000066',
  56.                                             '#000077','#000088','#000099','#0000aa','#0000bb','#0000cc','#0000dd','#0000ee','#0000ff',
  57.                                             '#1111ff','#2222ff','#3333ff','#4444ff','#5555ff','#6666ff','#7777ff','#8888ff','#9999ff',
  58.                                             '#aaaaff','#bbbbff','#ccccff','#ddddff','#eeeeff','#eeffff','#ffffff','#ffffff','#eeffff',
  59.                                             '#eeeeff','#ddddff','#ccccff','#bbbbff','#aaaaff','#9999ff','#8888ff','#7777ff','#6666ff',
  60.                                             '#5555ff','#4444ff','#3333ff','#2222ff','#1111ff','#0000ff','#0000ee','#0000dd','#0000cc',
  61.                                             '#0000bb','#0000aa','#000099','#000088','#000077','#000066','#000055','#000044','#000033',
  62.                                             '#000022','#000011','#000022','#000033','#000044','#000055','#000066','#000077','#000088',
  63.                                             '#000099','#0000aa','#0000bb','#0000cc','#0000dd','#0000ee','#0000ff','#1111ff','#2222ff',
  64.                                             '#3333ff','#4444ff','#5555ff','#6666ff','#7777ff','#8888ff','#9999ff','#aaaaff','#bbbbff',
  65.                                             '#ccccff','#ddddff','#eeeeff','#eeffff','#ffffff','#ffffff','#eeffff','#eeeeff','#ddddff',
  66.                                             '#ccccff','#bbbbff','#aaaaff','#9999ff','#8888ff','#7777ff','#6666ff','#5555ff','#4444ff',
  67.                                             '#3333ff','#2222ff','#1111ff','#0000ff','#0000ee','#0000dd','#0000cc','#0000bb','#0000aa',
  68.                                             '#000099','#000088','#000077');
  69.  
  70.   // Sin table Ripped by Gigatron Winuae Debugger; x first 255 , y after 256 to 512 !!
  71.   const sprite_dat : Array[0..511] of integer = (80,80,81,83,86,90,94,99,104,110,116,123,130,137,145,152,159,167,173,180,186,192,197,
  72.                                                  202,206,209,212,214,215,216,216,216,214,213,210,208,205,201,197,193,189,185,181,177,
  73.                                                  173,169,166,162,160,157,155,153,152,151,151,151,151,152,153,155,156,158,160,162,164,
  74.                                                  166,168,170,171,172,173,174,174,174,173,172,170,168,166,163,160,156,152,148,143,139,
  75.                                                  134,129,125,120,116,112,108,105,102,100,98,97,97,97,98,100,102,106,109,114,119,125,131,
  76.                                                  137,144,151,159,166,174,182,189,196,203,209,215,221,226,230,233,236,238,239,239,238,237,
  77.                                                  235,232,228,224,219,214,208,202,195,188,181,174,167,160,154,147,141,135,130,125,121,118,
  78.                                                  115,112,111,110,109,109,110,112,113,116,118,121,124,128,131,135,139,142,146,149,152,155,
  79.                                                  157,159,161,162,163,163,163,163,162,161,160,158,156,154,152,150,148,146,144,142,141,139,
  80.                                                  139,138,138,139,139,141,143,145,148,151,155,159,163,168,173,178,183,188,194,199,204,208,
  81.                                                  212,216,220,222,225,226,227,227,227,225,223,221,217,213,208,203,197,190,183,176,169,161,
  82.                                                  153,145,138,130,123,116,110,104,99,94,90,87,84,83,82,86,82,79,75,72,68,65,62,60,57,55,54,
  83.                                                  53,52,51,51,51,52,53,54,55,57,59,62,64,67,69,72,75,78,81,83,86,89,91,93,95,97,98,99,100,
  84.                                                  101,101,102,101,101,101,100,99,98,97,96,95,94,92,91,90,89,88,87,87,86,86,86,86,86,87,88,
  85.                                                  88,89,90,92,93,94,96,97,99,100,101,102,103,104,105,105,105,105,105,104,103,102,100,98,96,
  86.                                                  94,92,89,86,83,80,77,74,71,68,65,63,60,58,56,54,52,51,50,50,50,50,50,51,53,55,57,59,62,65,
  87.                                                  68,71,75,78,82,86,89,93,97,100,103,106,109,111,114,115,117,118,119,119,119,119,119,118,116,
  88.                                                  115,113,111,109,107,104,102,99,96,94,91,89,86,84,82,80,79,77,76,75,75,74,74,74,75,75,76,76,
  89.                                                  77,78,79,80,81,82,83,84,85,86,87,87,87,87,87,87,86,86,85,84,82,81,80,78,76,75,73,72,70,69,67,
  90.                                                  66,65,65,64,64,64,64,65,66,67,68,70,72,74,77,80,83,86,89,92,95,98,102,105,108,111,113,116,118,
  91.                                                  120,121,122,123,124,124,123,123,121,120,118,116,114,111,108,105,101,98,94,91);
  92.  
  93.     procedure InitializeStarfield;
  94.     procedure UpdateStarfield;
  95.  
  96.   public
  97.  
  98.   end;
  99.  
  100. var
  101.   Form1: TForm1;
  102.  
  103.   hexColor: string;
  104.   red, green, blue: Byte;
  105.   pause : integer;
  106.   j: integer;
  107.  
  108.   // sprite  vars
  109.  
  110.   xx,yy,nx,ny,ex,ey,exx,eyy : integer;
  111.  
  112. implementation
  113.  
  114. {$R *.lfm}
  115.  
  116. { TForm1 }
  117.  
  118. procedure TForm1.FormCreate(Sender: TObject);
  119. begin
  120.   Randomize;
  121.   InitializeStarfield;
  122.   j:=0;
  123.   pause := 0;
  124.  // sprite var initialisation one,nine,eight * 2
  125.   xx :=0;
  126.   yy := 256;
  127.   nx := 6;
  128.   ny := 256+6;
  129.   ex := 12;
  130.   ey := 256+12;
  131.   exx:= 18;
  132.   eyy:= 256+18;
  133.  
  134.  
  135. end;
  136.  
  137. procedure TForm1.FormShow(Sender: TObject);
  138. begin
  139.         bg_copper := BGLTexture('bg_copper.png');
  140.         a_logo := BGLTexture('champs_logo.png');
  141.  
  142.         one     := BGLTexture('one.png');
  143.         nine    := BGLTexture('nine.png');
  144.         eight   := BGLTexture('eight.png');
  145.         eight_2 := BGLTexture('eight_2.png');
  146.  
  147.  
  148. end;
  149.  
  150. procedure TForm1.InitializeStarfield;
  151. var
  152.   i: Integer;
  153. begin
  154.   SetLength(Stars, StarCount); // Nombre d'étoiles
  155.   for i := 0 to High(Stars) do
  156.   begin
  157.     Stars[i].X := Random(ClientWidth);
  158.     Stars[i].Y := (60+Random(ClientHeight-140));
  159.     Stars[i].Speed := Random * 2 + 1; // Vitesse aléatoire
  160.   end;
  161. end;
  162.  
  163. procedure TForm1.UpdateStarfield;
  164. var
  165.   i : integer;
  166. begin
  167.   for i := 0 to High(Stars) do
  168.   begin
  169.      Stars[i].X := Stars[i].X + Stars[i].Speed*3 ;
  170.  
  171.     if Stars[i].X > ClientWidth then // Réinitialiser la position si l'étoile sort de l'écran
  172.     begin
  173.       Stars[i].X := 0;
  174.       Stars[i].Y := (60+Random(ClientHeight-140));
  175.       Stars[i].Speed := Random * 2 + 1;
  176.  
  177.     end;
  178.   end;
  179. end;
  180.  
  181. procedure HexToRGB(hex: string; var r, g, b: Byte);
  182. begin
  183.   r := StrToInt('$' + Copy(hex, 2, 2));
  184.   g := StrToInt('$' + Copy(hex, 4, 2));
  185.   b := StrToInt('$' + Copy(hex, 6, 2));
  186. end;
  187.  
  188.  
  189. procedure TForm1.BGLVirtualScrRedraw(Sender: TObject; BGLContext: TBGLContext);
  190. var
  191.   i : integer;
  192.   StarPosition: TPoint;
  193.   sttype : Int16 ;
  194.   col: TColor;
  195.  
  196. begin
  197.  
  198.  
  199.  
  200.     // draw logo and update Sf + 2 vertical raster bars
  201.   BGLCanvas.StretchPutImage(0,0,640,480, bg_copper);
  202.   // stars
  203.   for i := 0 to High(Stars) do
  204.   begin
  205.  
  206.     StarPosition.X := Round(Stars[i].X );
  207.     StarPosition.Y := Round(Stars[i].Y);
  208.     sttype := Round(Stars[i].Speed);
  209.  
  210.     col := RGBToColor(50,50,50);
  211.     // stars bitplanes colors
  212.     case  (sttype)  of
  213.       1: col := RGBToColor(50,50,50);
  214.       2: col := RGBToColor(238,238,238);
  215.       3: col := RGBToColor(100,136,255);
  216.       4: col := RGBToColor(125,125,125);
  217.       5: col := RGBToColor(150,150,150);
  218.       6: col := RGBToColor(175,175,175);
  219.       7: col := RGBToColor(200,200,200);
  220.       8: col := RGBToColor(254,254,254);
  221.  
  222.     end;
  223.       BGLContext.Canvas.Rectangle(StarPosition.X, StarPosition.Y,StarPosition.X+1,StarPosition.Y+1,col);
  224.   end;
  225.  
  226.   // raster bars cycle colors with pause like A-Team intro
  227.   for i := 0 to 31 do
  228.   begin
  229.        hexColor := cop_col[i+j];
  230.        HexToRGB(hexColor, red, green, blue);
  231.        BGLContext.Canvas.FillRect(0,370+i*2,640,370+i*2-4,RGBToColor(red,green,blue));
  232.  
  233.   end;
  234.  
  235.   inc(pause);
  236.    if (pause>=3) then
  237.    begin
  238.        inc(j);
  239.        pause := 0;
  240.        if(j>=184) then j:=0;
  241.  
  242.     end;
  243.  
  244.   BGLCanvas.PutImage(0,50,a_logo,255);    // champs 1988
  245.  
  246.   // sprites
  247.  
  248.   // sin table ...
  249.  
  250.    BGLCanvas.StretchPutImage(-30+sprite_dat[xx]*2 ,-20+sprite_dat[yy]*2,32,32,eight);
  251.    BGLCanvas.StretchPutImage(-30+sprite_dat[nx]*2 ,-20+sprite_dat[ny]*2,32,32,eight);
  252.    BGLCanvas.StretchPutImage(-30+sprite_dat[ex]*2 ,-20+sprite_dat[ey]*2,32,32,nine);
  253.    BGLCanvas.StretchPutImage(-30+sprite_dat[exx]*2 ,-20+sprite_dat[eyy]*2,32,32,one);
  254.  
  255.  
  256.    BGLCanvas.StretchPutImage(-10+sprite_dat[xx]*2 ,322,32,32,eight);
  257.    BGLCanvas.StretchPutImage(-10+sprite_dat[nx]*2 ,322,32,32,eight);
  258.    BGLCanvas.StretchPutImage(-10+sprite_dat[ex]*2 ,322,32,32,nine);
  259.    BGLCanvas.StretchPutImage(-10+sprite_dat[exx]*2 ,322,32,32,one);
  260.  
  261.    // limites les boucles
  262.  
  263.  
  264.     inc(exx);
  265.     inc(eyy);
  266.     if(exx>=255) then exx :=0;
  267.     if(eyy>=511) then eyy :=256;
  268.  
  269.     inc(ex);
  270.     inc(ey);
  271.     if(ex>=255) then ex :=0;
  272.     if(ey>=511) then ey :=256;
  273.  
  274.     inc(nx);
  275.     inc(ny);
  276.     if(nx>=255) then nx :=0;
  277.     if(ny>=511) then ny :=256;
  278.  
  279.     inc(xx);
  280.     inc(yy);
  281.     if(xx>=255) then xx :=0;
  282.     if(yy>=511) then yy :=256;
  283.  
  284.  
  285.   UpdateStarfield;
  286.  
  287.  
  288.  
  289. end;
  290.  
  291. procedure TForm1.BGLVirtualScrUnloadTextures(Sender: TObject; BGLContext: TBGLContext);
  292. begin
  293.  
  294.   bg_copper := nil;
  295.   a_logo    := nil;
  296.  
  297.   one       := nil;
  298.   nine      := nil;
  299.   eight     := nil;
  300.   eight_2   := nil;
  301.  
  302. end;
  303.  
  304.  
  305.  
  306. procedure TForm1.Timer1Timer(Sender: TObject);
  307. begin
  308.  
  309.   BGLVirtualScr.Repaint;
  310. end;
  311.  
  312. end.




Logged
Sub Quantum Technology ! Gigatron 68000 Colmar France;

Lulu

  • Sr. Member
  • ****
  • Posts: 265
Re: Demoscene The Champs Cracktro
« Reply #1 on: April 18, 2024, 08:15:12 am »
Well done!
This remember me the circuits Copper, Blitter in the Amiga500! (may be other ? I forgot)
Logged
wishing you a nice life!
GitHub repositories https://github.com/Lulu04

KodeZwerg

  • Hero Member
  • *****
  • Posts: 2269
  • Fifty shades of code.
    • Delphi & FreePascal
Re: Demoscene The Champs Cracktro
« Reply #2 on: April 18, 2024, 06:20:31 pm »
Great job!
I hope you add soon a compressed project with those missing images so we can enjoy it as its supposed to be :D
Logged
« Last Edit: Tomorrow at 31:76:97 xm by KodeZwerg »

Gigatron

  • Full Member
  • ***
  • Posts: 154
  • Amiga Rulez !!
Re: Demoscene The Champs Cracktro
« Reply #3 on: April 18, 2024, 11:03:40 pm »
Hi,

I must just code bitmapfont scroller and it'ok  ;

Logged
Sub Quantum Technology ! Gigatron 68000 Colmar France;

KodeZwerg

  • Hero Member
  • *****
  • Posts: 2269
  • Fifty shades of code.
    • Delphi & FreePascal
Re: Demoscene The Champs Cracktro
« Reply #4 on: April 18, 2024, 11:29:50 pm »
Another way for a starfield simulation thingy ...
The stars are not moving, they are blinking to simulate you watching stars.
For my taste, less "stars" are better but tested without any problems up to 50k.
Maybe it be useful for upcoming demos/effects.
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,
  9.   BGLVirtualScreen, BGRAOpenGL;
  10.  
  11. type
  12.   TStar = packed record
  13.     X,
  14.     Y: Integer;
  15.     CurCol: TColor;
  16.   end;
  17.   TStars = array of TStar;
  18.  
  19. type
  20.  
  21.   { TForm1 }
  22.  
  23.   TForm1 = class(TForm)
  24.     BGLVirtualScreen1: TBGLVirtualScreen;
  25.     Panel1: TPanel;
  26.     Timer1: TTimer;
  27.     procedure BGLVirtualScreen1Redraw(Sender: TObject; BGLContext: TBGLContext);
  28.     procedure BGLVirtualScreen1Resize(Sender: TObject);
  29.     procedure FormShow(Sender: TObject);
  30.     procedure Timer1Timer(Sender: TObject);
  31.   strict private
  32.     FStars: TStars;
  33.     FMaxStars: Integer;
  34.   private
  35.     procedure GenerateStars(const AMaxStars: Integer);
  36.   public
  37.  
  38.   end;
  39.  
  40. var
  41.   Form1: TForm1;
  42.  
  43. implementation
  44.  
  45. {$R *.lfm}
  46.  
  47. { TForm1 }
  48.  
  49. procedure TForm1.FormShow(Sender: TObject);
  50. begin
  51.   Randomize;
  52.   GenerateStars(300); // adjust the stars, lower is better
  53.   Timer1.Interval := 250; // adjust the timer, higher is better
  54. end;
  55.  
  56. procedure TForm1.GenerateStars(const AMaxStars: Integer);
  57. var
  58.   i: Integer;
  59. begin
  60.   SetLength(FStars, AMaxStars);
  61.   FMaxStars := AMaxStars;
  62.   for i := Low(FStars) to High(FStars) do
  63.     begin
  64.       FStars[i].X := Random(BGLVirtualScreen1.Width);
  65.       FStars[i].Y := Random(BGLVirtualScreen1.Height);
  66.       FStars[i].CurCol := RGBToColor(
  67.                    Round(255 + (16 - 255) * Succ(i)),
  68.                    Round(255 + (16 - 255) * Succ(i)),
  69.                    Round(255 + (16 - 255) * Succ(i))
  70.                  );
  71.     end;
  72. end;
  73.  
  74. procedure TForm1.Timer1Timer(Sender: TObject);
  75. begin
  76.   BGLVirtualScreen1.Repaint;
  77. end;
  78.  
  79. procedure TForm1.BGLVirtualScreen1Redraw(Sender: TObject;
  80.   BGLContext: TBGLContext);
  81. var
  82.   i: Integer;
  83. begin
  84.   for i := Low(FStars) to High(FStars) do
  85.     BGLContext.Canvas.FillRect(FStars[i].X, FStars[i].Y, FStars[i].X + Succ(Random(2)), FStars[i].Y + Succ(Random(1)), FStars[i].CurCol);
  86. end;
  87.  
  88. procedure TForm1.BGLVirtualScreen1Resize(Sender: TObject);
  89. begin
  90.   GenerateStars(FMaxStars);
  91. end;
  92.  
  93. end.
Logged
« Last Edit: Tomorrow at 31:76:97 xm by KodeZwerg »

KodeZwerg

  • Hero Member
  • *****
  • Posts: 2269
  • Fifty shades of code.
    • Delphi & FreePascal
Re: Demoscene The Champs Cracktro
« Reply #5 on: April 19, 2024, 01:45:18 pm »
Here are some copperbars :D
Code: Pascal  [Select][+][-]
  1. unit uMain;
  2.  
  3. {$mode objfpc}{$H+}
  4.  
  5. interface
  6.  
  7. uses
  8.   Classes, SysUtils, Forms, Controls, Graphics, Dialogs, ExtCtrls,
  9.   BGLVirtualScreen, BGRAOpenGL, BGRABitmap,
  10.   BGRABitmapTypes, BGRAGradientScanner;
  11.  
  12. type
  13.   TCopperBar = packed record
  14.     Gradient: TBGRACustomGradient;
  15.     Y: Integer;
  16.     Size: Integer;
  17.     IsAdd: Boolean;
  18.   end;
  19.   TCopperBars = array of TCopperBar;
  20.  
  21. type
  22.  
  23.   { TForm1 }
  24.  
  25.   TForm1 = class(TForm)
  26.     BGLVirtualScreen1: TBGLVirtualScreen;
  27.     Panel1: TPanel;
  28.     Timer1: TTimer;
  29.     procedure BGLVirtualScreen1Redraw(Sender: TObject; BGLContext: TBGLContext);
  30.     procedure BGLVirtualScreen1Resize(Sender: TObject);
  31.     procedure FormClose(Sender: TObject; var CloseAction: TCloseAction);
  32.     procedure FormShow(Sender: TObject);
  33.     procedure Timer1Timer(Sender: TObject);
  34.   strict private
  35.     FCB: TCopperBars;
  36.     FMaxBars: Integer;
  37.   private
  38.     procedure ReleaseCB;
  39.     procedure GenerateCB(const AMaxBars: Integer);
  40.   public
  41.   end;
  42.  
  43. var
  44.   Form1: TForm1;
  45.  
  46. implementation
  47.  
  48. {$R *.lfm}
  49.  
  50. { TForm1 }
  51.  
  52. procedure TForm1.BGLVirtualScreen1Redraw(Sender: TObject;
  53.   BGLContext: TBGLContext);
  54. var
  55.   i: Integer;
  56.   sy: Integer;
  57. begin
  58.   for i := High(FCB) downto Low(FCB) do
  59.     for sy := 0 to FCB[i].Size do
  60.       begin
  61.         if FCB[i].IsAdd then
  62.           Inc(FCB[i].Y)
  63.         else
  64.           Dec(FCB[i].Y);
  65.         if FCB[i].Y < BGLContext.Canvas.ClipRect.Top then
  66.           FCB[i].IsAdd := True;
  67.         if FCB[i].Y > BGLContext.Canvas.ClipRect.Height then
  68.           FCB[i].IsAdd := False;
  69.         BGLContext.Canvas.FillRect(0, FCB[i].Y, BGLContext.Canvas.ClipRect.Width, Succ(FCB[i].Y), FCB[i].Gradient.GetColorAtF(sy));
  70.         if FCB[i].IsAdd then
  71.           BGLContext.Canvas.FillRect(0, FCB[i].Y - FCB[i].Size, BGLContext.Canvas.ClipRect.Width, Succ(FCB[i].Y - FCB[i].Size), FCB[i].Gradient.GetColorAtF(FCB[i].Size - sy))
  72.         else
  73.           BGLContext.Canvas.FillRect(0, FCB[i].Y + FCB[i].Size, BGLContext.Canvas.ClipRect.Width, Succ(FCB[i].Y + FCB[i].Size), FCB[i].Gradient.GetColorAtF(FCB[i].Size - sy));
  74.       end;
  75. end;
  76.  
  77. procedure TForm1.BGLVirtualScreen1Resize(Sender: TObject);
  78. begin
  79.   ReleaseCB;
  80.   GenerateCB(FMaxBars);
  81. end;
  82.  
  83. procedure TForm1.FormClose(Sender: TObject; var CloseAction: TCloseAction);
  84. begin
  85.   ReleaseCB;
  86.   CloseAction := caFree;
  87. end;
  88.  
  89. procedure TForm1.FormShow(Sender: TObject);
  90. begin
  91.   Randomize;
  92.   GenerateCB(10);
  93.   Timer1.Interval := 50;
  94.   Timer1.Enabled := True;
  95. end;
  96.  
  97. procedure TForm1.Timer1Timer(Sender: TObject);
  98. begin
  99.   BGLVirtualScreen1.Repaint;
  100. end;
  101.  
  102. procedure TForm1.ReleaseCB;
  103. var
  104.   i: Integer;
  105. begin
  106.   for i := High(FCB) downto Low(FCB) do
  107.     begin
  108.       FCB[i].Size := 0;
  109.       FCB[i].Y := 0;
  110.       FCB[i].IsAdd := False;
  111.       FCB[i].Gradient.Free;
  112.       FCB[i].Gradient := nil;
  113.     end;
  114. end;
  115.  
  116. procedure TForm1.GenerateCB(const AMaxBars: Integer);
  117. var
  118.   i: Integer;
  119.   Y: Integer;
  120. begin
  121.   FMaxBars := AMaxBars;
  122.   SetLength(FCB, FMaxBars);
  123.   Y := BGLVirtualScreen1.Height;
  124.   for i := Low(FCB) to High(FCB) do
  125.     begin
  126.       FCB[i].Size := 10;
  127.       Y := Y - (FCB[i].Size);
  128.       FCB[i].Y := Y;
  129.       FCB[i].Gradient := TBGRAMultiGradient.Create([RGBToColor(Random(High(Byte)), Random(High(Byte)), Random(High(Byte))), clBlackOpaque], [0, FCB[i].Size], True, False);
  130.       FCB[i].IsAdd := True;
  131.     end;
  132. end;
  133.  
  134. end.
Logged
« Last Edit: Tomorrow at 31:76:97 xm by KodeZwerg »

KodeZwerg

  • Hero Member
  • *****
  • Posts: 2269
  • Fifty shades of code.
    • Delphi & FreePascal
Re: Demoscene The Champs Cracktro
« Reply #6 on: April 19, 2024, 10:36:21 pm »
Copperbars -> Shadowbars!
Switched to the BGRA version for easier bitmap manipulation.
Switched to a fixed autocolored version with a nice shadow effect (gradient color switching)
Hope its useful to someone.
Heres the code, in attachment a full working demo project.
Code: Pascal  [Select][+][-]
  1. unit uMain;
  2.  
  3. {$mode objfpc}{$H+}
  4.  
  5. interface
  6.  
  7. uses
  8.   Classes, SysUtils, Forms, Controls, Graphics, Dialogs, ExtCtrls, Spin,
  9.   StdCtrls, BGRABitmap, BGRABitmapTypes,
  10.   BGRAGradientScanner, BGRAVirtualScreen, BCTypes;
  11.  
  12. type
  13.   TCopperBar = packed record
  14.     Gradient: TBGRACustomGradient;
  15.     Y: Integer;
  16.     Size: Integer;
  17.     IsAdd: Boolean;
  18.   end;
  19.   TCopperBars = array of TCopperBar;
  20.  
  21. type
  22.  
  23.   { TForm1 }
  24.  
  25.   TForm1 = class(TForm)
  26.     BGRAVirtualScreen1: TBGRAVirtualScreen;
  27.     Label1: TLabel;
  28.     Label2: TLabel;
  29.     Label3: TLabel;
  30.     Panel1: TPanel;
  31.     SpinEdit1: TSpinEdit;
  32.     SpinEdit2: TSpinEdit;
  33.     SpinEdit3: TSpinEdit;
  34.     Timer1: TTimer;
  35.     procedure BGRAVirtualScreen1Redraw(Sender: TObject; Bitmap: TBGRABitmap);
  36.     procedure BGRAVirtualScreen1Resize(Sender: TObject);
  37.     procedure FormClose(Sender: TObject; var CloseAction: TCloseAction);
  38.     procedure FormShow(Sender: TObject);
  39.     procedure SpinEdit1Change(Sender: TObject);
  40.     procedure SpinEdit2Change(Sender: TObject);
  41.     procedure SpinEdit3Change(Sender: TObject);
  42.     procedure Timer1Timer(Sender: TObject);
  43.   strict private
  44.     FCB: TCopperBars;
  45.     FMaxBars: Integer;
  46.   private
  47.     procedure ReleaseCB;
  48.     procedure GenerateCB;
  49.   public
  50.   end;
  51.  
  52. var
  53.   Form1: TForm1;
  54.  
  55. implementation
  56.  
  57. {$R *.lfm}
  58.  
  59. { TForm1 }
  60.  
  61. procedure TForm1.BGRAVirtualScreen1Redraw(Sender: TObject; Bitmap: TBGRABitmap);
  62. var
  63.   i: Integer;
  64.   sy: Integer;
  65.   bmp: TBGRABitmap;
  66. begin
  67.   bmp := TBGRABitmap.Create(BGRAVirtualScreen1.Width, BGRAVirtualScreen1.Height);
  68.   bmp.Canvas.Brush.Color := BGRAVirtualScreen1.Color;
  69.   bmp.Canvas.FillRect(bmp.Canvas.ClipRect);
  70.   try
  71.     for i := High(FCB) downto Low(FCB) do
  72.       begin
  73.         for sy := 0 to FCB[i].Size do
  74.           begin
  75.             if FCB[i].IsAdd then
  76.               Inc(FCB[i].Y)
  77.             else
  78.               Dec(FCB[i].Y);
  79.             if (FCB[i].Y < (bmp.Canvas.ClipRect.Top - FCB[i].Size)) then
  80.               FCB[i].IsAdd := True;
  81.             if (FCB[i].Y > (bmp.Canvas.ClipRect.Height + FCB[i].Size)) then
  82.               FCB[i].IsAdd := False;
  83.             bmp.Canvas.Brush.Color := FCB[i].Gradient.GetColorAtF(sy);
  84.             bmp.Canvas.FillRect(bmp.Canvas.ClipRect.Left, FCB[i].Y, bmp.Canvas.ClipRect.Width, Succ(FCB[i].Y));
  85.             bmp.Canvas.Brush.Color := FCB[i].Gradient.GetColorAtF(FCB[i].Size - sy);
  86.             if FCB[i].IsAdd then
  87.               bmp.Canvas.FillRect(bmp.Canvas.ClipRect.Left, FCB[i].Y - FCB[i].Size, bmp.Canvas.ClipRect.Width, Succ(FCB[i].Y - FCB[i].Size))
  88.             else
  89.               bmp.Canvas.FillRect(bmp.Canvas.ClipRect.Left, FCB[i].Y + FCB[i].Size, bmp.Canvas.ClipRect.Width, Succ(FCB[i].Y + FCB[i].Size));
  90.           end;
  91.       end;
  92.     Bitmap.Assign(bmp);
  93.   finally
  94.     bmp.Free;
  95.   end;
  96. end;
  97.  
  98. procedure TForm1.BGRAVirtualScreen1Resize(Sender: TObject);
  99. begin
  100.   Timer1.Enabled := False;
  101.   ReleaseCB;
  102.   GenerateCB;
  103.   Timer1.Enabled := True;
  104. end;
  105.  
  106.  
  107. procedure TForm1.FormClose(Sender: TObject; var CloseAction: TCloseAction);
  108. begin
  109.   Timer1.Enabled := False;
  110.   ReleaseCB;
  111.   CloseAction := caFree;
  112. end;
  113.  
  114. procedure TForm1.FormShow(Sender: TObject);
  115. begin
  116.   Randomize;
  117.   GenerateCB;
  118.   Timer1.Interval := SpinEdit3.Value;
  119.   Timer1.Enabled := True;
  120. end;
  121.  
  122. procedure TForm1.SpinEdit1Change(Sender: TObject);
  123. begin
  124.   Timer1.Enabled := False;
  125.   ReleaseCB;
  126.   GenerateCB;
  127.   Timer1.Enabled := True;
  128. end;
  129.  
  130. procedure TForm1.SpinEdit2Change(Sender: TObject);
  131. begin
  132.   Timer1.Enabled := False;
  133.   ReleaseCB;
  134.   GenerateCB;
  135.   Timer1.Enabled := True;
  136. end;
  137.  
  138. procedure TForm1.SpinEdit3Change(Sender: TObject);
  139. begin
  140.   Timer1.Interval := SpinEdit3.Value;
  141. end;
  142.  
  143. procedure TForm1.Timer1Timer(Sender: TObject);
  144. begin
  145.   BGRAVirtualScreen1.RedrawBitmap;
  146. end;
  147.  
  148. procedure TForm1.ReleaseCB;
  149. var
  150.   i: Integer;
  151. begin
  152.   for i := High(FCB) downto Low(FCB) do
  153.     begin
  154.       FCB[i].Size := 0;
  155.       FCB[i].Y := 0;
  156.       FCB[i].IsAdd := False;
  157.       FCB[i].Gradient.Free;
  158.       FCB[i].Gradient := nil;
  159.     end;
  160.   SetLength(FCB, 0);
  161.   FCB := nil;
  162. end;
  163.  
  164. procedure TForm1.GenerateCB;
  165. var
  166.   i: Integer;
  167.   Y: Integer;
  168.   Gradient: TBGRACustomGradient;
  169. begin
  170.   Y := BGRAVirtualScreen1.Height;
  171.   FMaxBars := Succ(Round(Y / SpinEdit2.Value) * 2);
  172.   SpinEdit1.Value := FMaxBars;
  173.   SetLength(FCB, FMaxBars);
  174.   Gradient := TBGRAMultiGradient.Create([RGBToColor(Random(High(Byte)), Random(High(Byte)), Random(High(Byte))), clBlackOpaque], [0, FMaxBars], True, False);
  175.   try
  176.     for i := Low(FCB) to High(FCB) do
  177.       begin
  178.         FCB[i].Size := SpinEdit2.Value;
  179.         Y := Y - (FCB[i].Size);
  180.         FCB[i].Y := Y;
  181.         FCB[i].Gradient := TBGRAMultiGradient.Create([Gradient.GetColorAtF(i), clBlackOpaque], [0, FCB[i].Size], True, False);
  182.         FCB[i].IsAdd := True;
  183.       end;
  184.   finally
  185.     Gradient.Free;
  186.   end;
  187. end;
  188.  
  189. end.
Logged
« Last Edit: Tomorrow at 31:76:97 xm by KodeZwerg »

Gigatron

  • Full Member
  • ***
  • Posts: 154
  • Amiga Rulez !!
Re: Demoscene The Champs Cracktro
« Reply #7 on: April 20, 2024, 01:05:16 am »
Hi, very good job, thank you for the copper bars ;

Now just a nice bitmap scroller for the the champs cracktro, not yet included to the cracktro but usefull for anyone
to learn bitmap scrolling text under 100 lines of 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,
  9.   BGRABitmap, BGRABitmapTypes, BGRAVirtualScreen;
  10.  
  11. const
  12.  
  13.     ascii : Array [0..58] of integer = (26,37,99,99,99,99,99,41,42,43,99,99,44,99,38,99,27,28,29,30,31,32,33,34,35,36,40,99,99,99,99,39,99,0,1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17,18,19,20,21,22,23,24,25);
  14.  
  15.  
  16. var
  17.   CharImage: TBGRABitmap;
  18.   ScrollSpeed: integer = 2;
  19.   ScrollCounter: integer = 1;
  20.   CharWidth : integer = 16;
  21.   CharHeight :  integer = 22;
  22.   CharsPerLine : integer = 700;
  23.   ScrollText2: String = '                                           YEAH OF COURSE !!!  ))))) THE CHAMPS (((((  PRESENT : SIDEWINDER CRACKED BY DELTA FORCE    THE BEST SALUTE GO TO : HOTLINE HIGH QUALITY CRACKINGS DELTA FORCE AND TRISTAR(THE BEST GET BETTER !!!)    THE SPECIAL GREETINGS IN ALPHABETICAL ORDER GO TO : AXXESS ANTITRAX BFBS BLIZZARDS BS1 BST CCW ERNIE FREE NETWORK GENERAL INDY IBB KNIGHT HAWKS MEGAFORCE NEW AGE MR.NEWLOOK NORTHERN LIGHTS POWERXTREME RANDOM ACCESS RED SECTOR SKYLINE TLC TOM VISITOR WIZARDS AND ALL THE OTHERS WE KNOW....   COMMING SOON MORE AND MORE NEW PRG FROM THE UNATTAINABLE   ))))) THE CHAMPS ((((( IN 1988 !!!!!                                                                         ';
  24.  
  25. type
  26.  
  27.   { TForm1 }
  28.  
  29.   TForm1 = class(TForm)
  30.     BGRAVirtualScreen1: TBGRAVirtualScreen;
  31.     Timer1: TTimer;
  32.     procedure BGRAVirtualScreen1Redraw(Sender: TObject; Bitmap: TBGRABitmap);
  33.     procedure FormCreate(Sender: TObject);
  34.     procedure Timer1Timer(Sender: TObject);
  35.   private
  36.  
  37.   public
  38.  
  39.   end;
  40.  
  41.  
  42. var
  43.   Form1: TForm1;
  44.  
  45. implementation
  46.  
  47. {$R *.lfm}
  48.  
  49. { TForm1 }
  50.  
  51. procedure TForm1.FormCreate(Sender: TObject);
  52.  
  53. begin
  54.  
  55.   CharImage := TBGRABitmap.Create('font.png');
  56.  
  57. end;
  58.  
  59. procedure TForm1.BGRAVirtualScreen1Redraw(Sender: TObject; Bitmap: TBGRABitmap);
  60. var
  61.    I,   Chr: Integer;
  62.    CharX, CharY: Integer;
  63.    ScrollOffset: Integer;
  64.  
  65. begin
  66.   Bitmap.Fill(BGRAPixelTransparent);
  67.   ScrollOffset :=  ScrollCounter ;
  68.  
  69.    for I := 0 to Length(ScrollText2) do
  70.     begin
  71.        Chr := Ord(ScrollText2[I]);
  72.        CharX := ((I - 1) mod CharsPerLine) * CharWidth - ScrollOffset  ;
  73.        CharY := ((I - 1) div CharsPerLine) * CharHeight  ;
  74.        Bitmap.PutImagePart(CharX ,240+CharY , CharImage, Rect(0, 24*ascii[chr-32] , 15, 24*ascii[chr-32]+CharHeight), dmDrawWithTransparency);
  75.     end;
  76.  
  77.      ScrollCounter := ScrollCounter + ScrollSpeed;
  78.  
  79.      if ScrollCounter >= CharWidth then
  80.  
  81.    begin
  82.     ScrollCounter := ScrollCounter - CharWidth;
  83.     ScrollText2 := Copy(ScrollText2,2, Length(ScrollText2) - 1) + ScrollText2[1];
  84.   end;
  85.  
  86. end;
  87.  
  88. procedure TForm1.Timer1Timer(Sender: TObject);
  89. begin
  90.  
  91.      BGRAVirtualScreen1.RedrawBitmap;
  92. end;
  93.  
  94. end.
  95.  
Logged
Sub Quantum Technology ! Gigatron 68000 Colmar France;
Pages: [1]
« previous next »
 

TinyPortal © 2005-2018