一个关于设备无关位图的问题

Question

请问怎么获得 指向一个DIB的指针 和 指向DIB像素的指针谢谢最好来段例程

Answer 1

这个是HUBDOG的文章你看看吧..
Example:uses Printers;type
  PPalEntriesArray = ^TPalEntriesArray; {for palette re-construction}
  TPalEntriesArray = array[0..0] of TPaletteEntry;procedure BltTBitmapAsDib(DestDc : hdc;   {Handle of where to blt}
                          x : word;       {Bit at x}
                          y : word;       {Blt at y}
                          Width : word;   {Width to stretch}
                          Height : word;  {Height to stretch}
                          bm : TBitmap);  {the TBitmap to Blt}
var
  OriginalWidth :LongInt;               {width of BM}
  dc : hdc;                             {screen dc}
  IsPaletteDevice : bool;               {if the device uses palettes}
  IsDestPaletteDevice : bool;           {if the device uses palettes}
  BitmapInfoSize : integer;             {sizeof the bitmapinfoheader}
  lpBitmapInfo : PBitmapInfo;           {the bitmap info header}
  hBm : hBitmap;                        {handle to the bitmap}
  hPal : hPalette;                      {handle to the palette}
  OldPal : hPalette;                    {temp palette}
  hBits : THandle;                      {handle to the DIB bits}
  pBits : pointer;                      {pointer to the DIB bits}
  lPPalEntriesArray : PPalEntriesArray; {palette entry array}
  NumPalEntries : integer;              {number of palette entries}
  i : integer;                          {looping variable}
