送50分。如何把修改了RGB值的图象快速显示出来? (50分)

  • 主题发起人 billjohn1999
  • 开始时间
B

billjohn1999

Unregistered / Unconfirmed
GUEST, unregistred user!
我需要对一幅图象的部分像素进行修改,然后想把它快速显示出来,该如何做。
当然,我可以用Pixels,但显示得太慢了。

下面是我的程序:
procedure TForm1.Button1Click(Sender: TObject);
var
i,j:integer;
kl:longint;
rr,gg,bb:byte;
begin
for i:=0 to image1.width-1 do
for j:=0 to image1.height-1 do
begin
kl:=ColorToRGB(image1.Canvas.Pixels[i,j]); //取图像的RGB值
rr:=byte(kl);
gg:=byte(kl shr 8);
bb:=byte(kl shr 8);
if rr=255 then rr:=138; //对图像的RBG值进行修改
if gg=255 then gg:=88;
if bb=255 then bb:=98;
image2.Canvas.Pixels[i,j] := RGB(rr,gg,bb); //我用这个方法也可以,
//但显示得太慢了,请问有没有好的方法?
//不知道用scanline可不可以?该如何用?
//希望能给出代码,非常感谢!!!
end;
end;
 
试试这个,还可以优化一下,速度还凑或

unit Unit1;

interface

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, ExtCtrls, StdCtrls;

type
TForm1 = class(TForm)
Button1: TButton;
Image1: TImage;
Image2: TImage;
procedure Button1Click(Sender: TObject);
procedure FormCreate(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;

var
Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.Button1Click(Sender: TObject);
var
i, j: integer;
rr, gg, bb: byte;
p, p1: pbytearray;
bp, bp1: Tbitmap;
begin
bp := Tbitmap.Create;
bp1 := Tbitmap.Create;
bp1.Assign(image1.Picture.Bitmap);
bp1.PixelFormat := pf24bit;
bp.Width := image1.Picture.Bitmap.Width;
bp.Height := image1.Picture.Bitmap.Height;
bp.PixelFormat := pf24bit;
for j := 0 to image1.height - 1 do
begin
p := bp.ScanLine[j];
p1 := bp1.ScanLine[j];
for i := 0 to image1.width - 1 do
begin
rr := p1[3 * i + 2];
gg := p1[3 * i + 1];
bb := p1[3 * i];
if rr = 255 then
rr := 138;
if gg = 255 then
gg := 88;
if bb = 255 then
bb := 98;
p[3 * i + 2] := rr;
p[3 * i + 1] := gg;
p[3 * i] := bb;
end;
end;
image2.Picture.Bitmap.Assign(bp);
bp.Free;
bp1.Free;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
image2.Width := image1.Width;
image2.Height := image1.Height;
end;

end.

 
huazai, thank you very much.
谢谢。你的方法是快多了。不过能不能再帮我优化一下?我不会.
另外,当图像为3000*3000以上时,就会出现以下错误:
Project Project1.exe raised exception class EOutOfReources with
message '参数错误。'. Process stopped. Use Step or Run to continue.
然后image2的图象就出不来了。
我的图像有很多是大于3000*3000的啊,如何解决这个问题呢。

 
下面的代码或许对你有用,它可以读出图像的一部分进行显示.
如果使用Stream.Write还可以对图像的局部进行修改(用fmOpenWrite打开).
const
ClipLeft = 0; //裁剪区的左侧
ClipTop = 0; //裁剪区的上侧
ClipWidth = 100; //裁剪区的宽度
ClipHeight = 100; //裁剪区的高度
ByteCount = 3; //如果是24位色,则设3;32位设4;8位设1
var
FileHeader: TBitmapFileHeader;
InfoHeader: TBitmapInfoHeader;
Stream: TFileStream;
LocalBmp: TBitmap;
LineLen, i: Integer;
begin
Stream := TFileStream.Create(BitmapFileName,
fmOpenRead or fmShareDenyWrite);
LocalBmp := TBitmap.Create; //裁剪出来的位图
try
//读文件头
Stream.Read(FileHeader, SizeOf(TBitmapFileHeader));
Stream.Read(InfoHeader, SizeOf(TBitmapInfoHeader));

//初始化裁剪位图
LocalBmp.Width := ClipWidth;
LocalBmp.Height := ClipHeight;
LocalBmp.PixelFormat := pf24Bit;//适当设置

//读取位图信息
LineLen := (ByteCount * InfoHeader.biWidth + 3) shr 2 shl 2;
for i := ClipTop to ClipTop + ClipHeight - 1 do begin
Stream.Position := FileHeader.bfOffBits
+ LineLen * (InfoHeader.biHeight - 1 - i)
+ ByteCount * ClipLeft;
Stream.Read(LocalBmp.ScanLine[i - ClipTop]^, ClipWidth * ByteCount);
end;

//用一个Image显示出来
Image1.Picture.Bitmap.Assign(nil);
Image1.Picture.Bitmap.Assign(LocalBmp);
finally
LocalBmp.Free;
Stream.Free;
end;
end;
 
ok,谢谢你们的帮助!!!
 
顶部