Bild oder Sprite verzerren?

Probleme beim Erstellen von 3D-Modellen und Texturen, keine Ahnung womit man Musik macht? Dies ist dein Forum.
Derren
Beiträge: 557
Registriert: 23.07.2011 02:08

Bild oder Sprite verzerren?

Beitrag von Derren »

Hallo.
Ich suche eine Möglichkeit ein Bild so zu verzerren, wie man es vielleicht von Grafikprogrammen her kennt, in dem man die Ecken des rechteckigen Objekts einfach umhercshieben kann.

Dabei ist es mir egal ob das per Spritebefehl geht, oder ob eine Datei direkt verwurstet wird (win-api, dll, irgendein ein toller mathematischer Algorithmus...)

Hier im Forum wurde auf einen Api-Befehl verwiesen (weiß nicht mehr genau wie der heißt. bitglt oder so), aber der kann nur Parallelogramm-Verzerrung. Ich brauche aber die Möglichkeit ein unregelmäßiges Rechteck zu erstellen.

Das hier schien ein vielversprechender Thread zu sein: http://purebasic.fr/german/viewtopic.php?f=4&t=14049
Daraus konnte ich wenigstens schon eine Lösung für die grässlichen Ergebnisse von Transformsprite3D() herauslesen, nämlich, dass die Z-werte ganz und gar nicht optional sind, wenn man ein unvermurkstes Ergegbnis haben will.
Leider ist es mir nicht gelungen aus Dark Dragon's Code eine Funktion zu extrahieren, die diese Z-werte berechnet.
Aber die Ergebnisse von TransformSprite3D() sind auch mit Z-werten nicht wirklich schön. Sieht nach der Resize-Funktion von Paint aus.
Ich hab die Rotationsfunktion hier mal rausgenommen:

Links im Bild das Ergebnis dieses Codes
Rechts das Ergebnis von Macromedia(Adobe) Fireworks, "von Hand" verzerrt (das mit SaveSprite() erstelle Sprite, welches auch vom Code benutzt wird).

Code: Alles auswählen

InitSprite()
InitSprite3D()
InitKeyboard()
InitMouse()

Enumeration
  #PLANE_TOP
  #PLANE_BOTTOM
 
  #PLANE_LEFT
  #PLANE_RIGHT
 
  #PLANE_FRONT
  #PLANE_BACK
EndEnumeration

Global Dim ProjectionMatrix.f(3, 3)

Structure SVector
  x.f
  y.f
  z.f
EndStructure

Structure SCube
  distance.f
  *v.SVector[4]
  sprite.l
EndStructure

