请问！！关于图像处理(200分)

mojialin100 · 2003-01-04

我正在编写一个关于图形操作的程序，可以对图像进行一系列的操作，比如旋转，虑境得请哪位可以提供一个很好的例子！一个好的url下载地址也行啊！高分报答

xzh2000 · 2003-01-04

www.playicq.com
其实你用opengl或directx有封装有的东东

dangbochang · 2003-01-04

你的email是多少？我发个demo给你

huazai · 2003-01-04

高斯滤波：

procedure TMainForm.GaotemplateClick(Sender: TObject); var
bmp1, bmp2: Tbitmap;
p1, p2, p3, p4: pbytearray;
i, j: integer;
begin
self.DoubleBuffered := true;
bmp1 := Tbitmap.Create;
bmp2 := Tbitmap.Create;
bmp1.Assign(ChildForm.image1.Picture.Bitmap);
bmp1.PixelFormat := pf24bit;
bmp1.Width := ChildForm.image1.Picture.Graphic.Width;
bmp1.Height := ChildForm.image1.Picture.Graphic.Height;
bmp2.Assign(ChildForm.image1.Picture.Bitmap);
bmp2.PixelFormat := pf24bit;
for j := 1 to bmp1.Height - 2 do
begin
p1 := bmp1.ScanLine[j];
p2 := bmp2.ScanLine[j - 1];
p3 := bmp2.ScanLine[j];
p4 := bmp2.ScanLine[j + 1];
for i := 1 to bmp1.Width - 2 do
begin

p1[3 * i + 2] := (p2[3 * (i - 1) + 2] + 2 * p2[3 * i + 2] +
p2[3
* (i + 1)
+ 2] + 2 * p3[3 * (i - 1) + 2] + 4 * p3[3 * i + 2] + 2
*
p3[3
* (i + 1)
+
2] + p4[3 * (i - 1) + 2] + 2 * p4[3 * i + 2] + p4[3 *
(i +
1) + 2])
shr
4;
p1[3 * i + 1] := (p2[3 * (i - 1) + 1] + 2 * p2[3 * i + 1] +
p2[3
* (i + 1)
+ 1] + 2 * p3[3 * (i - 1) + 1] + 4 * p3[3 * i + 1] + 2
*
p3[3
* (i + 1)
+
1] + p4[3 * (i - 1) + 1] + 2 * p4[3 * i + 1] + p4[3 *
(i +
1) + 1])
shr
4;
p1[3 * i] := (p2[3 * (i - 1)] + 2 * p2[3 * i] + p2[3 * (i +
1)] +
2 * p3[3
* (i - 1)] + 4 * p3[3 * i] + 2 * p3[3 * (i + 1)] + p4[3 *
(i -
1)] + 2 *
p4[3 * i] + p4[3 * (i + 1)]) shr 4;

end;

end;
ChildForm.Image1.Picture.Bitmap.Assign(Bmp1);Bmp1.Free;
bmp2.Free;
end;
90度旋转：
（一个顺时针，一个逆时针，比一般的速度要快得多）

