几何变换
提示:这里可以添加技术概要
核心源码
type
THelpRGB = packed record
rgb: TRGBTriple;
dummy: byte;
end;
type
pRGBArray = ^TRGBArray;
TRGBArray = array[0…32767] of TRGBTriple;
type
TForm1 = class(TForm)
MainMenu1: TMainMenu;
N1: TMenuItem;
N2: TMenuItem;
Rotateangle: TMenuItem;
N4: TMenuItem;
twist: TMenuItem;
Wrap: TMenuItem;
N7: TMenuItem;
N8: TMenuItem;
N9: TMenuItem;
N10: TMenuItem;
N901: TMenuItem;
ZoomIn: TMenuItem;
ZoomOut: TMenuItem;
Tilt: TMenuItem;
N14: TMenuItem;
cut: TMenuItem;
method1: TMenuItem;
method2: TMenuItem;
method3: TMenuItem;
N19: TMenuItem;
N20: TMenuItem;
OpenPictureDialog1: TOpenPictureDialog;
SavePictureDialog1: TSavePictureDialog;
Image1: TImage;
StatusBar1: TStatusBar;
N3: TMenuItem;
ToolBar1: TToolBar;
ToolButton1: TToolButton;
ToolButton2: TToolButton;
ImageList1: TImageList;
procedure N19Click(Sender: TObject);
procedure N20Click(Sender: TObject);
procedure method1Click(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure method2Click(Sender: TObject);
procedure ZoomInClick(Sender: TObject);
procedure FormDestroy(Sender: TObject);
procedure ZoomOutClick(Sender: TObject);
procedure TiltClick(Sender: TObject);
procedure method3Click(Sender: TObject);
procedure N8Click(Sender: TObject);
procedure N9Click(Sender: TObject);
procedure WrapClick(Sender: TObject);
procedure twistClick(Sender: TObject);
procedure RotateangleClick(Sender: TObject);
procedure N3Click(Sender: TObject);
procedure cutClick(Sender: TObject);
procedure ToolButton1Click(Sender: TObject);
procedure ToolButton2Click(Sender: TObject);
procedure N14Click(Sender: TObject);
procedure N10Click(Sender: TObject);
private
procedure RotateMethod2(aBitmap: TBitmap);
procedure TiltBitmap(const InBitmap, OutBitmap: TBitmap;
const WidthTop, WidthBottom: integer);
procedure RotateMethod3(Bitmap: TBitmap);
procedure bmp_rotate(Srcbmp, DestBmp: Tbitmap; angle: extended);
procedure TwistPicture(var Bmp, Dst: TBitmap; Amount: integer);
procedure WaveWrap(XDIV, YDIV, RatioVal: Integer);
procedure LeftRightMirror(bitmap: TBitmap);
procedure ZoomInOut(bitmap: TBitmap; m, n: extended);
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
starttime, endtime: longint;
OriginalBmp: TBitmap;
implementation
{$R *.dfm}
procedure TForm1.N19Click(Sender: TObject);
begin
if OpenPictureDialog1.Execute then
image1.Picture.Bitmap.LoadFromFile(OpenPictureDialog1.FileName);
OriginalBmp.Assign(image1.Picture.Bitmap);
Image1.Top := self.Height div 2 -
Image1.Picture.Bitmap.Height div 2;
Image1.Left := self.Width div 2 -
Image1.Picture.Bitmap.Width div 2;
end;
procedure TForm1.RotateMethod2(aBitmap: TBitmap);
var
nIdx, nOfs,
x, y, i, nMultiplier: integer;
nMemWidth, nMemHeight, nMemSize, nScanLineSize: LongInt;
aScnLnBuffer: PChar;
aScanLine: PByteArray;
begin
//消耗时间
nMultiplier := 3;
nMemWidth := aBitmap.Height;
nMemHeight := aBitmap.Width;
//实际需要内存大小
nMemSize := nMemWidth * nMemHeight * nMultiplier;
//开辟内存
GetMem(aScnLnBuffer, nMemSize);
try
//Scanline的长度
nScanLineSize := aBitmap.Width * nMultiplier;
//为ScanLine分配内存
GetMem(aScanLine, nScanLineSize);
try
for y := 0 to aBitmap.Height - 1 do
begin
//进行数据块的移动
Move(aBitmap.ScanLine[y]^, aScanLine^, nScanLineSize);
for x := 0 to aBitmap.Width - 1 do
begin
nIdx := ((aBitmap.Width - 1) - x) * nMultiplier;
nOfs := (x * nMemWidth * nMultiplier) + (y * nMultiplier);
for i := 0 to nMultiplier - 1 do
Byte(aScnLnBuffer[nOfs + i]) := aScanLine[nIdx + i];
end;
end;
//宽和高交换开始,逆时针旋转
aBitmap.Height := nMemHeight;
aBitmap.Width := nMemWidth;
for y := 0 to nMemHeight - 1 do
begin
//数据移动
nOfs := y * nMemWidth * nMultiplier;
Move((@(aScnLnBuffer[nOfs]))^, aBitmap.ScanLine[y]^, nMemWidth *
nMultiplier);
end;
finally
//释放内存aScanLine
FreeMem(aScanLine, nScanLineSize);
end;
finally
//释放内存aScnLnBuffer
FreeMem(aScnLnBuffer, nMemSize);
end;
end;
procedure TForm1.N20Click(Sender: TObject);
begin
SavePictureDialog1.Filter := ‘.bmp|.bmp’;
if Self.SavePictureDialog1.Execute then
begin
Image1.Picture.Bitmap.SaveToFile(SavePictureDialog1.FileName + ‘.bmp’);
end;
end;
procedure TForm1.method1Click(Sender: TObject);
var
i, J: Integer;
BmpS, BmpD: TBitmap;
begin
//创建Tbitmap对象BmpS和BmpD