et cela aussi bien avec une image de quelques dizaines de ko qu'une image de plus d'un mega
mes excuses pour la lisibilité du code
la procedure pg2419o() fonctionne trés bien
la procedure pg2417() peut etre pas (pour l'image) insertion dans la table tronquée?
la procedure pg2425() probleme (moitié d'image)
Code : Tout sélectionner
Procedure pg2419o();
nt=GetGadgetState(#g2411):nt$=GetGadgetItemText(#g2411,nt)
nb=GetGadgetState(#g2412):nb$=GetGadgetItemText(#g2412,nb,0)
OpenDatabase(0,"Base_moules.db","","")
DatabaseQuery(0,"select tb_interne.genre from tb_interne where tb_interne.nom="+Chr(34)+nt$+Chr(34)+" and tb_interne.champs="+Chr(34)+nb$+Chr(34)+"")
While NextDatabaseRow(0)
nd$=GetDatabaseString(0,0)
Wend
FinishDatabaseQuery(0)
CloseDatabase(0)
Select nd$
Case "image"
FreeImage(0)
ResizeGadget(#g2419,#PB_Ignore,#PB_Ignore,gw,gh)
UseJPEGImageDecoder()
UseJPEG2000ImageDecoder()
nfim$=OpenFileRequester("insertion image","","images|*.bmp;*.jpg",0)
If nfim$
LoadImage(0,nfim$)
iw=ImageWidth(0)
ih=ImageHeight(0)
indx.f=iw/gw
indy.f=ih/gh
If indx>indy
ResizeImage(0,iw/indx,ih/indx)
Else
ResizeImage(0,iw/indy,ih/indy)
EndIf
SetGadgetState(#g2419,ImageID(0))
mfim$=GetPathPart(nfim$):pfim$=GetFilePart(nfim$)
SetGadgetText(#g2419i,nfim$)
SetGadgetText(#g2419t,pfim$)
DisableGadget(#g2419,1):DisableGadget(#g2417,0)
nc=GetGadgetState(#g2412):SetGadgetItemText(#g2412,nc,pfim$,1)
EndIf
Case "memo"
;ExamineDirectory(0,rpt,"*.*")
;While NextDirectoryEntry(0)
;field$=DirectoryEntryName(0)
;If field$=nfi$
;Wend
;FinishDirectory(0)
ClearGadgetItems(#g2418)
mr$=OpenFileRequester("insertion texte","","texte|*.txt",0)
If mr$
OpenFile(0,mr$)
ReadFile(0,mr$)
While Eof(0)=0
hh$=ReadString(0,#PB_Ascii)
AddGadgetItem(#g2418,-1,hh$)
Wend
CloseFile(0)
ms$=GetFilePart(mr$)
SetGadgetText(#g2419c,mr$)
DisableGadget(#g2419,1):DisableGadget(#g2417,0)
nc=GetGadgetState(#g2412):SetGadgetItemText(#g2412,nc,ms$,1)
DisableGadget(#g2417,0)
EndIf
EndSelect
EndProcedure
Procedure pg2417();button valide saisie
nfim$=GetGadgetText(#g2419i)
pfim$=GetGadgetText(#g2419t)
nt=GetGadgetState(#g2411):nt$=GetGadgetItemText(#g2411,nt)
ng=CountGadgetItems(#g2412)
For i=0 To ng-1
dn$=GetGadgetItemText(#g2412,i,0)
dx$=GetGadgetItemText(#g2412,i,1)
OpenDatabase(1,"Base_moules.db","","")
DatabaseQuery(1,"select genre from tb_interne where nom='"+nt$+"' and champs='"+dn$+"'")
While NextDatabaseRow(1)
dw$=GetDatabaseString(1,0)
Wend
FinishDatabaseQuery(1)
CloseDatabase(1)
If dw$="image"
;UsePNGImageEncoder();partie vue sur forum anglais(10 lignes)
UseJPEGImageEncoder()
UseJPEG2000ImageEncoder()
If ReadFile(0,nfim$)
*mem = AllocateMemory(Lof(0))
ReadData(0, *mem, Lof(0))
CloseFile(0)
encoded$ = Space(MemorySize(*mem)*1.35)
result = Base64Encoder(*mem,MemorySize(*mem),@encoded$,Len(encoded$))
If result
dx$ = RTrim(encoded$)
;SaveImage(0,rpt+pfim$,#PB_ImagePlugin_JPEG)
EndIf
Else
;gg$=ErrorMessage()
;MessageRequester("",gg$,0)
EndIf
ClearGadgetItems(#g2419):FreeImage(0)
ElseIf dw$="memo"
bv=CountGadgetItems(#g2418)
For j=0 To bv-1
dz$=GetGadgetItemText(#g2418,j)
;If dz$<>"":dx$=dx$+" "+dz$:EndIf
dx$=dx$+dz$+Chr(13)
Next
;dx$=GetGadgetText(#g2418)
dx$=ReplaceString(dx$,Chr(34),Chr(39)+Chr(39))
ClearGadgetItems(#g2418);:mr$=""
EndIf
If i=0
dnn$=dn$+", "
If dx$="":dx$="'', ":Else:dx$=Chr(34)+dx$+Chr(34)+", ":EndIf
dxx$=dx$
Else
dnn$=dnn$+dn$+", "
If dx$="":dx$="'', ":Else:dx$=Chr(34)+dx$+Chr(34)+", ":EndIf
dxx$=dxx$+dx$
EndIf
Next
dx=Len(dxx$):dn=Len(dnn$)
dxx$=Left(dxx$,dx-2):dnn$=Left(dnn$,dn-2)
dww$="insert into "+nt$+" ("+dnn$+") values ("+dxx$+")"
OpenDatabase(0,rpt+"Base_moules.db","","")
DatabaseUpdate(0,dww$)
FinishDatabaseQuery(0)
CloseDatabase(0)
RemoveKeyboardShortcut(#moules,#PB_Shortcut_Return)
pg241()
EndProcedure
Procedure pg2425();listicon modif saisie colonne
mn=GetGadgetState(#g2425):mn$=GetGadgetItemText(#g2425,mn,0)
nta$=GetGadgetText(#g2421)
OpenDatabase(0,"Base_moules.db","","")
DatabaseQuery(0,"select tb_interne.genre from tb_interne where tb_interne.nom='"+nta$+"' and tb_interne.champs='"+mn$+"'")
While NextDatabaseRow(0)
np$=GetDatabaseString(0,0)
Wend
FinishDatabaseQuery(0)
CloseDatabase(0)
If np$="image"
FreeImage(0)
HideGadget(#g2427,0):DisableGadget(#g2427,0):HideGadget(#g2426,1):HideGadget(#g2425,1):ClearGadgetItems(#g24292):HideGadget(#g24293,1)
HideGadget(#g2429,0):HideGadget(#g2429a,1):DisableGadget(#g24292,1):HideGadget(#g24292,1):DisableGadget(#g24294,0)
RemoveKeyboardShortcut(#moules,#PB_Shortcut_Return)
ng=CountGadgetItems(#g2425)
h=0
For i=1 To ng-1
ch$=GetGadgetItemText(#g2425,i,0)
dn$=GetGadgetItemText(#g2425,i,1)
OpenDatabase(0,"Base_moules.db","","")
DatabaseQuery(0,"select tb_interne.genre from tb_interne where tb_interne.nom='"+nta$+"' and tb_interne.champs='"+ch$+"'")
While NextDatabaseRow(0)
ttdd$=GetDatabaseString(0,0)
Wend
FinishDatabaseQuery(0)
CloseDatabase(0)
If ttdd$<>"memo" And ttdd$<>"image"
If h=0
chdn$=ch$+" = '"+dn$+"' and ":h=1
Else
chdn$=chdn$+ch$+" = '"+dn$+"' and "
EndIf
EndIf
Next
chdn=Len(chdn$):chdn$=Left(chdn$,chdn-5)
sql$="select "+mn$+" from "+nta$+" where "+chdn$+""
UseJPEGImageDecoder()
UseJPEG2000ImageDecoder()
OpenDatabase(1,"Base_moules.db","","")
DatabaseQuery(1,sql$)
If FirstDatabaseRow(1) ;partie forum anglais
encoded$ = GetDatabaseString(1,0)
FinishDatabaseQuery(1)
CloseDatabase(1)
*mem = AllocateMemory(Len(encoded$)*1.35) ;1.35
result = Base64Decoder(@encoded$,Len(encoded$),*mem,MemorySize(*mem))
If result
ReAllocateMemory(*mem,result);*1.35 ou plus
CatchImage(0,*mem,result,#PB_Image_DisplayFormat)
Else
CatchImage(0,*mem,Len(encoded$),#PB_Image_DisplayFormat)
EndIf
ResizeGadget(#g2419,#PB_Ignore,#PB_Ignore,gw,gh)
iw=ImageWidth(0)
ih=ImageHeight(0)
indx.f=iw/gw
indy.f=ih/gh
If indx>indy
ResizeImage(0,iw/indx,ih/indx)
Else
ResizeImage(0,iw/indy,ih/indy)
EndIf
SetGadgetState(#g2427,ImageID(0))
EndIf
ElseIf np$="memo"
HideGadget(#g2426,0):DisableGadget(#g2426,0):HideGadget(#g2427,1):HideGadget(#g2425,1):ClearGadgetItems(#g24292):DisableGadget(#g24294,0)
HideGadget(#g2429,0):HideGadget(#g2429a,1):DisableGadget(#g24292,1):HideGadget(#g24292,1):HideGadget(#g24293,1)
RemoveKeyboardShortcut(#moules,#PB_Shortcut_Return)
ng=CountGadgetItems(#g2425)
v=0
For i=1 To ng-1
ct$=GetGadgetItemText(#g2425,i,0)
dt$=GetGadgetItemText(#g2425,i,1)
OpenDatabase(0,"Base_moules.db","","")
DatabaseQuery(0,"select tb_interne.genre from tb_interne where tb_interne.nom='"+nta$+"' and tb_interne.champs='"+ct$+"'")
While NextDatabaseRow(0)
ttvd$=GetDatabaseString(0,0)
Wend
FinishDatabaseQuery(0)
CloseDatabase(0)
If ttvd$<>"image" And ttvd$<>"memo"
If v=0
chvn$=ct$+" = '"+dt$+"' and ":v=1
Else
chvn$=chvn$+ct$+" = '"+dt$+"' and "
EndIf
EndIf
Next
chvn=Len(chvn$):chvn$=Left(chvn$,chvn-5)
sql$="select "+mn$+" from "+nta$+" where "+chvn$+""
OpenDatabase(1,"Base_moules.db","","")
DatabaseQuery(1,sql$)
While NextDatabaseRow(1)
sz$=GetDatabaseString(1,0)
Wend
FinishDatabaseQuery(1)
CloseDatabase(1)
SetGadgetText(#g2426,sz$)
Else
HideGadget(#g2426,1):HideGadget(#g2427,1):HideGadget(#g2429,0)
DisableGadget(#g24292,0):ClearGadgetItems(#g24292):HideGadget(#g24292,0):HideGadget(#g24293,0):DisableGadget(#g24294,1)
AddKeyboardShortcut(#Moules,#PB_Shortcut_Return,56)
k=0
While GetGadgetItemText(#g24291,k)<>""
nt$=GetGadgetItemText(#g24291,k)
nw$=nw$+nt$+" and "
k=k+1
Wend
If k<>0:nw=Len(nw$):nw$=" where "+Left(nw$,nw-5):EndIf
OpenDatabase(0,"Base_moules.db","","")
DatabaseQuery(0,"select "+nta$+"."+mn$+" from "+nta$+" "+nw$+" group by "+nta$+"."+mn$+" order by "+nta$+"."+mn$+"")
While NextDatabaseRow(0)
nb$=GetDatabaseString(0,0)
AddGadgetItem(#g24292,-1,nb$)
Wend
FinishDatabaseQuery(0)
CloseDatabase(0)
EndIf
EndProcedure
je tiens a felicité le(s) concepteur(s) de purebasic qui a la fois tiens d'un grande simplicité (moi j'ai des progrés a faire) et d'une grande maniabilité dans la conception dune application