PureBoard

Das deutsche PureBasic-Forum
http://forums.purebasic.com/german/

Bitmap drehen (links und rechts)

http://forums.purebasic.com/german/viewtopic.php?t=18695

Seite 1 von 1

Bitmap drehen (links und rechts)

Verfasst: 29.12.2008 23:54
von Delle
Hallo,

wie kann man untenstehenden Code so abändern das er das Bitmap auch nach links drehen kann?

Code: Alles auswählen

Procedure Rotate(Image$)

  Image1Dc = CreateCompatibleDC_(0)
  Image1 = LoadImage_(0,Image$,0,0,0,$2050)
  OldObject = SelectObject_(Image1Dc,Image1)
  GetObject_(Image1,SizeOf(BITMAP),bmp.BITMAP)

  Image2Dc = CreateCompatibleDC_(0)
  Image2 = CreateCompatibleBitmap_(Image1Dc,bmp\bmHeight,bmp\bmWidth)
  SelectObject_(Image2Dc,Image2)

  ia = bmp\bmHeight
  While ia > 0
    i = 0
    While i < bmp\bmWidth
      BitBlt_(Image2Dc,bmp\bmHeight-ia,i,1,1,Image1Dc,i,ia,#SRCCOPY)
      i = i + 1
    Wend
    ia = ia - 1
  Wend

  CreateImage(2,bmp\bmHeight,bmp\bmWidth)
  Windc = StartDrawing(ImageOutput(2))
  StretchBlt_(Windc,0,0,bmp\bmHeight,bmp\bmWidth,Image2Dc,0,0,bmp\bmHeight,bmp\bmWidth,#SRCCOPY)
  StopDrawing()

  ReleaseDC_(0,Image1Dc)
  DeleteObject_(Image1)
  ReleaseDC_(0,Image2Dc)
  DeleteObject_(Image2)
EndProcedure

Verfasst: 30.12.2008 01:04
von NicTheQuick
Ich würde sagen, entweder läufst du mit 'ia' hoch statt runter oder mit 'i' runter statt hoch.
Das sollte das selbe bewirken.

Verfasst: 31.12.2008 01:31
von Ligatur
Wenn du PlgBlt_() benutzt kannst du in beide Richtungen drehen. Ein nicht sehr ausgereiftes Beispiel (Drehwinkel in Bogenmaß):

Code: Alles auswählen

UseJPEGImageDecoder()

Procedure RotateIm(ImNr.i, wkl.f)
  Dim Vert.POINT(2)
  
  wi.i = ImageWidth(ImNr)
  hi.i = ImageHeight(ImNr)
  ; Vert(0) = linke obere Ecke
  ; Vert(1) = rechte obere Ecke
  ; Vert(2) = linke untere Ecke der gedrehten Image berechnen
  Vert(0)\x = 0
  Vert(0)\y = 0
  Vert(1)\x = wi * Cos(wkl)
  Vert(1)\y = wi * Sin(wkl)
  Vert(2)\x = -1 * hi * Sin(wkl)
  Vert(2)\y = hi * Cos(wkl)
  ; Die nächsten 4 If - Bedingungen dienen nur dazu, das die Ecken des Bildes nicht aus den sichtbaren Bereich herausrutschen
  If Vert(1)\x < 0
    Vert(0)\x = -1 * Vert(1)\x
    Vert(2)\x - Vert(1)\x
    Vert(1)\x = 0
  EndIf
  If Vert(2)\x < 0
    Vert(0)\x = -1 * Vert(2)\x
    Vert(1)\x - Vert(2)\x
    Vert(2)\x = 0
  EndIf
  If Vert(1)\y < 0
    Vert(0)\y = -1 * Vert(1)\y
    Vert(2)\y - Vert(1)\y
    Vert(1)\y = 0
  EndIf
  If Vert(2)\y < 0
    Vert(0)\y = -1 * Vert(2)\y
    Vert(1)\y - Vert(2)\y
    Vert(2)\y = 0
  EndIf
  CreateImage(1, 700, 600)
  ihdc = StartDrawing(ImageOutput(1))
  shdc = CreateCompatibleDC_(ihdc)
  obm.i = SelectObject_(shdc, ImageID(0))
  PlgBlt_(ihdc, @Vert(0), shdc, 0, 0, wi, hi, 0, 0, 0)
  DeleteDC_(shdc)
  StopDrawing()
  CopyImage(1, 0)
EndProcedure

OpenWindow(0, 0, 0, 800, 600, "Bild drehen", #WS_OVERLAPPEDWINDOW)
ImageGadget(0, 5, 5, 700, 600, 0, #PB_Image_Border)
ButtonGadget(1, 710, 5, 85, 20, "Laden")
TextGadget(2, 710, 35, 85, 15, "Winkel")
StringGadget(3, 710, 50, 85, 20, "0")
ButtonGadget(4, 710, 75, 85, 20, "Drehen")

Repeat
  event = WaitWindowEvent()
  Select event
    Case #PB_Event_Gadget
      Select EventGadget()
        Case 1
          dn.s = OpenFileRequester("Bild laden", "", "Bitmaps|*.bmp;*.jpg|Alle|*.*", 0)
          If dn <> ""
            If LoadImage(0, dn)
              SetGadgetState(0, ImageID(0))
            EndIf
          EndIf
        Case 4
          wkl.f = ValF(GetGadgetText(3))
          RotateIm(0, wkl)
          SetGadgetState(0, ImageID(0))
      EndSelect
  EndSelect
Until event = #PB_Event_CloseWindow
(Achtung, nicht mit zu großen Bildern testen)

Verfasst: 31.12.2008 11:42
von hjbremer
Bild nur 90 Grad drehen links oder rechts

Code: Alles auswählen

Procedure Bilddrehen(image,rl) 

  hh = ImageHeight(image) 
  br = ImageWidth(image)  
  If hh > br 
    tmp = CreateImage(#PB_Any,hh,hh) 
    Else 
    tmp = CreateImage(#PB_Any,br,br) 
  EndIf 
  
  Dim p.point(2) 
   
  If rl = 'rechts'
    p(0)\x=hh 
    p(0)\y=0 
    p(1)\x=hh 
    p(1)\y=br 
    p(2)\x=0 
    p(2)\y=0 
  Else
    p(0)\x=0
    p(0)\y=br 
    p(1)\x=0
    p(1)\y=0
    p(2)\x=hh  
    p(2)\y=br  
  EndIf
  
  dc = StartDrawing(ImageOutput(tmp)) 
       DrawImage(ImageID(image),0,0) 
       PlgBlt_(dc,p(),dc,0,0,br,hh,0,0,0) 
  StopDrawing() 
  imgnr = GrabImage(tmp,#PB_Any,0,0,hh,br) 
  FreeImage(tmp) 
  
  ProcedureReturn imgnr
EndProcedure 

pfad$ = #PB_Compiler_Home+"Examples\Sources\Data\" 
imgnr = LoadImage(#PB_Any,pfad$ + "PureBasicLogo.bmp")

OpenWindow(0,0,0,600,500,"",#PB_Window_ScreenCentered|#PB_Window_SystemMenu) 
  CreateGadgetList(WindowID(0)) 
    
  sp = WindowWidth(0) - 100

  butL = ButtonGadget(#PB_Any, sp, 10, 80, 25, "Links")
  butR = ButtonGadget(#PB_Any, sp, 40, 80, 25, "Rechts")
      
  butI = ImageGadget(#PB_Any,10,10,0,0,ImageID(imgnr)) 
   
Repeat

  event = WaitWindowEvent() 
    
  If event = #PB_Event_Gadget Or Event = #PB_Event_Menu 
          
      welcherButton = EventGadget()  
      
      Select welcherButton
                
          Case butL
              imgnr = Bilddrehen(imgnr,'links') 
              SetGadgetState(butI, ImageID(imgnr))
            
          Case butR
      
              imgnr = Bilddrehen(imgnr,'rechts') 
              SetGadgetState(butI, ImageID(imgnr))

      EndSelect      
  
  EndIf

Until event = #PB_Event_CloseWindow 

End

Verfasst: 31.12.2008 14:24
von Delle
Und PlgBlt() ist wirklich wesentlich schneller als BitBlt()?

Verfasst: 31.12.2008 19:04
von Ligatur
Delle hat geschrieben:Und PlgBlt() ist wirklich wesentlich schneller als BitBlt()?
Nein, BitBlt() ist eindeutig schneller, kann aber nicht drehen, spiegeln oder scheren. Schneller und unkomplizierter als deine pixelweise umkopiererei ist PlgBlt() aber auf jeden Fall. Und ich kann mir auch keine schnellere Möglichkeit vorstellen schneller als mit diesem Befehl ein Bild in den angegebenen Weisen mit Purebasic in den angegebenen Weisen zu manipulieren.

Re: Bitmap drehen (links und rechts)

Verfasst: 03.01.2019 23:32
von GPI
Ich weis, urururalter Thread, aber ich hab die erste Version etwas erweitert.

Sie arbeitet jetzt mit #pb_any (und ist damit überall ohne Konflikte nutzbar),
es kann ein Qualitätsfaktor (aa) angegeben werden (es wird dann mit aa facher Auflösung gedreht und dann verkleinert. Das glättet die harten Kanten, mit 2 siehts schon deutlich schöner aus),
man kann eine Hintergrundfarbe setzen,
die Imagegröße des rotierten Bildes wird korrekt berechnet,
statt Floats werden Double verwendet
UND enableExplicit-Tauglich.

viel Spaß

Code: Alles auswählen

EnableExplicit

UseJPEGImageDecoder()

Procedure RotateIm(ImNr.i, wkl.d,aa=2,back=#Black)
  Protected imTemp,wi,hi,cos.d,sin.d,i,a,x,y,newwidth,newhight,ihdc,shdc
  
  Dim Vert.POINT(3)
 
  wi = ImageWidth(ImNr)
  hi = ImageHeight(ImNr)
  
  cos=Cos(wkl)
  sin=Sin(wkl)
  
  
  ; Vert(0) = linke obere Ecke
  ; Vert(1) = rechte obere Ecke
  ; Vert(2) = linke untere Ecke der gedrehten Image berechnen
  ; 3ter ist eigentlich nicht nötig, aber praktisch für die neue größe zu berechnen
  vert(1)\x= (wi*cos) - (0*sin)
  vert(1)\y= (wi*sin) + (0*cos)
  vert(2)\x= (0*cos) - (hi*sin)
  vert(2)\y= (0*sin) + (hi*cos)
  vert(3)\x= (wi*cos) - (hi*sin)
  vert(3)\y= (wi*sin) + (hi*cos)
  
  ;test
  For i=0 To 3
    vert(i)\x*aa
    vert(i)\y*aa
  Next
  
  ;aus den Null drehen
  For i=0 To 3
    If vert(i)\x<0
      x=vert(i)\x
      For a=0 To 3
        vert(a)\x-x
      Next
    EndIf
    If vert(i)\y<0
      y=vert(i)\y
      For a=0 To 3
        vert(a)\y-y
      Next
    EndIf
  Next
  
  ;neue größe berechnen
  newwidth=0
  newhight=0
  
  For i=0 To 3
    Debug ""+i+":"+vert(i)\x+" "+vert(i)\y
    If vert(i)\x>newwidth
      newwidth=vert(i)\x
    EndIf
    If vert(i)\y>newhight
      newhight=vert(i)\y
    EndIf
  Next
  newwidth+1
  newhight+1
  imTemp=CreateImage(#PB_Any, newwidth, newhight)
  
  ihdc = StartDrawing(ImageOutput(imTemp))
  Box(0,0,newwidth,newhight,back)
  
  
  shdc = CreateCompatibleDC_(ihdc)
  
  SelectObject_(shdc, ImageID(imnr))
  PlgBlt_(ihdc, @Vert(0), shdc, 0, 0, wi, hi, 0, 0, 0)
  DeleteDC_(shdc)
  StopDrawing()
  
  ResizeImage(imtemp,newwidth/aa, newhight/aa,#PB_Image_Smooth)
  ;CopyImage(imTemp, imnr)
  ResizeImage(imnr,newwidth/aa,newhight/aa)
  StartDrawing(ImageOutput(imnr))
  DrawImage(ImageID(imtemp),0,0)
  StopDrawing()
    
  FreeImage(imTemp)
  
  ProcedureReturn ImageID(imnr)
  
  
  FreeImage(imTemp)
  
  
EndProcedure

Define event,wkl.d,dn.s

OpenWindow(0, 0, 0, 800, 600, "Bild drehen", #WS_OVERLAPPEDWINDOW)
ImageGadget(0, 5, 5, 700, 600, 0, #PB_Image_Border)
ButtonGadget(1, 710, 5, 85, 20, "Laden")
TextGadget(2, 710, 35, 85, 15, "Winkel (Radiant)")
StringGadget(3, 710, 50, 85, 20, "0")
ButtonGadget(4, 710, 75, 85, 20, "Drehen")

Repeat
  event = WaitWindowEvent()
  Select event
    Case #PB_Event_Gadget
      Select EventGadget()
        Case 1
          dn.s = OpenFileRequester("Bild laden", "", "Bitmaps|*.bmp;*.jpg|Alle|*.*", 0)
          If dn <> ""
            If LoadImage(0, dn)
              SetGadgetState(0, ImageID(0))
            EndIf
          EndIf
        Case 4
          wkl = Radian(ValD(GetGadgetText(3)))
          RotateIm(0, wkl,2,#Green)
          SetGadgetState(0, ImageID(0))
          ResizeGadget(0,5,5,ImageWidth(0),ImageHeight(0))
      EndSelect
  EndSelect
Until event = #PB_Event_CloseWindow
Alle Zeiten sind UTC+02:00
Seite 1 von 1

Powered by phpBB® Forum Software © phpBB Limited

Deutsche Übersetzung durch phpBB.de