ONLY USE COPIES OF YOUR IMAGES AND NOT ONES YOU VALUE
http://www.penguinbyte.com/apps/pbwebst ... ageTag.zip
Code: Select all
Structure Itag
Name.s
date.l
Author.s
Event.l
Location.s
Description.s
;Protect.l
;Password.s
EndStructure
Enumeration
#Window_0
EndEnumeration
;- Gadget Constants
;
Enumeration
#Image_0
#String_0
#String_1
#String_2
#String_3
#Editor_0
#Text_0
#Text_1
#Text_2
#Text_3
#Text_4
#Text_5
#Text_7
#CheckBox_0
#Combo_0
#Text_9
#Button_0
#Button_1
#Text_11
#Text_12
#date_0
EndEnumeration
Global Dim Event.s(15)
Event(0)="Sporting Event"
Event(1)="Family Gathering"
Event(2)="Birthday"
Event(3)="Pet"
Event(4)="Christmas"
Event(5)="Halloween"
Event(6)="Easter"
Event(7)="Religious"
Event(8)="Insurance"
Event(9)="Business"
Event(10)="Vacation"
Event(11)="Wedding"
Event(12)="Honeymoon"
Event(13)="School"
Event(14)="Other"
Global theimage.l, Filename$
UseJPEGImageDecoder()
UseJPEGImageEncoder()
;PNG
UsePNGImageEncoder()
UsePNGImageDecoder()
;TIFF/TGA decode
UseTIFFImageDecoder()
UseTGAImageDecoder()
UseWxCmmImageDecoder()
UseEC_IFFImageDecoder()
;WBMP
;UseEC_WBMPImageDecoder()
;UseEC_WBMPImageEncoder()
;UseEC_ILBMImageEncoder()
;UseEC_P1ImageEncoder()
;UseEC_P2ImageEncoder()
;PBM
;UseEC_PBMImageDecoder()
;UseEC_PBMImageEncoder()
;XBM
;UseEC_XBMImageDecoder()
;UseEC_XBMImageEncoder()
;XPM
;UseEC_XPMImageDecoder()
;UseEC_XPMImageEncoder()
;PGM
;UseEC_PGMImageDecoder()
;UseEC_PGMImageEncoder()
;PPM
UseEC_PPMImageDecoder()
UseEC_PPMImageEncoder()
Procedure LoadPictureFile(szFile.s)
;
; Loads
; BMP, GIF, JPG, WMF, EMF, ICO
;
hFile = CreateFile_(szFile, #GENERIC_READ, 0, #Null, #OPEN_EXISTING, 0, #Null)
If hFile
dwFileSize = GetFileSize_(hFile, #Null)
hGlobal = GlobalAlloc_(#GMEM_MOVEABLE, dwFileSize)
If hGlobal
pvData = GlobalLock_(hGlobal)
bRead = ReadFile_(hFile, pvData, dwFileSize, @dwBytesRead, #Null)
GlobalUnlock_(hGlobal)
If bRead
If CreateStreamOnHGlobal_(hGlobal, #True, @pstm.IStream) = #S_OK
If OleLoadPicture_(pstm, dwFileSize, #False,?IID_IPicture, @Bild.IPicture) = #S_OK
; Here we got the IPicture Object
Bild\get_Height(@height)
Bild\get_Width(@width)
hdc = GetDC_(GetDesktopWindow_())
ScreenPixels_X = GetDeviceCaps_(hdc,#LOGPIXELSX)
ScreenPixels_Y = GetDeviceCaps_(hdc,#LOGPIXELSY)
ReleaseDC_(GetDesktopWindow_(),hdc)
PicHeight = (height * ScreenPixels_X) / 2540
PicWidth = (width * ScreenPixels_Y) / 2540
Result = CreateImage(#PB_Any,PicWidth,PicHeight)
If Result
hdc = StartDrawing(ImageOutput(Result))
Bild\Render(hdc,0,PicHeight,PicWidth,-PicHeight,0,0,width,height,0)
StopDrawing()
EndIf
Bild\Release()
EndIf
pstm\Release()
EndIf
EndIf
EndIf
CloseHandle_(hFile)
EndIf
ProcedureReturn Result
DataSection
IID_IPicture:
Data.l $7BF80980
Data.w $BF32,$101A
Data.b $8B,$BB,$00,$AA,$00,$30,$0C,$AB
EndDataSection
EndProcedure
Procedure CreateImageTag(filename.s,*image.Itag)
If filename
SetIniKey("TagV1","Has","True",filename)
With *image
SetIniKey("Data","Name",\Name,filename)
SetIniKey("Data","Date",Str(\date),filename)
SetIniKey("Data","Author",\Author,filename)
SetIniKey("Data","Event",Str(\Event),filename)
SetIniKey("Data","Location",\Location,filename)
SetIniKey("Data","Description",\Description,filename)
EndWith
EndIf
EndProcedure
Procedure HasImageTag(filename.s)
If filename
If GetIniKey("TagV1","Has","",filename)="True"
ProcedureReturn #True
Else
ProcedureReturn #False
EndIf
EndIf
EndProcedure
Procedure ReadImageTag(filename.s,*image.Itag)
If filename And HasImageTag(filename)
With *image
\Name=GetIniKey("Data","Name","",filename)
\date=Val(GetIniKey("Data","Date","",filename))
\Author=GetIniKey("Data","Author","",filename)
\Event=Val(GetIniKey("Data","Event","",filename))
\Location=GetIniKey("Data","Location","",filename)
\Description=GetIniKey("Data","Description","",filename)
EndWith
EndIf
EndProcedure
Procedure image_scale(image.l,width,height)
IconSize=width
MemImgID = ImageID(image)
MemImgW = ImageWidth(image)
MemImgH = ImageHeight(image)
If MemImgH>MemImgW
MemImgMul.f = IconSize/MemImgH
MemImgW = Int(MemImgW*MemImgMul)
MemImgH = Int(MemImgH*MemImgMul)
MemImgX = Int((IconSize-MemImgW)/2)
MemImgY = 0
Else
MemImgMul = IconSize/MemImgW
MemImgW = Int(MemImgW*MemImgMul)
MemImgH = Int(MemImgH*MemImgMul)
MemImgX = 0
MemImgY = Int((IconSize-MemImgH)/2)
EndIf
tmpimage=CreateImage(#PB_Any, width,height)
StartDrawing(ImageOutput(tmpimage))
Box(0,0,IconSize,IconSize,RGB($FF,$FF,$FF))
DrawImage(MemImgID,0,0,MemImgW,MemImgH)
StopDrawing()
ProcedureReturn tmpimage
EndProcedure
Procedure Open_Window_0()
If OpenWindow(#Window_0, 348, 135, 677, 481, "Image Tagger", #PB_Window_SystemMenu | #PB_Window_TitleBar | #PB_Window_ScreenCentered )
If CreateGadgetList(WindowID(#Window_0))
ImageGadget(#Image_0, 10, 20, 400, 290, 0, #PB_Image_Border)
StringGadget(#String_0, 500, 30, 170, 20, "")
DateGadget(#date_0,500,60,170,20,"%mm/%dd/%yyyy")
StringGadget(#String_1, 500, 90, 170, 20, "")
StringGadget(#String_2, 500, 120, 170, 20, "")
StringGadget(#String_3, 500, 320, 170, 20, "")
EditorGadget(#Editor_0, 500, 150, 170, 130)
TextGadget(#Text_0, 430, 30, 60, 20, "Name")
TextGadget(#Text_1, 430, 60, 60, 20, "Date")
TextGadget(#Text_2, 430, 90, 60, 20, "Author")
TextGadget(#Text_3, 430, 120, 60, 20, "Location")
TextGadget(#Text_4, 430, 150, 60, 20, "Description")
TextGadget(#Text_5, 430, 290, 70, 20, "Protect")
TextGadget(#Text_7, 430, 320, 60, 20, "Password")
CheckBoxGadget(#CheckBox_0, 500, 290, 120, 20, "Protect?")
ComboBoxGadget(#Combo_0, 500, 350, 170, 120)
For a=0 To 14
AddGadgetItem(#Combo_0,a,Event(a))
Next
TextGadget(#Text_9, 430, 350, 60, 20, "Event")
ButtonGadget(#Button_0, 10, 370, 90, 30, "Open Image")
ButtonGadget(#Button_1, 530, 400, 100, 30, "Update Tag")
TextGadget(#Text_11, 10, 430, 80, 20, "Current Image:")
TextGadget(#Text_12, 10, 450, 410, 20, "", #PB_Text_Border)
SendMessage_(GadgetID(#Editor_0), #EM_SETTARGETDEVICE, #Null, 0)
EndIf
EndIf
EndProcedure
Open_Window_0()
;-Event Loop
Repeat
Select WaitWindowEvent()
Case #PB_Event_Gadget
Select EventGadget()
Case #Button_0
Pattern$="Supported Image Formats|*.jpg;*.bmp;*gif;*.tga;*.tif;*.emf,*.wmf;*.ico;*png"
Filename$=OpenFileRequester("Please choose file to save","",Pattern$,0)
If Filename$
Select LCase(GetExtensionPart(Filename$))
Case "bmp","jpg","tif","png","tga","ico"
theimage.l=LoadImage(#PB_Any,Filename$)
viewimage.l=image_scale(theimage,400, 290)
SetGadgetState(#Image_0,ImageID(viewimage))
SetGadgetText(#Text_12,Filename$)
Case "wmf","emf","gif"
theimage.l=LoadPictureFile(Filename$)
viewimage.l=image_scale(theimage,400, 290)
SetGadgetState(#Image_0,ImageID(viewimage))
SetGadgetText(#Text_12,Filename$)
EndSelect
If HasImageTag(Filename$)
anothertag.Itag
ReadImageTag(Filename$,anothertag.Itag)
With anothertag
SetGadgetText(#String_0,\Name)
SetGadgetState(#date_0,\date)
SetGadgetText(#String_1,\Author)
SetGadgetText(#String_2,\Location)
SetGadgetText(#Editor_0,\Description)
SetGadgetState(#Combo_0,\Event)
EndWith
Else
SetGadgetText(#String_0,"")
SetGadgetState(#date_0,Date())
SetGadgetText(#String_1,"")
SetGadgetText(#String_2,"")
SetGadgetText(#Editor_0,"")
SetGadgetState(#Combo_0,-1)
EndIf
EndIf
Case #Button_1
Debug GetGadgetState(#date_0)
If Filename$
mytag.Itag
With mytag
\Name=GetGadgetText(#String_0)
\date=GetGadgetState(#date_0)
\Author=GetGadgetText(#String_1)
\Location=GetGadgetText(#String_2)
\Description=GetGadgetText(#Editor_0)
\Event=GetGadgetState(#Combo_0)
EndWith
CreateImageTag(Filename$,mytag.Itag)
EndIf
EndSelect
Case #PB_Event_CloseWindow
Quit=1
EndSelect
Until Quit=1