unit1.pas

DelphigrayBMP.rar Convert delphi bmps to grayscale fastly.

//
//丂丂 Delphi偵傛傞DIB憖嶌
//
//   1999/ 7/12  幊屗丂婸岝
//

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  ExtCtrls, Menus, ExtDlgs,clipbrd;

type
  TForm1 = class(TForm)
    MainMenu1: TMainMenu;
    File1: TMenuItem;
    Open1: TMenuItem;
    N1: TMenuItem;
    Exit1: TMenuItem;
    G1: TMenuItem;
    OpenPictureDialog1: TOpenPictureDialog;
    PaintBox1: TPaintBox;
    procedure FormCreate(Sender: TObject);
    procedure Open1Click(Sender: TObject);
    procedure G1Click(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure PaintBox1Paint(Sender: TObject);
  private
    bmp:TBitmap;
    procedure grayScale(sBmp:TBitmap);
  end;

var
  Form1: TForm1;

implementation

{$R *.DFM}

procedure TForm1.FormCreate(Sender: TObject);
begin

  bmp:=TBitmap.Create; // 價僢僩儅僢僾嶌惉
  bmp.HandleType:=bmDIB; // 價僢僩儅僢僾偺宍幃傪DIB偵愝掕
  bmp.PixelFormat:=pf32bit; // DIB偺宍幃傪俁俀價僢僩偵愝掕

end;

procedure TForm1.Open1Click(Sender: TObject); // 乽奐偔乿儊僯儏乕
var
  wBMP:TBitmap;
begin

  if OpenPictureDialog1.Execute then
  begin

    wBMP:=TBitmap.Create; // 嶌嬈梡價僢僩儅僢僾嶌惉
    wBMP.LoadFromFile(OpenPictureDialog1.FileName);

    bmp.Width:=wBMP.Width;
    bmp.Height:=wBMP.Height;
    bmp.Canvas.Draw(0,0,wBMP);

    wBMP.Free; // 嶌嬈梡價僢僩儅僢僾攋婞

    G1.Enabled:=True; // 乽敀崟壔乿儊僯儏乕桳岠

    Paintbox1.Width:=bmp.Width;
    PaintBox1.Height:=bmp.Height;

    PaintBox1.Repaint;

  end;

end;

procedure TForm1.G1Click(Sender: TObject); // 乽敀崟壔乿儊僯儏乕
begin

  grayScale(bmp);
  PaintBox1.Repaint;

end;

procedure TForm1.grayScale(sBmp:TBitmap); // DIB傪敀崟壔
var
  cl,i,j,r,g,b:Integer;
  p,pp,pp2:^Integer;
begin

  for i:=0 to sBmp.Height-1 do
  begin

    p:=sBmp.ScanLine[i]; // 價僢僩儅僢僾嵗昗(0,i)偺億僀儞僞

    for j:=0 to sBmp.Width-1 do
    begin

      pp:=ptr(Integer(p)+j*4); // (j,i)偺億僀儞僞
      cl:=pp^; // cl偵(j,i)偺抣傪俁俀價僢僩偱庢摼

      r:=cl and $ff; // RGB惉暘偵暘夝
      g:=cl and $ff00 shr 8;
      b:=cl and $ff0000 shr 16;

      cl:=Round(r*0.3+g*0.59+b*0.11); // 柧傞偝傪寁嶼

      pp^:=cl+cl shl 8+cl shl 16; // (j,i)偵柧傞偝傪彂偒栠偡

    end;

  end;

end;

procedure TForm1.PaintBox1Paint(Sender: TObject);
begin

  PaintBox1.Canvas.Draw(0,0,bmp);

end;

procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin

  bmp.Free; // 價僢僩儅僢僾僐儞億乕僱儞僩攋婞

end;

end.