CPC 464 Game Images
lazarus / 38-Networking and Web Programming

----------------------------------------------------------------------
Gigatron · 2025-03-09 16:29

Hi,

A few weeks ago I had started a project to train on the programming
www on Lazarus pascal; The goal is to download for an image on the net
and display it. So here is this little project.
Cpc464 was my first computer and i like it ;

The Base web-site is : https://www.cpc-power.com/

You must download this ssl library and put all files to the project
drawer:
https://wiki.overbyte.eu/arch/openssl-1.1.1w-win64.zip

** Edit : If I have time the next version will be better, extract the
title in the HTML code etc...

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+}interfaceuses  Classes, SysUtils, Forms,
Controls, Graphics, Dialogs, StdCtrls, ExtCtrls,  Spin,
BGRAVirtualScreen, BGRABitmap, BGRABitmapTypes, OpenSSLSockets, 
fphttpclient; type  { TForm1 }  TForm1 = class(TForm)    Button1:
TButton;    Label1: TLabel;    Label2: TLabel;    Panel1: TPanel;   
SpinEdit1: TSpinEdit;    SpinEdit2: TSpinEdit;    VirtualScreen:
TBGRAVirtualScreen;    procedure BGRAVirtualScreenRedraw(Sender:
TObject; Bitmap: TBGRABitmap);    procedure Button1Click(Sender:
TObject);    procedure FormCreate(Sender: TObject);  private   
FBitmap: TBGRABitmap;  public  end; var  Form1: TForm1;  img_num,
img_slot, mono: integer;  HttpClient: TFPHTTPClient;  MemStream:
TMemoryStream;  ImageURL , ImageWWW : string;  implementation{$R
*.lfm} { TForm1 } procedure TForm1.FormCreate(Sender: TObject);begin 
FBitmap  := nil;  img_num  := SpinEdit1.value;  img_slot :=
SpinEdit2.value;  mono := 1;  // 1 = set ; 0 =
unset(color);end; procedure TForm1.BGRAVirtualScreenRedraw(Sender:
TObject; Bitmap: TBGRABitmap);begin   Bitmap.Fill(BGRAWhite);  if
Assigned(FBitmap) then  begin   
bitmap.StretchPutImage(rect(0,0,320*2,256*2),Fbitmap,dmSet); 
end;end; procedure TForm1.Button1Click(Sender: TObject); begin   if
Assigned(FBitmap) then  begin    FBitmap.Free;    FBitmap := nil; 
end;  Imagewww := 'https://www.cpc-
power.com/extra_lire_fichier.php?extra=cpcold&fiche=';  ImageURL := Im
agewww+inttostr(img_num)+'&slot='+inttostr(img_slot)+'&part=A&type=.pn
g&green='+inttoStr(mono)+'';  img_num  := SpinEdit1.value;  img_slot
:= SpinEdit2.value;    HttpClient := TFPHTTPClient.Create(nil); 
MemStream := TMemoryStream.Create;   try    try      
HttpClient.Get(ImageURL, MemStream);      MemStream.Position := 0;   
 FBitmap := TBGRABitmap.Create(MemStream);     
VirtualScreen.DiscardBitmap;      VirtualScreen.RedrawBitmap;   
except      on E: Exception do        ShowMessage('Erreur de
téléchargement: ' + E.Message);    end;  finally    HttpClient.Free; 
 MemStream.Free;  end;   Label1.Caption:= 'Image Number : '+
IntToStr(img_num);  Label2.Caption:= 'Image Slot : '+
IntToStr(img_slot); end;  end.

----------------------------------------------------------------------
Gigatron · 2025-03-10 16:28

Hi

This project become interesting, maybe usefull for you.

Added Monochrome color, favorite list , and simple 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+}interfaceuses  Classes, SysUtils, Forms,
Controls, Graphics, Dialogs, StdCtrls, ExtCtrls,  Spin,
BGRAVirtualScreen, BGRABitmap, BGRABitmapTypes, OpenSSLSockets, 
fphttpclient, RegExpr; type  { TForm1 }  TForm1 = class(TForm)   
Button1: TButton;    Button2: TButton;    Button3: TButton;    Label1:
TLabel;    Label2: TLabel;    Label3: TLabel;    ListBox1: TListBox; 
 Panel1: TPanel;    RadioButton1: TRadioButton;    RadioButton2:
