Aktuelle Zeit: 23.08.2019 21:53

Alle Zeiten sind UTC + 1 Stunde [ Sommerzeit ]




Ein neues Thema erstellen Auf das Thema antworten  [ 7 Beiträge ] 
Autor Nachricht
 Betreff des Beitrags: Bitmap drehen (links und rechts)
BeitragVerfasst: 29.12.2008 23:54 
Offline
Benutzeravatar

Registriert: 10.05.2005 22:48
Hallo,

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

Code:
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 5.70 LTS + Win 10


Nach oben
 Profil  
Mit Zitat antworten  
 Betreff des Beitrags:
BeitragVerfasst: 30.12.2008 01:04 
Offline
Ein Admin
Benutzeravatar

Registriert: 29.08.2004 20:20
Wohnort: Saarbrücken
Ich würde sagen, entweder läufst du mit 'ia' hoch statt runter oder mit 'i' runter statt hoch.
Das sollte das selbe bewirken.

_________________
Freakscorner.de - Der Bastelkeller | Neustes Video: Neje DK - 1 Watt Laser Engraver
Ubuntu Gnome 18.04.1 LTS x64, PureBasic 5.60 x64 (außerdem 4.41, 4.50, 4.61, 5.00, 5.10, 5.11, 5.21, 5.22, 5.30, 5.31, 5.40, 5.50)
"Die deutsche Rechtschreibung ist Freeware, du darfst sie kostenlos nutzen – Aber sie ist nicht Open Source, d. h. du darfst sie nicht verändern oder in veränderter Form veröffentlichen."


Nach oben
 Profil  
Mit Zitat antworten  
 Betreff des Beitrags:
BeitragVerfasst: 31.12.2008 01:31 
Offline
Benutzeravatar

Registriert: 09.07.2006 00:41
Wenn du PlgBlt_() benutzt kannst du in beide Richtungen drehen. Ein nicht sehr ausgereiftes Beispiel (Drehwinkel in Bogenmaß):

Code:
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)


Nach oben
 Profil  
Mit Zitat antworten  
 Betreff des Beitrags:
BeitragVerfasst: 31.12.2008 11:42 
Offline
Benutzeravatar

Registriert: 27.02.2006 22:30
Wohnort: Neumünster
Bild nur 90 Grad drehen links oder rechts

Code:
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.60 X 64 - Windows 10

Der Computer hat dem menschlichen Gehirn gegenüber nur einen Vorteil: Er wird benutzt
grüße hjbremer


Nach oben
 Profil  
Mit Zitat antworten  
 Betreff des Beitrags:
BeitragVerfasst: 31.12.2008 14:24 
Offline
Benutzeravatar

Registriert: 10.05.2005 22:48
Und PlgBlt() ist wirklich wesentlich schneller als BitBlt()?

_________________
PB 5.70 LTS + Win 10


Nach oben
 Profil  
Mit Zitat antworten  
 Betreff des Beitrags:
BeitragVerfasst: 31.12.2008 19:04 
Offline
Benutzeravatar

Registriert: 09.07.2006 00:41
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.


Nach oben
 Profil  
Mit Zitat antworten  
 Betreff des Beitrags: Re: Bitmap drehen (links und rechts)
BeitragVerfasst: 03.01.2019 23:32 
Offline

Registriert: 29.08.2004 13:18
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:
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!


Nach oben
 Profil  
Mit Zitat antworten  
Beiträge der letzten Zeit anzeigen:  Sortiere nach  
Ein neues Thema erstellen Auf das Thema antworten  [ 7 Beiträge ] 

Alle Zeiten sind UTC + 1 Stunde [ Sommerzeit ]


Wer ist online?

Mitglieder in diesem Forum: 0 Mitglieder und 5 Gäste


Sie dürfen keine neuen Themen in diesem Forum erstellen.
Sie dürfen keine Antworten zu Themen in diesem Forum erstellen.
Sie dürfen Ihre Beiträge in diesem Forum nicht ändern.
Sie dürfen Ihre Beiträge in diesem Forum nicht löschen.

Suche nach:
Gehe zu:  

 


Powered by phpBB © 2008 phpBB Group | Deutsche Übersetzung durch phpBB.de
subSilver+ theme by Canver Software, sponsor Sanal Modifiye