PureBasic Forums - English

Posted: **Mon Mar 08, 2004 6:20 pm**

Image Rotate, Pull, Reverse & Stretch

Title$ = "Image RPRS : Rotate, Pull, Reverse & Stretch Tool - beta 0.002 - by einander" 
; 
; Thanks Psychophanta for the Hypotenuse ASM procedure! 
; Dont forget to check the Compiler Option "Enable Inline ASM Support" 
;27 Feb 2005 Updated for PB 3.93 beta
; __________________________ 
; Pull Image corners with mouse 
; 
; welcomed improvements! - nested loops are a pain! 
; Added Menu - Open - Save - 
; still some trouble with redraw 
; 


UseJPEGImageDecoder() 
UseJPEGImageEncoder() 
UsePNGImageDecoder() 
UsePNGImageEncoder() 
UseTGAImageDecoder() 
UseTIFFImageDecoder() 


Global  Key, hDC, Show, ShowCorners 
Global Xmin, Xmax, Ymin, Ymax, CleanIMG, _Drawing 
Global _X, _Y, XX, YY, _MK,_MX, _MY, mxAnt, myAnt 
Global Xpoints, Ypoints, Px, Py 

#S=" "
Enumeration 
    #GadIMG 
    #IMG 
    #IMG2 
EndEnumeration 

Dim Corner.Point(3) 
Dim PX(3) : Dim PY(3) 

