Skip to content
Permalink
Browse files

Scraping is now available and Portuguese(BR) too !!

  • Loading branch information...
NeeeeB committed Oct 20, 2017
1 parent 1e84900 commit 52f68a79241f746a7f00a5aef3dcf0a46e5e764c
@@ -6,7 +6,7 @@ interface
Winapi.Windows, Winapi.Messages,
System.SysUtils, System.Variants, System.Classes, System.IniFiles,
Vcl.Graphics, Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls, Vcl.ComCtrls,
U_gnugettext, U_Resources;
U_gnugettext, U_Resources, Vcl.Imaging.GIFImg, Vcl.ExtCtrls;

type
TFrm_Help = class(TForm)
@@ -4,7 +4,7 @@ object Frm_Editor: TFrm_Editor
BorderIcons = [biSystemMenu, biMinimize]
BorderStyle = bsSingle
Caption = 'GameList Editor'
ClientHeight = 670
ClientHeight = 690
ClientWidth = 1210
Color = clBtnFace
Font.Charset = DEFAULT_CHARSET
@@ -6875,7 +6875,7 @@ object Frm_Editor: TFrm_Editor
Top = 205
Width = 139
Height = 25
Caption = 'Scraper'
Caption = 'Scrape'
Enabled = False
TabOrder = 35
OnClick = Btn_ScrapeClick
@@ -7205,7 +7205,7 @@ object Frm_Editor: TFrm_Editor
Left = 216
Top = 376
Bitmap = {
494C010101000800B40010001000FFFFFFFFFF10FFFFFFFFFFFFFFFF424D3600
494C010101000800C00010001000FFFFFFFFFF10FFFFFFFFFFFFFFFF424D3600
0000000000003600000028000000400000001000000001002000000000000010
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
@@ -1246,17 +1246,21 @@ procedure TFrm_Editor.Btn_SaveChangesClick(Sender: TObject);
//Au click sur le bouton Scraper
procedure TFrm_Editor.Btn_ScrapeClick(Sender: TObject);
var
SysId, _GameListPath: string;
SysId: string;
Frm_Scrape: TFrm_Scraper;
begin
_GameListPath:= FRootPath + FCurrentFolder + Cst_GameListFileName;
//on désactive pour éviter les clicks intempestifs pendant le chargement
Enabled:= False;
SysId:= GetCurrentSystemId;
Frm_Scrape:= TFrm_Scraper.Create( nil );
try
Frm_Scrape.Execute( SysId, _GameListPath, ( Lbx_Games.Items.Objects[Lbx_Games.ItemIndex] as TGame ) );
Frm_Scrape.Execute( SysId, FRootPath, FCurrentFolder, FImageFolder, FXmlImageFolderPath,
( Lbx_Games.Items.Objects[Lbx_Games.ItemIndex] as TGame ) );
finally
Frm_Scrape.Free;
end;
LoadGame( ( Lbx_Games.Items.Objects[Lbx_Games.ItemIndex] as TGame ) );
Enabled:= True;
end;

//Enregistre les changements effectués pour le jeu dans le fichier .xml
@@ -14,25 +14,25 @@ object Frm_Scraper: TFrm_Scraper
Font.Style = []
OldCreateOrder = False
Position = poScreenCenter
OnClose = FormClose
OnCreate = FormCreate
OnDestroy = FormDestroy
OnMouseWheelDown = FormMouseWheelDown
OnMouseWheelUp = FormMouseWheelUp
PixelsPerInch = 96
TextHeight = 13
object Pnl_Back: TPanel
Left = 0
Top = 50
Top = 49
Width = 960
Height = 360
Height = 361
Align = alClient
BevelOuter = bvNone
TabOrder = 0
object Scl_Games: TScrollBox
Left = 0
Top = 0
Width = 960
Height = 360
Height = 361
Align = alClient
BevelInner = bvNone
BevelOuter = bvNone
@@ -44,18 +44,24 @@ object Frm_Scraper: TFrm_Scraper
Left = 0
Top = 0
Width = 960
Height = 50
Height = 49
Align = alTop
TabOrder = 1
DesignSize = (
960
49)
object Lbl_Instructions: TLabel
Left = 307
Top = 18
Width = 347
Height = 16
Left = 148
Top = 15
Width = 665
Height = 19
Alignment = taCenter
Anchors = [akLeft, akTop, akRight, akBottom]
AutoSize = False
Caption = 'Double click on a picture to set it as the game picture'
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -13
Font.Height = -16
Font.Name = 'Tahoma'
Font.Style = [fsBold]
ParentFont = False
@@ -27,28 +27,34 @@ TFrm_Scraper = class(TForm)
Img_ScreenScraper: TImage;

procedure FormCreate(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure Btn_CloseClick(Sender: TObject);
procedure FormMouseWheelDown(Sender: TObject; Shift: TShiftState;
MousePos: TPoint; var Handled: Boolean);
procedure FormMouseWheelUp(Sender: TObject; Shift: TShiftState;
MousePos: TPoint; var Handled: Boolean);
procedure FormDestroy(Sender: TObject);


private
FGame: TGame;
FXmlPath: string;
FGameListPath: string;
FRootPath: string;
FCurrentFolder: string;
FImageFolder: string;
FXmlImageFolderPath: string;
FImgList: TObjectList<TImage>;

procedure DisplayPictures;
procedure WarnUser( aMessage: string );
procedure ChangeImage( aImg: TImage );
procedure ImgDblClick( Sender: TObject );

function GetGameInfos( const aSysId: string; aGame: TGame ): Boolean;
function LoadPictures: Boolean;
function GetFileSize( const aPath: string ): string;

public
procedure Execute( const aSysId, aGameListPath: string; aGame: TGame );
procedure Execute( const aSysId, aRootPath, aCurrentFolder, aImageFolder, aXmlImageFolderPath: string; aGame: TGame );
end;

implementation
@@ -60,25 +66,27 @@ procedure TFrm_Scraper.FormCreate(Sender: TObject);
begin
FXmlPath:= ExtractFilePath( Application.ExeName ) + Cst_TempXml;
FImgList:= TObjectList<TImage>.Create;
TranslateComponent( Self );
end;

procedure TFrm_Scraper.Execute( const aSysId, aGameListPath: string; aGame: TGame );
procedure TFrm_Scraper.Execute( const aSysId, aRootPath, aCurrentFolder, aImageFolder, aXmlImageFolderPath: string; aGame: TGame );
begin
Screen.Cursor:= crHourGlass;
FGame:= aGame;
FGameListPath:= aGameListPath;
//splash loading ^^
Frm_Splash.Show;
Frm_Splash.Refresh;
FRootPath:= aRootPath;
FCurrentFolder:= aCurrentFolder;
FImageFolder:= aImageFolder;
FXmlImageFolderPath:= aXmlImageFolderPath;

//Splash loading
FrmSplash.Show;
FrmSplash.Refresh;

if GetGameInfos( aSysId, FGame ) and LoadPictures then begin
DisplayPictures;
Screen.Cursor:= crDefault;
Frm_Splash.Close;
FrmSplash.Close;
ShowModal;
end else begin
Frm_Splash.Close;
Close;
end;
end;

@@ -108,13 +116,11 @@ function TFrm_Scraper.GetGameInfos( const aSysId: string; aGame: TGame ): Boolea
XMLDoc.SaveToFile( FXmlPath );
except
on E: EIdHTTPProtocolException do begin
Screen.Cursor:= crDefault;
ShowMessage( Rst_ServerError );
WarnUser( Rst_ServerError );
Exit;
end;
on E : Exception do begin
Screen.Cursor:= crDefault;
ShowMessage( Rst_StreamError );
WarnUser( Rst_StreamError );
Exit;
end;
end;
@@ -182,18 +188,23 @@ function TFrm_Scraper.LoadPictures: Boolean;
//On trouve le noeud qui nous intéresse
Nodes:= XMLDoc.ChildNodes[Cst_DataNode].ChildNodes[Cst_GameNode].ChildNodes[Cst_MediaNode].ChildNodes;
if ( Nodes.Count = 0 ) then begin
ShowMessage( Rst_NoMediaFound );
WarnUser( Rst_NoMediaFound );
Exit;
end;

//Et on boucle pour trouver les noeuds qui nous intéressent
for ii:= 0 to Pred( Nodes.Count ) do begin
//C'est moche mais ça évite le "na répond pas"
Application.ProcessMessages;

if ( Nodes[ii].Attributes[Cst_AttType] = Cst_MediaBox2d ) or
( Nodes[ii].Attributes[Cst_AttType] = Cst_MediaScreenShot ) or
( Nodes[ii].Attributes[Cst_AttType] = Cst_MediaSsTitle ) or
( Nodes[ii].Attributes[Cst_AttType] = Cst_MediaBox3d ) or
( Nodes[ii].Attributes[Cst_AttType] = Cst_MediaMix1 ) or
( Nodes[ii].Attributes[Cst_AttType] = Cst_MediaMix2 ) or
( Nodes[ii].Attributes[Cst_AttType] = Cst_MediaArcadeBox1 ) then begin
( Nodes[ii].Attributes[Cst_AttType] = Cst_MediaArcadeBox1 ) or
( Nodes[ii].Attributes[Cst_AttType] = Cst_MediaWheel ) then begin
Query:= Nodes[ii].Text;
Stream:= TMemoryStream.Create;
try
@@ -205,13 +216,11 @@ function TFrm_Scraper.LoadPictures: Boolean;
else LoadJpg( Stream );
except
on E: EIdHTTPProtocolException do begin
Screen.Cursor:= crDefault;
ShowMessage( Rst_ServerError );
WarnUser( Rst_ServerError );
Exit;
end;
on E : Exception do begin
Screen.Cursor:= crDefault;
ShowMessage( Rst_StreamError );
WarnUser( Rst_StreamError );
Exit;
end;
end;
@@ -224,11 +233,18 @@ function TFrm_Scraper.LoadPictures: Boolean;

//si on a pas trouvé de médias on le signale
if not Result then begin
Screen.Cursor:= crDefault;
ShowMessage( Rst_NoMediaFound );
WarnUser( Rst_NoMediaFound );
end;
end;

//Pour prévenir le user si problème ou pas de médias trouvés
procedure TFrm_Scraper.WarnUser( aMessage: string );
begin
FrmSplash.Close;
Screen.Cursor:= crDefault;
ShowMessage( aMessage );
end;

//Affichage des images récupérées
procedure TFrm_Scraper.DisplayPictures;
var
@@ -248,12 +264,71 @@ procedure TFrm_Scraper.DisplayPictures;
FImgList.Items[ii].Constraints.MinHeight:= 300;
FImgList.Items[ii].Constraints.MaxHeight:= 300;
FImgList.Items[ii].Constraints.MaxWidth:= 300;
FImgList.Items[ii].OnDblClick:= ImgDblClick;
FImgList.Items[ii].Center:= True;
FImgList.Items[ii].Visible:= True;
Left:= Left + FImgList.Items[ii].Width + 50;
end;
end;

procedure TFrm_Scraper.ImgDblClick( Sender: TObject );
begin
ChangeImage( ( Sender as TImage ) );
end;

//Remplace l'image actuelle du jeu (par autre ou défaut).
procedure TFrm_Scraper.ChangeImage( aImg: TImage );
var
_ImageLink: string;
_Node: IXMLNode;
_NodeAdded: Boolean;
begin
_NodeAdded:= False;
Screen.Cursor:= crHourGlass;

//on sauvegarde l'image dans le dossier avec les autres !!
// et on ajoute le chemin dans le xml
aImg.Picture.SaveToFile( FRootPath + FCurrentFolder + FImageFolder +
'\' + FGame.RomNameWoExt + Cst_ImageSuffixPng );

//On ouvre le fichier xml
XMLDoc.LoadFromFile( FRootPath + FCurrentFolder + Cst_GameListFileName );

//On récupère le premier noeud "game"
_Node := XMLDoc.DocumentElement.ChildNodes.FindNode( Cst_Game );

//Et on boucle pour trouver le noeud avec le bon Id
repeat
if ( _Node.ChildNodes.Nodes[Cst_Path].Text = FGame.RomPath ) then Break;
_Node := _Node.NextSibling;
until not Assigned( _Node );

//on écrit le chemin vers l'image
_ImageLink:= FXmlImageFolderPath + FGame.RomNameWoExt + Cst_ImageSuffixPng;

if not Assigned( _Node.ChildNodes.FindNode( Cst_ImageLink ) ) then begin
_Node.AddChild( Cst_ImageLink );
_NodeAdded:= True;
end;
_Node.ChildNodes.Nodes[Cst_ImageLink].Text:= _ImageLink;

//On enregistre le fichier.
if _NodeAdded then begin
XMLDoc.XML.Text:= Xml.Xmldoc.FormatXMLData( XMLDoc.XML.Text );
XMLDoc.Active:= True;
end;
XMLDoc.SaveToFile( FRootPath + FCurrentFolder + Cst_GameListFileName );
XMLDoc.Active:= False;

//Et enfin on met à jour l'objet TGame associé
FGame.ImagePath:= _ImageLink;
FGame.PhysicalImagePath:= FRootPath + FCurrentFolder +
IncludeTrailingPathDelimiter( FImageFolder ) +
FGame.RomNameWoExt + Cst_ImageSuffixPng;
Screen.Cursor:= crDefault;
Close;
end;

//Pour récupérer la taille du fichier du jeu
function TFrm_Scraper.GetFileSize( const aPath: string ): string;
var
@@ -287,8 +362,8 @@ procedure TFrm_Scraper.Btn_CloseClick(Sender: TObject);
Close;
end;

//A la fermeture de la form
procedure TFrm_Scraper.FormClose(Sender: TObject; var Action: TCloseAction);
//A la Destruction de la form
procedure TFrm_Scraper.FormDestroy(Sender: TObject);
begin
DeleteFile( FXmlPath );
FImgList.Free;

0 comments on commit 52f68a7

Please sign in to comment.
You can’t perform that action at this time.