Oppure

Loading
20/04/10 15:32
a_butta
Allora il codice funziona di per sè, solo che dato che io devo far passare i valori da una form a un altra ho fatto in questo modo: Dalla form principale ho impostato le variabili Source e Destination e poi ho inserito la chiamata SaveForm.Show.

Nella SaveUnit ho questo codice:

unit saveunit;

{$mode objfpc}{$H+}

interface

uses
  Classes, SysUtils, FileUtil, LResources, Forms, Controls, Graphics, Dialogs,
  ComCtrls, StdCtrls;
var Source, Destination: string;
type

  { TSaveForm }

  TSaveForm = class(TForm)
    Label1: TLabel;
    LabelCount: TLabel;
    ProgressBar1: TProgressBar;
    procedure FormCreate(Sender: TObject);
    procedure FormShow(Sender: TObject);
  private
    { private declarations }
  public
    { public declarations }
  end; 

  type
      {Thread Copiatura}

  TCopyProcedure = class(TThread)
     private
     fStatusText : string;

    protected
    procedure Execute; override;
end;

var
  SaveForm: TSaveForm;

implementation

{ TSaveForm }

procedure TCopyProcedure.Execute;
var
    newStatus : string;
    FromF,
    ToF        : file of byte;
    Buffer     : array[0..4096] of char;
    NumRead    : integer;
    FileLength : int64;
begin
  //TCopyProcedure.Synchronize ;
  //fStatusText := 'TMyThread Running...';
  AssignFile(FromF,Source);
  reset(FromF);
  ShowMessage(Destination);
  AssignFile(ToF,Destination);
  Rewrite(ToF);
  FileLength:=FileSize(Source);
  SaveForm.LabelCount.Caption := IntToStr(FileLength) ;
  SaveForm.Progressbar1.Max := FileLength;
    while FileLength > 0 do
    begin
      BlockRead(FromF,Buffer[0],SizeOf(Buffer),NumRead);
      FileLength := FileLength - NumRead;
      BlockWrite(ToF,Buffer[0],NumRead);
      SaveForm.Progressbar1.Position := SaveForm.Progressbar1.Position + NumRead;
      SaveForm.ProgressBar1 .Caption := IntToStr(SaveForm.ProgressBar1.Position );
      SaveForm.Label1.Caption:= IntToStr((SaveForm.Progressbar1.Position *  SaveForm.Progressbar1.Max) div 10000) + ' %';
    end;
    CloseFile(FromF);
    CloseFile(ToF);
  SaveForm.Label1.Caption := ('File Copiato con successo!');
  SaveForm.ProgressBar1.Position:=0;
  Terminate;
end;


procedure TSaveForm.FormCreate(Sender: TObject);
begin

end;

procedure TSaveForm.FormShow(Sender: TObject);
begin
  TCopyProcedure.Create (False);
end;

initialization
  {$I saveunit.lrs}

end.


Durante il debug non mi dà errore. Quando invece da runtime avvio la procedura, mi viene fuori il seguente errore:
Project nome.exe raised exception class 'EThread' with message CheckSyncronize called from non-main thread "$C78"

Le ultime tre lettere però variano ogni volta che esce il messaggio.

Non ho idea di come risolvere:d... potete aiutarmi?
Grazie...
Ultima modifica effettuata da a_butta 20/04/10 15:33
aaa
20/04/10 19:37
Senti ,io non ho capito cosa tu voglia fare con il multithreading.
Comunque se vuoi un copia file eccotelo (anche se so che sei capace di farne uno)
Ultima modifica effettuata da 21/04/10 16:26
20/04/10 19:40
Scusa ,ecco il codice:

unit Unit1;

{$mode objfpc}{$H+}

interface

uses
Classes, SysUtils, FileUtil, LResources, Forms, Controls, Graphics, Dialogs,
StdCtrls, ComCtrls,windows;

type

{ TForm1 }

TForm1 = class(TForm)
Button1 : TButton;
Button2 : TButton;
Label1 : TLabel;
Label2 : TLabel;
OpenDialog1 : TOpenDialog;
ProgressBar1 : TProgressBar;
SaveDialog1: TSaveDialog;
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
procedure FormClick(Sender: TObject);
private
{ private declarations }
public
{ public declarations }
end;

var
Form1: TForm1;

implementation

var
filesorg,
filedest : file;
recordletti : integer;
buffer : array[1..1000] of byte;
nome1,
nome2 : string;