procedure Rotate270Degrees(Bitmap: TBitmap);
var
aStream: TMemorystream;
header: TBITMAPINFO;
dc: hDC;
P: ^THelpRGB;
x, y, b, h: Integer;
RowOut: pRGBArray;
begin
aStream := TMemoryStream.Create;
aStream.SetSize(Bitmap.Height * Bitmap.Width * 4);
with header.bmiHeader do
begin
biSize := SizeOf(TBITMAPINFOHEADER);
biWidth := Bitmap.Width;
biHeight := Bitmap.Height;
biPlanes := 1;
biBitCount := 32;
biCompression := 0;
biSizeimage := aStream.Size;
biXPelsPerMeter := 1;
biYPelsPerMeter := 1;
biClrUsed := 0;
biClrImportant := 0;
end;
dc := GetDC(0);
P := aStream.Memory;
//The GetDIBits function retrieves the bits of the specified bitmap
//and copies them into a buffer using the specified format.
GetDIBits(dc, Bitmap.Handle, 0, Bitmap.Height, P, header, dib_RGB_Colors);
releaseDC(0, DC);
b := bitmap.Height; {rotate}
h := bitmap.Width; {rotate}
bitmap.Width := b;
bitmap.height := h;
for y := 0 to (h - 1) do //the new bitmap
begin
rowOut := Bitmap.ScanLine[(h - 1) - y];
P := aStream.Memory; {reset pointer}
//now the pointer point to the leftdown cornor of the primary bimtap
inc(p, y); // move the point column direction
for x := (b - 1) downto 0 do //&Ecirc;×&Iuml;&Egrave;&raquo;&ntilde;&Egrave;&iexcl;&micro;&Atilde;&Ecirc;&Ccedil;&Ocirc;&shy;&Ecirc;&frac14;&Icirc;&raquo;&Iacute;&frac14;&micro;&Auml;×&oslash;&Iuml;&Acirc;&frac12;&Ccedil;&micro;&Auml;&Ecirc;&yacute;&frac34;&Yacute;
begin
rowout[x] := p^.rgb;
inc(p, h);
end;
end;
aStream.Free;
end;
{-----------------------------------------------------------------------------
Procedure: Rotate90Degrees ---- colockwise rotate
Author: Administrator
Date: 30-&Ecirc;&reg;&Ograve;&raquo;&Ocirc;&Acirc;-2002
Arguments: Bitmap: TBitmap
Result: None
-----------------------------------------------------------------------------}

procedure Rotate90Degrees(Bitmap: TBitmap);
var
aStream: TMemorystream;
header: TBITMAPINFO;
dc: hDC;
P: ^THelpRGB;
x, y, b, h: Integer;
RowOut: pRGBArray;
begin
aStream := TMemoryStream.Create;
aStream.SetSize(Bitmap.Height * Bitmap.Width * 4);
with header.bmiHeader do
begin
biSize := SizeOf(TBITMAPINFOHEADER);
biWidth := Bitmap.Width;
biHeight := Bitmap.Height;
biPlanes := 1;
biBitCount := 32;
biCompression := 0;
biSizeimage := aStream.Size;
biXPelsPerMeter := 1;
biYPelsPerMeter := 1;
biClrUsed := 0;
biClrImportant := 0;
end;
dc := GetDC(0);
P := aStream.Memory;
GetDIBits(dc, Bitmap.Handle, 0, Bitmap.Height, P, header, dib_RGB_Colors);
ReleaseDC(0, dc);
b := bitmap.Height; {rotate}
h := bitmap.Width; {rotate}
bitmap.Width := b;
bitmap.height := h;
for y := 0 to (h - 1) do
begin
rowOut := Bitmap.ScanLine[y];
P := aStream.Memory; {reset pointer}
inc(p, y);
for x := 0 to (b - 1) do
begin
rowout[x] := p^.rgb;
inc(p, h);
end;
end;
aStream.Free;
end;

huazai · 2003-01-04

CONST
MaxPixelCount = 32768;

TYPE
pRGBArray = ^TRGBArray; // Use SysUtils.pByteArray for 8-bit color
TRGBArray = ARRAY[0..MaxPixelCount-1] OF TRGBTriple;
THelpRGB = packed record
rgb: TRGBTriple;
dummy: byte;
end;

cjg325 · 2003-01-04

给我也发一个DEMO我要可以随意放大缩小和移动的功能！！

dangbochang · 2003-01-04

代码:

堆积效果


procedure TForm1.N33Click(Sender: TObject);
var
  newbmp: Tbitmap;
  i, j, bmpheight, bmpwidth: integer;
