Recent

Author Topic: BGRA Cpc464 Tape Loader Simulation  (Read 820 times)

Gigatron

  • Jr. Member
  • **
  • Posts: 78
  • Amiga Rulez !!
BGRA Cpc464 Tape Loader Simulation
« on: May 24, 2024, 09:54:48 pm »
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][+][-]
  1. unit Unit1;
  2.  
  3. {$mode objfpc}{$H+}
  4.  
  5. interface
  6.  
  7. uses
  8.   Classes, SysUtils, Forms, Controls, Graphics, Dialogs, ExtCtrls, StdCtrls,
  9.   BGRAVirtualScreen, BGRABitmap, BGRABitmapTypes;
  10.  
  11. type
  12.  
  13.   { TForm1 }
  14.  
  15.   TForm1 = class(TForm)
  16.     BGRAVirtualScreen1: TBGRAVirtualScreen;
  17.     Label1: TLabel;
  18.     Timer1: TTimer;
  19.     procedure BGRAVirtualScreen1Redraw(Sender: TObject; Bitmap: TBGRABitmap);
  20.     procedure FormCreate(Sender: TObject);
  21.     procedure Timer1Timer(Sender: TObject);
  22.   private
  23.  
  24.     cpc_pic,mask : TBGRABitmap;
  25.  
  26.   public
  27.  
  28.   end;
  29.  
  30. var
  31.   Form1: TForm1;
  32.   y,i,j : integer;
  33.  
  34. implementation
  35.  
  36. {$R *.lfm}
  37.  
  38. { TForm1 }
  39.  
  40. procedure TForm1.Timer1Timer(Sender: TObject);
  41. begin
  42.     BGRAVirtualScreen1.RedrawBitmap;
  43. end;
  44.  
  45. procedure TForm1.FormCreate(Sender: TObject);
  46. begin
  47.       cpc_pic := TBGRABitmap.Create('head2.png');
  48.       mask    := TBGRABitmap.Create(320,200); // virtual bitmap
  49.       y:=0;i:=0;j:=0;
  50. end;
  51.  
  52. procedure TForm1.BGRAVirtualScreen1Redraw(Sender: TObject; Bitmap: TBGRABitmap);
  53. begin
  54.        inc(i,8);
  55.        mask.PutImagePart( 0 ,  y, cpc_pic,  Rect( 0, 0+y,i*2,1+y), dmSet);
  56.        if i>=160 then
  57.        begin
  58.           i:=0;
  59.           y := y +8;
  60.           if (y>8*25) then
  61.           begin
  62.              inc(j);
  63.              y:= 0 + j;
  64.              if(j>7) then
  65.               begin
  66.                j:=7;
  67.                label1.Caption := 'Loading : Done';
  68.               end;
  69.           end;
  70.        end;
  71.        bitmap.StretchPutImage(rect(0,0,640,400),mask,dmSet);
  72. end;
  73. end.
  74.  
« Last Edit: May 24, 2024, 09:57:49 pm by Gigatron »
Sub Quantum Technology ! We are in a micro universe.

domasz

  • Sr. Member
  • ****
  • Posts: 473
Re: BGRA Cpc464 Tape Loader Simulation
« Reply #1 on: May 25, 2024, 09:17:09 am »

Gigatron

  • Jr. Member
  • **
  • Posts: 78
  • Amiga Rulez !!
Re: BGRA Cpc464 Tape Loader Simulation
« Reply #2 on: May 26, 2024, 07:56:18 pm »
Nice!

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][+][-]
  1. unit Unit1;
  2.  
  3. {$mode objfpc}{$H+}
  4.  
  5. interface
  6.  
  7. uses
  8.   Classes, SysUtils, Forms, Controls, Graphics, Dialogs, ExtCtrls, StdCtrls,
  9.   BGRAVirtualScreen, BGRABitmap, BGRABitmapTypes, BCTypes;
  10.  
  11. type
  12.  
  13.   { TForm1 }
  14.  
  15.   TForm1 = class(TForm)
  16.     BGRAVirtualScreen1: TBGRAVirtualScreen;
  17.     BGRAVirtualScreen2: TBGRAVirtualScreen;
  18.     Timer1: TTimer;
  19.     Timer2: TTimer;
  20.     procedure BGRAVirtualScreen1Redraw(Sender: TObject; Bitmap: TBGRABitmap);
  21.     procedure BGRAVirtualScreen2Redraw(Sender: TObject; Bitmap: TBGRABitmap);
  22.     procedure FormCreate(Sender: TObject);
  23.     procedure Timer1Timer(Sender: TObject);
  24.     procedure Timer2Timer(Sender: TObject);
  25.   private
  26.     cpc_pic,mask : TBGRABitmap;
  27.   public
  28.   end;
  29.  
  30. var
  31.   Form1: TForm1;
  32.   y,i,j : integer;
  33.   loading_ : boolean;
  34.  
  35. implementation
  36.  
  37. {$R *.lfm}
  38.  
  39. { TForm1 }
  40.  
  41. procedure TForm1.Timer1Timer(Sender: TObject);
  42. begin
  43.     BGRAVirtualScreen1.RedrawBitmap;
  44. end;
  45.  
  46. procedure TForm1.Timer2Timer(Sender: TObject);
  47. begin
  48.      BGRAVirtualScreen2.RedrawBitmap;
  49. end;
  50.  
  51. procedure TForm1.FormCreate(Sender: TObject);
  52. begin
  53.       cpc_pic := TBGRABitmap.Create('head2.png');
  54.       mask    := TBGRABitmap.Create(320,200); // virtual bitmap
  55.       y:=0;i:=0;j:=0;
  56.       loading_ := true;
  57. end;
  58.  
  59. procedure TForm1.BGRAVirtualScreen1Redraw(Sender: TObject; Bitmap: TBGRABitmap);
  60. begin
  61.        inc(i,8);
  62.        mask.PutImagePart( 0 ,  y, cpc_pic,  Rect( 0, 0+y,i*2,1+y), dmSet);
  63.  
  64.        if (loading_) then
  65.        begin
  66.          if i>=160 then
  67.          begin
  68.           i:=0;
  69.           y := y +8;
  70.           if (y>8*25) then
  71.           begin
  72.              inc(j);
  73.              y:= 0 + j;
  74.              if(j>7) then
  75.              begin
  76.              j:=7;
  77.              loading_ :=false;
  78.              end;
  79.           end;
  80.          end;
  81.        end;
  82.  
  83.        bitmap.StretchPutImage(rect(0,0,640,400),mask,dmSet);
  84. end;
  85. // loading bars :
  86. procedure TForm1.BGRAVirtualScreen2Redraw(Sender: TObject; Bitmap: TBGRABitmap);
  87. var
  88.   y,b,h : integer;
  89. begin
  90.        b:=2;
  91.        y:=0;
  92.        h:= BGRAVirtualScreen2.Height;
  93.  
  94.        if (loading_) then begin
  95.  
  96.        while y<h do
  97.        begin
  98.         b := 1+Random(16);
  99.         bitmap.FillRect(0,  y+b, 754,  8+y+b, BGRA(0,0,250),dmSet);
  100.         y:=y+b;
  101.        end;
  102.  
  103.        end;
  104. end;
  105.  
  106. end.
  107.  
  108.  
Sub Quantum Technology ! We are in a micro universe.

 

TinyPortal © 2005-2018