//mi scuso se non applico bene le regole di modularita'
//ma e' solo un esempio
procedure copia;
begin
Assign(filesorg,nome1);
{$I-}
reset(filesorg,1);
{$I+}
if ioresult <> 0 then
showmessage('Errore');
// o se no : messagebox(form1.handle,'Errore!','',MB_ICONERROR);
Assign(filedest,nome2);
rewrite(filedest,1);
blockread(filesorg,buffer,sizeof(buffer),recordletti);
form1.ProgressBar1.Min := 0;
form1.ProgressBar1.Max := recordletti;
form1.progressbar1.Position := recordletti;
while recordletti > 0 do
begin
blockwrite(filedest,buffer,sizeof(buffer));
blockread(filesorg,buffer,sizeof(buffer),recordletti);
form1.ProgressBar1.Position := form1.ProgressBar1.position + recordletti;
end;

close(filesorg);
close(filedest);
form1.label2.Visible := true;
form1.label1.Caption := '' ;
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
//apre la finestra di scelta del file
if opendialog1.Execute then
begin
nome1 := form1.OpenDialog1.FileName;
label1.Caption := nome1;
end;
end;

procedure TForm1.FormClick(Sender: TObject);
begin
label2.Visible := false;
form1.progressbar1.Position := 0;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
if savedialog1.Execute then
begin
nome2 := savedialog1.FileName;
end;
copia;
end;

initialization
{$I unit1.lrs}

end.
Ultima modifica effettuata da 20/04/10 19:54
20/04/10 20:20
a_butta
si ma così non hai usato un thread separato... in questo modo io avrei lo stesso problema: mentre cerca di sviluppare la procedura COPIA il programma non fa altro... e sono punto a capo...
aaa
22/04/10 14:54
Prova questo :

a me funziona ..
solamente che dopo la prima copia la memoria occupata sale di colpo..
guarda il task menager


unit Unit1;

{$mode objfpc}{$H+}

interface

uses
Classes, SysUtils, FileUtil, LResources, Forms, Controls, Graphics, Dialogs,
StdCtrls, ComCtrls, ExtDlgs{,windows};

type



ThreadCopia = class(TThread)
private

procedure copiafile;

protected

Procedure Execute; override;//in execute si mette il codice da eseguire

public

constructor Create(CreateSuspended: boolean);

end;



{ TForm1 }

TForm1 = class(TForm)
Button1 : TButton;
Button2 : TButton;
Label1 : TLabel;
Label2 : TLabel;
OpenDialog1 : TOpenDialog;
ProgressBar1 : TProgressBar;
SaveDialog1: TSaveDialog;
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
procedure FormClick(Sender: TObject);
procedure FormCreate(Sender: TObject);

public
{ public declarations }
end;

var
Form1: TForm1;

implementation


var
filesorg,
filedest : file;
recordletti : int64;
buffer : array[1..1000] of byte;
nome1,
nome2 : string;
//il thread
th : ThreadCopia;

//mi scuso se non applico bene le regole di modularita'
//ma e' solo un esempio
procedure copia;
begin
Assign(filesorg,nome1);
{$I-}
reset(filesorg,1);
{$I+}
if ioresult <> 0 then
showmessage('Errore');
// o se no : messagebox(form1.handle,'Errore!','',MB_ICONERROR);
Assign(filedest,nome2);
{$I-}
rewrite(filedest,1);
{$I+}
if ioresult <> 0 then
showmessage('Inserire il nome del file!');
blockread(filesorg,buffer,sizeof(buffer),recordletti);
form1.ProgressBar1.Min := 0;
form1.ProgressBar1.Max := recordletti;
form1.progressbar1.Position := recordletti;
while recordletti > 0 do
begin
blockwrite(filedest,buffer,sizeof(buffer));
blockread(filesorg,buffer,sizeof(buffer),recordletti);
form1.ProgressBar1.Position := form1.ProgressBar1.position + recordletti;
end;

close(filesorg);
close(filedest);
form1.label2.Visible := true;
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
//apre la finestra di scelta del file
button1.visible := true;
if opendialog1.Execute then
begin
nome1 := form1.OpenDialog1.FileName;
label1.Caption := nome1;
end;
end;

procedure TForm1.FormClick(Sender: TObject);
begin
label2.Visible := false;
form1.progressbar1.Position := 0;
form1.label1.Caption := 'Nome del file : ' ;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
th := threadcopia.Create(true);
end;






procedure TForm1.Button1Click(Sender: TObject);
begin

if savedialog1.Execute then
begin
nome2 := savedialog1.FileName;
end;
if (nome2 <> '') and (nome1 <> '') then
th.Execute;