TRadioButton;    SpinEdit1: TSpinEdit;    SpinEdit2: TSpinEdit;   
VirtualScreen: TBGRAVirtualScreen;    procedure
BGRAVirtualScreenRedraw(Sender: TObject; Bitmap: TBGRABitmap);   
procedure Button1Click(Sender: TObject);    procedure
Button2Click(Sender: TObject);    procedure Button3Click(Sender:
TObject);    procedure FormCreate(Sender: TObject);    procedure
FormDestroy(Sender: TObject);    procedure
ListBox1SelectionChange(Sender: TObject; User: boolean);    procedure
RadioButton1Change(Sender: TObject);    procedure
RadioButton2Change(Sender: TObject);  private    FBitmap:
TBGRABitmap;  public  end; var  Form1: TForm1;  img_num, img_slot,
mono: integer;  HttpClient: TFPHTTPClient;  MemStream: TMemoryStream; 
ImageURL , ImageWWW,  GameTitle : string; implementation{$R
*.lfm} function GetGameTitle(const URL: string): string;var 
HttpClient: TFPHTTPClient;  PageSource: TStringList;  Regex:
TRegExpr;  RawTitle: string;begin  Result := 'Title Not Found '; 
HttpClient := TFPHTTPClient.Create(nil);  PageSource :=
TStringList.Create;  Regex := TRegExpr.Create;   try    try      //
HTML      PageSource.Text := HttpClient.Get(URL);      
Regex.Expression := '<title>(.*?)</title>';      if
Regex.Exec(PageSource.Text) then      begin        RawTitle :=
Regex.Match[1];         RawTitle := StringReplace(RawTitle, '&copy', '
:', [rfReplaceAll]);        RawTitle := Trim(RawTitle);         while
Pos('  ', RawTitle) > 0 do          RawTitle :=
StringReplace(RawTitle, '  ', ' ', [rfReplaceAll]);         Result :=
UpperCase(RawTitle);      end;     except      on E: Exception do    
  Result := 'Erreur: ' + E.Message;    end;  finally   
HttpClient.Free;    PageSource.Free;    Regex.Free;  end;end; { TForm1
} procedure TForm1.FormCreate(Sender: TObject);begin  FBitmap  :=
nil;  img_num  := SpinEdit1.value;  img_slot := SpinEdit2.value;  mono
:= 0;  // 1 = set ; 0 = unset(color);   HttpClient :=
TFPHTTPClient.Create(nil);  MemStream :=
TMemoryStream.Create; end; procedure
TForm1.BGRAVirtualScreenRedraw(Sender: TObject; Bitmap:
TBGRABitmap);var  DestRect: TRect;begin  Bitmap.Fill(BGRAWhite);  if
Assigned(FBitmap) then  begin    DestRect := Rect(0, 0,
VirtualScreen.Width, VirtualScreen.Height);   
Bitmap.StretchPutImage(DestRect, FBitmap, dmSet);  end;end; procedure
TForm1.Button1Click(Sender: TObject);var PageURL: string;begin   if
Assigned(FBitmap) then  FreeAndNil(FBitmap);   img_num  :=
SpinEdit1.value;  img_slot := SpinEdit2.value;   Imagewww :=
'https://www.cpc-
power.com/extra_lire_fichier.php?extra=cpcold&fiche=';  ImageURL := Im
agewww+inttostr(img_num)+'&slot='+inttostr(img_slot)+'&part=A&type=.pn
g&green='+inttoStr(mono)+'';   PageURL := 'https://www.cpc-
power.com/index.php?page=detail&num=' + IntToStr(img_num);  GameTitle
:= GetGameTitle(PageURL);   Label3.Caption := '' + GameTitle;   try 
MemStream.Clear;  // Réutilisation du même stream 
HttpClient.Get(ImageURL, MemStream);  MemStream.Position := 0;  if
MemStream.Size > 0 then  begin    FBitmap :=
TBGRABitmap.Create(MemStream);   // VirtualScreen.DiscardBitmap;   
VirtualScreen.RedrawBitmap;  end  else    ShowMessage('Empty Image
...');   except  on E: Exception do    ShowMessage('Loading Error ...'
+ E.Message);    end;   Label1.Caption:= 'Game : '+
IntToStr(img_num);  Label2.Caption:= 'Slot : ' +
IntToStr(img_slot); end;// add to favorite listprocedure
TForm1.Button2Click(Sender: TObject);var  game_name: String;  idx:
Integer;begin    idx := Pos(' : ', GameTitle);   if idx > 0 then   
game_name := Copy(GameTitle, 1, idx - 1)   else    game_name :=
GameTitle;    ListBox1.Items.Add(IntToStr(img_num) + ' : ' +
game_name); end; procedure TForm1.Button3Click(Sender: TObject);begin 
ListBox1.Clear;end; // get game_num from listboxprocedure
TForm1.ListBox1SelectionChange(Sender: TObject; User: boolean);var 
lst_txt, lst_num : String;  idx     : integer;begin     lst_txt :=
ListBox1.GetSelectedText;     idx := Pos(' : ', lst_txt);     if idx >
0 then     lst_num := Copy(lst_txt, 1, idx - 1);      SpinEdit1.Value
:= StrToInt(lst_num);     ListBox1.Update;   
 button1.Click;end; procedure TForm1.RadioButton1Change(Sender:
TObject);begin       if RadioButton1.Checked then mono := 1;     
 button1.Click;end; procedure TForm1.RadioButton2Change(Sender:
TObject);begin      if RadioButton2.Checked then mono := 0;     
button1.Click; // simulate clickend; procedure
TForm1.FormDestroy(Sender: TObject);begin  FreeAndNil(FBitmap); 
FreeAndNil(HttpClient);  FreeAndNil(MemStream);end;  end.

----------------------------------------------------------------------
Gigatron · 2025-03-11 00:28

Finally with 30 minutes of work this project ends, this shows that
with lazarus FPC development is as fast as the speed of light.

You are no need Indylaz , just the ssl library :
https://wiki.overbyte.eu/arch/openssl-1.1.1w-win64.zip

Hope you can use this project for other usage.

** Edit
Added all games list , load it and browse cpc games images.

Have Fun

----------------------------------------------------------------------
Gigatron · 2025-03-23 19:24

Ok

This project is now finished with some minor change like Find game
title in List;
All games list is now included , just unzip and load it;

Have Fun;