"GFL SDK is a powerfull library for developers who would like to support graphics image formats easily. "
GFL SDK 是免费看图软件 xnview 提供的一个库,可以在其主页(www.xnview.com) 下载.
前段时间看见一些漂亮的图标,于是就想给le换换图标,做好了各个按钮的图标后需要将其横排着合并为一个图片,在往常我是用xnview来合并的,但这次是要合并为带alpha通道的png文件,xnview怎样都做不到,合并后alpha通道都消失了.于是寻找其他工具,结果是未找到,难道要用ps手动的拼起来,如果只做一次合并还好,以后修改后还要再拼,太麻烦了,对于我此等懒人,还是算了.于是寻思着,自己写一个吧.
png格式的我不懂,要看懂也麻烦,用现成的库吧,于是想到了这个xnview提供的 GFL SDK. 好了,废话少说,上代码
'
---------------------------------------------------------------------------------------
'
Procedure : SaveCombine
'
DateTime : 2007-5-8 21:05
'
Author : lingll
'
email : lingll_xl@163.com
'
Purpose : 生成合并文件,horizontal指定是按水平方向对齐排列还是垂直方向
'
---------------------------------------------------------------------------------------
'

Private
Function SaveCombine()
Function SaveCombine(sDestFile$, sSrcFiles() As String, horizontal As Boolean) As Boolean


Dim tBmp_bg As GFL_BITMAP, tPtBmp_bg&
Dim tBmp_src As GFL_BITMAP

Dim tClr As GFL_COLOR
Dim tsave As GFL_SAVE_PARAMS
Dim trc As GFL_RECT

Dim ub&, lb&, i&
Dim tW&, tH&, tCX&, tCY&

trc.x = 0: trc.y = 0

ub = UBound(sSrcFiles)
lb = LBound(sSrcFiles)




gflLibraryInit
gflEnableLZW True

Call MeasureCombinedImage(sSrcFiles, horizontal, tW, tH)

tPtBmp_bg = gflAllockBitmap(GFL_ARGB, tW, tH, 4, tClr)
extGetGflBitmapFromPtr tPtBmp_bg, tBmp_bg


If horizontal Then
For i = lb To ub
tBmp_src = GetGlfBmp(sSrcFiles(i))
trc.w = tBmp_src.Width
trc.h = tBmp_src.Height
Call gflBitbltEx(tBmp_src, trc, tBmp_bg, tCX, 0)
tCX = tCX + tBmp_src.Width
gflFreeBitmapData tBmp_src
Next i
Else
For i = lb To ub
tBmp_src = GetGlfBmp(sSrcFiles(i))
trc.w = tBmp_src.Width
trc.h = tBmp_src.Height
Call gflBitbltEx(tBmp_src, trc, tBmp_bg, 0, tCY)
tCY = tCY + tBmp_src.Height
gflFreeBitmapData tBmp_src
Next i
End If


gflGetDefaultSaveParams tsave

tsave.FormatIndex = gflGetFormatIndexByName("png")

gflSaveBitmap sDestFile, tBmp_bg, tsave

gflFreeBitmapData tBmp_bg


gflLibraryExit


End Function

'
---------------------------------------------------------------------------------------
'
Procedure : MeasureCombinedImage
'
DateTime : 2007-5-8 21:14
'
Author : lingll
'
email : lingll_xl@163.com
'
Purpose : 计算合并后的图象长宽要多少
'
---------------------------------------------------------------------------------------
'

Private
Function MeasureCombinedImage()
Function MeasureCombinedImage( _
sFiles() As String, horizontal As Boolean, cx&, cy&) As Long
Dim tInf As GFL_FILE_INFORMATION
Dim ub&, lb&, i&
ub = UBound(sFiles)
lb = LBound(sFiles)

If horizontal Then
For i = lb To ub
Call gflGetFileInformation(sFiles(i), -1, tInf)
If tInf.Height > cy Then cy = tInf.Height
cx = cx + tInf.Width
gflFreeFileInformation tInf
Next i
Else
For i = lb To ub
gflGetFileInformation sFiles(i), -1, tInf
If tInf.Width > cx Then cx = tInf.Width
cy = cy + tInf.Height
gflFreeFileInformation tInf
Next i
End If
End Function

'
---------------------------------------------------------------------------------------
'
Procedure : GetGlfBmp
'
DateTime : 2007-5-8 20:35
'
Author : lingll
'
email : lingll_xl@163.com
'
Purpose : 加载图象
'
---------------------------------------------------------------------------------------
'

Private
Function GetGlfBmp()
Function GetGlfBmp(sFile$) As GFL_BITMAP
Dim tBmp_src As GFL_BITMAP, tPtBmp_src&

Dim tLoad As GFL_LOAD_PARAMS
Dim GflInfo As GFL_FILE_INFORMATION


gflGetDefaultLoadParams tLoad
tLoad.ColorModel = GFL_ARGB

gflLoadBitmapAny sFile, tPtBmp_src, tLoad, ByVal 0

extGetGflBitmapFromPtr tPtBmp_src, tBmp_src

GetGlfBmp = tBmp_src
End Function
用法与例子,将程序目录下的01.png-16.png水平合并为 all.png
Dim
tfiles(
1
To
16
)
As
String
Dim
i
&
For
i
=
1
To
16
tfiles(i)
=
App.Path
&
"/
"
&
Format
(i,
"
0#
"
)
&
"
.png
"
Next
i
Call
SaveCombine(App.Path
&
"
all.png
"
, tfiles,
True
)
lingll
lingll_xl@163.com
http://blog.youkuaiyun.com/lingll/
2007-5-10