unit1.pas

ziptv为delphi控件

Var
   i, j: Integer;
Begin
   With DragDropListView Do
   Begin
      ColumnWidths[0] := Columns[0].Width;
      j := 1;
      For i := 1 To MaxColumn Do
         If mnuView1.Items[i].Checked Then
         Begin
            ColumnWidths[i] := Columns[j].Width;
            Inc(j);
         End;
   End;
End;
//-------------------------------------------------------------

Procedure TForm1.ColumnsCreate;
Var
   i: Integer;
Begin
   With DragDropListView Do
   Begin
      For i := Items.Count - 1 Downto 0 Do
         TStringList(Items[i].Data).Free;

      Items.Clear();

      For i := Columns.Count - 1 Downto 0 Do
         Columns[i].Free();

      Columns.Add;
      Columns[0].Caption := Captions[0];
      Columns[0].Width := ColumnWidths[0];

      For i := 1 To MaxColumn Do
      Begin
         Columns.Add;
         Columns[Columns.Count - 1].Caption := Captions[i];
         If mnuView1.Items[i].Checked Then
            Columns[Columns.Count - 1].Width := ColumnWidths[i]
         Else
            Columns[Columns.Count - 1].Width := 0;
      End;

   End;
End;
//-------------------------------------------------------------

Procedure TForm1.ColumnsUpdate;
Var
   i: Integer;
Begin
   With DragDropListView Do
   Begin
      Columns[0].Caption := Captions[0];
      Columns[0].Width := ColumnWidths[0];

      For i := 1 To MaxColumn Do
         If mnuView1.Items[i].Checked Then
         Begin
            If Columns[i].Width = 0 Then
               Columns[i].Width := ColumnWidths[i];
         End
         Else
            Columns[i].Width := 0;

      //AlphaSort( );
   End;
End;
//-------------------------------------------------------------
{procedure TForm1.WMDROPFiles(var Msg: TWMDROPFILES);
var
 HDrop:THandle;
 News:Integer;
 FileName:PChar;
 uCount:Integer;
 fAction:Boolean;
  NewItem: TListItem;
begin
 HDrop:=Msg.Drop;
 Getmem(FileName,255);
 News := DragQueryFile(HDrop, $FFFFFFFF, FileName, 255);
 For uCount:=0 to Pred(News) do
 Begin
  DragQueryFile(HDrop, uCount, FileName,255);
  fAction:=True;
  NewItem := ListView1.Items.Add;                             (* Create a new row *)
  NewItem.Caption := FileName;
 end;
 DragFinish (HDrop);
 FreeMem(FileName,255);
 Msg.Result:=0;
end;}
//-------------------------------------------------------------

Procedure TForm1.FormCreate(Sender: TObject);
Begin
   InternalPasteMessage := RegisterWindowMessage('DragDrop PasteMsg');

   // list to hold dropped filenames
   FilenameList := TStringList.Create();

   // create custom TListView
   DragDropListView := TDragDropListView.Create(Self);
   With DragDropListView Do
   Begin
      Parent := Self;
      Align := alClient;
      MultiSelect := True;
      ViewStyle := vsReport;
      SmallImages := ImageList1;
      DragAcceptFiles(Handle, True);
   End;

   ReadIni();

   Show();
   ColumnsCreate();
   Application.ProcessMessages();

   // fill the custom listview (DragDropListView) with archive contents
   If Length(Edit1.Text) > 0 Then
      With ZipTV1 Do
      Begin
         DragDropListView.Items.BeginUpdate();

         ArchiveFile := Edit1.Text;
         FileSpec.Clear();
         If Length(Edit2.Text) > 0 Then
            FileSpec.Add(Edit2.Text)
         Else
            FileSpec.Add('*.*');

         If IsArcValid(ArcType) Then
            Activate();                 // fill the listbox

         DragDropListView.Items.EndUpdate();
      End;

End;
//-------------------------------------------------------------

Procedure TForm1.FormDestroy(Sender: TObject);
Begin
   DragDropListView.Free();
   FilenameList.Free();
End;
//-------------------------------------------------------------

Procedure TForm1.Exit1Click(Sender: TObject);
Begin
   Close();
End;
//-------------------------------------------------------------

Procedure TForm1.ZipTreeView1Click(Sender: TObject);
Begin
   DragDropListView.Items.Clear();
End;
//-------------------------------------------------------------

Procedure TForm1.FormClose(Sender: TObject; Var Action: TCloseAction);
Begin
   SaveColumnWidths();
   WriteIni();
End;
//-------------------------------------------------------------

Procedure TForm1.ReadIni;
Var
   i: Integer;
   b: Boolean;
