PureBasic Forums - English

http://www.purebasic.com
https://www.purebasic.fr/english/

Stretching grid

https://www.purebasic.fr/english/viewtopic.php?t=9263

Page 1 of 1

Stretching grid

Posted: Thu Jan 22, 2004 1:47 pm
by einander
Code updated For 5.20+

Code: Select all

;Stretching grid by Einander
;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
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 ; X horiz sup
  Ystep(0) = (PY(1)-PY(0)) / Xpoints ; Y HOR SUP
  
  Xstep(1) = (PX(2) - PX(3)) / Xpoints ; X HOR INF
  Ystep(1) = (PY(2)-PY(3)) / Xpoints ; Y HOR INF
  
  Xstep(2) = (PX(3) - PX(0)) / Ypoints ; X VER IZQ
  Ystep(2) = (PY(3)-PY(0)) / Ypoints ; Y VER IZQ
  
  Xstep(3) = (PX(2) - PX(1)) / Ypoints ; X VER DER
  Ystep(3) = (PY(2)-PY(1)) / Ypoints ; Y VER DER
  
  For i = 0 To Xpoints  ; posic x  para verticales
    Xgrid(i, 0) = Xstep(0)*i+PX(0)
    Ygrid(i, 0) = Ystep(0)*i+PY(0)
    Xgrid(i, Ypoints) = Xstep(1)*i+PX(3)
    Ygrid(i, Ypoints) = Ystep(1)*i+PY(3)
  Next
  
  For i = 0 To Ypoints  ; posic Y  para horizontales
    Xgrid( 0,i) = Xstep(2)*i+PX(0)
    Ygrid( 0,i) = Ystep(2)*i+PY(0)
    Xgrid(Xpoints,i) = Xstep(3)*i+PX(1)
    Ygrid(Xpoints,i) = Ystep(3)*i+PY(1)
  Next
EndProcedure ; ____________________________________________________________________________________________________________

Procedure ShowGrid()
  hIMG = CreateImage(#IMG, _X,_Y)
  StartDrawing (ImageOutput(#IMG))
  DrawingMode(4)
  BackColor(RGB(0,0,0))
  
  For i = 0 To 3
    Circle (PX(i) , PY(i) , 8,#Yellow)
    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
  
  StopDrawing()
  StartDrawing(WindowOutput(0))
  SetGadgetState(#grid, ImageID(#IMG))
  StopDrawing()
EndProcedure
; ____________________________________________________________________________________________________

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

Xpoints = 28 : Ypoints = 14 ; Here you can choose how many grid lines*********************************
Global Dim Xgrid (Xpoints , Ypoints )
Global Dim Ygrid (Xpoints , Ypoints )
Global Dim Xstep.f(3 ) : Global 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()
ShowGrid()
Repeat
  Ev = WaitWindowEvent()
  MX = WindowMouseX(0) - GetSystemMetrics_(#SM_CYSIZEFRAME)
  MY = WindowMouseY(0) - GetSystemMetrics_(#SM_CYCAPTION) - GetSystemMetrics_(#SM_CYSIZEFRAME)
  If Ev=#WM_LBUTTONDOWN
    MK=1
  ElseIf Ev=#WM_LBUTTONUP
    MK=0
  EndIf
  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

Posted: Thu Jan 22, 2004 4:49 pm
by Fred
Interresting piece of code !

Re: Stretching grid

Posted: Thu Jan 22, 2004 5:27 pm
by traumatic
Cool! 8)

What are you using this for?

Posted: Thu Jan 22, 2004 5:34 pm
by einander
Thanks Fred! :)

; replacing procedure Sizes with this new one, we can store X Y positions for inner line intersections in Xgrid() Ygrid().

Edited loop counter. Now x y positions are correct. (I hope.)

Code: Select all


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 ; _______________________________
____________________________________________________________________________________________________________

Re: Stretching grid

Posted: Thu Jan 22, 2004 5:45 pm
by einander
What are you using this for?
It´s part of a long time project to edit and transform MIDIfiles.
But now I've found it helpful also to transform images.
All times are UTC+01:00
Page 1 of 1

Powered by phpBB® Forum Software © phpBB Limited