Dim Color(0, 0) 
Dim Xgrid(0, 0) : Dim Ygrid(0, 0) : Dim Xstep.f(0) : Dim Ystep.f(0) 
ShowCorners = 1 : Show = 1 
_X = GetSystemMetrics_(#SM_CXSCREEN) - 8 : _Y = GetSystemMetrics_(#SM_CYSCREEN) - 68 
XX = _X / 2 : YY = _Y / 2 

Procedure CL(Fill) 
    Box(0, 0, WindowWidth(), WindowHeight(), Fill) 
EndProcedure 

Procedure POLYGON(Handle, Sides, Fill) ; polygon consisting of two or more vertices connected by straight lines. 
    DC = GetDC_(Handle) 
    SetPolyFillMode_(DC, #WINDING) 
    Pen = CreatePen_(#Ps_solid, 1, Fill) 
    Brush = CreateSolidBrush_(Fill) 
    SelectObject_(DC, Pen) 
    SelectObject_(DC, Brush) 
    Polygon_(DC, @Corner(), Sides) 
    DeleteObject_(Pen) 
    DeleteObject_(Brush) 
    ReleaseDC_(Handle, DC) 
EndProcedure 


Procedure.f Hypotenuse(Cateto1.f, Cateto2.f) ; this one is from Psychophanta 
    ! fld dword[esp] ; push Cateto1 to FPU stack (to st0) 
    ! fmul st0, st0 ; Cateto1^2 
    ! fld dword[esp + 4] ; push Cateto2 value to FPU stack (to st0) (Cateto1 is now in st1) 
    ! fmul st0, st0 ; Cateto2^2 
    ! faddp ; Cateto1^2+Cateto2^2 and pop FPU stack 
    ! fsqrt ; Sqr(Cateto1^2+Cateto2^2) 
EndProcedure 


Procedure Near(X, y, ArrSize, DIR1.l, DIR2.l) ; return elem Nearest to  x,y 
    Min = $FFFFFF 
    For i = 0 To ArrSize 
        A = Hypotenuse(X - PeekL(DIR1 + i * 4), y - PeekL(DIR2 + i * 4)) 
        If A < Min : Min = A : J = i : EndIf 
    Next i 
    ProcedureReturn J 
EndProcedure 


Procedure LeeImage() 
    StandardFile$ = "C:\" 
    Pattern$ = "Images (*.bmp, *.jpg, *.png, *.tiff, *.tga)|*.bmp;*.jpg; *.png; *.tiff ; *.tga |All files (*.*)|*.*" 
    File$ = OpenFileRequester("Load Image", StandardFile$, Pattern$, Pattern) 
    If File$ 
        hIMG = CreateCompatibleDC_(hDC) 
        IMG = LoadImage(0, File$) 
        ; IMG=ResizeImage(0,100,100) 
        SelectObject_(hIMG, IMG) 
        ProcedureReturn hIMG 
    Else 
        MessageRequester("Information", "The requester was canceled.", 0) 
    EndIf 
EndProcedure 


Procedure Get(X, y, Width, Height) ; get Image from hDC and puts it on memory; returns handle for the stored Image 
    Handle = CreateCompatibleDC_(hDC)     ; memory handle to strore Image 
    SelectObject_(Handle, CreateImage(0, Width, Height)) 
    BitBlt_(Handle, 0, 0, Width, Height, hDC, X, y, #SRCCOPY)  ; transfer Image 
    ProcedureReturn Handle 
EndProcedure 

Procedure GetImage(X, y, Width, Height, ID) ; get Image from window and puts it on Image ID; returns handle for the stored Image 
    CreateImage(ID, Width, Height) 
    If _Drawing: StopDrawing():EndIf 
    Handle = StartDrawing(ImageOutput())      
    BitBlt_(Handle, 0, 0, Width, Height, hDC, X, y, #SRCCOPY) ; copy sector from window to Image 
    StopDrawing(): _Drawing=0 
    ProcedureReturn Handle 
EndProcedure 

Procedure Corners() 
   DrawingMode(1)
    For i = 0 To 3 
        Circle (PX(i) , PY(i), 9, RGB(100,100,100)) 
        Locate(PX(i)-4 , PY(i)-7 ) 
        FrontColor(0, 0, 200) 
        DrawText(Str(i)) 
    Next 
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 HOR 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 
    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 Points() ; Faster than ShowImage - ONLY POINTS to circumvent the Polygon drawing 
    CreateImage(#IMG, _X, _Y) 
    StopDrawing() 
    _Drawing = StartDrawing (ImageOutput()) 
    
    Box(0, 0, ImageWidth(), ImageHeight(), #black) 
    For i = 0 To Xpoints Step 4 ; LONGER STEP = QUICKER DRAWING 
        For J = 0 To Ypoints Step 4 ; Increase Step for slow processor 
             SetPixel_(_DRAWING, xgrid(i, j), ygrid(i, j), Color(i, j))  ;   API alternative ; don't seems to be faster than Plot 
          ;  Plot(Xgrid(i, J), Ygrid(i, J), Color(i, J)) 
        Next 
    Next 
    StopDrawing() 
    _Drawing=StartDrawing(WindowOutput()) 
    SetGadgetState(#GadIMG, UseImage(#IMG)) 
    If ShowCorners : Corners() : EndIf 
EndProcedure
    
    
    
    
Procedure ShowImage() ; COMPLETO  - LENTO 
    If _MK = 0 
        If ShowCorners : Corners() : EndIf 
        For i = 0 To Xpoints 
                   WindowEvent() 
            If _MK = 1 : Show=0: ProcedureReturn : EndIf 
            For J = 0 To Ypoints 
                If J < Ypoints And i < Xpoints 
                    Corner(0)\X = Xgrid(i, J) ; corner()\ = position for each Polygon 
                    Corner(0)\y = Ygrid(i, J) 
                    Corner(1)\X = Xgrid(i + 1, J) 
                    Corner(1)\y = Ygrid(i + 1, J) 
                    Corner(2)\X = Xgrid(i + 1, J + 1) 
                    Corner(2)\y = Ygrid(i + 1, J + 1) 
                    Corner(3)\X = Xgrid(i, J + 1) 
                    Corner(3)\y = Ygrid(i, J + 1) 
                    POLYGON(WindowID(0), 4, Color(i, J)) ; replace each pixel from the original with a polygon 
                Else 
                    Plot(Xgrid(i, J), Ygrid(i, J), Color(i, J)) ; only 1 pixel for the last line 
                EndIf 
            Next 
        Next 
    EndIf 
    If ShowCorners : Corners() : EndIf 
    CleanIMG = Get(Xmin, Ymin, Xmax - Xmin + 1, Ymax - Ymin + 1) 
EndProcedure 

Procedure SalvaImage(Ext$) 
    If ShowCorners 
        ShowCorners = 0 : CL(#black) : ShowImage() : 
    EndIf ; erase ShowCorners 
    Width = Xmax - Xmin + 1 : Height = Ymax - Ymin + 1 
    StopDrawing():_Drawing=0 
    DC2 = GetImage(Xmin, Ymin, Width, Height, #IMG2) 
    Filename$=SaveFileRequester("Save","c:\",Ext$+"|*"+Ext$,0) 
    files$=LCase(GetExtensionPart(Filename$)) 
    If files$=Ext$  : mainfile$=Filename$ 
    Else : mainfile$=Filename$ + "."+Ext$ 
    EndIf 
    If mainfile$="" 
        MessageRequester("Error","File Name Is Needed Or User Canceled", #PB_MessageRequester_Ok) 
    Else 
        Select Ext$ 
            Case "bmp" 
                RESULT = SaveImage(#IMG2, mainfile$, #PB_ImagePlugin_BMP, 10) 
            Case "jpg" 
                RESULT = SaveImage(#IMG2, mainfile$, #PB_ImagePlugin_JPEG, 10) 
            Case"png" 
                RESULT = SaveImage(#IMG2, mainfile$, #PB_ImagePlugin_PNG, 10) 
        EndSelect 
        FreeImage(#IMG2) 
        DeleteDC_(DC2) 
        If RESULT = 0 
            MessageRequester("Error", "File not saved", 0) 
        EndIf 
        _Drawing=StartDrawing(WindowOutput()) 
        ShowImage() 
        
    EndIf  
    
EndProcedure 

Procedure Callback(Win, Msg, wParam, lParam) ; control mouse & key messages 
    RESULT = #PB_ProcessPureBasicEvents 
    _MX=WindowMouseX()
    _MY=WindowMouseY()
       _MK=Abs(GetAsyncKeyState_(#VK_LBUTTON) +GetAsyncKeyState_(#VK_RBUTTON)*2+GetAsyncKeyState_(#VK_MBUTTON)*3)/$8000
    Select Msg 
        Case #WM_KEYDOWN 
            Ev = EventwParam() 
            If Ev = 27 : End 
            EndIf 
        Case #PB_EventCloseWindow : End 
        Case #WM_ERASEBKGND 
            BitBlt_(hDC, Xmin, Ymin, Xmax - Xmin, Ymax - Ymin, CleanIMG, 0, 0, #SRCCOPY)  ; repaint 
            If ShowCorner:Corners(): EndIf 
    EndSelect 
    ProcedureReturn RESULT 
EndProcedure 

Procedure NewImage() 
    IMG = LeeImage() 
    CL(#black) ; clear screen 
    If IMG = 0 
        MessageRequester("Error", "Imagen no encontrada", 0) 
        End 
    EndIf 
    
    Xpoints = ImageWidth() - 1 
    Ypoints = ImageHeight() - 1 
    
    Dim Color(Xpoints, Ypoints) 
    For X = 0 To Xpoints 
        For y = 0 To Ypoints 
            Color(X, y) = GetPixel_(IMG, X, y) 
        Next 
    Next 
    
    Dim Xgrid (Xpoints, Ypoints ) 
    Dim Ygrid (Xpoints, Ypoints ) 
    Dim Xstep.f(3 ) : Dim Ystep.f(3 ) 
    
    PX(0) = (_X - Xpoints) / 2 : PY(0) = (_Y - Ypoints) / 2 : PX(1) = PX(0) + Xpoints : PY(1) = PY(0) 
    PX(2) = PX(1) : PY(2) = PY(1) + Ypoints : PX(3) = PX(0) : PY(3) = PY(2) 
    Sizes() 
    ShowImage() 
    ProcedureReturn IMG 
EndProcedure 
; ____________________________________________________________________________________________________ 

hWnd = OpenWindow(0, 0, 0, _X, _Y, #WS_OVERLAPPEDWINDOW | #WS_MAXIMIZE, Title$) 
hDC = GetDC_(hWnd) 
If CreateMenu(0, hWnd) = 0 : End : EndIf 

MenuItem( 1, "END") 
MenuItem(2,"Open new") 

OpenSubMenu("Save") 
MenuItem( 3, "*.BMP") 
MenuItem( 4, "*.JPG") 
MenuItem( 5, "*.PNG") 
CloseSubMenu() 

MenuItem( 6, "Corner Numbers") 

CreateGadgetList(hWnd) 
ImageGadget(#GadIMG, 0, 0, _X, _Y, 0) 
_Drawing=StartDrawing(WindowOutput()) 
  
IMG=NewImage() 
SetWindowCallback(@Callback()) 
    
Repeat 
    Ev = WaitWindowEvent() 
    If Ev = #PB_EventMenu 
        Select EventMenuID() ; To see which menu has been selected 
            Case 1 : End 
            Case 2 :NewImage() 
            Case 3 : SalvaImage("bmp") 
            Case 4 : SalvaImage("jpg") 
            Case 5 : SalvaImage("png") 
            Case 6 ; : switch corner numbers 
                ShowCorners = Abs(ShowCorners - 1) : CL(#black) 
                If ShowCorners : Corners() :EndIf 
                ShowImage()    
        EndSelect 
    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 
            Show = 0 
            PX(C) = _MX : PY(C) = _MY 
            Sizes() :  Points() 
        Else 
            If Show = 0 : Show = 1 : CL(#black):ShowImage() : EndIf 
            Sel = 0 
        EndIf 
    EndIf 
    mxAnt = _MX : myAnt = _MY : mkAnt = _MK 
Until Ev = #PB_EventCloseWindow 
End

Posted: **Mon Mar 08, 2004 6:24 pm**

@einander:

I like your code ... thx 4 sharing!

Posted: **Mon Mar 08, 2004 6:29 pm**

Very nice

Posted: **Mon Mar 08, 2004 7:58 pm**

Beautiful!!

Maybe Adobe should rewrite PhotoShop in Pure... 8O

Posted: **Tue Mar 09, 2004 12:18 am**

Neat! Thanks.

Posted: **Fri Apr 23, 2004 7:51 pm**

Einander -- this is something I've been trying (on and off) to figure out for months! Thanks for posting!

Posted: **Fri Apr 23, 2004 8:52 pm**

very nice

techjunkie wrote:Maybe Adobe should rewrite PhotoShop in Pure... 8O

I agree... Photoshop feels like it was made in DarkBASIC

Posted: **Sat Apr 24, 2004 2:44 am**

Wow, that is very very cool! I gotta play around with that, its crazy! Good job man!

Kris_a wrote:I agree... Photoshop feels like it was made in DarkBASIC

Aww... that sounded like another anti-DB statement... So Ill simply say as I have said before, that DB is for 3D games, which is why it is called "the ultimate 3D game creator"... so comparing its applications is pretty pointless. Oh well.

Posted: **Sat Apr 24, 2004 5:51 am**

8O Excellent!! Aguante einander!!

Posted: **Sat Apr 24, 2004 8:11 am**

haha, sorry, I don't mean it really

Posted: **Sat Apr 24, 2004 11:27 am**

Impresionant from Ourense.

Manolo

Posted: **Sun Apr 25, 2004 10:48 pm**

Thanks folks!

The transforming is done mainly in procedure SIZES. The rest is interface.
In somebody found a way to avoid the nested loops in SIZES, i'll be very grateful!

Best regards
Einander

Posted: **Sun Feb 27, 2005 9:39 pm**

I made a very slight speedup by preworking the variables for the inner loops....

Code: Select all

Title$ = "Image RPRS : Rotate, Pull, Reverse & Stretch Tool - beta 0.002 - by einander" 
; 
; Thanks Psychophanta for the Hypotenuse ASM procedure! 
; Dont forget to check the Compiler Option "Enable Inline ASM Support" 
;27 Feb 2005 Updated for PB 3.93 beta 
; __________________________ 
; Pull Image corners with mouse 
; 
; welcomed improvements! - nested loops are a pain! 
; Added Menu - Open - Save - 
; still some trouble with redraw 
; 


UseJPEGImageDecoder() 
UseJPEGImageEncoder() 
UsePNGImageDecoder() 
UsePNGImageEncoder() 
UseTGAImageDecoder() 
UseTIFFImageDecoder() 


Global  Key, hDC, Show, ShowCorners 
Global Xmin, Xmax, Ymin, Ymax, CleanIMG, _Drawing 
Global _X, _Y, XX, YY, _MK,_MX, _MY, mxAnt, myAnt 
Global Xpoints, Ypoints, Px, Py 

#S=" " 
Enumeration 
    #GadIMG 
    #IMG 
    #IMG2 
EndEnumeration 

Dim Corner.Point(3) 
Dim PX(3) : Dim PY(3) 

Dim Color(0, 0) 
Dim Xgrid(0, 0) : Dim Ygrid(0, 0) : Dim Xstep.f(0) : Dim Ystep.f(0) 
ShowCorners = 1 : Show = 1 
_X = GetSystemMetrics_(#SM_CXSCREEN) - 8 : _Y = GetSystemMetrics_(#SM_CYSCREEN) - 68 
XX = _X / 2 : YY = _Y / 2 

Procedure CL(Fill) 
    Box(0, 0, WindowWidth(), WindowHeight(), Fill) 
EndProcedure 

Procedure POLYGON(Handle, Sides, Fill) ; polygon consisting of two or more vertices connected by straight lines. 
    DC = GetDC_(Handle) 
    SetPolyFillMode_(DC, #WINDING) 
    Pen = CreatePen_(#Ps_solid, 1, Fill) 
    Brush = CreateSolidBrush_(Fill) 
    SelectObject_(DC, Pen) 
    SelectObject_(DC, Brush) 
    Polygon_(DC, @Corner(), Sides) 
    DeleteObject_(Pen) 
    DeleteObject_(Brush) 
    ReleaseDC_(Handle, DC) 
EndProcedure 


Procedure.f Hypotenuse(Cateto1.f, Cateto2.f) ; this one is from Psychophanta 
    ! fld dword[esp] ; push Cateto1 to FPU stack (to st0) 
    ! fmul st0, st0 ; Cateto1^2 
    ! fld dword[esp + 4] ; push Cateto2 value to FPU stack (to st0) (Cateto1 is now in st1) 
    ! fmul st0, st0 ; Cateto2^2 
    ! faddp ; Cateto1^2+Cateto2^2 and pop FPU stack 
    ! fsqrt ; Sqr(Cateto1^2+Cateto2^2) 
EndProcedure 


Procedure Near(X, y, ArrSize, DIR1.l, DIR2.l) ; return elem Nearest to  x,y 
    Min = $FFFFFF 
    For i = 0 To ArrSize 
        A = Hypotenuse(X - PeekL(DIR1 + i * 4), y - PeekL(DIR2 + i * 4)) 
        If A < Min : Min = A : J = i : EndIf 
    Next i 
    ProcedureReturn J 
EndProcedure 


Procedure LeeImage() 
    StandardFile$ = "C:\" 
    Pattern$ = "Images (*.bmp, *.jpg, *.png, *.tiff, *.tga)|*.bmp;*.jpg; *.png; *.tiff ; *.tga |All files (*.*)|*.*" 
    File$ = OpenFileRequester("Load Image", StandardFile$, Pattern$, Pattern) 
    If File$ 
        hIMG = CreateCompatibleDC_(hDC) 
        IMG = LoadImage(0, File$) 
        ; IMG=ResizeImage(0,100,100) 
        SelectObject_(hIMG, IMG) 
        ProcedureReturn hIMG 
    Else 
        MessageRequester("Information", "The requester was canceled.", 0) 
    EndIf 
EndProcedure 


Procedure Get(X, y, Width, Height) ; get Image from hDC and puts it on memory; returns handle for the stored Image 
    Handle = CreateCompatibleDC_(hDC)     ; memory handle to strore Image 
    SelectObject_(Handle, CreateImage(0, Width, Height)) 
    BitBlt_(Handle, 0, 0, Width, Height, hDC, X, y, #SRCCOPY)  ; transfer Image 
    ProcedureReturn Handle 
EndProcedure 

Procedure GetImage(X, y, Width, Height, ID) ; get Image from window and puts it on Image ID; returns handle for the stored Image 
    CreateImage(ID, Width, Height) 
    If _Drawing: StopDrawing():EndIf 
    Handle = StartDrawing(ImageOutput())      
    BitBlt_(Handle, 0, 0, Width, Height, hDC, X, y, #SRCCOPY) ; copy sector from window to Image 
    StopDrawing(): _Drawing=0 
    ProcedureReturn Handle 
EndProcedure 

Procedure Corners() 
   DrawingMode(1) 
    For i = 0 To 3 
        Circle (PX(i) , PY(i), 9, RGB(100,100,100)) 
        Locate(PX(i)-4 , PY(i)-7 ) 
        FrontColor(0, 0, 200) 
        DrawText(Str(i)) 
    Next 
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 HOR 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 
    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 Points() ; Faster than ShowImage - ONLY POINTS to circumvent the Polygon drawing 
    CreateImage(#IMG, _X, _Y) 
    StopDrawing() 
    _Drawing = StartDrawing (ImageOutput()) 
    
    Box(0, 0, ImageWidth(), ImageHeight(), #black) 
    For i = 0 To Xpoints Step 4 ; LONGER STEP = QUICKER DRAWING 
        For J = 0 To Ypoints Step 4 ; Increase Step for slow processor 
             SetPixel_(_DRAWING, xgrid(i, j), ygrid(i, j), Color(i, j))  ;   API alternative ; don't seems to be faster than Plot 
          ;  Plot(Xgrid(i, J), Ygrid(i, J), Color(i, J)) 
        Next 
    Next 
    StopDrawing() 
    _Drawing=StartDrawing(WindowOutput()) 
    SetGadgetState(#GadIMG, UseImage(#IMG)) 
    If ShowCorners : Corners() : EndIf 
EndProcedure 
    
    
    
    
Procedure ShowImage() ; COMPLETO  - LENTO 
    If _MK = 0 
        If ShowCorners : Corners() : EndIf 
        For i = 0 To Xpoints 
                   WindowEvent() 
            If _MK = 1 : Show=0: ProcedureReturn : EndIf 
            i2=i+1
            For J = 0 To Ypoints 
                If J < Ypoints And i < Xpoints
                  j2=j+1 
                    Corner(0)\X = Xgrid(i, J) ; corner()\ = position for each Polygon 
                    Corner(0)\y = Ygrid(i, J) 
                    Corner(1)\X = Xgrid(i2, J) 
                    Corner(1)\y = Ygrid(i2, J) 
                    Corner(2)\X = Xgrid(i2, J2) 
                    Corner(2)\y = Ygrid(i2, J2) 
                    Corner(3)\X = Xgrid(i, J2) 
                    Corner(3)\y = Ygrid(i, J2) 
                    POLYGON(WindowID(0), 4, Color(i, J)) ; replace each pixel from the original with a polygon 
                Else 
                    Plot(Xgrid(i, J), Ygrid(i, J), Color(i, J)) ; only 1 pixel for the last line 
                EndIf 
            Next 
        Next 
    EndIf 
    If ShowCorners : Corners() : EndIf 
    CleanIMG = Get(Xmin, Ymin, Xmax - Xmin + 1, Ymax - Ymin + 1) 
EndProcedure 

Procedure SalvaImage(Ext$) 
    If ShowCorners 
        ShowCorners = 0 : CL(#black) : ShowImage() : 
    EndIf ; erase ShowCorners 
    Width = Xmax - Xmin + 1 : Height = Ymax - Ymin + 1 
    StopDrawing():_Drawing=0 
    DC2 = GetImage(Xmin, Ymin, Width, Height, #IMG2) 
    Filename$=SaveFileRequester("Save","c:\",Ext$+"|*"+Ext$,0) 
    files$=LCase(GetExtensionPart(Filename$)) 
    If files$=Ext$  : mainfile$=Filename$ 
    Else : mainfile$=Filename$ + "."+Ext$ 
    EndIf 
    If mainfile$="" 
        MessageRequester("Error","File Name Is Needed Or User Canceled", #PB_MessageRequester_Ok) 
    Else 
        Select Ext$ 
            Case "bmp" 
                RESULT = SaveImage(#IMG2, mainfile$, #PB_ImagePlugin_BMP, 10) 
            Case "jpg" 
                RESULT = SaveImage(#IMG2, mainfile$, #PB_ImagePlugin_JPEG, 10) 
            Case"png" 
                RESULT = SaveImage(#IMG2, mainfile$, #PB_ImagePlugin_PNG, 10) 
        EndSelect 
        FreeImage(#IMG2) 
        DeleteDC_(DC2) 
        If RESULT = 0 
            MessageRequester("Error", "File not saved", 0) 
        EndIf 
        _Drawing=StartDrawing(WindowOutput()) 
        ShowImage() 
        
    EndIf  
    
EndProcedure 

Procedure Callback(Win, Msg, wParam, lParam) ; control mouse & key messages 
    RESULT = #PB_ProcessPureBasicEvents 
    _MX=WindowMouseX() 
    _MY=WindowMouseY() 
       _MK=Abs(GetAsyncKeyState_(#VK_LBUTTON) +GetAsyncKeyState_(#VK_RBUTTON)*2+GetAsyncKeyState_(#VK_MBUTTON)*3)/$8000 
    Select Msg 
        Case #WM_KEYDOWN 
            Ev = EventwParam() 
            If Ev = 27 : End 
            EndIf 
        Case #PB_EventCloseWindow : End 
        Case #WM_ERASEBKGND 
            BitBlt_(hDC, Xmin, Ymin, Xmax - Xmin, Ymax - Ymin, CleanIMG, 0, 0, #SRCCOPY)  ; repaint 
            If ShowCorner:Corners(): EndIf 
    EndSelect 
    ProcedureReturn RESULT 
EndProcedure 

Procedure NewImage() 
    IMG = LeeImage() 
    CL(#black) ; clear screen 
    If IMG = 0 
        MessageRequester("Error", "Imagen no encontrada", 0) 
        End 
    EndIf 
    
    Xpoints = ImageWidth() - 1 
    Ypoints = ImageHeight() - 1 
    
    Dim Color(Xpoints, Ypoints) 
    For X = 0 To Xpoints 
        For y = 0 To Ypoints 
            Color(X, y) = GetPixel_(IMG, X, y) 
        Next 
    Next 
    
    Dim Xgrid (Xpoints, Ypoints ) 
    Dim Ygrid (Xpoints, Ypoints ) 
    Dim Xstep.f(3 ) : Dim Ystep.f(3 ) 
    
    PX(0) = (_X - Xpoints) / 2 : PY(0) = (_Y - Ypoints) / 2 : PX(1) = PX(0) + Xpoints : PY(1) = PY(0) 
    PX(2) = PX(1) : PY(2) = PY(1) + Ypoints : PX(3) = PX(0) : PY(3) = PY(2) 
    Sizes() 
    ShowImage() 
    ProcedureReturn IMG 
EndProcedure 
; ____________________________________________________________________________________________________ 

hWnd = OpenWindow(0, 0, 0, _X, _Y, #WS_OVERLAPPEDWINDOW | #WS_MAXIMIZE, Title$) 
hDC = GetDC_(hWnd) 
If CreateMenu(0, hWnd) = 0 : End : EndIf 

MenuItem( 1, "END") 
MenuItem(2,"Open new") 

OpenSubMenu("Save") 
MenuItem( 3, "*.BMP") 
MenuItem( 4, "*.JPG") 
MenuItem( 5, "*.PNG") 
CloseSubMenu() 

MenuItem( 6, "Corner Numbers") 

CreateGadgetList(hWnd) 
ImageGadget(#GadIMG, 0, 0, _X, _Y, 0) 
_Drawing=StartDrawing(WindowOutput()) 
  
IMG=NewImage() 
SetWindowCallback(@Callback()) 
    
Repeat 
    Ev = WaitWindowEvent() 
    If Ev = #PB_EventMenu 
        Select EventMenuID() ; To see which menu has been selected 
            Case 1 : End 
            Case 2 :NewImage() 
            Case 3 : SalvaImage("bmp") 
            Case 4 : SalvaImage("jpg") 
            Case 5 : SalvaImage("png") 
            Case 6 ; : switch corner numbers 
                ShowCorners = Abs(ShowCorners - 1) : CL(#black) 
                If ShowCorners : Corners() :EndIf 
                ShowImage()    
        EndSelect 
    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 
            Show = 0 
            PX(C) = _MX : PY(C) = _MY 
            Sizes() :  Points() 
        Else 
            If Show = 0 : Show = 1 : CL(#black):ShowImage() : EndIf 
            Sel = 0 
        EndIf 
    EndIf 
    mxAnt = _MX : myAnt = _MY : mkAnt = _MK 
Until Ev = #PB_EventCloseWindow 
End

Not much faster, but every little bit helps...

-Anthony

Posted: **Mon Feb 28, 2005 2:02 am**

Hi Anthony
That's a good speedup: 27% faster
Nice!

Posted: **Mon Feb 28, 2005 2:25 am**

einander: Thanks

This may be [very] slightly faster...

I don't know if this is faster, it depends on how fast PureBasic converts its ints to floats in a calculation:

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 HOR 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 
    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

Is it faster?

PureBasic Forums - English

Image Rotate, Pull, Reverse & Stretch - Updated

Image Rotate, Pull, Reverse & Stretch - Updated