Q&A

  • 화면갭쳐후인쇄하는것인데요.98에서는잘되는데 2000에서 안돼요.. 아래소스포함
화면갭쳐후 인쇄한는것인데요..98에서는 갭쳐한 한화면이 잘나오거든요..
그런데.. 2000에서는 안돼요..
원인이 무엇인가요.. 알려주세요...
미치겠습니다..
꼭 답 부닥합니다.
procedure PrintBmp(const aCptn: string; aBmp: TBitmap);
var
  dc: HDC;
  isDcPalDevice : BOOL;
  MemDc :hdc;
  MemBitmap : hBitmap;
  OldMemBitmap : hBitmap;
  hDibHeader : THandle;
  pDibHeader : pointer;
  hBits : THandle;
  pBits : pointer;
  ScaleX, ScaleY: Double;
  pPal : PLOGPALETTE;
  pal, Oldpal: hPalette;
  i : integer;
begin
  if aBmp = nil then Exit;

  IsPrinting := True;
  Screen.Cursor := crHourGlass;
  try


    // Get the screen dc
    dc := GetDc(0);
    // Create a compatible dc
    MemDc := CreateCompatibleDc(dc);
    // create a bitmap
    MemBitmap := CreateCompatibleBitmap(Dc,
                                        aBmp.Width,
                                        aBmp.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,
           aBmp.Width, aBmp.Height,
           aBmp.Canvas.Handle,
           0, 0,
           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 := GlobalAlloc(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 := aBmp.Width;
    PBITMAPINFOHEADER(pDibHeader)^.biHeight := aBmp.Height;
    PBITMAPINFOHEADER(pDibHeader)^.biCompression := BI_RGB;

    // find out how much memory for the bits
    GetDIBits(dc,
              MemBitmap,
              0,
              aBmp.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,
              aBmp.Width,
              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 * sizeof(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 := aBmp.Height * (Printer.PageWidth / aBmp.Width);
    end else
    begin
     ScaleX := aBmp.Width * (Printer.PageHeight / aBmp.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;

    // draw caption and printed date/time
    Printer.Canvas.TextOut(0, 0, Format(GetStrPtr(STRNO_PRINTED),[DateTimeToStr(Now)]));
    Printer.Canvas.TextOut(0, 80, aCptn);

    // send the bits to the printer
    StretchDiBits(Printer.Canvas.Handle,
                  0, 160,
                  Round(scaleX), Round(scaleY),
                  0, 0,
                  aBmp.Width, aBmp.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;

  finally
    IsPrinting := False;
    Screen.Cursor := crDefault;
  end;
end;
0  COMMENTS