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