统一一个文件中bit位 1 的个数

unit CountThread;

interface

uses
  Classes, SysUtils, Dialogs, Math;

type
  TCountThread = class(TThread)
  private
    FFileName: string;
    FFileSize: Int64;

    FOnStartCount: TNotifyEvent;
    FOnProcess: TNotifyEvent;
    FOnEndCount: TNotifyEvent;

    FSumBit: Int64;
    FBlockCount: Integer;

    function CountBits(B: Byte): Integer;
  protected
    procedure Execute;override;
  public
    property FileName: string read FFileName write FFileName;
    property FileSize: Int64 read FFileSize write FFileSize;
    property BlockCount: Integer read FBlockCount write FBlockCount;
    property SumBit: Int64 read FSumBit write FSumBit;

    property OnStartCount: TNotifyEvent read FOnStartCount write FOnStartCount;
    property OnProgress: TNotifyEvent read FOnProcess write FOnProcess;
    property OnEndCount: TNotifyEvent read FOnEndCount write FOnEndCount;
  end;  

implementation

const
  BlockSize = 102400;

{ TCountThread }

function TCountThread.CountBits(B: Byte): Integer;
begin
  Result := 0;
  while b<>0 do begin
    if Odd(B) then Inc(Result);
    b := b shr 1;
  end;
end;

procedure TCountThread.Execute;
var
  s: TStream;
  i, rc: Integer;
  str: array[1..BlockSize] of byte;
begin
  inherited;
  FSumBit := 0;
  s := TFileStream.Create(FFileName, fmOpenRead);
  FFileSize := s.Size;
  FBlockCount := Ceil(FFileSize / BlockSize);
  FOnStartCount(Self);

  while FBlockCount > 0 do begin
    rc := s.Read(str, BlockSize);
    for i := 1 to rc do begin
      FSumBit := FSumBit + CountBits(str[i]);
    end;
    FOnProcess(Self);
    Dec(FBlockCount);
  end;
  FOnEndCount(Self);
  FreeAndNil(s);
end;

end.

unit Unit1;

interface

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

type
  TForm1 = class(TForm)
    btn1: TButton;
    mmo1: TMemo;
    dlgOpen1: TOpenDialog;
    pb1: TProgressBar;
    procedure btn1Click(Sender: TObject);
  private
    th: TCountThread;
    StartTime: TDateTime;
    procedure OnProcess(Sender: TObject);
    procedure OnStartCount(Sender: TObject);
    procedure OnEndCount(Sender: TObject);
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.btn1Click(Sender: TObject);
begin
  if dlgOpen1.Execute then begin
    StartTime := Now;

    th := TCountThread.Create(True);
    th.FileName := dlgOpen1.FileName;
    th.OnProgress := OnProcess;
    th.OnStartCount := OnStartCount;
    th.OnEndCount := OnEndCount;
    th.Resume;
  end;
end;

procedure TForm1.OnEndCount(Sender: TObject);
begin
  mmo1.Lines.Add(Format('个数：%d, 耗时：%fms,文件名：%s, 文件大小: %d', [TCountThread(Sender).SumBit, MilliSecondSpan(Now, StartTime), dlgOpen1.FileName, TCountThread(Sender).FileSize]));
end;

procedure TForm1.OnProcess(Sender: TObject);
begin
  pb1.Position := pb1.Position + 1;
end;

procedure TForm1.OnStartCount(Sender: TObject);
begin
  pb1.Max := TCountThread(Sender).BlockCount;
  pb1.Position := 0;
end;

end.