Procedure.f _cos(angle)
  ProcedureReturn Cos(angle * #PI / 180.0)
EndProcedure

Procedure.f _sin(angle)
  ProcedureReturn Sin(angle * #PI / 180.0)
EndProcedure

Procedure ScreenWidth()
  !extrn _PB_Screen_Width
  !mov eax,[_PB_Screen_Width]
  ProcedureReturn
EndProcedure

Procedure ScreenHeight()
  !extrn _PB_Screen_Height
  !mov eax,[_PB_Screen_Height]
  ProcedureReturn
EndProcedure

Procedure Rotate(*v.SVector, angleX, angleY)
  If angleX <> 0
    KA.f = *v\y : KB.f = *v\z
    *v\y = _cos(angleX) * KA + _sin(angleX) * KB
    *v\z = _cos(angleX) * KB - _sin(angleX) * KA
  EndIf
 
  If angleY <> 0
    KA.f = *v\z : KB.f = *v\x
    *v\z = _cos(angleY) * KA + _sin(angleY) * KB
    *v\x = _cos(angleY) * KB - _sin(angleY) * KA
  EndIf
EndProcedure

Procedure builtFrustum(Array Matrix.f(2), Left.d, Right.d, Bottom.d, Top.d, Near.d, Far.d)
  Matrix(0, 0) = (2.0 * Near)/(Right-Left)
  Matrix(1, 1) = (2.0 * Near)/(Top-Bottom)
  Matrix(2, 0) = (Right+Left)/(Right-Left)
  Matrix(2, 1) = (Top+Bottom)/(Top-Bottom)
  Matrix(2, 2) = -1.0 * ((Far+Near)/(Far-Near))
  Matrix(3, 2) = -1.0 * ((2.0*Far*Near)/(Far-Near))
  Matrix(2, 3) = -1.0
EndProcedure

Procedure builtPerspective(Array Matrix.f(2), Fov.d, Ratio.d, Near.d, Far.d)
  Protected Left.d, Right.d, Top.d, Bottom.d
  Protected L_Dummy.f
 
  Fov * #PI / 180.0
 
  L_Dummy = Tan(Fov * 0.5)
  L_Dummy * Near
  Top = L_Dummy
  Bottom = -L_Dummy
  Left = Bottom * Ratio
  Right = Top * Ratio
 
  builtFrustum(Matrix(), Left, Right, Bottom, Top, Near, Far)
EndProcedure

Procedure MultVectorMatrix(Array Matrix.f(2), *v.SVector)
  Protected result.SVector
  Protected w.f
 
  result\x = *v\x * Matrix(0, 0) + *v\y * Matrix(1, 0) + *v\z * Matrix(2, 0) + Matrix(3, 0)
  result\y = *v\x * Matrix(0, 1) + *v\y * Matrix(1, 1) + *v\z * Matrix(2, 1) + Matrix(3, 1)
;   result\z = *v\x * Matrix(0, 2) + *v\y * Matrix(1, 2) + *v\z * Matrix(2, 2) + Matrix(3, 2)
  w        = *v\x * Matrix(0, 3) + *v\y * Matrix(1, 3) + *v\z * Matrix(2, 3) + Matrix(3, 3)
 
  If w <> 0.0
    w = 1.0 / w
    *v\x = result\x * w
    *v\y = result\y * w
;     *v\z = result\z * w
  EndIf
EndProcedure

Procedure DisplayCube(SpriteTop, SpriteBottom, SpriteLeft, SpriteRight, SpriteFront, SpriteBack, RotationX, RotationY, Scale.f, MoveX.f, MoveY.f, MoveZ.f)
  Protected Dim v.SVector(7)
  Protected Dim planes.SCube(5)
  Protected k.l, mx.l, my.l
 
  MoveZ + 2.0
 
  v(0)\x =-1.0 : v(0)\y = 1.0 : v(0)\z = 1.0
  v(1)\x = 1.0 : v(1)\y = 1.0 : v(1)\z = 1.0
  v(2)\x = 1.0 : v(2)\y = 1.0 : v(2)\z =-1.0
  v(3)\x =-1.0 : v(3)\y = 1.0 : v(3)\z =-1.0
 
  v(4)\x =-1.0 : v(4)\y =-1.0 : v(4)\z = 1.0
  v(5)\x = 1.0 : v(5)\y =-1.0 : v(5)\z = 1.0
  v(6)\x = 1.0 : v(6)\y =-1.0 : v(6)\z =-1.0
  v(7)\x =-1.0 : v(7)\y =-1.0 : v(7)\z =-1.0
 
;           v0
;   v3               v1
;           v2
;   
;   
;           v4
;   v7               v5
;           v6
 
  mx = (MoveX / ScreenWidth ()) - 0.5
  my = (MoveY / ScreenHeight()) - 0.5
 
  For k=0 To 7
    Rotate(@v(k), RotationX, RotationY)
    v(k)\x + mx
    v(k)\y + my
    v(k)\z + MoveZ
   
    MultVectorMatrix(ProjectionMatrix(), @v(k))
   
    v(k)\x - mx
    v(k)\y - my
   
    v(k)\x * Scale
    v(k)\y * Scale
    v(k)\z * Scale
  Next k
 
  ; Top
  planes(0)\v[0] = @v(0)
  planes(0)\v[1] = @v(1)
  planes(0)\v[2] = @v(2)
  planes(0)\v[3] = @v(3)
  planes(0)\sprite = SpriteTop
 
  ; Back
  planes(1)\v[0] = @v(3)
  planes(1)\v[1] = @v(2)
  planes(1)\v[2] = @v(6)
  planes(1)\v[3] = @v(7)
  planes(1)\sprite = SpriteBack
 
  ; Right
  planes(2)\v[0] = @v(2)
  planes(2)\v[1] = @v(1)
  planes(2)\v[2] = @v(5)
  planes(2)\v[3] = @v(6)
  planes(2)\sprite = SpriteRight
 
  ; Front
  planes(3)\v[0] = @v(1)
  planes(3)\v[1] = @v(0)
  planes(3)\v[2] = @v(4)
  planes(3)\v[3] = @v(5)
  planes(3)\sprite = SpriteFront
 
  ; Left
  planes(4)\v[0] = @v(0)
  planes(4)\v[1] = @v(3)
  planes(4)\v[2] = @v(7)
  planes(4)\v[3] = @v(4)
  planes(4)\sprite = SpriteLeft
 
  ; Bottom
  planes(5)\v[0] = @v(4)
  planes(5)\v[1] = @v(7)
  planes(5)\v[2] = @v(6)
  planes(5)\v[3] = @v(5)
  planes(5)\sprite = SpriteBottom
 
  For k=0 To 5
    planes(k)\distance = (planes(k)\v[0]\z + planes(k)\v[1]\z + planes(k)\v[2]\z + planes(k)\v[3]\z) * 0.25
  Next k
 
  SortStructuredArray(planes(), 0, OffsetOf(SCube\distance), #PB_Sort_Float)
 
  For k=0 To 5
    TransformSprite3D(planes(k)\sprite, planes(k)\v[0]\x, planes(k)\v[0]\y, planes(k)\v[0]\z, planes(k)\v[3]\x, planes(k)\v[3]\y, planes(k)\v[3]\z, planes(k)\v[2]\x, planes(k)\v[2]\y, planes(k)\v[2]\z, planes(k)\v[1]\x, planes(k)\v[1]\y, planes(k)\v[1]\z)
    DisplaySprite3D(planes(k)\sprite, MoveX, MoveY)
Next k



EndProcedure

UsePNGImageDecoder()

OpenWindow(0, 50, 50, 640, 480, "Press Escape", #PB_Window_SystemMenu)
OpenWindowedScreen(WindowID(0), 0, 0, 640, 480, 1, 0, 0)

builtPerspective(ProjectionMatrix(), 45.0, ScreenWidth() / ScreenHeight(), 0.1, 10000.0)


CreateSprite(0,256,256,#PB_Sprite_Texture)

StartDrawing(SpriteOutput(0))

Box(0, 0, 256, 256, $0000FF)
Box(5, 5, 246, 246, $996600)
Circle(128,128,100,$0000FF)
LineXY(0, 0, 256, 256)
LineXY(0, 256,256,0)

StopDrawing()



CreateSprite3D(0, 0)
CreateSprite3D(1, 0)
CreateSprite3D(2, 0)
CreateSprite3D(3, 0)
CreateSprite3D(4, 0)
CreateSprite3D(5, 0)
CreateSprite3D(6, 0)

Define mdx.d
Define mdy.d
Define lastTime.l
Define currentTime.l

currentTime = ElapsedMilliseconds()

Repeat
  WindowEvent()
  ExamineKeyboard()
  

  If IsImage(MyImage)
  StartDrawing(SpriteOutput(0))
      DrawImage(ImageID(MyImage), 0, 0, 256, 256)
    StopDrawing()
  EndIf 
  currentTime = ElapsedMilliseconds()
 
  mdx = 50
  mdy = 130   
 
  
  ClearScreen(0)
  Start3D()
  
  DisplayCube(0, 0, 0, 0,0, 0, mdy, mdx, 170.0, 200.0, 230.0, 1.5)
  Stop3D()
  FlipBuffers()
Until WindowEvent() = #PB_Event_CloseWindow Or KeyboardPushed(#PB_Key_Escape)


End
Ich hab mich dann mit PBs 3D Engine befasst und nach Befehlen gesucht. Bin aber nicht fündig geworden. Das gleiche gilt für die MP3D engine.

Zur Veranschaulichung: Das kann Fireworks: http://tinypic.com/r/j0ejba/6
Allerdings leider nicht als Batch.
Es geht mir auch gar nicht um das "rumfahren" mit der Maus, wenn ich die X/Y Koordinaten für jede Ecke angeben kann, reicht das vollkommen. Wie TransformSprite3D(), aber der Output sollte halt nicht ganz so hässlich sein...

Bin für jeden Tipp dankbar, wie das irgendwie klappen könnte :)
Signatur und so
c4s
Beiträge: 1235
Registriert: 19.09.2007 22:18

Re: Bild oder Sprite verzerren?

Beitrag von c4s »

Ich hab mal meine Code-Sammlung durchforstet und folgendes gefunden:

Code: Alles auswählen

Structure PointF :  X.f : Y.f : EndStructure
Structure FLEX
  pt.POINT
  Plg.POINT[4]
  Vertx.POINT[4]
  s1.f[4]
  S2.PointF[4]
EndStructure

 
Global __Clip ,__Hatch,__Rim
Global _Brush,_BrushRGB,_BrushStyle
Global _DRAWING,_Grid,_Mode
Global _MyFont10=FontID(LoadFont(-1,"Arial",10))
Global _OldBrush,_Pen,_PenRGB,_PenStyle,_ShowCornerNumbers=1,_Showflag=1
Global _X,_Xmax,_Xmin,_Y,_Ymax,_Ymin

Global Dim Color(0, 0)
Global Dim Grid.POINT(0, 0) 
Global _Flex.FLEX

Title$ = "Image Rotate, Pull, Reverse & Stretch"
   
UseJPEGImageDecoder()
UseJPEGImageEncoder()
UsePNGImageDecoder()
UsePNGImageEncoder()
UseTGAImageDecoder()
UseTIFFImageDecoder()
#DBLUE=$660000
#LBLUE=$FFFCC2
Enumeration
  #ImGad
  #IMG
  #IMG2
  #Open
  #SaveAs
  #CornerNumbers
  #Quit     
  #HorVer
  #Diag
  #Grid
  #GridIMG
EndEnumeration
 
Macro MMx :  WindowMouseX(EventWindow()) : EndMacro
Macro MMy :  WindowMouseY(EventWindow()) : EndMacro
Macro MMK
  Abs(GetAsyncKeyState_(#VK_LBUTTON) +GetAsyncKeyState_(#VK_RBUTTON)*2+GetAsyncKeyState_(#VK_MBUTTON)*3)/$8000   
EndMacro
 
Macro MouseOverGad ;- MouseOverGad : ret GadgetID under mouse
  WindowFromPoint_(MMx|MMy<<32)
EndMacro
 
Macro LoBound(A,B) :  If A<B :A=B:EndIf : EndMacro
Macro HiBound(A,B) :  If A>B :A=B:EndIf : EndMacro
 
Procedure InMousEX(X,Y,X1,Y1)
  SetRect_(rc.RECT,X,Y,X1,Y1)
  ProcedureReturn PtInRect_(@rc,MMx|MMy<<32)
EndProcedure

Procedure  EndClip() ;- EndClip
  SelectClipRgn_(_DRAWING, 0)
  DeleteObject_(__Clip)
EndProcedure
 
Procedure  Clip(X,Y,X1,Y1) ;- Clip(X,Y,X1,Y1)
  If __Clip:EndClip():EndIf
  __Clip = CreateRectRgn_(X,Y,X1,Y1)
  If __Clip : SelectClipRgn_(_DRAWING, __Clip)
  Else      : __Clip=0
  EndIf
EndProcedure
 
Macro STOPDRAW  ;- StopDraw
  If _DRAWING
StopDrawing() : _DRAWING=0: EndIf
EndMacro
 
Macro DrawIMG(IMG) ;- DrawIMG(IMG) ; #ImageOutput=2
  STOPDRAW
_DRAWING=StartDrawing(ImageOutput(IMG)) ;<
EndMacro
 
Procedure Min(A,B)
  If A<B:ProcedureReturn A:EndIf
  ProcedureReturn B
EndProcedure
 
Procedure  ClsImg(IMG,RGB=0) ;-ClsImg(IMG,RGB=0)
  DrawIMG(IMG)
  Box(0,0,ImageWidth(IMG),ImageHeight(IMG),RGB)
EndProcedure
 
 
Macro DelBrush()   ;-DelBrush()
  If _Brush :DeleteObject_(_Brush) :EndIf
  _Brush=0
  If _OldBrush : SelectObject_(_DRAWING, _OldBrush) : EndIf
  _BrushRGB=0
EndMacro
 
Procedure  Brush(BrushRGB,style=#BS_SOLID,Hatch=0)  ;- Brush(BrushRGB,Style=#BS_SOLID,Hatch=0) #BS_HOLLOW, #BS_PATTERN
  Protected L.LOGBRUSH
  DelBrush()
  L\lbStyle=style
  L\lbColor=BrushRGB
  L\lbHatch=Hatch
  _Brush = CreateBrushIndirect_(@L)
  _OldBrush=SelectObject_(_DRAWING,_Brush)
  _BrushRGB=BrushRGB
  _BrushStyle=style
  __Hatch=Hatch
EndProcedure 
   
Macro DelPen() ;- DelPen
  If _Pen: DeleteObject_(_Pen) :EndIf
  _Pen=0: _PenRGB=0:__Rim=0
EndMacro
 
Macro Pen(Rim=1, PenRGB=0,style=#PS_SOLID) ;-  Pen(Rim=1, PenRGB=0,style=#ps_solid)
  DelPen()
  If style=#NULL_PEN
    _Pen= SelectObject_(_DRAWING,GetStockObject_ ( #NULL_PEN ))
  Else
    _Pen=CreatePen_(style,Rim,PenRGB)   
    SelectObject_(_DRAWING,_Pen)
  EndIf
  __Rim=Rim
  _PenRGB=PenRGB
  _PenStyle=style
EndMacro
     
Procedure CenterTXT(X,Y,Wi,He,T.S) 
 
  Protected TextWidth=TextWidth(T),TextHeight=TextHeight(T)
  Protected X1=X+Wi,Y1=Y+He
  Clip(X,Y,X1,Y1)
  If TextWidth>Wi :  DrawText(X,(Y+Y1)/2-TextHeight/2 , T)
  Else :  DrawText((X+X1)/2-TextWidth/2, (Y1+Y)/2-TextHeight/2 , T)
  EndIf
  EndClip()
EndProcedure
 
Procedure  Corners() ;-  draw corners
  Protected i
  With _Flex
    DrawingFont(_MyFont10)
    FrontColor(#LBLUE):BackColor(#DBLUE)
    For i = 0 To 3
      Circle (\Vertx[i]\X , \Vertx[i]\Y, 9,#DBLUE)
      CenterTXT(\Vertx[i]\X-5,\Vertx[i]\Y-5,10,10,Str(i))
    Next
  EndWith
EndProcedure
   
Procedure Bounding() ;- Bounding()
  Protected i
  With _Flex
    _Xmax=0 : _Xmin=$FFFFFF:_Ymax=0:_Ymin=$FFFFFF
    For i = 0 To 3   
      HiBound(_Xmin,\Vertx[i]\X)
      LoBound(_Xmax,\Vertx[i]\X)
      HiBound(_Ymin,\Vertx[i]\Y)
      LoBound(_Ymax,\Vertx[i]\Y)
    Next
  EndWith
EndProcedure
 
Procedure  STP(A,B,C,D,E)  ;- STP(A,B,C,D,E)  - aux de Sizes
  With _Flex
    \s1[0]   = (\S2[A]\X - \S2[B]\X) / E
    \s1[1]   = (_Flex\Vertx[C]\X - _Flex\Vertx[D]\X) / E
    \s1[2]   = (\S2[A]\Y    - \S2[B]\Y)   / E
    \s1[3]   = (_Flex\Vertx[C]\Y - _Flex\Vertx[D]\Y) / E
  EndWith
EndProcedure
   
Procedure  Sizes()
  Protected i,j,A.f,B.f,C.f,D.f
  With _Flex
    ;  _Xmax = 0 : _Xmin = _X : _Ymax = 0 : _Ymin = _Y
    Bounding()
    \S2[0]\X = (\Vertx[1]\X - \Vertx[0]\X)  / \pt\X ; step X HOR TOP
    \S2[0]\Y = (\Vertx[1]\Y - \Vertx[0]\Y)  / \pt\X ; step Y HOR TOP
    \S2[1]\X = (\Vertx[2]\X - \Vertx[3]\X)  / \pt\X ; step X HOR BOTTOM
    \S2[1]\Y = (\Vertx[2]\Y - \Vertx[3]\Y)  / \pt\X ; step Y HOR BOTTOM
    \S2[2]\X = (\Vertx[3]\X - \Vertx[0]\X)  / \pt\Y ; step X VER LEFT
    \S2[2]\Y = (\Vertx[3]\Y - \Vertx[0]\Y)  / \pt\Y ; step Y VER LEFT
    \S2[3]\X = (\Vertx[2]\X - \Vertx[1]\X)  / \pt\Y ; step X VER RIGHT
    \S2[3]\Y = (\Vertx[2]\Y - \Vertx[1]\Y)  / \pt\Y ; step Y VER RIGHT
   
    STP(1,0,3,0,\pt\Y)
   
    For j = 0 To \pt\Y
      A=\S2[0]\X     +\s1[0]*j
      B=\Vertx[0]\X  +\s1[1]*j
      C=\S2[0]\Y     +\s1[2]*j
      D=\Vertx[0]\Y  +\s1[3]*j
      For i = 0 To \pt\X
        Grid(i,j)\X=A*i+B
        Grid(i,j)\Y=C*i+D
      Next
    Next
   
    STP(3,2,1,0,\pt\X)
   
    For j = 0 To \pt\X
      A=\S2[2]\X    +\s1[0]*j
      B=\Vertx[0]\X +\s1[1]*j
      C=\S2[2]\Y    +\s1[2]*j
      D=\Vertx[0]\Y +\s1[3]*j
      For i = 1 To \pt\Y
        Grid(j,i)\X=A*i+B
        Grid(j,i)\Y=C*i+D
      Next
    Next
  EndWith
EndProcedure 
   
Procedure FastGrid(Wi,He,StpX=24,StpY=-1,RGB=-1)
  If StpY=-1:StpY=StpX:EndIf
  If RGB=-1:RGB=$555555:EndIf
  For Y=0 To He
    LineXY(0,Y,Wi,Y,RGB)
    Y+StpY
  Next
  For X=0 To Wi
    LineXY(X,0,X,He,RGB)
    X+StpX   
  Next
EndProcedure
 
Macro InitGrid() ;- InitGrid()
  CreateImage(#GridIMG,_X,_Y)
  DrawIMG(#GridIMG)
  FastGrid(_X,_Y,30,30)
  STOPDRAW
EndMacro     
   
Procedure  FastImage() ;- Faster than ShowImage - ONLY POINTS to circumvent the Polygon drawing
  Static i,j,STP
  With _Flex
    If _Grid
      FreeImage(#IMG)
      GrabImage(#GridIMG,#IMG,0,0,_X,_Y)
      DrawIMG(#IMG)
    Else       
      DrawIMG(#IMG)
      ClsImg(#IMG)
    EndIf 
    If _ShowCornerNumbers : Corners() : EndIf
    STP=\pt\X/120  ; LONGER STP = QUICKER DRAWING 
    LoBound(STP,1)
    i=0
    Repeat   ; Increase Stp for slow processor
      j=0
      Repeat
        Box(Grid(i, j)\X, Grid(i, j)\Y,1,1, Color(i, j))
        j+STP
      Until j>=\pt\Y
      i+STP
    Until i>=\pt\X
    STOPDRAW
    SetGadgetState(#ImGad, ImageID(#IMG))
  EndWith
EndProcedure
     
Procedure  Polyg( Sides,*P,RGB=-1) ;P= array of POINT struc with polyg vertices ; sides >1
  If RGB>-1
    Pen(1,RGB):Brush(RGB)
  EndIf
  Polygon_(_DRAWING,*P,Sides) 
EndProcedure
     
Procedure ShowImage()
  Protected i,j,i2,j2
  With _Flex
    If _Grid
      FreeImage(#IMG)
      GrabImage(#GridIMG,#IMG,0,0,_X,_Y)
      DrawIMG(#IMG)
    Else       
      DrawIMG(#IMG)
      ClsImg(#IMG,0)
    EndIf 
    If _ShowCornerNumbers : Corners() : EndIf
   
    For i = 0 To \pt\X
      DrawIMG(#IMG)
     
      If MMK = 1 : _Showflag=0: ProcedureReturn : EndIf ;  show interruptus
      i2=i+1
      WindowEvent()
     
      For j = 0 To \pt\Y
        If j < \pt\Y And i < \pt\X
          j2=j+1
          \Plg[0]\X = Grid(i ,j )\X ;  Polygon positions
          \Plg[0]\Y = Grid(i ,j )\Y
          \Plg[1]\X = Grid(i2,j )\X
          \Plg[1]\Y = Grid(i2,j )\Y
          \Plg[2]\X = Grid(i2,j2)\X
          \Plg[2]\Y = Grid(i2,j2)\Y
          \Plg[3]\X = Grid(i ,j2)\X
          \Plg[3]\Y = Grid(i ,j2)\Y
          Pen(1,Color(i,j)):Brush(Color(i,j))
          Polyg(4,\Plg[0])
        Else
          Plot(Grid(i,j)\X, Grid(i,j)\Y, Color(i,j)) ; only 1 pixel for the last line
        EndIf
      Next
      If _ShowCornerNumbers : Corners() : EndIf
      STOPDRAW
      SetGadgetState(#ImGad,ImageID(#IMG))
    Next
  EndWith
EndProcedure
   
Procedure SaveImg(DefaultFile$="",Title.S="Save Image") ; Save Image
  Protected Flag, Pattern$ = "(*.bmp)|*.bmp|"   
  Pattern$ + "(*.jpg)|*.jpg|"   
  Pattern$ + "(*.png)|*.png|"   
  File$=SaveFileRequester("Please Choose The File Name To Save", DefaultFile$, Pattern$, 0)
  If File$
    If _ShowCornerNumbers
      Flag=1
      _ShowCornerNumbers = 0
    EndIf   
    If _Grid
      Flag+2
      _Grid=0
    EndIf
    If Flag : ShowImage()  : EndIf
   
    Select SelectedFilePattern()
      Case 0 : SaveImage(#IMG,File$,#PB_ImagePlugin_BMP)
      Case 1 : SaveImage(#IMG,File$,#PB_ImagePlugin_JPEG,10)
      Case 2 : SaveImage(#IMG,File$,#PB_ImagePlugin_PNG)
    EndSelect
    MessageRequester("","Saved to "+File$, #PB_MessageRequester_Ok)
  Else
    MessageRequester("","File Not Saved", #PB_MessageRequester_Ok)
  EndIf   
 
  If Flag=1 Or Flag=3:_ShowCornerNumbers=1:EndIf
  If Flag=2 Or Flag=3:_Grid=1:EndIf
  If Flag:ShowImage():EndIf
EndProcedure
   
Procedure$ GetLastDir(LastDirFile.S)
  Protected Temp= ReadFile(-1,GetTemporaryDirectory()+LastDirFile)
  If Temp
    LastDir.S=ReadString(Temp)
    CloseFile(Temp)
  EndIf   
  ProcedureReturn LastDir.S
EndProcedure
 
Procedure SetLastDir(LastDirFile.S,LastDir.S)  ;-SetLastDir - pone en TempDir
  Protected Temp
  DeleteFile(GetTemporaryDirectory()+LastDirFile)
  Temp=OpenFile(-1,GetTemporaryDirectory()+LastDirFile)
  If Temp
    WriteString(Temp,LastDir)
    CloseFile(Temp)
  EndIf
EndProcedure
 
Procedure LeeImg(*P.POINT)
  Protected StandardFile$
  Static IMG,hIMG
  If IsImage(IMG):FreeImage(IMG):EndIf
  If hIMG:DeleteDC_(hIMG):EndIf
  LastDirFile.S="EstiraLast"
  Pattern$ = "Images (*.bmp, *.jpg, *.png, *.tiff, *.tga)|*.bmp;*.jpg; *.png; *.tiff ; *.tga |All files (*.*)|*.*"
  StandardFile$=GetLastDir(LastDirFile)
  If StandardFile$=""
    StandardFile$ = "c:\" ; put here your image directory
  EndIf
  File$ = OpenFileRequester("Load Image", StandardFile$, Pattern$, Pattern)
  If File$
    StandardFile$=GetPathPart(File$)
    SetLastDir(LastDirFile,StandardFile$)
    hIMG = CreateCompatibleDC_(GetDC_(WindowID(0)))
    IMG = LoadImage(#PB_Any, File$,  #PB_Image_DisplayFormat)
    If ImageWidth(IMG)>_X
      ResizeImage(IMG,_X,ImageHeight(IMG))
    EndIf
    If ImageHeight(IMG)>_Y
      ResizeImage(IMG,ImageWidth(IMG),_Y)
    EndIf
    *P\X=ImageWidth(IMG):*P\Y=ImageHeight(IMG)
    SelectObject_(hIMG, ImageID(IMG))
    ProcedureReturn hIMG
  EndIf
EndProcedure
   
Procedure  Menu(Win=0) ;- Menu(win)
  Protected Menu= CreateMenu(-1, WindowID(Win))   
  MenuTitle("   File")
  MenuItem(#Open,"Open ")
  MenuBar()
  MenuItem(#SaveAs,"Save As")
  MenuBar()
  MenuItem(#Quit,"Quit")
  MenuTitle("   Options")
  MenuItem( #CornerNumbers, "Switch Corner Numbers")
  MenuBar()
  MenuItem(#Grid,"Switch Grid")
  ProcedureReturn Menu
EndProcedure
     
Procedure NewImage()
 Protected hIMG = LeeImg(@P.POINT) ,X,Y,CenterX,CenterYsz
  With _Flex
    If hIMG 
      \pt\X = P\X - 1 : \pt\Y = P\Y - 1
      Global Dim Color(\pt\X, \pt\Y)
      Global Dim Grid.POINT (\pt\X, \pt\Y )
      For X = 0 To \pt\X
        For Y = 0 To \pt\Y
          Color(X, Y) = GetPixel_(hIMG, X, Y)
        Next
      Next
      CenterX=_X/2:CenterY=_Y/2
      SZ=Min(_X,_Y)/10
      \Vertx[0]\X = CenterX-SZ
      \Vertx[0]\Y = CenterY-SZ
      \Vertx[1]\X = CenterX+SZ
      \Vertx[1]\Y = CenterY-SZ
      \Vertx[2]\X = CenterX+SZ
      \Vertx[2]\Y = CenterY+SZ
      \Vertx[3]\X = CenterX-SZ
      \Vertx[3]\Y = CenterY+SZ       
      Sizes() : ShowImage()
    EndIf
  EndWith
EndProcedure

Procedure GetDistance(A1,A2) ;- GetDistance(a1,a2)
  ProcedureReturn Sqr(A1*A1 + A2*A2)         
EndProcedure

Procedure Near(X,Y); X, Y, ArrSize, ARRAY P.POINT(1)) ; Return elem de Array de Points Nearest to  x,y
  Protected A,i,min
  With _Flex
    min = $FFFFFFF
    For i = 0 To 3
      A = GetDistance(X - \Vertx[i]\X, Y - \Vertx[i]\Y)
      If A < min : min = A : Near = i : EndIf
    Next i
    ProcedureReturn Near
  EndWith
EndProcedure

    ;<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
   
If  OpenWindow(0, 100, 100,600,400,Title$, #WS_OVERLAPPEDWINDOW | #WS_MAXIMIZE)
  SetWindowColor(0,0)
  StickyWindow(0,1)
 
  _X=WindowWidth(0):_Y=WindowHeight(0)
  Menu()   
  CreateImage(#IMG, _X,_Y,32)
  ImageGadget(#ImGad,0,0,0,0,ImageID(#IMG))
  SetWindowLongPtr_(GadgetID(#ImGad), -20, GetWindowLongPtr_(GadgetID(#ImGad), -20) | $2000000)
 
  InitGrid() : NewImage()
  With _Flex
   
    Repeat
      If GetAsyncKeyState_(#VK_ESCAPE) :  End:EndIf
     
      Ev = WaitWindowEvent(1)
      Select Ev
        Case #PB_Event_Menu
          Select EventMenu() ; To see which menu has been selected
            Case #Quit  : End
            Case #Open  :NewImage()
            Case #SaveAs:SaveImg()
            Case #CornerNumbers ;  switch corner numbers
              _ShowCornerNumbers = 1 -_ShowCornerNumbers 
              ShowImage() 
            Case #Grid
              _Grid=1-_Grid
              ShowImage()     
          EndSelect
        Case #PB_Event_SizeWindow
          _X=WindowWidth(0):_Y=WindowHeight(0)
          ShowImage()
        Default
          If Ev=#WM_MOUSEMOVE
            If MMK = 1
              If  InMousEX(1,1,_X-4,_Y-4)
                If Sel = 0
                  Near = Near(MMx,MMy)
                  Sel = 1
                EndIf
                _Showflag = 0
                \Vertx[Near]\X = MMx
                \Vertx[Near]\Y = MMy
                Sizes() :  FastImage()
              EndIf
            EndIf   
           
          EndIf 
          If MMK=0
            If _Showflag = 0 : _Showflag = 1 : ShowImage() : EndIf
            Sel = 0
          EndIf     
      EndSelect
    Until Ev = #PB_Event_CloseWindow
  EndWith
EndIf
  End 
... benutzt zwar z.T. WinAPI aber es sieht so aus, dass es sich auch komplett über das CanvasGadget() umsetzen lassen würde.

(Quelle und Autor leider unbekannt. Wer genaueres weiß, bitte bescheid sagen.)
"Menschenskinder, das Niveau dieses Forums singt schon wieder!" — GronkhLP ||| "ich hogffe ihr könnt den fehle endecken" — Marvin133 ||| "Ideoten gibts ..." — computerfreak ||| "Jup, danke. Gruss" — funkheld
Derren
Beiträge: 557
Registriert: 23.07.2011 02:08

Re: Bild oder Sprite verzerren?

Beitrag von Derren »

Hi. Erstmal danke für die flotte Antwort.
Aber bei mir funktioniert das nicht richtig.
Das geladene Bild wird nicht angezeigt. Nur wenn man die Ecken verzieht sieht man das eigentliche Bild. Aber es flimmert, wie ein Stroboskop und man sieht ein schwarzes Gitternetz. Das gespeicherte Ergebnis ist auch mangelhaft. Da ist nämich nur ein kleiner Ausschnitt.

Wenn man in den Optionen das Grid anmacht dann kann man damit arbeiten und der Output ist auch vollständig. Allerdings ist der Algorithmus nicht wirklich brauchbar. Das ist irgendeine komische Annäherung, die Kurven erzeugt. Mit dem Sprite, dass ich in dem Code oben erstelle, sieht man das ganz gut.

Hier nochmal ein Vergleich. Links das Ergebnis von deinem Code (Screenshot, aber das gespeicherte Bild sieht genauso aus, nur halt ohne die Ecken-Anfasser), rechts Fireworks.

Bild
Signatur und so
Rebon
Beiträge: 263
Registriert: 20.05.2009 19:13

Re: Bild oder Sprite verzerren?

Beitrag von Rebon »

Derren hat geschrieben:Bin für jeden Tipp dankbar, wie das irgendwie klappen könnte :)
Also da du für jeden Tipp geschrieben hast, versuche ich einen zu geben, aber ich sage gleich dazu das ich nur rate und auf dem Gebiet totaler Laie bin, vermutlich habt ihr das sicher schon in euren Codes berücksichtigt.

Möglicherweise wird in Fireworks bei jeder Veränderung immer wieder neu vom Ausgangsbild berechnet.

Ich entschuldige mich bereits jetzt schon mal vorsorglich, falls sich jemand durch diese Spekulation auf den Schlips getreten fühlt. :oops:
PB 4.00 | Windows XP Home SP3
Antworten