Avatar billede michael-schou Novice
22. september 2008 - 10:24 Der er 6 kommentarer og
1 løsning

Hvordan indsætter man en CANCEL knap / funktion i dette EKS?

Hejsa eksperten.

Hvordan laver man en cancel knap i nedenstående eksempel?

Nedenstående eksempel er skrevet af kroning :

---------------------------------------------
unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ComCtrls;

type
  TForm1 = class(TForm)
    Label1: TLabel;
    Label2: TLabel;
    Label3: TLabel;
    ProgressBar1: TProgressBar;
    ProgressBar2: TProgressBar;
    Button1: TButton;
    procedure Button1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
    procedure CopyFolder(src, dest : string );
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

function CopyProgressRoutine(
    TotalFileSize : Int64;    // total file size, in bytes
    TotalBytesTransferred : Int64;    // total number of bytes transferred
    StreamSize : Int64;    // total number of bytes for this stream
    StreamBytesTransferred : Int64;    // total number of bytes transferred for this stream
    dwStreamNumber : DWORD;    // the current stream
    dwCallbackReason : DWORD;    // reason for callback
    hSourceFile : THandle;    // handle to the source file
    hDestinationFile : THandle;    // handle to the destination file
    lpData : pointer) : DWORD; stdcall; // passed by CopyFileEx
begin
  with Form1 do
  begin
    ProgressBar1.Max:=TotalFileSize;
    ProgressBar1.Position:=TotalBytesTransferred;
    ProgressBar1.Update;
    ProgressBar2.Position:=integer(lpData);
    ProgressBar2.Update;
    if TotalFileSize>0 then
      Label2.Caption:='Fil '+IntToStr(round((TotalBytesTransferred/TotalFileSize)*100));
    Label2.Update;
  end;
end;

procedure TForm1.CopyFolder(src, dest : string );
var
  fl : TStringList;
  i : integer;
  Path : string;

procedure MakeList(src, dest : string);
var
  sts : Integer ;
  SR: TSearchRec;
