Konwersja Bitmapy na GrayScale pod WinAPI - przyśpieszenie kodu.

Cześć.

Mam taki kod pod Delphi. Ma on być docelowo tylko dla WinAPI. Ale dla szybkich testów jest sprawdzany pod VCL na formatce:

//..
var
  TestBitmapHandle : HBITMAP;
  POldMainFormProc : Pointer;

function BitmapToGrayScale(BitmapHandle : HBITMAP) : HBITMAP;
var
  DCMem : HDC;
  BM : BITMAP;
  I, J : integer;
  PixelColor : Longint;
  GrayShade, Red, Green, Blue : Byte;
begin
  DcMem := CreateCompatibleDC(0);
  Result := SelectObject(DCMem, BitmapHandle);
  GetObject(BitmapHandle, SizeOf(BM), @BM);
  for I := 0 to BM.bmWidth - 1 do
  begin
    for J := 0 to BM.bmHeight - 1 do
    begin
      PixelColor := ColorToRGB(GetPixel(DCMem, I, J));
      Red := PixelColor;
      Green := PixelColor shr 8;
      Blue := PixelColor shr 16;
      GrayShade := Round(0.3 * Red + 0.6 * Green + 0.1 * Blue);
      SetPixel(DCMem, I, J, RGB(GrayShade, GrayShade, GrayShade));
    end;
  end;
  Result := SelectObject(DCMem, Result);
  DeleteDC(DCMem);
end;

function MainFormWindowProc(Wnd : HWND; Msg : UINT; WParam : WParam; LParam : LParam) : LRESULT; stdcall;
var
  BM : BITMAP;
  DC, DCMem : HDC;
  HbmOld : HBITMAP;
  PS : TPaintStruct;
begin
  case Msg of
    WM_PAINT :
      begin
        DC := BeginPaint(Wnd, PS);
        DcMem := CreateCompatibleDC(DC);
        HbmOld := SelectObject(DCMem, BitmapToGrayScale(TestBitmapHandle));
        GetObject(TestBitmapHandle, SizeOf(BM), @BM);
        BitBlt(DC, 0, 0, bm.bmWidth, bm.bmHeight, DCMem, 0, 0, SRCCOPY);
        SelectObject(DCMem, HbmOld);
        DeleteDC(DCMem);
        EndPaint(Wnd, PS);
      end;
  end;
  Result := CallWindowProc(POldMainFormProc, Wnd, Msg, WParam, LParam);
end;

procedure TForm1.FormCreate(Sender : TObject);
begin
  TestBitmapHandle := LoadImage(GetModuleHandle(nil),
    'D:\test.bmp', IMAGE_BITMAP, 450, 250, LR_LOADFROMFILE);
  POldMainFormProc := Pointer(SetWindowLong(Self.Handle, GWL_WNDPROC, integer(@MainFormWindowProc)));
end;

//...

Proszę Was o przykłady modyfikacji kodu, w jaki sposób można przyśpieszyć całą operację grayscalowania. By nie czytac po pixelu i po pixelu nie zapisywac. Wiem o ScanLines pod VCL, ale nie ogarniam tego pod WinAPI niestety. I tutaj w Was nadzieja. Z góry dziekuję za pomoc.

Także przybywajcie @kAzek, @Azarien i każdy kto moze tutaj mi z tym pomóc :)

P.S.: Wyedytowałem treść poprzedniego posta w tym wątku, po raz kolejny.

http://msdn.microsoft.com/en-us/library/windows/desktop/dd144879%28v=vs.85%29.aspx

http://msdn.microsoft.com/en-us/library/windows/desktop/dd162973%28v=vs.85%29.aspx

