求快速算法(200分)

  • 主题发起人 主题发起人 Another_eYes
  • 开始时间 开始时间
A

Another_eYes

Unregistered / Unconfirmed
GUEST, unregistred user!
对一个矩形区域内的各像素颜色值进行运算以生成新的像素值. (256色以上)
求最快的算法(不要两重循环每点赋值的算法,我现在就用这算法, 速度太慢).
注: 像素颜色计算公式:
每像素的
新颜色值红=添加颜色值红+(源颜色值红-添加颜色值红)*X%
新颜色值绿=添加颜色值绿+(源颜色值绿-添加颜色值绿)*X%
新颜色值蓝=添加颜色值蓝+(源颜色值蓝-添加颜色值蓝)*X%

另: 讨厌"请参见已答问题XXXX"之类的回答
 
以下程序在我的计算机中通过了,速度还可以.
要想再快把中间部分用汇编写一下:

TForm1 = class(TForm)
Button1: TButton;
procedure FormCreate(Sender: TObject);
procedure Button1Click(Sender: TObject);
procedure FormDestroy(Sender: TObject);
private
{ Private declarations }
B:TBitmap;
public
{ Public declarations }
end;

implementation
procedure TForm1.FormCreate(Sender: TObject);
begin
B :=TBitmap.Create; B.PixelFormat :=pf24Bit;
B.width :=300; B.Height :=300;
end;

procedure TForm1.Button1Click(Sender: TObject);
var x,y,i:integer;
P:PByteArray;
begin
i :=20;
for y := 0 to B.height -1 do
begin
P := B.ScanLine[y];
for x := 0 to B.width*3 -1 do
P[x] := 20+(P[x]-i) div 2;
end;
Canvas.draw(0,0,B);
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
B.free;
end;
end.
 
如何将该bitmap与屏幕区域相连?
另: 如何转换成256色(api方式)?
 
哈哈,给fuliang的程序动动手术:
procedure TForm1.Button1Click();
var x,y,i,j:integer;
P:PByteArray;
begin
i :=20; j :=B.width*3 -1;
//B.width是定值,在此处初始化可以省b.Height-1次乘法运算
for y := 0 to B.height -1 do
begin
P := B.ScanLine[y];
for x := 0 to j do
P[x] := 20+(P[x]-i) div 2;
end;
Canvas.draw(0,0,B);
end;

================
另外,使用ScanLine()的方法较老套了,一年前在DelphiChat站上讨论过,
好象会比用RGB()的方法快20倍左右。大家有没有新的算法呢?
 
var BB:TBitmap;
C:TCanvas;
begin
BB :=TBitmap.create;
BB.width :=300; BB.height :=300;
BB.canvas.handle :=GetDc(0);//canvas.handle;
// GetDc(0) 获得屏幕的区域,如果想获得本窗口区域用canvas.handle
canvas.draw(100,100,BB);
// 如果还要写回到窗口 用下面这三句
C :=TCanvas.create;
C.Handle :=GetDc(0);
C.Draw(100,100,BB);
BB.free;
end;

转换成256色用 B.PixelFormat :=pf8Bit
它跟api 效果一样,你要得到数据可以用scanline.
 
是否可把图象转换成256色, 然后修改palette达到相同效果?
如果可行, 求最优算法.
 
function ChangePalette(Palette:HPalette):HPalette;
var
PaletteSize: Integer;
LogPal: TMaxLogPalette;
P:PByteArray;
i:integer;
begin
if Palette = 0 then Exit;
PaletteSize := 0;
if GetObject(Palette, SizeOf(PaletteSize), @PaletteSize) = 0 then Exit;
if PaletteSize = 0 then Exit;
with LogPal do
begin
palVersion := $0300;
palNumEntries := PaletteSize;
GetPaletteEntries(Palette, 0, PaletteSize, palPalEntry);
P :=@palPalEntry[0];
for i:=0 to PaletteSize*4-1 do P :=P div 3 *2;
end;
result := CreatePalette(PLogPalette(@LogPal)^);
end;

有些图像不好使,速度不一定有上一个方法快.
在我的机器上,白背景是能成功的,你再试验试验.

Palette:HPalette;
begin
Palette :=ChangePalette(B.Palette);
B.Palette :=Palette;
// SelectPalette(B.Canvas.Handle,B.Palette,true);
// RealizePalette(B.Canvas.Handle);
Canvas.draw(0,0,B);
end;
 
多谢fuliang大侠.
网太慢, 另有相关问题可否私下请教您?
 
Hehe, if you are using a MMX CPU, :) ...
 
Hi ThirdEye,

"AdjustColor" function should do the job. Don't ask me how, I am still
working on it.
 
接受答案了.
 

Similar threads

S
回复
0
查看
3K
SUNSTONE的Delphi笔记
S
S
回复
0
查看
2K
SUNSTONE的Delphi笔记
S
D
回复
0
查看
2K
DelphiTeacher的专栏
D
I
回复
0
查看
600
import
I
I
回复
0
查看
631
import
I
后退
顶部