begin
  sts := FindFirst(src + '*.*' , faAnyFile , SR );
  while sts = 0 do
  begin
    if ( SR.Name <> '.' ) and ( SR.Name <> '..' ) then
    begin
      if ((SR.Attr and faDirectory)=faDirectory) then
        MakeList( src + SR.Name + '\', dest + SR.Name+ '\')
      else
        fl.Add(src + SR.Name+'='+dest + sr.name);
    end;
    sts:=FindNext( SR );
  end;
  FindClose( SR ) ;
end;

begin
  fl:=TStringList.Create;
  MakeList(src, dest);
  ProgressBar2.Max:=fl.Count;
  ProgressBar2.Position:=0;
  for i:=0 to fl.Count-1 do
  begin
    Label1.Caption:='Kopierer '+fl.Names[i]+' til '+fl.ValueFromIndex[i];
    Label1.Update;
    Label3.Caption:='Samlet '+IntToStr(Round(((i+1)/fl.Count)*100));
    Label3.Update;
    Path:=ExtractFilePath(fl.ValueFromIndex[i]);
    if not DirectoryExists(Path) then
      ForceDirectories(Path);
    CopyfileEx(PChar(fl.Names[i]), pchar(fl.ValueFromIndex[i]), @CopyProgressRoutine, pointer(i), nil, 0);
  end;
  fl.Free;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  CopyFolder('C:\Temp\', 'D:\Temp\');
end;

end.
---------------------------------------------

Mvh.

Michael.
Avatar billede hrc Mester
22. september 2008 - 10:50 #1
Du skriver koden om, retter den til og tester det. Det er en kende arrogant, men det er jo ikke et tagselv-bord af vores kunnen udi programmering.

Hvis du har tænkt dig at pakke det ind i en tråd må det være MakeList der kopieres til Execute. For-løkken ændres til en "while (i < List.Count - 1) and not Terminated do". Endelig skal al skrivning til komponenter pakkes ind i en Synchronize. På formen hvor du har din progress-bar placerer du en TButton hvori du sætter fMYCopyThread.Terminate := true;
Avatar billede borrisholt Novice
22. september 2008 - 11:15 #2
Man bruger en tråd, og kalder terminate på den ... Lidt opsøgende arbejde skulle bringe dig på sporet ...

Prøv www.LæsEnbogOgBlivKoog.nu evt bare www.LæsEnBog.nu

Hvis du køber dig en bog omkring Delphi læserden og tænker bag efter det var s... svært jeg fattede kun 10% af det hele ja så har du fundet den rigtige bog, forid så er du parat til at læse den igen ....

I øvrigt er jeg helt på linje med hrc.. Magen til arrogant holdning skal man lede efter ...

Hvis du selv helst vil være fri for alt det grove arbejde .. Ja så er vi flere der gør det for penge .. 8 timer om dagen .. Koder Delphi altså ;o) Og mod passende betaling leverer gerne en nøgle klar løsning ...

Jens Borrisholt
Avatar billede michael-schou Novice
22. september 2008 - 11:25 #3
Hmmm ... okay først og fremmest har jeg fået hjælp af kroning til dette eksempel jeg har skrevet øverste oppe det er taget fra mit eget spørgmål ..

For det andet har jeg altid spurgt pænt har altid fået en form for hjælp herinde .. det er først gang jeg er blevet kaldt arrogant.

Syntes selv at jeg spurgte pænt ihvertfald.

Men det skal ikke være på den måde jeg lukker spørgsmålet

Tak for hjælpen.
Avatar billede michael-schou Novice
22. september 2008 - 11:42 #4
Ikke fordi jeg er sur, men man kunne overveje at sige det på en pænere måde en anden gang har altid holdt en god tone her og har også fået hjælp af både dig (borrisholt) og hrc.

Ville bare lige tilføje at jeg godt kan forstå at man ikke bare lige overlever en færdig løsning, men skriv det på en pænere måde en anden gang, syntes at det er et fantastisk sted her på eksperten og vil ikke ligge mig ud med nogen og er heller ikke interesseret i at blive uvenner med nogen.

Mvh.

Michael.
Avatar billede borrisholt Novice
22. september 2008 - 12:43 #5
michael-schou>> Jeg farer i blæk huset fordi dit spørgsmål virker sådan lidt jeg gidder ikke lave noget selv .. EEndvidre ville bare en anelse recarch have bragt dig på sproet af dette spm :

http://www.eksperten.dk/spm/845617

Lad mig anbefale du får min tård til at virke først ...

En form en knap og et memofelt.. Så tager du min tråd og får skrevet alle de filnavne ud du finder ...

Du kan også ekespermentere med at sætte etn pause kanp på din form ...

Når så du har det til at vbirke så opretter du bare et spm her inde på eksperten så skal jeg gerne hjælpe dig gennem næste step .. Overser jeg dit spørgsmål må du gerne skrive direkte : Jens@Borrisholt.com

Men kære ven .. start selv :D

Så det korte svar start med at får ThreadSearch til at virke ...
Avatar billede michael-schou Novice
22. september 2008 - 13:09 #6
Helt ok borrisholt :D

Jeg kan sagtens se det fra din side og hrc's, men det var ikke sådan ment, jeg burde også have tilføjet at jeg har prøvet mig frem med nedenstående :

Uden for tråd :

Var
pbCancel: Bool;

with Form1 do
begin
    ProgressBar1.Max:=TotalFileSize;
    ProgressBar1.Position:=TotalBytesTransferred;
    ProgressBar1.Update;
    ProgressBar2.Position:=integer(lpData);
    ProgressBar2.Update;

  if pbCancel then
    Result                      := PROGRESS_CANCEL
  else
    Result                      := PROGRESS_CONTINUE;

    if TotalFileSize>0 then
      Label2.Caption:='Fil '+IntToStr(round((TotalBytesTransferred/TotalFileSize)*100));
    Label2.Update;
  end;

begin
  fl:=TStringList.Create;
  MakeList(src, dest);
  ProgressBar2.Max:=fl.Count;
  ProgressBar2.Position:=0;
  if pbCancel then
  Break;
  for i:=0 to fl.Count-1 do
  begin
    Label1.Caption:='Kopierer '+fl.Names[i]+' til '+fl.ValueFromIndex[i];
    Label1.Update;
    Label3.Caption:='Samlet '+IntToStr(Round(((i+1)/fl.Count)*100));
    Label3.Update;
    Path:=ExtractFilePath(fl.ValueFromIndex[i]);
    if not DirectoryExists(Path) then
      ForceDirectories(Path);
    CopyfileEx(PChar(fl.Names[i]), pchar(fl.ValueFromIndex[i]), @CopyProgressRoutine, pointer(i), nil, 0);
  end;
  fl.Free;
end;

procedure TForm1.btnCancelClick(Sender: TObject);
begin
pbCancel := True;
end;

Plejer næsten altid at prøve mig frem inden jeg jeg opretter et spørgsmål her på eksperten :-)

Men nok om det - jeg ser på dit link og prøver mig frem - takker indtil videre
borrisholt :-)
Avatar billede michael-schou Novice
03. oktober 2008 - 08:21 #7
Løsning er fundet takket være borrisholt, der viste vejen til en Thread løsning :

Har oprette Tråden : CopyThread som bliver tildelt til CT variablen.

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ComCtrls;

