Перетащить изображение на окно...
Code
;**************************************************************
; Program: PicPak
; Author: netmaestro
; Date: April 15, 2006
; Target OS: Microsoft Windows All
; Target Compiler: PureBasic 4.xx
; License: Free, unrestricted, credit appreciated
; but not required
;**************************************************************
Declare CreateDataSection(picin.s)
Procedure.s GetDroppedFile()
buf.s=Space(DragQueryFile_(EventwParam(),0,0,0))
DragQueryFile_(EventwParam(), 0, buf, Len(buf)+1)
DragFinish_(EventwParam())
ProcedureReturn buf
EndProcedure
line$=Chr(10)
line$+ " Written in PureBasic by netmaestro, April 2006"+Chr(10)+Chr(10)
line$+ " 100% free to use, distribute, reverse-engineer,"+Chr(10)
line$+ " repackage and say you wrote it, anything you want"+Chr(10)
line$+ " to do with it is A-OK with me"+Chr(10)
use$=""+Chr(10)
use$ + Space(3) + "1. Перетащите сюда файл изображения."+Chr(13)+Chr(10)+Chr(10)
use$ + Space(3) + "2. Введите метку (несколько букв)"+Chr(13)+Chr(10)+Chr(10)
use$ + Space(3) + "3. Получите Temp.pbi "+Chr(13)+Chr(10)+Chr(10)
use$ + Space(3) + "4. #image img0 готов к использованию!"+Chr(13)+Chr(10)+Chr(10)
CreateImage(0, 512,512,32)
StartDrawing(ImageOutput(0))
Box(0,0,512,512,GetSysColor_(#COLOR_BTNFACE))
Circle(256,256,256,#Red)
Circle(256,256,200,#White)
Circle(256,256,145,#Red)
Circle(256,256,80,#White)
Circle(256,256,40,#Red)
StopDrawing()
ResizeImage(0,120,120)
OpenWindow(0,0,0,150,170,"PicPak",#PB_Window_SystemMenu|#PB_Window_ScreenCentered)
;CreateGadgetList(WindowID(0))
ImageGadget(0,15,15,0,0,ImageID(0))
DisableGadget(0,1)
DragAcceptFiles_ (WindowID(0), #True)
StickyWindow(0,#True)
If CreateMenu(0, WindowID(0))
MenuTitle("Menu")
MenuItem( 1, "Как сделать.")
MenuItem( 2, "About...")
EndIf
source.s = ProgramParameter()
If source
CreateDataSection(source)
EndIf
Repeat
ev=WaitWindowEvent()
Select ev
Case #WM_DROPFILES
Source.s = GetDroppedFile()
ext.s = GetExtensionPart(source)
If FindString("BMP JPG TIF PNG", UCase(ext),1)
CreateDataSection(source)
Else
StickyWindow(0,#False)
MessageRequester("Ошибка в выборе формата","Файл должен быть только: BMP, JPG, PNG или TIF",#MB_ICONERROR)
StickyWindow(0,#True)
EndIf
Case #PB_Event_Menu
Select EventMenu()
Case 1
StickyWindow(0,#False)
MessageRequester("Как пользоваться",use$,$C0)
StickyWindow(0,#True)
Case 2
StickyWindow(0,#False)
MessageRequester("About PicPak",line$, $C0)
StickyWindow(0,#True)
EndSelect
EndSelect
Until ev=#WM_CLOSE
Procedure CreateDataSection(picin.s)
Pattern$ = "BMP (*.bmp)|*.bmp|JPEG (*.jpg)|*.jpg|PNG (*.png)|*.png|TIFF (*.tif)|*.tif"
If picin = " "
picin.s = OpenFileRequester("Выберите файл изображения", "", pattern$, 0)
EndIf
ext.s = GetExtensionPart(picin)
If ReadFile(0,picin)
FileLength = Lof(0)
*Source = AllocateMemory(FileLength)
*Target = AllocateMemory(FileLength+8)
If FileLength And *Source And *Target
ReadData(0, *Source, FileLength)
CompressedLength = 0;PackMemory(*Source, *Target, FileLength, 9)
If CompressedLength
DecompressedLength = UnpackMemory(*Target, *Source)
If DecompressedLength = FileLength
StickyWindow(0,#False)
MessageRequester("Информация", "Сжато успешно:"+Chr(10)+Chr(10)+"Старый размер: "+Str(FileLength)+Chr(10)+"Новый размер: "+Str(CompressedLength), #MB_ICONINFORMATION)
StickyWindow(0,#True)
FreeMemory(*source)
*Source = AllocateMemory(compressedLength)
CopyMemory(*target,*source,compressedlength)
EndIf
Else
compressedlength=filelength
StickyWindow(0,#False)
MessageRequester("Итак...", "Сжатие не нужно", #MB_ICONINFORMATION)
StickyWindow(0,#True)
EndIf
StickyWindow(0,#False)
label.s = InputRequester("Ввести метку","Несколько букв для DataSection: ","PicPak:")
If Trim(label)=""
label="picpak"
EndIf
label=" "+label
StickyWindow(0,#True)
label=RemoveString(label,":")
endlabel.s = label+"end:"
label+":"
If CreateFile(1,GetCurrentDirectory()+"temp.pbi")
WriteStringN(1,""):clip$=Chr(10)
Select ext
Case "jpg"
WriteStringN(1,"UseJPEGImageDecoder()"):clip$+"UseJPEGImageDecoder()"+Chr(10)
Case "png"
WriteStringN(1,"UsePNGImageDecoder()"):clip$+"UsePNGImageDecoder()"+Chr(10)
Case "tif"
WriteStringN(1,"UseTIFFImageDecoder()"):clip$+"UseTIFFImageDecoder()"+Chr(10)
EndSelect
If compressedlength<>filelength
WriteStringN(1,"*unpacked = AllocateMemory("+Str(Filelength)+")")
WriteStringN(1,"UnpackMemory(?"+Trim(RemoveString(label,":"))+", *unpacked)")
WriteStringN(1,"img0 = CatchImage(#PB_Any, *unpacked, "+Str(Filelength)+")")
clip$+"*unpacked = AllocateMemory("+Str(Filelength)+")"+Chr(10)
clip$+"UnpackMemory(?"+Trim(RemoveString(label,":"))+", *unpacked)"+Chr(10)
clip$+"img0 = CatchImage(#PB_Any, *unpacked, "+Str(Filelength)+")"+Chr(10)
Else
WriteStringN(1,"img0 = CatchImage(#PB_Any, ?" + Trim(RemoveString(label,":")) + ", "+Str(Filelength)+")")
clip$+"img0 = CatchImage(#PB_Any, ?" + Trim(RemoveString(label,":")) + ", "+Str(Filelength)+")"+Chr(10)
EndIf
clip$+Chr(10)
SetClipboardText(clip$)
WriteStringN(1,"")
WriteStringN(1,"Datasection")
WriteStringN(1,label)
WriteString(1," Data.b ")
c=0
For i = 0 To compressedlength-1
If i=compressedlength-1
lastbyte=#True
Else
lastbyte=#False
EndIf
c+1
If c >= 20 Or lastbyte
c = 0
WriteStringN(1, "$"+RSet(Hex(PeekC(*source+i)),2,"0"))
If Not lastbyte
WriteString(1," Data.b ")
EndIf
Else
WriteString(1, "$"+RSet(Hex(PeekC(*source+i)),2,"0")+",")
EndIf
Next
WriteStringN(1,endlabel)
WriteStringN(1,"EndDatasection")
CloseFile(1)
FreeMemory(*Source)
FreeMemory(*Target)
CloseFile(0)
MessageRequester("Удачно!","Temp.pbi успешно создан: "+GetCurrentDirectory()+"temp.pbi")
Else
MessageRequester("Проблемы","Невозможно открыть файл")
EndIf
Else
MessageRequester("Проблемы..","Невозможно обработать память. Возможно слишком большой файл.")
EndIf
Else
MessageRequester("Проблемы","Невозможно открыть файл")
EndIf
EndProcedure