德尔福改变GrayScale Weight的动态值

时间:2016-12-20 20:13:43

标签: image delphi colors bitmap

我认识德尔福近一个月,

我找到了一个功能代码,通过改变颜色权重来改变灰度的颜色,我想问一下,有没有比这段代码更快的方法来改变颜色或加权颜色?

        function tform1.changecolorweighting(coloredbmp:tbitmap):tbitmap;
    Var
    X, Y: Integer;
    P   : TColor;
    r,g,b: byte;
    RP,GP,BP:single;
        changegray:tbitmap;
    changecolor:tbitmap;
    begin
    x:=RedWeight.value+GreenWeight.value+BlueWeight.value;
    RP:=RedWeight.value/x;
    GP:=Greenweight.value/x;
    BP:=BlueWeight.value/x;
    changegray := tbitmap.Create;
    changegray.Width := coloredbmp.Width;
    changegray.Height := coloredbmp.Height;
    changecolor.Assign(coloredbmp);
    For X := 0 to changecolor.Width do
    begin
    For y := 0 to changecolor.Height do
    begin
    P := changecolor.Canvas.Pixels[X, Y];
    r := (P and $00000FF);
    g := (P and $00FF00) shr 8;
    b := (P and $FF0000) shr 16;
    changegray.Canvas.Pixels[X, Y] :=  round(r * RP + g * GP + b*BP) * $010101;
    end;
    end;
    result := changegray;
    end;

如果您有某人更快地更改颜色权重,请更正我在互联网上找到的代码,或者如果您有比该代码更快的内容,请提供帮助。

上面的代码,在使用颜色权重应用灰度之前需要1秒。

谢谢

1 个答案:

答案 0 :(得分:0)

这是我正在寻找的答案,来自Embarcadero: https://community.embarcadero.com/blogs/entry/converting-to-grayscale-with-tbitmapscanline-property-39051

    procedure ToGray(aBitmap: Graphics.TBitmap; redweightvalue,greenweightvalue,blueweightvalue:integer);
    var w, h: integer; CurrRow, OffSet: integer;
    x: byte; pRed, pGreen, pBlue: PByte;
    function RGBToGray(R, G, B: byte): byte;
    var x:integer;
    RP,GP,BP:single;
    begin
    x:=redweightvalue+greenweightvalue+blueweightvalue;
    RP:=redweightvalue/x;
    GP:=greenweightvalue/x;
    BP:=blueweightvalue/x;
    //Result := round(0.2989*R + 0.5870*G + 0.1141*B); // coeffs from Matlab
    Result := round(rp*R + gp*G + bp*B);
    end;
    begin
    if aBitmap.PixelFormat <> pf24bit then exit;
    CurrRow := Integer(aBitmap.ScanLine[0]);
    OffSet := Integer(aBitmap.ScanLine[1]) - CurrRow;
    for h := 0 to aBitmap.Height - 1 do
    begin
    for w := 0 to aBitmap.Width - 1 do
    begin
    pBlue  := pByte(CurrRow + w*3);
    pGreen := pByte(CurrRow + w*3 + 1);
    pRed   := pByte(CurrRow + w*3 + 2);
    x := RGBToGray(pRed^, pGreen^, pBlue^);
    pBlue^  := x;
    pGreen^ := x;
    pRed^   := x;
    end;
    inc(CurrRow, OffSet);
    end;
    end;