PureBasicPrint, imprimer vos codes sources en couleur

camomille · Message par **camomille** » ven. 22/août/2014 7:13

Bonjour,

malgré une recherche approfondie, je n' ai trouvé aucun lien valide pour
l' outil "PUREBASICPRINT" Hightlight de Flype ,je fait appel à une âme
charitable qui l' aurait conservé et qui pourrait me donner un lien valide
de l' exécutable et/ou du code source pour une éventuelle adaptation.

Merci d'avance

Cordialement

graph100 · Message par **graph100** » ven. 22/août/2014 9:37

Flype passe de temps en temps, tu peux lui faire un mp

camomille · Message par **camomille** » ven. 22/août/2014 9:57

@graph100

merci de t' intéressé à mon problème.
J'ai déjà contacté Flype en Août mais sans réponse,il est sans doute en vacances.
Je lui réitérerai ma demande mp en Septembre.
J' espérai que quelqu' un avait gardé ce programme sous le coude

cdt

graph100 · Message par **graph100** » ven. 22/août/2014 10:04

J'ai cherché dans mes codes, mais je ne l'ai pas. Flype est passé ici le 10 août, il doit effectivement se dorer la pilule quelque part (pas en France puisqu'il n'y fait pas beau

)

PAPIPP · Message par **PAPIPP** » sam. 23/août/2014 14:56

Bonjour à tous

Voici un fichier du 22082009 PUREBASICPRINT.ZIP de FLYPE

Le fichier sera accessible au moins 1 mois à l'adresse suivante:
http://dl.free.fr/mAp07JVke

Le fichier sera accessible à l'adresse suivante:
http://dl.free.fr/mAp07JVke

camomille · Message par **camomille** » sam. 23/août/2014 18:34

@Graph100
Merci de m'avoir consacré un peu de temps

@PAPIPP
Merci pour la même raison et en plus d'avoir réglé mon problème

cdt

Ollivier · Message par **Ollivier** » sam. 23/août/2014 21:22

@Camomille

Ton pseudo me rappelle cette plante que j'ai mis en terre, sarclé, admiré et vu être dévastée par la neige. Je me suis vu la récolter à la lampe frontale Petzl en bottes et tenue intégrale Guy Cotten sous la neige tombante et un vent plutôt frisquet à la faucille contre l'ordre du patron qui avait abandonné, résigné par la cruauté du climat (Les 2/3 de la surface étaient déjà cuits par le gel). Edit: ceci est un hors sujet évidemment, j'éviterai de trop en faire. C'est une plante qui a accompagné ma vie le temps d'une saison. Je ne vais pas m'étendre sur ses vertues!

camomille · Message par **camomille** » dim. 24/août/2014 8:48

@Ollivier

Je ne pense pas avoir autant de vertus que la plante,
mais comme elle j'ai connu l'antiquité .

.
Encore merci à ce site qui m'aide au quotidien à
développer mon projet.

cdt

falsam · Message par **falsam** » dim. 24/août/2014 9:05

camomille a écrit :Encore merci à ce site qui m'aide au quotidien à
développer mon projet.

Un petit mot sur ce projet?

camomille · Message par **camomille** » dim. 24/août/2014 9:38

Une image vaut mieux qu'une longue explication,mais je n'est pas trouvé le moyen de la déposer simplement.

Il s' agit d'un programme de graphiques et tableaux pour la simulation des taxes et impôts pour des retraits programmés
sur une assurance vie permettant des choix sur les options d'investissement.

Sujet qui semble sérieux ,mais qui me permet d' occuper mon cerveau.

cdt

MLD · Message par **MLD** » dim. 24/août/2014 10:34

@Camomille regarde si cela peut t'aidé

Code : Tout sélectionner

