Géométrie Elémentaire

Programmation d'applications complexes
Avatar de l’utilisateur
kernadec
Messages : 1606
Inscription : ven. 25/avr./2008 11:14

Géométrie Elémentaire

Message par kernadec »

Bonjour
C’est un code en deux partie !
j'ai essayer de faire des commandes utile pour le dessin
mais j'ai rencontrer des problèmes avec statusbar
est aussi releaseDC qui libère pas la mémoire correctement
comme me la recommander .le Soldat Inconnu, mais avec sa méthode
que j'ai testée, j'avais trop de problèmes d'affichage avec la boucle
NewList DrawX d'Ollivier, mais cette boucle a beaucoup de qualités,
je me suis résolu a continuer dans la voie du MakeWinScreenshot,
et puis ce n'est qu'un test, car il me faut maintenant établir une gestion
des objets du dessin dans une base de données

Fonctionne avec PB 5.11

Code : Tout sélectionner

; ######################################################################## 
; Géométrie Elémentaire avec PureBasic (°£°) Kernadec PB440 01/2010      # 
; fonctions géométriques de base pour le dessin 2D                       # 
; ajout d'une fenêtre loupe adaptée de code archive merci Andre          # 
; Sauvegarde des dessins dans le dossier "Mes images"                    # 
; Pour vista mettre à la ligne 31 la variable "vista=1"                  # 
; ######################################################################## 
#CSIDL_MYPICTURES=$27:#E_POINTER2 = $80000005:#E_NOINTERFACE2=$80000004:#E_OUTOFMEMORY2=$80000002 
#IPicture_Release=8:#IPicture_Get_Width=24:#IPicture_Get_Height=28:#IPicture_Render=32 
Global hWindow, pstm.IStream, gpPicture.IPicture,width.l,height.l,hmwidth,hmheight,FileSize,BITMAP.l,coulor.l,click.l 
Define.l hwnd.l,hwnd1.l,wl.l,wh.l,left.l,top.l,right.l,bottom.l,BState.l,iconex.l,iconeY.l,brush.l,polyg.l,click2.l 
Global mx0.l,my0.l,mx1.l,my1.l,mx_0.l,my_0.l,mx_1.l,my_1.l,dessin.l,color.l,Color1.l,style.l,B.l,Epais.l,vista.l 
Global co1.l,co2.l,co3.l,coB1.l,coB2.l,coB3.l,coul1.l,coul2.l,coul3.l,aireco1.l,aireco2.l,aireco3.l,polypt.l 
Global coul1.l,coul2.l,coul3.l,aireco1.l,aireco2.l,aireco3.l,IdCursor.l,angl1.l,angl2.l,font0.l,zl.l,parall.l 
Global xcenter.d,ycenter.d,Radius.d,xRadius.d,yRadius.d,zRad.d,ray.d,ray1.d,ray2.d,raydemiang.d,compteurT.l 
Global AngleStep.d,StartAngle.d,FinishAngle.d,Ang.d,Angd.d,angle.d,anglea.d,angleb.d,lecteur.s,compteur.l 
Global angopa.d,angopc.d,angp.d,angapb.d,angapc.d,angbpc.d,DisplayX.d,DisplayY.d,r.RECT,old.RECT,Colorp.l 
Global xm.d,ym.d,x1.d,y1.d,x2.d,y2.d,x3.d,y3.d,x4.d,y4.d,x5.d,y5.d,dx.d,dy.d,dx1.d,dx2.d,dy1.d,dy2.d,ext$,Ech.l 
Global dx.d,dy.d,dx1.d,dx2.d,dy1.d,dy2.d,pax.d,pay.d,pbx.d,pby.d,pcx.d,pcy.d,ox.d,oy.d,click3.l,extperp.l 
Global Hyp1.d,Hyp2.d,Hyp3.d,hyp4.d,mrx.d,mry.d,bx1.d,by1.d,bx2.d,by2.d,Hyp1.d,Hyp2.d,Hyp3.d,hyp4,nbimg.l 
Global Xtheta.d,Ytheta.d,Ztheta.d,Ttheta.d,Vxx.d,Vxy.d,Vyx.d,Vyy.d,TX.d,TY.d,ex.d,ey.d,x.d,y.d,clipb.l 
Global tasknom.s,Tfont$,Fonte$,Tx$,Ty$,tex$,mes1$,mes2$,dist1.s,dist2.s,anglecur.s,nbbmp$,nbjpg$,nbpng$ 
Global Handle.l,Factor.l,BmpID.l,MemDC.l,xx.l,yy.l,hImage2.l,hGadget.l,hwnd2.l,hBitmap.l,cursorpost.POINT 
Procedure.s SpecialFolder2(folderno)    
 listptr=0                                                      ; procedure chemin Merci Mr Dobro  
 result$=Space(270) 
 SHGetSpecialFolderLocation_(0,folderno,@listptr) 
 SHGetPathFromIDList_(listptr,@result$) 