Begin
   With TIniFile.Create(ChangeFileExt(Application.ExeName, '.INI')) Do
   Try
      With Form1 Do
      Begin
         Width := ReadInteger('Setup', 'Width', 560);
         Height := ReadInteger('Setup', 'Height', 400);
         Top := ReadInteger('Setup', 'Top',
            (GetSystemMetrics(SM_CYSCREEN) - Height) Div 2);
         left := ReadInteger('Setup', 'Left',
            (GetSystemMetrics(SM_CXSCREEN) - Width) Div 2);
      End;

      With DragDropListView Do
      Begin
         Font.Name := ReadString('Setup', 'FormatName', 'Arial');
         Font.Size := ReadInteger('Setup', 'FormatSize', 10);
         b := ReadBool('Setup', 'BoldFormat', False);
         If b Then
            Font.Style := [fsBold]
         Else
            Font.Style := [];

         b := ReadBool('Setup', 'ItalicFormat', False);
         If b Then
            Font.Style := Font.Style + [fsItalic];

         For i := 0 To MaxColumn Do
            ColumnWidths[i] := ReadInteger('Setup',
               'ColumnWidth' + IntToStr(i), DefaultWidths[i]);
      End;

      PrintName := ReadString('Setup', 'PrintName', 'Courier New');
      PrintSize := ReadInteger('Setup', 'PrintSize', 10);

      b := ReadBool('Setup', 'BoldPrint', False);
      If b Then
         PrintStyle := [fsBold]
      Else
         PrintStyle := [];

      b := ReadBool('Setup', 'ItalicPrint', False);
      If b Then
         PrintStyle := PrintStyle + [fsItalic];

      For i := 0 To MaxColumn Do
         mnuView1.Items[i].Checked := ReadBool('Setup', 'ViewChecked' + IntToStr(i),
            DefaultChecked[i]);

      CommaDelimited := ReadBool('Setup', 'CommaDelimited', False);
      With SaveDialog1 Do
         If CommaDelimited Then
            FilterIndex := 2
         Else
            FilterIndex := 1;

      Edit1.Text := ReadString('Setup', 'LastArchive', 'c:\test.zip');
      ComboBox2.ItemIndex := ReadInteger('Setup', 'ArchiveType', 6);
   Finally
      Free();
   End;
End;
//-------------------------------------------------------------

Procedure TForm1.WriteIni;
Var
   i: Integer;
   b: Boolean;
Begin
   With TIniFile.Create(ChangeFileExt(Application.ExeName, '.INI')) Do
   Try
      If WindowState <> wsMaximized Then
         With Form1 Do
         Begin
            WriteInteger('Setup', 'Width', Width);
            WriteInteger('Setup', 'Height', Height);
            WriteInteger('Setup', 'Top', Top);
            WriteInteger('Setup', 'Left', left);
         End;

      WriteString('Setup', 'LastArchive', Edit1.Text);

      With DragDropListView Do
      Begin
         WriteString('Setup', 'FormatName', Font.Name);
         WriteInteger('Setup', 'FormatSize', Font.Size);

         b := (fsBold In Font.Style);
         WriteBool('Setup', 'BoldFormat', b);

         b := (fsItalic In Font.Style);
         WriteBool('Setup', 'ItalicFormat', b);

         For i := 0 To MaxColumn Do
            If ColumnWidths[i] > 0 Then
               WriteInteger('Setup', 'ColumnWidth' + IntToStr(i), ColumnWidths[i]);
      End;

      WriteString('Setup', 'PrintName', PrintName);
      WriteInteger('Setup', 'PrintSize', PrintSize);

      b := (fsBold In PrintStyle);
      WriteBool('Setup', 'BoldPrint', b);

      b := (fsItalic In PrintStyle);
      WriteBool('Setup', 'ItalicPrint', b);

      For i := 0 To MaxColumn Do
         WriteBool('Setup', 'ViewChecked' + IntToStr(i), mnuView1.Items[i].Checked);

      WriteBool('Setup', 'CommaDelimited', CommaDelimited);
      WriteInteger('Setup', 'PrintSize', PrintSize);
      WriteInteger('Setup', 'ArchiveType', ComboBox2.ItemIndex);
   Finally
      Free;
   End;
End;
//-------------------------------------------------------------

Procedure TForm1.ToggleChecked(Sender: TObject);
Begin
   With Sender As TMenuItem Do
      Checked := Not Checked;

   ColumnsUpdate();
   SaveColumnWidths();
End;
//-------------------------------------------------------------

Procedure TForm1.ScreenFont1Click(Sender: TObject);
Begin
   With FontDialog1 Do
   Begin
      Font.Name := DragDropListView.Font.Name;
      Font.Size := DragDropListView.Font.Size;
      Font.Style := DragDropListView.Font.Style;
      If Execute Then
      Begin
         DragDropListView.Font.Name := Font.Name;
         DragDropListView.Font.Size := Font.Size;
         DragDropListView.Font.Style := Font.Style;
      End;
   End;
End;
//-------------------------------------------------------------

Procedure TForm1.PrintFont1Click(Sender: TObject);
Begin
   With FontDialog1 Do
   Begin
      Font.Name := PrintName;
      Font.Size := PrintSize;
      Font.Style := PrintStyle;
      If Execute() Then
      Begin
         PrintName := Font.Name;
         PrintSize := Font.Size;
         PrintStyle := Font.Style;
      End;
   End;
End;
//-------------------------------------------------------------

Procedure TForm1.CalcBuffer;
Var
   i, j, k: Longint;
Begin
   For i := 0 To MaxColumn Do
      FieldLen[i] := 0;

   With DragDropListView Do
   Begin
      For i := 0 To Items.Count - 1 Do
         If (Items[i].Selected) And
            (Length(Items[i].Caption) > FieldLen[0]) Then
            FieldLen[0] := Length(Items[i].Caption);

      k := 0;
      For i := 1 To MaxColumn Do
         If mnuView1.Items[i].Checked Then
         Begin
            For j := 0 To Items.Count - 1 Do
               If (Items[j].Selected) And
                  (Length(Items[j].SubItems[k]) > FieldLen[i]) Then
                  FieldLen[i] := Length(Items[j].SubItems[k]);
            Inc(k);
         End;

      k := FieldLen[0];
      For i := 1 To MaxColumn Do
         If mnuView1.Items[i].Checked Then
            k := k + 1 + FieldLen[i];   {1 space between fields}
      k := k + 2;                       {crlf}
      BufferSize := k * SelCount;
   End;
End;
//-------------------------------------------------------------

Procedure TForm1.MakeBuffer;
Var
   i, j, k, p, q: Longint;
   crlf: String;