PureBasic Forums - English

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

Image Rotate, Pull, Reverse & Stretch - Updated

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

Page 2 of 2

Posted: Mon Feb 28, 2005 9:06 am
by benny
Excellent work, again guys :!: Thanx for sharing.


I just wonder isn't there some WinApi-Functions (e.g. in GDIPlus.dll) which
also do the job :?:


Nevertheless ... powerful code!

Posted: Mon Feb 28, 2005 12:37 pm
by einander
Anthony:
Im confused with my benchmarks:

Your first improvement is faster than mine, but your last one seems slower, tested on both Pentium 3400 and AMD 1477.

Strange: the whole test runs faster on AMD 1477 than on Pentium 3400, so the test is not thrustworthy.

May be AMD is clever than Pentium dealing with empty arrays?

On other benchmarks, this Pentium is (obviously?) much faster then the AMD
Memory read with Lavalys Everest home edition:
Pentium: 5230 MB/S ; AMD: 1848 MB/s

Here is the benchmark code

Code: Select all

Iterations=Val(InputRequester("Iterations","Enter iterations, and then wait",Str(100000)))


Xpoints=1000 : Ypoints=1000
Dim PX(3):Dim PY(3):Dim Xstep.f(3):Dim Ystep.f(3)
Dim Xgrid.f (Xpoints,Ypoints)
Dim Ygrid.f (Xpoints,Ypoints)


Procedure Sizes()    ; my original slower 
    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 HOR top
    Ystep(0) = (PY(1) - PY(0)) / Xpoints ; step Y HOR top 
    
    Xstep(1) = (PX(2) - PX(3)) / Xpoints ; stepX HOR bottom 
    Ystep(1) = (PY(2) - PY(3)) / Xpoints ; step Y HOR bottom 
    
    Xstep(2) = (PX(3) - PX(0)) / Ypoints ; step X VER left 
    Ystep(2) = (PY(3) - PY(0)) / Ypoints ; step Y VER left 
    
    Xstep(3) = (PX(2) - PX(1)) / Ypoints ; step X VER right 
    Ystep(3) = (PY(2) - PY(1)) / Ypoints ; step Y VER right 
    
    DXstep1.f = (Xstep(1) - Xstep(0)) / Ypoints 
    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 
            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 
    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 
            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 Sizes2()   ; your first improvement, slightly faster. My first benchmark was too optimistic!
    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 HOR top 
    Ystep(0) = (PY(1) - PY(0)) / Xpoints ; step Y HOR top 
    
    Xstep(1) = (PX(2) - PX(3)) / Xpoints ; stepX HOR bottom 
    Ystep(1) = (PY(2) - PY(3)) / Xpoints ; step Y HOR bottom 
    
    Xstep(2) = (PX(3) - PX(0)) / Ypoints ; step X VER left 
    Ystep(2) = (PY(3) - PY(0)) / Ypoints ; step Y VER left 
    
    Xstep(3) = (PX(2) - PX(1)) / Ypoints ; step X VER right 
    Ystep(3) = (PY(2) - PY(1)) / Ypoints ; step Y VER right 
    
    DXstep1.f = (Xstep(1) - Xstep(0)) / Ypoints 
    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 
        TempA.f=Xstep(0)+DXstep1*J 
        TempB.f=PX(0)+DpX1*J 
        TempC.f=Ystep(0)+DXstep2*J 
        TempD.f=PY(0)+DpX2*J 
        For i = 0 To Xpoints 
            Xgrid(i,J)=TempA*i+TempB: Ygrid(i,J)=TempC*i+TempD 
        Next 
    Next 
    
    DYstep1.f = (Xstep(3) - Xstep(2)) / Xpoints 
    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 
        TempA.f=Xstep(2)+DYstep1*J 
        TempB.f=PX(0)+DpY1*J 
        TempC.f=Ystep(2)+DYstep2*J 
        TempD.f=PY(0)+DpY2*J 
        For i = 1 To Ypoints 
            Xgrid(J,i)=TempA*i+TempB:Ygrid(J,i)=TempC*i+TempD 
        Next 
    Next 
