用Delphi实现图像放大镜

在一些常用的看图软件中都带有一个可以放大局部图像的功能 本实例就是为模仿这一功能开发的 向窗体上添加两个TImage组件 其中一个TImage组件的Name属性设置为Image 它充当原图片显示的载体 另一个TImage组件的Name属性设置为Image 它可以显示放大后的图像 添加组件后的窗体如图 所示[[The No Picture ]] 图 添加组件后的窗体 本例的核心是StretchBlt函数 利用StretchBlt函数实现局部图像放大 响应代码如下 procedure TForm Image MouseMove(Sender: TObjectShift: TShiftStateX Y: Integer)beginStretchBlt(Image Canvas Handle Image Width Image Height Image Canvas Handle X Y SRCCOPY)Image RefreshScreen Cursors[ ]:=LoadCursorFromFile( MAGNIFY CUR )Self Cursor:= end程序首先会调用StretchBlt函数 以鼠标当前位置作为中心点 以边长为 选中Image 组件上的局部图像 并放大此局部图像到Image 组件上 然后通过调用Image 组件的Refresh方法以刷新Image 组件的显示 最后设置鼠标指针为新的形状 程序代码如下 unit Unit interfaceusesWindows Messages SysUtils Variants Classes Graphics Controls Forms Dialogs ExtCtrls StdCtrlstypeTForm = class(TForm)Image : TImageImage : TImageprocedure Image MouseMove(Sender: TObjectShift: TShiftStateX Y: Integer)procedure FormMouseMove(Sender: TObjectShift: TShiftStateX Y: Integer)private{ Private declarations }public{ Public declarations }endvarForm : TForm implementation{$R * dfm}procedure TForm Image MouseMove(Sender:TObjectShift:TShiftStateX Y: Integer)beginStretchBlt(Image Canvas Handle Image Width Image Height Image Canvas Handle X Y SRCCOPY)Image RefreshScreen Cursors[ ]:=LoadCursorFromFile( MAGNIFY CUR )Self Cursor:= endprocedure TForm FormMouseMove(Sender: TObjectShift: TShiftStateX Y: Integer)beginScreen Cursors[ ]:=crDefaultSelf Cursor:= endend 保存文件 然后按F 键运行程序 程序运行结果如图 所示[[The No Picture ]] 图 程序运行结果 lishixinzhi/Article/program/Delphi/201311/8410

你的DC每次有没有销毁。

你可能重复了DC。

把代码贴上来看看。

Private Sub load_map(num As Long)

Dim l as long

