unit1.pas

ziptv为delphi控件

   Begin
      SetCurrentDir(Dir);
      edtSearchDir.Text := Dir;
   End
   Else
      edtSearchDir.Text := '';
End;
//-------------------------------------------------------------
(* OnActivate event *)

Procedure TfrmMain.FindFile1Activate(Sender: TObject);
Begin
   ListView1.Cursor := crHourGlass;
   ListView1.Items.Clear();
   ListView1.Update();
End;
//-------------------------------------------------------------
(* OnDeactivate event *)

Procedure TfrmMain.FindFile1Deactivate(Sender: TObject);
Begin
   With ListView1 Do
   Begin
      Cursor := crDefault;
      Update();
   End;

   StatusBar1.SimpleText := 'Done...';
   StatusBar2.SimpleText := '';
End;
//-------------------------------------------------------------
(* OnGetPassword event *)

Procedure TfrmMain.FindFile1GetPassword(Sender: TObject; FName: String;
   Var Password: String; Var TryAgain: Boolean);
Begin
   If Not InputQuery('Encrypted file...', 'Enter password', Password) Then
      TryAgain := False;
End;
//-------------------------------------------------------------
(* OnNextVolume event *)

Procedure TfrmMain.FindFile1NextVolume(Sender: TObject; Var Dir, FileName: String;
   VolumeID: String; FExists: Boolean; Var Cancel: Boolean);
Var
   NewFileName,
      Prompt,
      Caption: String;
Begin
   Cancel := False;
   If Not FExists Then
   Begin
      Caption := 'Enter drv:\dir\volname...';
      Prompt := 'Volume ID: ' + VolumeID;
      NewFileName := AppendDirTail(Dir) + FileName;
      If Not InputQuery(Caption, Prompt, NewFileName) Then
         Cancel := True
      Else
      Begin
         Dir := ExtractFilePath(NewFileName);
         FileName := ExtractFilename(NewFileName);
      End;
   End;
End;
//-------------------------------------------------------------
(* OnProgress event *)

Procedure TfrmMain.FindFile1Progress(Sender: TObject; ProgressByFile, ProgressByArchive:
   Byte);
Begin
   ProgressBar1.Position := ProgressByFile;
   ProgressBar1.Update();
   ProgressBar2.Position := ProgressByArchive;
   ProgressBar1.Update();
End;
//-------------------------------------------------------------
(* OnExtractBegin event *)

Procedure TfrmMain.FindFile1ExtractBegin(Sender: TObject; FName: String;
   Count: Integer; Var Extract: Boolean);
Begin
   {$IFDEF THREADSAFE}
   MultiTasker1.LockExecution();        // lock threading resource until this
   // thread is finished decompressing
   {$ENDIF}
   //Label4.Caption := 'Extracting:';
   //Label4.Update();
   Label5.Caption := 'Extracting:';
   Label5.Update();
   StatusBar2.SimpleText := FName;
   StatusBar2.Update();
   Application.ProcessMessages();
End;
//-------------------------------------------------------------
(* OnExtractEnd event *)

Procedure TfrmMain.FindFile1ExtractEnd(Sender: TObject; FileName: String;
   CRC_PASS: Boolean);
Begin
   StatusBar1.SimpleText := '';
   StatusBar1.Update();
   ProgressBar1.Position := 0;
   ProgressBar2.Position := 0;
   {$IFDEF THREADSAFE}
   MultiTasker1.UnlockExecution();      // unlock threading resources...
   // decompression is finished.
   {$ENDIF}
End;
//-------------------------------------------------------------
(* OnCurrentDir event *)

Procedure TfrmMain.FindFile1CurrentDir(Sender: TObject; Dir: String);
Begin
   Label4.Caption := 'Directory:';
   StatusBar1.SimpleText := MinimizeName(Dir, StatusBar1.Canvas, StatusBar1.Width - 10);
   StatusBar1.Update();
   StatusBar2.SimpleText := '';
   StatusBar2.Update();
End;
//-------------------------------------------------------------
(* OnCurrentFile event *)
(* Display the current archive & file in StatusBar *)

Procedure TfrmMain.FindFile1CurrentFile(Sender: TObject; FileName: String);
Begin
   Label5.Caption := 'File:';
   Label5.Update();
   StatusBar2.SimpleText := FileName;
   StatusBar2.Update();
End;
//-------------------------------------------------------------
(* OnElaspedTime event *)

Procedure TfrmMain.FindFile1ElapsedTime(Sender: TObject; ElapsedTime: Single);
Var
   s: ShortString;
