BGRA Cpc464 Tape Loader Simulation
lazarus / 39-Graphics

----------------------------------------------------------------------
Gigatron · 2024-05-24 19:54

Hi,

In the past i had Cpc464 and played on some games with tape loading
take times, to simulate tape loader i made
a nice little program to share with you; BGRA Rulez !

The cpc picture must be 320x200 size; go to www and take a picture of
a cpc games ;
Missing sfx and border bars !

https://www.youtube.com/watch?v=OiCqZ8E_4XM&t=61s

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, StdCtrls,  BGRAVirtualScreen,
BGRABitmap, BGRABitmapTypes; type   { TForm1 }   TForm1 =
class(TForm)    BGRAVirtualScreen1: TBGRAVirtualScreen;    Label1:
TLabel;    Timer1: TTimer;    procedure
BGRAVirtualScreen1Redraw(Sender: TObject; Bitmap: TBGRABitmap);   
procedure FormCreate(Sender: TObject);    procedure
Timer1Timer(Sender: TObject);  private     cpc_pic,mask :
TBGRABitmap;   public   end; var  Form1: TForm1;  y,i,j :
integer; implementation {$R *.lfm} { TForm1 } procedure
TForm1.Timer1Timer(Sender: TObject);begin   
BGRAVirtualScreen1.RedrawBitmap;end; procedure
TForm1.FormCreate(Sender: TObject);begin      cpc_pic :=
TBGRABitmap.Create('head2.png');      mask    :=
TBGRABitmap.Create(320,200); // virtual bitmap     
y:=0;i:=0;j:=0;end; procedure TForm1.BGRAVirtualScreen1Redraw(Sender:
TObject; Bitmap: TBGRABitmap);begin       inc(i,8);     
 mask.PutImagePart( 0 ,  y, cpc_pic,  Rect( 0, 0+y,i*2,1+y), dmSet); 
    if i>=160 then       begin          i:=0;          y := y +8;    
    if (y>8*25) then          begin             inc(j);           
 y:= 0 + j;             if(j>7) then              begin             
 j:=7;               label1.Caption := 'Loading : Done';             
end;          end;       end;     
 bitmap.StretchPutImage(rect(0,0,640,400),mask,dmSet);end;end.

----------------------------------------------------------------------
domasz · 2024-05-25 07:17

Nice!

CPC screenshots and scene art:
https://tomseditor.com/gallery/browse&lang=en&platform=amstrad

----------------------------------------------------------------------
Gigatron · 2024-05-26 17:56

Quote from: domasz on May 25, 2024, 09:17:09 amNice!

CPC screenshots and scene art:
https://tomseditor.com/gallery/browse&lang=en&platform=amstrad

Thank you @domasz , there'is cpc-power my favorite to pic an image ;
https://www.cpc-power.com/index.php?page=detail&num=1066

If we want to include loading with border bars , the source is like so
;

 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, StdCtrls,  BGRAVirtualScreen,
BGRABitmap, BGRABitmapTypes, BCTypes; type   { TForm1 }   TForm1 =
class(TForm)    BGRAVirtualScreen1: TBGRAVirtualScreen;   
BGRAVirtualScreen2: TBGRAVirtualScreen;    Timer1: TTimer;    Timer2:
TTimer;    procedure BGRAVirtualScreen1Redraw(Sender: TObject; Bitmap:
TBGRABitmap);    procedure BGRAVirtualScreen2Redraw(Sender: TObject;
Bitmap: TBGRABitmap);    procedure FormCreate(Sender: TObject);   
procedure Timer1Timer(Sender: TObject);    procedure
Timer2Timer(Sender: TObject);  private    cpc_pic,mask : TBGRABitmap; 
public  end; var  Form1: TForm1;  y,i,j : integer;  loading_ :
boolean; implementation {$R *.lfm} { TForm1 } procedure
TForm1.Timer1Timer(Sender: TObject);begin   
BGRAVirtualScreen1.RedrawBitmap;end; procedure
TForm1.Timer2Timer(Sender: TObject);begin   
 BGRAVirtualScreen2.RedrawBitmap;end; procedure
TForm1.FormCreate(Sender: TObject);begin      cpc_pic :=
TBGRABitmap.Create('head2.png');      mask    :=
TBGRABitmap.Create(320,200); // virtual bitmap      y:=0;i:=0;j:=0;  
  loading_ := true;end; procedure
TForm1.BGRAVirtualScreen1Redraw(Sender: TObject; Bitmap:
TBGRABitmap);begin       inc(i,8);       mask.PutImagePart( 0 ,  y,
cpc_pic,  Rect( 0, 0+y,i*2,1+y), dmSet);        if (loading_) then   
  begin         if i>=160 then         begin          i:=0;          y
:= y +8;          if (y>8*25) then          begin             inc(j); 
           y:= 0 + j;             if(j>7) then             begin     
      j:=7;             loading_ :=false;             end;         
end;         end;       end;      
 bitmap.StretchPutImage(rect(0,0,640,400),mask,dmSet);end;// loading
bars :procedure TForm1.BGRAVirtualScreen2Redraw(Sender: TObject;
Bitmap: TBGRABitmap);var  y,b,h : integer;begin       b:=2;     
 y:=0;       h:= BGRAVirtualScreen2.Height;        if (loading_) then
begin        while y<h do       begin        b := 1+Random(16);      
bitmap.FillRect(0,  y+b, 754,  8+y+b, BGRA(0,0,250),dmSet);       
y:=y+b;       end;        end;end; end.