;ML le 7/06/2014 compilation PB 5.22 
XIncludeFile "SIG+.pbi"
Enumeration
#fencal = 0
#coch_1 = 3
#coch_2 = 4
#coch_3 = 5
#coch_4 = 6
#coch_5 = 7
#coch_6 = 8
#coch_7 = 9
#coch_8 = 10
#coch_9 = 11
#coch_10 = 12
#coch_11 = 13
#coch_12 = 14
#coch_13 = 15
#trait1 = 16
#trait2 = 17
#trait3 = 18
#trait4 = 19
#trait5 = 20
#trait6 = 21
#etictr1 = 22
#etictr2 = 23
#etictr3 = 24
#etictext1=25
#etictext2=26
#etictext3=27
#etictext4=28
#etictext5=29
#etictext6=30
#flbl1 = 31
#flbl2 = 32
#string1 = 35
#string2 = 36
#string3 = 37
#spin1 = 38
#spin2 = 39
#imageico = 40
#btstop = 41
#btcalcul = 42
#bteff = 43
#eticresult1 = 44
#eticresult2 = 45
#eticresult3 = 46
#result1 = 47
#result2 = 48
#result3 = 49
#timer1 = 50
#textinfos = 51
#textbar = 52
EndEnumeration
Global FontID3
 FontID3 = LoadFont(3,"Arial",y(10),#PB_Font_HighQuality)
Global FontID4
FontID4 = LoadFont(4,"Tahoma",y(14) ,#PB_Font_Bold|#PB_Font_HighQuality|#PB_Font_Italic)
UseJPEGImageDecoder()
;- image
Enumeration 2
#img_8 = 207 ; bt stop
#img_9 = 208 ; bt calcul
#img_10 = 209 ; bt efface
EndEnumeration

DataSection
Image6: :IncludeBinary "47.ico"
Image7: :IncludeBinary "312.ico"
Image8: :IncludeBinary "378.ico"
EndDataSection

CatchImage(#img_8, ?Image6);bt stop
CatchImage(#img_9, ?Image7);bt calcul
CatchImage(#img_10, ?Image8);bt efface

Declare Organise(gadget)

Global gadgetBkg
gadgetBkg  = CreateSolidBrush_($C1E2E8)
Procedure Colorcoh(hWnd, msg, wParam, lParam)
   If msg=#WM_CTLCOLORSTATIC
    Select GetDlgCtrlID_(lParam)   
       Case 1 To 15  
         ProcedureReturn gadgetBkg
    EndSelect
  EndIf
  ProcedureReturn #PB_ProcessPureBasicEvents
EndProcedure

Procedure ToolTipMic(WindowNumber.l,GadgetNumber.l,Text.s,couleurf)
  Protected Balloon.TOOLINFO
  Tooltip=CreateWindowEx_(0,"ToolTips_Class32","",#WS_POPUP | #TTS_NOPREFIX | #TTS_BALLOON,0,0,0,0,WindowID(WindowNumber),0,GetModuleHandle_(0),0)
  SendMessage_(Tooltip,#TTM_SETTIPTEXTCOLOR,GetSysColor_(#COLOR_INFOTEXT),0)
  SendMessage_(Tooltip,#TTM_SETTIPBKCOLOR,couleurf,0)
  SendMessage_(Tooltip,#TTM_SETMAXTIPWIDTH,0,180)
  Balloon\cbSize=SizeOf(TOOLINFO)
  Balloon\uFlags=#TTF_IDISHWND | #TTF_SUBCLASS
  If IsGadget(GadgetNumber)
    Balloon\hwnd=GadgetID(GadgetNumber)
    Balloon\uId=GadgetID(GadgetNumber)
  Else
    Balloon\hwnd=GadgetNumber
    Balloon\uId=GadgetNumber
  EndIf
  Balloon\lpszText=@Text
  SendMessage_(Tooltip,#TTM_ADDTOOL,0,@Balloon)
  ProcedureReturn Tooltip
EndProcedure

Procedure razcoche(gadget)
For z = 3 To 15
If z <> gadget
 SetGadgetState(z,#PB_Checkbox_Unchecked)
Else
 SetGadgetState(z,#PB_Checkbox_Checked)
EndIf
Next
For xx = 35 To 37
  SetGadgetText(xx,"0")
Next
For xx = 47 To 49
  SetGadgetText(xx,"0.€")
Next
For yy = 27 To 30
  HideGadget(yy,1)
Next
For yy = 37 To 39
  HideGadget(yy,1)
Next
For yy = 45 To 46
  HideGadget(yy,1)
Next
For yy = 48 To 49
  HideGadget(yy,1)
Next
Organise(gadget)
EndProcedure

Procedure elemorigine()
ResizeGadget(#etictext1, #PB_Ignore,y(100),#PB_Ignore, #PB_Ignore)
ResizeGadget(#string1, #PB_Ignore,y(125),#PB_Ignore, #PB_Ignore)
ResizeGadget(#etictext2, #PB_Ignore,y(170),#PB_Ignore, #PB_Ignore)
ResizeGadget(#string2, #PB_Ignore,y(195),#PB_Ignore, #PB_Ignore)
ResizeGadget(#etictext3, #PB_Ignore,y(240),#PB_Ignore, #PB_Ignore)
ResizeGadget(#string3, #PB_Ignore,y(260),#PB_Ignore, #PB_Ignore)
EndProcedure

Procedure Organise(gadget)
 Select gadget
  Case 3
   elemorigine()
   SetGadgetText(#etictext1,"Investissement initial")
   SetGadgetText(#etictext2,"Taux d'intérêt (%)")
   SetGadgetText(#etictext3,"Nb de période de composition de l'intérêt")
   ResizeGadget(#string3, #PB_Ignore,y(280),#PB_Ignore, #PB_Ignore)
   SetGadgetText(#eticresult1,"Capital en fin de période d'investissement")
   SetGadgetText(#eticresult2,"Gain sur investissement")
   ResizeGadget(#eticresult1, #PB_Ignore,y(150),#PB_Ignore, #PB_Ignore)
   ResizeGadget(#result1, #PB_Ignore,y(200),#PB_Ignore, #PB_Ignore)
   ResizeGadget(#eticresult2, #PB_Ignore,y(230),#PB_Ignore, #PB_Ignore)
   ResizeGadget(#result2, #PB_Ignore,y(260),#PB_Ignore, #PB_Ignore)
   For yy = 27 To 30
    HideGadget(yy,0)
   Next
   For yy = 37 To 39
    HideGadget(yy,0)
   Next
   HideGadget(45,0)
   HideGadget(48,0)
  Case 4
   SetGadgetText(#etictext1,"Montant des dépots")
   SetGadgetText(#etictext2,"Taux d'intérêt (%)")
   SetGadgetText(#etictext3,"Nombre annuel de dépots")
   ResizeGadget(#string3, #PB_Ignore,y(270),#PB_Ignore, #PB_Ignore)
   SetGadgetText(#eticresult1,"Capital en fin de période d'investissement")
   SetGadgetText(#eticresult2,"Capital investi")
   SetGadgetText(#eticresult3,"Gain")
   ResizeGadget(#eticresult1, #PB_Ignore,y(120),#PB_Ignore, #PB_Ignore)
   ResizeGadget(#result1, #PB_Ignore,y(170),#PB_Ignore, #PB_Ignore)
   ResizeGadget(#eticresult2, #PB_Ignore,y(200),#PB_Ignore, #PB_Ignore)
   ResizeGadget(#result2, #PB_Ignore,y(230),#PB_Ignore, #PB_Ignore)
   For yy = 27 To 30
    HideGadget(yy,0)
   Next
   For yy = 37 To 39
    HideGadget(yy,0)
   Next
   HideGadget(45,0)
   For yy = 45 To 46
    HideGadget(yy,0)
   Next
   For yy = 48 To 49
    HideGadget(yy,0)
  Next
  Case 5
   elemorigine()
   SetGadgetText(#etictext1,"Valeur future")
   SetGadgetText(#etictext2,"Taux d'intérêt (%)")
   SetGadgetText(#etictext3,"Nombre annuel de dépots")
   ResizeGadget(#string3, #PB_Ignore,y(270),#PB_Ignore, #PB_Ignore)
   SetGadgetText(#eticresult1,"Montant de chaque dépot")
   SetGadgetText(#eticresult2,"Capital investi")
   SetGadgetText(#eticresult3,"Gain")
   ResizeGadget(#eticresult1, #PB_Ignore,y(140),#PB_Ignore, #PB_Ignore)
   ResizeGadget(#result1, #PB_Ignore,y(170),#PB_Ignore, #PB_Ignore)
   ResizeGadget(#eticresult2, #PB_Ignore,y(200),#PB_Ignore, #PB_Ignore)
   ResizeGadget(#result2, #PB_Ignore,y(230),#PB_Ignore, #PB_Ignore)
   For yy = 27 To 30
    HideGadget(yy,0)
   Next
   For yy = 37 To 39
    HideGadget(yy,0)
   Next
   For yy = 45 To 46
    HideGadget(yy,0)
   Next
   For yy = 48 To 49
    HideGadget(yy,0)
  Next 
  Case 6
   elemorigine()
   SetGadgetText(#etictext1,"Valeur future")
   SetGadgetText(#etictext2,"Taux d'intérêt (%)")
   SetGadgetText(#etictext3,"Nb de période de composition de l'intérêt")
   ResizeGadget(#string3, #PB_Ignore,y(280),#PB_Ignore, #PB_Ignore)
   SetGadgetText(#eticresult1,"Montant de l'investissement initial")
   SetGadgetText(#eticresult2,"Gain sur investissement")
   ResizeGadget(#eticresult1, #PB_Ignore,y(150),#PB_Ignore, #PB_Ignore)
   ResizeGadget(#result1, #PB_Ignore,y(180),#PB_Ignore, #PB_Ignore)
   ResizeGadget(#eticresult2, #PB_Ignore,y(230),#PB_Ignore, #PB_Ignore)
   ResizeGadget(#result2, #PB_Ignore,y(260),#PB_Ignore, #PB_Ignore)
   For yy = 27 To 30
    HideGadget(yy,0)
   Next
   For yy = 37 To 39
    HideGadget(yy,0)
   Next
   HideGadget(45,0)
   HideGadget(48,0)
  Case 7
   elemorigine()
   SetGadgetText(#etictext1,"Capital initial")
   SetGadgetText(#etictext2,"Taux d'intérêt (%)")
   SetGadgetText(#etictext3,"Nombre annuel de retraits")
   ResizeGadget(#string3, #PB_Ignore,y(270),#PB_Ignore, #PB_Ignore)
   SetGadgetText(#eticresult1,"Montant des retraits")
   ResizeGadget(#eticresult1, #PB_Ignore,y(180),#PB_Ignore, #PB_Ignore)
   ResizeGadget(#result1, #PB_Ignore,y(210),#PB_Ignore, #PB_Ignore) 
   For yy = 27 To 30
    HideGadget(yy,0)
   Next
   For yy = 37 To 39
    HideGadget(yy,0)
   Next
  Case 8
   elemorigine()
   SetGadgetText(#etictext1,"Montant de chaque retrait")
   SetGadgetText(#etictext2,"Taux d'intérêt (%)")
   SetGadgetText(#etictext3,"Nombre annuel de retraits")
   ResizeGadget(#string3, #PB_Ignore,y(270),#PB_Ignore, #PB_Ignore)
   SetGadgetText(#eticresult1,"Capital initial")
   ResizeGadget(#eticresult1, #PB_Ignore,y(180),#PB_Ignore, #PB_Ignore)
   ResizeGadget(#result1, #PB_Ignore,y(210),#PB_Ignore, #PB_Ignore) 
   For yy = 27 To 30
    HideGadget(yy,0)
   Next
   For yy = 37 To 39
    HideGadget(yy,0)
   Next
  Case 9
   elemorigine()
   SetGadgetText(#etictext1,"Capital initial")
   SetGadgetText(#etictext2,"Capital final")
   SetGadgetText(#etictext3,"Nb de période de composition de l'intérêt")
   ResizeGadget(#string3, #PB_Ignore,y(280),#PB_Ignore, #PB_Ignore)
   SetGadgetText(#eticresult1,"Taux d'intérêt nominal")
   ResizeGadget(#eticresult1, #PB_Ignore,y(180),#PB_Ignore, #PB_Ignore)
   ResizeGadget(#result1, #PB_Ignore,y(210),#PB_Ignore, #PB_Ignore) 
   For yy = 27 To 30
    HideGadget(yy,0)
   Next
   For yy = 37 To 39
    HideGadget(yy,0)
   Next
  Case 10
   elemorigine()
   SetGadgetText(#etictext1,"Capital")
   SetGadgetText(#etictext2,"Taux d'intérêt (%)")
   SetGadgetText(#etictext3,"Nombre annuel de remboursement")
   ResizeGadget(#string3, #PB_Ignore,y(280),#PB_Ignore, #PB_Ignore)
   SetGadgetText(#eticresult1,"Montant de chaque remboursement")
   SetGadgetText(#eticresult2,"Total remboursé")
   SetGadgetText(#eticresult3,"Coût du pret")
   ResizeGadget(#eticresult1, #PB_Ignore,y(120),#PB_Ignore, #PB_Ignore)
   ResizeGadget(#result1, #PB_Ignore,y(170),#PB_Ignore, #PB_Ignore)
   ResizeGadget(#eticresult2, #PB_Ignore,y(200),#PB_Ignore, #PB_Ignore)
   ResizeGadget(#result2, #PB_Ignore,y(230),#PB_Ignore, #PB_Ignore)
   For yy = 27 To 30
    HideGadget(yy,0)
   Next
   For yy = 37 To 39
    HideGadget(yy,0)
   Next
   For yy = 45 To 46
    HideGadget(yy,0)
   Next
   For yy = 48 To 49
    HideGadget(yy,0)
  Next
  Case 11
   elemorigine()
   HideGadget(#string2,1)
   SetGadgetText(#etictext1,"Première remise")
   ResizeGadget(#etictext1, #PB_Ignore,GadgetY(#etictext1) + 50,#PB_Ignore, #PB_Ignore)
   ResizeGadget(#string1, #PB_Ignore,GadgetY(#string1) + 50,#PB_Ignore, #PB_Ignore)
   ResizeGadget(#string2, #PB_Ignore,y(185),#PB_Ignore, #PB_Ignore)
   SetGadgetText(#etictext2,"Seconde remise")
   ResizeGadget(#etictext2, #PB_Ignore,GadgetY(#etictext2) + 48,#PB_Ignore, #PB_Ignore)
   ResizeGadget(#string2, #PB_Ignore,GadgetY(#string2) + 58,#PB_Ignore, #PB_Ignore)
   SetGadgetText(#etictext3,"Troisième remise")
   ResizeGadget(#etictext3, #PB_Ignore,GadgetY(#etictext3) + 43,#PB_Ignore, #PB_Ignore)
   ResizeGadget(#string3, #PB_Ignore,GadgetY(#string3) + 50,#PB_Ignore, #PB_Ignore)
   SetGadgetText(#eticresult1,"Remise globale")
   ResizeGadget(#eticresult1, #PB_Ignore,y(180),#PB_Ignore, #PB_Ignore)
   ResizeGadget(#result1, #PB_Ignore,y(210),#PB_Ignore, #PB_Ignore) 
   HideGadget(#string2,0)
   HideGadget(#etictext3,0)
   HideGadget(#string3,0)
  Case 12
   elemorigine()
   HideGadget(#string2,1)
   SetGadgetText(#etictext1,"Prix d'achat")
   ResizeGadget(#etictext1, #PB_Ignore,GadgetY(#etictext1) + 50,#PB_Ignore, #PB_Ignore)
   ResizeGadget(#string1, #PB_Ignore,GadgetY(#string1) + 50,#PB_Ignore, #PB_Ignore)
   SetGadgetText(#etictext2,"Prix de vente")
   ResizeGadget(#etictext2, #PB_Ignore,GadgetY(#etictext2) + 58,#PB_Ignore, #PB_Ignore)
   ResizeGadget(#string2, #PB_Ignore,GadgetY(#string2) + 58,#PB_Ignore, #PB_Ignore)
   SetGadgetText(#eticresult1,"Taux de bénéfice")
   SetGadgetText(#eticresult2,"Montant du bénéfice")
   ResizeGadget(#eticresult1, #PB_Ignore,y(150),#PB_Ignore, #PB_Ignore)
   ResizeGadget(#result1, #PB_Ignore,y(180),#PB_Ignore, #PB_Ignore)
   ResizeGadget(#eticresult2, #PB_Ignore,y(230),#PB_Ignore, #PB_Ignore)
   ResizeGadget(#result2, #PB_Ignore,y(260),#PB_Ignore, #PB_Ignore)
   HideGadget(#string2,0)
   HideGadget(45,0)
   HideGadget(48,0)
  Case 13
   elemorigine()
   HideGadget(#string2,1)
   SetGadgetText(#etictext1,"Première valeur")
   ResizeGadget(#etictext1, #PB_Ignore,GadgetY(#etictext1) + 50,#PB_Ignore, #PB_Ignore)
   ResizeGadget(#string1, #PB_Ignore,GadgetY(#string1) + 50,#PB_Ignore, #PB_Ignore)
   SetGadgetText(#etictext2,"Seconde valeur")
   ResizeGadget(#etictext2, #PB_Ignore,GadgetY(#etictext2) + 58,#PB_Ignore, #PB_Ignore)
   ResizeGadget(#string2, #PB_Ignore,GadgetY(#string2) + 58,#PB_Ignore, #PB_Ignore) 
   SetGadgetText(#eticresult1,"Valeur moyenne")
   ResizeGadget(#eticresult1, #PB_Ignore,y(180),#PB_Ignore, #PB_Ignore)
   ResizeGadget(#result1, #PB_Ignore,y(210),#PB_Ignore, #PB_Ignore) 
   HideGadget(#string2,0)
  Case 14
   elemorigine()
   HideGadget(#string2,1)
   SetGadgetText(#etictext1,"Prix toutes taxes")
   ResizeGadget(#etictext1, #PB_Ignore,GadgetY(#etictext1) + 50,#PB_Ignore, #PB_Ignore)
   ResizeGadget(#string1, #PB_Ignore,GadgetY(#string1) + 50,#PB_Ignore, #PB_Ignore)
   SetGadgetText(#etictext2,"Taux de taxe (%)")
   ResizeGadget(#etictext2, #PB_Ignore,GadgetY(#etictext2) + 58,#PB_Ignore, #PB_Ignore)
   ResizeGadget(#string2, #PB_Ignore,GadgetY(#string2) + 58,#PB_Ignore, #PB_Ignore) 
   SetGadgetText(#eticresult1,"Prix hors taxe")
   SetGadgetText(#eticresult2,"Montant de la taxe")
   ResizeGadget(#eticresult1, #PB_Ignore,y(150),#PB_Ignore, #PB_Ignore)
   ResizeGadget(#result1, #PB_Ignore,y(180),#PB_Ignore, #PB_Ignore)
   ResizeGadget(#eticresult2, #PB_Ignore,y(230),#PB_Ignore, #PB_Ignore)
   ResizeGadget(#result2, #PB_Ignore,y(260),#PB_Ignore, #PB_Ignore)
   HideGadget(#string2,0)
   HideGadget(45,0)
   HideGadget(48,0)  
  Case 15
   elemorigine()
   HideGadget(#string2,1)
   SetGadgetText(#etictext1,"Prix hors taxe")
   ResizeGadget(#etictext1, #PB_Ignore,GadgetY(#etictext1) + 50,#PB_Ignore, #PB_Ignore)
   ResizeGadget(#string1, #PB_Ignore,GadgetY(#string1) + 50,#PB_Ignore, #PB_Ignore)
   SetGadgetText(#etictext2,"Taux de taxe (%)")
   ResizeGadget(#etictext2, #PB_Ignore,GadgetY(#etictext2) + 58,#PB_Ignore, #PB_Ignore)
   ResizeGadget(#string2, #PB_Ignore,GadgetY(#string2) + 58,#PB_Ignore, #PB_Ignore) 
   SetGadgetText(#eticresult1,"Prix toutes  taxes")
   SetGadgetText(#eticresult2,"Montant de la taxe")
   ResizeGadget(#eticresult1, #PB_Ignore,y(150),#PB_Ignore, #PB_Ignore)
   ResizeGadget(#result1, #PB_Ignore,y(180),#PB_Ignore, #PB_Ignore)
   ResizeGadget(#eticresult2, #PB_Ignore,y(230),#PB_Ignore, #PB_Ignore)
   ResizeGadget(#result2, #PB_Ignore,y(260),#PB_Ignore, #PB_Ignore)
   HideGadget(#string2,0)
   HideGadget(45,0)
   HideGadget(48,0)   
 EndSelect
EndProcedure

Procedure disString(gadgetactiv)
 Select gadgetactiv
  Case 35
   SetActiveGadget(36)
  Case 36
   If GetGadgetState(#coch_10)=1 Or GetGadgetState(#coch_11)=1 Or GetGadgetState(#coch_12)=1 Or GetGadgetState(#coch_13)=1
    SetActiveGadget(35)
   Else
    SetActiveGadget(37)
   EndIf 
  Case 37
   If GetGadgetState(#coch_9)=1
     SetActiveGadget(35)
   Else
     SetActiveGadget(38)
   EndIf 
  Case 38
    SetActiveGadget(39)
  Case 39
   SetActiveGadget(35) 
 EndSelect  
EndProcedure

Procedure fininfos()
AddWindowTimer(#fencal,#timer1, 2500)
Repeat 
 Event = WaitWindowEvent()
  If Event = #PB_Event_Timer And EventTimer() = #timer1
    SetGadgetText(#textinfos,"")
  EndIf
 Until Event = #PB_Event_Timer And EventTimer() = #timer1 
RemoveWindowTimer(#fencal,#timer1) 
EndProcedure

Procedure.l calcul()
;///////////////// Pour ne pas faire un calcul avec un string vide\\\\\\\\\\\\\\\\\
For x = 3 To 10
 If GetGadgetState(x) = 1
  For y = 35 To 38
   If GetGadgetText(y) = "" Or GetGadgetText(y) = "0"
    SetGadgetText(#textinfos,"Il manque un ou plusieurs éléments")
    fininfos()
    SetActiveGadget(y)
    ProcedureReturn 0
   EndIf 
  Next 
 EndIf
Next
If GetGadgetState(11) = 1
 For y = 35 To 36
   If GetGadgetText(y) = "" Or GetGadgetText(y) = "0"
    SetGadgetText(#textinfos,"Il manque un ou plusieurs éléments")
    fininfos()
    SetActiveGadget(y)
    ProcedureReturn 0
   EndIf 
  Next 
 EndIf
For z = 12 To 15
 If GetGadgetState(z) = 1
  For y = 35 To 36
   If GetGadgetText(y) = "" Or GetGadgetText(y) = "0"
    SetGadgetText(#textinfos,"Il manque un ou plusieurs éléments")
    fininfos()
    SetActiveGadget(y)
    ProcedureReturn 0
   EndIf 
  Next 
 EndIf
Next 
;///////////////////////////////////////////////////////////////////////////////
;///////////// calcul année/mois \\\\\\\\\\\\\\
For x = 3 To 10
 If GetGadgetState(x) = 1
 a.F = ValF(GetGadgetText(38)) ;nb année
 m.F = ValF(GetGadgetText(39)) ;nb mois
 an.F = (12 * a + m) / 12
 EndIf
Next 
;////////////////// Valeur future d'un investissement \\\\\\\\\\\\\\\\\\\\\\\\\\
i.F =0:res.F = 0
If GetGadgetState(3) = 1
 p.F = ValF(GetGadgetText(#string1)) ;invest initial
 ic.F = ValF(GetGadgetText(#string2)) ;taux d'intérêt
 n.F = ValF(GetGadgetText(#string3)) ;nb de période
 i.F = ic.F / n.F / 100
 res.F = p.F *  Pow((1 + i.F),(n.f * an.F))
 SetGadgetText(#result1, StrF(res.F,2)+".€")
 res2.F = res.F - p.F
 SetGadgetText(#result2, StrF(res2.F,2)+".€")
EndIf
;////////////////// Valeur future d'une série de dépots réguliers \\\\\\\\\\\\\\\\\\\\\\\\\\
If GetGadgetState(4) = 1
 p.F = ValF(GetGadgetText(#string1)) ;Montant des dépots
 ic.F = ValF(GetGadgetText(#string2)) ;taux d'intérêt
 n.F = ValF(GetGadgetText(#string3)) ;nb de dépots/an
 i.F = ic.F / n.F / 100
 res.F = p.F *  (Pow((1 + i.F),(n.f * an.F))-1)/i.F
 capinvest.F = p.f * n.F * an.F
 SetGadgetText(#result1, StrF(res.F,2)+".€")
 SetGadgetText(#result2, StrF(capinvest.F,2)+".€")
 res2.F = res.F - capinvest.F
 SetGadgetText(#result3, StrF(res2.F,2)+".€")
EndIf
;////////////////// Montant des dépots réguliers pour une valeur future\\\\\\\\\\\\\\\\\\\\\\\\\\
If GetGadgetState(5) = 1
 p.F = ValF(GetGadgetText(#string1)) ;valeur future
 ic.F = ValF(GetGadgetText(#string2)) ;taux d'intérêt
 n.F = ValF(GetGadgetText(#string3)) ;nb de dépots/an
 i.F = ic.F / n.F / 100
 res.F = p.F * i.F / (Pow((1 + i.F),(n.f * an.F))-1)
 capinvest.F = res.F * n.F * an.F
 SetGadgetText(#result1, StrF(res.F,2)+".€")
 SetGadgetText(#result2, StrF(capinvest.F,2)+".€")
 res2.F = p.F - capinvest.F
 SetGadgetText(#result3, StrF(res2.F,2)+".€")
EndIf
;////////////////// investissement initial pour une valeur future \\\\\\\\\\\\\\\\\\\\\\\\\\
If GetGadgetState(6) = 1
 p.F = ValF(GetGadgetText(#string1)) ;valeur future
 ic.F = ValF(GetGadgetText(#string2)) ;taux d'intérêt
 n.F = ValF(GetGadgetText(#string3)) ;nb de période
 i.F = ic.F / n.F / 100
 res.F = p.F/Pow((1 + i.F),(n.f * an.F))
 res2.F = p.F - res.F
 SetGadgetText(#result1, StrF(res.F,2)+".€")
 SetGadgetText(#result2, StrF(res2.F,2)+".€")
EndIf
;////////////////// Retrait régulier d'un capital \\\\\\\\\\\\\\\\\\\\\\\\\\
If GetGadgetState(7) = 1
 p.F = ValF(GetGadgetText(#string1)) ;Capital initial
 ic.F = ValF(GetGadgetText(#string2)) ;taux d'intérêt
 n.F = ValF(GetGadgetText(#string3)) ;nb annuel de retrait
 i.F = ic.F / n.F / 100
 res.F = p.F * (i.F / (Pow((1 + i.F),(n.f * an.F))-1)+ i.F)
 SetGadgetText(#result1, StrF(res.F,2)+".€")
EndIf 
;////////////////// Capital nécéssaire pour des retraits réguliers \\\\\\\\\\\\\\\\\\\\\\\\\\
If GetGadgetState(8) = 1
 p.F = ValF(GetGadgetText(#string1)) ;montant de chaque retrait
 ic.F = ValF(GetGadgetText(#string2)) ;taux d'intérêt
 n.F = ValF(GetGadgetText(#string3)) ;nb annuel de retrait
 i.F = ic.F /100
 res.F = ((p.F * n.F)/i.F) * (1 - (1 /Pow((1 + i.F/n.f),(n.f * an.F))))
 SetGadgetText(#result1, StrF(res.F,2)+".€")
EndIf
;////////////////// Taux d'intérêt nominal servi sur un capital \\\\\\\\\\\\\\\\\\\\\\\\\\  
If GetGadgetState(9) = 1
 p.F = ValF(GetGadgetText(#string1)) ;capital initial
 t.F = ValF(GetGadgetText(#string2)) ;capital futur
 n.F = ValF(GetGadgetText(#string3)) ;nb annuel de compos de l'intérêt
 res.F = n.F * (Pow((t.F / p.F),1 / (n.F * an.F))-1) *100
 SetGadgetText(#result1, StrF(res.F,2)+" %")
EndIf
;////////////////// Remboursement régulier sur un pret \\\\\\\\\\\\\\\\\\\\\\\\\\
If GetGadgetState(10) = 1 
 p.F = ValF(GetGadgetText(#string1)) ;capital
 ic.F = ValF(GetGadgetText(#string2)) ;taux d'intérêt
 n.F = ValF(GetGadgetText(#string3)) ;nb de dépots/an
 res.F = ((ic.F / 100) * p.F/n.F) / (1-1/ Pow(((ic.F / 100) / n.F + 1),(n.F * an.F))) 
 SetGadgetText(#result1, StrF(res.F,2)+".€")
 caprmb.F = res.F * n.F * an.F
 SetGadgetText(#result2, StrF(caprmb.F,2)+".€")
 res2.F = caprmb.F - p.F
 SetGadgetText(#result3, StrF(res2.F,2)+".€")
EndIf
;////////////////// Remises aditionnelles \\\\\\\\\\\\\\\\\\\\\\\\\\
If GetGadgetState(11) = 1 
 p.F = ValF(GetGadgetText(#string1)) ;remise1
 ic.F = ValF(GetGadgetText(#string2)) ;remise2
 n.F = ValF(GetGadgetText(#string3)) ;remise3
 r1.F = (100 * p.F) / 100
 r2.F = ((100 - r1.F) * ic.F) / 100
 r3.F = ((100 - r1.F - r2.F) * n.F) / 100
 res.F = r1.F + r2.F + r3.F
 SetGadgetText(#result1, StrF(res.F,2)+".%")
EndIf
;////////////////// Bénéfice \\\\\\\\\\\\\\\\\\\\\\\\\\ 
If GetGadgetState(12) = 1 
 p.F = ValF(GetGadgetText(#string1)) ;PA
 ic.F = ValF(GetGadgetText(#string2)) ;PV
 If ic.F < p.F 
  SetGadgetText(#textinfos,"Anomalie dans les éléments de calcul ?")
  fininfos()
  SetActiveGadget(#string2)
 EndIf 
 res.F = ((ic.F - p.F) / p.F) * 100
 SetGadgetText(#result1, StrF(res.F,2)+".%")
 res2.F = ic.F - p.F
 SetGadgetText(#result2, StrF(res2.F,2)+".€")
EndIf
;////////////////// Valeur moyenne \\\\\\\\\\\\\\\\\\\\\\\\\\
If GetGadgetState(13) = 1 
 p.F = ValF(GetGadgetText(#string1)) ;valeur 1
 ic.F = ValF(GetGadgetText(#string2)) ;valeur 2
 res.F = (P.F + IC.F)/2
 SetGadgetText(#result1, StrF(res.F,2)+".€")
EndIf
;////////////////// recherche du prix hors taxe \\\\\\\\\\\\\\\\\\\\\\\\\\
If GetGadgetState(14) = 1
 p.F = ValF(GetGadgetText(#string1)) ;Prix tous taxes
 ic.F = ValF(GetGadgetText(#string2)) ;taux de taxe
 res.F = p.F / (1 + (ic.F / 100))
 SetGadgetText(#result1, StrF(res.F,2)+".€")
 res2.F = p.F - res.F
 SetGadgetText(#result2, StrF(res2.F,2)+".€")
EndIf
;////////////////// Calcul du prix toutes taxes comprises \\\\\\\\\\\\\\\\\\\\\\\\\\ 
If GetGadgetState(15) = 1
 p.F = ValF(GetGadgetText(#string1)) ;Prix hord taxe
 ic.F = ValF(GetGadgetText(#string2)) ;taux de taxe
 res.F = p.F * (1 + (ic.F / 100))
 SetGadgetText(#result1, StrF(res.F,2)+".€")
 res2.F = res.F - P.F
  SetGadgetText(#result2, StrF(res2.F,2)+".€")
EndIf 
EndProcedure

MLD_openfen(#fencal,600,200,1000,450,"Ma Fenêtre",#PB_Window_BorderLess , #PB_Window_Invisible , #PB_Window_ScreenCentered,0,0)
SetClassLongPtr_(WindowID(#fencal),#GCL_STYLE,$00020000)
HideWindow(#fencal,0)
StickyWindow(#fencal,1)
Handle = WindowID (#fencal)
SetWindowColor(#fencal ,$C1E2E8)
SetWindowCallback(@Colorcoh()) 
AddKeyboardShortcut(#fencal, #PB_Shortcut_Return, 0) ; menu  pour traitement du clavier dans les string gadgjet 
N$ = "    CALCULS FINANCIERS "
For x = 1 To Len(N$)
 L$ = L$ + Mid(N$,x,1) + Chr(10) 
Next  
MLD_TextGadget(52,0,0,30,450,L$,#PB_Text_Center,0,0,0)
SetGadgetColor(52,#PB_Gadget_BackColor,$FF0000)
SetGadgetColor(52,#PB_Gadget_FrontColor,$FFFFFF)
MLD_CheckBoxGadget(#coch_1,100,105,320,20,"Valeur future d'un investissement",0,0,0,0) 
MLD_CheckBoxGadget(#coch_2,100,125,320,20,"Valeur future d'une série de dépots réguliers",0,0,0,0) 
MLD_CheckBoxGadget(#coch_3,100,145,350,20,"Montant des dépots réguliers pour une valeur future",0,0,0,0) 
MLD_CheckBoxGadget(#coch_4,100,165,320,20,"investissement initial pour une valeur future",0,0,0,0) 
MLD_CheckBoxGadget(#coch_5,100,185,320,20,"Retrait régulier d'un capital",0,0,0,0) 
MLD_CheckBoxGadget(#coch_6,100,205,320,20,"Capital nécéssaire pour des retraits réguliers",0,0,0,0) 
MLD_CheckBoxGadget(#coch_7,100,225,320,20,"Taux d'intérêt nominal servi sur un capital",0,0,0,0) 
MLD_CheckBoxGadget(#coch_8,100,245,320,20,"Remboursement régulier sur un prêt",0,0,0,0) 
MLD_CheckBoxGadget(#coch_9,100,265,320,20,"(Commercial) Remises aditionnelles",0,0,0,0) 
MLD_CheckBoxGadget(#coch_10,100,285,320,20,"(Commercial) Bénéfice",0,0,0,0) 
MLD_CheckBoxGadget(#coch_11,100,305,320,20,"(Commercial) Valeur moyenne",0,0,0,0) 
MLD_CheckBoxGadget(#coch_12,100,325,320,20,"(Commercial) Recherche du prix hors taxe",0,0,0,0) 
MLD_CheckBoxGadget(#coch_13,100,345,350,20,"(Commercial) Calcul du prix toutes taxes comprises",0,0,0,0) 
For zz = 3 To 15 
  SetGadgetFont(zz,FontID3);*************************
Next
trait3dv(#trait1,470,2,85,449 ,Handle)
trait3dv(#trait2,473,2,85,449 ,Handle)
trait3dv(#trait3,476,2,85,449 ,Handle)
trait3dv(#trait4,745,2,85,449,Handle)
trait3dv(#trait5,748,2,85,449,Handle)
trait3dv(#trait6,751,2,85,449,Handle)
MLD_TextGadget(22,150,50,200,25,"FONCTIONS",#PB_Text_Center,0,0,0)
MLD_TextGadget(23,490,50,240,25,"ELEMENTS DE CALCUL",#PB_Text_Center,0,0,0)
MLD_TextGadget(24,775,50,200,25,"RESULTATS",#PB_Text_Center,0,0,0)
For xy = 22 To 24
  SetGadgetFont(xy,FontID4)
  SetGadgetColor(xy,#PB_Gadget_BackColor,$C1E2E8)
  SetGadgetColor(xy,#PB_Gadget_FrontColor,$CD0000) 
Next  
MLD_TextGadget(#etictext1,510,100,200,20,"",#PB_Text_Center,0,0,0)
MLD_TextGadget(#etictext2,510,160,200,20,"",#PB_Text_Center,0,0,0)
MLD_TextGadget(#etictext3,510,240,200,35,"",#PB_Text_Center,0,0,0)
MLD_TextGadget(#etictext4,590,320,40,20,"Durée",#PB_Text_Center,0,0,0)
MLD_TextGadget(#etictext5,520,350,100,20,"Année(s)",#PB_Text_Center,0,0,0)
MLD_TextGadget(#etictext6,608,350,100,20,"Mois",#PB_Text_Center,0,0,0)
For xx = 25 To 30
  SetGadgetColor(xx,#PB_Gadget_BackColor,$C1E2E8)
  SetGadgetColor(xx,#PB_Gadget_FrontColor,$2F6B55) 
Next
MLD_StringGadget(#string1,560,125,100,22,"0",#ES_CENTER,#PB_String_BorderLess,0,0)
MLD_StringGadget(#string2,560,195,100,22,"0",#ES_CENTER,#PB_String_BorderLess,0,0)
MLD_StringGadget(#string3,560,280,100,22,"0",#ES_CENTER,#PB_String_BorderLess,0,0)
MLD_SpinGadget(38,540,370,60,30,0,99,#PB_Spin_ReadOnly,#PB_Spin_Numeric,0,0)
SetGadgetState(38,0)
SetGadgetColor(38,#PB_Gadget_BackColor,$CBEFCB) 
MLD_SpinGadget(39,625,370,60,30,0,12,#PB_Spin_ReadOnly,#PB_Spin_Numeric,0,0)
SetGadgetColor(39,#PB_Gadget_BackColor,$CBEFCB) 
SetGadgetState(39,0)
For xx = 35 To 37
  SetGadgetColor(xx,#PB_Gadget_BackColor,$C1E2E8)
Next
;MLD_ButtonImageGadget(#btstop,925, 380,55, 55,207,0,0,0,0)
MLD_ButtonGadget((#btstop,925, 380,55, 55,"Stop",0,0,0,0
ToolTipMic(#fencal,#btstop, "Arret des calculs financiers",$F9F9D5) 
;MLD_ButtonImageGadget(#btcalcul,871,380,55,55,208,0,0,0,0)
MLD_ButtonGadget(#btcalcul,871,380,55,55,Calcul,0,0,0,0)
ToolTipMic(#fencal,#btcalcul, "Calculs",$F9F9D5)
;MLD_ButtonImageGadget(#bteff,817,380,55, 55,209,0,0,0,0)
MLD_ButtonGadget(#bteff,817,380,55, 55,"Eff",0,0,0,0)
ToolTipMic(#fencal,#bteff, "Efface les éléments de calcul",$F9F9D5)
MLD_TextGadget(#eticresult1,755, 120, 240, 40,"",#PB_Text_Center,0,0,0)
MLD_TextGadget(#eticresult2,755, 200, 240, 20,"",#PB_Text_Center,0,0,0)
MLD_TextGadget(#eticresult3,755, 260, 240, 20,"",#PB_Text_Center,0,0,0)
MLD_TextGadget(#result1,755, 170, 240, 20,"0.€",#PB_Text_Center,0,0,0)
MLD_TextGadget(#result2,755, 230, 240, 20,"0.€",#PB_Text_Center,0,0,0)
MLD_TextGadget(#result3,755, 290, 240, 20,"0.€",#PB_Text_Center,0,0,0)
For xx = 44 To 49
  SetGadgetColor(xx,#PB_Gadget_BackColor,$C1E2E8)
Next
For xx = 47 To 49
  SetGadgetColor(xx,#PB_Gadget_FrontColor,$551077)
Next
MLD_TextGadget(#textinfos,480,420,260,20,"",#PB_Text_Center,0,0,0)
SetGadgetColor(51,#PB_Gadget_FrontColor,$0906BF)
SetGadgetColor(51,#PB_Gadget_BackColor,$C1E2E8)
;/////////// Taches préliminaires \\\\\\\\\\\\\\\\\\
razcoche(3)
SetGadgetState(#coch_1, #PB_Checkbox_Checked)
SetActiveGadget(#string1)
;/////////////////////\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\
Repeat
  Event = WaitWindowEvent()
   If Event = #WM_LBUTTONDOWN
      SendMessage_(WindowID(#fencal), #WM_NCLBUTTONDOWN, #HTCAPTION, 0) 
   EndIf 
   If Event = #PB_Event_Menu 
      Select EventMenu()
       Case 0
         disString(GetActiveGadget())
      EndSelect
   EndIf
   Select EventGadget()
    Case #coch_1
      razcoche(#coch_1)
      SetGadgetState(#coch_1, #PB_Checkbox_Checked)
      SetActiveGadget(#string1)
    Case #coch_2
      razcoche(#coch_2)
      SetGadgetState(#coch_2, #PB_Checkbox_Checked)
      SetActiveGadget(#string1)
    Case #coch_3
      razcoche(#coch_3)
      SetGadgetState(#coch_3, #PB_Checkbox_Checked)
      SetActiveGadget(#string1)
    Case #coch_4
      razcoche(#coch_4)
      SetGadgetState(#coch_4, #PB_Checkbox_Checked)
      SetActiveGadget(#string1) 
    Case #coch_5
      razcoche(#coch_5)
      SetGadgetState(#coch_5, #PB_Checkbox_Checked)
      SetActiveGadget(#string1)
    Case #coch_6
      razcoche(#coch_6)
      SetGadgetState(#coch_6, #PB_Checkbox_Checked)
      SetActiveGadget(#string1)
    Case #coch_7
      razcoche(#coch_7)
      SetGadgetState(#coch_7, #PB_Checkbox_Checked)
      SetActiveGadget(#string1)
    Case #coch_8
      razcoche(#coch_8)
      SetGadgetState(#coch_8, #PB_Checkbox_Checked)
      SetActiveGadget(#string1)
    Case #coch_9
      razcoche(#coch_9)
      SetGadgetState(#coch_9, #PB_Checkbox_Checked)
      SetActiveGadget(#string1)
    Case #coch_10
      razcoche(#coch_10)
      SetGadgetState(#coch_10, #PB_Checkbox_Checked)
      SetActiveGadget(#string1)
    Case #coch_11
      razcoche(#coch_11)
      SetGadgetState(#coch_11, #PB_Checkbox_Checked)
      SetActiveGadget(#string1)
    Case #coch_12
      razcoche(#coch_12)
      SetGadgetState(#coch_12, #PB_Checkbox_Checked)
      SetActiveGadget(#string1)   
    Case #coch_13
      razcoche(#coch_13)
      SetGadgetState(#coch_13, #PB_Checkbox_Checked)
      SetActiveGadget(#string1)                             
    Case #string1
      Select EventType()
        Case #PB_EventType_Focus 
          SetGadgetColor(#string1,#PB_Gadget_BackColor,$CBEFCB)
          If GetGadgetText(#string1) = "0" : SetGadgetText(#string1,""):EndIf 
        Case #PB_EventType_LostFocus
          SetGadgetColor(#string1,#PB_Gadget_BackColor,$C1E2E8)
          If GetGadgetText(#string1) = "" : SetGadgetText(#string1,"0"):EndIf 
      EndSelect    
      String_NumericD(#string1)
    Case #string2
      Select EventType()
        Case #PB_EventType_Focus 
          SetGadgetColor(#string2,#PB_Gadget_BackColor,$CBEFCB) 
          If GetGadgetText(#string2) = "0" : SetGadgetText(#string2,""):EndIf 
        Case #PB_EventType_LostFocus
          SetGadgetColor(#string2,#PB_Gadget_BackColor,$C1E2E8)
          If GetGadgetText(#string2) = "" : SetGadgetText(#string2,"0"):EndIf 
      EndSelect    
      String_NumericD(#string2)
    Case #string3
      Select EventType()
        Case #PB_EventType_Focus 
          SetGadgetColor(#string3,#PB_Gadget_BackColor,$CBEFCB)
          If GetGadgetText(#string3) = "0" : SetGadgetText(#string3,""):EndIf 
        Case #PB_EventType_LostFocus
          SetGadgetColor(#string3,#PB_Gadget_BackColor,$C1E2E8)
          If GetGadgetText(#string3) = "" : SetGadgetText(#string3,"0"):EndIf 
      EndSelect   
      String_NumericD(#string3)
    
    Case #btcalcul
      calcul()
    Case #bteff
     For xx = 35 To 37
       SetGadgetText(xx,"0")
     Next
     SetGadgetState(38,0)
     SetGadgetState(39,0)
     For xx = 47 To 49
       SetGadgetText(xx,"0.€")
     Next
     SetActiveGadget(#string1)
    Case #btstop
      CloseWindow(#fencal)
      DeleteObject_(GadgetBkg)
      End 
   EndSelect
ForEver

Code : Tout sélectionner

;**********************
;MLD le 03/03/2014
;PB 5.22 LTS X86
;Standard Interface Graphique
;Droits réservés 
;**********************

#Ldef = 1920:#Hdef = 1080 :#Corf = 12

Global definecrlarg.d = GetSystemMetrics_(#SM_CXSCREEN)
Global definecrht.d = GetSystemMetrics_(#SM_CYSCREEN)
Global typH.b
Global St
Global L.d,Hwq.d
hdc = GetDC_(GetDesktopWindow_())
If hdc : dpiX.d = GetDeviceCaps_(hdc, #LOGPIXELSX) :EndIf
If hdc : Global dpiY.d = GetDeviceCaps_(hdc, #LOGPIXELSY) : ReleaseDC_(GetDesktopWindow_(), hdc) : EndIf
Global mmx.d = (dpiX / 2.54)/10
Global mmy.d = (dpiY / 2.54)/10
  If definecrht.d = #Hdef And dpiY.d = 96
    dft.w = #Corf
    Global FontID0 = LoadFont(0, "Arial",dft.w,#PB_Font_HighQuality)
  Else
    dft.W = (#Corf / (#Hdef/definecrht.d)-1)
    ;If dft.W < 7 : dft.W = 7:EndIf
    Global FontID0 = LoadFont(0, "Microsoft Sans Serif",dft.w,#PB_Font_HighQuality)
  EndIf  
  SetGadgetFont(#PB_Default, FontID(0))

#LVM_GETHEADER = #LVM_FIRST + 31 ;Hauteur du header des listIcon
Global oldproc.l, newheight.l 
Procedure.l WinProc(hWnd.l, Msg.l, wParam.l, lParam.l) 
    result.l = 0 
    If Msg = #HDM_LAYOUT 
        result = CallWindowProc_(oldproc, hWnd, Msg, wParam, lParam) 
        *hdlayout.HD_LAYOUT = lParam 
        If *hdlayout\prc <> 0 
            *rect.RECT = *hdlayout\prc 
            *rect\top = newheight 
        EndIf 
        If *hdlayout\pwpos <> 0 
            *windowpos.WINDOWPOS = *hdlayout\pwpos 
            *windowpos\cy = newheight 
        EndIf 
    Else 
        result = CallWindowProc_(oldproc, hWnd, Msg, wParam, lParam) 
    EndIf 
    ProcedureReturn result 
  EndProcedure 
  
Procedure Ywp(y.d)
Select y.d
  Case 0
   ProcedureReturn 0 ;en haut de l'écran
 Default
  If definecrht.d = #Hdef
   ProcedureReturn y.d 
  Else
   ProcedureReturn y.d * (definecrht /#Hdef)
  EndIf 
EndSelect   
EndProcedure

Procedure Hw(Dh.d,typH.b)
definecrht.d = GetSystemMetrics_(#SM_CYSCREEN)
SystemParametersInfo_(#SPI_GETWORKAREA,0,@DesktopWorkArea.RECT,0)
htTaskbarwin.d = definecrht.d - DesktopWorkArea\Bottom
OpenWindow(2000,0,0,200,200,"",#PB_Window_SystemMenu|#PB_Window_Invisible)
If OSVersion() = #PB_OS_Windows_XP
 EPframeH.d = WindowX(2000, #PB_Window_InnerCoordinate)
 EPframeL.d = WindowX(2000, #PB_Window_InnerCoordinate)
Else
 EPframeH.d = (WindowX(2000, #PB_Window_InnerCoordinate)*3)
 EPframeL.d = WindowX(2000, #PB_Window_InnerCoordinate)  
EndIf  
Httitre.d = WindowY(2000, #PB_Window_InnerCoordinate)
CloseWindow(2000)
Select typH.b
 Case 1 ;fen avec titre et haut max
  If St = 0  
   Hwq.d = definecrht - (Httitre.d + EPframeH) 
   ProcedureReturn Hwq.d
  Else ; fen sans titre et hauteur max
   Hwq.d = definecrht
   ProcedureReturn Hwq.d 
  EndIf 
 Case 2 ;fen avec titre et barre de tache win visible
  If St = 0   
   Hwq.d = definecrht - (htTaskbarwin  + Httitre.d  + EPframeH)
   ProcedureReturn hwq.d 
  Else  ; fen sans titre et barre de tache win visible
   Hwq.d = definecrht - htTaskbarwin 
   ProcedureReturn Hwq.d
  EndIf 
 Default ;fen quelconque
  If Dh = 0:Dh = 1:EndIf
  If definecrht <> #Hdef
   Hwq.d =  Dh * (definecrht /#Hdef)
   ProcedureReturn Hwq.d
  Else
   Hwq.d =  Dh
   ProcedureReturn Hwq.d 
  EndIf  
EndSelect 
EndProcedure

Procedure XWp(lp.d)
Select lp.d
 Case 0
  ProcedureReturn 1 ;a gauche
 Default
  If definecrlarg <> #Ldef
   ProcedureReturn lp.d * (definecrlarg /#Ldef)
  Else
   ProcedureReturn lp.d
  EndIf 
EndSelect 
EndProcedure

Procedure Lw(dL.d)
Select dL.d
 Case 0 
   If St = 0 ;largeur max avec bordure
    L.d = definecrlarg - 10
    ProcedureReturn L.d
   Else ;largeur max sans bordure
    L.d = definecrlarg
    ProcedureReturn L.d
   EndIf 
 Default
  If definecrlarg <> #Ldef
    L.d = dL * (definecrlarg /#Ldef)
    ProcedureReturn L.d
   Else 
     L.d = dL
     ProcedureReturn L.d
   EndIf
EndSelect 
EndProcedure

Procedure MLD_openfen(ng.d,x.d,y.d,Lf.d,H.d,titre$,opt1.l,opt2.l,opt3.l,opt4.l,typH.b)
  If y.d <> 0 :typH.b = 0:EndIf 
  Select #PB_Window_BorderLess
   Case opt1.l,opt2.l,opt3.l,opt4.l
    Global St = 1
   Default
     Global St = 0
     If L.d < 300 And L.d > 0:L.d = 300:EndIf
  EndSelect 
  Select #PB_Window_ScreenCentered 
   Case opt1.l,opt2.l,opt3.l,opt4.l
     typH.b =0
 EndSelect
 If opt1.l = 0 And opt2.l = 0 And opt3.l = 0 And opt4.l = 0; les options ne supporte pas les 0(pas de bouton)
    OpenWindow(ng.d,Xwp(x.d),Ywp(y.d),Lw(Lf.d),Hw(H.d,typH.b),titre$)
 Else  
   OpenWindow(ng.d,Xwp(x.d),Ywp(y.d),Lw(Lf.d),Hw(H.d,typH.b),titre$,opt1.l|opt2.l|opt3.l|opt4.l)
   a.d = Xwp(x.d)
 EndIf 
EndProcedure   

Procedure X(lg.d)
  ProcedureReturn lg *(definecrlarg.d/#Ldef)
EndProcedure

Procedure y(h.d)
  ProcedureReturn h *(definecrht.d /#Hdef) 
EndProcedure 

Procedure MLD_ButtonGadget(numgad.d,x.d,y.d,Gl.d,Gh.d,Text$,Opt1.l,Opt2.l,Opt3.l,Opt4.l)
  ButtonGadget(numgad.d,X(x.d),y(y.d),X(Gl.d),Y(Gh.d),Text$, Opt1|Opt2|Opt3|Opt4) 
EndProcedure

Procedure MLD_ButtonImageGadget(numgad.d,x.d,y.d,Gl.d,Gh.d,img.d,Opt1.l,Opt2.l,Opt3.l,Opt4.l)
  If img.d = 0
    ButtonImageGadget(numgad.d,X(x.d),y(y.d),X(Gl.d),Y(Gh.d),0, Opt1|Opt2|Opt3|Opt4) 
  Else  
    ButtonImageGadget(numgad.d,X(x.d),y(y.d),X(Gl.d),Y(Gh.d),ImageID(img.d), Opt1|Opt2|Opt3|Opt4)
  EndIf
EndProcedure 

Procedure MLD_CheckBoxGadget(numgad.d,x.d,y.d,Gl.d,Gh.d,Text$,Opt1.l,Opt2.l,Opt3.l,Opt4.l)
  CheckBoxGadget(numgad.d,X(x.d),y(y.d),X(Gl.d),Y(Gh.d),Text$, Opt1|Opt2|Opt3|Opt4) 
EndProcedure

Procedure MLD_ContainerGadget(numgad.d,x.d,y.d,Gl.d,Gh.d,Opt1.l,Opt2.l,Opt3.l,Opt4.l)
  ContainerGadget(numgad.d,X(x.d),y(y.d),X(Gl.d),Y(Gh.d),Opt1.l|Opt2.l|Opt3.l|Opt4.l)
EndProcedure

Procedure MLD_EditorGadget(numgad.d,x.d,y.d,Gl.d,Gh.d,Opt1.l,Opt2.l,Opt3.l,Opt4.l)
  EditorGadget(numgad.d,X(x.d),y(y.d),X(Gl.d),Y(Gh.d),Opt1.l|Opt2.l|Opt3.l|Opt4.l)
EndProcedure
 
Procedure MLD_FrameGadget(numgad.d,x.d,y.d,Gl.d,Gh.d,Text$,Opt1.l,Opt2.l,Opt3.l,Opt4.l)
   FrameGadget(numgad.d,X(x.d),y(y.d),X(Gl.d),Y(Gh.d),Text$, Opt1|Opt2|Opt3|Opt4) 
EndProcedure
 
Procedure MLD_HyperLinkGadget(numgad.d,x.d,y.d,Gl.d,Gh.d,Text$,coul.d,Opt1.l,Opt2.l,Opt3.l,Opt4.l)
   HyperLinkGadget(numgad.d,X(x.d),y(y.d),X(Gl.d),Y(Gh.d),Text$,coul.d, Opt1|Opt2|Opt3|Opt4) 
EndProcedure 
 
Procedure MLD_OptionGadget(numgad.d,x.d,y.d,Gl.d,Gh.d,Text$,Opt1.l,Opt2.l,Opt3.l,Opt4.l)
  OptionGadget(numgad.d,X(x.d),y(y.d),X(Gl.d),Y(Gh.d),Text$)
EndProcedure

Procedure MLD_ImageGadget(numgad.d,x.d,y.d,Gl.d,Gh.d,img.d,Opt1.l,Opt2.l,Opt3.l,Opt4.l)
  ImageGadget(numgad.d,X(x.d),y(y.d),X(Gl.d),Y(Gh.d),ImageID(img.d), Opt1|Opt2|Opt3|Opt4) 
EndProcedure 

Procedure MLD_ListViewGadget(numgad.d,x.d,y.d,Gl.d,Gh.d,Opt1.l,Opt2.l,Opt3.l,Opt4.l)
   ListViewGadget(numgad.d,X(x.d),y(y.d),X(Gl.d),Y(Gh.d),Opt1|Opt2|Opt3|Opt4)
EndProcedure
 
Procedure MLD_ListIconGadget(numgad.d,x.d,y.d,Gl.d,Gh.d,Text$,Ltitre,Opt1.l,Opt2.l,Opt3.l,Opt4.l)
  ListIconGadget(numgad.d,X(x.d),y(y.d),X(Gl.d),Y(Gh.d),Text$,X(Ltitre), Opt1|Opt2|Opt3|Opt4)
  header = SendMessage_(GadgetID(numgad.d), #LVM_GETHEADER, 0, 0) 
  oldproc = SetWindowLong_(header, #GWL_WNDPROC, @WinProc()) 
  newheight = y(22);hauteur header 
  SendMessage_(GadgetID(numgad.d),#LVM_SETIMAGELIST,#LVSIL_SMALL,ImageList_Create_(1,x(32) ,#ILC_COLORDDB,0,0));hauteur ligne
EndProcedure

Procedure JustifyColumn(Gadget, Column, FMT)
 Lvc.LVCOLUMN;attention Bug peut devenir LV_COLUMN
 Lvc\Mask = #LVCF_FMT
 Mask = #LVCF_FMT
 Select FMT
  Case 1
   Lvc\FMT = #LVCFMT_CENTER
   FMT = #LVCFMT_CENTER
  Case 2
   Lvc\FMT = #LVCFMT_RIGHT
   FMT = #LVCFMT_RIGHT
 EndSelect
 SendMessage_(GadgetID(Gadget), #LVM_SETCOLUMN, Column, @Lvc)
EndProcedure
    

Procedure.l SetListPos(Gadget.l,Position.l);pour afficher la fin de la liste
 Protected Pos.POINT
 SendMessage_(GadgetID(Gadget),#LVM_GETITEMPOSITION,Position -1,Pos)
 SendMessage_(GadgetID(Gadget),#LVM_SCROLL,0,Pos\y)
EndProcedure

Procedure MLD_PanelGadget(numgad.d,x.d,y.d,Gl.d,Gh.d,Opt1.l,Opt2.l,Opt3.l,Opt4.l)
   PanelGadget(numgad.d,X(x.d),y(y.d),X(Gl.d),Y(Gh.d))
 EndProcedure
 
Procedure MLD_ProgressBarGadget(numgad.d,x.d,y.d,Gl.d,Gh.d,Min.d,Max.d,Opt1.l,Opt2.l,Opt3.l,Opt4.l)
  ProgressBarGadget(numgad.d,X(x.d),y(y.d),X(Gl.d),Y(Gh.d),Min.d,Max.d,Opt1|Opt2|Opt3|Opt4)
EndProcedure

Procedure MLD_SpinGadget(numgad.d,x.d,y.d,Gl.d,Gh.d,Min.d,Max.d,Opt1.l,Opt2.l,Opt3.l,Opt4.l)
  SpinGadget(numgad.d,X(x.d),y(y.d),X(Gl.d),Y(Gh.d),Min.d,Max.d,Opt1|Opt2|Opt3|Opt4)
EndProcedure

Procedure MLD_StringGadget(numgad.d,x.d,y.d,Gl.d,Gh.d,Text$,Opt1.l,Opt2.l,Opt3.l,Opt4.l)
  StringGadget(numgad.d,X(x.d),y(y.d),X(Gl.d),Y(Gh.d),Text$,Opt1|Opt2|Opt3|Opt4)
EndProcedure

Procedure String_NumericD(Gadget)   
If Len(GetGadgetText(Gadget)) <>0 
 SendMessage_(GadgetID(Gadget), #EM_GETSEL, @Debut_Position, @Fin_position)     
  a$ = Mid(GetGadgetText(Gadget),Debut_position,1)
   ValeurASCII = Asc(a$) 
    If ValeurASCII = 46
     Else
     If ValeurASCII <48 Or ValeurASCII > 57  
      y = Debut_Position
      Texte.s = GetGadgetText(Gadget)
      x = Len(Texte)
      If Mid(Texte,y,1) = "," ; modification d'une virgule en point
       Texte2.s = Left(Texte,y -1) + "." + Right(Texte,x-y)
       SetGadgetText(Gadget,Texte2)
       SendMessage_(GadgetID(Gadget), #EM_SETSEL, x + 1, x + 1) 
      Else
       Texte2.s = Left(Texte,y -1) + Right(Texte,x-y)
       SetGadgetText(Gadget,Texte2)
       SendMessage_(GadgetID(Gadget), #EM_SETSEL, x-1, x-1)    
    EndIf 
  EndIf
 EndIf 
EndIf 
EndProcedure

Procedure.s ChangeStringField(chaine$,Index,Delimiteur$,texte$)
nbd.w = 0 : lenG = 0 : lenD = 0
If chaine$ <> ""
 For i.w = 1 To Len(chaine$)
  If Mid(chaine$,i,1) = Delimiteur$
    nbd = nbd + 1
    If nbd = index -1
     lenG = i
    EndIf
    If nbd = Index
     lenDd = i
    EndIf
  EndIf
  lenD = i - lenDd
 Next
 If nbd => Index ;vérif qu'il y a bien le nombre de délimiteur nécéssaire pour l'appel de la fonction
   ProcedureReturn Left(chaine$,lenG) + texte$ + Right(chaine$,lenD+1)
 EndIf
EndIf    
EndProcedure

Procedure GestionCaret(Gadget) ; Gestion du caret dans stringGadget
 SendMessage_(GadgetID(Gadget), #EM_GETSEL, @Debut_Position, @Fin_position)    
 y = Debut_Position
 Texte.s = GetGadgetText(Gadget)
 x =Len(Texte)
 Texte2.s = Left(Texte,y ) + Right(Texte,x-y)
 SendMessage_(GadgetID(Gadget), #EM_SETSEL, x, x) 
EndProcedure

Procedure.s Formatmonnaie(a$)
ReplaceString(a$, ".", ",", #PB_String_InPlace, 1)
i.w=0
For x = Len(a$) To 1 Step -1
 b$ = Mid(a$,x,1)
 i + 1
 If b$ <> "," And i= 3
  c$ =  " " + b$ + c$ 
  i + 1
 Else
  c$ =  b$ + c$
  If b$ = ",": i = 0:EndIf
 EndIf 
 If i > 3 : i = 0: EndIf
Next 
ProcedureReturn c$
EndProcedure 

Procedure mformetele(gadget)
a$ = GetGadgetText(gadget)
 b$ = ""
 inter.l = 0
 For w = 1 To Len(a$)
  valeurascii = Asc(Mid(a$,w,1))
   If valeurascii >= 48 And valeurascii<= 57
     b$ = b$ + Mid(a$,w,1)
      If w <= (Len(a$) -2)
       inter = inter + 1
        If inter = 2
       b$ = b$ + Chr(32)
      inter = 0
     EndIf 
    EndIf 
   EndIf
  Next 
   SetGadgetText(gadget,b$)
EndProcedure
 
Procedure MLD_TextGadget(numgad.d,x.d,y.d,Gl.d,Gh.d,Text$,Opt1.l,Opt2.l,Opt3.l,Opt4.l)
  TextGadget(numgad.d,X(x.d),y(y.d),X(Gl.d),Y(Gh.d),Text$,Opt1|Opt2|Opt3|Opt4)
EndProcedure

Procedure MLD_TrackBarGadget(numgad.d,x.d,y.d,Gl.d,Gh.d,Min.d,Max.d,Opt1.l,Opt2.l,Opt3.l,Opt4.l)
  TrackBarGadget(numgad.d,X(x.d),y(y.d),X(Gl.d),Y(Gh.d),Min.d,Max.d,Opt1|Opt2|Opt3|Opt4)
EndProcedure

Procedure MLD_TreeGadget(numgad.d,x.d,y.d,Gl.d,Gh.d,Opt1.l,Opt2.l,Opt3.l,Opt4.l)
    TreeGadget(numgad.d,X(x.d),y(y.d),X(Gl.d),Y(Gh.d))
EndProcedure
  
Procedure trait3dv(id,x,y,cx,cy,parent)
  Protected style.l
  style = #SS_ETCHEDVERT|#WS_CHILD|#WS_VISIBLE
  CreateWindowEx_(0,"static","",style,X(x),Y(y),X(cx),Y(cy),parent,id,0,0)
EndProcedure

Procedure trait3dh(id,x,y,cx,cy,parent)
  Protected style.l
  style = #SS_ETCHEDHORZ|#WS_CHILD|#WS_VISIBLE
  CreateWindowEx_(0,"static","",style,X(x),Y(y),X(cx),Y(cy),parent,id,0,0)
EndProcedure

; pour Bt image
#BCM_FIRST = $1600
#BCM_SETIMAGELIST = #BCM_FIRST + 2
#BUTTON_IMAGELIST_ALIGN_LEFT = 0
#LVM_GETITEMPOSITION = 4112
#LVM_SCROLL = 4116
OpenLibrary(1,"comctl32.dll")
Prototype ImageList_AddIcon(List,Icon)
Global ImageList_AddIcon.ImageList_AddIcon
ImageList_AddIcon=GetFunction(1,"ImageList_AddIcon")
Structure _BUTTON_IMAGELIST
  himl.l
  margin.RECT
  uAlign.l
EndStructure
Procedure AddIconToButton(ButtonID,IconID,w= 32,h= 32)
  Protected buttonImgList._BUTTON_IMAGELIST
  himlIcons = ImageList_Create_(X(w),Y(h), #ILC_MASK |#ILC_COLOR32, 1, 0)
  ImageList_AddIcon(himlIcons, IconID)
  With buttonImgList
    \uAlign = #BUTTON_IMAGELIST_ALIGN_LEFT
    \margin\top = 3
    \margin\bottom = 3
    \margin\left = 3
    \margin\right = 3
    \himl = himlIcons
  EndWith
  SendMessage_(ButtonID, #BCM_SETIMAGELIST, 0, buttonImgList)  
EndProcedure

Met ces deux codes dans le même dossier.
Bon courage

falsam · Message par **falsam** » dim. 24/août/2014 11:04

Je suppose que le 2eme code doit être sauvegarder sous le nom de SIG+.pbi ?

Ollivier · Message par **Ollivier** » dim. 24/août/2014 12:40

Camomille a écrit :mais comme elle j'ai connu l'antiquité . .

C'est sûr que là tu vas plus t'amuser qu'avec un Sudoku! Surtout si tu aimes les "petits strings"!
Sinon tu as le sujet anglais sur les grands nombres si tu veux pousser la chansonnette dans une gamme plus élevée. Ce qui est intéressant dans ce sujet d'alors, n'est pas la taille des nombres (quoique bien utile en terme de compatibilité à venir) mais les optimisations publiées qui sont un bon départ en terme de performance.

@MLD

Merci pour ces sources. Vivement que je me remette dans le bain pour explorer tout ça.

MLD · Message par **MLD** » dim. 24/août/2014 13:04

@ falsam
yes

PAPIPP · Message par **PAPIPP** » dim. 24/août/2014 17:58

Bonjour Mld
Merci pour ton prg fort intéressant.
je suis arrivé à le faire fonctionner après quelques modifications.

Parenthèses en moins ou en trop.
chaine calcul à mettre entre ""
et mise en commentaire de :
DataSection
; Image6: :IncludeBinary "47.ico"
; Image7: :IncludeBinary "312.ico"
; Image8: :IncludeBinary "378.ico"
EndDataSection

; CatchImage(#img_8, ?Image6);bt stop
; CatchImage(#img_9, ?Image7);bt calcul
; CatchImage(#img_10, ?Image8);bt efface

des icônes qui me manquent pour les boutons mais qui ne sont pas nécessaire.
A+

PureBasic

PureBasicPrint, imprimer vos codes sources en couleur

Re: PureBasicPrint, imprimer vos codes sources en couleur

Re: PureBasicPrint, imprimer vos codes sources en couleur

Re: PureBasicPrint, imprimer vos codes sources en couleur

Re: PureBasicPrint, imprimer vos codes sources en couleur

Re: PureBasicPrint, imprimer vos codes sources en couleur

Re: PureBasicPrint, imprimer vos codes sources en couleur

Re: PureBasicPrint, imprimer vos codes sources en couleur

Re: PureBasicPrint, imprimer vos codes sources en couleur

Re: PureBasicPrint, imprimer vos codes sources en couleur

Re: PureBasicPrint, imprimer vos codes sources en couleur

Re: PureBasicPrint, imprimer vos codes sources en couleur

Re: PureBasicPrint, imprimer vos codes sources en couleur

Re: PureBasicPrint, imprimer vos codes sources en couleur

Re: PureBasicPrint, imprimer vos codes sources en couleur

Re: PureBasicPrint, imprimer vos codes sources en couleur