EndProcedure ; _______________________________ 

Procedure Sizes3()  ; your last modification, slower
    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 HOR top 
    Ystep(0) = (PY(1) - PY(0)) / Xpoints ; step Y HOR top 
    
    Xstep(1) = (PX(2) - PX(3)) / Xpoints ; stepX HOR bottom 
    Ystep(1) = (PY(2) - PY(3)) / Xpoints ; step Y HOR bottom 
    
    Xstep(2) = (PX(3) - PX(0)) / Ypoints ; step X VER left 
    Ystep(2) = (PY(3) - PY(0)) / Ypoints ; step Y VER left 
    
    Xstep(3) = (PX(2) - PX(1)) / Ypoints ; step X VER right 
    Ystep(3) = (PY(2) - PY(1)) / Ypoints ; step Y VER right 
    
    DXstep1.f = (Xstep(1) - Xstep(0)) / Ypoints 
    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 
        TempA.f=Xstep(0)+DXstep1*J 
        TempB=PX(0)+DpX1*J 
        TempC.f=Ystep(0)+DXstep2*J 
        TempD=PY(0)+DpX2*J 
        For i = 0 To Xpoints 
            Xgrid(i,J)=TempA*i+TempB: Ygrid(i,J)=TempC*i+TempD 
        Next 
    Next 
    
    DYstep1.f = (Xstep(3) - Xstep(2)) / Xpoints 
    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 
        TempA.f=Xstep(2)+DYstep1*J 
        TempB=PX(0)+DpY1*J 
        TempC.f=Ystep(2)+DYstep2*J 
        TempD=PY(0)+DpY2*J 
        For i = 1 To Ypoints 
            Xgrid(J,i)=TempA*i+TempB:Ygrid(J,i)=TempC*i+TempD 
        Next 
    Next 
EndProcedure 

Ti=GetTickCount_()  ; testing Sizes old
For i=0 To Iterations :    Sizes() :Next
elapsed1=GetTickCount_()-Ti
    
Ti=GetTickCount_()   ; testing Sizes 1 : slightly faster
For i=0 To Iterations :   Sizes2() :Next
elapsed2=GetTickCount_()-Ti
    
Ti=GetTickCount_()   ;esting Sizes 2  ; slower
For i=0 To Iterations :    Sizes3() :Next
elapsed3=GetTickCount_()-Ti

MessageRequester(Str(Iterations)+" Iterations","Procedure 1 : "+Str(elapsed1)+Chr(10)+"Procedure 2 : "+Str(elapsed2)+Chr(10)+"Procedure 3 : "+Str(elapsed3),0)

Posted: Mon Feb 28, 2005 12:58 pm
by DoubleDutch
It must just take longer to do the conversion from ints to floats that I thought. :(

never mind...

-Anthony

Posted: Mon Feb 28, 2005 1:00 pm
by einander
Thanks Benny!
I just wonder isn't there some WinApi-Functions (e.g. in GDIPlus.dll) which
also do the job :?:
I've found this about GDIplus:
TrafficStatistic News has shown a demo pic exploiting the Microsoft gdiplus.dll vulnerability
Heise.de found a toolkit with graphical user interface to create malicious jpegs. The user of the toolkit can just enter any URI from the world wide web to a program and a vulnerable system or application will automatically download and execute this program when encountering a so prepared jpeg.
http://www.trafficstatistic.com/news/news_item_342.html

Posted: Mon Feb 28, 2005 3:31 pm
by benny
@einander:

Thanx for the info.

That's definately a pro for using your routine ;-) !

Posted: Wed May 04, 2005 10:47 pm
by akee
WOW!!!! :shock: COOL!!!! 8)

Posted: Sun Mar 29, 2009 5:14 pm
by einander
Updated for PB 4.30
Edited to remove Clip Procedures

Code: Select all


Structure PointF :  X.f : Y.f : EndStructure
Structure FLEX
  pt.POINT
  Plg.POINT[4]
  Vertx.POINT[4]
  s1.f[4]
  S2.PointF[4]
