High quality rotation image for photo

[oryaaaaa]

High quality rotation image Tips for photo
example angle is float -0.1234567

bi-linear interpolation
and auto triming process

Code: Select all

UseJPEGImageDecoder()
#Image = 1

Procedure CopyImageToMemory(ImageNumber.l, Memory.l)
  Protected TemporaryDC.l, TemporaryBitmap.BITMAP, TemporaryBitmapInfo.BITMAPINFO 
  TemporaryDC = CreateDC_("DISPLAY", #Null, #Null, #Null)
  GetObject_(ImageID(ImageNumber), SizeOf(BITMAP), TemporaryBitmap.BITMAP) 
  TemporaryBitmapInfo\bmiHeader\biSize        = SizeOf(BITMAPINFOHEADER)
  TemporaryBitmapInfo\bmiHeader\biWidth       = TemporaryBitmap\bmWidth
  TemporaryBitmapInfo\bmiHeader\biHeight      = -TemporaryBitmap\bmHeight
  TemporaryBitmapInfo\bmiHeader\biPlanes      = 1
  TemporaryBitmapInfo\bmiHeader\biBitCount    = 32
  TemporaryBitmapInfo\bmiHeader\biCompression = #BI_RGB 
  GetDIBits_(TemporaryDC, ImageID(ImageNumber), 0, TemporaryBitmap\bmHeight, Memory, TemporaryBitmapInfo, #DIB_RGB_COLORS)
  DeleteDC_(TemporaryDC) 
EndProcedure

Procedure CopyMemoryToImage(Memory.l,ImageNumber.l)
  Protected TemporaryDC.l, TemporaryBitmap.BITMAP, TemporaryBitmapInfo.BITMAPINFO 
  TemporaryDC = CreateDC_("DISPLAY", #Null, #Null, #Null) 
  GetObject_(ImageID(ImageNumber), SizeOf(BITMAP), TemporaryBitmap.BITMAP)
  TemporaryBitmapInfo\bmiHeader\biSize        = SizeOf(BITMAPINFOHEADER)
  TemporaryBitmapInfo\bmiHeader\biWidth       = TemporaryBitmap\bmWidth
  TemporaryBitmapInfo\bmiHeader\biHeight      = -TemporaryBitmap\bmHeight
  TemporaryBitmapInfo\bmiHeader\biPlanes      = 1
  TemporaryBitmapInfo\bmiHeader\biBitCount    = 32
  TemporaryBitmapInfo\bmiHeader\biCompression = #BI_RGB
  SetDIBits_(TemporaryDC, ImageID(ImageNumber), 0, TemporaryBitmap\bmHeight, Memory, TemporaryBitmapInfo, #DIB_RGB_COLORS)
  DeleteDC_(TemporaryDC)
EndProcedure

Procedure Rotation_Image_Angle(image.l, angle.f)
  Protected MemorySizeOrigin.l, *MemoryOrigin, *MemoryCopy
  Protected theta.f, vcos.f, vsin.f, dx.f, dy.f
  Protected W.l, H.l, cx.l, cy.l, x.l, Y.l, ncx.l, ncy.l,nx.l, ny.l, zStep.b, zxm.l
  Protected zx1.l, zy1.l, zx2.l, zy2.l, zw.l, zh.l,zx3.l, zy3.l, zx4.l, zy4.l, zxS.l, zyS.l, zxE.l, zyE.l, nw.l, nh.l
  Protected Origindata_R0.l, Origindata_R1.l, Origindata_R2.l, Origindata_R3.l, Origindata_R4.l
  Protected Origindata_G0.l, Origindata_G1.l, Origindata_G2.l, Origindata_G3.l, Origindata_G4.l
  Protected Origindata_B0.l, Origindata_B1.l, Origindata_B2.l, Origindata_B3.l, Origindata_B4.l
  ; Input initialize
  W = ImageWidth(image) 
  H = ImageHeight(image)
  cx = Int(W/2)
  cy = Int(H/2)
  theta = angle*(-1) * #PI /180
  vcos = Cos(theta)
  vsin = Sin(theta)
  ; Output initialize
  nw = Int(W * Abs(vcos) + H * Abs(vsin))
  nh = Int(W * Abs(vsin) + H * Abs(vcos))
  ncx = Int((nw) / 2)
  ncy = Int((nh)/ 2)
  
  MemorySizeOrigin = (W*H  << 2)
  *MemoryOrigin = AllocateMemory(MemorySizeOrigin)
  MemorySizeOrigin = (nw*nh  << 2)
  *MemoryCopy  = AllocateMemory(MemorySizeOrigin)
  CopyImageToMemory(image, *MemoryOrigin)
  
  ; 1st Pass Auto Triming
  For ny = 0 To nh-1
    For  nx=0 To nw-1
      dx = ((nx-ncx)*vcos - (ny-ncy)*vsin)+cx
      dy = ((nx-ncx)*vsin + (ny-ncy)*vcos)+cy
      x = Int(dx)
      Y = Int(dy)
      If dx>=0 And dx<(W-1) And dy>=0 And dy<(H-1)
        dx= dx - x
        dy = dy - Y
        Origin = (ny * nw + nx) << 2 
        PokeL(*MemoryCopy + Origin, 1)
      EndIf
    Next 
  Next 
  If angle> 0
    For ny=0 To nh-1
      For nx=0 To nw-1
        Origin = (ny * nw + nx) << 2 
        If PeekL(*MemoryCopy + Origin)=1
          zx1 = nx : zy1 =ny
          Break 2
        EndIf
      Next
    Next
    
    For nx=(nw-1) To 0 Step -1
      For ny=0 To nh-1
        Origin = (ny * nw + nx) << 2 
        If PeekL(*MemoryCopy + Origin)=1
          zx2 = nx : zy2 =ny
          Break 2
        EndIf
      Next
    Next
    ;
    For nx=0 To (nw-1)
      For ny=(nh-1) To 0 Step -1
        Origin = (ny * nw + nx) << 2 
        If PeekL(*MemoryCopy + Origin)=1
          zx3 = nx : zy3 =ny
          Break 2
        EndIf
      Next
    Next
    ; 
    For ny=(nh-1) To 0 Step -1
      For nx=(nw-1) To 0 Step -1
        Origin = (ny * nw + nx) << 2 
        If PeekL(*MemoryCopy + Origin)=1
          zx4 = nx : zy4 =ny
          Break 2
        EndIf 
      Next
    Next
    ;
    zxS = zx1 : zyS = zy2 : zxE=zx4 : zyE=zy3 
  Else
    For nx=0 To nw-1
      For ny=0 To nh-1
        Origin = (ny * nw + nx) << 2 
        If PeekL(*MemoryCopy + Origin)=1
          zx1 = nx : zy1 =ny
          Break 2
        EndIf
      Next
    Next 
    ;
    For ny=0 To nh-1
      For nx=(nw-1) To 0 Step -1
        Origin = (ny * nw + nx) << 2 
        If PeekL(*MemoryCopy + Origin)=1
          zx2 = nx : zy2 =ny
          Break 2
        EndIf
      Next
    Next
    ;
    For ny=(nh-1) To 0 Step -1
      For nx=0 To nw-1
        Origin = (ny * nw + nx) << 2 
        If PeekL(*MemoryCopy + Origin)=1
          zx3 = nx : zy3 =ny
          Break 2
        EndIf 
      Next
    Next
    ;
    For nx=(nw-1) To 0 Step -1
      For ny=(nh-1) To 0 Step -1
        Origin = (ny * nw + nx) << 2 
        If PeekL(*MemoryCopy + Origin)=1
          zx4 = nx : zy4 =ny
          Break 2
        EndIf
      Next
    Next
    ; 
    zxS = zx3 : zyS = zy1 : zxE=zx2 : zyE=zy4
  EndIf
  
  zw = zxE-zxS : zh = zyE-zyS
  
  ; 2nd Pass Triming rotation image
  For ny = zyS To zyE
    For  nx=zxS To zxE
      
      dx = ((nx-ncx)*vcos - (ny-ncy)*vsin)+cx
      dy = ((nx-ncx)*vsin + (ny-ncy)*vcos)+cy
      x = Int(dx)
      Y = Int(dy)
      If dx>=0 And dx<(W-1) And dy>=0 And dy<(H-1)
        dx= dx - x
        dy = dy - Y
        
        Origin = (Y* W + x) << 2 
        Origindata_B1 = PeekL(*MemoryOrigin + Origin) & $0000FF
        Origindata_G1 = (PeekL(*MemoryOrigin + Origin) & $00FF00) >> 8
        Origindata_R1 = (PeekL(*MemoryOrigin + Origin) & $FF0000) >> 16
        Origin = (Y * W + x+1) << 2
        Origindata_B2 = PeekL(*MemoryOrigin + Origin) & $0000FF
        Origindata_G2 = (PeekL(*MemoryOrigin + Origin) & $00FF00) >> 8
        Origindata_R2 = (PeekL(*MemoryOrigin + Origin) & $FF0000) >> 16
        Origin = ((Y+1) * W + x) << 2
        Origindata_B3 = PeekL(*MemoryOrigin + Origin) & $0000FF
        Origindata_G3 = (PeekL(*MemoryOrigin + Origin) & $00FF00) >> 8
        Origindata_R3 = (PeekL(*MemoryOrigin + Origin) & $FF0000) >> 16
        Origin = ((Y+1) * W + x+1) << 2
        Origindata_B4 = PeekL(*MemoryOrigin + Origin) & $0000FF
        Origindata_G4 = (PeekL(*MemoryOrigin + Origin) & $00FF00) >> 8
        Origindata_R4 = (PeekL(*MemoryOrigin + Origin) & $FF0000) >> 16
        Origin = ((ny-zyS) * zw + (nx-zxS)) << 2 
        Origindata_R0 = Round((1-dy)*((1-dx)*Origindata_R1+ dx*Origindata_R2)+dy*((1-dx)*Origindata_R3+dx*Origindata_R4) ,#PB_Round_Nearest)
        Origindata_G0 = Round((1-dy)*((1-dx)*Origindata_G1+ dx*Origindata_G2)+dy*((1-dx)*Origindata_G3+dx*Origindata_G4) ,#PB_Round_Nearest) 
        Origindata_B0 = Round((1-dy)*((1-dx)*Origindata_B1+ dx*Origindata_B2)+dy*((1-dx)*Origindata_B3+dx*Origindata_B4) ,#PB_Round_Nearest)
        If Origindata_R0>255
          Origindata_R0 = 255
        EndIf
        If Origindata_G0>255
          Origindata_G0 = 255
        EndIf
        If Origindata_B0>255
          Origindata_B0 = 255
        EndIf
        Origindata_G0 = (Origindata_G0 << 8) & $00FF00
        Origindata_R0 = (Origindata_R0 << 16) & $FF0000
        PokeL(*MemoryCopy + Origin, Origindata_R0 | Origindata_G0 | Origindata_B0  )
      EndIf 
    Next
  Next 
  ResizeImage(image, zw, zh)
  CopyMemoryToImage(*MemoryCopy, image)
  FreeMemory(*MemoryOrigin)
  FreeMemory(*MemoryCopy)
EndProcedure

; Main
Filename.s = OpenFileRequester("Image load", "*.*", "*.*",0)
LoadImage(#Image, Filename)
Rotation_Image_Angle(#Image, -0.1234567)
SaveImage(#Image, Filename+".bmp", #PB_ImagePlugin_BMP)

[djes]

This code is nice, but obviously sloooooow. To be fast, you should really try to limit memory access, and calculus in loops. Keep the original code as it's easy to read, but try an optimised (but reversible) version.

[oryaaaaa]

Slow? My father have core i7 note book pc. This tips used software run very fast.
12M pixel
1st 1sec
2nd 3sec

but Core2duo 3GHz, My PC
12M pixel
1st 4sec
2nd 6sec

I want to speed up, but asm programing is difficult. now, used liner interpolating.
I want to more high quality.

[AAT]

oryaaaaa, thank you for sharing you code!
I found en error in trimming.
Look at this after
Rotation_Image_Angle(#Image, -30.5234567)

1. source picture http://atlab.narod.ru/other/SO14_blured.jpg
2. rotated picture http://atlab.narod.ru/other/SO14_blured.jpg.bmp

[oryaaaaa]

AAT, Thank you for your report.

Photo rotation use maybe -5..+5 only. -30 rot used cameraman had photo skill is poor.

[djes]

We did this a long time ago. I'll try to change a bit your code for you to see.

Code: Select all

;Fast and clean rotation 
;Original Code : LSI (le soldat inconnu) for his effects library (http://www.purearea.net/pb/download/userlibs/Effect.zip) 
;Optimisation (not fully optimised) by djes (djes@free.fr)
;Not needing assembly inline by psychophanta

;#PI.f=3.14159265 

;******************************************************************************************************
; RotateImageEx2
;>= Angle (in degrees :()
ProcedureDLL.l RotateImageEx2(ImageID, Angle.f)
  Protected bmi.BITMAPINFO, bmi2.BITMAPINFO, Hdc.l, NewImageID, Mem, n, nn, bm.BITMAP 
  
  ;radian conversion
  Debug "Angle : "+Str(angle)
  Angle*#PI/180 
  
  Protected Cos.f = Cos(Angle) 
  Protected Sin.f = Sin(Angle) 
  
  Protected CouleurFond = 0 
  
  GetObject_(ImageID, SizeOf(BITMAP), @bm.BITMAP) 
  
  bmi\bmiHeader\biSize = SizeOf(BITMAPINFOHEADER) 
  bmi\bmiHeader\biWidth = bm\bmWidth 
  bmi\bmiHeader\biHeight = bm\bmHeight 
  bmi\bmiHeader\biPlanes = 1 
  bmi\bmiHeader\biBitCount = 32 
  bmi\bmiHeader\biCompression = #BI_RGB 
  
  bmi2\bmiHeader\biSize = SizeOf(BITMAPINFOHEADER) 
  bmi2\bmiHeader\biWidth = bm\bmWidth * Abs(Cos) + bm\bmHeight * Abs(Sin) 
  bmi2\bmiHeader\biHeight = bm\bmHeight * Abs(Cos) + bm\bmWidth * Abs(Sin) 
  bmi2\bmiHeader\biPlanes = 1 
  bmi2\bmiHeader\biBitCount = 32 
  bmi2\bmiHeader\biCompression = #BI_RGB 
  
  Mem = AllocateMemory(bm\bmWidth * bm\bmHeight * 4) 
  If Mem 
    Protected Mem2 = AllocateMemory(bmi2\bmiHeader\biWidth * bmi2\bmiHeader\biHeight * 4) 
    If Mem2 
      
      ;retrieves the bits of the specified bitmap and copies them into a buffer
      Hdc = CreateCompatibleDC_(GetDC_(ImageID)) 
      If Hdc 
        GetDIBits_(Hdc, ImageID, 0, bm\bmHeight, Mem, @bmi, #DIB_RGB_COLORS)
        ReleaseDC_(0, Hdc) 
      EndIf 
      
      Protected CX1 = bm\bmWidth - 1 
      Protected CY1 = bm\bmHeight - 1 
      Protected CX2 = bmi2\bmiHeader\biWidth - 1 
      Protected CY2 = bmi2\bmiHeader\biHeight - 1 
      
      Protected Mem01 = Mem + bm\bmWidth * 4 
      Protected Mem10 = Mem + 4 
      Protected Mem11 = Mem01 + 4 
      
      Protected Mem2Temp = Mem2 
      Protected deb=-CX2/2
      Protected fin=deb+CX2;= Round(CX2/2,1) but <> (CX2*2-CX2)/2 
          
      For nn = 0 To CY2 

        Protected x1b.l
        Protected y1b.l = (nn * 2) - CY2 

        Protected Temp1.f = (CX1 - (y1b * Sin))/2
        Protected Temp2.f = (CY1 + (y1b * Cos))/2       

        Protected x1.f = Temp1 + (deb * Cos)
        Protected y1.f = Temp2 + (deb * Sin)

        For x1b = deb To fin 
          
          ;could be faster with arrays
          
          Protected x2.l = x1 
          Protected y2.l = y1 
          
          If x1 < x2 
            !dec dword[p.v_x2] 
          EndIf 
          If y1 < y2 
            !dec dword[p.v_y2] 
          EndIf 
          
          Protected x2b.l = x2 + 1 
          Protected y2b.l = y2 + 1 
          
          ;test boundaries
          If x2b >= 0 And x2 <= CX1 And y2b >= 0 And y2 <= CY1  
          
            Protected fx.f = x1 - x2 
            Protected fy.f = y1 - y2 
            Protected f00.f = 1 - fx 
            Protected f10.f = 1 - fy 
            Protected f01.f = f00 * fy 
            f00 * f10 
            f10 * fx 
            Protected f11.f = fx * fy 
          
            Protected MemTemp = (x2 + y2 * bm\bmWidth) * 4 
            Protected c00.l, c01.l, c11.l, c10.l 
            
            If x2 >= 0 And x2 <= CX1 
              If y2 >= 0 And y2 <= CY1 
                !mov eax,dword[p.v_Mem] 
                !add eax,dword[p.v_MemTemp] 
                !mov eax,dword[eax] 
                !mov dword[p.v_c00],eax 
                ;c00 = PeekL(Mem + MemTemp) 
              Else 
                c00 = 0 
              EndIf 
              If y2b >= 0 And y2b <= CY1 
                !mov eax,dword[p.v_Mem01] 
                !add eax,dword[p.v_MemTemp] 
                !mov eax,dword[eax] 
                !mov dword[p.v_c01],eax 
                ;c01 = PeekL(Mem01 + MemTemp) 
              Else 
                c01 = 0 
              EndIf 
            Else 
              c00 = 0 
              c01 = 0 
            EndIf 
            If x2b >= 0 And x2b <= CX1 
              If y2 >= 0 And y2 <= CY1 
                !mov eax,dword[p.v_Mem10] 
                !add eax,dword[p.v_MemTemp] 
                !mov eax,dword[eax] 
                !mov dword[p.v_c10],eax 
                ;c10 = PeekL(Mem10 + MemTemp) 
              Else 
                c10 = 0 
              EndIf 
              If  y2b >= 0 And y2b <= CY1 
                !mov eax,dword[p.v_Mem11] 
                !add eax,dword[p.v_MemTemp] 
                !mov eax,dword[eax] 
                !mov dword[p.v_c11],eax 
                ;c11 = PeekL(Mem11 + MemTemp) 
              Else 
                c11 = 0 
              EndIf 
            Else 
              c10 = 0 
              c11 = 0 
            EndIf 
    
            Protected r1.l,r2.l,r3.l,r4.l,g1.l,g2.l,g3.l,g4.l,b1.l,b2.l,b3.l,b4.l 

            !mov eax,dword[p.v_c00] 
            !mov ebx,eax 
            !mov ecx,eax 

            !and eax,$FF 
            !mov dword[p.v_r1],eax 
            !and ebx,$FF00 
            !mov dword[p.v_g1],ebx 
            !and ecx,$FF0000 
            !mov dword[p.v_b1],ecx 

            !mov eax,dword[p.v_c10] 
            !mov ebx,eax 
            !mov ecx,eax 

            !and eax,$FF 
            !mov dword[p.v_r2],eax 
            !and ebx,$FF00 
            !mov dword[p.v_g2],ebx 
            !and ecx,$FF0000 
            !mov dword[p.v_b2],ecx 

            !mov eax,dword[p.v_c01] 
            !mov ebx,eax 
            !mov ecx,eax 

            !and eax,$FF 
            !mov dword[p.v_r3],eax 
            !and ebx,$FF00 
            !mov dword[p.v_g3],ebx 
            !and ecx,$FF0000 
            !mov dword[p.v_b3],ecx 

            !mov eax,dword[p.v_c11] 
            !mov ebx,eax 
            !mov ecx,eax 

            !and eax,$FF 
            !mov dword[p.v_r4],eax 
            !and ebx,$FF00 
            !mov dword[p.v_g4],ebx 
            !and ecx,$FF0000 
            !mov dword[p.v_b4],ecx 
      
           ;pure knows well how to do this 
            Protected r.l = r1 * f00 + r2 * f10 + r3 * f01 + r4 * f11
            Protected g.l = g1 * f00 + g2 * f10 + g3 * f01 + g4 * f11 
            Protected b.l = b1 * f00 + b2 * f10 + b3 * f01 + b4 * f11 
          
            !mov eax,dword[p.v_r] 
            !mov ebx,dword[p.v_g] 
            !mov ecx,dword[p.v_b]
            ;one trick is to let triplets at the same place to avoid shifting
            !and eax,$FF                                      
            !and ebx,$FF00 
            !and ecx,$FF0000 
            !or eax,ebx 
            !or eax,ecx 

            !mov ebx,dword[p.v_Mem2Temp] 
            !mov dword[ebx],eax 
          
          Else 

            !mov ebx,dword[p.v_Mem2Temp] 
            !xor eax,eax 
            !mov dword[ebx],eax 

          EndIf 
          
          Mem2Temp + 4 
          x1 + cos
          y1 + sin
          
        Next 
      Next 
      
      ; On crée la nouvelle image 
      NewImageID = CreateImage(#PB_Any, bmi2\bmiHeader\biWidth, bmi2\bmiHeader\biHeight) 
      Hdc = CreateCompatibleDC_(GetDC_(ImageID(NewImageID))) 
      If Hdc 
        SetDIBits_(Hdc, ImageID(NewImageID), 0, bmi2\bmiHeader\biHeight, Mem2, @bmi2, #DIB_RGB_COLORS) ; on envoie la liste dans l'image 
        ReleaseDC_(0, Hdc) 
      EndIf 
      
      FreeMemory(Mem2) 
    EndIf 
    FreeMemory(Mem) 
  EndIf 
  
  ProcedureReturn NewImageID 
EndProcedure 

;******************************************************************************************************
;- Speed Test

SetPriorityClass_(GetCurrentProcess_(),#REALTIME_PRIORITY_CLASS) 

#NbTest = 4 

MessageRequester("Speed test",Str(#NbTest)+" rotations of a 1000x1000 image...") 

BigImage = CreateImage(#PB_Any, 1000, 1000) 
If BigImage<>0 
  StartDrawing(ImageOutput(BigImage)) 
    For n = 0 To 999 
      For nn = 0 To 999 
        Plot(n, nn, Random($FFFFFF)) 
      Next 
    Next 
  StopDrawing() 
  
  Dim Liste(ImageWidth(BigImage) - 1, ImageHeight(BigImage) - 1) 
  
  Time1 = ElapsedMilliseconds() 
  
  For n = 1 To #NbTest 
    DestImage = RotateImageEx2(ImageID(BigImage), 30) 
  Next 
  
  Time2 = ElapsedMilliseconds() 
  
  Speed = (Time2 - Time1) / #NbTest 
  NbPixels = ImageHeight(BigImage) * ImageWidth(BigImage) 
  
  MessageRequester("Results", "Average speed of "+Str(Speed) + " ms" + Chr(10) + "Image of " + Str(ImageWidth(BigImage)) + " * " + Str(ImageHeight(BigImage)) + " pixels" + Chr(10) + "Pixels nb = " + Str(NbPixels), 0) 
EndIf 

;******************************************************************************************************
;- Drawing test 

SrcImage = CreateImage(#PB_Any, 80, 100) 

If SrcImage<>0 
  StartDrawing(ImageOutput(SrcImage)) 
    Box(0, 0, 80, 100, $6F6F6F) 
    Box(5, 5, 35, 45, $FF) 
    Box(40, 5, 35, 45, $FF00) 
    Box(5, 50, 35, 45, $FF0000) 
    Box(40, 50, 35, 45, $FFFFFF) 
  StopDrawing() 
  
  RotImage = RotateImageEx2(ImageID(SrcImage), u)  

EndIf 

SetPriorityClass_(GetCurrentProcess_(),#NORMAL_PRIORITY_CLASS) 

; Création de la fenêtre et de la GadgetList 
If OpenWindow(0, 0, 0, 250, 300, "Effect - Image rotation", #PB_Window_SystemMenu | #PB_Window_ScreenCentered | #PB_Window_MinimizeGadget) = 0 Or CreateGadgetList(WindowID(0)) = 0 
  End 
EndIf 

TextGadget(#PB_Any, 10, 10, 100, 15, "Src Image") 
ImageGadget(#PB_Any, 10, 25, 0, 0, ImageID(SrcImage)) 

TextGadget(1, 10, 135, 100, 15, "Rotation") 
ImageGadget(2, 10, 150, 0, 0, ImageID(RotImage)) 

angle = 1

Repeat

  Event = WindowEvent() 
  Delay(20)

  RotImage1 = ImageID(RotateImageEx2(ImageID(SrcImage), angle))

  SetGadgetText(1, "Rotation : " + Str(angle))
  SetGadgetState(2, RotImage1)

  If IsImage(RotImage2) : FreeImage(RotImage2) : Delay(20) : EndIf

  angle + 1

  RotImage2 = ImageID(RotateImageEx2(ImageID(SrcImage), angle))

  SetGadgetText(1, "Rotation : " + Str(angle))
  SetGadgetState(2, RotImage2)

  If IsImage(RotImage1) : FreeImage(RotImage1) : Delay(20) : EndIf

  angle + 1
  

Until Event = #PB_Event_CloseWindow 

End

[USCode]

Anyway this could be done in a cross-platform way using PB-only commands?

[luis]

Sure can be done. These routines works on pixels, PB commands can work with pixels from an image and access them directly from memory too (see DrawingBuffer()), so it can be done.

Why not ?


EDIT:
Since Djes mentioned that one in ASM, I have to mention mine :
http://www.purebasic.fr/english/viewtop ... 12&t=38975
Crossplatform using only PB commands.

[oryaaaaa]

djes, Thank you.

I understand more expert PB code by you.

[Fangbeast]

Is there a way to do high quality image resample as well, the way paintshop pro does?

When I resize my images, they look squashed. I remember paintshop pro had a resample into the new size and it looked proportional to the resize.

[Michael Vogel]

Is there a way to do high quality image resample as well, the way paintshop pro does?

When I resize my images, they look squashed. I remember paintshop pro had a resample into the new size and it looked proportional to the resize.

Not sure, do you mean to keep the ascpect ratio? If so, you must change the height or width, like here...

Code: Select all

Procedure.i CreateDummyImage(W,H)

	Protected i,j
	Protected Image=CreateImage(#PB_Any,W,H,#PB_Image_DisplayFormat)

	StartDrawing(ImageOutput(Image))
	Protected hDC=CreateDC_("DISPLAY",0,0,0)

	For i=0 To w-1
		For j=0 To h-1
			Plot(i,j,GetPixel_(hDC,i,j))
		Next j
	Next i
	DeleteDC_(hDC)
	StopDrawing()

	ProcedureReturn Image

EndProcedure

Procedure AspectResizeImage(Image,w,h)
	
	Protected x,y,z
	
	x=ImageWidth(Image)
	y=ImageHeight(Image)
	z=x*h/y
	If z<w
		w=z
	Else
		z=y*w/x
		If z<h
			h=z
		EndIf
	EndIf
	
	ResizeImage(Image,w,h,#PB_Image_Smooth)
	
EndProcedure

Image=CreateDummyImage(600,400)

sx=300
sy=300

OpenWindow(0,0,0,sx,sy,"Resize Me",#PB_Window_ScreenCentered|#PB_Window_SystemMenu)

AspectResizeImage(Image,sx,sy)

ImageGadget(0,0,0,sx,sy,ImageID(Image))

SetActiveWindow(0)
Repeat
	Select WaitWindowEvent()
	Case #PB_Event_CloseWindow
		Break
	EndSelect
ForEver

[Fangbeast]

When I resize an image into an imagegadget, they look squashed. When I resize an image into a larger imagegadget, they look stretched.

I think a proportional resize without data loss is what I meant. I just remember PaintShop pro had something like that and it was fantastic.

Thanks for the example Michael, I will have a play and see if that's what I meant (too confused these days)