Set PicBmp = LoadPicture(App.Path &"\map\" &CStr(num) &".map")

Dim bm As BITMAP

Dim hBitmap1 As Long, holdmap As Long

GetObject PicBmp.Handle, Len(bm), bm

w = bm.bmWidth

h = bm.bmHeight

hMemDc = CreateCompatibleDC(hdc)

SelectObject hMemDc, PicBmp.Handle

w1 = w * 8

h1 = h * 8

hMemDc1 = CreateCompatibleDC(hdc)

hBitmap1 = CreateCompatibleBitmap(hdc, w1, h1)

holdmap = SelectObject(hMemDc1, hBitmap1)

l = StretchBlt(hMemDc1, 0, 0, w1, h1, hMemDc, 0, 0, w, h, vbSrcCopy)

DeleteObject hBitmap1

If holdmap <>0 Then

DeleteObject holdmap

End If

DeleteDC hMemDc

DeleteDC hMemDc1

If l = 0 Then Msgbox "显示地图：" &map_num &"失败"

End Sub

VC 下 StretchBlt 的模式及失真问题

用一个CCD的相机，采集图像，然后在对话框的图片控件中显示。

现象：原本应该是黑白相机的灰度图像，显示出来的却是花花绿绿的彩色图像。

开始的时候

怀疑是采集的数据有问题，可是查看保存下来的bmp文件，却正常的很。可以确定是显示程序的

问题。问题是，基本上是按照sdk的sample逐行抄的，唯一的一点区别就是，sdk是在一个单

文档的view中显示，我的程序是在对话框的图片控件中显示，最有可能出错的就是

StretchDIBits(pDC->GetSafeHdc(),

rect.left,

rect.top,

rect.Width(), //显示窗口宽度

rect.Height(), //显示窗口高度

0,

0,

Width, //图像宽度

Height, //图像高度

m_pImageBuffer, //图像缓冲区

m_pBmpInfo,//BMP图像描述信息

DIB_RGB_COLORS,

SRCCOPY

)

认真地检查了所有的参数，没有发现异常。

跑到baidu和google上疯狂地搜，又重新建立了一个对话框工程，load一个图片来显示，问题

重现，偶然看到 http://hi.baidu.com/68400165/blog/item/fa2409c66ab7e2dbd000601a.html里面

提到StretchDIBits引起的失真问题，

遂增加pDC->SetStretchBltMode(HALFTONE)

问题解决！

附上网文：

　在 VC 中使用 StretchBlt 会碰到一些与点阵图大小缩放相关的一些问题。在扩展一个点阵图时，StretchBlt必须复制图素行或列。如果放大倍数不是原图的整数倍，那么此 *** 作会造成产生的图像有些失真。

如果目的矩形比来源矩形小，那么StretchBlt在缩小图像时就必须把两行（或列）或者多 行（或列）的图素合并到一行（或列）。完成此 *** 作有四种方法，它根据装置内容伸展模式属性来选择其中一种方法。您可使用 SetStretchBltMode 函数来修改这个属性。

SetStretchBltMode (hdc, iMode)

iMode 可取下列值：

BLACKONWHITE 或者 STRETCH_ANDSCANS（内定）：如果两个或多个图素得合并成一个图素，那么StretchBlt会对图素执行一个逻辑AND运算。这样的结果是只有全部的原始图素是白色时该图素才为白 色，其实际意义是黑色图素控制了白色图素。这适用于白背景中主要是黑色的单色点阵图。

WHITEONBLACK 或 STRETCH_ORSCANS：如果两个或多个图素得合并成一个图素，那么StretchBlt 执行逻辑OR运算。这样的结果是只有全部的原始图素都是黑色时才是黑色，也就是说由白色图 素决定颜色。这适用於黑色背景中主要是白色的单色点阵图。

COLORONCOLOR 或 STRETCH_DELETESCANS：StretchBlt 简单地消除图素行或列，而没有任何逻辑组合。这是通常是处理彩色点阵图的最佳方法。

HALFTONE 或 STRETCH_HALFTONE：Windows根据组合起来的来源颜色来计算目的的平均颜色。这将与半调调色盘联合使用，第十六章将展示这一程序。

利用StretchBlt缩小图片时有时会出现颜色失真。解决步骤如下：

1、先把目标DC (也就是 HDC hDestDC) ::SetStretchBltMode (hDestDC, HALFTONE)

2、调用一下 ::SetBrushOrgEx(hDestDC, 0, 0, NULL)

3、最后调用 CImage 的 StretchBlt

或者这样解决：

1。hbit = (HBITMAP)LoadImage( NULL,cBmpPath,IMAGE_BITMAP,0,0,LR_LOADFROMFILE)

if(hbit != NULL) {

Bitmap.Attach(hbit)

DCCompatible.CreateCompatibleDC(GetDC())

DCCompatible.SelectObject(&Bitmap)

Bitmap.GetObject(sizeof(bm),&bm)}

2。OnPaint()：

pDC->SetStretchBltMode(HALFTONE)

pDC->StretchBlt(MAP_LEFT,MAP_TOP,MAP_WIDTH,MAP_HEIGHT,

&DCCompatible,0,0,bm.bmWidth,bm.bmHeight,SRCCOPY)

---