| |
VB.NET - Ein- und UmsteigerRechteck skalieiren | | | Autor: 00Tobi | Datum: 07.04.16 19:18 |
| Hallo,
ich lasse mir über 2 Textboxen ein Rechteck zentriert in einer Groupbox erstellen.
Public Class Form1
Private Sub Button1_Click(sender As Object, e As EventArgs) Handles _
Button1.Click
Dim x As String
Dim y As String
Dim x1 As String
Dim y1 As String
Dim myBrush As New System.Drawing.SolidBrush( _
System.Drawing.Color.LemonChiffon)
Dim formGraphics As System.Drawing.Graphics
formGraphics = Me.GroupBox1.CreateGraphics()
x = TextBox1.Text
y = TextBox2.Text
x1 = (600 - x) / 2
y1 = (400 - y) / 2
'wenn leer
If TextBox1.Text = "" Or
TextBox2.Text = "" Then
Else
Label1.Text = x / y
formGraphics.FillRectangle(myBrush, New Rectangle(x1, y1, x, y))
End If
End Sub
End Class Wie würdet Ihr es machen, wenn der x Wert größer 580 und/oder der Y Wert größer 380 ist sollen die Maße im Verhältnis herunterskaliert werden.
Beispiel X Wert 870 enspricht den 1,5 fachen von 580, dann sollte auch der Y heruntergerechtnet werden.
Ich hoffe ich habe mich verständlich ausgedrückt.
Gruß | |
Re: Rechteck skalieren | | | Autor: Manfred X | Datum: 07.04.16 20:02 |
| Hallo !
Seien x, y die Size-Angaben und xmax, ymax die maximal zulässigen
Werte -> in xr, yr stehen nach Aufruf die skalierten Werte.
Eventuell noch ganzzahlig abrunden!
Private Sub Rescale(x As Double, y As Double, _
xmax As Double, ymax As Double, _
ByRef xr As Double, ByRef yr As Double)
If x < 1 Or y < 1 or xmax < 10 or ymax < 10 Then
Throw New ArgumentException
End If
xr = x : yr = y
If xr > xmax Then
xr = xmax : yr = y * xmax / x
End If
If yr > ymax Then
yr = ymax : xr = x * ymax / y
End If
End Sub Deklariere x,y,x1,y1 als Integer.
Nutze für die Abfrage der TextBoxen die Integer.Tryparse-Methode.
Verwende OPTION STRICT ON.
Hier noch die Integer-Variante:
Private Sub Rescale(x As Integer, y As Integer, _
xmax As Integer, ymax As Integer, _
ByRef xr As Integer, ByRef yr As Integer)
If x < 1 Or y < 1 Or ymax < 10 Or xmax < 10 Then
Throw New ArgumentException
End If
xr = x : yr = y
If xr > xmax Then
xr = xmax : yr = CInt(Math.Floor(y * xmax / x))
End If
If yr > ymax Then
yr = ymax : xr = CInt(Math.Floor(x * ymax / y))
End If
End Sub
Beitrag wurde zuletzt am 07.04.16 um 20:19:49 editiert. | |
Re: Rechteck skalieiren | | | Autor: 00Tobi | Datum: 07.04.16 20:39 |
| Hallo,
ich verstehe das Beispiel. Leider nicht wie ich es einbauen muss | |
Re: Rechteck skalieren | | | Autor: Manfred X | Datum: 07.04.16 21:08 |
| Muß das nicht eher so aussehen ....
Zeichnen im Paint-Eventhandler
Private Sub groupbox1_Paint(sender As Object,
e As System.Windows.Forms.PaintEventArgs) _
Handles groupbox1.Paint
Const xmax As Integer = 580
Const ymax As Integer = 380
Dim x, y, xr, yr, x1, y1 As Integer
If Not Integer.TryParse(textbox1.Text, x) Then Exit Sub
If Not Integer.TryParse(textbox2.Text, y) Then Exit Sub
Rescale(x, y, xmax, ymax, xr, yr) 'Integer-Variante von oben
x1 = CInt((600 - xr) / 2)
y1 = CInt((400 - yr) / 2)
Using myBrush As New SolidBrush(Color.LemonChiffon)
e.Graphics.FillRectangle(myBrush, New Rectangle(x1, y1, xr, yr))
End Using
End Sub Zeichnung anfordern:
Private Sub Button1_Click(sender As Object, _
e As System.EventArgs) Handles Button1.Click
groupbox1.Invalidate()
End Sub
Beitrag wurde zuletzt am 07.04.16 um 21:09:29 editiert. | |
Re: Rechteck skalieren | | | Autor: Opossum01 | Datum: 29.11.22 21:05 |
| Moin,
wie kann ich folgende Form skalieren ?
Public Class Form1
Private Sub Groupbox1_Paint(sender As Object, e As _
System.Windows.Forms.PaintEventArgs) Handles GroupBox1.Paint
e.Graphics.DrawLine(Pens.Brown, 100, 690, 100, 100)
e.Graphics.DrawLine(Pens.Brown, 100, 690, 900, 690)
e.Graphics.DrawLine(Pens.Brown, 100, 100, 471, 100)
e.Graphics.DrawLine(Pens.Brown, 471, 100, 471, 149)
e.Graphics.DrawLine(Pens.Brown, 471, 149, 561, 149)
e.Graphics.DrawLine(Pens.Brown, 561, 149, 561, 100)
e.Graphics.DrawLine(Pens.Brown, 561, 100, 832, 100)
e.Graphics.DrawLine(Pens.Brown, 832, 100, 832, 149)
e.Graphics.DrawLine(Pens.Brown, 832, 149, 900, 149)
e.Graphics.DrawLine(Pens.Brown, 900, 149, 900, 690)
End Sub
End Class | |
Re: Rechteck skalieren | | | Autor: Manfred X | Datum: 30.11.22 06:44 |
| Hallo!
Geht es darum. die gesamte Anzeige oder Teile davon einer Graphik neu zu skalieren?
Dafür gibt es Methoden im Framework bzw. GDI+ (z.B. Graphics.TransformPoints). | |
Re: Rechteck skalieren | | | Autor: Opossum01 | Datum: 30.11.22 20:16 |
| Hallo,
es geht darum, das ganze zu skalieren. Die beiden Ausklinkungen haben immer die gleichen Maße.
Ecke (70 x 40) und gerade (90 x 40)
Nur das ursprüngliche Rechteck hat andere Maße.
Geht sowas mit den Graphics.TransformPoints ? | |
Re: Rechteck skalieren | | | Autor: Manfred X | Datum: 30.11.22 21:55 |
| Hallo
Du kannst die Punkte skalieren.
Bei der Ausklinkung auf der Gerade aber nur den Punkt der linken oberen Ecke
(Geradenpunkt).
Die drei weiteren Punkte sind durch die relative Lage zu diesem Eckpunkt
unmittelbar ohne Skalierung gegeben (90,40).
Bei der Ecken-Ausklinkung ergibt sich die linke obere Ecke aus der neuen Breite des
Rechtecks abzüglich der gegebenen Eckenbreite (70, 40).
Die beiden weiteren Punkte sind dann durch die relative Lage zu diesem Eckpunkt
unmittelbar gegeben. | |
Re: Rechteck skalieren | | | Autor: Opossum01 | Datum: 01.12.22 19:07 |
| OK, das verstehe ich das alles relativ zu einen Punkt gesehen werden muss.
Könnten Sie vielleicht noch einen kleinen Beispielcode posten ? | |
Re: Rechteck skalieren | | | Autor: Manfred X | Datum: 02.12.22 11:44 |
| Hallo!
Hier ein programmiertes Beispiel zur Kombination von skalierten und relativen dazu liegenden Linien.
Private Function DrawFigure()
'Ausgangsgröße
Dim x() As Integer = {100, 471, 561, 832, 900}
Dim y() As Integer = {100, 149, 690}
'Größe der Kerben (Auslinkungen?)
Dim kerbtiefe As Integer = 40, kerblänge1 As Integer = 90, kerblänge2 = _
70
'skalierbare Punkte der Figur
Dim pts() As Point = {New Point(x(0), y(0)), New Point(x(0), y(2)),
New Point(x(4), y(2)), New Point(x(1), y(0)),
New Point(x(2), y(0))}
'Zentrum der Skalierung festlegen
Dim center As Point = pts(0)
'Skalierungsfaktoren (z.B. halbe Ausgangs-Größe)
Dim ScaleX As Single = 0.5
Dim ScaleY As Single = 0.5
'Skalierbare Punkte skalieren (Rescale Methode)
For i As Integer = 0 To pts.Length - 1
pts(i) = Rescale(pts(i), center, ScaleX, ScaleY)
Next
'Zeichnung (pb sei eine Picurebox auf der Form)
pb.Image = New Bitmap(1000, 1000)
Using g As Graphics = Graphics.FromImage(pb.Image),
p As New Pen(Color.Brown, 2)
'Skalierte Punkte zeichnen
g.DrawLine(p, pts(1), pts(0))
g.DrawLine(p, pts(1), pts(2))
g.DrawLine(p, pts(0), pts(4))
'Einkerbung relativ zu pts(4)
g.DrawLine(p, pts(4), New Point(pts(4).X, pts(4).Y + kerbtiefe))
g.DrawLine(p, New Point(pts(4).X, pts(4).Y + kerbtiefe),
New Point(pts(4).X + kerblänge1, pts(4).Y + kerbtiefe))
g.DrawLine(p, New Point(pts(4).X + kerblänge1, pts(4).Y + _
kerbtiefe),
New Point(pts(4).X + kerblänge1, pts(4).Y))
'Verbindungslinie zwischen Kerben
g.DrawLine(p, New Point(pts(4).X + kerblänge1, pts(4).Y),
New Point(pts(2).X - kerblänge2, pts(4).Y))
'zweite Einkerbung (relativ zu Punkt 2 und Punkt 4)
g.DrawLine(p, New Point(pts(2).X - kerblänge2, pts(4).Y),
New Point(pts(2).X - kerblänge2, pts(4).Y + _
kerbtiefe))
g.DrawLine(p, New Point(pts(2).X - kerblänge2, pts(4).Y + _
kerbtiefe),
New Point(pts(2).X, pts(4).Y + kerbtiefe))
'rechter Rand des Rechtecks ab Kerbung
g.DrawLine(p, New Point(pts(2).X, pts(4).Y + kerbtiefe), pts(2))
End Using
End Function
Private Function Rescale(p As Point, center As Point,
scalefactorX As Single, scalefactorY As Single) As Point
Return New Point(CInt((p.X - center.X) * scalefactorX + center.X),
(p.Y - center.Y) * scalefactorY + center.Y)
End Function | |
| Sie sind nicht angemeldet! Um auf diesen Beitrag zu antworten oder neue Beiträge schreiben zu können, müssen Sie sich zunächst anmelden.
Einloggen | Neu registrieren |
|
|
sevISDN 1.0
Überwachung aller eingehender Anrufe!
Die DLL erkennt alle über die CAPI-Schnittstelle eingehenden Anrufe und teilt Ihnen sogar mit, aus welchem Ortsbereich der Anruf stammt. Weitere Highlights: Online-Rufident, Erkennung der Anrufbehandlung u.v.m. Weitere InfosTipp des Monats sevAniGif (VB/VBA)
Anzeigen von animierten GIF-Dateien
Ab sofort lassen sich auch unter VB6 und VBA (Access ab Version 2000) animierte GIF-Grafiken anzeigen und abspielen, die entweder lokal auf dem System oder auf einem Webserver gespeichert sind. Weitere Infos
|