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

📄 bitmapindirectu.pas

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

interface

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

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

var
  Form1: TForm1;

implementation

{$R *.DFM}

{Note: This example works correctly only under a 256 color video driver}

procedure TForm1.Button1Click(Sender: TObject);
var
  TheBitmap: HBITMAP;                 // a handle to the new bitmap
  BitmapInfo: Windows.TBitmap;        // the bitmap information structure
  OffscreenDC: HDC;                   // a handle to a memory device context
  BitmapBits: array[0..4095] of byte; // holds the bitmap image
begin
  {initialize the bitmap image to the color in palette slot 5}
  FillMemory(@BitmapBits, 4096, 5);

  {define the new bitmap}
  BitmapInfo.bmType       := 0;
  BitmapInfo.bmWidth      := 64;
  BitmapInfo.bmHeight     := 64;
  BitmapInfo.bmWidthBytes := 64;
  BitmapInfo.bmPlanes     := 1;
  BitmapInfo.bmBitsPixel  := 8;           // 8 bits/pixel, a 256 color bitmap
  BitmapInfo.bmBits       := @BitmapBits;

  {create the bitmap based on the bitmap information}
  TheBitmap := CreateBitmapIndirect(BitmapInfo);

  {create a memory device context compatible with the screen}
  OffscreenDC := CreateCompatibleDC(0);

  {select the new bitmap and a stock pen into the memory device context}
  SelectObject(OffscreenDC, TheBitmap);
  SelectObject(OffscreenDC, GetStockObject(WHITE_PEN));

  {draw a single line on the bitmap}
  MoveToEx(OffscreenDC, 0, 0, nil);
  LineTo(OffscreenDC, 64, 64);

  {display the bitmap}
  BitBlt(PaintBox1.Canvas.Handle, (PaintBox1.Width div 2)-32,
         (PaintBox1.Height div 2)-32, 64, 64, OffscreenDC, 0, 0, SRCCOPY);

  {we are done with the memory device context and bitmap, so delete them}
  DeleteDC(OffscreenDC);
  DeleteObject(TheBitmap);
end;

end.

⌨️ 快捷键说明

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