⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 createdibitmapu.pas

📁 DelphiWin32核心API参考光盘内容.是学习书籍中的源码,便于学习.
💻 PAS
字号:
unit CreateDIBitmapU;

interface

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

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

var
  Form1: TForm1;

implementation

{$R *.DFM}

procedure TForm1.Button1Click(Sender: TObject);
var
  Dib: HBITMAP;           // holds a handle to a new device independent bitmap
  DDB: HBITMAP;           // holds a handle to a new device dependent bitmap
  DibInfo: PBitmapInfo;   // a pointer to a bitmap information structure
  BitsPtr: PByte;         // a pointer to the DIB bitmap bits
  ReferenceDC: HDC;       // holds a handle to a reference device context
  ScreenDC: HDC;          // holds a handle to a screen device context
  iCount: Integer;        // general loop counter

  SystemPalette: array[0..255] of TPaletteEntry;  // required for converting the
                                                  // system palette into a DIB
                                                  // compatible palette
begin
  {allocate memory for the DIB}
  GetMem(DibInfo, SizeOf(TBitmapInfo)+256*SizeOf(TRGBQuad));

  {initialize the DIB information}
  DibInfo^.bmiHeader.biWidth         := 64;     // create a 64 X 64 pixel DIB,
  DibInfo^.bmiHeader.biHeight        := -64;    // 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 iCount := 0 to 255 do
  begin
    DibInfo^.bmiColors[iCount].rgbBlue     := SystemPalette[iCount].peBlue;
    DibInfo^.bmiColors[iCount].rgbRed      := SystemPalette[iCount].peRed;
    DibInfo^.bmiColors[iCount].rgbGreen    := SystemPalette[iCount].peGreen;
    DibInfo^.bmiColors[iCount].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);

  {draw bands of color into the DIB}
  FillMemory(BitsPtr, 8*64, $03);
  FillMemory(Pointer(LongInt(BitsPtr)+8*64), 8*64, $05);
  FillMemory(Pointer(LongInt(BitsPtr)+2*(8*64)), 8*64, $03);
  FillMemory(Pointer(LongInt(BitsPtr)+3*(8*64)), 8*64, $05);
  FillMemory(Pointer(LongInt(BitsPtr)+4*(8*64)), 8*64, $03);
  FillMemory(Pointer(LongInt(BitsPtr)+5*(8*64)), 8*64, $05);
  FillMemory(Pointer(LongInt(BitsPtr)+6*(8*64)), 8*64, $03);
  FillMemory(Pointer(LongInt(BitsPtr)+7*(8*64)), 8*64, $05);

  {get a screen based DC which is used as a reference point
   when creating the device dependent bitmap}
  ScreenDC := GetDC(0);

  {create a device dependent bitmap from the DIB}
  DDB := CreateDIBitmap(ScreenDC, DibInfo^.bmiHeader, CBM_INIT, PChar(BitsPtr),
                        DibInfo^, DIB_RGB_COLORS);

  {delete the screen based device context}
  ReleaseDC(0, ScreenDC);

  {select the device dependent bitmap into the offscreen DC}
  SelectObject(ReferenceDC, DDB);

  {copy the device independent bitmap to the form}
  SetDIBitsToDevice(Form1.Canvas.Handle, 50, 5, 64, 64, 0, 0, 0, 64, BitsPtr,
                    DibInfo^, DIB_RGB_COLORS);

  {copy the device dependent bitmap to the form}
  BitBlt(Form1.Canvas.Handle, 166, 5, 64, 64, ReferenceDC, 0, 0, SRCCOPY);

  {we no longer need the bitmaps or the device context, so free everything}
  DeleteDC(ReferenceDC);
  DeleteObject(Dib);
  DeleteObject(DDB);
  FreeMem(DibInfo, SizeOf(TBitmapInfo)+256*SizeOf(TRGBQuad));
end;



end.

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -