Gummiband

[Ralph Theobald]

Ich suche schon länger die Möglichkeit eine Linie,ein Rechteck mit der
Maus flimmerfrei auf den Bildschirm zu zeichnen.

Ich habe eine Lösung gefunden, deren Umsetzung in Profan mir nicht gelingt.(Text zwischen den beiden Smilies)

Zitat:
" ( wg. Guttenberg )

Echtzeit-Ausgabe beim Erstellen und Editieren von Zeichenobjekten

Wenn man zum Beispiel mit der Maus in einem Zeichenprogramm ein geometrisches Objekt (z.B. ein Polygon) auf der Zeichenfläche in Echtzeit von Position A nach Position B verschieben möchte, dann wäre es sinnlos, für jede der Zwischenpositionen, an denen sich die Maus gerade befindet, alles neu zu zeichnen, den Puffer zu füllen und anschließend auszugeben. Hier bedient man sich eines Kniffes. Mit Hilfe des ROP (Raster Operator) kann man mit XOR (exklusives OR) folgendermaßen vorgehen.
Man zeichnet das zu verschiebende Objekt zunächst mit XOR an der alten Stelle noch einmal direkt auf dem Ausgabegerät. Dadurch „verschwindet“ dieses Objekt auf der Ausgabefläche wie von Geisterhand. Nun zeichnet man das Objekt direkt und ohne XOR an die neue Position, so dass es dort wieder sichtbar wird. Das wiederholt man bei jeder einzelnen Mausbewegung erneut, so dass innerhalb einer Sekunde durchaus 10-50 Positionsveränderungen dargestellt werden können. Das träge Auge nimmt dies als ruckelfreien und fließenden Vorgang ohne Flimmern wahr. Erst am Schluss wird der Puffer komplett neu gefüllt und ausgegeben. Diese Methode des nicht beständigen, direkten Zeichnens auf ein Device nennt man auch „floating drawing“.
"
Bei Microsoft findet man folgendes:

For a color device, GDI uses RGB values to represent the colors of the pen and the destination. An RGB color value is a long integer that contains a red, a green, and a blue color field, each specifying the intensity of the specified color. Intensities range from 0 through 255. The values are packed in the three low-order bytes of the long integer. The color of a pen is always a solid color, but the color of the destination may be a mixture of any two or three colors. If an application attempts to draw with a white pen on a blue destination by using the available binary raster operations, the following results occur.
Raster operation Result
R2_BLACK Visible black line
R2_COPYPEN Visible white line
R2_MASKNOTPEN Visible black line
R2_MASKPEN Invisible blue line
R2_MASKPENNOT Visible red/green line
R2_MERGENOTPEN Invisible blue line
R2_MERGEPEN Visible white line
R2_MERGEPENNOT Visible white line
R2_NOP Invisible blue line
R2_NOT Visible red/green line
R2_NOTCOPYPEN Visible black line
R2_NOTMASKPEN Visible red/green line
R2_NOTMERGEPEN Visible black line
R2_NOTXORPEN Invisible blue line
R2_WHITE Visible white line
R2_XORPEN Visible red/green line


Kann mir jemand ein Beispiel machen, indem diese GDI32 Funktionen
(Rasteroperationen XOR) benutzt werden.

[Andreas Miethe]

Hallo Ralph,

hier ein kleines Beispiel, das funktioniert nur wenn Du von links/oben nach recht/unten das Rechteck mit der Maus aufziehst. Du musst Dir also die Koordinaten für andere Bewegungen anpassen.

$H Windows.ph

cls
Struct RECT = left&,top&,right&,bottom&
Declare Ende&,startx&,starty&
Var R# = New(RECT)