Wielkie dzięki @Azarien. Dzięki kodowi znalezionemu na tej stronie: http://ksymeon.blogspot.com/2010/02/getdibits-vs-scanline-vs-pixels-in.html oraz Twojemu nakierowaniu poradziłem sobie. Takze poniżej - jakby ktoś potrzebował, elegancki i szybki kod do rysowania HBITMAP jako obrazka "GrayScale". Kod pisany pod Delphi 7 dołaczony ze wszystkimi potrzebnymi plikami. Jak też i exekiem do tego posta. Jak widać mimo dla łatwych testów pod VCL, całość nie korzysta w ogóle z modułu Graphics. Czyli mam to na czym mi zależało.

Jednocześnie mam nadzieję, że nie ma poniżej większych błędów i jakichś wycieków. Na pewno przy aplikacji w jednej instancji nie nastąpi wyciek chyba. Bo takie mi zdarzają się w pluginach dla Total Commandera dopiero, po odtworzeniu ponad 3500 modułów Protrackera. I jak @kAzek poprawia kod. To niby narzędzie do GDI nie pokazuje wycieków. A i tak nadal całośc do dzisiaj się pierdzieli, więc zarzuciłem tamten projekt w rozwoju. To tak btw. Najważniejsze, że to co poniżej działa, tak jak chcę. Jeszcze raz dziękuję za nakierowanie. Sporo też dał tamten art zagranicznego kodera. I oby można było ten wątek wygooglować sobie, jako dowód, że nie samym VCL/LCL człowiek żyje :) I można modzić pod WinAPI fajne rzeczy. Nie tylko w MASMie i nie tylko "generatorki Yeti" ;)

unit a_code_main;

interface

uses
  Windows, Messages, Classes, Controls, Forms;

type
  TMainForm = class(TForm)
    procedure FormCreate(Sender : TObject);
  private
  public
  end;

var
  MainForm : TMainForm;

implementation

{$R *.dfm}

var
  TestBitmapHandle : HBITMAP;
  POldMainFormProc : Pointer;

type
  TColor = -$7FFFFFFF - 1..$7FFFFFFF;

function ColorToRGB(Color : TColor) : Longint;
begin
  if Color < 0 then
  begin
    Result := GetSysColor(Color and $000000FF)
  end
  else
  begin
    Result := Color;
  end;
end;

function MainFormWindowProc(Wnd : HWND; Msg : UINT; WParam : WParam; LParam : LParam) : LRESULT; stdcall;
var
  BM : BITMAP;
  DC, DCMem : HDC;
  HbmOld : HBITMAP;
  PS : TPaintStruct;
begin
  case Msg of
    WM_PAINT :
      begin
        DC := BeginPaint(Wnd, PS);
        DcMem := CreateCompatibleDC(DC);
        HbmOld := SelectObject(DCMem, TestBitmapHandle);
        GetObject(TestBitmapHandle, SizeOf(BM), @BM);
        BitBlt(DC, 0, 0, bm.bmWidth, bm.bmHeight, DCMem, 0, 0, SRCCOPY);
        SelectObject(DCMem, HbmOld);
        DeleteDC(DCMem);
        EndPaint(Wnd, PS);
      end;
  end;
  Result := CallWindowProc(POldMainFormProc, Wnd, Msg, WParam, LParam);
end;

procedure GetDIBitsFromBitmap32(const BitmapHandle : HBITMAP; const AWidth, AHeight : integer; var P : Pointer);
var
  DCMem : HDC;
  BM : BITMAP;
  BI : TBitmapInfo;
  OldBmp : HBITMAP;
begin
  FillChar(bI, SizeOf(BI), 0);
  with BI.bmiHeader do
  begin
    biSize := SizeOf(BI.bmiHeader);
    biWidth := AWidth;
    biHeight := AHeight;
    biPlanes := 1;
    biBitCount := 32;
    biCompression := BI_RGB;
  end;
  DcMem := CreateCompatibleDC(0);
  OldBmp := SelectObject(DCMem, BitmapHandle);
  GetObject(BitmapHandle, SizeOf(BM), @BM);
  GetMem(p, AWidth * AHeight * 4);
  GetDIBits(DCMem, BitmapHandle, 0, BM.bmHeight, P, BI, DIB_RGB_COLORS);
  SelectObject(DCMem, OldBmp);
  DeleteDC(DCMem);