Begin
   (* If CheckBox3 checked, display elasped time *)
   If CheckBox3.Checked Then
   Begin
      s := Format('Seconds: %g', [ElapsedTime]);
      ShowMessage(s + #13#13'OnElapsedTime event');
   End;
End;
//-------------------------------------------------------------
(* ListView1 ColumnClick event *)

Procedure TfrmMain.ListView1ColumnClick(Sender: TObject; Column: TListColumn);
Begin
   ShowMessage('For an example of column sorting see demos/zipview/zptvdemo.dpr');
End;
//-------------------------------------------------------------
(* Menu item File/Exit *)

Procedure TfrmMain.Exit1Click(Sender: TObject);
Begin
   FindFile1.Cancel := True;
   Close;
End;
//-------------------------------------------------------------
(* Menu item View/Error Messages *)

Procedure TfrmMain.ErrorMessages1Click(Sender: TObject);
Begin
   frmErrorMsgs.ShowModal;
End;
//-------------------------------------------------------------
(* Execute the file clicked on *)

Procedure TfrmMain.ListView1DblClick(Sender: TObject);
Const
   (* ListView Column Subitems *)
   SUBITEM_ARCHIVE = 3;
Begin

   If ListView1.ItemFocused.Caption = '' Then
      Exit;

   ZipRun1.ArchiveFile :=
      AppendDirTail(edtSearchDir.Text) +
      ExtractFilename(ListView1.ItemFocused.SubItems[SUBITEM_ARCHIVE]);

   ZipRun1.FileSpec.Clear();
   ZipRun1.FileSpec.Add(ListView1.ItemFocused.Caption);
   ZipRun1.Execute(ListView1.ItemFocused.Caption);
End;
//-------------------------------------------------------------
(* Cancel button *)

Procedure TfrmMain.btnCancelClick(Sender: TObject);
Begin
   FindFile1.Cancel := True;
End;
//-------------------------------------------------------------

Procedure TfrmMain.Panel2MouseMove(Sender: TObject; Shift: TShiftState; x, y: Integer);
Begin
   Cursor := crDefault;
End;
//-------------------------------------------------------------

Procedure TfrmMain.CheckBox2Click(Sender: TObject);
Begin
   Panel9.Visible := CheckBox2.Checked;
   Panel10.Visible := CheckBox2.Checked;
End;
//-------------------------------------------------------------

Procedure TfrmMain.FindFile1CurrentArchive(Sender: TObject; ArchiveFile: String);
Begin
   Label4.Caption := 'Archive:';
   StatusBar1.SimpleText := MinimizeName(TZipCommon(Sender).ArchiveFile,
      StatusBar1.Canvas, StatusBar1.Width - 10);
   StatusBar1.Update();
   StatusBar2.SimpleText := '';
   StatusBar2.Update();
End;
//-------------------------------------------------------------

Procedure TfrmMain.FormActivate(Sender: TObject);
Begin
   {$IFDEF ListView}
   ListView1.BringToFront;
   {$ELSE}
   ZipView1.BringToFront;
   {$ENDIF}
End;
//-------------------------------------------------------------

Procedure TfrmMain.MultiTasker1TaskLaunched;
Begin
   {$IFDEF THREADSAFE}
   ShowMessage('Task Launched'#13#13 + 'Current thread: ' +
      IntToStr(MultiTasker1.Count));
   {$ENDIF}
End;
//-------------------------------------------------------------

Procedure TfrmMain.MultiTasker1AllTaskFinished;
Begin
   {$IFDEF THREADSAFE}
   ShowMessage('All Tasks Finished'#13#13 + 'Active threads: ' +
      IntToStr(MultiTasker1.Count));
   {$ENDIF}
End;
//-------------------------------------------------------------

Procedure TfrmMain.MultiTasker1TaskFinished;
Begin
   {$IFDEF THREADSAFE}
   ShowMessage('Task Finished'#13#13 + 'Active threads: ' + IntToStr(MultiTasker1.Count -
      1));
   {$ENDIF}
End;
//-------------------------------------------------------------

Procedure TfrmMain.MultiTasker1Error;
Begin
   {$IFDEF THREADSAFE}
   //ShowMessage( 'Error: ' +  MultiTasker1.ThreadID + #13#13MultiTasker1.ErrorMessage ) );
   ShowMessage('Error: ' + MultiTasker1.LastError);
   {$ENDIF}
End;
//-------------------------------------------------------------

Procedure TfrmMain.MultiTasker1Waiting;
Begin
   ShowMessage('Waiting...');
End;
//-------------------------------------------------------------

Procedure TfrmMain.FormCreate(Sender: TObject);
Begin
   {$IFDEF THREADSAFE}
   MultiTasker1 := TMultiTasker.Create(Nil);
   MultiTasker1.OnAllTaskFinished := MultiTasker1AllTaskFinished;
   MultiTasker1.OnTaskFinished := MultiTasker1TaskFinished;
   MultiTasker1.OnError := MultiTasker1Error;
   MultiTasker1.OnWaiting := MultiTasker1Waiting;
   MultiTasker1.OnTaskLaunched := MultiTasker1TaskLaunched;
   {$ENDIF}
End;
//-------------------------------------------------------------

Procedure TfrmMain.FormDestroy(Sender: TObject);
Begin
   {$IFDEF THREADSAFE}
   MultiTasker1.Destroy();
   {$ENDIF}
End;
//-------------------------------------------------------------

End.