ProcedureReturn Trim(result$) 
EndProcedure 
vista=0:ExamineDesktops():lecteur=SpecialFolder2(#CSIDL_MYPICTURES)+"\"  ; Lecteur chemin pas encore testé avec Vista 
Macro modulo(xm,ym)              
  xm-ym*Int(xm/ym) 
EndMacro 
Procedure Frac(ym) 
  ProcedureReturn ym-Int(ym) 
EndProcedure 
Procedure dec(xm) 
  ProcedureReturn Int(xm)+((Int(Frac(Frac(xm))*100)/100)/3*5)+(Frac((xm*100))/36) 
EndProcedure 
Procedure MakeWinScreenshot(ImageNr,hwnd,width,height) 
  If IsImage(ImageNr):FreeImage(ImageNr):DeleteDC_(ImageNr):DeleteDC_(hImage):EndIf 
  hImage=CreateImage(ImageNr,width,height):hdc=StartDrawing(ImageOutput(ImageNr)) 
  BitBlt_(hdc,0,0,width,height,GetDC_(hwnd),0,0,#SRCCOPY) 
  StopDrawing():ReleaseDC_(hwnd,hdc):DeleteDC_(hdc) 
ProcedureReturn hImage 
EndProcedure 
Procedure CaptureScreen(left.l,top.l,width.l,height.l) 
  ; Author: wayne1 Date: 30. January 2002 
  dm.DEVMODE:BMPHandle.l  
  srcDC=CreateDC_("DISPLAY","","",dm):trgDC=CreateCompatibleDC_(srcDC) 
  BMPHandle=CreateCompatibleBitmap_(srcDC,width-10,height-56) 
  SelectObject_( trgDC,BMPHandle)  
    ;bitblt avec ajustement pour windows menu et barre avec ce mode sans r.RECT  
  BitBlt_( trgDC,0,0,width+10,height+4,srcDC,left+6,top+52,#SRCCOPY) 
  If width<11 Or height<57 :width=width+10:height=height+56:EndIf   
  DeleteDC_(trgDC):ReleaseDC_(BMPHandle,srcDC):DeleteDC_(srcDC) 
  OpenClipboard_(#Null):EmptyClipboard_() 
  SetClipboardData_(2,BMPHandle):ciHwnd=GetClipboardData_(#CF_BITMAP) 
  If IsImage(40): FreeImage(40):EndIf 
  If ciHwnd 
    GetObject_(ciHwnd,SizeOf(BITMAP),bm.BITMAP)       
    CreateImage(40,width-10,height-56)  ; image n°40 
    StartDrawing(ImageOutput(40))    
    DrawImage(ciHwnd,0,0) 
    StopDrawing() 
  EndIf 
EndProcedure 
Procedure CaptureScreenL(left.l, top.l, Handle.l,Factor) 
  DC.l = GetDC_(hwnd):MemDC=CreateCompatibleDC_(DC) 
  If IsImage(BmpID): DeleteDC_(BmpID):EndIf 
  If Handle=0:BmpID=CreateCompatibleBitmap_(DC,200,200):Else:BmpID=Handle:EndIf 
  SelectObject_(MemDC, BmpID) 
  StretchBlt_(MemDC,0,0,200*6,200*6,DC,left-20,top-20,200,200,#SRCCOPY) 
  DeleteDC_(MemDC):ReleaseDC_(hwnd,DC):DeleteDC_(DC) 
  ProcedureReturn BmpID ;same BUG if Bitmap or BmpID is used... 
EndProcedure 
Procedure rafraichir() 
  hShotWindow=FindWindow_(0,tasknom) 
  If hShotWindow 
    hWinBmp=MakeWinScreenshot(1,hShotWindow,WindowWidth(0),WindowHeight(0)) 
    SetGadgetState(0,hWinBmp) 
  EndIf 
EndProcedure 
Procedure redrawimage() 
  StartDrawing (WindowOutput(0))    
    DrawImage(ImageID(0),0,0,WindowWidth(0),WindowHeight(0)) 
    DrawingMode(4) 
  StopDrawing() 
EndProcedure 
Procedure angle_mouse_clic(mx_0,my_0,mx_1,my_1) 
  ;Angle depuis le 1er clic mx_0,my_0 vers le 2eme clic mx_1,my_1 :ecran=zéro a 3 heures 
  If ((mx_0-mx_1)<=0 And (my_0-my_1)<=0)         ;angle souris depuis son depart 1 quart 3h/6h 
  zRad=ATan(Abs(my_0-my_1)/Abs(mx_0-mx_1)):EndIf 
  If ((mx_0-mx_1)=>0 And (my_0-my_1)<=0)         ;angle souris depuis son depart 2 quart 6h/9h 
  zRad=ATan(Abs(mx_0-mx_1)/Abs(my_0-my_1))+(#PI/2):EndIf 
  If ((mx_0-mx_1)=>0 And (my_0-my_1)=>0)         ;angle souris depuis son depart 3 quart 9h/12h 
  zRad=ATan(Abs(my_0-my_1)/Abs(mx_0-mx_1))+#PI:EndIf 
  If ((mx_0-mx_1)<=0 And (my_0-my_1)=>0)         ;angle souris depuis son depart 4 quart 12h/3h 
  zRad=ATan(Abs(mx_0-mx_1)/Abs(my_0-my_1))+(#PI*1.5):EndIf 
  ProcedureReturn zRad 
EndProcedure 
Procedure Lin(x,y,x1,y1,Epais,color,style) 
  hdc=GetDC_(WindowID(0)): pen=CreatePen_(style,Epais,color) 
  hPenOld=SelectObject_(hdc,pen):MoveToEx_(hdc,x,y,0):LineTo_(hdc,x1,y1) 
  DeleteObject_(pen): DeleteObject_(hPenOld):ReleaseDC_(hwnd,hdc):DeleteDC_(hdc) 
EndProcedure 
Procedure RoundRect(x,y,x1,y1,Epais,color,fram,angle1,angle2) 
  GetWindowRect_(hwnd,r.RECT):hdc=GetWindowDC_(WindowID(0)) 
  pen=CreatePen_(fram,Epais,color):SelectObject_(hdc,pen) 
  SelectObject_(hdc,brush):nDrawMode=SetROP2_(hdc,#R2_MASKPEN) 
  RoundRect_(hdc,x+4,y+51,x1+4,y1+51,angle1,angle2) 
  SetROP2_(hdc,nDrawMode):DeleteObject_(pen) 
  DeleteObject_(brush):ReleaseDC_(hwnd,hdc):DeleteDC_(hdc) 
EndProcedure 
Procedure Rectangle(x,y,x1,y1,Epais,color,fram) 
  GetWindowRect_(hwnd,r.RECT):hdc=GetWindowDC_(WindowID(0)) 
  hPen=CreatePen_(fram,Epais,color):hOldPen=SelectObject_(hdc,hPen) 
  hBrush=GetStockObject_(#NULL_BRUSH):hOldBrush=SelectObject_(hdc,hBrush):nDrawMode=SetROP2_(hdc,#R2_COPYPEN) 
  If vista=0: Rectangle_(hdc,x+4,y+51,x1+4,y1+51)  ;rectangle mode XP 
    Else:Rectangle_(hdc,x+8,y+49,x1+8,y1+49):EndIf ;rectangle mode VISTA  
  SetROP2_(hdc,nDrawMode):SelectObject_(hdc,hOldBrush):SelectObject_(hdc,hOldPen) 
  DeleteObject_(hPen):DeleteObject_(brush):ReleaseDC_(hwnd,hdc):DeleteDC_(hdc) 
EndProcedure 
Procedure mire(mrx,mry)  ; la fonction plot bug avec startdrawing() declaré avant l'appel procedure 
  hdc=GetDC_(WindowID(0)):pen=CreatePen_(0,0,RGB(co1,co2,co3)):hPenOld=SelectObject_(hdc,pen) 
  SetPixel_(hdc,mrx-1,mry-1,RGB(co1,co2,co3)):SetPixel_(hdc,mrx+1,mry+1,RGB(co1,co2,co3)) 
  SetPixel_(hdc,mrx+1,mry-1,RGB(co1,co2,co3)):SetPixel_(hdc,mrx-1,mry+1,RGB(co1,co2,co3)) 
  DeleteObject_(pen): DeleteObject_(hPenOld):ReleaseDC_(WindowID(0),hdc):DeleteDC_(hdc) 
EndProcedure 
Procedure Ptrepere(mrx,mry)   
  hdc=GetDC_(WindowID(0)):pen=CreatePen_(0,0,RGB(0,0,0)):hPenOld=SelectObject_(hdc,pen) 
  SetPixel_(hdc,mrx-1,mry,RGB(co1,co2,co3)):SetPixel_(hdc,mrx+1,mry,RGB(co1,co2,co3)) 
  SetPixel_(hdc,mrx,mry-1,RGB(co1,co2,co3)):SetPixel_(hdc,mrx,mry+1,RGB(co1,co2,co3)):SetPixel_(hdc,mrx,mry,RGB(255-co1,255-co2,255-co3)) 
  DeleteObject_(pen): DeleteObject_(hPenOld):ReleaseDC_(WindowID(0),hdc):DeleteDC_(hdc) 
EndProcedure 
Procedure EllipseWithRotation(xcenter,ycenter,xRadius,yRadius,StartAngle,FinishAngle,Epais,color,style,ncote,polyg) 
  ; Procedure Ellipse d'Ollivier trouvee sur le forum english qui utilise la newlist Drawx() 
  ; je le remercie au passage pour cette idee qui permet aussi de tracer des polygones. 
  If ncote=0:AngleStep=0:Else:AngleStep=360/ncote:EndIf   
  If polyg=0              ; mode cercle 
    polypt=0 
    If style>1: 
      AngleStep=360/72    ; permet de cree style dashdot etc pour les figures sans trop se prendre la tete 
    Else                 ; tant que l'on reste dans le dessin miniature lol 
      AngleStep=1 
    EndIf 
  EndIf 
  NewList DrawX.POINT() 
  angle=StartAngle 
  Repeat    
    x=Cos(angle*#PI/180)*xRadius:y=-Sin(angle*#PI/180)*yRadius     ; Draw an ellipse... polygone 
    DisplayX=x*Cos(zRad+raydemiang)-y*Sin(zRad+raydemiang)         ; Rotation... 
    DisplayY=x*Sin(zRad+raydemiang)+y*Cos(zRad+raydemiang)        
    AddElement(DrawX())                                            ; Record... 
    DrawX()\x=xcenter+DisplayX:DrawX()\y=ycenter+DisplayY        
    angle+AngleStep    
  Until angle > FinishAngle+1 
  ResetList(DrawX())                                               ; Draw... 
  For i=1 To ListSize(DrawX()) - 1        
    SelectElement(DrawX(),i - 1) 
    x1=DrawX()\x:y1=DrawX()\y 
    SelectElement(DrawX(),i) 
    x2=DrawX()\x:y2=DrawX()\y 
    If polyg=0 Or (polyg=1 And polypt=0) Or (polyg=2 And polypt=0) 
      Lin(x1,y1,x2,y2,Epais,color,style)                           ; mode lignes 
    Else 
      Ptrepere(x2,y2)                                              ; mode poinrs 
    EndIf 
  Next 
  ClearList(DrawX()) 
EndProcedure 
Procedure Cerclen3point(pax,pay,pbx,pby,pcx,pcy) 
  ;3 points de coordonnees tester sur un rayon de 10Km avec un centre a 0,0 avec nb entier 
  ; pax=0-5877:pay=0-8091:pbx=9945:pby=0-1047:pcx=0-7430:pcy=6693 
  bx1=(pbx+pax) / 2: by1=((pby+0.00000001)+pay) / 2   ;bisectrice (x1,y1),(x2,y2) 
  dy1=pbx - pax: dx1=-((pby+0.00000001) - pay) ;ajout d'une chiure pour eviter les soucis avec aX bX null 
  bx2=(pcx+pbx) / 2: by2=(pcy+pby) / 2 ;bisectrice (x2,y2),(x3,y3) 
  dy2=pcx - pbx: dx2=-(pcy - pby) 
  ; centre au point de croisement des bisectrices 
  ox=(by1*dx1*dx2+bx2*dx1*dy2-bx1*dy1*dx2-by2*dx1*dx2)/(dx1*dy2-dy1*dx2) 
  oy=(ox-bx1)*dy1/dx1+by1 
  dx=ox - pax:dy=oy - pay              
  Radius=Sqr(dx * dx+dy * dy)    ; radius et ox,oy=centre du cercle 
EndProcedure 
Procedure angleproject(Ang) 
  angle_mouse_clic(pax,pay,pbx,pby):angapb=zRad/#PI*180 
  x1=Pow(Abs(pax - pbx),2):y1=Pow(Abs(pay - pby),2) 
  Hyp1= Sqr(x1+y1):pcx=mx1:pcy=my1 
  If Ang>180:Ang=360-Ang:EndIf 
  Angd=(180-Ang)*#PI/180:x3=pax:y3=pay 
  angle_mouse_clic(pax,pay,pcx,pcy):angapc=zRad/#PI*180 
  angp=modulo((angapb-angapc),360) 
  If angp<=-180: angp=Abs(angp)-180:EndIf 
  x2=Pow(Abs(x3-pcx),2):y2=Pow(Abs(y3-pcy),2) 
  Hyp2= Sqr(x2+y2):ray=Hyp2*Cos(#PI) 
  If (angp=>0 And angp<180) 
    x2=x3+Cos((angapb*#PI/180)+Angd)*ray:y2=y3+Sin((angapb*#PI/180)+Angd)*ray 
  Else 
    x2=x3+Cos((angapb*#PI/180)-Angd)*ray:y2=y3+Sin((angapb*#PI/180)-Angd)*ray 
  EndIf 
  If polypt=0 
    Lin(x3,y3,x2,y2,Epais,RGB(co1,co2,co3),style)                   ; mode lignes 
  Else 
    Ptrepere(x2,y2)                                                 ; mode poinrs 
  EndIf 
  angle_mouse_clic(x3,y3,x2,y2): 
  x1=Pow(Abs(x3-x2),2):y1=Pow(Abs(y3-y2),2):Hyp1=Sqr(x1+y1) 
  dist1=Right(Str(Hyp1+10000),4):mes1$="Ray:"     ; mesures 
  anglecur=Right(StrD((zRad/#PI*180)+1000,2),6):mes2$=" Ang:" 
EndProcedure 
Procedure loupe() 
  StartDrawing (WindowOutput(7)) 
    DrawingMode(4):zl=25 ; cible viseur 
    Circle(zl+23,zl+24,15,coulor) 
    Circle(zl+23,zl+24,21,coulor) 
    Circle(zl+23,zl+24,8,coulor) 
    LineXY(zl+20,zl+0,zl+20,zl+46,coulor) 
    LineXY(zl+26,zl+0,zl+26,zl+46,coulor) 
    LineXY(zl+46,zl+20,zl+0,zl+20,coulor) 
    LineXY(zl+46,zl+26,zl+0,zl+26,coulor) 
  StopDrawing() 
EndProcedure 
Procedure OleOpen(File$) 
  hBitmap = 0 
  If ReadFile(0, File$) 
    FileSize = FileSize(File$) 
    hGlobal = GlobalAlloc_(#GMEM_MOVEABLE, FileSize) 
    pvData = GlobalLock_(hGlobal) 
    ReadData(0,pvData, FileSize) 
    CloseFile(0) 
    GlobalUnlock_(hGlobal) 
    CreateStreamOnHGlobal_(hGlobal, #True, @pstm):ErrorNumber = 0 
    Select OleLoadPicture_(pstm, FileSize, #False,?IID_IPicture,@gpPicture) 
      Case #E_POINTER2:ErrorNumber = 222 
      Case #E_NOINTERFACE2:ErrorNumber = 223 
      Case #E_OUTOFMEMORY2:ErrorNumber = 224 
    EndSelect
    pstm\Release()                             ;CallCOM(#IPicture_Release, pstm) 
    GlobalFree_(hGlobal) 
    If ErrorNumber=0 
      gpPicture\Get_Width(@hmwidth)            ;CallCOM(#IPicture_Get_Width, gpPicture, @hmwidth) 
      gpPicture\Get_Height(@hmheight)          ;CallCOM(#IPicture_Get_Height, gpPicture, @hmheight) 
      hDC = GetDC_(hwnd) 
      xScreenPixels = GetDeviceCaps_(hDC, #LOGPIXELSX) 
      yScreenPixels = GetDeviceCaps_(hDC, #LOGPIXELSY) 
      width = Abs((hmwidth*xScreenPixels)/2540) 
      height = Abs((hmheight*yScreenPixels)/2540) 
      rc.RECT:rc\left=0:rc\top=0:rc\right=width:rc\bottom=height 
      mDC = CreateCompatibleDC_(hDC) 
      hBitmap=CreateCompatibleBitmap_(hDC, width, height) 
      OldBitmap=SelectObject_(mDC, hBitmap) 
      gpPicture\Render(mDC,0,0, width, height, 0, hmheight, hmwidth, -hmheight, rc) 
      ;CallCOM(#IPicture_Render, gpPicture, mDC, 0, 0, width, height, 0, hmheight, hmwidth, -hmheight, rc) 
      SelectObject_(mDC, OldBitmap) 
      DeleteDC_(mDC) 
      ReleaseDC_(hwnd, hDC) 
      gpPicture\Release() ;CallCOM(#IPicture_Release, gpPicture)  
     EndIf 
  EndIf 
  ProcedureReturn hBitmap 
EndProcedure 
;######################################################################################################### 
wl=802:wh=622:iconex.l=32:iconeY.l=32:anglea=45:angl1=060:angl2=060:ech=100
nbbmp$="":nbjpg$="":nbpng$="":tex$="":Fonte$="Arial":Tfont$=Str(8) 
cur0=LoadCursor_(0,#IDC_ARROW):cur1=LoadCursor_(0,#IDC_CROSS):LoadFont (1,"Arial",8) 
tasknom="Géométrie Elémentaire avec PureBasic (°£°) Kernadec 10/2008" 
hwnd=OpenWindow(0,0,0,wl,wh,tasknom,#PB_Window_SystemMenu | #PB_Window_SizeGadget| #PB_Window_MinimizeGadget | #PB_Window_MaximizeGadget | #PB_Window_ScreenCentered | #WS_OVERLAPPEDWINDOW ) 
hwnd1=OpenWindow(1,2,WindowHeight(0)-34,210,16,"",#PB_Window_BorderLess)    ; fenetre child 
SetParent_(WindowID(1), WindowID(0)):InitKeyboard()
  nbimg=16                      ; 18 images pour mode restore et annule attention à la memoire avec nb images 
  For i=0 To 18                ; 16 retour arriere 
    CreateImage(i,WindowWidth(0),WindowHeight(0))            
  Next i 
  CreateImage(50,WindowWidth(0),WindowHeight(0)) 
  CreateImage(52,WindowWidth(0),WindowHeight(0)) 
  CreateImage(53,WindowWidth(0),WindowHeight(0)) 
  If CreateMenu(1,WindowID(0)) 
    MenuTitle("Outils") 
    OpenSubMenu("Ligne") 
      MenuItem(1,"Ligne Chainée") 
      MenuItem(2,"Mesures - Dbclic Place Repere") 
      MenuItem(3,"Extension 3Pt-Ligne____") 
      MenuItem(4,"Extension 3Pt-Point.....") 
      MenuItem(5,"Perpendiculaire 3Pt-Ligne____") 
      MenuItem(6,"Perpendiculaire 3Pt-Point.....") 
      MenuItem(7,"Bissectrice 3Pt-Ligne____") 
      MenuItem(8,"Bissectrice 3Pt-Point.....") 
      MenuItem(9,"Parallele 3Pt-Ligne____") 
      OpenSubMenu("Projection d'Angle") 
        MenuItem(10,"projette Angle 3Pt-Ligne____") 
        MenuItem(11,"projette Angle 3Pt-Point.....") 
        MenuItem(12,"Changer d'Angle") 
      CloseSubMenu() 
    CloseSubMenu() 
    OpenSubMenu("Polygone") 
      MenuItem(14,"Bloc Rectangle") 
      OpenSubMenu("Bloc Rectangle Arrondi") 
        MenuItem(16,"Bloc Arrondi par Défaut") 
        MenuItem(18,"Dimension des Arrondis") 
      CloseSubMenu() 
      MenuItem(20,"Bloc Rectangle 3pts") 
      MenuItem(22,"Polyg-Inscrit-Corde____") 
      MenuItem(23,"Polyg-Inscrit-Point.....") 
      MenuItem(24,"Polyg-Circonscrit-Corde____") 
      MenuItem(25,"Polyg-Circonscrit-Point.....") 
      MenuItem(26,"Polyg-par le coté-Corde____") 
      MenuItem(27,"Polyg-par le coté-Point.....") 
     CloseSubMenu()
     OpenSubMenu("Nbs de cotés") 
      MenuItem(28,"3 côtés") 
      MenuItem(30,"4 côtés") 
      MenuItem(32,"5 côtés") 
      MenuItem(34,"6 cotés") 
      MenuItem(36,"7 côtés") 
      MenuItem(38,"8 côtés") 
      MenuItem(40,"9 côtés") 
      MenuItem(42,"10 côtés") 
      MenuItem(44,"12 côtés") 
      MenuItem(46,"15 côtés") 
      MenuItem(48,"24 côtés") 
      MenuItem(50,"+côtés") 
      MenuItem(52," -- côtés") 
    CloseSubMenu() 
    OpenSubMenu("Cercle") 
      MenuItem(54,"Centre") 
      MenuItem(56,"Diametre") 
      MenuItem(58,"Excentrer") 
      MenuItem(60,"Avec 3 Points") 
      MenuItem(62,"Arc en 3 Pts Ang")
      MenuItem(63,"Arc en 3 Pts Ray") 
    CloseSubMenu() 
    OpenSubMenu("Ellipse et Poly") 
      MenuItem(64,"Ellipse") 
      MenuItem(66,"PolyEllipt-Inscrit-Corde____") 
      MenuItem(67,"PolyEllipt-Inscrit-Point.....") 
      MenuItem(68,"PolyEllipt-Circonscrit-Corde____") 
      MenuItem(69,"PolyEllipt-Circonscrit-Point.....") 
    CloseSubMenu() 
    OpenSubMenu("Style") 
      MenuItem(70,"PS_SOLID") 
      MenuItem(72,"PS_DASH") 
      MenuItem(74,"PS_DOT") 
      MenuItem(76,"PS_DASHDOT") 
      MenuItem(78,"PS_DASHDOTDOT") 
    CloseSubMenu() 
    OpenSubMenu("Epaisseur") 
      MenuItem(80,"1") 
      MenuItem(82,"2") 
      MenuItem(84,"3") 
      MenuItem(86,"4") 
      MenuItem(88,"6") 
      MenuItem(90,"8") 
      MenuItem(92,"10") 
      MenuItem(94,"+1") 
      MenuItem(96,"--1") 
    CloseSubMenu() 
    MenuItem(98,"Point") 
    MenuItem(100,"Texte") 
    OpenSubMenu("Couleur") 
      MenuItem(102,"Couleur Trait ou Text") 
      MenuBar() 
      MenuItem(104,"Remplir ou FondText DBClic") 
    CloseSubMenu() 
    MenuBar() 
    OpenSubMenu("Efface/Annule") 
      MenuItem(106,"Annule Précédent") 
      MenuItem(107,"Restore Précédent") 
      MenuItem(108,"Gomme box") 
      MenuItem(110,"Gomme") 
      MenuBar() 
      MenuItem(112,"Efface Change de Couleur") 
      MenuItem(114,"Efface Tout blanc") 
    CloseSubMenu() 
    MenuBar() 
    OpenSubMenu("Sauve X/Y") 
      MenuItem(116,"C:\X-YTemp.BMP") 
      MenuItem(118,"C:\X-YTemp.JPG") 
      MenuItem(120,"C:\X-YTemp.PNG") 
    CloseSubMenu() 
    MenuItem(122,"Fenêtre X/Y") 
    OpenSubMenu("Seiect Cadre Clipboard") 
      MenuItem(124,"Clipboard C:\X-YTemp.BMP") 
      MenuItem(126,"Clipboard C:\X-YTemp.JPG") 
      MenuItem(128,"Clipboard C:\X-YTemp.PNG") 
    CloseSubMenu() 
    OpenSubMenu("Charge Image") 
      MenuItem(130,"Sans Redim-Centrée") 
      MenuItem(132,"Avec Redim-Fenêtre") 
    CloseSubMenu() 
    MenuBar() 
   MenuItem(134,"Infos") 
   MenuBar() 
   MenuItem(136,"Quitter") 
  CloseSubMenu() 
 EndIf 
 coB1=255:coB2=255:coB3=255 
 StartDrawing (WindowOutput(0)) 
  Box(0,0,DesktopWidth(0),DesktopHeight(0),RGB(255,255,255)) ;fond blanc 
  couleurbox=Point(1,1) 
 StopDrawing() 
  hShotWindow=FindWindow_(0,tasknom) 
  If hShotWindow 
    hWinBmp=MakeWinScreenshot(0,hShotWindow,WindowWidth(0),WindowHeight(0)-20) 
    ImageGadget(0,0,0,WindowWidth(0),WindowHeight(0),hWinBmp) 
  EndIf 
  CopyImage(0,1):CopyImage(0,2):CopyImage(0,53):CopyImage(0,50):ResizeImage(50,DesktopWidth(0),DesktopHeight(0)) 
  Zonedessin=ImageGadget(0,0,0,WindowWidth(0),WindowHeight(0),hWinBmp) 
  hwnd2=OpenWindow(7,0,WindowHeight(0)-130,96,96,"",#PB_Window_BorderLess|#PB_Window_Invisible)
  SetParent_(WindowID(7),WindowID(0)) 
  StickyWindow(7, 1):HideWindow(7,0):  
  hImage2=CaptureScreenL(cursorpost\x,cursorpost\y, hImage2,0) 
  hGadget=ImageGadget(55,-75,-75,WindowWidth(0),WindowHeight(0),hImage2)
  SetActiveWindow(0):dessin=1:ncote=3:Epais=1:departclic=0:click=1:MBState=#False 
  Repeat 
    Event=WaitWindowEvent(2) 
    If Event = #WM_KEYDOWN:key=EventwParam():EndIf          ; Commande clavier 
    Tx$=Right(Str(((WindowMouseX(0))+10000)),4)              ; Coordonnées du curseur 
    Ty$=Right(Str(((WindowMouseY(0))+10000)),4) 
    If Tx$="9999":Tx$="0000":EndIf                          ; ajout de 0 
    If Ty$="9999":Ty$="0000":EndIf 
    StartDrawing(WindowOutput(0)):Colorp=Point(1,1)  
     x=WindowMouseX(0):y=WindowMouseY(0)
     If x<>-1 And y<>-1
     If Point(x,y)= RGB(255,0,0):coulor=RGB(128,128,128); change couleur curseur si fond rouge 
     Else:coulor=RGB(255,0,0):EndIf:EndIf   
    StopDrawing()   
    StartDrawing(WindowOutput(1)) 
      DrawingMode(0) 
      DrawingFont(FontID(1)) 
      Box(0,0,210,14,Colorp) 
      DrawText(0,0,"MX:"+Tx$+" MY:"+Ty$,RGB(255-coB1,255-coB2,255-coB3),Point(1,1)) ; affiche les coordonnées  
      DrawText(100,0,mes1$+dist1+mes2$+anglecur,RGB(255-coB1,255-coB2,255-coB3),Point(1,1))     
    StopDrawing() 
    GetCursorPos_(cursorpos.POINT)
      MapWindowPoints_(0,hwnd,cursorpos,2) ; curseur croix 
      Select ChildWindowFromPoint_(hwnd,cursorpos\x|cursorpos\y<<32)
       Case hwnd         : SetCursor_(cur1)   ;"Zonedessin" par "hwnd"
       Case 0            : SetCursor_(cur0):redrawimage()     
      EndSelect 
    hImage2 = CaptureScreenL(cursorpost\x, cursorpost\y, hImage2,0) 
    SendMessage_(hGadget, #STM_SETIMAGE, #IMAGE_BITMAP, hImage2) 
    Select Event                    
      Case #PB_Event_Menu 
        Select EventMenu() 
          Case 1:dessin=1:MBState=#False                                      ; Ligne Chainée 
          Case 2:dessin=2:MBState=#False                                      ; Mesures Dclk Place Repere 
          Case 3:dessin=5:click=0:departclic=0:MBState=#False:extperp=2       ; Extension de ligne 3 points 
          Case 4:dessin=5:click=0:departclic=0:MBState=#False:extperp=3       ; Extension de Pt 3 points  
          Case 5:dessin=5:click=0:departclic=0:MBState=#False:extperp=0       ; Perpend de ligne 3 points 
          Case 6:dessin=5:click=0:departclic=0:MBState=#False:extperp=1       ; Perpend d'un Pt 3 points 
          Case 7:dessin=7:click=0:departclic=0:MBState=#False:polypt=0        ; Bissectrice ligne 3 points 
          Case 8:dessin=7:click=0:departclic=0:MBState=#False:polypt=1        ; Bissectrice Pt 3 points 
          Case 9:dessin=20:click=0:departclic=0:MBState=#False:parall=1       ; parallele 3 points 
          Case 10:dessin=10:click=0:departclic=0:MBState=#False:polypt=0      ; Projecte Angle 3 Points 
          Case 11:dessin=10:click=0:departclic=0:MBState=#False:polypt=1      ; Projecte Angle 3 Points 
          Case 12                                                             ; Modifier l'angle 
;{-Window 2 12-(202-208) ; saisie de l'angle à projeter 
            If OpenWindow(2,20,250,180,70,"Angle à Projeter",#PB_Window_SystemMenu) 
              StringGadget(202,120,10,40,20,StrD(anglea,2),#PB_String_Numeric) 
              SendMessage_(GadgetID(202),#EM_LIMITTEXT,6,0) 
              TextGadget(204,10,14,100,20,"Angle {>0 <-> <180}") 
              ButtonGadget(206,20,40,60,20,"Annuler") 
              ButtonGadget(208,100,40,60,20,"OK") 
            EndIf 
            Repeat 
              event2=WindowEvent() 
              Select event2 
                Case #PB_Event_CloseWindow 
                  CloseWindow(2):Break 
              EndSelect 
              If event2=#PB_Event_Gadget 
                Select EventMenu() 
                  Case 206:CloseWindow(2):Break 
                  Case 208 
                    HideWindow(2,1):redrawimage() 
                    anglea=ValD(GetGadgetText(202)) 
                    SetGadgetText(202,StrD(anglea,2)) 
                    CloseWindow(2):Break 
                EndSelect 
              EndIf 
            ForEver   ;} 
          Case 14:dessin=14:click=1:MBState=#False               ; bloc Rectangle 
          Case 16:dessin=16:click=1:MBState=#False               ; bloc Rectangle Arrondi 
          Case 18                                                ; Dimension des Arrondis 
;{-Window 3 18-(302-312) ; angles Arrondis 
            If OpenWindow(3,20,250,180,70,"Angle Arrondi",#PB_Window_SystemMenu) 
              StringGadget(302,50,10,30,20,Str(angl1),#PB_String_Numeric) 
              SendMessage_(GadgetID(302),#EM_LIMITTEXT,3,0) 
              TextGadget(304,10,14,45,20,"Angle1") 
              StringGadget(306,130,10,30,20,Str(angl2),#PB_String_Numeric) 
              SendMessage_(GadgetID(306),#EM_LIMITTEXT,3,0) 
              TextGadget(308,90,14,125,20,"Angle2") 
              ButtonGadget(310,20,40,60,20,"Annuler") 
              ButtonGadget(312,100,40,60,20,"OK") 
            EndIf 
            Repeat 
              event3=WindowEvent() 
              Select event3 
                Case #PB_Event_CloseWindow 
                  CloseWindow(3):Break 
              EndSelect 
              If event3=#PB_Event_Gadget 
                Select EventMenu() 
                  Case 310:CloseWindow(3):Break 
                  Case 312 
                    HideWindow(3,1):redrawimage() 
                    angl1=ValD(GetGadgetText(302)) 
                    SetGadgetText(302,StrD(angl1,2)) 
                    angl2=ValD(GetGadgetText(306)) 
                    SetGadgetText(306,StrD(angl2,2)) 
                    CloseWindow(3):dessin=16:Break 
                EndSelect 
              EndIf 
            ForEver   ;} 
          Case 20:dessin=20:click=0:departclic=0:MBState=#False:parall=0      ; bloc Rectangle en 3 points 
          Case 22:dessin=22:click=1:MBState=#False:polypt=0                   ; Polygone Inscrit Corde 
          Case 23:dessin=22:click=1:MBState=#False:polypt=1                   ; Polygone Inscrit Point 
          Case 24:dessin=24:click=1:MBState=#False:polypt=0                   ; Polygone Circonscrit Corde 
          Case 25:dessin=24:click=1:MBState=#False:polypt=1                   ; Polygone Circonscrit Point 
          Case 26:dessin=26:click=1:MBState=#False:polypt=0                   ; Polygone par le Coté Corde 
          Case 27:dessin=26:click=1:MBState=#False:polypt=1                   ; Polygone par le Coté Point 
          Case 28:ncote=3                                                     ; Nombres de Cotés  
          Case 30:ncote=4 
          Case 32:ncote=5 
          Case 34:ncote=6  
          Case 36:ncote=7  
          Case 38:ncote=8 
          Case 40:ncote=9 
          Case 42:ncote=10 
          Case 44:ncote=12 
          Case 46:ncote=15 
          Case 48:ncote=24 
          Case 50:ncote=ncote+1 
          Case 52:ncote=ncote-1:If ncote=<3:ncote=3:EndIf 
          Case 54:dessin=54:click=1:MBState=#False                            ; Cercle par le Centre 
          Case 56:dessin=56:click=1:MBState=#False                            ; Cercle par le Diametre 
          Case 58:dessin=58:click=1:MBState=#False                            ; Cercle Excentrer  
          Case 60:dessin=60:click=0:departclic=0:MBState=#False               ; Cercle 3 en Point 
          Case 62:dessin=62:click=0:departclic=0:MBState=#False               ; Arc en 3 Points angle
          Case 63:dessin=63:click=0:departclic=0:MBState=#False               ; Arc en 3 Points rayon
          Case 64:dessin=64:click=0:departclic=0:MBState=#False               ; Ellipse  
          Case 66:dessin=66:click=0:departclic=0:MBState=#False:polypt=0      ; Polygone Elliptique Inscrit Corde 
          Case 67:dessin=66:click=0:departclic=0:MBState=#False:polypt=1      ; Polygone Elliptique Inscrit Point 
          Case 68:dessin=68:click=0:departclic=0:MBState=#False:polypt=0      ; Polygone Elliptique Circonscrit Corde 
          Case 69:dessin=68:click=0:departclic=0:MBState=#False:polypt=1      ; Polygone Elliptique Circonscrit Point 
          Case 70:style=0                                                     ; PS_SOLID  
          Case 72:style=1                                                     ; PS_DASH 
          Case 74:style=2                                                     ; PS_DOT 
          Case 76:style=3                                                     ; PS_DASHDOT 
          Case 78:style=4                                                     ; PS_DASHDOTDOT 
          Case 80:Epais=1                                                     ; Epaisseur 
          Case 82:Epais=2  
          Case 84:Epais=3  
          Case 86:Epais=4  
          Case 88:Epais=6  
          Case 90:Epais=8  
          Case 92:Epais=10    
          Case 94:Epais=Epais+1 
          Case 96:Epais=Epais-1:If Epais=<1:Epais=1:EndIf 
          Case 98:dessin=98:MBState=#False   ; Point 
          Case 102                           ; Couleur Trait ou Text 
            color.l=ColorRequester() 
            If color > - 1 
              co1=Red(color):co2=Green(color):co3=Blue(color) 
            EndIf 
          Case 104:dessin=104                ; Remplir ou FondText DBClic  
            Color1.l=ColorRequester()  
            If Color1 > - 1 
              aireco1=Red(Color1):aireco2=Green(Color1):aireco3=Blue(Color1) 
            EndIf 
          Case 106                           ; Annule Précédent tracer 
            ; annule remplace l'image par la précédente sans le dernier tracer 
            If compteur=>1:compteur=compteur-1:EndIf 
            StartDrawing (WindowOutput(0))   
              CopyImage(2+modulo(compteur,nbimg),0):CopyImage(2+modulo(compteur,nbimg),1) 
              DrawImage(ImageID(0),0,0,WindowWidth(0),WindowHeight(0)) 
              DrawingMode(4) 
            StopDrawing() 
          Case 107                           ; restore Précédent tracer 
            ; restore replace l'image avec le dernier tracer 
            compteur=compteur+1 
            If compteur=<compteurT 
              StartDrawing (WindowOutput(0))    
                CopyImage(2+modulo(compteur,nbimg),0):CopyImage(2+modulo(compteur,nbimg),1) 
                DrawImage(ImageID(0),0,0,WindowWidth(0),WindowHeight(0)) 
                DrawingMode(4) 
              StopDrawing() 
            EndIf 
          Case 108:dessin=108:MBState=#False  ; Gomme Cadre 
          Case 110:dessin=110:MBState=#False  ; Gomme  
          Case 114                            ; Efface Tout blanc 
            compteur=compteur+1:compteurT=compteurT+1 
            CopyImage(0,2+modulo(compteur,nbimg)) 
            coB1=255:coB2=255:coB3=255:aireco1=255:aireco2=255:aireco3=255 
            StartDrawing(ImageOutput(0)) 
              Box(0,0,DesktopWidth(0),DesktopHeight(0),RGB(255,255,255)) 
            StopDrawing() 
            StartDrawing(WindowOutput(0)) 
              Box(0,0,DesktopWidth(0),DesktopHeight(0),RGB(255,255,255)) 
              CopyImage(0,53):CopyImage(0,1) 
            StopDrawing():rafraichir():click=2
          Case 122:dessin=122            ; Fenêtre X/Y  
          Case 124:dessin=124:clipb=124            
          Case 126:dessin=124:clipb=126  ; Cadre Capture clipboard  
          Case 128:dessin=124:clipb=128 
          Case 130 
;{-Window 8  18-(802-816)		           ;  "Image Redim et Centrée"		
            filename$ = OpenFileRequester("Open image",lecteur, "JPEG image (*.jpg;*.jpeg)|*.jpg;*.jpeg|Icon file (*.ico)|*.ico|Cursor file (*.cur)|*.cur|BMP image (*.bmp)|*.bmp|GIF image (*.gif)|*.gif|Windows Metafile (*.wmf)|*.wmf|Enhanced Metafile (*.emf)|*.emf", 0)
						If filename$
						  ImageID = OleOpen(filename$)
						EndIf
						If OpenWindow(8,20,250,180,70,"Redim et Centrée"+ext$,#PB_Window_SystemMenu)
              StringGadget(802,82,10,30,20,Str(width),#PB_String_Numeric)
              SendMessage_(GadgetID(802),#EM_LIMITTEXT,4,0)
              TextGadget(804,70,14,50,20,"X")
              StringGadget(806,132,10,30,20,Str(height),#PB_String_Numeric)
              SendMessage_(GadgetID(806),#EM_LIMITTEXT,4,0)
              TextGadget(808,120,14,50,20,"Y")
              StringGadget(810,34,10,30,20,Str(Ech),#PB_String_Numeric)
              SendMessage_(GadgetID(810),#EM_LIMITTEXT,4,0)
              TextGadget(812,5,14,50,20,"Ech%")
              ButtonGadget(814,20,40,60,20,"Annuler")
              ButtonGadget(816,100,40,60,20,"OK")
             EndIf
             Repeat
              event8=WindowEvent()
               Select event8
                 Case #PB_Event_CloseWindow
                  CloseWindow(8):Break
               EndSelect
               If event8=#PB_Event_Gadget
                width=Int(Val(GetGadgetText(802))*(Val(GetGadgetText(810))/100)):height=Int(Val(GetGadgetText(806))*(Val(GetGadgetText(810))/100))
               Select EventMenu()
                Case 814:CloseWindow(8):Break
                Case 816:CloseWindow(8)
       			    If ImageID
							   StartDrawing(WindowOutput(0))
								  DrawImage(ImageID(0),0,0)
							    DrawingMode(4)
							    DrawImage(ImageID, (WindowWidth(0)-width)/2,((WindowHeight(0)-height)/2)-12, width,height)
							    ResizeImage(0,width,height,#PB_Image_Smooth)
							   StopDrawing():rafraichir():CopyImage(1,0)
						    Break
						    EndIf
						   EndSelect
              EndIf
            ForEver   ;}  
           Case 132
						filename$ = OpenFileRequester("Open image",lecteur, "JPEG image (*.jpg;*.jpeg)|*.jpg;*.jpeg|Icon file (*.ico)|*.ico|Cursor file (*.cur)|*.cur|BMP image (*.bmp)|*.bmp|GIF image (*.gif)|*.gif|Windows Metafile (*.wmf)|*.wmf|Enhanced Metafile (*.emf)|*.emf", 0)
							If filename$
								ImageID = OleOpen(filename$)
								If ImageID
									StartDrawing(WindowOutput(0))
										ResizeWindow(0,WindowX(0),WindowY(0),width,height)
										DrawingMode(4):DrawImage(ImageID, 0, 0 , width,height)
									StopDrawing():rafraichir():CopyImage(1,0)
								EndIf
							EndIf  
           Case 134                       ; Infos 
              lgtxt1$="Construire en 3 points avec un alignement du 1er clic gauche vers" 
              lgtxt2$="le 2ème clic gauche, Le 3eme clic place l'objet à la position du" 
              lgtxt3$="curseur. Le clic droit annule la saisie de l'objet. Les mesures" 
              lgtxt4$="se fonts en pixels du 1er clic via la ligne et le curseur souris." 
              lgtxt5$="On peut aussi utiliser ligne pour éffacer les traits de constructions" 
              lgtxt6$="Sauver en Mode BMP pour réutiliser son dessin avec des coloriages" 
              lgtxt7$="Utiliser des nombres Paires pour les constructions base, rayons etc.." 
              lgtxt8$=" Géométrie Elémentaire avec PureBasic par Kernadec 10/2008" 
              MessageRequester("Infos pour l'utilisation de la Souris",lgtxt1$+Chr(13)+lgtxt2$+Chr(13)+lgtxt3$+Chr(13)+lgtxt4$+Chr(13)+lgtxt5$+Chr(13)+lgtxt6$+Chr(13)+lgtxt7$+Chr(13)+Chr(13)+lgtxt8$,#PB_MessageRequester_Ok) 
          Case 136                      ; Quitter 
              Event=#PB_Event_CloseWindow 
    EndSelect
;{-Window 4 100-(402-416) ; Texte  
    If EventMenu()=100    
      If OpenWindow(4,25,150,190,100,"Saisie de Texte",#PB_Window_SystemMenu) 
        StringGadget(400,28,24,150,20,tex$) 
        SendMessage_(GadgetID(400),#EM_LIMITTEXT,30,0) 
        SetActiveGadget(400) 
        TextGadget(404,15,5,170,20,"Placer Texte bouton G Appuyer") 
        TextGadget(406,2,28,34,20,"Text:") 
        StringGadget(406,32,50,30,20,Tfont$) 
        SendMessage_(GadgetID(406),#EM_LIMITTEXT,3,#PB_String_Numeric) 
        TextGadget(408,2,54,34,20,"Taille:") 
        StringGadget(410,100,50,78,20,Fonte$) 
        SendMessage_(GadgetID(410),#EM_LIMITTEXT,15,0) 
        TextGadget(412,66,54,34,20,"Police:") 
        ButtonGadget(414,20,75,60,20,"Annuler") 
        ButtonGadget(416,110,75,60,20,"OK") 
      EndIf 
      Repeat 
        Event4=WindowEvent() 
         Select Event4 
          Case #PB_Event_CloseWindow 
           CloseWindow(4):Break 
         EndSelect 
         If Event4=#PB_Event_Gadget 
          Select EventMenu() 
           Case 414:CloseWindow(4):Break 
           Case 416 
            HideWindow(4,1):redrawimage():click=1:MBState=#False 
            tex$=GetGadgetText(400):Tfont$=GetGadgetText(406):Fonte$=GetGadgetText(410) 
            font0=LoadFont(0,GetGadgetText(410),Val(GetGadgetText(406))) 
            CloseWindow(4):dessin=100:Break 
          EndSelect 
         EndIf 
      ForEver 
    EndIf       ;} 
;{-Window 5 116-118-120-(502-512) ; C:\X-YTemp.BMP C:\X-YTemp.JPG C:\X-YTemp.PNG  
    If EventMenu()=116 Or EventMenu()=118 Or EventMenu()=120 
       iconex=WindowWidth(0)-2:iconeY=WindowHeight(0)-22 
       choix=EventMenu() 
       If choix=116:ext$=".BMP":EndIf 
       If choix=118:ext$=".JPG":EndIf 
       If choix=120:ext$=".PNG":EndIf 
       If OpenWindow(5,20,250,180,70,"Redim. et Sauve "+ext$,#PB_Window_SystemMenu) 
         StringGadget(502,52,10,30,20,Str(iconex),#PB_String_Numeric) 
         SendMessage_(GadgetID(502),#EM_LIMITTEXT,4,0) 
         TextGadget(504,5,14,50,20,"Dimen. X") 
         StringGadget(506,132,10,30,20,Str(iconeY),#PB_String_Numeric) 
         SendMessage_(GadgetID(506),#EM_LIMITTEXT,4,0) 
         TextGadget(508,85,14,50,20,"Dimen. Y") 
         ButtonGadget(510,20,40,60,20,"Annuler") 
         ButtonGadget(512,100,40,60,20,"OK") 
       EndIf 
      Repeat 
        event5=WindowEvent() 
         Select event5 
           Case #PB_Event_CloseWindow 
             CloseWindow(5):Break 
         EndSelect 
        If event5=#PB_Event_Gadget 
         Select EventMenu() 
           Case 510:CloseWindow(5):Break 
           Case 512 
             HideWindow(7,1):HideWindow(1,1):HideWindow(5,1):redrawimage():WindowSize.RECT 
             iconex=Val(GetGadgetText(502)):iconeY=Val(GetGadgetText(506)) 
             GetWindowRect_(hwnd,@WindowSize)  ; ici attention au nom 'hwnd' de la fenetre 0 
             CaptureScreen(WindowSize\left,WindowSize\top,WindowSize\right - WindowSize\left,WindowSize\bottom - WindowSize\top) 
             ImageGadget(40,0,0,WindowWidth(0),WindowHeight(0),BITMAP) 
             ResizeImage(40,iconex,iconeY,#PB_Image_Smooth) 
             If choix=116 
               For i=1 To 100      
                 If ReadFile(0,lecteur+Str(iconex)+"x"+Str(iconeY)+"temp"+Str(i)+ext$)    
                   CloseFile(0)      ; test si le nom du fichier existe  
                 Else          
                   SaveImage(40,lecteur+Str(iconex)+"x"+Str(iconeY)+"temp"+Str(i)+ext$,#PB_ImagePlugin_BMP) 
                   dessin=2:Break   ; sauvegarde avec le numero disponible et sortie 
                 EndIf 
               Next i 
             EndIf 
            If choix=118 
              For i=1 To 100      
                If ReadFile(0,lecteur+Str(iconex)+"x"+Str(iconeY)+"temp"+Str(i)+ext$)    
                  CloseFile(0)      ; test si le nom du fichier existe  
                Else          
                  UseJPEGImageEncoder() 
                  SaveImage(40,lecteur+Str(iconex)+"x"+Str(iconeY)+"temp"+Str(i)+ext$,#PB_ImagePlugin_JPEG) 
                  dessin=2:Break   ; sauvegarde avec le numero disponible et sortie 
                EndIf 
              Next i 
            EndIf 
            If choix=120 
              For i=1 To 100      
                If ReadFile(0,lecteur+Str(iconex)+"x"+Str(iconexy)+"temp"+Str(i)+ext$)    
                  CloseFile(0)      ; test si le nom du fichier existe  
                Else            
                  UsePNGImageEncoder() 
                  SaveImage(40,lecteur+Str(iconex)+"x"+Str(iconexy)+"temp"+Str(i)+ext$,#PB_ImagePlugin_PNG) 
                  dessin=2:Break   ; sauvegarde avec le numero disponible et sortie 
                EndIf 
              Next i 
            EndIf 
            CloseClipboard_():CloseWindow(5):dessin=2 
            SetActiveWindow(0):HideWindow(1,0):HideWindow(7,0):Break 
         EndSelect 
        EndIf 
      ForEver 
    EndIf          ;}  
    If EventMenu()=112                  ; Efface Change de Couleur 
      compteur=compteur+1:compteurT=compteurT+1 
       CopyImage(0,2+modulo(compteur,nbimg)) 
       Colorb.l=ColorRequester() 
        If Colorb > -1 
          coB1=Red(Colorb):coB2=Green(Colorb):coB3=Blue(Colorb) 
          StartDrawing(ImageOutput(0)) 
           Box(0,0,DesktopWidth(0),DesktopHeight(0),RGB(coB1,coB2,coB3)) 
          StopDrawing() 
          StartDrawing(WindowOutput(0)) 
          Box(0,0,DesktopWidth(0),DesktopHeight(0),RGB(coB1,coB2,coB3)) 
           CopyImage(0,53):CopyImage(0,1)
          StopDrawing():rafraichir():click=2 
         EndIf 
     EndIf 
2ème partie
dans le post suivant
Dernière modification par kernadec le dim. 05/mai/2013 10:10, modifié 32 fois.
Avatar de l’utilisateur
kernadec
Messages : 1606
Inscription : ven. 25/avr./2008 11:14

mise à jours

Message par kernadec »

bonjour
le code précédent a été mis a jours
Je pense avoir résolu le bug de la fenêtre qui copier le bureau en fond d’écran
après quelque temps d’utilisation, enfin j'espère que le problème n'est plus là!.
J’ai ajouter aussi un mini zoom avec l’aide de Little_magnifier.pb de code archive
pour une meilleure utilisation.
Avatar de l’utilisateur
kernadec
Messages : 1606
Inscription : ven. 25/avr./2008 11:14

mise a jours

Message par kernadec »

bonjour
ce week end j'avais un peu de temps,
alors voila quelques petites modifs:
la taille de la loupe à été agrandie
sauvegarde auto du clipboard avec choix du format
avec la dimension du cadre de selection.
sauvegarde avec incrémentation des numeros d'images
sans ecrasement jusqu'a 100 images.. ooops!
et aussi importation d'images

Cordialement

2ème Partie : Fonctionne avec PB 5.11

Code : Tout sélectionner

;{-Window 6 122-(602-612) ; Taille Fenêtre  
     If EventMenu()=122 
       If OpenWindow(6,20,150,180,70,"Dimension Window",#PB_Window_SystemMenu) 
         StringGadget(602,52,10,30,20,Str(WindowWidth(0)-2),#PB_String_Numeric) 
         SendMessage_(GadgetID(602),#EM_LIMITTEXT,4,0) 
         TextGadget(604,5,14,50,20,"Dimen. X") 
         StringGadget(606,132,10,30,20,Str(WindowHeight(0)-22),#PB_String_Numeric) 
         SendMessage_(GadgetID(606),#EM_LIMITTEXT,4,0) 
         TextGadget(608,85,14,50,20,"Dimen. Y") 
         ButtonGadget(610,20,40,60,20,"Annuler") 
         ButtonGadget(612,100,40,60,20,"OK") 
       EndIf 
       Repeat 
         Event6=WindowEvent() 
           Select Event6 
             Case #PB_Event_CloseWindow 
               CloseWindow(6):Break 
           EndSelect 
           If Event6=#PB_Event_Gadget 
               Select EventMenu() 
                Case 610 
                  CloseWindow(6):Break 
                Case 612 
                  HideWindow(6,1):redrawimage() 
                  ResizeWindow(0,WindowX(0),WindowY(0),Val(GetGadgetText(602))+2,Val(GetGadgetText(606))+22) 
                  SetGadgetText(602,Str(WindowWidth(0)+2)) 
                  SetGadgetText(606,Str(WindowHeight(0)+22)) 
                  CloseWindow(6):Break 
              EndSelect 
           EndIf 
       ForEver 
     EndIf           ;} 
    Case #PB_Event_Gadget    
        Case #WM_LBUTTONDOWN   ; commande qui fonctionne à présent?
          MBState=#True 
          mx0=WindowMouseX(0):my0=WindowMouseY(0) 
         If click=0:click=1:Else:click=0:EndIf 
          CopyImage(0,2+modulo(compteur,nbimg))       ; creation un image pour annulation 
         If dessin=7 Or dessin=5 Or dessin=10 Or dessin=20 Or dessin=60 Or dessin=62 Or dessin=63 Or dessin=64 Or dessin=66 Or dessin=68 
           departclic=departclic+1 
            If departclic=1:pax=mx0:pay=my0:EndIf 
            If departclic=2:pbx=mx0:pby=my0:EndIf 
             If click=1 
               rafraichir()                           ; sauvegarde dessin
               StartDrawing (ImageOutput(0)) 
                CopyImage(1,0) 
               StopDrawing() 
               MBState=#False 
               redrawimage() 
               If departclic=>3 
                departclic=0 
                click=0 
                compteur=compteur+1:compteurT=compteurT+1 
                EndIf 
              EndIf 
          EndIf 
          If  dessin=14 Or dessin=16 Or dessin=22 Or dessin=24 Or dessin=26 Or dessin=54 Or dessin=56 Or dessin=58 Or dessin=100 
            If click=1 
                rafraichir()                           ; sauvegarde dessin
                StartDrawing (ImageOutput(0)) 
                  CopyImage(1,0) 
                StopDrawing() 
                MBState=#False:redrawimage():departclic=0:click=1 
                compteur=compteur+1:compteurT=compteurT+1 
             EndIf 
          EndIf 
          If dessin=1   
            If clicklg=1:mx0=mx1:my0=my1:EndIf       ; pour eviter les blanc entre les lignes Chainées 
              If click2=0 
                click2=1                              ; filtre clic du compteur 
              Else 
               compteur=compteur+1:compteurT=compteurT+1    
              EndIf 
                rafraichir()                           ; sauvegarde dessin
                StartDrawing (ImageOutput(0)) 
                  CopyImage(1,0) 
                StopDrawing() 
               clicklg=1 
            EndIf 
           If dessin=108  Or dessin=124             ; gomme box et clipboard 
               SetCapture_(hwnd) 
               r\left=WindowMouseX(0):r\top=WindowMouseY(0) 
           EndIf 
    Case   #WM_LBUTTONDBLCLK 
        If dessin=2                                   ; mesures 
          MBState=#False 
           StartDrawing(ImageOutput(1)) 
             Plot(mx1+1,my1,RGB(co1,co2,co3)):Plot(mx1-1,my1,RGB(co1,co2,co3)) 
             Plot(mx1,my1+1,RGB(co1,co2,co3)):Plot(mx1,my1-1,RGB(co1,co2,co3)) 
             Plot(mx1,my1,RGB(255-co1,255-co2,255-co3)):CopyImage(1,0) 
           StopDrawing():redrawimage() 
           compteur=compteur+1:compteurT=compteurT+1 
        EndIf 
        If dessin=104                                 ; double clic remplir 
          StartDrawing (WindowOutput(0)) 
           FillArea(WindowMouseX(0),WindowMouseY(0),RGB(co1,co2,co3),RGB(aireco1,aireco2,aireco3)) 
          StopDrawing():rafraichir() 
            CopyImage(0,2+modulo(compteur,nbimg)) 
            compteur=compteur+1:compteurT=compteurT+1 
            CopyImage(0,2+modulo(compteur,nbimg)) 
        EndIf 
    Case #WM_LBUTTONUP 
          If dessin=1 Or dessin=2 Or dessin=7 Or dessin=5  Or dessin=10 Or dessin=14 Or dessin=16 Or dessin=20 Or dessin=22 Or dessin=24 Or dessin=26 Or dessin=54 Or dessin=56 Or dessin=58 Or dessin=60 Or dessin=62 Or dessin=63 Or dessin=64 Or dessin=66 Or dessin=68 Or dessin=100 
            MBState=#True                           ; fonction d'objet attacher au curseur non appuyer 
            If dessin>1 
              CopyImage(0,2+modulo(compteur,nbimg))        ; sauvegarde image ligne chainée 
            EndIf 
          Else 
            MBState=#False 
            StartDrawing (WindowOutput(0)) 
              CopyImage(1,0) 
            StopDrawing() 
          EndIf 
          If dessin=98 
             rafraichir()                           ; sauvegarde dessin
            StartDrawing (ImageOutput(0)) 
              CopyImage(1,0) 
            StopDrawing() 
          EndIf 
          If dessin=108                                 ; gomme box 
            StartDrawing (WindowOutput(0)) 
              DrawingMode(1) 
              Box(r\left,r\top ,r\right-r\left ,r\bottom-r\top,Point(1,1)) 
            StopDrawing():rafraichir() 
              DeleteObject_(old) 
              ReleaseCapture_() 
            StartDrawing (WindowOutput(0)) 
              CopyImage(1,0) 
            StopDrawing() 
          EndIf 
          If dessin=110 
            rafraichir()                           ; sauvegarde dessin
            StartDrawing (ImageOutput(0)) 
              CopyImage(1,0) 
            StopDrawing() 
          EndIf 
          If dessin=124                                ; clipboard 
              DeleteObject_(old) 
             InvalidateRect_(hwnd,#Null,#True) 
             ReleaseCapture_() 
             CloseClipboard_() 
             DeleteDC_(trgDC) 
             ReleaseDC_(BMPHandle,srcDC) 
             DeleteDC_(srcDC) 
             HideWindow(7,0) 
            redrawimage() 
            EndIf 
          If clipb=124 
              hBitmap = GetClipboardImage( #PB_Any ) 
                If hBitmap 
                  For i=1 To 100      
                    If ReadFile(0,lecteur+Str(iconex)+"x"+Str(iconeY)+"temp"+Str(i)+".bmp")    
                      CloseFile(0)              ; test si le nom du fichier existe  
                    Else          
                      SaveImage(hBitmap,lecteur+Str(iconex)+"x"+Str(iconeY)+"temp"+Str(i)+".bmp",#PB_ImagePlugin_BMP) 
                      clipb=0:dessin=1:Break   ; sauvegarde avec le numero disponible et sortie 
                    EndIf 
                  Next i 
                Else 
                  MessageRequester("Avertissement "," Pas d'image dans le presse-papiers",0) 
                EndIf 
            redrawimage() 
          EndIf  
          If clipb=126 
              hBitmap = GetClipboardImage( #PB_Any ) 
                If hBitmap 
                  UseJPEGImageEncoder() 
                    For i=1 To 100      
                      If ReadFile(0,lecteur+Str(iconex)+"x"+Str(iconeY)+"temp"+Str(i)+".jpg")    
                        CloseFile(0)              ; test si le nom du fichier existe  
                      Else          
                        SaveImage(hBitmap,lecteur+Str(iconex)+"x"+Str(iconeY)+"temp"+Str(i)+".jpg",#PB_ImagePlugin_JPEG) 
                        clipb=0:dessin=1:Break   ; sauvegarde avec le numero disponible et sortie 
                      EndIf 
                    Next i 
                Else 
                  MessageRequester("Avertissement "," Pas d'image dans le presse-papiers",0) 
                EndIf 
            redrawimage() 
          EndIf 
          If clipb=128 
              hBitmap = GetClipboardImage( #PB_Any ) 
                If hBitmap 
                  UsePNGImageEncoder() 
                    For i=1 To 100      
                      If ReadFile(0,lecteur+Str(iconex)+"x"+Str(iconeY)+"temp"+Str(i)+".png")    
                        CloseFile(0)              ; test si le nom du fichier existe  
                      Else          
                        SaveImage(hBitmap,lecteur+Str(iconex)+"x"+Str(iconeY)+"temp"+Str(i)+".png",#PB_ImagePlugin_PNG) 
                        clipb=0:dessin=1:Break   ; sauvegarde avec le numero disponible et sortie 
                      EndIf 
                    Next i 
                Else 
                  MessageRequester("Avertissement "," Pas d'image dans le presse-papiers",0) 
                EndIf 
                redrawimage() 
          EndIf    
    Case  #WM_RBUTTONDOWN 
         departclic=0 
          If dessin=1 Or dessin=2                    ; Ligne Chainée mesures point de repere 
            MBState=#False:clicklg=0:redrawimage() 
              If click2=1 
                click2=0:click=0:CopyImage(0,2+modulo(compteur,nbimg))   ; sortie et sauvegarde image ligne chainée 
              EndIf 
          EndIf 
          If  dessin=7 Or dessin=5 Or dessin=10 Or dessin=60 Or dessin=62 Or dessin=64 Or dessin=66 Or dessin=68 
            MBState=#False:redrawimage():departclic=0:click=0   ; sortie de fonction avec clic droit 
          EndIf 
          If dessin=14 Or dessin=16 Or dessin=22 Or dessin=24 Or dessin=26 Or dessin=54 Or dessin=56 Or dessin=58 Or dessin=100 
           MBState=#False:redrawimage():departclic=0:click=1   ; sortie de fonction avec clic droit 
          EndIf 
              Case #WM_MOUSEMOVE 
          If MBState=#True 
            mx1=WindowMouseX(0):my1=WindowMouseY(0) 
            StartDrawing (WindowOutput(0)) 
              DrawImage(ImageID(0),0,0,WindowWidth(0),WindowHeight(0)) 
              DrawingMode(1|4) 
            StopDrawing() 
            x2=Pow(Abs(mx0-mx1),2):y2=Pow(Abs(my0-my1),2):Radius=Sqr(x2+y2)                    
            x2=mx0-mx1:y2=my0-my1:angle_mouse_clic(mx0,my0,mx1,my1) 
            If dessin=1  Or dessin=2                 ; Ligne Chainée mesures point de repere 
              Lin(mx0,my0,mx1,my1,Epais,RGB(co1,co2,co3),style)
              angle_mouse_clic(mx0,my0,mx1,my1)     ; mesures 
              dist1=Right(Str(Radius+10000),4):mes1$="Dist:" 
              anglecur=Right(StrD((zRad/#PI*180)+1000,2),6):mes2$=" Ang:" 
              If anglecur="-1.#J":anglecur="0":EndIf 
          EndIf 
          If dessin=7                              ; Bissectrice en 3 point 
            If departclic=2 
              If click=0 
                pcx=mx1:pcy=my1:angle_mouse_clic(pax,pay,pbx,pby) 
                angopa=zRad/#PI*180:x4=Pow(Abs(pax-pbx),2) 
                y4=Pow(Abs(pay-pby),2):ray= Sqr(x4+y4)/2                  
                x4=pax+Cos(zRad)*ray:y4=pay+Sin(zRad)*ray 
                angle_mouse_clic(pax,pay,pcx,pcy):angopc=zRad/#PI*180 
                angp=modulo(((angopc+360)-angopa),360) 
                x1=Pow(Abs(pax-pcx),2):y1=Pow(Abs(pay-pcy),2) 
                Hyp1= Sqr(x1+y1):ray=Hyp1*Cos((angp*#PI/180)) 
                x2=pax+Cos(angopa*#PI/180)*ray:y2=pay+Sin(angopa*#PI/180)*ray 
                angle_mouse_clic(pcx,pcy,x2,y2) 
                x3=Pow(Abs(x2-pcx),2):y3=Pow(Abs(y2-pcy),2) 
                Hyp1= Sqr(x3+y3):ray=Hyp1*Cos(#PI) 
                x3=x4+Cos(zRad)*ray:y3=y4+Sin(zRad)*ray    
                If polypt=0 
                  Lin(x4,y4,x3,y3,Epais,RGB(co1,co2,co3),style)  ; mode ligne 
                Else 
                  Ptrepere(x3,y3):Ptrepere(x4,y4)                 ; mode point 
                EndIf 
                angle_mouse_clic(x4,y4,x3,y3) 
                x1=Pow(Abs(x4-x3),2):y1=Pow(Abs(y4-y3),2):Hyp1=Sqr(x1+y1) 
                dist1=Right(Str(Hyp1+10000),4):mes1$="Ray:"  ; mesures  
                anglecur=Right(StrD((zRad/#PI*180)+1000,2),6):mes2$=" Ang:" 
              EndIf  
            EndIf  
          EndIf  
          If dessin=5                             ; Perpendiculaire en 3 point 
            If departclic=2 
              If click=0 
                pcx=mx1:pcy=my1:angle_mouse_clic(pax,pay,pbx,pby) 
                angopa=zRad/#PI*180:angle_mouse_clic(pax,pay,pcx,pcy) 
                angopc=zRad/#PI*180:angp=modulo(((angopc+360)-angopa),360) 
                x1=Pow(Abs(pax-pcx),2):y1=Pow(Abs(pay-pcy),2) 
                Hyp1=Sqr(x1+y1):ray=Hyp1*Cos((angp*#PI/180)) 
                x3=pax+Cos(angopa*#PI/180)*ray:y3=pay+Sin(angopa*#PI/180)*ray 
                If extperp=0                    ; Perpendiculaire mode ligne 
                  Lin(x3,y3,pcx,pcy,Epais,RGB(co1,co2,co3),style) 
                  x1=Pow(Abs(x3-pcx),2):y1=Pow(Abs(y3-pcy),2):Hyp1=Sqr(x1+y1) 
                  angle_mouse_clic(x3,y3,pcx,pcy) 
                EndIf 
                If extperp=1                    ; Perpendiculaire mode point 
                  Ptrepere(pcx,pcy) 
                  x1=Pow(Abs(x3-pcx),2):y1=Pow(Abs(y3-pcy),2):Hyp1=Sqr(x1+y1) 
                  angle_mouse_clic(x3,y3,pcx,pcy) 
                EndIf 
                If extperp=2                    ; Extension mode ligne 
                 Lin(pax,pay,x3,y3,Epais,RGB(co1,co2,co3),style) 
                 x1=Pow(Abs(x3-pax),2):y1=Pow(Abs(y3-pay),2):Hyp1=Sqr(x1+y1) 
                  angle_mouse_clic(pax,pay,x3,y3) 
                EndIf 
                If extperp=3                    ; Extension mode point 
                  Ptrepere(x3,y3) 
                  x1=Pow(Abs(x3-pax),2):y1=Pow(Abs(y3-pay),2):Hyp1=Sqr(x1+y1) 
                  angle_mouse_clic(pax,pay,x3,y3) 
                EndIf 
                  dist1=Right(Str(Hyp1+10000),4):mes1$="Long:"  ; mesures  
                  anglecur=Right(StrD((zRad/#PI*180)+1000,2),6):mes2$=" Ang:" 
              EndIf  
            EndIf 
          EndIf 
          If dessin=10                             ; projeter une droite avec un angle en 3 point 
            If departclic=2 
              If click=0 
                angleb=dec(anglea) 
                angleproject(angleb) 
              EndIf  
            EndIf  
          EndIf 
          If dessin=14                             ; Bloc Rectangle 
            If click=0 
              Rectangle(mx0,my0-1,mx1+1,my1,Epais,RGB(co1,co2,co3),style) 
              dist1=Right(Str(Abs(mx0-mx1)+10000),4):mes1$="CôtA:" 
                anglecur=Right(Str(Abs(my0-my1)+10000),4):mes2$=" CôtB:" 
            EndIf 
          EndIf 
          If dessin=16                            ; Bloc Rectangle Arrondi 
            If click=0 
              RoundRect(mx0,my0-1,mx1+1,my1,Epais,RGB(co1,co2,co3),style,angl1,angl2) 
              dist1=Right(Str(Abs(mx0-mx1)+10000),4):mes1$="CôtA:" 
              anglecur=Right(Str(Abs(my0-my1)+10000),4):mes2$=" CôtB:" 
          EndIf 
          EndIf 
          If dessin=20                            ; Bloc Rectangle en 3 points 
            If departclic=2 
              If click=0 
                pcx=mx1:pcy=my1:angle_mouse_clic(pax,pay,pbx,pby):angopa=zRad/#PI*180 
                angle_mouse_clic(pax,pay,pcx,pcy):angopc=zRad/#PI*180 
                angp=modulo(((angopc+360)-angopa),360):x1=Pow(Abs(pax-pcx),2) 
                y1=Pow(Abs(pay-pcy),2):Hyp1=Sqr(x1+y1):ray=Hyp1*Cos((angp*#PI/180)) 
                x2=pax+Cos(angopa*#PI/180)*ray:y2=pay+Sin(angopa*#PI/180)*ray 
                angle_mouse_clic(pcx,pcy,x2,y2) 
                x3=Pow(Abs(x2-pcx),2):y3=Pow(Abs(y2-pcy),2):Hyp2=Sqr(x3+y3) 
                ray=Hyp2*-1:x3=pax+Cos(zRad)*ray:y3=pay+Sin(zRad)*ray 
                x1=Pow(Abs(x3-pcx),2):y1=Pow(Abs(y3-pcy),2):Hyp1=Sqr(x1+y1) 
                x4=Pow(Abs(x2-pcx),2):y4=Pow(Abs(y2-pcy),2):Hyp2=Sqr(x4+y4) 
                dist1=Right(Str(Abs(Hyp1)+10000),4):anglecur=Right(Str(Abs(Hyp2)+10000),4) 
                If parall=0                                      ; mode Bloc Rectangle 
                  Lin(x3,y3,pcx,pcy,Epais,RGB(co1,co2,co3),style) 
                  Lin(pax,pay,x2,y2,Epais,RGB(co1,co2,co3),style) 
                  Lin(x2,y2,pcx,pcy,Epais,RGB(co1,co2,co3),style) 
                  Lin(pax,pay,x3,y3,Epais,RGB(co1,co2,co3),style) 
                  Lin(pcx,pcy,pcx+1,pcy,Epais,RGB(co1,co2,co3),style) ; bouche trou loll 
                  mes1$="CôtA:":mes2$=" CôtB:"        ; mesures 
                Else                                
                  Lin(x3,y3,pcx,pcy,Epais,RGB(co1,co2,co3),style)   ; parallele mode ligne 
                  mes1$="Long:":mes2$=" Dist:"        ; mesures 
                EndIf 
              EndIf  
            EndIf 
          EndIf 
          If dessin=22                             ; Polygone inscrit 
            If click=0 
              x2=Pow(Abs(mx0-mx1),2):y2=Pow(Abs(my0-my1),2) 
              Radius= Sqr(x2+y2):raydemiang=0 
              EllipseWithRotation(mx0,my0,Radius,Radius,0,360,Epais ,RGB(co1,co2,co3),style,ncote,1) 
              mire(mx0,my0):angle_mouse_clic(mx0,my0,mx1,my1) 
              dist1=Right(Str(Radius+10000),4):mes1$="Ray:"      
              anglecur=Right(StrD((zRad/#PI*180)+1000,2),6):mes2$=" Ang:" 
            EndIf 
          EndIf 
          If dessin=24                             ; Polygone circonscrit 
            If click=0 
              Radius=((Radius/2)/Cos(((360/ncote)/2)*#PI/180)*2):raydemiang=((360/ncote)/2)*#PI/180 
              EllipseWithRotation(mx0,my0,Radius,Radius,0,360,Epais,RGB(co1,co2,co3),style,ncote,1) 
              mire(mx0,my0):angle_mouse_clic(mx0,my0,mx1,my1) 
              x2=Pow(Abs(mx0-mx1),2):y2=Pow(Abs(my0-my1),2):Hyp1=Sqr(x2+y2) 
              dist1=Right(Str(Hyp1+10000),4):mes1$="Ray:"      
              anglecur=Right(StrD((zRad/#PI*180)+1000,2),6):mes2$=" Ang:" 
            EndIf 
          EndIf 
          If dessin=26                             ; Polygone par le coté 
            If click=0 
              If polypt=0 
                Lin(mx0,my0,mx1,my1,Epais,RGB(co1,co2,co3),style)                ; mode lignes 
              Else  
                Ptrepere(mx0,my0)                                                ; mode point 
              EndIf 
              angle_mouse_clic(mx0,my0,mx1,my1) 
              angp=((180-(360/ncote))/2)*#PI/180:ray=(Radius/2)/Cos(angp)          
              x3=mx0+Cos(zRad-angp)*ray:y3=my0+Sin(zRad-angp)*ray:ray1=zRad 
              x2=Pow(Abs(mx0-x3),2):y2=Pow(Abs(my0-y3),2):ray= Sqr(x2+y2) 
              angle_mouse_clic(mx0,my0,x3,y3):mire(x3,y3) 
              mx1=x5:my1=y5:angp=((360/ncote)*#PI/180) 
              For i=1 To ncote 
                x4=x3-Cos(zRad-(angp*i))*ray:y4=y3-Sin(zRad-(angp*i))*ray 
                If (x5<>0 And y5<>0) 
                  If polypt=0 
                    Lin(x5,y5,x4,y4,Epais,RGB(co1,co2,co3),style)                 ; mode lignes 
                  Else 
                    Ptrepere(x5,y5):Ptrepere(x4,y4)                               ; mode point 
                  EndIf 
                  x1=Pow(Abs(x5-x4),2):y1=Pow(Abs(y5-y4),2):Hyp1=Sqr(x1+y1) 
                  dist1=Right(Str(Hyp1+10000),4):mes1$="Côté"      
                  anglecur=Right(StrD((ray1/#PI*180)+1000,2),6):mes2$=" Ang:" 
                EndIf  
                x5=x3-Cos(zRad-(angp*i))*ray:y5=y3-Sin(zRad-(angp*i))*ray 
              Next i 
              x5=0:y5=0 
            EndIf 
          EndIf 
          If dessin=54                                ; cercle centre 
            If click=0 
              x2=Pow(Abs(mx0-mx1),2):y2=Pow(Abs(my0-my1),2):Radius=Sqr(x2+y2) 
              EllipseWithRotation(mx0,my0,Radius,Radius,0,360,Epais,RGB(co1,co2,co3),style,0,0) 
              Ptrepere(mx0,my0-Radius):Ptrepere(mx0,my0+Radius)  
              Ptrepere(mx0-Radius,my0):Ptrepere(mx0+Radius,my0) 
              mire(mx0,my0):angle_mouse_clic(mx0,my0,mx1,my1) 
              dist1=Right(Str(Radius+10000),4):mes1$="Ray:"  ; mesures  
              anglecur=Right(StrD((zRad/#PI*180)+1000,2),6):mes2$=" Ang:" 
            EndIf  
          EndIf 
          If dessin=56                              ; cercle par le diametre 
            If click=0 
              ray=(Radius/2)/Cos(#PI) 
              x3=mx0+Cos(zRad+#PI)*ray:y3=my0+Sin(zRad+#PI)*ray:raydemiang=0 
              EllipseWithRotation(x3,y3,ray,ray,0,360,Epais,RGB(co1,co2,co3),style,0,0) 
              zRad=0:polypt=1:EllipseWithRotation(x3,y3,ray,ray,0,360,1,RGB(co1,co2,co3),0,4,1) 
              mire(x3,y3):angle_mouse_clic(x3,y3,mx1,my1)         ; mesures 
              dist1=Right(Str(Radius+10000),4):mes1$="Diam:"      
              anglecur=Right(StrD((zRad/#PI*180)+1000,2),6):mes2$=" Ang:" 
            EndIf 
          EndIf 
          If dessin=58                             ; cercle excentrer  
            If click=0 
              ray=(Radius)/Cos(#PI) 
              x3=mx0+Cos(zRad-#PI)*ray:y3=my0+Sin(zRad-#PI)*ray:raydemiang=0 
              EllipseWithRotation(x3,y3,ray,ray,0,360,Epais,RGB(co1,co2,co3),style,0,0) 
              zRad=0:polypt=1:EllipseWithRotation(x3,y3,ray,ray,0,360,1,RGB(co1,co2,co3),0,4,1) 
              mire(x3,y3):angle_mouse_clic(mx0,my0,mx1,my1)        ; mesures 
              dist1=Right(Str(Radius+10000),4):mes1$="Ray:"      
              anglecur=Right(StrD((zRad/#PI*180)+1000,2),6):mes2$=" Ang:" 
            EndIf 
          EndIf 
          If dessin=60                             ; construire un cercle par 3 points 
            If departclic=2 
              If click=0 
                Cerclen3point(pax,pay,pbx,pby,mx1,my1):raydemiang=0 
                EllipseWithRotation(ox,oy,Radius,Radius,0,360,Epais,RGB(co1,co2,co3),style,0,0) 
                zRad=0:polypt=1:EllipseWithRotation(ox,oy,Radius,Radius,0,360,1,RGB(co1,co2,co3),0,4,1) 
                mire(ox,oy):angle_mouse_clic(ox,oy,mx1,my1)        ; mesures 
                dist1=Right(Str(Radius+10000),4):mes1$="Ray:"      
                anglecur=Right(StrD((zRad/#PI*180)+1000,2),6):mes2$=" Ang:" 
              EndIf  
            EndIf  
          EndIf 
          If dessin=62                             ; construire un arc par 3 points 
            If departclic=2 
              If click=0 
                pcx=mx1:pcy=my1 
                Cerclen3point(pax,pay,pbx,pby,pcx,pcy) 
                angle_mouse_clic(ox,oy,pax,pay):angopa=zRad/#PI*180 
                angle_mouse_clic(ox,oy,pcx,pcy):angopc=zRad/#PI*180 
                mire(ox,oy):angp=modulo(((angopc+360)-angopa),360) 
                For i=0 To angp-1 
                  x1=ox+Cos(((angopa+i)*#PI/180))*Radius:y1=oy+Sin(((angopa+i)*#PI/180))*Radius 
                  x2=ox+Cos(((angopa+i+1)*#PI/180))*Radius:y2=oy+Sin(((angopa+i+1)*#PI/180))*Radius 
                  Lin(x1,y1,x2,y2,Epais,RGB(co1,co2,co3),style) 
                Next i 
                angle_mouse_clic(ox,oy,mx1,my1)                    ; mesures 
                dist1=Right(Str(Radius+10000),4):mes1$="Ray:"      
                anglecur=Right(StrD((zRad/#PI*180)+1000,2),6):mes2$=" Ang:" 
              EndIf  
            EndIf 
          EndIf 
          If dessin=63                             ; construire un arc par 3 points 
            If departclic=2 
              If click=0 
                pcx=mx1:pcy=my1 
                Cerclen3point(pax,pay,pcx,pcy,pbx,pby) 
                angle_mouse_clic(ox,oy,pax,pay):angopa=zRad/#PI*180 
                angle_mouse_clic(ox,oy,pbx,pby):angopc=zRad/#PI*180 
                mire(ox,oy):angp=modulo(((angopc+360)-angopa),360) 
                For i=0 To angp-1 
                  x1=ox+Cos(((angopa+i)*#PI/180))*Radius:y1=oy+Sin(((angopa+i)*#PI/180))*Radius 
                  x2=ox+Cos(((angopa+i+1)*#PI/180))*Radius:y2=oy+Sin(((angopa+i+1)*#PI/180))*Radius 
                  Lin(x1,y1,x2,y2,Epais,RGB(co1,co2,co3),style) 
                Next i 
                angle_mouse_clic(ox,oy,mx1,my1)                    ; mesures 
                dist1=Right(Str(Radius+10000),4):mes1$="Ray:"      
                anglecur=Right(StrD((zRad/#PI*180)+1000,2),6):mes2$=" Ang:" 
              EndIf  
            EndIf 
          EndIf 
          If dessin=64                             ; ellipse en rotation avec ellongation 
            raydemiang=0 
            If departclic=2 
              If click=0 
                pcx=mx1:pcy=my1:angle_mouse_clic(pax,pay,pbx,pby):angapb=(zRad/#PI*180) 
                x1=Pow(Abs(pax-pbx),2):y1=Pow(Abs(pay-pby),2):xRadius= Sqr(x1+y1) 
                angle_mouse_clic(pax,pay,pcx,pcy):angapc=(zRad/#PI*180) 
                x2=Pow(Abs(pax-pcx),2):y2=Pow(Abs(pay-pcy),2):Radius= Sqr(x2+y2) 
                EllipseWithRotation(pax,pay,Radius,xRadius,0,360,Epais,RGB(co1,co2,co3),style,0,0) 
                mire(pax,pay):angle_mouse_clic(pax,pay,mx1,my1)     ; mesures 
                dist1=Right(Str(Radius+10000),4):mes1$="Ray:"      
                anglecur=Right(StrD((zRad/#PI*180)+1000,2),6):mes2$=" Ang:" 
              EndIf 
            EndIf 
          EndIf 
          If dessin=66                              ; polygone elliptique inscrit 
            raydemiang=0 
            If departclic=2 
              If click=0 
                pcx=mx1:pcy=my1:angle_mouse_clic(pax,pay,pbx,pby):angapb=(zRad/#PI*180) 
                x1=Pow(Abs(pax-pbx),2):y1=Pow(Abs(pay-pby),2):xRadius=Sqr(x1+y1) 
                angle_mouse_clic(pax,pay,pcx,pcy):angapc=(zRad/#PI*180) 
                x2=Pow(Abs(pax-pcx),2):y2=Pow(Abs(pay-pcy),2):Radius=Sqr(x2+y2) 
                EllipseWithRotation(pax,pay,Radius,xRadius,0,360,Epais,RGB(co1,co2,co3),style,ncote,2) 
                mire(pax,pay):angle_mouse_clic(pax,pay,mx1,my1)     ; mesures 
                dist1=Right(Str(Radius+10000),4):mes1$="Ray:"  
                anglecur=Right(StrD((zRad/#PI*180)+1000,2),6):mes2$=" Ang:" 
              EndIf 
            EndIf 
          EndIf 
          If dessin=68                              ; polygone elliptique circonscrit 
            raydemiang=0 
            If departclic=2 
              If click=0 
                pcx=mx1:pcy=my1:angle_mouse_clic(pax,pay,pbx,pby):angapb=(zRad/#PI*180) 
                x1=Pow(Abs(pax-pbx),2):y1=Pow(Abs(pay-pby),2):xRadius= Sqr(x1+y1) 
                angle_mouse_clic(pax,pay,pcx,pcy):angapc=(zRad/#PI*180) 
                x2=Pow(Abs(pax-pcx),2):y2=Pow(Abs(pay-pcy),2):Radius= Sqr(x2+y2) 
                xRadius=(xRadius)*(1/(Cos(((360/ncote)/2)*#PI/180))) 
                Radius=(Radius)*(1/(Cos(((360/ncote)/2)*#PI/180))) 
                EllipseWithRotation(pax,pay,Radius,xRadius,0-((360/ncote)/2),360,Epais,RGB(co1,co2,co3),style,ncote,2) 
                mire(pax,pay):angle_mouse_clic(pax,pay,mx1,my1)     ; mesures 
                dist1=Right(Str(Radius+10000),4):mes1$="Ray:"      
                anglecur=Right(StrD((zRad/#PI*180)+1000,2),6):mes2$=" Ang:" 
              EndIf 
           EndIf 
          EndIf 
         If dessin=98                               ; point  
            StartDrawing (ImageOutput(0)) 
              If Epais=1 
                Plot(WindowMouseX(0),WindowMouseY(0),RGB(co1,co2,co3)) 
              Else 
                Circle(WindowMouseX(0),WindowMouseY(0)-1,Epais-1,RGB(co1,co2,co3)) 
              EndIf 
            StopDrawing() 
          EndIf 
          If dessin=100                             ; Placer text 
            If click=0 
              StartDrawing (WindowOutput(0)) 
                DrawingMode(1):DrawingFont(font0) 
                DrawText(WindowMouseX(0),WindowMouseY(0),tex$,RGB(co1,co2,co3),Point(WindowMouseX(0),WindowMouseY(0))) 
                DrawingMode(1|4) 
              StopDrawing() 
            EndIf 
          EndIf 
          If dessin=108                            ; Gomme avec cadre de selection 
            If EventwParam() & #MK_LBUTTON 
              hdc=GetDC_(hwnd):Epais=1 
              If hdc 
                r\right=WindowMouseX(0):r\bottom=WindowMouseY(0) 
                DrawFocusRect_(hdc,r) 
                StartDrawing (WindowOutput(0)) 
                  Rectangle(r\left,r\top-1,r\right,r\bottom-1,Epais,RGB(co1,co2,co3),2) 
                StopDrawing() 
              EndIf 
            EndIf 
          EndIf 
          If dessin=110                             ; Gomme 
            StartDrawing (ImageOutput(0)) 
              Ellipse(WindowMouseX(0),WindowMouseY(0),5,5,RGB(coB1,coB2,coB3)) 
            StopDrawing() 
          EndIf 
          If dessin=124                             ; clipboard avec cadre de selection 
            HideWindow(7,1) 
            If EventwParam() & #WM_LBUTTONDOWN   ;#MK_LBUTTON 
              hdc=GetDC_(hwnd):Epais=1 
              If hdc 
                r\right=WindowMouseX(0):r\bottom=WindowMouseY(0) 
                DrawFocusRect_(hdc,r) 
                If vista=0                       ; windows xp 
                  CaptureScreen(WindowX(0)+r\left-1,WindowY(0)+ r\top-1 ,r\right-r\left+8 ,r\bottom-r\top+54 ) 
                Else                             ; windows vista 
                  CaptureScreen(WindowX(0)+r\left+2,WindowY(0)+ r\top-4,r\right-r\left+10 ,r\bottom-r\top+56 ) 
                EndIf 
                ReleaseDC_(hwnd,hdc) 
                dist1=Right(Str(Abs(r\right-1-r\left-1)+10000),4):mes1$="ClipX:":iconex=Val(dist1) 
                anglecur=Right(Str(Abs(r\bottom-1-r\top-1)+10000),4):mes2$=" ClipY:":iconeY=Val(anglecur) 
              EndIf 
            EndIf 
          EndIf 
        EndIf 
          StartDrawing(WindowOutput(1)) 
            DrawingMode(0) 
            DrawingFont(FontID(1)) 
            Box(0,0,210,14,Colorp) 
            DrawText(0,0,"MX:"+Tx$+" MY:"+Ty$,RGB(255-coB1,255-coB2,255-coB3),Point(1,1)) 
            DrawText(100,0,mes1$+dist1+mes2$+anglecur,RGB(255-coB1,255-coB2,255-coB3),Point(1,1)) 
            DrawingMode(1|4) 
          StopDrawing() 
          StartDrawing(WindowOutput(0)) 
           x=WindowMouseX(0):y=WindowMouseY(0)
           If x<>-1 And y<>-1
           If Point(x,y)= RGB(255,0,0):coulor=RGB(128,128,128); change couleur curseur si fond rouge 
           Else:coulor=RGB(255,0,0):EndIf:EndIf  
          StopDrawing() 
          GetCursorPos_(cursorpost.POINT) 
          hImage2 = CaptureScreenL(cursorpost\x, cursorpost\y, hImage2,0) 
          SendMessage_(hGadget, #STM_SETIMAGE, #IMAGE_BITMAP, hImage2)
          loupe():Delay(2) 
    Case #SW_SHOWMAXIMIZED 
          MoveWindow_(hwnd2,0,WindowHeight(0)-130,96,96,0) 
          MoveWindow_(hwnd1,2,WindowHeight(0)-34,210,16,0) 
          redrawimage() 
          rafraichir()                           ; sauvegarde dessin
    Case #SW_SHOWMINIMIZED 
          MoveWindow_(hwnd2,0,WindowHeight(0)-130,96,96,0) 
          MoveWindow_(hwnd1,2,WindowHeight(0)-34,210,16,0) 
          redrawimage() 
    Case #WM_SIZE 
          MoveWindow_(hwnd2,0,WindowHeight(0)-130,96,96,0) 
          MoveWindow_(hwnd1,2,WindowHeight(0)-34,210,16,0) 
          redrawimage() 
    Case #PB_Event_CloseWindow 
          CloseWindow(0):Break 
    EndSelect 
      loupe():Delay(2) 
  Until Event=#PB_Event_CloseWindow Or key = 27 
End 
!section '.data' Data readable writeable 
IID_IPicture: 
!DD $07BF80980 
!DW $0BF32, $0101A 
!DB $08B, $0BB, 0, $0AA, 0, $030, $0C, $0AB

Dernière modification par kernadec le dim. 05/mai/2013 10:11, modifié 14 fois.
Avatar de l’utilisateur
Cool Dji
Messages : 1126
Inscription : ven. 05/sept./2008 11:42
Localisation : Besançon
Contact :

Message par Cool Dji »

Hello Kernadec,

Chouette Appli qui présente l'avantage d'offrir des procédures toutes faites pour les formes géométriques.
J'ai joué avec le tracé de lignes chainées et parfois une ligne tracée n'apparait pas.
ça m'a rappelé un bug d'une de mes appli. Cela venait du test bouton souris qui ne prends pas en compte le relachement du clic => si tu restes trop longtemps appuyé, le programme a le temps de prendre le second point en meme temps que le premier, et donc la ligne est sur un seul point.
La soluce : je test un déclic souris et là j'autorise à passer à la suite...
Bon code
Cool Dji
Avatar de l’utilisateur
kernadec
Messages : 1606
Inscription : ven. 25/avr./2008 11:14

Message par kernadec »

Bonjour Cool Dji
merci pour tes encouragement.
Je viens de mettre le code précèdent a jours, et d’ajouter les dimensions
Pour la construction des objets et aussi ajouter avec mesures une fonction
Pour placer des points de construction en alignement avec la distance pixel affichée
A l’aide du double clic

ensuite pour la ligne chaînée j'ai régler le problème en partie,
j’ai déplacé la sauvegarde depuis case MouseUP vers case clic gauche,
mais il reste encore un petit soucis si l'on reste appuyer un cours instant après le clic,
il me fait un blanc ? mais je pense que c'est acceptable pour le moment

je test avec Windows XPSP2, mais je rencontre des problèmes de décalage
du curseur avec les cadres et box de sélection, cela s'est produit sur un XP
plus récent que le mien???. Même chose mais un peut différente sur Vista
mais cela reste aussi un problème de curseur décalé.,
et.. voila ?? maintenant je me retrouve avec le problème des curseurs souris?
un truc pas facile a régler, car je ne possède ni vista ni un XP récent !
mais bien sur toute amélioration et modification de ce code et la bienvenue
Avatar de l’utilisateur
Cool Dji
Messages : 1126
Inscription : ven. 05/sept./2008 11:42
Localisation : Besançon
Contact :

Clic Souris

Message par Cool Dji »

Yo Kernadec,
Je reviens sur le clicleft (au passage, il manque à PB une fonction qui différencie clic appuyé et clic relaché, PB 5.0 ?)
Je débute en PB et je n'ai trouvé que ça pour eviter les bugs.
Je centralise en un seul endroit la gestion de la souris (en début de boucle, après le flipbuffers, par exemple). Je copie les valeurs de la souris dans des variables, ensuite je ne travaille plus qu'avec ces variables (je ne suis pas perturbé par les coordonnées systèmes).

Code : Tout sélectionner

Repeat ; Boucle principale
    FlipBuffers()
    
 ExamineMouse()
    If (ClickLeft =0)  ; la souris peut bouger quand pas de clic (clickleft=0)
      MouseDeltax = MouseX()   
      MouseDeltay = MouseY()   
    EndIf

  If MouseButton(#PB_MouseButton_Left)
    If (ClickLeft=0) : ClickLeft =1 : EndIf
; quand on clic, clickleft=1 (là, ça bloque la souris, le prog fait ce qu'il a à faire et quand les opérations sont terminées, le prog met clickleft=2. Ainsi clickleft peut rester à 1 plusieurs secondes sans perturber les autres opérations => la boucle principale se répète sans soucis)   
  Else
    If ClickLeft=2 : ClickLeft = 0  : EndIf
 ; à ce moment, je rends la liberté à la souris (c'est à dire que je reprends en compte ses mouvements)
    EndIf

; ici, se déroulent les actions dans la boucle
; Calculs
; Affichages

Until EscapeKey=1 ; fin de la boucle principale

Je ne prétends pas que c'est la solution, mais pour l'instant ça me va bien.
Je l'utilise dans un jeu de mémory qui se joue à 1 ou 2 joueurs (une version avec IA pour jouer contre l'ordi est en cours de dev.). Ce sera ma première contribution PB sur le forum.

Sinon, j'ai un XP de deux ans à la maison et un XP tout neuf sur mon portable du boulot. Si je peux t'aider pour tes tests, pas de soucis...
Avatar de l’utilisateur
kernadec
Messages : 1606
Inscription : ven. 25/avr./2008 11:14

Message par kernadec »

bonjour Cool Dji
je te remercie de ton Aide avec ce bout de code
j'ai écrit une version pour le mode fenêtre a partir de ton code
car je n'ai pas utilisé openscreen dans ce code
mais ça n'a rien donner vue que maintenant le problème
est passer en mousedown,
mais je te l'ai dit maintenant pour faire un espace
il faut vraiment rester appuyer et provoquer un déplacement simultané
et rapide pour avoir des ratés.
si l'on fait une utilisation normal plus de soucis
pour le moment je travail pour obtenir une meilleure ergonomie
mais voila le temps me manque malgré une heure de plus ce week-end
et te remercie aussi pour ta proposition de tests a l'occasion
a plus
Avatar de l’utilisateur
kernadec
Messages : 1606
Inscription : ven. 25/avr./2008 11:14

Message par kernadec »

bonjour

le code précèdent a été mis jours désolé, pour toutes ces versions

je viens de modifier le mode d’utilisation de la souris,
maintenant j’ai réussi a obtenir le même genre de commande
dessin que sur Microstation

maintenant toutes les commandes sont avec le clic gauche et droit
pour annuler on est plus obliger de rester appuyer sur le bouton pour
placer les objets, je pense que c’est plus intuitif.
Je n’ai pas régler le problème des cadres de sélection et des blocs avec vista etc..
Mais cela fonctionne mais c’est moins précis désolé pour vista
Avatar de l’utilisateur
kernadec
Messages : 1606
Inscription : ven. 25/avr./2008 11:14

Message par kernadec »

bonsoir
mises du code precedent
je viens d'ajouter au menu polygone le mode point pour
pouvoir tracer des points de repères grâce aux polygones,
et corrigé quelques petites anomalies de sauvegarde clipboard
Avatar de l’utilisateur
kernadec
Messages : 1606
Inscription : ven. 25/avr./2008 11:14

Message par kernadec »

Bonjour
Le code précèdent a été mis a jours

Ajout des constructions de points aux polygones par le côté
Et aussi le mi point avec la bissectrice et la projection d’angle
avec des points de repère.
J’ai rencontré des problèmes avec la fonction Plot ??
Mais bon ! il y a Pset_ qui fonctionne parfaitement !
Backup
Messages : 14526
Inscription : lun. 26/avr./2004 0:40

Message par Backup »

kernadec a écrit : J’ai rencontré des problèmes avec la fonction Plot ??
Plot() fonctionne tres bien !! :D

les deux erreur frénétiquement rencontrées sont dues

1 - erreur d'indice (dans une boucle 0-14 représente 15 éléments)
et cela peut générer des erreurs de dessin, parce qu'on ne tiens pas compte de "l'élément supplémentaire d'une boucle "

2- si plot() écrit en dehors de l'écran, cela reviens a faire un Lpoke() n'importe ou en RAM !!
et là gros plantage !!
cette erreur fréquemment rencontré est d'ailleurs souvent due a l'erreur numero 1 cité ci-dessus ! :D

un indice de trop, et hop , on "Plote" en dehors de l'écran !!
et faut pas hein !! faut pas !! :lol:

les boucles pour l'ecran devraient etre de 0 a 799 pour une resolution de 800x600 par exemple ;)
Avatar de l’utilisateur
kernadec
Messages : 1606
Inscription : ven. 25/avr./2008 11:14

Message par kernadec »

merci mr dobro

mais j'ai perdu le bout de code qui me pauser
probleme avec plot pendant sa correction sinon je l'aurais posté dsl!

mais voila deux sites de oufs de la geometrie:

http://www.zefdamen.nl/CropCircles/en/C ... les_en.htm
http://www.bertjanssen.nl/content/cropc/croprec00.html
Avatar de l’utilisateur
kernadec
Messages : 1606
Inscription : ven. 25/avr./2008 11:14

Message par kernadec »

bonsoir
le code à été mis a jours

avec l'ajout d'une commande de copie parallele,
car en etudiant les dessins des crops circles je me suis
rendu a compte que j'avais omis cette commande

modification la gestion des couleurs des points de repere
pour dessiner avec une couleur de fond de son choix
Avatar de l’utilisateur
Cool Dji
Messages : 1126
Inscription : ven. 05/sept./2008 11:42
Localisation : Besançon
Contact :

Géométrie dans les champs

Message par Cool Dji »

Sympa les tracés géométriques dans les champs...
Merci Kernadec. Je ne suis pas chez moi et n'ai pas PB (je ne peux pas tester ton code).
Je vois bien sous Illustrator comment créer des figures comme dans les champs à partir de géométrie élémentaire, mais sous PB, de manière paramétrée, ça reste encore un peu flou pour moi...
Only PureBasic makes it possible
Avatar de l’utilisateur
kernadec
Messages : 1606
Inscription : ven. 25/avr./2008 11:14

Message par kernadec »

Bonjour
cool Dji je suis content que ça t'intéresse

mais j'ai eu l'occasion de récupérer le film d'une boule de feu
lumineuse au dessus d'un champ de crop, filmée par la fille d'un
ami et après avoir décompose au ralenti le film avec virtual dub
on peut apercevoir une masse compact semblable a une sphère métallique
qui a des des mouvement très ordonnes non visible a l'œil nu.
mais sur le film on se rend compte d'un mouvement circulaire
sur le plan des x ensuite il passe sur le plan y ensuite sur le plan du z
etc.. ce qui est la demonstration quelle suit des reseaux de champs magnétiques et que
ce phénomène n'est après tout que des réactions magnétique entre le sol et le ciel,
un peu comme la foudre qui elle aussi est une boule d'énergie très compacte !
bien sur dans ce domaine il y a des imposture. et puis il y a aussi la nature
et ses mystères

Mise a jour du code précèdent

Ajout d’une commande extension de ligne et point
Qui faisait défaut .
Le mode annuler avec retour avant arrière a été mis à 20 fois
Mises a jours de quelques petites anomalies
Répondre