Whilenot Ende&
  WaitInput
  startx&=%mousex
  starty&=%mousey
  while %mousepressed
    ~SetROP2(%hdc,~R2_NOTXORPEN)
    IfNot ~IsRectEmpty(r#)
      Rectangle R#.Left&,R#.Top& - R#.right&,R#.bottom&
    endif
    ~SetRect(R#,startx&,starty&,%mousex,%mousey)
    Rectangle R#.Left&,R#.Top& - R#.right&,R#.bottom&
  Endwhile
  ~SetROP2(%hdc,~R2_COPYPEN)
EndWhile

[Frabbing]

Hab da auch noch was rumliegen:

Def SystemParametersInfo(4) !"user32","SystemParametersInfoA"
Def DrawFocusRect(2) !"user32","DrawFocusRect"
Def GetCursorPos(1) !"user32","GetCursorPos"
Def ScreenToClient(2) !"user32","ScreenToClient"

Declare x&,y&,rect#,z&
Dim rect#,16

Cls
DrawPic "Background.bmp", 0, 0 - x&, y&; 0

SystemParametersInfo($2011,0,4,0)    '4 = Strichbreite (ab XP)
SystemParametersInfo($200F,0,4,0)    '4 = Strichhöhe (ab XP)

UserMessages $200
While 1
  WaitInput
  Case %key=2:Break
  If IsKey(1)
    DrawFocusRect(%hdc,rect#)
    GetCursorPos(rect#)
    ScreenToClient(%hwnd,rect#)
    Long rect#,8=Long(rect#,0),Long(rect#,4)
    Long rect#,0=x&,y&
    If Long(rect#,0)>Long(rect#,8)
      z&=Long(rect#,8)
      Long rect#,8=Long(rect#,0)
      Long rect#,0=z&
    EndIf
    If Long(rect#,4)>Long(rect#,12)
      z&=Long(rect#,12)
      Long rect#,12=Long(rect#,4)
      Long rect#,4=z&
    EndIf
      Long rect#,0=Long(rect#,0)+2
      Long rect#,4=Long(rect#,4)+2
      DrawFocusRect(%hdc,rect#)
    Else
    GetCursorPos(rect#)
    ScreenToClient(%hwnd,rect#)
    x&=Long(rect#,0)
    y&=Long(rect#,4)
    Long rect#,0=0,0,0,0
  EndIf
Endwhile

Funktioniert in alle Richtungen und flimmerfrei. Bildname mal anpassen.

[Ralph Theobald]

Danke Frank

Beispiel 1 sieht schon mal gut aus.
Das Testprogramm in C++ kriegt das nicht hin.

[Ralph Theobald]

Das zweite Beispiel ist spitze.

[Andreas Miethe]

Zitat von Ralph Theobald

Das zweite Beispiel ist spitze.

Stimmt, nicht schlecht mit FocusRect().

Mit SetROP2() ist allerdings flexibler(Rechtecke, Kreise, Linien usw.), auch wenn es ein Relikt aus Zeiten von Win3.1 ist, funktioniert das doppelte Invertieren sehr gut.

$H Windows.ph
$H Messages.ph

cls $ff0000

'Pfad anpassen
Loadbmp "Creek.jpg",0,0;0

Struct RECT = left&,top&,right&,bottom&
Declare Ende&,startx&,starty&
Declare Oldx&,Oldy&
Var R# = New(RECT)

Usermessages ~WM_LBUTTONDOWN,~WM_MOUSEMOVE,~WM_LBUTTONUP

Whilenot Ende&
  WaitInput
  If %UMessage = ~WM_LBUTTONDOWN
    Usebrush 0,0
    Usepen 1,2,0
    startx&=Loword(&ULParam)
    starty&=HiWord(&ULParam)
    ~SetRect(R#,0,0,0,0)
  ElseIf (%UMessage = ~WM_MOUSEMOVE) and (&UWParam = ~MK_LBUTTON)
    ~SetROP2(%hdc,~R2_NOTXORPEN)
    ~SetROP2(%hdc2,~R2_NOTXORPEN)
    
    IfNot ~IsRectEmpty(r#)
      Ellipse R#.Left&,R#.Top& - R#.right&,R#.bottom&
    endif
    
    'Richtung ermitteln
    '##################
    if (startx& < LOWORD(&ulParam)) AND (starty& > HIWORD(&ulParam))
      ~SetRect(R#,startx&,HIWORD(&ulParam),LOWORD(&ulParam),starty&)
    elseif (startx& > LOWORD(&ulParam)) and (starty& > HIWORD(&ulParam))
      ~SetRect(R#,LOWORD(&ulParam),HIWORD(&ulParam),startx&,starty&)
    elseif (startx& > LOWORD(&ulParam)) AND (starty& < HIWORD(&ulParam))
      ~SetRect(R#,LOWORD(&ulParam),starty&,startx&,HIWORD(&ulParam))
    else
      ~SetRect(R#,startx&,starty&, LOWORD(&ulParam),HIWORD(&ulParam))
    endif
    '##################
    
    Ellipse R#.Left&,R#.Top& - R#.right&,R#.bottom&

  elseif %UMessage = ~WM_LBUTTONUP
    ~SetROP2(%hdc,~R2_COPYPEN)
    ~SetROP2(%hdc2,~R2_COPYPEN)
    Usepen 0,1,$FFFFFF
    Usebrush 1,$FF
    Ellipse R#.Left&,R#.Top& - R#.right&,R#.bottom&
  Endif
EndWhile

[Ralph Theobald]

Hallo Andreas,

$H Windows.ph

cls
Struct RECT = left&,top&,right&,bottom&
Declare Ende&,startx&,starty&
Var R# = New(RECT)

Whilenot Ende&
  WaitInput
  startx&=%mousex
  starty&=%mousey
  while %mousepressed
    ~SetROP2(%hdc,~R2_NOTXORPEN)
   ' IfNot ~IsRectEmpty(r#)
      Rectangle R#.Left&,R#.Top& - R#.right&,R#.bottom&
   ' EndIf
 
    ~SetRect(R#,startx&,starty&,%mousex,%mousey)
    Rectangle R#.Left&,R#.Top& - R#.right&,R#.bottom&
  Endwhile
  ~SetROP2(%hdc,~R2_NOTXORPEN)
EndWhile

So funktioniert dein Beispiel in alle Richtungen.

[Ralph Theobald]

Wie kann man im letzten Beispiel von Andreas die Füllung
halbtransparent machen

[Ralph Theobald]

Bevor ich es vergesse,

Allen ein Frohes Osterfest !

[Frabbing]

Stimmt, nicht schlecht mit FocusRect().

Mit SetROP2() ist allerdings flexibler(Rechtecke, Kreise, Linien usw.), auch wenn es ein Relikt aus Zeiten von Win3.1 ist, funktioniert das doppelte Invertieren sehr gut.

SetROP2 nutze ich selber auch gerne. Jetzt war aber nach Rechteck gefragt, da bieten sich die Focuslinien an. Vor allem, weil die Dicke auch frei wählbar ist.

[Frabbing]

Zitat von Ralph Theobald

Hallo Andreas,

$H Windows.ph

cls
Struct RECT = left&,top&,right&,bottom&
Declare Ende&,startx&,starty&
Var R# = New(RECT)

Whilenot Ende&
  WaitInput
  startx&=%mousex
  starty&=%mousey
  while %mousepressed
    ~SetROP2(%hdc,~R2_NOTXORPEN)
   ' IfNot ~IsRectEmpty(r#)
      Rectangle R#.Left&,R#.Top& - R#.right&,R#.bottom&
   ' EndIf
 
    ~SetRect(R#,startx&,starty&,%mousex,%mousey)
    Rectangle R#.Left&,R#.Top& - R#.right&,R#.bottom&
  Endwhile
  ~SetROP2(%hdc,~R2_NOTXORPEN)
EndWhile

So funktioniert dein Beispiel in alle Richtungen.

Das flackert bei mir leider sehr extrem. Ist auch ungünstig, das Zeichnen in einer Schleife laufen zu lassen, die ständig aktualisiert. In der Zeit wird auch keine Message mehr verarbeitet.

[Ralph Theobald]

Ich habe unter Codeproject folgendes gefunden:

DrawTools - CodeProject


Zu dieser Anwendung gehört eine DLL, vllt kann man die unter Xprofan
nutzen.

Dort gibt es noch einige interessante Demos: Painter,GDI+Generator.

[Ralph Theobald]

Was ist eigentlich aus deinem Oframe.dll - Projekt geworden Frank

Gibt es diese Dll auch ohne Nagscreen ?

[Frabbing]

Die OFrame ist eigentlich fertig so. Du findest die neuste Version auf Jac's Webpage: bloody random - Frank Abbings Software
Auf meiner Webpage versuche ich, mich auf wenige, ausgesuchte Software zu konzentrieren.

[Andreas Miethe]

Noch ein Gummiband, gefällt mir fast am besten, da sichtbarer.

$H Windows.ph
$H Messages.ph

cls
'Pfad anpassen
Loadbmp "Creek.jpg",0,0;0

Struct RECT = left&,top&,right&,bottom&
Declare Ende&,startx&,starty&
Var R# = New(RECT)

Usermessages ~WM_LBUTTONDOWN,~WM_MOUSEMOVE,~WM_LBUTTONUP
Randomize

Whilenot Ende&
  WaitInput
  If %UMessage = ~WM_LBUTTONDOWN
    Usebrush 0,0
    Usepen 0,2,$0000FF
    startx&=Loword(&ULParam)
    starty&=HiWord(&ULParam)
    ~SetRect(R#,0,0,0,0)
  ElseIf (%UMessage = ~WM_MOUSEMOVE) and (&UWParam = ~MK_LBUTTON)
    
    IfNot ~IsRectEmpty(r#)
      ~BitBlt(%hdc,R#.Left&-1,R#.Top&-1,R#.right&+1,R#.bottom&+1,%hdc2,R#.Left&-1,R#.Top&-1,~SRCCOPY)
    endif
    
    'Richtung ermitteln
    '##################
    if (startx& < LOWORD(&ulParam)) AND (starty& > HIWORD(&ulParam))
      ~SetRect(R#,startx&,HIWORD(&ulParam),LOWORD(&ulParam),starty&)
    elseif (startx& > LOWORD(&ulParam)) and (starty& > HIWORD(&ulParam))
      ~SetRect(R#,LOWORD(&ulParam),HIWORD(&ulParam),startx&,starty&)
    elseif (startx& > LOWORD(&ulParam)) AND (starty& < HIWORD(&ulParam))
      ~SetRect(R#,LOWORD(&ulParam),starty&,startx&,HIWORD(&ulParam))
    else
      ~SetRect(R#,startx&,starty&, LOWORD(&ulParam),HIWORD(&ulParam))
    endif
    
    '##################
    ' Malen nur mit API, nie mit Xprofan
    ' sonst wird %hdc2 überschrieben
    '##################
    'Linie
    ~MovetoEx(%hdc,startx&,starty&,0)
    ~LineTo(%hdc, LOWORD(&ulParam),HIWORD(&ulParam))
    'Ellipse
    ~Ellipse(%hdc,R#.Left&,R#.Top&,R#.right&,R#.bottom&)
    'Rechteck
    ~Rectangle(%hdc,R#.Left&,R#.Top&,R#.right&,R#.bottom&)
    
  elseif %UMessage = ~WM_LBUTTONUP
    'Usepen 0,2,$00FFFF
    'Usebrush 1,RND($FFFFFF)
    '###################
    'HDC2 überschreiben
    '###################
    Rectangle R#.Left&,R#.Top& - R#.right&,R#.bottom&
    Ellipse R#.Left&,R#.Top& - R#.right&,R#.bottom&
    MoveTo startx&,starty&
    LineTo LOWORD(&ulParam),HIWORD(&ulParam)
  Endif
EndWhile