이미지 프린트 하기

이번에 올리는 자료는 지난번 이미지 프린트에대한 소스를 조금 수정했습니다...
바뀐부분만 간단히 설명드리겠습니다.
우선 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;

Love and Happy and..

이미지 프린트 하기

티스토리툴바

이미지 프린트 하기

관련글

티스토리툴바