begin
{If range checking is on - lets turn it off for now}
{we will remember if range checking was on by defining}
{a define called CKRANGE if range checking is on.}
{We do this to access array members past the arrays}
{defined index range without causing a range check}
{error at runtime. To satisfy the compiler, we must}
{also access the indexes with a variable. ie: if we}
{have an array defined as a: array[0..0] of byte,}
{and an integer i, we can now access a[3] by setting}
{i := 3; and then accessing a[i] without error}
{$IFOPT R+}
  {$DEFINE CKRANGE}
  {$R-}
{$ENDIF} {Save the original width of the bitmap}
  OriginalWidth := bm.Width; {Get the screen's dc to use since memory dc's are not reliable}
  dc := GetDc(0);
 {Are we a palette device?}
  IsPaletteDevice :=
    GetDeviceCaps(dc, RASTERCAPS) and RC_PALETTE = RC_PALETTE;
 {Give back the screen dc}
  dc := ReleaseDc(0, dc); {Allocate the BitmapInfo structure}
  if IsPaletteDevice then
    BitmapInfoSize := sizeof(TBitmapInfo) + (sizeof(TRGBQUAD) * 255)
  else
    BitmapInfoSize := sizeof(TBitmapInfo);
  GetMem(lpBitmapInfo, BitmapInfoSize); {Zero out the BitmapInfo structure}
  FillChar(lpBitmapInfo^, BitmapInfoSize, #0); {Fill in the BitmapInfo structure}
  lpBitmapInfo^.bmiHeader.biSize := sizeof(TBitmapInfoHeader);
  lpBitmapInfo^.bmiHeader.biWidth := OriginalWidth;
  lpBitmapInfo^.bmiHeader.biHeight := bm.Height;
  lpBitmapInfo^.bmiHeader.biPlanes := 1;
  if IsPaletteDevice then
    lpBitmapInfo^.bmiHeader.biBitCount := 8
  else
    lpBitmapInfo^.bmiHeader.biBitCount := 24;
  lpBitmapInfo^.bmiHeader.biCompression := BI_RGB;
  lpBitmapInfo^.bmiHeader.biSizeImage :=
    ((lpBitmapInfo^.bmiHeader.biWidth *
      longint(lpBitmapInfo^.bmiHeader.biBitCount)) div 8) *
      lpBitmapInfo^.bmiHeader.biHeight;
  lpBitmapInfo^.bmiHeader.biXPelsPerMeter := 0;
  lpBitmapInfo^.bmiHeader.biYPelsPerMeter := 0;
  if IsPaletteDevice then begin
    lpBitmapInfo^.bmiHeader.biClrUsed := 256;
    lpBitmapInfo^.bmiHeader.biClrImportant := 256;
  end else begin
    lpBitmapInfo^.bmiHeader.biClrUsed := 0;
    lpBitmapInfo^.bmiHeader.biClrImportant := 0;
  end; {Take ownership of the bitmap handle and palette}
  hBm := bm.ReleaseHandle;
  hPal := bm.ReleasePalette; {Get the screen's dc to use since memory dc's are not reliable}
  dc := GetDc(0);  if IsPaletteDevice then begin
   {If we are using a palette, it must be}
   {selected into the dc during the conversion}
    OldPal := SelectPalette(dc, hPal, TRUE);
   {Realize the palette}
    RealizePalette(dc);
  end;
 {Tell GetDiBits to fill in the rest of the bitmap info structure}
  GetDiBits(dc,
            hBm,
            0,
            lpBitmapInfo^.bmiHeader.biHeight,
            nil,
            TBitmapInfo(lpBitmapInfo^),
            DIB_RGB_COLORS); {Allocate memory for the Bits}
  hBits := GlobalAlloc(GMEM_MOVEABLE,
                       lpBitmapInfo^.bmiHeader.biSizeImage);
  pBits := GlobalLock(hBits);
 {Get the bits}
  GetDiBits(dc,
            hBm,
            0,
            lpBitmapInfo^.bmiHeader.biHeight,
            pBits,
            TBitmapInfo(lpBitmapInfo^),
            DIB_RGB_COLORS);
  if IsPaletteDevice then begin
   {Lets fix up the color table for buggy video drivers}
    GetMem(lPPalEntriesArray, sizeof(TPaletteEntry) * 256);
   {$IFDEF VER100}
      NumPalEntries := GetPaletteEntries(hPal,
                                         0,
                                         256,
                                         lPPalEntriesArray^);
   {$ELSE}
      NumPalEntries := GetSystemPaletteEntries(dc,
                                               0,
                                               256,
                                               lPPalEntriesArray^);
   {$ENDIF}
    for i := 0 to (NumPalEntries - 1) do begin
      lpBitmapInfo^.bmiColors[i].rgbRed :=
        lPPalEntriesArray^[i].peRed;
      lpBitmapInfo^.bmiColors[i].rgbGreen :=
        lPPalEntriesArray^[i].peGreen;
      lpBitmapInfo^.bmiColors[i].rgbBlue :=
        lPPalEntriesArray^[i].peBlue;
    end;
    FreeMem(lPPalEntriesArray, sizeof(TPaletteEntry) * 256);
  end;  if IsPaletteDevice then begin
   {Select the old palette back in}
    SelectPalette(dc, OldPal, TRUE);
   {Realize the old palette}
    RealizePalette(dc);
  end; {Give back the screen dc}
  dc := ReleaseDc(0, dc); {Is the Dest dc a palette device?}
  IsDestPaletteDevice :=
    GetDeviceCaps(DestDc, RASTERCAPS) and RC_PALETTE = RC_PALETTE;
  if IsPaletteDevice then begin
   {If we are using a palette, it must be}
   {selected into the dc during the conversion}
    OldPal := SelectPalette(DestDc, hPal, TRUE);
   {Realize the palette}
    RealizePalette(DestDc);
  end; {Do the blt}
  StretchDiBits(DestDc,
                x,
                y,
                Width,
                Height,
                0,
                0,
                OriginalWidth,
                lpBitmapInfo^.bmiHeader.biHeight,
                pBits,
                lpBitmapInfo^,
                DIB_RGB_COLORS,
                SrcCopy);  if IsDestPaletteDevice then begin
   {Select the old palette back in}
    SelectPalette(DestDc, OldPal, TRUE);
   {Realize the old palette}
    RealizePalette(DestDc);
  end; {De-Allocate the Dib Bits}
  GlobalUnLock(hBits);
  GlobalFree(hBits); {De-Allocate the BitmapInfo}
  FreeMem(lpBitmapInfo, BitmapInfoSize); {Set the ownership of the bimap handles back to the bitmap}
  bm.Handle := hBm;
  bm.Palette := hPal;  {Turn range checking back on if it was on when we started}
{$IFDEF CKRANGE}
  {$UNDEF CKRANGE}
  {$R+}
{$ENDIF}
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
  if PrintDialog1.Execute then begin
    Printer.BeginDoc;
    BltTBitmapAsDib(Printer.Canvas.Handle,
                    0,
                    0,
                    Image1.Picture.Bitmap.Width,
                    Image1.Picture.Bitmap.Height,
                    Image1.Picture.Bitmap);
    Printer.EndDoc;
  end;
end;

Answer 2

这个也是..
　　有时我们要打印任意排列的表或往已经印好的登记表上对号入座写上数据时，可以新建一个窗体（假设为Form1），再把Form1的BorderStyle设为bsNone、AutoScroll设为True，接下来再创建一个新窗体（假设为Form2），再建个按钮Button1，编写代码：
procedure TForm2.Button1Click(Sender: TObject);
begin
Form1.Width :=900;
Form1.Height :=800;
Form1.Print;
end;
　　接下来你在Form1上对应的位置写上数据，运行后按Button1就会一五一十的打印下来了。
////////////////////////////////////
procedure TForm1.Button3Click(Sender: TObject);
  var
  dc: HDC;
  isDcPalDevice : BOOL;
  MemDc :hdc;
  MemBitmap : hBitmap;
  OldMemBitmap : hBitmap;
  hDibHeader : Thandle;
  pDibHeader : pointer;
  hBits : Thandle;
  pBits : pointer;
  ScaleX : Double;
  ScaleY : Double;
  ppal : PLOGPALETTE;
  pal : hPalette;
  Oldpal : hPalette;
  i : integer;begin
  {Get the screen dc}
  dc:=GetDc(0);  {Create a compatible dc}
  MemDc:=CreateCompatibleDc(dc);  {create a bitmap}
  MemBitmap:=CreateCompatibleBitmap(Dc,form1.width,form1.height);  {select the bitmap into the dc}
  OldMemBitmap:=SelectObject(MemDc, MemBitmap);  {Lets prepare to try a fixup for broken video drivers}
  isDcPalDevice:=false;
  if GetDeviceCaps(dc,RASTERCAPS) and RC_PALETTE=RC_PALETTE then
  begin
    GetMem(pPal,sizeof(TLOGPALETTE)+(255*sizeof(TPALETTEENTRY)));
    FillChar(pPal^,sizeof(TLOGPALETTE)+(255*sizeof(TPALETTEENTRY)),#0);
    pPal^.palVersion:= 300;
    pPal^.palNumEntries =GetSystemPaletteEntries(dc,0,256,pPal^.palPalEntry);
    if pPal^.PalNumEntries<>0 then
    begin
      pal:=CreatePalette(pPal^);
      oldPal:=SelectPalette(MemDc, Pal, false);
      isDcPalDevice:=true
    end
    else
      FreeMem(pPal,sizeof(TLOGPALETTE)+(255*Sizeof(TPALETTEENTRY)));
  end;  {copy from the screen to the memdc/bitmap}
  BitBlt(MemDc,0,0,form1.width,form1.height,Dc,form1.left,form1.top,SrcCopy);
  if isDcPalDevice=true then
  begin
    SelectPalette(MemDc,OldPal,false);
    DeleteObject(Pal);
  end;  {unselect the bitmap}
  SelectObject(MemDc,OldMemBitmap);  {delete the memory dc}
  DeleteDc(MemDc);  {Allocate memory for a DIB structure}
  hDibHeader:= lobalAlloc(GHND,sizeof(TBITMAPINFO)+(sizeof(TRGBQUAD)*256));  {get a pointer to the alloced memory}
  pDibHeader:=GlobalLock(hDibHeader);  {fill in the dib structure with info on the way we want the DIB}
  FillChar(pDibHeader^,sizeof(TBITMAPINFO)+ sizeof(TRGBQUAD)*256),#0);
  PBITMAPINFOHEADER(pDibHeader)^.biSize:=sizeof(TBITMAPINFOHEADER);
  PBITMAPINFOHEADER(pDibHeader)^.biPlanes:=1;
  PBITMAPINFOHEADER(pDibHeader)^.biBitCount:=8;
  PBITMAPINFOHEADER(pDibHeader)^.biWidth:=form1.width;
  PBITMAPINFOHEADER(pDibHeader)^.biHeight:=form1.height;
  PBITMAPINFOHEADER(pDibHeader)^.biCompression:=BI_RGB;  {find out how much memory for the bits}
  GetDIBits(dc,MemBitmap,0,form1.height,nil,TBitmapInfo(pDibHeader^),DIB_RGB_COLORS);  {Alloc memory for the bits}
  hBits:=GlobalAlloc(GHND,PBitmapInfoHeader(pDibHeader)^.BiSizeImage);  {Get a pointer to the bits}
  pBits:=GlobalLock(hBits);  {Call fn again, but this time give us the bits!}
  GetDIBits(dc,MemBitmap,0,form1.height,pBits,PBitmapInfo(pDibHeader)^,DIB_RGB_COLORS);  {Lets try a fixup for broken video drivers}
  if isDcPalDevice=true then
  begin
    for i:=0 to (pPal^.PalNumEntries-1) do
    begin
      PBitmapInfo(pDibHeader)^.bmiColors[i].rgbRed:=pPal^.palPalEntry[i].peRed;
      PBitmapInfo(pDibHeader)^.bmiColors[i].rgbGreen:=pPal^.palPalEntry[i].peGreen;
      PBitmapInfo(pDibHeader)^.bmiColors[i].rgbBlue:=pPal^.palPalEntry[i].peBlue;
    end;
    FreeMem(pPal,sizeof(TLOGPALETTE)+(255* izeof(TPALETTEENTRY)));
  end;  {Release the screen dc}
  ReleaseDc(0,dc);  {Delete the bitmap}
  DeleteObject(MemBitmap);  {Start print job}
  Printer.BeginDoc;  {Scale print size}
  if Printer.PageWidth<Printer.PageHeight then
  begin
   ScaleX:=Printer.PageWidth;
   ScaleY:=Form1.Height* Printer.PageWidth/Form1.Width);
  end
  else
  begin
   ScaleX:=Form1.Width*(Printer.PageHeight/Form1.Height);
   ScaleY:=Printer.PageHeight;
  end;  {Just incase the printer drver is a palette device}
  isDcPalDevice:=false;
  if GetDeviceCaps(Printer.Canvas.Handle,RASTERCAPS) and RC_PALETTE=RC_PALETTE then
  begin
   {Create palette from dib}
    GetMem(pPal,sizeof(TLOGPALETTE)+(255*Sizeof(TPALETTEENTRY)));
    FillChar(pPal^,sizeof(TLOGPALETTE)+(255*sizeof(TPALETTEENTRY)),#0);
    pPal^.palVersion:=$300;
    pPal^.palNumEntries:=256;
    for i:=0 to (pPal^.PalNumEntries-1) do
    begin
      pPal^.palPalEntry[i].peRed:=PBitmapInfo(pDibHeader)^.bmiColors[i].rgbRed;
      pPal^.palPalEntry[i].peGreen:=PBitmapInfo(pDibHeader)^.bmiColors[i].rgbGreen;
      pPal^.palPalEntry[i].peBlue:=PBitmapInfo(pDibHeader)^.bmiColors[i].rgbBlue;
    end;
    pal:=CreatePalette(pPal^);
    FreeMem(pPal,sizeof(TLOGPALETTE)+(255*sizeof(TPALETTEENTRY)));
    oldPal:=SelectPalette(Printer.Canvas.Handle,Pal,false);
    isDcPalDevice:=true
  end;  {send the bits to the printer}
  StretchDiBits(Printer.Canvas.Handle,
                0, 0,
                Round(scaleX), Round(scaleY),
                0, 0,
                Form1.Width, Form1.Height,
                pBits,
                PBitmapInfo(pDibHeader)^,
                DIB_RGB_COLORS,
                SRCCOPY);  {Just incase you printer drver is a palette device}
  if isDcPalDevice = true then
  begin
    SelectPalette(Printer.Canvas.Handle, oldPal, false);
    DeleteObject(Pal);
  end;  {Clean up allocated memory}
  GlobalUnlock(hBits);
  GlobalFree(hBits);
  GlobalUnlock(hDibHeader);
  GlobalFree(hDibHeader);  {End the print job}
  Printer.EndDoc;
end;

Answer 3

这些都是Delphi之未经证实的葵花宝典上面的..
自已参考下下...