Demoscene The Champs Cracktro lazarus / 39-Graphics ---------------------------------------------------------------------- Gigatron · 2024-04-18 00:26 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][+][-]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, FileUtil, Forms, Controls, Graphics, Dialogs, ExtCtrls,  BGLVirtualScreen, BGRAOpenGL, BGRABitmap,  BGRABitmapTypes; const  StarCount = 400;  MaxSpeed  = 3; type  TStar = record        //  Stars    X, Y, Z: Double;    Speed:   Double;  end;   { TForm1 }   TForm1 = class(TForm)    BGLVirtualScr: TBGLVirtualScreen;    Timer1: TTimer;    procedure BGLVirtualScrRedraw(Sender: TObject; BGLContext: TBGLContext);    procedure BGLVirtualScrUnloadTextures(Sender: TObject; BGLContext: TBGLContext);    procedure FormCreate(Sender: TObject);    procedure FormShow(Sender: TObject);    procedure Timer1Timer(Sender: TObject);     private     Stars  : array of TStar;    a_logo, bg_copper      : IBGLTexture;    one,nine,eight,eight_2 : IBGLTexture;     private     const cop_col:Array[0..245] of String =('#000066','#000055','#000044','#0000 33','#000022','#000011','#000011','#000022','#000033',                                          '#000044','#000055','#000066','#000077','#0 00088','#000099','#0000aa','#0000bb','#0000cc',                                          '#0000dd','#0000ee','#0000ff','#1111ff','#2222ff', '#3333ff','#4444ff','#5555ff','#6666ff',                                          '#7777ff','#8888ff','#9999ff','#aaaaff','#bbbbff','#ccccf f','#ddddff','#eeeeff','#eeffff',                                          '#ffffff','#ffffff','#eeffff','#eeeeff','#ddddff','#ccccff','#bb bbff','#aaaaff','#9999ff',                                            '#8888ff','#7777ff','#6666ff','#5555ff','#4444ff','#3333ff','#2222ff', '#1111ff','#0000ff',                                            '#0000 ee','#0000dd','#0000cc','#0000bb','#0000aa','#000099','#000088','#0000 77','#000066',                                            '#000055','# 000044','#000033','#000022','#000011','#000022','#000033','#000044','# 000055',                                            '#000066','#000077 ','#000088','#000099','#0000aa','#0000bb','#0000cc','#0000dd','#0000ee ',                                            '#0000ff','#1111ff','#22 22ff','#3333ff','#4444ff','#5555ff','#6666ff','#7777ff','#8888ff',                                          '#9999ff','#aaaaff','#bbbbff',' #ccccff','#ddddff','#eeeeff','#eeffff','#ffffff','#ffffff',                                          '#eeffff','#eeeeff','#ddddff','#ccccff ','#bbbbff','#aaaaff','#9999ff','#8888ff','#7777ff',                                          '#6666ff','#5555ff','#4444ff','#3333ff','#222 2ff','#1111ff','#0000ff','#0000ee','#0000dd',                                          '#0000cc','#0000bb','#0000aa','#000099','#000088','# 000077','#000066','#000055','#000044',                                          '#000033','#000022','#000011','#000011','#000022','#000033' ,'#000044','#000055','#000066',                                          '#000077','#000088','#000099','#0000aa','#0000bb','#0000cc','#0000 dd','#0000ee','#0000ff',                                            '# 1111ff','#2222ff','#3333ff','#4444ff','#5555ff','#6666ff','#7777ff','# 8888ff','#9999ff',                                            '#aaaaff ','#bbbbff','#ccccff','#ddddff','#eeeeff','#eeffff','#ffffff','#ffffff ','#eeffff',                                            '#eeeeff','#dd ddff','#ccccff','#bbbbff','#aaaaff','#9999ff','#8888ff','#7777ff','#66 66ff',                                            '#5555ff','#4444ff', '#3333ff','#2222ff','#1111ff','#0000ff','#0000ee','#0000dd','#0000cc',                                           '#0000bb','#0000aa','#00009 9','#000088','#000077','#000066','#000055','#000044','#000033',                                          '#000022','#000011','#000022','#00 0033','#000044','#000055','#000066','#000077','#000088',                                          '#000099','#0000aa','#0000bb','#0000cc',' #0000dd','#0000ee','#0000ff','#1111ff','#2222ff',                                          '#3333ff','#4444ff','#5555ff','#6666ff','#7777ff ','#8888ff','#9999ff','#aaaaff','#bbbbff',                                          '#ccccff','#ddddff','#eeeeff','#eeffff','#ffffff','#fff fff','#eeffff','#eeeeff','#ddddff',                                          '#ccccff','#bbbbff','#aaaaff','#9999ff','#8888ff','#7777ff','# 6666ff','#5555ff','#4444ff',                                          '#3333ff','#2222ff','#1111ff','#0000ff','#0000ee','#0000dd','#0000cc' ,'#0000bb','#0000aa',                                            '#000099','#000088','#000077');   // Sin table Ripped by Gigatron Winuae Debugger; x first 255 , y after 256 to 512 !!  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,                                               202,206,209,212,214,215,216,216,216,214,213,210, 208,205,201,197,193,189,185,181,177,                                               173,169,166,162,160,157,155,153,152,151,151,151,151,152, 153,155,156,158,160,162,164,                                               166,168,170,171,172,173,174,174,174,173,172,170,168,166,163,160, 156,152,148,143,139,                                                 1 34,129,125,120,116,112,108,105,102,100,98,97,97,97,98,100,102,106,109, 114,119,125,131,                                                 137,1 44,151,159,166,174,182,189,196,203,209,215,221,226,230,233,236,238,239 ,239,238,237,                                                 235,232, 228,224,219,214,208,202,195,188,181,174,167,160,154,147,141,135,130,12 5,121,118,                                                 115,112,111 ,110,109,109,110,112,113,116,118,121,124,128,131,135,139,142,146,149,1 52,155,                                                 157,159,161,16 2,163,163,163,163,162,161,160,158,156,154,152,150,148,146,144,142,141, 139,                                                 139,138,138,139,1 39,141,143,145,148,151,155,159,163,168,173,178,183,188,194,199,204,208 ,                                                 212,216,220,222,225, 226,227,227,227,225,223,221,217,213,208,203,197,190,183,176,169,161,                                               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,                                               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,                                               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,                                               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,                                               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,                                               68,71,75,78,82,86,89,93,97,100,103,106,1 09,111,114,115,117,118,119,119,119,119,119,118,116,                                               115,113,111,109,107,104,102,99,96,94,91,8 9,86,84,82,80,79,77,76,75,75,74,74,74,75,75,76,76,                                               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,                                               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,                                               120,121,122,123,124,124,123,123,121,120 ,118,116,114,111,108,105,101,98,94,91);     procedure InitializeStarfield;    procedure UpdateStarfield;   public   end; var  Form1: TForm1;   hexColor: string;  red, green, blue: Byte;  pause : integer;  j: integer;   // sprite  vars   xx,yy,nx,ny,ex,ey,exx,eyy : integer; implementation {$R *.lfm} { TForm1 } procedure TForm1.FormCreate(Sender: TObject);begin  Randomize;  InitializeStarfield;  j:=0;  pause := 0; // sprite var initialisation one,nine,eight * 2  xx :=0;  yy := 256;  nx := 6;  ny := 256+6;  ex := 12;  ey := 256+12;  exx:= 18;  eyy:= 256+18;  end; procedure TForm1.FormShow(Sender: TObject);begin        bg_copper := BGLTexture('bg_copper.png');        a_logo := BGLTexture('champs_logo.png');         one     := BGLTexture('one.png');        nine    := BGLTexture('nine.png');      eight   := BGLTexture('eight.png');        eight_2 := BGLTexture('eight_2.png');  end; procedure TForm1.InitializeStarfield;var  i: Integer;begin  SetLength(Stars, StarCount); // Nombre d'étoiles  for i := 0 to High(Stars) do  begin  Stars[i].X := Random(ClientWidth);    Stars[i].Y := (60+Random(ClientHeight-140));    Stars[i].Speed := Random * 2 + 1; // Vitesse aléatoire  end;end; procedure TForm1.UpdateStarfield;var  i : integer;begin  for i := 0 to High(Stars) do  begin     Stars[i].X := Stars[i].X + Stars[i].Speed*3 ;     if Stars[i].X > ClientWidth then // Réinitialiser la position si l'étoile sort de l'écran    begin    Stars[i].X := 0;      Stars[i].Y := (60+Random(ClientHeight-140));    Stars[i].Speed := Random * 2 + 1;     end;  end;end; procedure HexToRGB(hex: string; var r, g, b: Byte);begin  r := StrToInt('$' + Copy(hex, 2, 2));  g := StrToInt('$' + Copy(hex, 4, 2));  b := StrToInt('$' + Copy(hex, 6, 2));end;  procedure TForm1.BGLVirtualScrRedraw(Sender: TObject; BGLContext: TBGLContext);var  i : integer;  StarPosition: TPoint;  sttype : Int16 ;  col: TColor; begin       // draw logo and update Sf + 2 vertical raster bars  BGLCanvas.StretchPutImage(0,0,640,480, bg_copper);  // stars  for i := 0 to High(Stars) do  begin     StarPosition.X := Round(Stars[i].X );    StarPosition.Y := Round(Stars[i].Y);    sttype := Round(Stars[i].Speed);     col := RGBToColor(50,50,50);    // stars bitplanes colors    case  (sttype)  of      1: col := RGBToColor(50,50,50);      2: col := RGBToColor(238,238,238);      3: col := RGBToColor(100,136,255);      4: col := RGBToColor(125,125,125);      5: col := RGBToColor(150,150,150);      6: col := RGBToColor(175,175,175);      7: col := RGBToColor(200,200,200);      8: col := RGBToColor(254,254,254);     end;      BGLContext.Canvas.Rectangle(StarPosition.X, StarPosition.Y,StarPosition.X+1,StarPosition.Y+1,col);  end;   // raster bars cycle colors with pause like A-Team intro  for i := 0 to 31 do  begin       hexColor := cop_col[i+j];       HexToRGB(hexColor, red, green, blue);       BGLContext.Canvas.FillRect(0,370+i*2,640,370+ i*2-4,RGBToColor(red,green,blue));   end;   inc(pause);   if (pause>=3) then   begin       inc(j);       pause := 0;       if(j>=184) then j:=0;     end;   BGLCanvas.PutImage(0,50,a_logo,255);    // champs 1988   // sprites   // sin table ...    BGLCanvas.StretchPutImage(-30+sprite_dat[xx]*2 ,-20+sprite_dat[yy]*2,32,32,eight);   BGLCanvas.StretchPutImage(-30+sprite_dat[nx]*2 ,-20+sprite_dat[ny]*2,32,32,eight);   BGLCanvas.StretchPutImage(-30+sprite_dat[ex]*2 ,-20+sprite_dat[ey]*2,32,32,nine);   BGLCanvas.StretchPutImage(-30+sprite_dat[exx]*2 ,-20+sprite_dat[eyy]*2,32,32,one);     BGLCanvas.StretchPutImage(-10+sprite_dat[xx]*2 ,322,32,32,eight);   BGLCanvas.StretchPutImage(-10+sprite_dat[nx]*2 ,322,32,32,eight);   BGLCanvas.StretchPutImage(-10+sprite_dat[ex]*2 ,322,32,32,nine);   BGLCanvas.StretchPutImage(-10+sprite_dat[exx]*2 ,322,32,32,one);    // limites les boucles      inc(exx);    inc(eyy);    if(exx>=255) then exx :=0;    if(eyy>=511) then eyy :=256;     inc(ex);    inc(ey);    if(ex>=255) then ex :=0;    if(ey>=511) then ey :=256;   inc(nx);    inc(ny);    if(nx>=255) then nx :=0;    if(ny>=511) then ny :=256;     inc(xx);    inc(yy);    if(xx>=255) then xx :=0;    if(yy>=511) then yy :=256;    UpdateStarfield;   end; procedure TForm1.BGLVirtualScrUnloadTextures(Sender: TObject; BGLContext: TBGLContext);begin   bg_copper := nil;  a_logo    := nil;   one       := nil;  nine      := nil;  eight     := nil;  eight_2   := nil; end;   procedure TForm1.Timer1Timer(Sender: TObject);begin   BGLVirtualScr.Repaint;end; end. ---------------------------------------------------------------------- Lulu · 2024-04-18 06:15 Well done! This remember me the circuits Copper, Blitter in the Amiga500! (may be other ? I forgot) ---------------------------------------------------------------------- KodeZwerg · 2024-04-18 16:20 Great job! I hope you add soon a compressed project with those missing images so we can enjoy it as its supposed to be ---------------------------------------------------------------------- Gigatron · 2024-04-18 21:03 Hi, I must just code bitmapfont scroller and it'ok  ; ---------------------------------------------------------------------- KodeZwerg · 2024-04-18 21:29 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][+][-]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,  BGLVirtualScreen, BGRAOpenGL; type  TStar = packed record    X,    Y: Integer;    CurCol: TColor;  end;  TStars = array of TStar; type   { TForm1 }   TForm1 = class(TForm)    BGLVirtualScreen1: TBGLVirtualScreen;    Panel1: TPanel;    Timer1: TTimer;    procedure BGLVirtualScreen1Redraw(Sender: TObject; BGLContext: TBGLContext);    procedure BGLVirtualScreen1Resize(Sender: TObject);    procedure FormShow(Sender: TObject);    procedure Timer1Timer(Sender: TObject);  strict private    FStars: TStars;    FMaxStars: Integer;  private    procedure GenerateStars(const AMaxStars: Integer);  public   end; var  Form1: TForm1; implementation {$R *.lfm} { TForm1 } procedure TForm1.FormShow(Sender: TObject);begin  Randomize;  GenerateStars(300); // adjust the stars, lower is better  Timer1.Interval := 250; // adjust the timer, higher is betterend; procedure TForm1.GenerateStars(const AMaxStars: Integer);var  i: Integer;begin  SetLength(FStars, AMaxStars);  FMaxStars := AMaxStars;  for i := Low(FStars) to High(FStars) do    begin      FStars[i].X := Random(BGLVirtualScreen1.Width);      FStars[i].Y := Random(BGLVirtualScreen1.Height);      FStars[i].CurCol := RGBToColor(                   Round(255 + (16 - 255) * Succ(i)),                 Round(255 + (16 - 255) * Succ(i)),                   Round(255 + (16 - 255) * Succ(i))                 );    end;end; procedure TForm1.Timer1Timer(Sender: TObject);begin  BGLVirtualScreen1.Repaint;end; procedure TForm1.BGLVirtualScreen1Redraw(Sender: TObject;  BGLContext: TBGLContext);var  i: Integer;begin  for i := Low(FStars) to High(FStars) do    BGLContext.Canvas.FillRect(FStars[i].X, FStars[i].Y, FStars[i].X + Succ(Random(2)), FStars[i].Y + Succ(Random(1)), FStars[i].CurCol);end; procedure TForm1.BGLVirtualScreen1Resize(Sender: TObject);begin  GenerateStars(FMaxStars);end; end. ---------------------------------------------------------------------- KodeZwerg · 2024-04-19 11:45 Here are some copperbars 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 uMain; {$mode objfpc}{$H+} interface uses  Classes, SysUtils, Forms, Controls, Graphics, Dialogs, ExtCtrls,  BGLVirtualScreen, BGRAOpenGL, BGRABitmap,  BGRABitmapTypes, BGRAGradientScanner; type  TCopperBar = packed record    Gradient: TBGRACustomGradient;    Y: Integer;    Size: Integer;    IsAdd: Boolean;  end;  TCopperBars = array of TCopperBar; type   { TForm1 }   TForm1 = class(TForm)    BGLVirtualScreen1: TBGLVirtualScreen;    Panel1: TPanel;    Timer1: TTimer;    procedure BGLVirtualScreen1Redraw(Sender: TObject; BGLContext: TBGLContext);    procedure BGLVirtualScreen1Resize(Sender: TObject);    procedure FormClose(Sender: TObject; var CloseAction: TCloseAction);    procedure FormShow(Sender: TObject);    procedure Timer1Timer(Sender: TObject);  strict private    FCB: TCopperBars;    FMaxBars: Integer;  private    procedure ReleaseCB;    procedure GenerateCB(const AMaxBars: Integer);  public  end; var  Form1: TForm1; implementation {$R *.lfm} { TForm1 } procedure TForm1.BGLVirtualScreen1Redraw(Sender: TObject;  BGLContext: TBGLContext);var  i: Integer;  sy: Integer;begin  for i := High(FCB) downto Low(FCB) do    for sy := 0 to FCB[i].Size do      begin        if FCB[i].IsAdd then          Inc(FCB[i].Y)        else          Dec(FCB[i].Y);        if FCB[i].Y < BGLContext.Canvas.ClipRect.Top then          FCB[i].IsAdd := True;        if FCB[i].Y > BGLContext.Canvas.ClipRect.Height then          FCB[i].IsAdd := False;        BGLContext.Canvas.FillRect(0, FCB[i].Y, BGLContext.Canvas.ClipRect.Width, Succ(FCB[i].Y), FCB[i].Gradient.GetColorAtF(sy));        if FCB[i].IsAdd then        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))        else          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));      end;end; procedure TForm1.BGLVirtualScreen1Resize(Sender: TObject);begin  ReleaseCB;  GenerateCB(FMaxBars);end; procedure TForm1.FormClose(Sender: TObject; var CloseAction: TCloseAction);begin  ReleaseCB;  CloseAction := caFree;end; procedure TForm1.FormShow(Sender: TObject);begin  Randomize;  GenerateCB(10);  Timer1.Interval := 50;  Timer1.Enabled := True;end; procedure TForm1.Timer1Timer(Sender: TObject);begin  BGLVirtualScreen1.Repaint;end; procedure TForm1.ReleaseCB;var  i: Integer;begin  for i := High(FCB) downto Low(FCB) do    begin      FCB[i].Size := 0;      FCB[i].Y := 0;      FCB[i].IsAdd := False;    FCB[i].Gradient.Free;      FCB[i].Gradient := nil;    end;end; procedure TForm1.GenerateCB(const AMaxBars: Integer);var  i: Integer;  Y: Integer;begin  FMaxBars := AMaxBars;  SetLength(FCB, FMaxBars);  Y := BGLVirtualScreen1.Height;  for i := Low(FCB) to High(FCB) do    begin      FCB[i].Size := 10;      Y := Y - (FCB[i].Size);      FCB[i].Y := Y;      FCB[i].Gradient := TBGRAMultiGradient.Create([RGBToColor(Random(High(Byte)), Random(High(Byte)), Random(High(Byte))), clBlackOpaque], [0, FCB[i].Size], True, False);      FCB[i].IsAdd := True;    end;end; end. ---------------------------------------------------------------------- KodeZwerg · 2024-04-19 20:36 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][+][-]window.onload = function(){var x1 = document.getElementById("main_content_section"); if (x1) { var x = document.getElementsByClassName("geshi");for (var i = 0; i unit uMain; {$mode objfpc}{$H+} interface uses  Classes, SysUtils, Forms, Controls, Graphics, Dialogs, ExtCtrls, Spin,  StdCtrls, BGRABitmap, BGRABitmapTypes,  BGRAGradientScanner, BGRAVirtualScreen, BCTypes; type  TCopperBar = packed record    Gradient: TBGRACustomGradient;    Y: Integer;    Size: Integer;    IsAdd: Boolean;  end;  TCopperBars = array of TCopperBar; type   { TForm1 }   TForm1 = class(TForm)    BGRAVirtualScreen1: TBGRAVirtualScreen;    Label1: TLabel;    Label2: TLabel;    Label3: TLabel;    Panel1: TPanel;    SpinEdit1: TSpinEdit;    SpinEdit2: TSpinEdit;    SpinEdit3: TSpinEdit;    Timer1: TTimer;    procedure BGRAVirtualScreen1Redraw(Sender: TObject; Bitmap: TBGRABitmap);    procedure BGRAVirtualScreen1Resize(Sender: TObject);    procedure FormClose(Sender: TObject; var CloseAction: TCloseAction);    procedure FormShow(Sender: TObject);    procedure SpinEdit1Change(Sender: TObject);    procedure SpinEdit2Change(Sender: TObject);    procedure SpinEdit3Change(Sender: TObject);    procedure Timer1Timer(Sender: TObject);  strict private    FCB: TCopperBars;    FMaxBars: Integer;  private    procedure ReleaseCB;    procedure GenerateCB;  public  end; var  Form1: TForm1; implementation {$R *.lfm} { TForm1 } procedure TForm1.BGRAVirtualScreen1Redraw(Sender: TObject; Bitmap: TBGRABitmap);var  i: Integer;  sy: Integer;  bmp: TBGRABitmap;begin  bmp := TBGRABitmap.Create(BGRAVirtualScreen1.Width, BGRAVirtualScreen1.Height);  bmp.Canvas.Brush.Color := BGRAVirtualScreen1.Color;  bmp.Canvas.FillRect(bmp.Canvas.ClipRect);  try    for i := High(FCB) downto Low(FCB) do      begin        for sy := 0 to FCB[i].Size do          begin            if FCB[i].IsAdd then              Inc(FCB[i].Y)            else              Dec(FCB[i].Y);            if (FCB[i].Y < (bmp.Canvas.ClipRect.Top - FCB[i].Size)) then              FCB[i].IsAdd := True;            if (FCB[i].Y > (bmp.Canvas.ClipRect.Height + FCB[i].Size)) then              FCB[i].IsAdd := False;            bmp.Canvas.Brush.Color := FCB[i].Gradient.GetColorAtF(sy);            bmp.Canvas.FillRect(bmp.Canvas.ClipRect.Left, FCB[i].Y, bmp.Canvas.ClipRect.Width, Succ(FCB[i].Y));            bmp.Canvas.Brush.Color := FCB[i].Gradient.GetColorAtF(FCB[i].Size - sy);            if FCB[i].IsAdd then              bmp.Canvas.FillRect(bmp.Canvas.ClipRect.Left, FCB[i].Y - FCB[i].Size, bmp.Canvas.ClipRect.Width, Succ(FCB[i].Y - FCB[i].Size))            else              bmp.Canvas.FillRect(bmp.Canvas.ClipRect.Left, FCB[i].Y + FCB[i].Size, bmp.Canvas.ClipRect.Width, Succ(FCB[i].Y + FCB[i].Size));          end;      end;    Bitmap.Assign(bmp);  finally    bmp.Free;  end;end; procedure TForm1.BGRAVirtualScreen1Resize(Sender: TObject);begin  Timer1.Enabled := False;  ReleaseCB;  GenerateCB;  Timer1.Enabled := True;end;  procedure TForm1.FormClose(Sender: TObject; var CloseAction: TCloseAction);begin  Timer1.Enabled := False;  ReleaseCB;  CloseAction := caFree;end; procedure TForm1.FormShow(Sender: TObject);begin  Randomize;  GenerateCB;  Timer1.Interval := SpinEdit3.Value;  Timer1.Enabled := True;end; procedure TForm1.SpinEdit1Change(Sender: TObject);begin  Timer1.Enabled := False;  ReleaseCB;  GenerateCB;  Timer1.Enabled := True;end; procedure TForm1.SpinEdit2Change(Sender: TObject);begin  Timer1.Enabled := False;  ReleaseCB;  GenerateCB;  Timer1.Enabled := True;end; procedure TForm1.SpinEdit3Change(Sender: TObject);begin  Timer1.Interval := SpinEdit3.Value;end; procedure TForm1.Timer1Timer(Sender: TObject);begin  BGRAVirtualScreen1.RedrawBitmap;end; procedure TForm1.ReleaseCB;var  i: Integer;begin  for i := High(FCB) downto Low(FCB) do    begin      FCB[i].Size := 0;      FCB[i].Y := 0;      FCB[i].IsAdd := False;    FCB[i].Gradient.Free;      FCB[i].Gradient := nil;    end;  SetLength(FCB, 0);  FCB := nil;end; procedure TForm1.GenerateCB;var  i: Integer;  Y: Integer;  Gradient: TBGRACustomGradient;begin  Y := BGRAVirtualScreen1.Height;  FMaxBars := Succ(Round(Y / SpinEdit2.Value) * 2);  SpinEdit1.Value := FMaxBars;  SetLength(FCB, FMaxBars);  Gradient := TBGRAMultiGradient.Create([RGBToColor(Random(High(Byte)), Random(High(Byte)), Random(High(Byte))), clBlackOpaque], [0, FMaxBars], True, False);  try    for i := Low(FCB) to High(FCB) do    begin        FCB[i].Size := SpinEdit2.Value;        Y := Y - (FCB[i].Size);        FCB[i].Y := Y;        FCB[i].Gradient := TBGRAMultiGradient.Create([Gradient.GetColorAtF(i), clBlackOpaque], [0, FCB[i].Size], True, False);        FCB[i].IsAdd := True;      end;  finally    Gradient.Free;  end;end; end. ---------------------------------------------------------------------- Gigatron · 2024-04-19 23:05 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][+][-]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,  BGRABitmap, BGRABitmapTypes, BGRAVirtualScreen; const     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);  var  CharImage: TBGRABitmap;  ScrollSpeed: integer = 2;  ScrollCounter: integer = 1;  CharWidth : integer = 16;  CharHeight :  integer = 22;  CharsPerLine : integer = 700;  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 !!!!!                                                                       '; type   { TForm1 }   TForm1 = class(TForm)    BGRAVirtualScreen1: TBGRAVirtualScreen;    Timer1: TTimer;    procedure BGRAVirtualScreen1Redraw(Sender: TObject; Bitmap: TBGRABitmap);    procedure FormCreate(Sender: TObject);    procedure Timer1Timer(Sender: TObject);  private   public   end;  var  Form1: TForm1; implementation {$R *.lfm} { TForm1 } procedure TForm1.FormCreate(Sender: TObject); begin   CharImage := TBGRABitmap.Create('font.png'); end; procedure TForm1.BGRAVirtualScreen1Redraw(Sender: TObject; Bitmap: TBGRABitmap);var   I,   Chr: Integer;   CharX, CharY: Integer;   ScrollOffset: Integer; begin  Bitmap.Fill(BGRAPixelTransparent);  ScrollOffset :=  ScrollCounter ;    for I := 0 to Length(ScrollText2) do    begin       Chr := Ord(ScrollText2[I]);       CharX := ((I - 1) mod CharsPerLine) * CharWidth - ScrollOffset  ;       CharY := ((I - 1) div CharsPerLine) * CharHeight  ;       Bitmap.PutImagePart(CharX ,240+CharY , CharImage, Rect(0, 24*ascii[chr-32] , 15, 24*ascii[chr-32]+CharHeight), dmDrawWithTransparency);    end;      ScrollCounter := ScrollCounter + ScrollSpeed;      if ScrollCounter >= CharWidth then    begin    ScrollCounter := ScrollCounter - CharWidth;    ScrollText2 := Copy(ScrollText2,2, Length(ScrollText2) - 1) + ScrollText2[1];  end; end; procedure TForm1.Timer1Timer(Sender: TObject);begin      BGRAVirtualScreen1.RedrawBitmap;end; end.