delphi jpg文件合并器代码


好多的图片文件想合并成一个jpg文件,这个工具就是解决这个问题的。有源代码你自己可以根据需要修改。
unit Unit1;

interface

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, Buttons,jpeg, ExtDlgs, ComCtrls, StdCtrls, CheckLst;

type
TForm1 = class(TForm)
SpeedButton1: TSpeedButton;
SpeedButton2: TSpeedButton;
SpeedButton3: TSpeedButton;
OpenDialog1: TOpenDialog;
CheckListBox1: TCheckListBox;
SpeedButton4: TSpeedButton;
SpeedButton5: TSpeedButton;
SaveDialog1: TSaveDialog;
procedure SpeedButton1Click(Sender: TObject);
procedure SpeedButton3Click(Sender: TObject);
procedure SpeedButton2Click(Sender: TObject);
procedure SpeedButton4Click(Sender: TObject);

procedure SpeedButton5Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;

var
Form1: TForm1;

implementation

{$R *.dfm}
procedure MoveBy(moves:Integer); //moves为负表上多,为正表下移
var
id:integer;
begin
if Form1.checklistbox1.itemindex=-1 then exit; //检查有没有行被选取
id:=Form1.checklistbox1.itemindex;
if moves <0 then //上移
begin
if id+moves <0 then moves:=-id; //最上行
Form1.checklistbox1.items.move(id,id+moves);
Form1.checklistbox1.itemindex:=id+moves;
end
else
begin
if moves> 0 then //下移
if (id+moves)> (Form1.checklistbox1.count-1) then //最下行
begin
Form1.checklistbox1.itemindex:= Form1.checklistbox1.count-1;
end
else
begin
Form1.checklistbox1.items.move(id,id+moves);
Form1.checklistbox1.itemindex:=id+moves;
end;
end;
end;

procedure TForm1.SpeedButton1Click(Sender: TObject);
var
i,j:integer;
jp: TJPEGImage;
bmp_t, bmp: TBitmap;
sfile:string;
P : PByteArray;
x,y : Integer;

begin
if SaveDialog1.Execute then
begin
sfile:=SaveDialog1.FileName;
if not Form1.checklistbox1.Count>0 then exit;
jp := TJPEGImage.Create;
bmp := TBitmap.Create;
bmp.PixelFormat:=pf32bit;
bmp_t := TBitmap.Create;
bmp_t.PixelFormat:=pf24bit;
bmp.Width:=0;
bmp.Height:=0;
j:=0;
for i:=0 to CheckListBox1.Count-1 do
begin
if CheckListBox1.Checked then
begin
jp.LoadFromFile(CheckListBox1.Items.Strings);
if jp.Width>bmp.Width then bmp.Width := jp.Width;
bmp.Height := bmp.Height+jp.Height;
end;
end;

for i:=0 to CheckListBox1.Count-1 do
begin
if CheckListBox1.Checked then
begin

jp.LoadFromFile(CheckListBox1.Items.Strings);
bmp_t.Assign(jp);
bmp.Canvas.Draw(0, j, bmp_t);
j:=j+jp.Height;
end;
end;
jp.Assign(bmp);

jp.SaveToFile(sfile);

bmp.Free;
bmp_t.Free;
jp.Free;
end;
end;


procedure TForm1.SpeedButton3Click(Sender: TObject);
var
i:integer;
begin
if OpenDialog1.Execute then
CheckListBox1.Items:= OpenDialog1.Files;
for i:=0 to Form1.checklistbox1.count-1 do
CheckListBox1.Checked:=true;
end;

procedure TForm1.SpeedButton2Click(Sender: TObject);
begin
Application.Terminate;
end;

procedure TForm1.SpeedButton4Click(Sender: TObject);
var
i:integer;
begin
for i:=0 to Form1.checklistbox1.count-1 do

begin

moveby(-1);
break;
end;

end;

procedure TForm1.SpeedButton5Click(Sender: TObject);
var
i:integer;
begin
for i:=0 to Form1.checklistbox1.count-1 do

begin
moveby(1);
break;
end;

end;

end.

联系电话:
020-00000000
联系电话:
020-00000000
联系电话:
020-12345678