bjr à tous
j'ai ajouter une procédure de sauvegarde avec énumération des fichiers
pour une utilisation de fichiers temporaires...
ps: j'ai une demande pour un codeur, j'aimerais créer un fichier pbi d'un code de @Danilo pour
la sauvegarde de fichiers au format *.ico *.cur , j'ai un peu oublié toutes les conditions de ce format..
si quelqu'un à le courage de le faire pour la communauté, je serais vraiment sympa.
voilà, je pourrais bien sur utiliser la procédure de @Danilo dans mon programme,
Mais un fichier SauveIcone.pbi serait peut être plus pratique
Je vous poste à la suite le code de @Rashad qui a utilisé cette procédure sur le forum anglais
cordialement
Code : Tout sélectionner
Enumeration
#Window
#Canvas
#File
#Bouton1
#Bouton2
#Bouton3
#Bouton4
EndEnumeration
Enumeration
#Image1
#Image2
#ImageBouton1
#ImageBouton2
#ImageBouton3
#ImageBouton4
EndEnumeration
UseJPEGImageEncoder()
UsePNGImageEncoder()
Procedure Imagebouton(num_Img, x, y, w, h, colorFr, ColorTx, ColorFx, titre$, Ft$, hf,typ)
;Auteur ??
ImgID = CreateImage(num_Img, w, h)
Font=LoadFont(#PB_Any, ft$ , hf, typ)
StartDrawing(ImageOutput(num_Img))
DrawingMode(#PB_2DDrawing_Transparent)
Box(0, 0, w, h,colorFr)
DrawingFont(FontID(Font))
FrontColor(ColorTx)
DrawText(x+1,y-1,titre$)
FrontColor(colorFx)
DrawText(x,y,titre$)
StopDrawing()
ProcedureReturn ImgID
EndProcedure
Procedure.s EnumerationImage(Fichier$)
;-00--Boucle d'énumérotation des noms de fichiers jusqu’à 999 ... plus probablement :mrgreen:
;-01--Utilisation principale est de créer des fichiers temporaires, Auteur: kernadec
Repeat
;-02--Capture nom de l'extension
ext$ = StringField(Fichier$,CountString(Fichier$, ".") + 1, ".")
;-03--Capture le nombre de lettre de l'extension
ext = Len(StringField(Fichier$,CountString(Fichier$, ".") + 1, "."))
;-04--Capture le chemin des repertoires du fichier
CheminTmp$ = Mid(Fichier$, 1, Len(Fichier$)-Len(StringField(Fichier$,CountString(Fichier$, "\") + 1, "\")))
;-05--Capture le nom du fichier pour lui créér un pseudo nom
FichierTmp$ = StringField(Fichier$,CountString(Fichier$, "\") + 1, "\")
;-06--Sont accéptée que les extensions de 1 à 3 lettres
If ext => 1 And ext < 4
;-07--Reconnait que ces 3 formats d'images: bmp, jpg, et png
If Right(FichierTmp$,ext) = "bmp" Or Right(FichierTmp$,ext) = "jpg" Or Right(FichierTmp$,ext) = "png"
;-08--Recherche avec Chemin et Nom complet le numero suivant
If ReadFile(#File,Fichier$)
;-09--Capture le numéro associé au nom du fichier
tmp = Val(Mid(FichierTmp$, Len(FichierTmp$)-(3 + ext), ext))
;-10--Incrémente le numéro et place 2 zéro avant comme s'il était inférieur à 10
tmp$ = "00" + Str(tmp + 1)
;-11--Conserve les 3 caractères de droite du chiffre
If Len(tmp$) > 3 : tmp$ = Right(tmp$,3) : EndIf
;-12--Restitue chemin et nom et retourne tester si ce nom est disponible
Fichier$ = CheminTmp$ + Left(FichierTmp$,Len(FichierTmp$) - (3 + ext) - 1) + Tmp$ + "." + ext$
;-13--Passe à la rechercher du numéro suivant!
CloseFile(#File)
Else
;-14--Ce numéro de nom est accepté retour au selecteur
ProcedureReturn Fichier$
Break
EndIf
Else
MessageRequester("Format de Sauvegarde Inconnu", "Image Non Sauvegardée: " + Fichier$)
Break
EndIf
Else
MessageRequester("Après recherche du Type", " Ce fichier n'a pas d'extension: " + Fichier$)
Break
EndIf
ForEver
EndProcedure
Procedure Sauvegarde_Image_Canvas(Fichier$)
;###################################### Sauvegarde Image Canvas JPEG, PNG, BMP Images
Fichier$ = EnumerationImage(Fichier$) ; Recherche si le nom du fichier existe a cette destination.
Fichier$ = SaveFileRequester("Sauvegarde Image...", Fichier$, "Images (JPG,PNG,BMP) | *.jpg;*.jpeg;*.Png;*.bmp", 0)
If Fichier$ And (FileSize(Fichier$) = -1 Or MessageRequester("Canvas", "Fichier existant! utiliser le meme Nom? " + Fichier$, #PB_MessageRequester_YesNo) = #PB_MessageRequester_Yes)
If CreateImage(#Image2, GadgetWidth(#Canvas), GadgetHeight(#Canvas), 24)
StartDrawing(ImageOutput(#Image2)) ; Copie de votre dessin Canvas dans cette Image
DrawImage(GetGadgetAttribute(#Canvas, #PB_Canvas_Image), 0, 0)
StopDrawing()
If Right(Fichier$,3) = "jpg" Or Right(Fichier$,4) = "jpeg"
If SaveImage(#Image2, Fichier$, #PB_ImagePlugin_JPEG) = 0
MessageRequester("Canvas Sauvegarde Image", "Image Non Sauvegardée: " + Fichier$)
EndIf
ElseIf Right(Fichier$,3) = "png"
If SaveImage(#Image2, Fichier$, #PB_ImagePlugin_PNG) = 0
MessageRequester("Canvas Sauvegarde Image", "Image Non Sauvegardée: " + Fichier$)
EndIf
ElseIf Right(Fichier$,3) = "bmp"
If SaveImage(#Image2, Fichier$) = 0
MessageRequester("Canvas Sauvegarde Image", "Image Non Sauvegardée: " + Fichier$)
EndIf
EndIf
FreeImage(#Image2)
EndIf
EndIf
EndProcedure
Chemin$ = GetCurrentDirectory()
Fichier$ = Chemin$ + "Image001.jpg" ; nom de fichier par defaut
Color.l=RGB(Random(255), Random(255), Random(255))
If OpenWindow(#Window, 0, 0, 300,360, "CanvasGadget", #PB_Window_SystemMenu | #PB_Window_ScreenCentered)
CanvasGadget(#Canvas, 10, 10, 280, 310,#PB_Canvas_ClipMouse)
ButtonImageGadget(#bouton1, 9, 330,78, 22,Imagebouton(#ImageBouton1, 4, 4, 75, 22,Color,RGB(255,255,255),RGB(0,0,0)," C o u l e u r ","arial",8,#PB_Font_Bold))
ButtonImageGadget(#bouton2, 100, 330, 60, 22,Imagebouton(#ImageBouton2, 2, 4, 56, 22,RGB(255,255,255),RGB(255,255,255),RGB(0,0,0)," E f f a c e ","arial",8,#PB_Font_Bold))
ButtonImageGadget(#bouton3, 170, 330, 60, 22,Imagebouton(#ImageBouton3, 2, 4, 56, 22,RGB(0,255,0),RGB(255,255,255),RGB(0,0,0)," S a u v e ","arial",8,#PB_Font_Bold))
ButtonImageGadget(#bouton4, 240, 330, 50, 22,Imagebouton(#ImageBouton4, 4, 4, 46, 22,RGB(255,0,0),RGB(0,0,0),RGB(255,255,255)," Q u i t ","arial",9,#PB_Font_Bold))
SetGadgetAttribute(#Canvas, #PB_Canvas_Cursor, #PB_Cursor_Hand)
Repeat
Event = WaitWindowEvent()
Select Event
Case #PB_Event_Gadget
Select EventGadget()
Case #bouton1
Color = ColorRequester()
ButtonImageGadget(#bouton1, 9, 330,78, 22,Imagebouton(#ImageBouton1, 4, 4, 75, 22,Color,RGB(255,255,255),RGB(0,0,0)," C o u l e u r ","arial",8,#PB_Font_Bold))
Case #bouton2
StartDrawing(CanvasOutput(#Canvas)) : Box(0, 0, 280, 310,#White) : StopDrawing()
Case #bouton3
Sauvegarde_Image_Canvas(Fichier$)
Case #bouton4
Quit = 1
EndSelect
EndSelect
If Event = #PB_Event_Gadget And EventGadget() = #Canvas
If EventType() = #PB_EventType_LeftButtonDown Or (EventType() = #PB_EventType_MouseMove And GetGadgetAttribute(#Canvas, #PB_Canvas_Buttons) & #PB_Canvas_LeftButton)
c=1
StartDrawing(CanvasOutput(#Canvas))
x = GetGadgetAttribute(#Canvas, #PB_Canvas_MouseX)
y = GetGadgetAttribute(#Canvas, #PB_Canvas_MouseY)
Circle(x, y, 4, Color)
StopDrawing()
EndIf
;
If EventType() = #PB_EventType_MouseLeave
If c=1
Debug "sortie & save buffer"
EndIf
c=0
EndIf
EndIf
Until Quit = 1 Or Event = #PB_Event_CloseWindow
EndIf
A la suite voilà le code de Rashad avec la procedure de Danilo
Code : Tout sélectionner
UsePNGImageEncoder()
UsePNGImageDecoder()
UseTGAImageDecoder()
UseTIFFImageDecoder()
UseJPEGImageDecoder()
;http://www.purebasic.fr/english/viewtopic.php?p=159048#159048
;SaveIcon(hIcon, filename$)
;By Stephen Rodriguez 2006 (Updated 2010).
crossHnd = LoadCursor_(0, #IDC_CROSS )
arrowHnd = LoadCursor_(0, #IDC_ARROW )
Procedure.i SaveIcon(hIcon, filename$)
Protected result, iconinfo.ICONINFO, hbmMask, hbmColor
Protected cbitmap.BITMAP, cwidth, cheight, cbitsperpixel, colorcount, colorplanes
Protected mbitmap.BITMAP, mwidth, mheight, fIcon, xHotspot, yHotspot
Protected file, imagebytecount, hdc, oldbitmap, mem, bytesinrow, temp
Protected *bitmapinfo.BITMAPINFO
;Get information regarding the icon.
If Not(GetIconInfo_(hIcon, iconinfo)) : ProcedureReturn 0 : EndIf ; Not a valid icon handle.
fIcon=2-iconinfo\fIcon ;icon = 1, cursor = 2,
If fIcon=2 ;Cursor.
xHotspot=iconinfo\xHotspot
yHotspot=iconinfo\yHotspot
EndIf
;Allocate memory for a BITMAPINFO structure + a color table with 256 entries.
*bitmapinfo = AllocateMemory(SizeOf(BITMAPINFO) + SizeOf(RGBQUAD)<<8)
If *bitmapinfo = 0 : ProcedureReturn 0 :EndIf
;Get the mask (AND) bitmap, which, if the icon is B/W monochrome, contains the colour bitmap.
hbmMask=iconinfo\hbmMask
GetObject_(hbmMask, SizeOf(BITMAP),mbitmap)
mwidth= mbitmap\bmWidth
mheight= mbitmap\bmHeight
;Get the colour (XOR) bitmap.
hbmColor=iconinfo\hbmColor
If hbmColor
GetObject_(hbmColor, SizeOf(BITMAP),cbitmap)
cwidth= cbitmap\bmWidth
cheight= cbitmap\bmHeight
cbitsperpixel = cbitmap\bmBitsPixel
If cbitsperpixel = 0 : cbitsperpixel = 1 : EndIf
If cbitsperpixel < 8
colorcount=Pow(2,cbitsperpixel) ;colorcount = 0 if 8 or more bpp.
EndIf
colorplanes=cbitmap\bmplanes
Else ;Monochrome icon.
cwidth= mwidth
cheight= mheight/2
cbitsperpixel = 1
colorcount=2
colorplanes=1
mheight=cheight
EndIf
;Ready to start creating the file.
file=CreateFile(#PB_Any,filename$)
If file
;Write the data.
;word = 0
WriteWord(file,0)
;word = 1 for icon, 2 for cursor.
WriteWord(file,ficon) ;1 for icon, 2 for cursor.
;word = number of icons in file.
WriteWord(file,1) ;***CHANGE IF EXTENDING CODE TO MORE THAN ONE ICON***
;16 byte ICONDIRENTRY structure, one for each icon.
WriteByte(file, cwidth)
WriteByte(file, cheight)
WriteByte(file, colorcount)
WriteByte(file, 0) ;Reserved.
If ficon=1 ;Icon.
WriteWord(file, colorplanes) ;Should equal 1, -but just in case!
WriteWord(file, cbitsperpixel)
Else ;Cursor.
WriteWord(file, xhotspot)
WriteWord(file, yhotspot)
EndIf
WriteLong(file,0) ;TEMPORARY! WE NEED TO RETURN WHEN WE KNOW THE EXACT QUANTITY.
; Size of (InfoHeader + ANDbitmap + XORbitmap)
WriteLong(file,Loc(file)+4) ;FilePos, where InfoHeader starts
;Now the image data in the form BITMAPINFOHEADER (40 bytes) + colour map for the colour bitmap
;+ bits of colour bitmap + bits of mask bitmap. Gulp! One for each icon.
;40 byte BITMAPINFOHEADER structure.
imagebytecount=SizeOf(BITMAPINFOHEADER)
WriteLong(file, imagebytecount) ;Should be 40.
WriteLong(file, cwidth)
WriteLong(file, cheight+mheight) ;Combined heights of colour + mask images.
WriteWord(file, colorplanes) ;Should equal 1, -but just in case!
WriteWord(file, cbitsperpixel)
WriteLong(file, 0) ;Compression.
WriteLong(file, 0) ;Image size. Valid to set to zero if there's no compression.
WriteLong(file, 0) ;Unused.
WriteLong(file, 0) ;Unused.
WriteLong(file, 0) ;Unused.
WriteLong(file, 0) ;Unused.
;Colour map. Only applies for <= 8 bpp.
hdc=CreateCompatibleDC_(0) ;Needed in order to get the colour table.
If hbmColor = 0 ;Monochrome icon.
WriteLong(file, #Black)
WriteLong(file, #White)
imagebytecount+SizeOf(rgbquad)*2
ElseIf cbitsperpixel<=8 ;Includes 1 bit non-monochrome icons.
;Get colour table.
temp=Pow(2,cbitsperpixel)
bytesinrow = SizeOf(rgbquad)*temp
mem=AllocateMemory(bytesinrow)
oldbitmap=SelectObject_(hdc, hbmColor)
GetDIBColorTable_(hdc, 0, temp, mem)
WriteData(file, mem, bytesinrow) ;Write color table.
FreeMemory(mem)
SelectObject_(hdc, oldbitmap)
imagebytecount+bytesinrow
EndIf
;Now the colour image bits. We use GetDiBits_() for this.
bytesinrow = (cwidth*cbitsperpixel+31)/32*4 ;Aligned to a 4-byte boundary.
bytesinrow * cheight
mem=AllocateMemory(bytesinrow)
*bitmapinfo\bmiHeader\biSize=SizeOf(BITMAPINFOHEADER)
*bitmapinfo\bmiHeader\biWidth=cwidth
*bitmapinfo\bmiHeader\biPlanes=colorplanes
*bitmapinfo\bmiHeader\biBitCount=cbitsperpixel
If hbmColor
*bitmapinfo\bmiHeader\biHeight=cheight
GetDIBits_(hdc,hbmColor,0,cheight,mem,*bitmapinfo,#DIB_RGB_COLORS)
Else ;Monochrome color image is the bottom half of the mask image.
*bitmapinfo\bmiHeader\biHeight=2*cheight
GetDIBits_(hdc,hbmMask,0,cheight,mem,*bitmapinfo,#DIB_RGB_COLORS)
EndIf
WriteData(file, mem, bytesinrow)
FreeMemory(mem)
imagebytecount+bytesinrow
;Now the mask image bits. We use GetDiBits_() for this.
bytesinrow = (mwidth+31)/32*4 ;Aligned to a 4-byte boundary.
bytesinrow * mheight
mem=AllocateMemory(bytesinrow)
*bitmapinfo\bmiHeader\biWidth=mwidth
*bitmapinfo\bmiHeader\biPlanes=1
*bitmapinfo\bmiHeader\biBitCount=1
If hbmColor
*bitmapinfo\bmiHeader\biHeight=mheight
GetDIBits_(hdc,hbmMask,0,mheight,mem,*bitmapinfo,#DIB_RGB_COLORS)
Else
*bitmapinfo\bmiHeader\biHeight=2*mheight
GetDIBits_(hdc,hbmMask,mheight,mheight,mem,*bitmapinfo, #DIB_RGB_COLORS)
EndIf
WriteData(file, mem, bytesinrow)
FreeMemory(mem)
imagebytecount+bytesinrow
DeleteDC_(hdc)
;Finally, return to the field we missed out.
FileSeek(file, 14)
WriteLong(file, imagebytecount)
CloseFile(file)
result= 1 ;Signal everything is fine.
Else
result= 0
EndIf
DeleteObject_(hbmMask) ;These are copies created as a result of GetIconInfo_() and so require deleting.
DeleteObject_(hbmColor)
FreeMemory(*bitmapinfo)
ProcedureReturn result
EndProcedure
Procedure GrayScaleImg(Img)
StartDrawing(ImageOutput(Img))
Width = ImageWidth(Img) - 1
Height = ImageHeight(Img) - 1
For y = 0 To Height
For x = 0 To Width
Pixel = Point(x, y)
Gray = Red(Pixel) * 77 ; 0.2989 * 256 = 76.5184
Gray + Green(Pixel) * 150 ; 0.5870 * 256 = 150.2720
Gray + Blue(Pixel) * 29 ; 0.1140 * 256 = 29.1840
Gray = Gray >> 8 ; / 256
Plot(x, y, RGB(Gray, Gray, Gray))
Next x
Next y
StopDrawing()
ProcedureReturn #True
EndProcedure
OpenWindow(0,0,0,250,290,"Icon - Cursor Creator",#PB_Window_SystemMenu|#PB_Window_ScreenCentered)
OptionGadget(1,10,10,100,22," 16 x 16")
OptionGadget(2,10,35,100,22," 24 x 24")
OptionGadget(3,10,60,100,22," 32 x 32")
OptionGadget(4,10,85,100,22," 48 x 48")
OptionGadget(5,10,110,100,22," 64 x 64")
OptionGadget(6,10,135,100,22," 128 x 128")
OptionGadget(7,10,160,100,22," Custom Size")
DisableGadget(7,1)
SetGadgetState(6,1)
StringGadget(8,135,160,30,22,"",#PB_String_Numeric)
StringGadget(9,175,160,30,22,"",#PB_String_Numeric)
DisableGadget(8,1)
DisableGadget(9,1)
CheckBoxGadget(10,60,195,50,22," Color")
OptionGadget(11,10,195,50,22," Icon")
OptionGadget(12,10,220,50,22," Cursor")
SetGadgetState(10,1)
ContainerGadget(13,110,10,128,128, #PB_Container_BorderLess)
ButtonImageGadget(14,-1,-1,130,130,0)
CloseGadgetList()
DisableGadget(13,1)
ButtonGadget(15,10,260,75,22,"Load Image")
ButtonGadget(16,95,260,75,22,"Save As...")
ButtonGadget(17,180,260,63,22,"EXIT")
TextGadget(18,120,195,22,22,"",#SS_CENTERIMAGE | #SS_CENTER| #WS_BORDER| #SS_NOTIFY)
TextGadget(19,150,195,90,22,"Transparent Color",#SS_CENTERIMAGE)
SetGadgetColor(18,#PB_Gadget_BackColor,#White)
Repeat
Select WaitWindowEvent()
Case #PB_Event_CloseWindow
Quit =1
Case #WM_MOUSEMOVE
If ChildWindowFromPoint_(WindowID(0),WindowMouseY(0) << 32 + WindowMouseX(0)) = GadgetID(13)
Flag = 1
SetClassLongPtr_(WindowID(0), #GCL_HCURSOR,crossHnd)
Else
Flag = 0
SetClassLongPtr_(WindowID(0), #GCL_HCURSOR,arrowHnd)
EndIf
Case #WM_LBUTTONDOWN
If Flag = 1 And IsImage(0)
StartDrawing(WindowOutput(0))
color = Point(WindowMouseX(0),WindowMouseY(0))
StopDrawing()
SetGadgetColor(18,#PB_Gadget_BackColor,Color )
EndIf
Case #PB_Event_Menu
Select EventMenu()
Case 1
EndSelect
Case #PB_Event_Gadget
Select EventGadget()
Case 10
If IsImage(0) <> 0 And GetGadgetState(12) = 0
If GetGadgetState(10) = 0
CopyImage(0, 1)
ResizeImage(1,Size,Size)
GrayScaleImg(1)
SetGadgetAttribute(14,#PB_Button_Image,ImageID(1))
Else
CopyImage(0, 1)
ResizeImage(1,Size,Size)
SetGadgetAttribute(14,#PB_Button_Image,ImageID(1))
EndIf
Else
SetGadgetState(10,0)
EndIf
Case 12
SetGadgetState(10,0)
If IsImage(0)
CopyImage(0, 1)
ResizeImage(1,Size,Size)
GrayScaleImg(1)
SetGadgetAttribute(14,#PB_Button_Image,ImageID(1))
EndIf
Case 1 To 6
For x = 1 To 6
If GetGadgetState(x) = 1
Break
EndIf
Next
If x = 1
Size = 16
ElseIf x = 2
Size = 24
ElseIf x = 3
Size = 32
ElseIf x = 4
Size = 48
ElseIf x = 5
Size = 64
ElseIf x = 6
Size = 128
EndIf
If IsImage(0)
CopyImage(0, 1)
ResizeImage(1,Size,Size)
If GetGadgetState(10) = 0
GrayScaleImg(1)
EndIf
SetGadgetAttribute(14,#PB_Button_Image,ImageID(1))
EndIf
Case 15
File$ = OpenFileRequester("Raw Image", "*.bmp","bmp (*.bmp)| *.bmp| jpg (*.jpg)| *.jpg| tif (*.tif)| *.tif| png (*.png)| *.png| tga (*.tga)|*.tga,| All files (*.*)| *.*",0)
If File$
LoadImage(0,File$)
For x = 1 To 6
If GetGadgetState(x) = 1
Break
EndIf
Next
If x = 1
Size = 16
ElseIf x = 2
Size = 24
ElseIf x = 3
Size = 32
ElseIf x = 4
Size = 48
ElseIf x = 5
Size = 64
ElseIf x = 6
Size = 128
EndIf
CopyImage(0, 1)
ResizeImage(1,Size,Size)
If GetGadgetState(10) = 0
GrayScaleImg(1)
EndIf
SetGadgetAttribute(14,#PB_Button_Image,ImageID(1))
EndIf
Case 16
sFile$ = SaveFileRequester("Please choose file to save",""," Icon file (*.ico)|*.ico| Cursor file (*.cur)|*.cur",0)
If sFile$
CreateImage(2, Size,Size)
StartDrawing(ImageOutput(2))
If GetGadgetState(11) = 1
DrawingMode(#PB_2DDrawing_AllChannels )
Else
DrawingMode(#PB_2DDrawing_AlphaChannel )
EndIf
DrawImage(ImageID(1),0,0)
StopDrawing()
iinf.ICONINFO
If GetGadgetState(11) = 1
iinf\fIcon = 1
iinf\hbmMask = ImageID(1)
iinf\hbmColor = ImageID(2)
icoHnd = CreateIconIndirect_(iinf)
sFile$ = GetPathPart(sFile$) + GetFilePart(sFile$,1) + ".ico"
SaveIcon(icoHnd, sFile$)
Else
iinf\fIcon = 0
iinf\xHotspot = Size/2
iinf\yHotspot = Size/2
iinf\hbmMask = ImageID(1)
iinf\hbmColor = ImageID(2)
curHnd = CreateIconIndirect_(iinf)
sFile$ = GetPathPart(sFile$) + GetFilePart(sFile$,1) + ".cur"
SaveIcon(curHnd, sFile$)
EndIf
EndIf
Case 17
End
EndSelect
EndSelect
Until Quit = 1
End