begin
  image1.Visible := true;
  form1.Repaint;
  newbmp := tbitmap.Create;
  newbmp.Width := Image1.Width;
  newbmp.Height := Image1.Height;
  bmpheight := Image1.Height;
  bmpwidth := Image1.Width;
  i := bmpheight;
  while i > 0 do
  begin
    for j := 10 to i do
    begin
      newbmp.Canvas.CopyRect(Rect(0, i - 20, bmpwidth, j),
        image1.Canvas,
        Rect(0, i - 20, bmpwidth, i));
      Canvas.Draw(395, 109, newbmp);
    end;
    i := i - 20;
  end;
  newbmp.free;
end;

//**********************

百叶窗水平效果
procedure TForm1.N21Click(Sender: TObject);
var
  newbmp: TBitmap;
  i, j, bmpheight, bmpwidth: integer;
  xgroup, xcount: integer;
begin
  image1.Visible := true;
  form1.Repaint;
  image1.Visible := true;
  form1.Repaint;
  newbmp := TBitmap.Create;
  newbmp.Width := image1.Width;
  newbmp.Height := image1.Height;
  bmpheight := image1.Height;
  bmpwidth := image1.Width;
  xgroup := 16;
  xcount := bmpheight div xgroup;
  for i := 0 to xcount do
    for j := 0 to xgroup do
    begin
      newbmp.Canvas.CopyRect(Rect(0, xcount * j + i - 1, bmpwidth, xcount * j + i),
        image1.Canvas,
        Rect(0, xcount * j + i - 1, bmpwidth, xcount * j + i));
      Canvas.Draw(395, 109, newbmp);
    end;
  newbmp.Free;
end;
//**********************

颜色翻转
procedure TForm1.N37Click(Sender: TObject);
begin
  image1.Visible := true;
  form1.Repaint;
  paintbox1.Refresh();
  hdc2 := paintbox1.Canvas.Handle;
  hdc1 := image1.Canvas.Handle;
  bitblt(hdc2, 0, 0, w, h, hdc1, 0, 0, notsrccopy);
end;

//**********************
浓雾效果
procedure TForm1.N36Click(Sender: TObject);
begin
  image1.Visible := true;
  form1.Repaint;
  paintbox1.Refresh();
  hdc2 := paintbox1.Canvas.Handle;
  hdc1 := image1.Canvas.Handle;
  bitblt(hdc2, 0, 0, w, h, hdc1, 0, 0, srcpaint);
end;


//**********************
流动效果
procedure TForm1.N34Click(Sender: TObject);
var
  newbmp1: Tbitmap;
  i1, j1, bmpheight1, bmpwidth1: integer;
begin
  image1.Visible := true;
  form1.Repaint;
  newbmp1 := tbitmap.Create;
  newbmp1.Width := Image1.Width;
  newbmp1.Height := Image1.Height;
  bmpheight1 := Image1.Height;
  bmpwidth1 := Image1.Width;
  for i1 := bmpheight1 downto 1 do
    for j1 := 1 to i1 do
    begin
      newbmp1.Canvas.CopyRect(rect(0, j1 - 1, bmpwidth1, j1), image1.canvas, rect(0, i1 - 1, bmpwidth1, i1));
      Canvas.Draw(395, 109, newbmp1);
    end;
  newbmp1.Free;
end;



[h1][/h1]

menxin · 2003-01-04

要做这么多操作最好的办法就是找一个现成的控件
pegasusimage 非常强大你去看看吧

huazai · 2003-01-04

类似的控件很多，效果很好，不过还是少用控件。有什么会有一些莫名其妙的问题，锻炼一下自己
编程能力

请问！！关于图像处理(200分)

mojialin100

Unregistered / Unconfirmed

xzh2000

Unregistered / Unconfirmed

dangbochang

Unregistered / Unconfirmed

huazai

Unregistered / Unconfirmed

huazai

Unregistered / Unconfirmed

cjg325

Unregistered / Unconfirmed

dangbochang

Unregistered / Unconfirmed

menxin

Unregistered / Unconfirmed

huazai

Unregistered / Unconfirmed

Similar threads