PureBasic

Enumeration
  #Fenetre_principale
  #Canvas
EndEnumeration

#largeur_colonne=100
#hauteur_ligne=30

Global drag_entete=#False

;Font_entete = LoadFont(#PB_Any, "tahoma"  ,  8, #PB_Font_Bold)

Procedure grille()
  ;CLS
  If StartDrawing(CanvasOutput(#Canvas))
    Box(0, 0, 800, 590, RGB(255,255,255))
    StopDrawing()
  EndIf
 
  ;dessin colonne
  For x=#hauteur_ligne To 800 Step #largeur_colonne
    If StartDrawing(CanvasOutput(#Canvas))
     
      LineXY(x, 0, x, 590, RGB(0,0,255))
      StopDrawing()
    EndIf
  Next x
 
  ;dessin ligne
  For x=#hauteur_ligne To 600 Step #hauteur_ligne
    If StartDrawing(CanvasOutput(#Canvas))
      LineXY(0, x, 800, x, RGB(0,0,255))
      StopDrawing()
    EndIf
  Next x
 
EndProcedure

Procedure entete_colonne()
  ;fond gris
  StartDrawing(CanvasOutput(#Canvas))
  For i=0 To 7
    FillArea(25+(i*100), 25, RGB(0,0,255) , RGB(208,208,208))
    FillArea(15, 15+(i*30), RGB(0,0,255) , RGB(208,208,208))
  Next i
  For i=0 To 6;i=0
    DrawText(70+(i*100),5,Chr(65+i),0,RGB(208,208,208))
    Next i
  StopDrawing()
 
EndProcedure


OpenWindow(#Fenetre_principale, 0, 0, 800, 600, "CanvasGadget", #PB_Window_SystemMenu | #PB_Window_ScreenCentered)
;ScrollAreaGadget(0, 10, 10, 290,120, 375, 155, 30)
CanvasGadget(#Canvas, 0, 10, 800, 590,#PB_Canvas_Border|#PB_Canvas_ClipMouse|#PB_Canvas_Keyboard|#PB_Canvas_DrawFocus)
;   #PB_Canvas_Border   : Draws a border around the gadget.
;   #PB_Canvas_ClipMouse: Automatically clips the mouse To the gadget area While a mouse button is down.
;   #PB_Canvas_Keyboard : Allows the gadget To receive the keyboard focus And keyboard events.
;   #PB_Canvas_DrawFocus: Draws a focus rectangle on the gadget If it has keyboard focus.

grille() ; dessin de la grille
entete_colonne() ;dessin des en-têtes de colonne

Repeat
  Evenement=WaitWindowEvent()
  Select Evenement
    Case #PB_Event_Gadget
      Select EventGadget()
        Case #CANVAS ; Le canvasgadget       
          Select EventType()
            Case #PB_EventType_MouseEnter   
            Case #PB_EventType_MouseLeave 
            Case #PB_EventType_MouseMove     
              cx=GetGadgetAttribute(#CANVAS,#PB_Canvas_MouseX)
              ;     Debug cx
              If drag_entete= #True
                Debug "ok"
                If StartDrawing(CanvasOutput(#Canvas))
                 
                  LineXY(cx-1, 0, cx-1, 600, RGB(255,255,255))
                  LineXY(cx, 0, cx, 600, RGB(0,0,255))
                 
                  StopDrawing()
                EndIf
              EndIf
             
;             Case #PB_EventType_MouseWheel 
;             Case #PB_EventType_LeftButtonDown ;: The left mouse button was pressed           
            Case #PB_EventType_LeftButtonUp    ; The left mouse button was released
              drag_entete= #False
             
            Case #PB_EventType_LeftClick       ; A click With the left mouse button
              cx=GetGadgetAttribute(#CANVAS,#PB_Canvas_MouseX)
              If cx=30 Or cx=130
                drag_entete= #True
                Debug cx
              EndIf
;             Case #PB_EventType_LeftDoubleClick ; A double-click With the left mouse button
;             Case #PB_EventType_RightButtonDown ; The right mouse button was pressed
;             Case #PB_EventType_RightButtonUp   ; The right mouse button was released
            Case #PB_EventType_RightClick      ; A click With the right mouse button
              grille()
              entete_colonne()
             
;             Case #PB_EventType_RightDoubleClick; A double-click With the right mouse button
;             Case #PB_EventType_MiddleButtonDown; The middle mouse button was pressed
;             Case #PB_EventType_MiddleButtonUp  ; The middle mouse button was released
;             Case #PB_EventType_Focus           ; The gadget gained keyboard focus
;             Case #PB_EventType_LostFocus       ; The gadget lost keyboard focus
            Case #PB_EventType_KeyDown         ; A key was pressed
              ;Case #PB_EventType_KeyUp           ; A key was released
;             Case #PB_EventType_Input           ;: Text input was generated   
            Case #PB_EventType_KeyUp
              quitte=GetGadgetAttribute(#CANVAS, #PB_Canvas_Key)
              ;Debug quitte
              If quitte=27;27 = esc
                quit=1
              EndIf
          EndSelect
      EndSelect
     
    Case #PB_Event_CloseWindow
      Select EventWindow()
        Case #Fenetre_principale
          CloseWindow(#Fenetre_principale)
          Break
      EndSelect
  EndSelect
Until quit = 1

; English forum: http://www.purebasic.fr/english/viewtopic.php?t=9263
; Author: einander (updated for PB 4.00 by Andre + edel)
; Date: 22. January 2004
; OS: Windows
; Demo: No


; Problem: innerhalb der Event-Rountine wird zwar offensichtlich die Maus abgefragt, es passiert aber nichts...


;Stretching grid by Einander  (updated Sizes() procedure included)
;PB 3.81 - jan 22-2004

Enumeration
  #grid
  #IMG
EndEnumeration

Global Xmin, Ymin, Xmax, Ymax
Global _X, _Y, XX, YY, s$, MX, MY, MK, mxant, myant
Global  Xpoints, Ypoints

Global Dim Xgrid(0, 0) : Global Dim Ygrid(0, 0) : Global Dim Xstep.f(0) : Global Dim Ystep.f(0)

_X = GetSystemMetrics_(#SM_CXSCREEN) - 8 : _Y = GetSystemMetrics_(#SM_CYSCREEN) - 68
XX = _X / 2 : YY = _Y / 2
; Debug GetSystemMetrics_(#SM_CXSCREEN)
; Debug GetSystemMetrics_(#SM_CYSCREEN)
; Debug _X:Debug _Y
; Debug XX:Debug YY

Global Dim PX(3) : Global Dim PY(3)

Procedure VarL(DIR, i) ; RET ELEM I DEL ARRAY CON DIRECCION DIR
  ProcedureReturn PeekL(DIR + i * 4) ; VALE COMO REEMPLAZO PARA PASAR ARRAYS A PROCS
EndProcedure

Procedure Near(x, y, ArrSize, DIR1, DIR2) ; ; retorna indice del elem de LOS ARRAYS EN DIR1, DIR2 mas Near a x,y
  MIN = $FFFF
  For i = 0 To ArrSize
    A = Sqr(Pow(x - VarL(DIR1, i), 2) + Pow(y - VarL(DIR2, i), 2))
    If A < MIN : MIN = A : IN = i: EndIf
  Next i
  ProcedureReturn IN
EndProcedure

Procedure.s LoadIMG()
  Show$ = "c:\"
  Pat$ = "BitMap (*.BMP)|*.bmp;*.bmp|Jpg (*.jpg)|*.bmp|All files (*.*)|*.*"
  File$ = OpenFileRequester("Choose file to load", Show$, Pat$, 0)
  If File$
    ProcedureReturn File$
  Else
    End
  EndIf
EndProcedure

Procedure MOU(Ev)
  Select Ev
    Case #WM_LBUTTONDOWN
      If MK = 2 : MK = 3 : Else : MK = 1 : EndIf
    Case #WM_LBUTTONUP
      If MK = 3 : MK = 2 : Else : MK = 0 : EndIf
    Case #WM_RBUTTONDOWN
      If MK = 1 : MK = 3 : Else : MK = 2 : EndIf
    Case #WM_RBUTTONUP
      If MK = 3 : MK = 1 : Else : MK = 0 : EndIf
    Case #WM_MOUSEMOVE
      MX = WindowMouseX(0) - GetSystemMetrics_(#SM_CYSIZEFRAME)
      MY = WindowMouseY(0) - GetSystemMetrics_(#SM_CYCAPTION) - GetSystemMetrics_(#SM_CYSIZEFRAME)
  EndSelect
EndProcedure

Procedure Sizes()
  Xmax = 0 : Xmin = _X : Ymax = 0 : Ymin = _Y
  For i = 0 To 3
    x = PX(i) : y = PY(i)
    If x < Xmin : Xmin = x : EndIf
    If x > Xmax : Xmax = x : EndIf
    If y < Ymin : Ymin = y : EndIf
    If y > Ymax : Ymax = y : EndIf
  Next
 
  Xstep(0) = (PX(1) - PX(0)) / Xpoints ; step X horiz sup
  Ystep(0) = (PY(1)-PY(0)) / Xpoints ; step Y HOR SUP
 
  Xstep(1) = (PX(2) - PX(3)) / Xpoints ; stepX HOR INF
  Ystep(1) = (PY(2)-PY(3)) / Xpoints ; step Y HOR INF
 
  Xstep(2) = (PX(3) - PX(0)) / Ypoints ; step X VER IZQ
  Ystep(2) = (PY(3)-PY(0)) / Ypoints ; step Y VER IZQ
 
  Xstep(3) = (PX(2) - PX(1)) / Ypoints ; step X VER DER
  Ystep(3) = (PY(2)-PY(1)) / Ypoints ; step Y VER DER
 
  DXstep1.f=(Xstep(1)-Xstep(0))/Ypoints  ; para calcular posic horiz de cruces internos
  DpX1.f=(PX(3)-PX(0))/Ypoints
  DXstep2.f=(Ystep(1)-Ystep(0))/Ypoints
  DpX2.f=(PY(3)-PY(0))/Ypoints
 
  For j=0 To Ypoints
    For i = 0 To Xpoints  ; posic x  para verticales
      Xgrid(i, j) = (Xstep(0)+DXstep1*j)*i+PX(0)+DpX1*j : Ygrid(i, j) = (Ystep(0)+DXstep2*j)*i+PY(0)+DpX2*j
    Next
  Next
 
  DYstep1.f=(Xstep(3)-Xstep(2))/Xpoints  ; para calcular posic vert de cruces internos
  DpY1.f=(PX(1)-PX(0))/Xpoints
  DYstep2.f=(Ystep(3)-Ystep(2))/Xpoints
  DpY2.f=(PY(1)-PY(0))/Xpoints
 
  For j = 1 To Xpoints
    For i = 1 To Ypoints  ; posic Y  para horizontales
      Xgrid( j,i) = (Xstep(2)+DYstep1*j)*i+PX(0)+DpY1*j  :  Ygrid( j,i) = (Ystep(2)+DYstep2*j)*i+PY(0)+DpY2*j
    Next
  Next
EndProcedure ; _______________________________

Procedure ShowGrid()
  hIMG = CreateImage(#IMG, _X,_Y)
  StartDrawing (ImageOutput(#IMG))
  DrawingMode(1)
  BackColor(RGB(255,255,255))
  Box(0,0, _X,_Y,#White)
  DrawingMode(4)
 
  ;cadrillage de fond
  For i=0 To 7
    LineXY(100*i, 0, 100*i, 600,  #Blue)
    LineXY(0, 100*i, 600, 100*i,  #Blue)
  Next i
 
 
  For i = 0 To 3
    Circle (PX(i) , PY(i) , 8,#Red)
    ;DrawText(PX(i) + 10, PY(i), Str(i))
  Next
  ;Box(Xmin, Ymin, Xmax-Xmin, Ymax-Ymin, #Blue)
 
  For i = 0 To Xpoints ; vertical lines
    LineXY(Xgrid( i, 0), Ygrid( i, 0), Xgrid(i, Ypoints ), Ygrid(i, Ypoints ),  #Green)
  Next
 
  For i = 0 To Ypoints ;horizontal lines
    LineXY(Xgrid(0,i), Ygrid(  0,i), Xgrid( Xpoints,i ), Ygrid( Xpoints,i ),  #Magenta)
  Next
  ;imagegadget
  StopDrawing()
  StartDrawing(WindowOutput(0))
  SetGadgetState(#grid, ImageID(#IMG))
  StopDrawing()
EndProcedure
; ____________________________________________________________________________________________________

OpenWindow(0, 0, 0, _X, _Y, "", #WS_OVERLAPPEDWINDOW |#WS_MAXIMIZE)
;CreateGadgetList(WindowID(0))
ImageGadget(#grid,0,0,0,0,0)

DisableGadget(#grid,#True)

Xpoints = 1 : Ypoints = 1; Here you can choose how many grid lines*********************************
Dim Xgrid (Xpoints , Ypoints )
Dim Ygrid (Xpoints , Ypoints )
Dim Xstep.f(3 ) : Dim Ystep.f(3 )

PX(0) = _X / 2-100 : PY(0) = _Y / 2-100 : PX(1) = PX(0) + 200 : PY(1) = PY(0)
PX(2) = PX(1) : PY(2) = PY(1) + 200 : PX(3) = PX(0) : PY(3) = PY(2)

Sizes() ;calcul des points
ShowGrid() ;creation de l'image + dessin + transfert dans imagegadget

Repeat
  Ev = WaitWindowEvent(10)
 
  MOU(Ev)
 
  If MX <> mxant Or MY <> myant Or MK <> mkant
    If sel=0 :   C = Near(MX, MY, 3, @PX(), @PY()):sel=1:EndIf
    If MK = 1
      PX(C) = MX : PY(C) = MY
      Sizes()
      ShowGrid()
    Else
      sel=0
    EndIf
  EndIf
  mxant = MX : myant = MY : mkant = MK
Until Ev = #PB_Event_CloseWindow
End