type
  CopyThread = class(TThread)
  private
  { Private declarations }
  Public
  { Public declarations }
  protected
  procedure Execute; override;
  end;

  TForm1 = class(TForm)
    Label1: TLabel;
    Label2: TLabel;
    Label3: TLabel;
    ProgressBar1: TProgressBar;
    ProgressBar2: TProgressBar;
    Button1: TButton;
    Button2: TButton;
    Button3: TButton;
    Label4: TLabel;
    procedure FormCreate(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure Button3Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
    procedure CopyFolder(src, dest : string );
  end;

var
  Form1: TForm1;
  CT : CopyThread;

implementation

{$R *.dfm}

procedure StartAgain;
begin
CT := CopyThread.Create(True);
Form1.ProgressBar1.Position := 0;
Form1.ProgressBar2.Position := 0;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
StartAgain;
end;

function CopyProgressRoutine(
    TotalFileSize : Int64;    // total file size, in bytes
    TotalBytesTransferred : Int64;    // total number of bytes transferred
    StreamSize : Int64;    // total number of bytes for this stream
    StreamBytesTransferred : Int64;    // total number of bytes transferred for this stream
    dwStreamNumber : DWORD;    // the current stream
    dwCallbackReason : DWORD;    // reason for callback
    hSourceFile : THandle;    // handle to the source file
    hDestinationFile : THandle;    // handle to the destination file
    lpData : pointer) : DWORD; stdcall; // passed by CopyFileEx
begin
  with Form1 do
  begin
    ProgressBar1.Max:=TotalFileSize;
    ProgressBar1.Position:=TotalBytesTransferred;
    ProgressBar1.Update;
    ProgressBar2.Position:=integer(lpData);
    ProgressBar2.Update;
    if TotalFileSize>0 then
      Label2.Caption:=(IntToStr(round((TotalBytesTransferred/TotalFileSize)*100))+'%');
    Label2.Update;

    Application.ProcessMessages;
  end;
end;


procedure TForm1.CopyFolder(src, dest : string );
var
  fl : TStringList;
  i : integer;
  Path : string;

procedure MakeList(src, dest : string);
var
  sts : Integer ;
  SR: TSearchRec;
begin
  sts := FindFirst(src + '*.*' , faAnyFile , SR );
  while sts = 0 do
  begin
    if ( SR.Name <> '.' ) and ( SR.Name <> '..' ) then
    begin
      if ((SR.Attr and faDirectory)=faDirectory) then
        MakeList( src + SR.Name + '\', dest + SR.Name+ '\')
      else
        fl.Add(src + SR.Name+'='+dest + sr.name);
    end;
    sts:=FindNext( SR );
  end;
  FindClose( SR ) ;
end;

begin
  fl:=TStringList.Create;
  MakeList(src, dest);
  ProgressBar2.Max:=fl.Count;
  ProgressBar2.Position:=0;
  for i:=0 to fl.Count-1 do
  begin
    Label1.Caption:='Kopierer '+fl.Names[i]+' til '+fl.ValueFromIndex[i];
    Label1.Update;
    Label3.Caption:=(IntToStr(Round(((i+1)/fl.Count)*100))+'%');
    Label3.Update;
    Path:=ExtractFilePath(fl.ValueFromIndex[i]);
    if not DirectoryExists(Path) then
      ForceDirectories(Path);
    CopyfileEx(PChar(fl.Names[i]), pchar(fl.ValueFromIndex[i]), @CopyProgressRoutine, pointer(i), nil, 0);
  end;
  fl.Free;
end;

Procedure CopyThread.Execute;
begin
FreeOnTerminate := True;
Form1.CopyFolder('C:\Temp\', 'D:\Temp\');
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
StartAgain;
CT.Resume;
end;

procedure TForm1.Button2Click(Sender: TObject);
label
Done;
begin
If NOT (Form1.Label4.Caption = 'Pause aktivated') Then
Begin
  CT.Suspended := True;
  Form1.Label4.Caption := 'Pause activated';
  GoTo Done;
end;

If (Form1.Label4.Caption = 'Pause aktivated') Then
Begin
  Form1.Label4.Caption := 'Pause NOT aktivated';
  CT.Resume;
  GoTo Done;
end;

Done :
end;

procedure TForm1.Button3Click(Sender: TObject);
begin
CT.Suspended := True;

If CT.Suspended Then
Begin
  StartAgain;
  Form1.Label4.Caption := 'Process Stopped';
end;
end;

end.
Avatar billede Ny bruger Nybegynder

Din løsning...

Tilladte BB-code-tags: [b]fed[/b] [i]kursiv[/i] [u]understreget[/u] Web- og emailadresser omdannes automatisk til links. Der sættes "nofollow" på alle links.

Loading billede Opret Preview
Kategori
Kurser inden for grundlæggende programmering

Log ind eller opret profil

Hov!

For at kunne deltage på Computerworld Eksperten skal du være logget ind.

Det er heldigvis nemt at oprette en bruger: Det tager to minutter og du kan vælge at bruge enten e-mail, Facebook eller Google som login.

Du kan også logge ind via nedenstående tjenester