end;


//////// DEFINIZIONE DELLO THREAD ///////////////////////////////////////////////////


constructor threadcopia.Create(CreateSuspended : boolean);
begin
FreeOnTerminate := True;
inherited Create(CreateSuspended);
end;

procedure threadcopia.copiafile;
begin
copia;
end;

procedure threadcopia.Execute;
begin
Synchronize(@copiafile);
end;

initialization
{$I unit1.lrs}

end.
22/04/10 15:27
a_butta
ciao ho visto un po' il tuo codice... grazie mille...
Io avevo portato questo codice in Delphi 2010:
unit MainUnit;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ExtCtrls, ComCtrls, Grids, StdCtrls, Menus, GIFImg, pngimage, MPlayer;
var Source, Destination : String;
type
  TMainForm = class(TForm)
      (*... Qui ci sono tutte le dichiarazioni della form ...*);
end;

  type ThreadCopy = class(TThread)

     private

     public
     protected
     Procedure Execute; override;
end;

Const FilesFolder = 'files\';
var
  MainForm: TMainForm;
  NumCanti: byte;
  i : byte = 0;
implementation

{$R *.dfm}

procedure ThreadCopy.Execute;
var
    newStatus : string;
    FromF,
    ToF        : file of byte;
    Buffer     : array[0..4096] of char;
    NumRead    : integer;
    FileLength : longint;
    Qualcosa   : real;
begin

  AssignFile(FromF,Source);
  reset(FromF);
  AssignFile(ToF,Destination);
  Rewrite(ToF);
  FileLength:=FileSize(FromF);
  MainForm.Progressbar1.Max := FileLength;
    while FileLength > 0 do
    begin
      BlockRead(FromF,Buffer[0],SizeOf(Buffer),NumRead);
      FileLength := FileLength - NumRead;
      BlockWrite(ToF,Buffer[0],NumRead);
      MainForm.Progressbar1.Position := MainForm.Progressbar1.Position + NumRead;
      Qualcosa:= (MainForm.ProgressBar1.Position / MainForm.Progressbar1.Max) *100;
      //MainForm.Image1.Width := Trunc((374 * Qualcosa) / 100);
      MainForm.Label2.Caption:= IntToStr(Trunc(Qualcosa)) + ' %';
    end;
    CloseFile(FromF);
    CloseFile(ToF);
  ShowMessage('File Copiato con successo!');
  MainForm.ProgressBar1.Position:=0;
  MainForm.ProgressBar1.Visible := False;
  MainForm.Label2.Visible := False;
  Terminate;
end;

procedure TMainForm.OriginaleMP31Click(Sender: TObject);
var i:byte; n,s:string;
    f:textfile;
begin
n:= StringGrid1.Cells[0,StringGrid1.Row];
s:= StringGrid1.Cells[1,StringGrid1.Row];
Source:= GetCurrentDir+'\'+FilesFolder+n+'\'+n+'a.mp3';
With SaveDialog1 do
begin
for i:=1 to length(s) do
   if s[i] = ':' then s[i]:= ',';
  SaveDialog1.Title:= 'Salva sul pc Originale Mp3';
  SaveDialog1.Filter:= 'Originale MP3 (*.mp3) | *.mp3';
  SaveDialog1.FileName:= StringGrid1.Cells[0,StringGrid1.Row] + ' - ' + s+'.mp3';
  SaveDialog1.Execute;
  if not(SaveDialog1.FileName = '') then
     begin
          ProgressBar1.Visible := True;
          Label2.Visible := True;
          Destination:= SaveDialog1.FileName;
          //ShowMessage('Source: '+Source);
          //ShowMessage('Destination: '+Destination);
          ThreadCopy.Create(False);
     end;
end;
end;

end.


Di per sè funziona molto bene... Solo che non riesco a far terminare il Thread... Cioè non riesco ad usare un comando dall'esterno, tipo un bottone della form, per bloccare il Thread... Hai dei consigli?
grazie mille comunque di tutto
aaa
23/04/10 15:49
prova ad impostare la proprieta' terminated a true. O se no usi direttamente la procedura.
09/05/10 15:34
Daf
Ho trovato l'errore nel codice:
Quando crei il Thread per poi poterlo fermare devi "salvarlo" cioè
var
  Copia: TNomeOggettoThread;
begin
  Copia := TNomeOggettoThread.Create(False);
end;

procedure Bottone1(Sender: TObject);
begin
  Copia.Terminate;
end;

:k:
Ultima modifica effettuata da Daf 09/05/10 15:35
aaa