Bitmap drehen (links und rechts)

Anfängerfragen zum Programmieren mit PureBasic.
Benutzeravatar
Delle
Beiträge: 1118
Registriert: 10.05.2005 22:48

Bitmap drehen (links und rechts)

Beitrag 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
PB 6.02 LTS + Win 11
Benutzeravatar
NicTheQuick
Ein Admin
Beiträge: 8675
Registriert: 29.08.2004 20:20
Computerausstattung: Ryzen 7 5800X, 32 GB DDR4-3200
Ubuntu 22.04.3 LTS
GeForce RTX 3080 Ti
Wohnort: Saarbrücken
Kontaktdaten:

Beitrag 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.
Bild
Benutzeravatar
Ligatur
Beiträge: 196
Registriert: 09.07.2006 00:41

Beitrag 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)
Benutzeravatar
hjbremer
Beiträge: 822
Registriert: 27.02.2006 22:30
Computerausstattung: von gestern
Wohnort: Neumünster

Beitrag 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
Purebasic 5.70 x86 5.72 X 64 - Windows 10

Der Computer hat dem menschlichen Gehirn gegenüber nur einen Vorteil: Er wird benutzt
grüße hjbremer
Benutzeravatar
Delle
Beiträge: 1118
Registriert: 10.05.2005 22:48

Beitrag von Delle »

Und PlgBlt() ist wirklich wesentlich schneller als BitBlt()?
PB 6.02 LTS + Win 11
Benutzeravatar
Ligatur
Beiträge: 196
Registriert: 09.07.2006 00:41

Beitrag 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.
GPI
Beiträge: 1511
Registriert: 29.08.2004 13:18
Kontaktdaten:

Re: Bitmap drehen (links und rechts)

Beitrag 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
CodeArchiv Rebirth: Deutsches Forum Github Hilfe ist immer gern gesehen!
Antworten