Application/Delphi Lecture

이미지 프린트 하기

현이빈이 2008. 7. 24. 15:29
반응형
이번에 올리는 자료는 지난번 이미지 프린트에대한 소스를 조금 수정했습니다...
바뀐부분만 간단히 설명드리겠습니다.
우선 Parameter가 추가 되었습니다...
만일 아래와 같이 호출한다면

ImagePrint(30,      //용지에서 왼쪽의 기본 여백을 30mm로 한다는 것입니다.
          image1,  //요건 그냥 TImage Object입니다.
          50,      //이미지를 용지에 출력할때 용지상의 폭입니다.
                   //단위는 mm이구요..
          80,      //요건 길이 입니다.
          False);  //Stretching시 이미지 기준이면 True입니다.

별거 아니지만 고마움의 표시로 생각해 주세요....


procedure ImagePrint(tX: Integer;
                    Ti: TImage;
                    pX, pY: Integer;
                    Balances: Boolean);
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 := Ti.Canvas.Handle;
    {Create a compatible dc}
    MemDc := CreateCompatibleDc(Dc);
    {create a bitmap}
    MemBitmap := CreateCompatibleBitmap(Dc,
                                        Ti.Picture.Bitmap.Width,
                                      Ti.Picture.Bitmap.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, Ti.Picture.Bitmap.Width,
                        Ti.Picture.Bitmap.Height,
                        Dc,
                        Ti.Left, Ti.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 := 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 := Ti.Picture.Bitmap.Width;
    PBITMAPINFOHEADER(pDibHeader)^.biHeight := Ti.Picture.Bitmap.Height;
    PBITMAPINFOHEADER(pDibHeader)^.biCompression := BI_RGB;
    {find out how much memory for the bits}
    GetDIBits(dc, MemBitmap, 0, Ti.Picture.Bitmap.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, Ti.Picture.Bitmap.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 * sizeof(TPALETTEENTRY)));
    end;
    {Release the screen dc}
    ReleaseDc(0, Dc);
    {Delete the bitmap}
    DeleteObject(MemBitmap);
    Printer.BeginDoc;
    tX:=Round(((tX / 25.4)*GetDeviceCaps(Printer.Handle, LOGPIXELSX)));
    pX:=Round(((pX / 25.4)*GetDeviceCaps(Printer.Handle, LOGPIXELSX)));
    pY:=Round(((pY / 25.4)*GetDeviceCaps(Printer.Handle, LOGPIXELSY)));
    if pX < pY then
    begin
         ScaleX := pX;
         ScaleY := Ti.Picture.Bitmap.Height * (pY / Ti.Picture.Bitmap.Width);
    end else
    begin
         ScaleX := Ti.Picture.Bitmap.Width * (pY / Ti.Picture.Bitmap.Height);
         ScaleY := pY;
    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}
    if Balances then
      StretchDiBits(Printer.Canvas.Handle,
                    tX, fCurrentY,
                    Round(scaleX), Round(scaleY),
                    0, 0,
                    Ti.Picture.Bitmap.Width, Ti.Picture.Bitmap.Height,
                    pBits,
                    PBitmapInfo(pDibHeader)^,
                    DIB_RGB_COLORS,
                    SRCCOPY)
    else              
        StretchDiBits(Printer.Canvas.Handle,
                      tX, fCurrentY,
                      pX, pY,
                      0, 0,
                      Ti.Picture.Bitmap.Width, Ti.Picture.Bitmap.Height,
                      pBits,
                      PBitmapInfo(pDibHeader)^,
                      DIB_RGB_COLORS,
                      SRCCOPY);
    {Just incase you printer drver is a palette device}
    if isDcPalDevice then
    begin
         SelectPalette(Printer.Canvas.Handle, oldPal, false);
         DeleteObject(Pal);
    end;
    {Clean up allocated memory}
    GlobalUnlock(hBits);
    GlobalFree(hBits);
    GlobalUnlock(hDibHeader);
    GlobalFree(hDibHeader);
    Printer.EndDoc;
end;

반응형