Code updated for 5.20+
Nice work!
But you've used an old version of the wmf-view-example:
Code: Select all
;Wmf-View (extended)
;Get size of Wmf-File (only Wmf2-portable <-which you can find in the end mostly, and Emf)
;Mischa Brandt
Structure sizeofwmf
w.l
h.l
EndStructure
Global WmfSize.sizeofwmf
Procedure LoadWmfImage(name.s)
If name<>""
WmfSize\w=-1:WmfSize\h=-1
hemf = GetEnhMetaFile_(name)
If hemf=0
hmf = GetMetaFile_(name)
If hmf=0
size=FileSize(name)-22
ReadFile(1,name)
FileSeek(1, 6)
l=ReadWord(1):t=ReadWord(1)
r=ReadWord(1):b=ReadWord(1)
WmfSize\w=r-l:WmfSize\h=b-t
FileSeek(1, 22)
*buffer=AllocateMemory(size)
ReadData(1, *buffer,size)
CloseFile(1)
Else
size = GetMetaFileBitsEx_(hmf,size,0)
*buffer=AllocateMemory(size)
GetMetaFileBitsEx_(hmf,size,*buffer)
EndIf
hemf = SetWinMetaFileBits_(size,*buffer,GetDC_(0),0)
FreeMemory(*buffer)
Else
ReadFile(1,name)
FileSeek(1, 8)
l=ReadLong(1):t=ReadLong(1)
r=ReadLong(1):b=ReadLong(1)
WmfSize\w=r-l+1:WmfSize\h=b-t+1
CloseFile(1)
EndIf
ProcedureReturn hemf
EndIf
EndProcedure
Procedure DrawWmfImage(hnd,sdc,x,y,b,h)
SetRect_(WmfRect.RECT,x,y,x+b-1,y+h-1)
PlayEnhMetaFile_(sdc,hnd,WmfRect)
EndProcedure
Procedure FreeWmfImage(hnd)
DeleteEnhMetaFile_(hnd)
EndProcedure
hwnd=OpenWindow(0, 100, 100, 400, 300,"Wmf-Test", #PB_Window_SystemMenu)
ButtonGadget(1, 100, 250, 200, 20, "Load Wmf")
Repeat
EventID = WaitWindowEvent()
If EventID = #PB_Event_Gadget
Select EventGadget()
Case 1
image=LoadWmfImage(OpenFileRequester("Open","","Metafile|*.wmf;*.emf",0))
MessageRequester("Size of Clipart","Width: "+Str(WmfSize\w)+Chr(13)+Chr(10)+"Height: "+Str(WmfSize\h),0)
DrawWmfImage(image,GetDC_(hwnd),100,25,200,200)
FreeWmfImage(image)
EndSelect
EndIf
Until EventID = #PB_Event_CloseWindow
This version can read size of image.
(..although windows occasionally another size calculates!?
)
And here is another little tip for playing with emf.
It's very easy to create emf images in memory, or as file:
(Don't know if this is interesting for you)
Code: Select all
Global TextObject1,TextObject2
Procedure CreateTextObject(text.s,font,color,align)
tdc=CreateEnhMetaFile_(0,0,0,0)
SelectObject_(tdc,font)
SetBkMode_(tdc,#TRANSPARENT)
SetTextColor_(tdc,color)
DrawText_(tdc,text,-1,rect.RECT,#DT_CALCRECT)
DrawText_(tdc,text,-1,rect.RECT,align)
emfhandle=CloseEnhMetaFile_(tdc)
ProcedureReturn emfhandle
EndProcedure
Procedure ReDrawText(emf,x,y,w,h,dc)
set.RECT\left=x:set\top=y:set\right=x+w-1:set\bottom=y+h-1
PlayEnhMetaFile_(dc,emf,set)
EndProcedure
Procedure ImageReCreate(w,h)
If w > 0 And h > 0
CreateImage(0,w,h)
dc=StartDrawing(ImageOutput(0))
Box(0,0,w,h,GetSysColor_(#COLOR_BTNFACE))
ReDrawText(TextObject1,0,0,w,h/2,dc)
ReDrawText(TextObject2,0,h/2,w,h/2,dc)
StopDrawing()
EndIf
EndProcedure
Procedure Callback(WindowID, Message, wParam, lParam)
Result = #PB_ProcessPureBasicEvents
If Message=#WM_SIZE
w = WindowWidth(0)
h = WindowHeight(0)
ImageReCreate(w,h)
SetGadgetState(0,ImageID(0))
ResizeGadget(0,-1,-1,w,h)
EndIf
ProcedureReturn Result
EndProcedure
hwnd=OpenWindow(0,0,0,400,300,"ScaleText",#PB_Window_SystemMenu|#PB_Window_ScreenCentered|#PB_Window_SizeGadget)
CreateImage(0,400,300)
font1=LoadFont(0,"Times New Roman",20)
font2=LoadFont(1,"Arial",20,#PB_Font_Italic|#PB_Font_Bold)
Restore text:Read.s Line.s:Repeat:text.s+Line+Chr(13)+Chr(10):Read.s Line:Until Line="End"
TextObject1=CreateTextObject(text.s,font1,RGB(0,0,160),#DT_CENTER)
TextObject2=CreateTextObject(text.s,font2,RGB(160,0,0),#DT_CENTER)
ImageReCreate(400,300)
ImageGadget(0,0,0,WindowWidth(0),WindowHeight(0), ImageID(0))
SetWindowCallback(@Callback())
Repeat:Until WaitWindowEvent()=#PB_Event_CloseWindow
DeleteEnhMetaFile_(TextObject1)
DeleteEnhMetaFile_(TextObject2)
End
DataSection
text:
Data.s "Scalable Text Demonstration"
Data.s "-------------------------------"
Data.s "This example shows a simple method"
Data.s "how text-blocks can be resized "
Data.s "with lossless quality."
Data.s "Regards,"
Data.s "Mischa"
Data.s " "
Data.s "Test it!"
Data.s "Scale the window"
Data.s "End"
EndDataSection
Regards,
Mischa
