|
回复 1# 的帖子
具体代码如下:- Function JPG_DrawEllipseAndString(filename,str,leftlen,toplen,rightlen,bottomlen)
- '******************************
- ' Description: Add note to a picture at specific area
- ' Precondition: Install tool aspjpeg
- ' Input: filename---Picture path
- ' str--------String to write
- ' leftlen----left lenth to original point
- ' toplen-----top lenth to original point
- ' rightlen---right lenth to original point
- ' bottomlen-bottom lenth to original point
- ' Output: None
- ' Example: JPG_DrawEllipseAndString("C:\org.jpg","LantianWei",100,200,500,400)
- ' Tester: LantianWei
- ' Date: Dec 23, 2007
- '******************************
- Dim Jpeg,tmpleft,tmptop,tmpright,tmpbottom
- Set Jpeg=CreateObject("Persits.Jpeg")
- Jpeg.Open filename
- Jpeg.Canvas.Pen.Color=vbRed
- Jpeg.Canvas.Pen.Width=2
- Jpeg.Canvas.Brush.Solid=False '是否加粗
- Jpeg.Canvas.Ellipse leftlen,toplen,rightlen,bottomlen '画椭圆
-
- If leftlen>Jpeg.OriginalWidth/2 Then
- tmpleft=leftlen
- tmptop=toplen+(bottomlen-toplen)/2
- If toplen+(bottomlen-toplen)/2>Jpeg.OriginalHeight/2 Then
- tmpright=leftlen-100
- tmpbottom=toplen+(bottomlen-toplen)/2-100
- Else
- tmpright=leftlen-100
- tmpbottom=toplen+(bottomlen-toplen)/2+100
- End If
- Else
- tmpleft=rightlen
- tmptop=toplen+(bottomlen-toplen)/2
- If toplen+(bottomlen-toplen)/2>Jpeg.OriginalHeight/2 Then
- tmpright=rightlen+100
- tmpbottom=toplen+(bottomlen-toplen)/2-100
- Else
- tmpright=rightlen+100
- tmpbottom=toplen+(bottomlen-toplen)/2+100
- End If
- End If
-
- Jpeg.Canvas.DrawLine tmpleft,tmptop,tmpright,tmpbottom
- Jpeg.Canvas.Font.Color=vbRed '红颜色
- Jpeg.Canvas.Font.Bold=True '是否加粗
- Jpeg.Canvas.Print tmpright,tmpbottom,str
- Jpeg.Canvas.DrawBar 0,0,Jpeg.OriginalWidth,Jpeg.OriginalHeight
- Jpeg.Save filename
- Jpeg.Close
- Set Jpeg=Nothing
- End Function
复制代码 在此应该感谢一位朋友,kernzhang,原创是他,曾经他做了个框架方面的视频,而上面有一小部分代码在视频上出现了,再感谢另外一位朋友,是他很有心,硬是把那小段代码从视频上抄下来的。而我做的只是进行了修补,完善,呵呵。。。以上代码还是有不足的地方,有心的朋友可以进行完善,然后再分享给大家。
[ 本帖最后由 lantianwei 于 2009-7-20 12:45 编辑 ] |
|