unit1.~pas

delphi图片批量压缩工具

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, IniFiles, ExtCtrls, jpeg, ExtDlgs, StrUtils, WinSkinData,
  Menus, FileCtrl;

type
  TForm1 = class(TForm)
    d1: TRadioButton;
    d2: TRadioButton;
    Edit1: TEdit;
    Label1: TLabel;
    Label2: TLabel;
    Edit2: TEdit;
    Label3: TLabel;
    Edit3: TEdit;
    Button2: TButton;
    Button3: TButton;
    Open: TOpenDialog;
    Edit4: TEdit;
    Button1: TButton;
    Label4: TLabel;
    Edit5: TEdit;
    zidong: TCheckBox;
    SkinData1: TSkinData;
    PopupMenu1: TPopupMenu;
    N1: TMenuItem;
    Button4: TButton;
    Button5: TButton;
    jpg: TImage;
    Timer1: TTimer;
    procedure Button2Click(Sender: TObject);
    procedure Button3Click(Sender: TObject);
    procedure Edit1KeyPress(Sender: TObject; var Key: Char);
    procedure Edit2KeyPress(Sender: TObject; var Key: Char);
    procedure Edit3KeyPress(Sender: TObject; var Key: Char);
    procedure Button1Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure N1Click(Sender: TObject);
    procedure Button4Click(Sender: TObject);
    procedure Button5Click(Sender: TObject);
  private
    { Private declarations }

  public
    { Public declarations }
  end;

var
  Form1: TForm1;
  myinifile: Tinifile;

implementation

{$R *.dfm}

function tpcl(src1, dst: string): Boolean;
var
  Bmp: TBitmap;
  jpeg: TJpegImage;
  kuan, gao, bili: double;
begin
  if (ExtractFileExt(src1) = '.JPG') or (ExtractFileExt(src1)
    = '.jpg') then
  begin
    jpeg := TJpegImage.Create;
    try
      jpeg.LoadFromFile(src1);
      kuan := jpeg.Width;
      gao := jpeg.Height;
      if form1.d2.Checked then
      begin
        if (kuan<= strtoint(form1.Edit3.Text)) and (gao<= strtoint(form1.Edit3.Text)) then
        exit;
      end;
      if kuan > gao then
        bili := StrToInt(Form1.Edit3.Text) / kuan
      else
        bili := StrToInt(Form1.Edit3.Text) / gao;
      Bmp := TBitmap.Create;
      try
        if Form1.d1.Checked then
        begin
          Bmp.Width := StrToInt(Form1.Edit1.Text);
          Bmp.Height := StrToInt(Form1.Edit2.Text);
        end
        else
        begin
          Bmp.Width := Round(kuan * bili);
          Bmp.Height := Round(gao * bili);
        end;
        Bmp.Canvas.StretchDraw(Rect(0, 0, Bmp.Width, Bmp.Height), jpeg);
        jpeg.Assign(Bmp);
      finally
      end;
      jpeg.SaveToFile(dst);
      Bmp.Free;
    finally
      Screen.Cursor := crDefault;
    end;
    jpeg.Free;
  end;

  if (ExtractFileExt(src1) = '.BMP') or (ExtractFileExt(src1) = '.bmp') then
  begin
    Bmp := TBitmap.Create;
    try
      Bmp.LoadFromFile(src1);
      kuan := Bmp.Width;
      gao := Bmp.Height;
      if form1.d2.Checked then
      begin
        if (kuan<= strtoint(form1.Edit3.Text)) and (gao<= strtoint(form1.Edit3.Text)) then
        exit;
      end;
      if kuan > gao then
        bili := StrToInt(Form1.Edit3.Text) / kuan
      else
        bili := StrToInt(Form1.Edit3.Text) / gao;
      try
        if Form1.d1.Checked then
        begin
          Bmp.Width := StrToInt(Form1.Edit1.Text);
          Bmp.Height := StrToInt(Form1.Edit2.Text);
        end
        else
        begin
          Bmp.Width := Round(kuan * bili);
          Bmp.Height := Round(gao * bili);
        end;
        Bmp.Canvas.StretchDraw(Rect(0, 0, Bmp.Width, Bmp.Height), Bmp);
        Bmp.Assign(Bmp);
      finally
        Bmp.SaveToFile(dst);
      end;
      Bmp.Free;
    finally
      Screen.Cursor := crDefault;
    end;
  end;
  result := true;
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
  Open.Filter := '图片|*.jpg;*.bmp';
  if not Open.execute then
    Exit
  else
  begin
    if zidong.Checked then
      tpcl(Open.FileName, Edit4.Text + Edit5.Text +
        ExtractFileName(Open.FileName))
    else
      tpcl(Open.FileName, Edit4.Text + ExtractFileName(Open.FileName));
    ShowMessage('压缩成功！');
  end;
end;

procedure TForm1.Button3Click(Sender: TObject);
var
  i: integer;
