Code: Select all
Global oldWNDPROC,iwidth,iheight
UseTGAImageDecoder()
UseTIFFImageDecoder()
Structure ImageSizeType
Width.l
Height.l
EndStructure
Procedure ImageFileDimension(filename.s,*imagesize.ImageSizeType)
#ImageMinimumSize= 24
#ImageHeaderSize= 2048
#ImageHeaderGIF= $38464947; 'GIF8'
#ImageHeaderJPG= $E0FFD8FF; -
#ImageHeaderJP2= $0C000000; -
#ImageHeaderPNG= $474E5089; '‰PNG'
#ImageHeaderBMP= $4D42; 'BM'
#ImageHeaderTIF_LSB= $4949; 'II'
#ImageHeaderTIF_MSB= $4D4D; 'MM'
#ImageHeaderPCX= $0A; -
#ImageHeaderTGA= $01; -
Structure MemArray
StructureUnion
a.a[0]
w.w[0]
l.l[0]
EndStructureUnion
EndStructure
Protected *Buffer.MemArray
Protected *MemArray.MemArray
Protected BytesRead.i
Protected a.a,n.l,m
#ImageFile=666
*imagesize\width=#Null
*imagesize\height=#Null
If ReadFile(#ImageFile,FileName, #PB_File_NoBuffering)
*Buffer=AllocateMemory(#ImageHeaderSize,#PB_Memory_NoClear)
BytesRead=ReadData(#ImageFile,*Buffer,#ImageHeaderSize)
If BytesRead>=#ImageMinimumSize
Select *Buffer\l[0]&$FFFFFFFF
Case #ImageHeaderJPG
n=*Buffer\a[4]<< 8|*Buffer\a[5]+4
If n>20
FileSeek(0,n)
BytesRead=ReadData(#ImageFile,*Buffer,#ImageHeaderSize)
n=0
EndIf
*MemArray=*Buffer+n
While *MemArray-*Buffer+6<BytesRead
If *MemArray\a[0]=$FF
a=*MemArray\a[1]
If a=$c0 Or (a>>4=$C And a&3)
*imagesize\width=*MemArray\a[7]<<8|*MemArray\a[8]
*imagesize\height=*MemArray\a[5]<<8|*MemArray\a[6]
Break
EndIf
Else
Break
EndIf
*MemArray+*MemArray\a[2]<<8|*MemArray\a[3]+2
Wend
Case #ImageHeaderPNG
*imagesize\width=*Buffer\a[18]<<8|*Buffer\a[19]
*imagesize\height=*Buffer\a[22]<<8|*Buffer\a[23]
Case #ImageHeaderGIF
*imagesize\width=*Buffer\w[3]
*imagesize\height=*Buffer\w[4]
Case #ImageHeaderJP2
n=*Buffer\a[14]<<8|*Buffer\a[15]+35
If n<#ImageHeaderSize
*imagesize\width=*Buffer\a[n-1]<<8|*Buffer\a[n]
*imagesize\height=*Buffer\a[n-5]<<8|*Buffer\a[n-4]
EndIf
Default
Select *Buffer\w[0]&$FFFF
Case #ImageHeaderBMP
*imagesize\width=*Buffer\w[9]
n=*Buffer\w[11]&$FFFF
If n<0
n=-n
EndIf
*imagesize\height=n
EndSelect
EndSelect
EndIf
FreeMemory(*Buffer)
CloseFile(#ImageFile)
EndIf
iwidth = *imagesize\Width
iheight = *imagesize\Height
EndProcedure
Procedure WebGadgetWProc(hwnd, uMsg, wParam, lParam)
Protected count, sz, *m, file$
If uMsg = #WM_DROPFILES
count = DragQueryFile_(wParam, -1, 0, 0)
If count >= 1
sz = DragQueryFile_(wParam, 0, 0, 0)
If sz > 0
sz + 1
*m = AllocateMemory(sz * 4)
If *m
If DragQueryFile_(wParam, 0, *m, sz)
file$ = PeekS(*m)
If file$
ww= 100 :hh=100
ext$ = LCase(GetExtensionPart(file$))
Select ext$
Case "bmp","jpg","png","gif"
x.ImageSizeType
ImageFileDimension( file$,x)
scale.f = 0.2
Text$ = "<img style="+"position:absolute;left:50px;top:50px;"+" width="+Str(iwidth*scale)+" Height="+Str(iheight*scale)+" src=" + #DQUOTE$ + file$ + #DQUOTE$ + "></img>"
SetGadgetItemText(0, #PB_Web_HtmlCode, Text$)
Case "emf";,"wmf"
Text$ = "<img style="+"position:absolute;left:50px;top:50px;"+" width="+Str(ww)+" Height="+Str(hh)+" src=" + #DQUOTE$ + file$ + #DQUOTE$ + "></img>"
SetGadgetItemText(0, #PB_Web_HtmlCode, Text$)
Case "tif","tiff","tga"
LoadImage(0,file$)
file$ = GetTemporaryDirectory()+GetFilePart(file$)+".bmp"
SaveImage(0,file$)
FreeImage(0)
x.ImageSizeType
ImageFileDimension( file$,x)
scale.f = 0.2
Text$ = "<img style="+"position:absolute;left:50px;top:50px;"+" width="+Str(iwidth*scale)+" Height="+Str(iheight*scale)+" src=" + #DQUOTE$ + file$ + #DQUOTE$ + "></img>"
SetGadgetItemText(0, #PB_Web_HtmlCode, Text$)
Default
SetGadgetText(0, file$)
EndSelect
EndIf
EndIf
FreeMemory(*m)
EndIf
EndIf
EndIf
DragFinish_(wParam)
EndIf
ProcedureReturn CallWindowProc_(oldWNDPROC, hwnd, uMsg, wParam, lParam)
EndProcedure
Procedure sizeCB()
ResizeGadget(0,10,10,WindowWidth(0)-20,WindowHeight(0)-20)
EndProcedure
If OpenWindow(0, 0, 0, 600, 300, "WebGadget", #PB_Window_SystemMenu | #PB_Window_SizeGadget | #PB_Window_ScreenCentered)
hwnd = WebGadget(0, 10, 10, 580, 280, "")
DragAcceptFiles_(hwnd, 1)
oldWNDPROC = SetWindowLongPtr_(GadgetID(0), #GWLP_WNDPROC, @WebGadgetWProc())
BindEvent(#PB_Event_SizeWindow,@sizeCB())
Repeat
Select WaitWindowEvent()
Case #PB_Event_CloseWindow
Quit = 1
EndSelect
Until Quit = 1
EndIf