求将一个tbitmap里的图片水平切割的代码(65分)

如题

65分

copyrect

to:
来自：白河愁, 时间：2008-7-5 10:58:49, ID：3906316
copyrect


我是用的CopyRect啊

unit CutBitmap;

interface

uses Windows,Graphics,Classes,Messages, SysUtils, Variants;

type
TSplitPic=class
private
FPic:TPicture;
FCount:Integer;
FPics:array of TBitmap;

procedure Setpic(const Value: TPicture);

procedure SetLen(ACount:Integer);
function GetBitMaps(index: Integer): TBitmap;
procedure SetBitMap(const Value: TBitmap);
protected
procedure SplitBitmap;
public
constructor Create(APic:TPicture;ACount:Integer=4); overload;
constructor Create(APath:String;ACount:Integer=4); overload;
destructor Destroy;override;

property Pics[index:Integer]:TBitmap read GetBitMaps ;
property Count:Integer read FCount write FCount;
property pic:TPicture read FPic write Setpic;
end;

TRGBArray = ARRAY[0..0] OF TRGBTriple;
pRGBArray = ^TRGBArray;

implementation

{ TSplitPic }

constructor TSplitPic.Create(APath: String; ACount: Integer);
begin
FPic:=TPicture.Create;
FCount:=ACount;
SetLen(ACount);
FPic.LoadFromFile(APath);
Assert(FPic.Bitmap.HandleAllocated,'Error: FPic.Bitmap.Handle NOT Allocate!');
SplitBitmap;
end;

constructor TSplitPic.Create(APic: TPicture; ACount: Integer);
begin
FPic:=TPicture.Create;
FPic.Assign(APic);
FCount:=ACount;
SetLen(ACount);
SplitBitmap;
end;

destructor TSplitPic.Destroy;
var
I:Integer;
begin
FPic.Free;
for I:=0 to Length(FPics)-1 do FPics.Free;
inherited;
end;

function TSplitPic.GetBitMaps(index: Integer): TBitmap;
begin
if index >FCount-1 then raise Exception.Create('Index out of bounds');
Result:=FPics[index];
end;


procedure TSplitPic.SetBitMap(const Value: TBitmap);
begin
FPic.Assign(Value);
end;

procedure TSplitPic.SetLen(ACount:Integer);
var
I:Integer;
begin
if Length(FPics)>0 then
for I:=0 to Length(FPics) do
if (Assigned(FPics)) and (FPics<>nil) then
FPics.Free;
SetLength(FPics,ACount);
for I:=0 to ACount-1 do
FPics:=TBitmap.create;
end;

procedure TSplitPic.Setpic(const Value: TPicture);
begin

end;

procedure TSplitPic.SplitBitmap;
var
Row: PRGBArray;
H,C:Integer;
R,dest,Src:TRect;
begin
FPic.Bitmap.Canvas.FillRect(R);
dest.Left:=0;
dest.Top:=0;
dest.Right:=r.Right div FCount;
dest.Bottom:=R.Bottom;
Src.Top:=0;
Src.Bottom:=r.Bottom;
for C:=0 to FCount-1 do
begin
Src.Left:=r.Right div FCount * (C);
Src.Right:=r.Right div FCount * (C+1);

FPics[C].Canvas.CopyRect(dest,FPic.Bitmap.Canvas,src);
Assert(FPics[C].Canvas.HandleAllocated,'Error: FPics[C].Canvas.Handle NOT Allocate!');
end;

end;

end.



//===========
procedure TForm1.Button1Click(Sender: TObject);
var
t:TSplitPic;
I:Integer;
begin
t:=TSplitPic.Create('F:/downloads/desktop/1/DesktopExpress/Skins/Button_next.bmp');
for I:=0 to 3 do
begin
t.Pics.SaveToFile(Format('C:/%D.bmp',));
end;
t.Free;
end;

为什么保存的图片什么都没有？

var
bmpFile: String;
bmpSource,bmpDest: TBitmap;
OPD: TOpenPictureDialog;
begin
OPD := TOpenPictureDialog.Create(Self);
if OPD.Execute then begin
bmpFile := OPD.FileName;
end else begin
bmpFile := '';
end;

if bmpFile<>'' then begin
bmpSource := TBitMap.Create;
bmpSource.PixelFormat := pf24bit;
bmpSource.LoadFromFile(bmpFile);

bmpDest := TBitmap.Create;
bmpDest.PixelFormat := pf24bit;
bmpDest.Width := bmpSource.Width div 2;
bmpDest.Height:= bmpSource.Height;

bmpDest.Canvas.CopyRect(Rect(0,0,bmpDest.Width,bmpDest.Height),bmpSource.Canvas
,Rect(0,0,bmpDest.Width,bmpDest.Height));

bmpDest.SaveToFile('D:/half.bmp');

bmpSource.Free;
bmpDest.Free;
end;

OPD.Free;
end;

procedure TForm1.Button1Click(Sender: TObject);
var
bmp: Tbitmap;
begin
bmp := Tbitmap.Create;
bmp.Height := 100; // 子图高
bmp.Width := image1.Height;

bmp.Canvas.CopyRect(Rect(0,0,bmp.Width,bmp.Height), image1.Canvas, Rect(0,0,bmp.Width,bmp.Height));
bmp.SaveToFile ('c:/1.bmp');

bmp.Canvas.CopyRect(Rect(0,0,bmp.Width,bmp.Height), image1.Canvas, Rect(0,bmp.Height,bmp.Width,bmp.Height+bmp.Height));
bmp.SaveToFile('c:/2.bmp');

bmp.Free;
end;

多人接受答案了。