begin
  Open.Filter := '图片文件|*.jpg;*.bmp';
  Open.Options := [ofallowmultiselect, ofHideReadOnly, ofEnableSizing];
  if not Open.execute then
  begin
    Open.Options := [ofHideReadOnly, ofEnableSizing];
    Exit;
  end
  else
  begin
    for i := 0 to Open.Files.Count - 1 do
    begin
      if zidong.Checked then
        tpcl(Open.Files.Strings[i], Edit4.Text + Edit5.Text +
          ExtractFileName(Open.Files.Strings[i]))
      else
      begin
        application.ProcessMessages;
        tpcl(Open.Files.Strings[i], Edit4.Text + ExtractFileName(Open.Files.Strings[i]));
      end;
    end;
    Open.Options := [ofHideReadOnly, ofEnableSizing];
    showmessage('压缩成功');
  end;
end;

procedure TForm1.Edit1KeyPress(Sender: TObject; var Key: Char);
begin
  if not (Key in ['0'..'9']) then
  begin
    Key := #0;
  end;
end;

procedure TForm1.Edit2KeyPress(Sender: TObject; var Key: Char);
begin
  if not (Key in ['0'..'9']) then
  begin
    Key := #0;
  end;
end;

procedure TForm1.Edit3KeyPress(Sender: TObject; var Key: Char);
begin
  if not (Key in ['0'..'9']) then
  begin
    Key := #0;
  end;
end;

procedure TForm1.Button1Click(Sender: TObject);
var
  Str: string;
begin
  if not SelectDirectory('选择源目录', '', Str) then
    Exit
  else
  begin
    if AnsiEndsText('\', Str) then
      Edit4.Text := Str
    else
      Edit4.Text := Str + '\';
  end;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  myinifile := Tinifile.Create(ExtractFilePath(Application.ExeName) +
    '设置.ini');
  Edit1.Text := myinifile.ReadString('图片设置', '宽', '800');
  Edit2.Text := myinifile.ReadString('图片设置', '高', '600');
  Edit3.Text := myinifile.ReadString('图片设置', '长度', '800');
  Edit4.Text := myinifile.ReadString('软件设置', '保存目录',
    ExtractFilePath(Application.ExeName));
  Edit5.Text := myinifile.ReadString('软件设置', '加字', '少鹰_');
  d1.Checked := myinifile.ReadBool('软件设置', '指定尺寸', true);
  d2.Checked := myinifile.ReadBool('软件设置', '比例缩放', false);
  zidong.Checked := myinifile.ReadBool('软件设置', '自动命名', true);
  myinifile.Free;
end;

procedure TForm1.N1Click(Sender: TObject);
begin
  myinifile := Tinifile.Create(ExtractFilePath(Application.ExeName) +
    '设置.ini');
  myinifile.WriteString('图片设置', '宽', Edit1.Text);
  myinifile.WriteString('图片设置', '高', Edit2.Text);
  myinifile.WriteString('图片设置', '长度', Edit3.Text);
  myinifile.WriteString('软件设置', '保存目录', Edit4.Text);
  myinifile.WriteString('软件设置', '加字', Edit5.Text);
  myinifile.WriteBool('软件设置', '指定尺寸', d1.Checked);
  myinifile.WriteBool('软件设置', '比例缩放', d2.Checked);
  myinifile.WriteBool('软件设置', '自动命名', zidong.Checked);
  myinifile.Free;
end;

procedure TForm1.Button4Click(Sender: TObject);
begin
  Open.Filter := '图片|*.bmp';
  if not Open.execute then
    Exit
  else
  begin
    jpg.Picture.LoadFromFile(Open.FileName);
    if zidong.Checked then
      jpg.Picture.SaveToFile(Edit4.Text + Edit5.Text +
        ChangeFileExt(ExtractFileName(Open.FileName), '') + '.jpg')
    else
      jpg.Picture.SaveToFile(Edit4.Text +
        ChangeFileExt(ExtractFileName(Open.FileName), '') + '.jpg');
    ShowMessage('转换成功！');
  end;
end;

function plzh(P: pointer): Longint; stdcall;
var
  i: integer;
begin
  for i := 0 to Form1.Open.Files.Count - 1 do
  begin
    Form1.jpg.Picture.LoadFromFile(Form1.Open.Files.Strings[i]);
    if Form1.zidong.Checked then
      Form1.jpg.Picture.SaveToFile(Form1.Edit4.Text + Form1.Edit5.Text +
        ChangeFileExt(ExtractFileName(Form1.Open.Files.Strings[i]), '') + '.jpg')
    else
      Form1.jpg.Picture.SaveToFile(Form1.Edit4.Text +
        ChangeFileExt(ExtractFileName(Form1.Open.Files.Strings[i]), '') +
        '.jpg');
  end;
  Application.MessageBox('图片转换完毕！', '少鹰提示');
  Form1.Button5.Enabled := true;
end;

procedure TForm1.Button5Click(Sender: TObject);
var
  i: integer;
  hThread: Thandle; //定义一个句柄
  ThreadID: DWord;
begin
  Open.Filter := '图片文件|*.bmp';
  Open.Options := [ofallowmultiselect, ofHideReadOnly, ofEnableSizing];
  if not Open.execute then
  begin
    Open.Options := [ofHideReadOnly, ofEnableSizing];
    Exit;
  end
  else
  begin
    Button5.Enabled := false;
    hThread := CreateThread(nil, 0, @plzh, nil, 0, ThreadID);
    Open.Options := [ofHideReadOnly, ofEnableSizing];
  end;
end;

end.