end;

procedure SetDIBitsToBitmap32(const BitmapHandle : HBITMAP; const AWidth, AHeight : integer; var P : Pointer);
var
  bi : TBitmapInfo;
  DCMem : HDC;
  BM : BITMAP;
  OldBmp : HBITMAP;
begin
  FillChar(BI, SizeOf(BI), 0);
  with BI.bmiHeader do
  begin
    biSize := SizeOf(BI.bmiHeader);
    biWidth := AWidth;
    biHeight := AHeight;
    biPlanes := 1;
    biBitCount := 32;
    biCompression := BI_RGB;
  end;
  DcMem := CreateCompatibleDC(0);
  OldBmp := SelectObject(DCMem, BitmapHandle);
  GetObject(BitmapHandle, SizeOf(BM), @BM);
  SetDIBits(DCMem, BitmapHandle, 0, AHeight, P, BI, DIB_RGB_COLORS);
  SelectObject(DCMem, OldBmp);
  DeleteDC(DCMem);
end;

procedure BitmapToGrayScale(BitmapHandle : HBITMAP);
var
  P : Pointer;
  BM : BITMAP;
  X, Y : integer;
  PixelColor : Longint;
  BufInt : PIntegerArray;
  GrayShade, Red, Green, Blue : Byte;
begin
  GetObject(BitmapHandle, SizeOf(BM), @BM);
  GetDIBitsFromBitmap32(TestBitmapHandle, BM.bmWidth, BM.bmHeight, P);
  BufInt := P;
  for Y := 0 to BM.bmHeight - 1 do
  begin
    for X := 0 to BM.bmWidth - 1 do
    begin
      PixelColor := ColorToRGB(BufInt[Y * BM.bmWidth + X]);
      Red := PixelColor;
      Green := PixelColor shr 8;
      Blue := PixelColor shr 16;
      GrayShade := Round(0.3 * Red + 0.6 * Green + 0.1 * Blue);
      bufInt[Y * BM.bmWidth + X] := RGB(GrayShade, GrayShade, GrayShade);
    end;
  end;
  SetDIBitsToBitmap32(TestBitmapHandle, BM.bmWidth, BM.bmHeight, P);
end;

procedure TMainForm.FormCreate(Sender : TObject);
var
  BM : BITMAP;
begin
  TestBitmapHandle := LoadImage(GetModuleHandle(nil), '.\test.bmp', IMAGE_BITMAP, 0, 0, LR_LOADFROMFILE);
  GetObject(TestBitmapHandle, SizeOf(BM), @BM);
  BitmapToGrayScale(TestBitmapHandle);
  ClientWidth := BM.bmWidth;
  ClientHeight := BM.bmHeight;
  POldMainFormProc := Pointer(SetWindowLong(Self.Handle, GWL_WNDPROC, integer(@MainFormWindowProc)));
end;

end.

http://graphics32.org/wiki/Main/Graphics32

@rebe_jojo: ale co ma link do rzeczy? Albo źle patrzę, ale są w opisie informacje o typach z modułu Graphics. A to mnie nie interesuje. Ponieważ chciałem czyste WinAPI. Gdyż docelowo będzie to użyte do przycisków będącymi staticami z własnym rysowaniem i naniesioną bitmapą na całą wielkość. A szukałem tego rozwiązania. Ponieważ wyszarzenie niektórych grafik gdy dany przycisk jest nieaktywny, wygląda po prostu tragicznie, nic nie widać. Stąd całe te kombinacje.

Ja tam bym pewnie użył Windows Imaging Component, choćby z tego powodu, że obsługuje różne formaty, nie tylko BMP...