setdibitsu.pas

DelphiWin32核心API参考光盘内容.是学习书籍中的源码,便于学习.

unit SetDIBitsU;

interface

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

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

var
  Form1: TForm1;

implementation

{$R *.DFM}

{This example will run properly only with a 256 color video driver.}

var
   Started: Boolean = FALSE;  // controls the overall loop


procedure TForm1.Button1Click(Sender: TObject);
var
   TheBitmap: HBitmap;     // a handle for a regular bitmap
   OffScreen: HDC;         // an offscreen device context
   Dib: HBITMAP;           // holds a handle to the device independent bitmap
   DibInfo: PBitmapInfo;   // a pointer to the bitmap information data structure
   BitsPtr: PByte;         // holds a pointer to the bitmap bits
   ReferenceDC: HDC;       // a handle to the reference device context
   Loop: Integer;          // a general loop counter

   SystemPalette: array[0..255] of TPaletteEntry; // required for converting the
                                                  // system palette into a DIB
                                                  // compatible palette
begin
   {toggle the loop control variable}
   Started := not Started;

   {change the button caption to reflect the new state}
   if Started then
     Button1.Caption := 'Stop'
   else
     Button1.Caption := 'Start';

   {create a 128 X 128 pixel bitmap}
   TheBitmap := CreateBitmap(128, 128, 1, 8, nil);

   {create an offscreen device context that is
    compatible with the screen}
   OffScreen := CreateCompatibleDC(0);

   {select the new bitmap into the offscreen device context}
   SelectObject(OffScreen, TheBitmap);

   {get the memory needed for the bitmap information data structure}
   GetMem(DibInfo, SizeOf(TBitmapInfo)+256*SizeOf(TRGBQuad));

   {initialize the bitmap information}
   DibInfo^.bmiHeader.biWidth         := 128;    // create a 128 X 128 pixel
   DibInfo^.bmiHeader.biHeight        := -128;   // oriented top-down
   DibInfo^.bmiHeader.biPlanes        := 1;
   DibInfo^.bmiHeader.biBitCount      := 8;      // 256 colors
   DibInfo^.bmiHeader.biCompression   := BI_RGB; // no compression
   DibInfo^.bmiHeader.biSizeImage     := 0;      // let Windows determine size
   DibInfo^.bmiHeader.biXPelsPerMeter := 0;
   DibInfo^.bmiHeader.biYPelsPerMeter := 0;
   DibInfo^.bmiHeader.biClrUsed       := 0;
   DibInfo^.bmiHeader.biClrImportant  := 0;
   DibInfo^.bmiHeader.biSize          := SizeOf(TBitmapInfoHeader);

   {retrieve the current system palette}
   GetSystemPaletteEntries(Form1.Canvas.Handle, 0, 256, SystemPalette);

   {the system palette is returned as an array of TPaletteEntry structures,
    which store the palette colors in the form of Red, Green, and Blue. however,
    the TBitmapInfo structure's bmiColors member takes an array of TRGBQuad
    structures, which store the palette colors in the form of Blue, Green, and
    Red.  therefore, we must translate the TPaletteEntry structures into the
    appropriate TRGBQuad structures to get the correct color entries.}
   for Loop := 0 to 255 do
   begin
     DibInfo^.bmiColors[Loop].rgbBlue     := SystemPalette[Loop].peBlue;
     DibInfo^.bmiColors[Loop].rgbRed      := SystemPalette[Loop].peRed;
     DibInfo^.bmiColors[Loop].rgbGreen    := SystemPalette[Loop].peGreen;
     DibInfo^.bmiColors[Loop].rgbReserved := 0;
   end;

   {create a memory based device context}
   ReferenceDC := CreateCompatibleDC(0);

   {create the dib based on the memory device context and the
    initialized bitmap information}
   Dib := CreateDIBSection(ReferenceDC, DibInfo^, DIB_RGB_COLORS,
                           Pointer(BitsPtr), 0, 0);

   {delete the reference device context}
   DeleteDC(ReferenceDC);

   {this loop continues until the button is pressed again}
   while Started do
   begin
     {fill the bitmap bit information with white}
     FillMemory(BitsPtr, 128*128, $FF);

     {set 10000 random pixels to black. this loop has been 'unrolled' somewhat
      for optimization}
     for Loop := 0 to 1000 do
     begin
        PByte(Longint(BitsPtr)+Random(128)*128+Random(128))^ := 0;
        PByte(Longint(BitsPtr)+Random(128)*128+Random(128))^ := 0;
        PByte(Longint(BitsPtr)+Random(128)*128+Random(128))^ := 0;
        PByte(Longint(BitsPtr)+Random(128)*128+Random(128))^ := 0;
        PByte(Longint(BitsPtr)+Random(128)*128+Random(128))^ := 0;
        PByte(Longint(BitsPtr)+Random(128)*128+Random(128))^ := 0;
        PByte(Longint(BitsPtr)+Random(128)*128+Random(128))^ := 0;
        PByte(Longint(BitsPtr)+Random(128)*128+Random(128))^ := 0;
        PByte(Longint(BitsPtr)+Random(128)*128+Random(128))^ := 0;
        PByte(Longint(BitsPtr)+Random(128)*128+Random(128))^ := 0;
        PByte(Longint(BitsPtr)+Random(128)*128+Random(128))^ := 0;
        PByte(Longint(BitsPtr)+Random(128)*128+Random(128))^ := 0;
     end;

     {copy the bit values from the DIB directly into the DDB bitmap}
     SetDIBits(Form1.Canvas.Handle, TheBitmap, 0, 128, BitsPtr, DibInfo^,
               DIB_RGB_COLORS);

     {copy the bitmap to the canvas of the form}
     BitBlt(Form1.Canvas.Handle, (Form1.Width div 2)-64, 8, 128, 128,
            Offscreen, 0, 0, SRCCOPY);

     {this is required for proper Windows operation}
     Application.ProcessMessages;
   end;

   {destroy the offscreen device context}
   DeleteDC(Offscreen);

   {free our bitmaps}
   DeleteObject(TheBitmap);
   DeleteObject(Dib);
   FreeMem(DibInfo, SizeOf(TBitmapInfo)+256*SizeOf(TRGBQuad));
end;

end.