EndStructure

Global __Hatch,__Rim
Global _Brush,_BrushRGB,_BrushStyle
Global _DRAWING,_Grid,_Mode
Global _MyFont10=FontID(LoadFont(-1,"Arial",10))
Global _OldBrush,_Pen,_PenRGB,_PenStyle,_ShowCornerNumbers=1,_Showflag=1
Global _X,_Xmax,_Xmin,_Y,_Ymax,_Ymin

Global Dim Color(0, 0) 
Global Dim Grid.POINT(0, 0)  
Global _Flex.FLEX

Title$ = "Image Rotate, Pull, Reverse & Stretch" 
   
UseJPEGImageDecoder() 
UseJPEGImageEncoder() 
UsePNGImageDecoder() 
UsePNGImageEncoder() 
UseTGAImageDecoder() 
UseTIFFImageDecoder() 
#DBLUE=$660000
#LBLUE=$FFFCC2
Enumeration 
  #ImGad 
  #IMG 
  #IMG2 
  #Open
  #SaveAs
  #CornerNumbers
  #Quit      
  #HorVer
  #Diag
  #Grid
  #GridIMG
EndEnumeration 
  
Macro MMx :  WindowMouseX(EventWindow()) : EndMacro
Macro MMy :  WindowMouseY(EventWindow()) : EndMacro
Macro MMK
  Abs(GetAsyncKeyState_(#VK_LBUTTON) +GetAsyncKeyState_(#VK_RBUTTON)*2+GetAsyncKeyState_(#VK_MBUTTON)*3)/$8000   
EndMacro
 
Macro MouseOverGad ;- MouseOverGad : ret GadgetID under mouse
  WindowFromPoint_(MMx|MMy<<32)
EndMacro
  
Macro LoBound(A,B) :  If A<B :A=B:EndIf : EndMacro
Macro HiBound(A,B) :  If A>B :A=B:EndIf : EndMacro
  
Procedure InMousEX(X,Y,X1,Y1)
  SetRect_(rc.RECT,X,Y,X1,Y1)
  ProcedureReturn PtInRect_(@rc,MMx|MMy<<32)
EndProcedure
  
Macro STOPDRAW  ;- StopDraw
  If _DRAWING
StopDrawing() : _DRAWING=0: EndIf 
EndMacro
  
Macro DrawIMG(IMG) ;- DrawIMG(IMG) ; #ImageOutput=2
  STOPDRAW
_DRAWING=StartDrawing(ImageOutput(IMG)) ;<
EndMacro
  
Procedure Min(A,B)
  If A<B:ProcedureReturn A:EndIf
  ProcedureReturn B
EndProcedure
  
Procedure  ClsImg(IMG,RGB=0) ;-ClsImg(IMG,RGB=0) 
  DrawIMG(IMG)
  Box(0,0,ImageWidth(IMG),ImageHeight(IMG),RGB)
EndProcedure 
  
Macro DelBrush()   ;-DelBrush()
  If _Brush :DeleteObject_(_Brush) :EndIf
  _Brush=0
  If _OldBrush : SelectObject_(_DRAWING, _OldBrush) : EndIf
  _BrushRGB=0
EndMacro 
  
Procedure  Brush(BrushRGB,style=#BS_SOLID,Hatch=0)  ;- Brush(BrushRGB,Style=#BS_SOLID,Hatch=0) #BS_HOLLOW, #BS_PATTERN
  Protected L.LOGBRUSH
  DelBrush()
  L\lbStyle=style
  L\lbColor=BrushRGB
  L\lbHatch=Hatch
  _Brush = CreateBrushIndirect_(@L) 
  _OldBrush=SelectObject_(_DRAWING,_Brush)
  _BrushRGB=BrushRGB
  _BrushStyle=style
  __Hatch=Hatch
EndProcedure  
   
Macro DelPen() ;- DelPen
  If _Pen: DeleteObject_(_Pen) :EndIf
  _Pen=0: _PenRGB=0:__Rim=0
EndMacro
  
Macro Pen(Rim=1, PenRGB=0,style=#PS_SOLID) ;-  Pen(Rim=1, PenRGB=0,style=#ps_solid)
  DelPen()
  If style=#NULL_PEN
    _Pen= SelectObject_(_DRAWING,GetStockObject_ ( #NULL_PEN ))
  Else
    _Pen=CreatePen_(style,Rim,PenRGB)   
    SelectObject_(_DRAWING,_Pen) 
  EndIf
  __Rim=Rim
  _PenRGB=PenRGB
  _PenStyle=style
EndMacro
      
Procedure CenterTXT(X,Y,Wi,He,T.S)  
  
  Protected TextWidth=TextWidth(T),TextHeight=TextHeight(T)
  Protected X1=X+Wi,Y1=Y+He
  If TextWidth>Wi :  DrawText(X,(Y+Y1)/2-TextHeight/2 , T)
  Else :  DrawText((X+X1)/2-TextWidth/2, (Y1+Y)/2-TextHeight/2 , T)
  EndIf
EndProcedure
  
Procedure  Corners() ;-  draw corners
  Protected i
  With _Flex
    DrawingFont(_MyFont10)
    FrontColor(#LBLUE):BackColor(#DBLUE)
    For i = 0 To 3 
      Circle (\Vertx[i]\X , \Vertx[i]\Y, 9,#DBLUE) 
      CenterTXT(\Vertx[i]\X-5,\Vertx[i]\Y-5,10,10,Str(i)) 
    Next 
  EndWith
EndProcedure
   
Procedure Bounding() ;- Bounding()
  Protected i
  With _Flex
    _Xmax=0 : _Xmin=$FFFFFF:_Ymax=0:_Ymin=$FFFFFF
    For i = 0 To 3   
      HiBound(_Xmin,\Vertx[i]\X)
      LoBound(_Xmax,\Vertx[i]\X)
      HiBound(_Ymin,\Vertx[i]\Y)
      LoBound(_Ymax,\Vertx[i]\Y)
    Next 
  EndWith
EndProcedure 
  
Procedure  STP(A,B,C,D,E)  ;- STP(A,B,C,D,E)  - aux de Sizes
  With _Flex
    \s1[0]   = (\S2[A]\X - \S2[B]\X) / E 
    \s1[1]   = (_Flex\Vertx[C]\X - _Flex\Vertx[D]\X) / E 
    \s1[2]   = (\S2[A]\Y    - \S2[B]\Y)   / E 
    \s1[3]   = (_Flex\Vertx[C]\Y - _Flex\Vertx[D]\Y) / E 
  EndWith
EndProcedure
   
Procedure  Sizes() 
  Protected i,j,A.f,B.f,C.f,D.f
  With _Flex
    Bounding()
    \S2[0]\X = (\Vertx[1]\X - \Vertx[0]\X)  / \pt\X ; step X HOR TOP
    \S2[0]\Y = (\Vertx[1]\Y - \Vertx[0]\Y)  / \pt\X ; step Y HOR TOP
    \S2[1]\X = (\Vertx[2]\X - \Vertx[3]\X)  / \pt\X ; step X HOR BOTTOM
    \S2[1]\Y = (\Vertx[2]\Y - \Vertx[3]\Y)  / \pt\X ; step Y HOR BOTTOM
    \S2[2]\X = (\Vertx[3]\X - \Vertx[0]\X)  / \pt\Y ; step X VER LEFT
    \S2[2]\Y = (\Vertx[3]\Y - \Vertx[0]\Y)  / \pt\Y ; step Y VER LEFT
    \S2[3]\X = (\Vertx[2]\X - \Vertx[1]\X)  / \pt\Y ; step X VER RIGHT
    \S2[3]\Y = (\Vertx[2]\Y - \Vertx[1]\Y)  / \pt\Y ; step Y VER RIGHT
    
    STP(1,0,3,0,\pt\Y)
    
    For j = 0 To \pt\Y 
      A=\S2[0]\X     +\s1[0]*j 
      B=\Vertx[0]\X  +\s1[1]*j 
      C=\S2[0]\Y     +\s1[2]*j 
      D=\Vertx[0]\Y  +\s1[3]*j 
      For i = 0 To \pt\X 
        Grid(i,j)\X=A*i+B
        Grid(i,j)\Y=C*i+D 
      Next 
    Next 
    
    STP(3,2,1,0,\pt\X)
    
    For j = 0 To \pt\X 
      A=\S2[2]\X    +\s1[0]*j 
      B=\Vertx[0]\X +\s1[1]*j 
      C=\S2[2]\Y    +\s1[2]*j 
      D=\Vertx[0]\Y +\s1[3]*j 
      For i = 1 To \pt\Y 
        Grid(j,i)\X=A*i+B
        Grid(j,i)\Y=C*i+D 
      Next 
    Next 
  EndWith
EndProcedure  
   
Procedure FastGrid(Wi,He,StpX=24,StpY=-1,RGB=-1)
  If StpY=-1:StpY=StpX:EndIf
  If RGB=-1:RGB=$555555:EndIf
  For Y=0 To He
    LineXY(0,Y,Wi,Y,RGB)
    Y+StpY
  Next
  For X=0 To Wi
    LineXY(X,0,X,He,RGB)
    X+StpX    
  Next
EndProcedure 
  
Macro InitGrid() ;- InitGrid()
  CreateImage(#GridIMG,_X,_Y)
  DrawIMG(#GridIMG)
  FastGrid(_X,_Y,30,30)
  STOPDRAW
EndMacro     
   
Procedure  FastImage() ;- Faster than ShowImage - ONLY POINTS to circumvent the Polygon drawing 
  Static i,j,STP
  With _Flex
    If _Grid
      FreeImage(#IMG)
      GrabImage(#GridIMG,#IMG,0,0,_X,_Y)
      DrawIMG(#IMG)
    Else       
      DrawIMG(#IMG)
      ClsImg(#IMG)
    EndIf  
    If _ShowCornerNumbers : Corners() : EndIf 
    STP=\pt\X/120  ; LONGER STP = QUICKER DRAWING  
    LoBound(STP,1)
    i=0
    Repeat   ; Increase Stp for slow processor
      j=0
      Repeat
        Box(Grid(i, j)\X, Grid(i, j)\Y,1,1, Color(i, j))
        j+STP
      Until j>=\pt\Y 
      i+STP
    Until i>=\pt\X 
    STOPDRAW
    SetGadgetState(#ImGad, ImageID(#IMG)) 
  EndWith
EndProcedure 
     
Procedure  Polyg( Sides,*P,RGB=-1) ;P= array of POINT struc with polyg vertices ; sides >1 
  If RGB>-1
    Pen(1,RGB):Brush(RGB)
  EndIf
  Polygon_(_DRAWING,*P,Sides)  
EndProcedure 
     
Procedure ShowImage() 
  Protected i,j,i2,j2
  With _Flex
    If _Grid
      FreeImage(#IMG)
      GrabImage(#GridIMG,#IMG,0,0,_X,_Y)
      DrawIMG(#IMG)
    Else       
      DrawIMG(#IMG)
      ClsImg(#IMG,0)
    EndIf  
    If _ShowCornerNumbers : Corners() : EndIf 
    
    For i = 0 To \pt\X
      DrawIMG(#IMG)
      
      If MMK = 1 : _Showflag=0: ProcedureReturn : EndIf ;  show interruptus
      i2=i+1 
      WindowEvent()
      
      For j = 0 To \pt\Y 
        If j < \pt\Y And i < \pt\X 
          j2=j+1 
          \Plg[0]\X = Grid(i ,j )\X ;  Polygon positions
          \Plg[0]\Y = Grid(i ,j )\Y
          \Plg[1]\X = Grid(i2,j )\X 
          \Plg[1]\Y = Grid(i2,j )\Y 
          \Plg[2]\X = Grid(i2,j2)\X 
          \Plg[2]\Y = Grid(i2,j2)\Y 
          \Plg[3]\X = Grid(i ,j2)\X 
          \Plg[3]\Y = Grid(i ,j2)\Y 
          Pen(1,Color(i,j)):Brush(Color(i,j))
          Polyg(4,\Plg[0])
        Else 
          Plot(Grid(i,j)\X, Grid(i,j)\Y, Color(i,j)) ; only 1 pixel for the last line 
        EndIf 
      Next 
      If _ShowCornerNumbers : Corners() : EndIf 
      STOPDRAW
      SetGadgetState(#ImGad,ImageID(#IMG))
    Next 
  EndWith
EndProcedure 
   
Procedure SaveImg(DefaultFile$="",Title.S="Save Image") ; Save Image 
  Protected Flag, Pattern$ = "(*.bmp)|*.bmp|"   
  Pattern$ + "(*.jpg)|*.jpg|"   
  Pattern$ + "(*.png)|*.png|"   
  File$=SaveFileRequester("Please Choose The File Name To Save", DefaultFile$, Pattern$, 0)
  If File$
    If _ShowCornerNumbers
      Flag=1
      _ShowCornerNumbers = 0 
    EndIf   
    If _Grid 
      Flag+2
      _Grid=0
    EndIf
    If Flag : ShowImage()  : EndIf
    
    Select SelectedFilePattern()
      Case 0 : SaveImage(#IMG,File$,#PB_ImagePlugin_BMP)
      Case 1 : SaveImage(#IMG,File$,#PB_ImagePlugin_JPEG,10)
      Case 2 : SaveImage(#IMG,File$,#PB_ImagePlugin_PNG)
    EndSelect
    MessageRequester("","Saved to "+File$, #PB_MessageRequester_Ok)
  Else
    MessageRequester("","File Not Saved", #PB_MessageRequester_Ok)
  EndIf   
  
  If Flag=1 Or Flag=3:_ShowCornerNumbers=1:EndIf
  If Flag=2 Or Flag=3:_Grid=1:EndIf
  If Flag:ShowImage():EndIf
EndProcedure
   
Procedure$ GetLastDir(LastDirFile.S)
  Protected Temp= ReadFile(-1,GetTemporaryDirectory()+LastDirFile)
  If Temp
    LastDir.S=ReadString(Temp)
    CloseFile(Temp)
  EndIf    
  ProcedureReturn LastDir.S
EndProcedure 
  
Procedure SetLastDir(LastDirFile.S,LastDir.S)  ;-SetLastDir - pone en TempDir
  Protected Temp
  DeleteFile(GetTemporaryDirectory()+LastDirFile)
  Temp=OpenFile(-1,GetTemporaryDirectory()+LastDirFile)
  If Temp
    WriteString(Temp,LastDir)
    CloseFile(Temp)
  EndIf
EndProcedure 
  
Procedure LeeImg(*P.POINT) 
  Protected StandardFile$
  Static IMG,hIMG
  If IsImage(IMG):FreeImage(IMG):EndIf
  If hIMG:DeleteDC_(hIMG):EndIf
  LastDirFile.S="EstiraLast"
  Pattern$ = "Images (*.bmp, *.jpg, *.png, *.tiff, *.tga)|*.bmp;*.jpg; *.png; *.tiff ; *.tga |All files (*.*)|*.*" 
  StandardFile$=GetLastDir(LastDirFile)
  If StandardFile$=""
    StandardFile$ = "e:\" ; put here your image directory 
  EndIf
  File$ = OpenFileRequester("Load Image", StandardFile$, Pattern$, Pattern) 
  If File$ 
    StandardFile$=GetPathPart(File$)
    SetLastDir(LastDirFile,StandardFile$)
    hIMG = CreateCompatibleDC_(GetDC_(WindowID(0))) 
    IMG = LoadImage(#PB_Any, File$,  #PB_Image_DisplayFormat) 
    If ImageWidth(IMG)>_X
      ResizeImage(IMG,_X,ImageHeight(IMG))
    EndIf
    If ImageHeight(IMG)>_Y
      ResizeImage(IMG,ImageWidth(IMG),_Y)
    EndIf
    *P\X=ImageWidth(IMG):*P\Y=ImageHeight(IMG)
    SelectObject_(hIMG, ImageID(IMG)) 
    ProcedureReturn hIMG 
  EndIf 
EndProcedure 
   
Procedure  Menu(Win=0) ;- Menu(win)
  Protected Menu= CreateMenu(-1, WindowID(Win))   
  MenuTitle("   File")
  MenuItem(#Open,"Open ") 
  MenuBar() 
  MenuItem(#SaveAs,"Save As") 
  MenuBar()
  MenuItem(#Quit,"Quit")
  MenuTitle("   Options")
  MenuItem( #CornerNumbers, "Switch Corner Numbers on/off") 
  MenuBar()
  MenuItem(#Grid,"Switch Grid on/off")
  ProcedureReturn Menu
EndProcedure 
     
Procedure NewImage() 
 Protected hIMG = LeeImg(@P.POINT) ,X,Y,CenterX,CenterYsz
  With _Flex
    If hIMG  
      \pt\X = P\X - 1 : \pt\Y = P\Y - 1 
      Global Dim Color(\pt\X, \pt\Y) 
      Global Dim Grid.POINT (\pt\X, \pt\Y ) 
      For X = 0 To \pt\X 
        For Y = 0 To \pt\Y 
          Color(X, Y) = GetPixel_(hIMG, X, Y) 
        Next 
      Next 
      CenterX=_X/2:CenterY=_Y/2
      SZ=Min(_X,_Y)/10
      \Vertx[0]\X = CenterX-SZ 
      \Vertx[0]\Y = CenterY-SZ 
      \Vertx[1]\X = CenterX+SZ 
      \Vertx[1]\Y = CenterY-SZ 
      \Vertx[2]\X = CenterX+SZ 
      \Vertx[2]\Y = CenterY+SZ 
      \Vertx[3]\X = CenterX-SZ 
      \Vertx[3]\Y = CenterY+SZ        
      Sizes() : ShowImage() 
    EndIf
  EndWith
EndProcedure 

Procedure GetDistance(A1,A2) ;- GetDistance(a1,a2) 
  ProcedureReturn Sqr(A1*A1 + A2*A2)          
EndProcedure 

Procedure Near(X,Y); X, Y, ArrSize, ARRAY P.POINT(1)) ; Return elem de Array de Points Nearest to  x,y 
  Protected A,i,min
  With _Flex
    min = $FFFFFFF 
    For i = 0 To 3 
      A = GetDistance(X - \Vertx[i]\X, Y - \Vertx[i]\Y) 
      If A < min : min = A : Near = i : EndIf 
    Next i 
    ProcedureReturn Near 
  EndWith
EndProcedure 

    ;<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< 
    
If  OpenWindow(0, 100, 100,600,400,Title$, #WS_OVERLAPPEDWINDOW | #WS_MAXIMIZE) 
  SetWindowColor(0,0)
  StickyWindow(0,1)
  
  _X=WindowWidth(0):_Y=WindowHeight(0)
  Menu()    
  CreateImage(#IMG, _X,_Y,32) 
  ImageGadget(#ImGad,0,0,0,0,ImageID(#IMG)) 
  SetWindowLongPtr_(GadgetID(#ImGad), -20, GetWindowLongPtr_(GadgetID(#ImGad), -20) | $2000000)
  
  InitGrid() : NewImage() 
  With _Flex
    
    Repeat 
      If GetAsyncKeyState_(#VK_ESCAPE) :  End:EndIf
      
      Ev = WaitWindowEvent(1) 
      Select Ev
        Case #PB_Event_Menu 
          Select EventMenu() ; To see which menu has been selected 
            Case #Quit  : End 
            Case #Open  :NewImage() 
            Case #SaveAs:SaveImg()
            Case #CornerNumbers ;  switch corner numbers 
              _ShowCornerNumbers = 1 -_ShowCornerNumbers  
              ShowImage()  
            Case #Grid 
              _Grid=1-_Grid
              ShowImage()     
          EndSelect 
        Case #PB_Event_SizeWindow
          _X=WindowWidth(0):_Y=WindowHeight(0)
          ShowImage()
        Default
          If Ev=#WM_MOUSEMOVE
            If MMK = 1 
              If  InMousEX(1,1,_X-4,_Y-4)
                If Sel = 0
                  Near = Near(MMx,MMy) 
                  Sel = 1 
                EndIf 
                _Showflag = 0 
                \Vertx[Near]\X = MMx 
                \Vertx[Near]\Y = MMy 
                Sizes() :  FastImage() 
              EndIf 
            EndIf    
            
          EndIf  
          If MMK=0
            If _Showflag = 0 : _Showflag = 1 : ShowImage() : EndIf 
            Sel = 0 
          EndIf     
      EndSelect
    Until Ev = #PB_Event_CloseWindow 
  EndWith
EndIf
  End

Posted: Mon Mar 30, 2009 4:13 am
by yrreti
Thank you for posting this code, as I was really looking for something like this.
But I have observed the strangest problem with it. It doesn't make any sense.
When I copy and paste the code in a new editor window, it works every time.
I can select a picture and rotate it. But when ever I save the code with a name.
The following line marked with an arrow below

Code: Select all

Procedure  Clip(X,Y,X1,Y1) ;- Clip(X,Y,X1,Y1)
  If __Clip:EndClip():EndIf    ;<----------------------------<<<<<
  __Clip = CreateRectRgn_(X,Y,X1,Y1)
  If __Clip : SelectClipRgn_(_DRAWING, __Clip)
  Else      : __Clip=0
  EndIf
EndProcedure
always gives me a 'Line 70: Garbage at the end of the line.', and the program
won't run? There is nothing wrong with the code on the line that I can see.
I press F5 when not saved and it runs. I press F5 after saving and it always
errors. I would appreciate any input or ideas, on this as I really would like to
use this code. But I am at a loss as to what is happening here. I am using PB4.3.
Thanks for any help.

Posted: Mon Mar 30, 2009 5:10 am
by Blue
Impressive !!! :shock:
Thanks for sharing this code.
This is excellent work.



--------------------------------------------------------------
May i suggest a change in your menu wording ?
Since you use "Switch" to offer an on/off selector in the options menu,
it would be better to append on/off at the end, as follows
(1) Switch Corner Numbers On/Off
and
(2) Switch Grid On/Off
rather than simply saying "Switch" as you do now.
--------------------------------------------------------------

Posted: Mon Mar 30, 2009 11:43 am
by einander
@yrreti:
Removed the Clip procedures.
I put them in a hurry because a question for Image Distortion was asked yesterday in Coding Questions, and CenterText() (from my very big Include File) have a call to Clip().

@Blue
Thanks for your corrections. Code updated.

Posted: Mon Mar 30, 2009 12:30 pm
by yrreti
Just a quick note as I've got to go to work.
Thanks for the update, and I discovered what was causing the weird problem
that I was having only after saving the file. I thought it best to put this quick note
in case it happens to someone else. I forgot all about the special '_' character
that allows for long line continuation in one of the plugins I installed.
That is why the program would error out with garbage at end of line.
Again, thanks for the nice code.

Posted: Wed Apr 08, 2009 10:20 am
by Michael Vogel
Hm,

should not do TransformSprite3D() do exactly what you want?
This function is around 50 to 100 times faster here on my tiny netbook :D

Okay, TransformSprite3D means that...
...Sprites instead of images have to be used :?
...InitSprite3D(), Start3D(), Stop3D() have to be used :(
...OpenScreen or OpenWindowScreen have to used :cry:
...TransformSprite3D does not work correct (calculates wrong results) :evil:

Michael
All times are UTC+01:00
Page 2 of 2

Powered by phpBB® Forum Software © phpBB Limited