@kAzek zaraz to spróbuję, poniżej wstawiłem cały kod.
unit uTest;
interface
uses
Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Internet,
Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls, sLabel, sGauge, Vcl.Graphics,
MyAccess, rDefineMySQL, uConst, Vcl.Buttons, sSpeedButton, PrestaShopConst, Vcl.ExtCtrls, Jpeg;
type
TImageType = packed record
Name: String;
Width: Integer;
Height: Integer;
end;
TArrayImageType = array of TImageType;
type
TImageTypePresta = class
fArrayImageType: TArrayImageType;
fTypeCount: Integer;
fConnection: TMyConnection;
private
public
constructor Create(MyConnection: TMyConnection);
Procedure GetImageType;
Property ArrayType: TArrayImageType read fArrayImageType write fArrayImageType;
Property TypeCount: Integer read fTypeCount;
published
end;
type
TReferenceToIdProduct = packed record
Reference: string;
IdProduct: Integer;
end;
TLinkReferenceToIdProduct = Array of TReferenceToIdProduct;
type
TFileImage = packed record
Name: String;
Size: Integer;
Raflo_ImageId: Integer;
end;
TArrayFileImage = Array of TFileImage;
type
TProduct = packed record
Coded: String;
Name: String;
Raflo_DetailsId: Integer;
Raflo_IdCategory: Integer;
QtyInWarehause: Integer;
Price: Double;
DescProduct: String;
DescTechnical: String;
Width: Double;
Height: Double;
Depth: Double;
Weight: Double;
State: String;
FileImage: TArrayFileImage;
IdStatusDecription: Integer;
end;
TArrayProduct = Array of TProduct;
type
TPrestaProductPictureAdd = class(TThread)
fException: Exception;
fPrestaModule: TForm;
fFTP: TFTP;
fIT: TImageTypePresta;
fProgress: Integer;
fProgressMax: Integer;
fProgressTitle: String;
fProgressMore: Integer;
fProgressMoreMax: Integer;
fProgressMoreTitle: String;
fLinkReferenceToIdProduct: TLinkReferenceToIdProduct;
fsup: Integer;
public
constructor Create(fPM: TForm); //(fPM: TfPrestashopModule);
destructor Destroy; override;
private
procedure DoHandleException;
procedure sUp;
procedure ShowError;
function CreateDirList(ID: Integer): String;
procedure SendOrUpdateFile(ID: Integer);
procedure DrawTransparency(Canvas: TCanvas; X, Y: Integer; aBitmap: TBitmap; Transparency: Byte);
procedure ChangeResizeJpg(AOldFilename, ANewFilename: string; AWatermark: TPicture; Height, Width: Integer; ATransparency: Byte = 70;
background: TColor = clWhite);
procedure AddWatermarkJpg(AOldFilename, ANewFilename: string; AWatermark: TPicture; ATransparency: Byte = 70);
procedure PrepareImage(ID: Integer; fFile: string);
Procedure AddImage(Product: TProduct);
procedure GetAllReferenceFromPresta;
procedure UpdateProgress;
procedure SetProgress;
procedure UpdateProgressMore;
procedure SetProgressMore;
protected
procedure Execute; override;
procedure HandleException; virtual;
end;
implementation
// -----------------------------------------------------------------------------------------------------------
// TImageTypePresta
// -----------------------------------------------------------------------------------------------------------
Constructor TImageTypePresta.Create(MyConnection: TMyConnection);
begin
fConnection := MyConnection;
fTypeCount := 0;
setlength(fArrayImageType, 0);
end;
Procedure TImageTypePresta.GetImageType;
{ Pobiera nazwy i rozmiary w jakich muszą zostać utworzone pliki ze zdjęciami produktu }
var
DataPresta: TMyQuery;
begin
DataPresta := TMyQuery.Create(nil);
Try
DataPresta.Connection := fConnection;
DataPresta.SQL.Text := 'SELECT * FROM ' + Tab_Ps_image_type + ' WHERE ' + psit_products + '=1';
DataPresta.Active := True;
fTypeCount := DataPresta.RecordCount;
setlength(fArrayImageType, fTypeCount);
while not DataPresta.Eof do
begin
fArrayImageType[DataPresta.RecNo - 1].Name := DataPresta.FieldByName(psit_name).AsString;
fArrayImageType[DataPresta.RecNo - 1].Width := DataPresta.FieldByName(psit_width).AsInteger;
fArrayImageType[DataPresta.RecNo - 1].Height := DataPresta.FieldByName(psit_height).AsInteger;
DataPresta.Next;
end;
Finally
DataPresta.Free;
End;
end;
// -------------------------------------------------------------------------------------------------------------------------------
// Thread PrestaProductPictureAdd
// -------------------------------------------------------------------------------------------------------------------------------
constructor TPrestaProductPictureAdd.Create(fPM: TForm);
begin
fPrestaModule := fPM;
FreeOnTerminate := True;
fIT := TImageTypePresta.Create(fPrestaModule.fConnectionShop);
inherited Create(False);
end;
destructor TPrestaProductPictureAdd.Destroy;
begin
fIT.Free;
inherited Destroy;
end;
procedure TPrestaProductPictureAdd.DoHandleException;
begin
if GetCapture <> 0 then
SendMessage(GetCapture, WM_CANCELMODE, 0, 0);
if fException is Exception then
Application.ShowException(fException)
else
System.SysUtils.ShowException(fException, nil);
end;
procedure TPrestaProductPictureAdd.HandleException;
begin
// This function is virtual so you can override it
// and add your own functionality.
fException := Exception(ExceptObject);
try
// Don't show EAbort messages
if not(fException is EAbort) then
Synchronize(DoHandleException);
finally
fException := nil;
end;
end;
procedure TPrestaProductPictureAdd.UpdateProgress;
begin
fPrestaModule.SetGauge(fProgress);
end;
procedure TPrestaProductPictureAdd.SetProgress;
begin
fPrestaModule.InfoLabel(fProgressTitle);
fPrestaModule.InitGauge(fProgressMax);
fPrestaModule.SetGauge(0);
end;
procedure TPrestaProductPictureAdd.UpdateProgressMore;
begin
fPrestaModule.SetGaugeMore(fProgressMore);
end;
procedure TPrestaProductPictureAdd.SetProgressMore;
begin
fPrestaModule.InfoMoreLabel(fProgressMoreTitle);
fPrestaModule.InitGaugeMore(fProgressMoreMax);
fPrestaModule.SetGaugeMore(0);
end;
procedure TPrestaProductPictureAdd.Execute;
var
RP: TRafloProducts;
PNR: Integer;
begin
fException := nil;
sleep(200); // Czas na wykonanie ShowModal
Try
fProgressTitle := 'Wgrywanie nowych zdjęć do produktów';
fProgressMax := 1;
Synchronize(SetProgress);
fIT.GetImageType;
RP := TRafloProducts.Create(fPrestaModule.ConnectionRaflo);
Try
RP.OnlyGetCodec := True;
RP.GetImageId := True;
GetAllReferenceFromPresta;
if fPrestaModule.UpdateFromArray then
begin
// From list
fProgressMax := High(fPrestaModule.fArrayProductIdDetails);
if fProgressMax < 0 then
begin
PostMessage(fPrestaModule.Handle, WM_EndThread, Msg_Error, 0); // Aborted
Exit;
end;
Synchronize(SetProgress);
RP.AddProduct(fPrestaModule.fArrayProductIdDetails); // Odczyt produktu
for PNR := 0 to High(fPrestaModule.fArrayProductIdDetails) do
begin
AddImage(RP.Product[PNR]);
fProgress := PNR;
Synchronize(UpdateProgress);
if fPrestaModule.Aborted then
begin
PostMessage(fPrestaModule.Handle, WM_EndThread, Msg_Aborted, 0); // Aborted
Exit;
end;
end;
end
else
begin
// All
RP.AddProduct(fPrestaModule.fArrayProductIdDetails); // Odczyt produktu
fProgressMax := RP.ProductCount;
Synchronize(SetProgress);
for PNR := 0 to RP.ProductCount - 1 do
begin
AddImage(RP.Product[PNR]);
fProgress := PNR;
Synchronize(UpdateProgress);
if fPrestaModule.Aborted then
begin
PostMessage(fPrestaModule.Handle, WM_EndThread, Msg_Aborted, 0); // Aborted
Exit;
end;
end;
end;
Finally
RP.Free;
End;
PostMessage(fPrestaModule.Handle, WM_EndThread, Msg_OK, 0)
Except
HandleException;
End;
end;
Procedure TPrestaProductPictureAdd.ShowError;
Begin
raise Exception.Create('Procedura przerwana');
End;
Procedure TPrestaProductPictureAdd.GetAllReferenceFromPresta;
var
DataPresta: TMyQuery;
begin
DataPresta := TMyQuery.Create(nil);
Try
DataPresta.Connection := fPrestaModule.ConnectionShop;
DataPresta.SQL.Text := 'SELECT ' + psp_id_product + ',' + psp_reference + ' FROM ' + Tab_ps_product;
DataPresta.Active := True;
setlength(fLinkReferenceToIdProduct, DataPresta.RecordCount);
While not DataPresta.Eof do
begin
fLinkReferenceToIdProduct[DataPresta.RecNo - 1].Reference := UpperCase(DataPresta.FieldByName(psp_reference).AsString);
fLinkReferenceToIdProduct[DataPresta.RecNo - 1].IdProduct := DataPresta.FieldByName(psp_id_product).AsInteger;
DataPresta.Next;
end;
Finally
DataPresta.Free;
End;
end;
Procedure TPrestaProductPictureAdd.AddImage(Product: TProduct);
type
TExecute = (Nothing, Add, Update);
var
DataPresta: TMyQuery;
DataRaflo: TMyQuery;
X, Y: Integer;
fIdImage: Integer;
RecImage: Integer;
ArrayIdImage: Array of Integer;
Execute: TExecute;
LastImage: Integer;
function IdImageIsInPresta(aId: Integer): Boolean;
var
Z: Integer;
begin
Result := False;
for Z := 0 to High(ArrayIdImage) do
if ArrayIdImage[Z] = aId then
Exit(True);
end;
function BuildSetIdImage: String;
var
B: Integer;
begin
Result := '(';
for B := 0 to High(ArrayIdImage) do
Result := Result + IntToStr(ArrayIdImage[B]) + ',';
Result[High(Result)] := ')';
end;
begin
DataPresta := TMyQuery.Create(nil);
Try
DataPresta.Connection := fPrestaModule.ConnectionShop;
for X := 0 to High(fLinkReferenceToIdProduct) do
if fLinkReferenceToIdProduct[X].Reference = Product.Coded then
break;
if X <= High(fLinkReferenceToIdProduct) then
begin
// Werfikacja zdjec juz wgranych a te które są do wgrania
// Pobierz idImage zdjec danego produktu z PrestaShop
DataPresta.SQL.Text := 'SELECT ' + psi_id_image + ',' + psi_position + ' FROM ' + Tab_ps_image + ' WHERE ' + psi_id_product + '=' +
IntToStr(fLinkReferenceToIdProduct[X].IdProduct) + ' ORDER BY ' + psi_position;
DataPresta.Active := True;
setlength(ArrayIdImage, DataPresta.RecordCount);
LastImage := 0;
while not DataPresta.Eof do
begin
ArrayIdImage[DataPresta.RecNo - 1] := DataPresta.FieldByName(psi_id_image).AsInteger;
LastImage := DataPresta.FieldByName(psi_position).AsInteger;
DataPresta.Next;
end;
DataRaflo := TMyQuery.Create(nil);
Try
DataRaflo.Connection := fPrestaModule.ConnectionRaflo;
{...}
// Przygotuj zdjęcia
fIdImage := 1;
PrepareImage(fIdImage + fLinkReferenceToIdProduct[X].IdProduct * 10, Product.FileImage[0].Name);
{...}
Finally
DataRaflo.Free;
End;
end;
Finally
DataPresta.Free;
End;
end;
function TPrestaProductPictureAdd.CreateDirList(ID: Integer): String;
var
X: Integer;
T: String;
begin
Result := '';
T := IntToStr(ID);
for X := 1 to Length(T) do
Result := Result + T[X] + '/';
end;
procedure TPrestaProductPictureAdd.sUp;
begin
SendOrUpdateFile(fsup);
end;
procedure TPrestaProductPictureAdd.SendOrUpdateFile(ID: Integer);
var
FoundFile: Integer;
DirList: TStringList;
RecFile: TSearchRec;
begin
fPrestaModule.FTPShop.Login;
fPrestaModule.FTPShop.ChangeToRootDir;
fPrestaModule.FTPShop.ForceCreateDir(urlImgPrestashop + CreateDirList(ID));
// Pobieranie listy plików
DirList := TStringList.Create;
try
FoundFile := FindFirst(SystemRaflo.Path.AppData + PathPrestaShop + IntToStr(ID) + '\*.*', faAnyFile, RecFile);
while FoundFile = 0 do
begin
if RecFile.Name[1] <> '.' then
DirList.Add(SystemRaflo.Path.AppData + PathPrestaShop + IntToStr(ID) + '\' + RecFile.Name);
FoundFile := FindNext(RecFile);
end;
// Wgrywanie plików na serwer
for FoundFile := 0 to DirList.Count - 1 do
begin
fPrestaModule.FTPShop.DirectFileName := DirList[FoundFile];
fPrestaModule.FTPShop.DirectFile := True;
fPrestaModule.FTPShop.StoreFile(ExtractFileName(DirList[FoundFile]), not True);
end;
finally
DirList.Free;
end;
end;
procedure TPrestaProductPictureAdd.PrepareImage(ID: Integer; fFile: string);
const
index = '<?php' + #13#10 + 'header("Expires: Mon, 26 Jul 1997 05:00:00 GMT");' + #13#10 + 'header("Last-Modified: ".gmdate("D, d M Y H:i:s")." GMT");' +
#13#10 + 'header("Cache-Control: no-store, no-cache, must-revalidate");' + #13#10 + 'header("Cache-Control: post-check=0, pre-check=0", false);' + #13#10 +
'header("Pragma: no-cache");' + #13#10 + 'header("Location: ../");' + #13#10 + 'exit;';
var
TypeNr: Integer;
Transparancy: Integer;
Path: String;
TF: TextFile;
begin
Path := SystemRaflo.Path.AppData + PathPrestaShop + IntToStr(ID) + '\';
ForceDirectories(Path);
if fPrestaModule.Settings.Watermark_Active Then
Transparancy := 70
else
Transparancy := 100;
// AddWatermarkJpg(PWideChar(fFile), PWideChar(Path + IntToStr(ID) + '.jpg'), CompanyData.Logo, Transparancy);
for TypeNr := 0 to fIT.TypeCount - 1 do
ChangeResizeJpg(fFile, Path + IntToStr(ID) + '-' + fIT.ArrayType[TypeNr].Name + '.jpg', CompanyData.Logo, fIT.ArrayType[TypeNr].Height,
fIT.ArrayType[TypeNr].Width, Transparancy);
// Wymagany plik index.php przez prestashop
AssignFile(TF, Path + 'index.php');
Try
ReWrite(TF);
Write(TF, Index);
Flush(TF);
Finally
CloseFile(TF);
End;
end;
procedure TPrestaProductPictureAdd.AddWatermarkJpg(AOldFilename, ANewFilename: string; AWatermark: TPicture; ATransparency: Byte = 70);
var
CurrentPicture: TBitmap;
PictureWatermark: TBitmap;
jpg: TJpegImage;
NewHeight: Integer;
NewWidth: Integer;
pt: TPoint;
begin
jpg := TJpegImage.Create;
try
try
jpg.Loadfromfile(AOldFilename);
CurrentPicture := TBitmap.Create;
Try
{ Tworzy płutno z zawartością JPG }
CurrentPicture.Width := jpg.Width;
CurrentPicture.Height := jpg.Height;
CurrentPicture.Canvas.Draw(0, 0, jpg);
{ Wstawianie znaku wodnego }
If Assigned(AWatermark.Graphic) then
If not AWatermark.Graphic.Empty then
Begin
NewHeight := Round(CurrentPicture.Height * 0.5);
NewWidth := Round(CurrentPicture.Height * 0.5) * PictureWatermark.Width div PictureWatermark.Height;
if NewWidth > CurrentPicture.Width then
begin
NewWidth := Round(CurrentPicture.Width * 0.5);
NewHeight := NewWidth * PictureWatermark.Height div PictureWatermark.Width;
end;
PictureWatermark := TBitmap.Create;
Try
PictureWatermark.SetSize(NewWidth, NewHeight);
PictureWatermark.TransparentColor := clWhite;
PictureWatermark.Transparent := True;
PictureWatermark.Canvas.StretchDraw(Rect(0, 0, NewWidth, NewHeight), AWatermark.Graphic);
pt.X := (CurrentPicture.Width - PictureWatermark.Width) div 2;
pt.Y := (CurrentPicture.Height - PictureWatermark.Height) div 2;
DrawTransparency(CurrentPicture.Canvas, pt.X, pt.Y, PictureWatermark, ATransparency);
Finally
PictureWatermark.Free;
end;
end;
jpg.Assign(CurrentPicture);
jpg.SaveToFile(ANewFilename);
finally
CurrentPicture.Free;
end;
except
raise;
end;
finally
jpg.Free;
end;
end;
procedure TPrestaProductPictureAdd.ChangeResizeJpg(AOldFilename, ANewFilename: string; AWatermark: TPicture; Height, Width: Integer;
ATransparency: Byte = 70; background: TColor = clWhite);
{ Procedura zmienia wielkość zdjęcia i jeśli szerokość albo wysokość podana jest nieproporcjonalna co do zdjęcia to
zostaje to uzupełnione tłem o kolorze background }
var
CurrentPicture: TBitmap;
NewPicture: TBitmap;
PictureWatermark: TBitmap;
jpg: TJpegImage;
NewHeight: Integer;
NewWidth: Integer;
pt: TPoint;
begin
jpg := TJpegImage.Create;
try
jpg.Loadfromfile(AOldFilename);
// Proporcjonalne pomnijeszenie
NewHeight := Height;
NewWidth := Height * jpg.Width div jpg.Height;
if NewWidth > Width then
begin
NewWidth := Width;
NewHeight := NewWidth * jpg.Height div jpg.Width;
end;
CurrentPicture := TBitmap.Create;
try
NewPicture := TBitmap.Create;
try
{ Tworzy nowy rysunek z zachowanie proporcji }
CurrentPicture.SetSize(NewWidth, NewHeight);
CurrentPicture.Canvas.StretchDraw(CurrentPicture.Canvas.Cliprect, jpg);
{ Tworzenie tła o podanych wymiarach i kolorze }
NewPicture.SetSize(Height, Width);
NewPicture.Canvas.Brush.Style := bsSolid;
NewPicture.Canvas.Brush.Color := background;
NewPicture.Canvas.FillRect(Rect(0, 0, Width, Height));
{ Nakładanie obrazka na tło }
pt.X := (Width - CurrentPicture.Width) div 2;
pt.Y := (Height - CurrentPicture.Height) div 2;
NewPicture.Canvas.Draw(pt.X, pt.Y, CurrentPicture);
{ Wstawianie znaku wodnego }
if Assigned(AWatermark.Graphic) then
if not AWatermark.Graphic.Empty then
begin
if NewPicture.Width > 200 then
begin
NewHeight := Round(NewPicture.Height * 0.5);
NewWidth := Round(NewPicture.Height * 0.5) * AWatermark.Width div AWatermark.Height;
if NewWidth > NewPicture.Width then
begin
NewWidth := Round(NewPicture.Width * 0.5);
NewHeight := NewWidth * AWatermark.Height div AWatermark.Width;
end;
PictureWatermark := TBitmap.Create;
Try
PictureWatermark.SetSize(NewWidth, NewHeight);
PictureWatermark.TransparentColor := clWhite;
PictureWatermark.Transparent := True;
PictureWatermark.Canvas.StretchDraw(Rect(0, 0, NewWidth, NewHeight), AWatermark.Graphic);
pt.X := (NewPicture.Width - PictureWatermark.Width) div 2;
pt.Y := (NewPicture.Height - PictureWatermark.Height) div 2;
DrawTransparency(NewPicture.Canvas, pt.X, pt.Y, PictureWatermark, ATransparency);
Finally
PictureWatermark.Free;
End;
end;
end;
jpg.Assign(NewPicture);
jpg.CompressionQuality := 85;
jpg.Compress;
jpg.SaveToFile(ANewFilename);
finally
NewPicture.Free;
end;
finally
CurrentPicture.Free;
end;
finally
jpg.Free;
end;
end;
procedure TPrestaProductPictureAdd.DrawTransparency(Canvas: TCanvas; X, Y: Integer; ABitmap: TBitmap; Transparency: Byte);
var
Temp: TBitmap;
ByteSrc, ByteDest: ^Byte;
TripleSrc, TripleDest: ^TRGBTriple;
TransparentColor: TRGBTriple;
H, V: Integer;
begin
ABitmap.PixelFormat := pf24bit;
Temp := TBitmap.Create;
Temp.Canvas.Brush.Color := ABitmap.TransparentColor;
Temp.Width := ABitmap.Width;
Temp.Height := ABitmap.Height;
Temp.PixelFormat := pf24bit;
Temp.Canvas.CopyRect(Rect(0, 0, ABitmap.Width, ABitmap.Height), Canvas, Rect(X, Y, ABitmap.Width + X, ABitmap.Height + Y));
if ABitmap.Transparent then
begin
TransparentColor.rgbtBlue := (ABitmap.TransparentColor and $FF0000) shr 16;
TransparentColor.rgbtGreen := (ABitmap.TransparentColor and $00FF00) shr 8;
TransparentColor.rgbtRed := ABitmap.TransparentColor and $0000FF;
Temp.TransparentColor := ABitmap.TransparentColor;
Temp.Transparent := True;
for V := 0 to ABitmap.Height - 1 do
begin
TripleSrc := ABitmap.Scanline[V];
TripleDest := Temp.Scanline[V];
for H := 0 to ABitmap.Width - 1 do
begin
if (TransparentColor.rgbtBlue <> TripleSrc.rgbtBlue) or (TransparentColor.rgbtGreen <> TripleSrc.rgbtGreen) or
(TransparentColor.rgbtRed <> TripleSrc.rgbtRed) then
begin
TripleDest^.rgbtBlue := Trunc((TripleDest^.rgbtBlue / 100) * Transparency + (TripleSrc^.rgbtBlue / 100) * (100 - Transparency));
TripleDest^.rgbtGreen := Trunc((TripleDest^.rgbtGreen / 100) * Transparency + (TripleSrc^.rgbtGreen / 100) * (100 - Transparency));
TripleDest^.rgbtRed := Trunc((TripleDest^.rgbtRed / 100) * Transparency + (TripleSrc^.rgbtRed / 100) * (100 - Transparency));
end;
Inc(TripleSrc);
Inc(TripleDest);
end;
end;
end
else
begin
for V := 0 to ABitmap.Height - 1 do
begin
ByteSrc := ABitmap.Scanline[V];
ByteDest := Temp.Scanline[V];
for H := 0 to ABitmap.Width * 3 - 1 do
begin
ByteDest^ := Trunc((ByteDest^ / 100) * Transparency +
(ByteSrc^ / 100) * (100 - Transparency));
Inc(ByteSrc);
Inc(ByteDest);
end;
end;
end;
Canvas.Draw(X, Y, Temp);
Temp.Free;
end;
end.