BGRA Cpc464 Tape Loader Simulation

[Gigatron]

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.  

[domasz]

Nice!

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

[Gigatron]

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.