'=============================VisualMonsters.cba.pl============================== Imports System.Drawing.Imaging Public Class Form1 Public OffsetX As New List(Of Integer) Public OffsetY As New List(Of Integer) Public WszystkiePuzzle As New List(Of Bitmap) Public LokalizacjaPuzzla As New List(Of Rectangle) Private Trzymany As Integer = 0 Public TrzymanyIndex As New List(Of Boolean) Public TrzymanyIndexPrecyzyjny As New List(Of Integer) 'wykorzystamy go do precyzyjnego dopasowania elementów Private Sub Form1_Load(sender As Object, e As EventArgs) Handles MyBase.Load Me.BackgroundImage = ZmienKrycie(My.Resources.sp, 0.1) Dim ran As New Random 'przeszukujemy specjalną lokalizację naszego projektu, w poszukiwaniu obrazków For Each ResourceFile As DictionaryEntry In My.Resources.ResourceManager.GetResourceSet(Globalization.CultureInfo.CurrentCulture, True, True).OfType(Of Object)() 'jeśli natrafimy na obrazek If TypeOf (ResourceFile.Value) Is Image Then 'nie jest on obrazkiem złożonym sp.bmp (tym podglądowym) If Not ResourceFile.Key.ToString.Contains("sp") Then Dim imaeege As Image = ResourceFile.Value Dim bm_source As New Bitmap(imaeege) 'uzupełniamy listę o tą bitmapę WszystkiePuzzle.Add(bm_source) 'ustawiamy położenie startowe puzzli 'każdy puzel zostanie rozsypany losowo OffsetX.Add(ran.Next(0, Me.Width - 2 * bm_source.Width)) OffsetY.Add(ran.Next(0, Me.Height - 2 * bm_source.Height)) 'nie trzymamy jeszcze żadnych puzli, więc listę wypełniamy 'False' TrzymanyIndex.Add(False) End If End If Next 'Nie chcemy aby wielkość formy była mniejsza niż nasz obrazek, dlatego dodamy sobie takie ograniczenie Me.MinimumSize = New Size(My.Resources.sp.Width + 50, My.Resources.sp.Height + 50) 'Tworzymy figury o określonej lokalizacji (X,Y) i wielkości obrazka For i As Integer = 0 To WszystkiePuzzle.Count - 1 LokalizacjaPuzzla.Add(New Rectangle(OffsetX(i), OffsetY(i), WszystkiePuzzle(i).Width, WszystkiePuzzle(i).Height)) Next End Sub Private Sub Form1_Paint(ByVal sender As Object, ByVal e As System.Windows.Forms.PaintEventArgs) Handles Me.Paint 'Tworzy grafikę na formie głównej, wywoływany jest gdy zmianie ulega jakiś element For i As Integer = 0 To WszystkiePuzzle.Count - 1 If TrzymanyIndexPrecyzyjny.Contains(i) Then e.Graphics.FillRectangle(New SolidBrush(Color.FromArgb(50, 255, 0, 0)), LokalizacjaPuzzla(i)) End If e.Graphics.DrawImage(WszystkiePuzzle(i), LokalizacjaPuzzla(i)) Next End Sub 'Pubiera index elementu nad którym znajduje się kursor i zmienia położenie elementu jeśli jest trzymany Private Sub Form1_MouseMove(ByVal sender As Object, ByVal e As System.Windows.Forms.MouseEventArgs) Handles Me.MouseMove For i As Integer = 0 To WszystkiePuzzle.Count - 1 If TrzymanyIndex(i) = True Then LokalizacjaPuzzla(i) = New Rectangle(e.X + OffsetX(i), e.Y + OffsetY(i), WszystkiePuzzle(i).Width, WszystkiePuzzle(i).Height) Me.Invalidate() 'powoduje ponowne malowanie obiektów Else Dim new_cursor As Cursor = Cursors.Default For d As Integer = 0 To WszystkiePuzzle.Count - 1 If (KursorJestNadObiektem(e.X, e.Y, d)) Then new_cursor = Cursors.Hand 'ustawia index obiektu nad którym jest kursor Trzymany = d End If Next If (Me.Cursor <> new_cursor) Then Me.Cursor = new_cursor End If End If Next End Sub Private Function KursorJestNadObiektem(ByVal x As Integer, ByVal y As Integer, ByVal k As Integer) As Boolean If ((x < LokalizacjaPuzzla(k).Left) OrElse (y < LokalizacjaPuzzla(k).Top) OrElse (x >= LokalizacjaPuzzla(k).Right) _ OrElse (y >= LokalizacjaPuzzla(k).Bottom)) _ Then Return False Dim i As Integer = x - LokalizacjaPuzzla(k).X Dim j As Integer = y - LokalizacjaPuzzla(k).Y Return (WszystkiePuzzle(k).GetPixel(i, j).A > 0) End Function Private Sub Form1_MouseDown(ByVal sender As Object, ByVal e As System.Windows.Forms.MouseEventArgs) Handles Me.MouseDown TrzymanyIndexPrecyzyjny.Clear() Panel1.Enabled = False 'Warunek sprawdza który klawisz myszy jest trzymany If e.Button = MouseButtons.Left Then 'Trzymanie jednego elementu 'Funkcja sprawdza czy kursor myszy nadal jest nad obiektem If (KursorJestNadObiektem(e.X, e.Y, Trzymany)) Then TrzymanyIndex(Trzymany) = True 'elementy wykorzystywane do zmiany położenia puzzla OffsetX(Trzymany) = LokalizacjaPuzzla(Trzymany).X - e.X OffsetY(Trzymany) = LokalizacjaPuzzla(Trzymany).Y - e.Y 'lista wykorzystywana na późniejszym etapie do precyzyjnego ustawienia położenia TrzymanyIndexPrecyzyjny.Add(Trzymany) End If Else 'trzymanie wielu elementów Dim listaPolaczonych As New List(Of Integer) 'przechowuje elementy wielu połączonych puzzli 'Funkcja sprawdza czy kursor myszy nadal jest nad obiektem If (KursorJestNadObiektem(e.X, e.Y, Trzymany)) Then 'dodaje pierwszy index trzymanego obiektu TrzymanyIndex(Trzymany) = True 'elementy wykorzystywane do zmiany położenia puzzla OffsetX(Trzymany) = LokalizacjaPuzzla(Trzymany).X - e.X OffsetY(Trzymany) = LokalizacjaPuzzla(Trzymany).Y - e.Y ' dwie listy indexów, jedna wykorzystywana do przenoszenia bardzo wielu połączonych puzzli listaPolaczonych.Add(Trzymany) TrzymanyIndexPrecyzyjny.Add(Trzymany) For Each el As Rectangle In LokalizacjaPuzzla 'Warunek sprawdza czy w obrębie puzla znajdują się inne puzle które można by przesunąć (z dokładnością 5%) If (el.Location.X >= (LokalizacjaPuzzla(Trzymany).Location.X - 0.05 * LokalizacjaPuzzla(Trzymany).Width) And el.Location.X <= (LokalizacjaPuzzla(Trzymany).Location.X + LokalizacjaPuzzla(Trzymany).Width + 0.05 * LokalizacjaPuzzla(Trzymany).Width) Or el.Location.X + el.Width >= (LokalizacjaPuzzla(Trzymany).Location.X - 0.05 * LokalizacjaPuzzla(Trzymany).Width) And el.Location.X <= (LokalizacjaPuzzla(Trzymany).Location.X + LokalizacjaPuzzla(Trzymany).Width + 0.05 * LokalizacjaPuzzla(Trzymany).Width)) And (el.Location.Y >= (LokalizacjaPuzzla(Trzymany).Location.Y - 0.05 * LokalizacjaPuzzla(Trzymany).Height) And el.Location.Y <= (LokalizacjaPuzzla(Trzymany).Location.Y + LokalizacjaPuzzla(Trzymany).Height + 0.05 * LokalizacjaPuzzla(Trzymany).Height) Or el.Location.Y + el.Height >= (LokalizacjaPuzzla(Trzymany).Location.Y - 0.05 * LokalizacjaPuzzla(Trzymany).Height) And el.Location.Y <= (LokalizacjaPuzzla(Trzymany).Location.Y + LokalizacjaPuzzla(Trzymany).Height + 0.05 * LokalizacjaPuzzla(Trzymany).Height)) Then 'Jeśli znajdują się tam jakieś puzzle wtedy dodajemy ich indexy do list aby była możliwość 'wyróżnienia ich w następnych krokach If Not TrzymanyIndexPrecyzyjny.Contains(LokalizacjaPuzzla.IndexOf(el)) Then TrzymanyIndexPrecyzyjny.Add(LokalizacjaPuzzla.IndexOf(el)) TrzymanyIndex(LokalizacjaPuzzla.IndexOf(el)) = True 'ustawiamy offset OffsetX(LokalizacjaPuzzla.IndexOf(el)) = LokalizacjaPuzzla(LokalizacjaPuzzla.IndexOf(el)).X - e.X OffsetY(LokalizacjaPuzzla.IndexOf(el)) = LokalizacjaPuzzla(LokalizacjaPuzzla.IndexOf(el)).Y - e.Y End If End If Next 'Jeśli przytrzymamy Ctrl na klawiaturze, podczas trzymania lewego przycisku myszy 'będziemy mogli przesunąć nietylko elementy zawierające się w obrębie jednego puzzla, 'będziemy mogli przesunąć wszystkie puzzle do siebie przylegające If My.Computer.Keyboard.CtrlKeyDown Then 'pętla strawdza warunek dla wszystkich elementów z listy dodatkowej, jeśli do elementów na liście należą inne elementy na liście się nie znajdującej, wtedy dodawane są do listy Do Dim przerwijPetle As Boolean = True 'warunek kończący pętle For i As Integer = 0 To TrzymanyIndex.Count - 1 If TrzymanyIndex(i) = True Then If Not listaPolaczonych.Contains(i) Then listaPolaczonych.Add(i) przerwijPetle = False For Each el As Rectangle In LokalizacjaPuzzla If (el.Location.X >= (LokalizacjaPuzzla(i).Location.X - 0.05 * LokalizacjaPuzzla(i).Width) And el.Location.X <= (LokalizacjaPuzzla(i).Location.X + LokalizacjaPuzzla(i).Width + 0.05 * LokalizacjaPuzzla(i).Width) Or el.Location.X + el.Width >= (LokalizacjaPuzzla(i).Location.X - 0.05 * LokalizacjaPuzzla(i).Width) And el.Location.X <= (LokalizacjaPuzzla(i).Location.X + LokalizacjaPuzzla(i).Width + 0.05 * LokalizacjaPuzzla(i).Width)) And (el.Location.Y >= (LokalizacjaPuzzla(i).Location.Y - 0.05 * LokalizacjaPuzzla(i).Height) And el.Location.Y <= (LokalizacjaPuzzla(i).Location.Y + LokalizacjaPuzzla(i).Height + 0.05 * LokalizacjaPuzzla(i).Height) Or el.Location.Y + el.Height >= (LokalizacjaPuzzla(i).Location.Y - 0.05 * LokalizacjaPuzzla(i).Height) And el.Location.Y <= (LokalizacjaPuzzla(i).Location.Y + LokalizacjaPuzzla(i).Height + 0.05 * LokalizacjaPuzzla(i).Height)) Then If Not TrzymanyIndexPrecyzyjny.Contains(LokalizacjaPuzzla.IndexOf(el)) Then TrzymanyIndexPrecyzyjny.Add(LokalizacjaPuzzla.IndexOf(el)) TrzymanyIndex(LokalizacjaPuzzla.IndexOf(el)) = True OffsetX(LokalizacjaPuzzla.IndexOf(el)) = LokalizacjaPuzzla(LokalizacjaPuzzla.IndexOf(el)).X - e.X OffsetY(LokalizacjaPuzzla.IndexOf(el)) = LokalizacjaPuzzla(LokalizacjaPuzzla.IndexOf(el)).Y - e.Y End If End If Next End If End If Next 'pętla kończy się gdy nie ma już co dodać If przerwijPetle = True Then Exit Do End If Loop End If End If End If End Sub 'Upuszczenie puzla Private Sub Form1_MouseUp(ByVal sender As Object, ByVal e As System.Windows.Forms.MouseEventArgs) Handles Me.MouseUp Panel1.Enabled = True For i As Integer = 0 To WszystkiePuzzle.Count - 1 'Nie chcemy aby nasze puzzle wylądowały poza obszarem gry, dlatego wprowadzimy sobie dodatkowe ustawienia If LokalizacjaPuzzla(i).Location.X + WszystkiePuzzle(i).Width > Me.Width Then LokalizacjaPuzzla(i) = New Rectangle(Me.Width - WszystkiePuzzle(i).Width, LokalizacjaPuzzla(i).Location.Y, WszystkiePuzzle(i).Width, WszystkiePuzzle(i).Height) End If If LokalizacjaPuzzla(i).Location.Y + WszystkiePuzzle(i).Height > Me.Height Then LokalizacjaPuzzla(i) = New Rectangle(LokalizacjaPuzzla(i).Location.X, Me.Height - WszystkiePuzzle(i).Height, WszystkiePuzzle(i).Width, WszystkiePuzzle(i).Height) End If If LokalizacjaPuzzla(i).Location.X < 0 Then LokalizacjaPuzzla(i) = New Rectangle(0, LokalizacjaPuzzla(i).Location.Y, WszystkiePuzzle(i).Width, WszystkiePuzzle(i).Height) End If If LokalizacjaPuzzla(i).Location.Y < 0 Then LokalizacjaPuzzla(i) = New Rectangle(LokalizacjaPuzzla(i).Location.X, 0, WszystkiePuzzle(i).Width, WszystkiePuzzle(i).Height) End If TrzymanyIndex(i) = False Next TrzymanyIndexPrecyzyjny.Clear() Me.Invalidate() End Sub 'Aby ułatwić użytkownikowi kontrolę położenia puzla dodamy sobie możliwość jego dokładnej kontroli 'za pośrednictwem klawiszsy strzałek na klawiaturze Private Sub main_KeyDown(ByVal sender As System.Object, ByVal e As System.Windows.Forms.KeyEventArgs) Handles MyBase.KeyDown Select Case e.KeyCode Case Keys.Up For i As Integer = 0 To TrzymanyIndexPrecyzyjny.Count - 1 Dim moveX As Integer = LokalizacjaPuzzla(TrzymanyIndexPrecyzyjny(i)).Location.X Dim movey As Integer = LokalizacjaPuzzla(TrzymanyIndexPrecyzyjny(i)).Location.Y - 1 LokalizacjaPuzzla(TrzymanyIndexPrecyzyjny(i)) = New Rectangle(moveX, movey, WszystkiePuzzle(TrzymanyIndexPrecyzyjny(i)).Width, WszystkiePuzzle(TrzymanyIndexPrecyzyjny(i)).Height) Next Case Keys.Left For i As Integer = 0 To TrzymanyIndexPrecyzyjny.Count - 1 Dim moveX As Integer = LokalizacjaPuzzla(TrzymanyIndexPrecyzyjny(i)).Location.X - 1 Dim movey As Integer = LokalizacjaPuzzla(TrzymanyIndexPrecyzyjny(i)).Location.Y LokalizacjaPuzzla(TrzymanyIndexPrecyzyjny(i)) = New Rectangle(moveX, movey, WszystkiePuzzle(TrzymanyIndexPrecyzyjny(i)).Width, WszystkiePuzzle(TrzymanyIndexPrecyzyjny(i)).Height) Next Case Keys.Right For i As Integer = 0 To TrzymanyIndexPrecyzyjny.Count - 1 Dim moveX As Integer = LokalizacjaPuzzla(TrzymanyIndexPrecyzyjny(i)).Location.X + 1 Dim movey As Integer = LokalizacjaPuzzla(TrzymanyIndexPrecyzyjny(i)).Location.Y LokalizacjaPuzzla(TrzymanyIndexPrecyzyjny(i)) = New Rectangle(moveX, movey, WszystkiePuzzle(TrzymanyIndexPrecyzyjny(i)).Width, WszystkiePuzzle(TrzymanyIndexPrecyzyjny(i)).Height) Next Case Keys.Down For i As Integer = 0 To TrzymanyIndexPrecyzyjny.Count - 1 Dim moveX As Integer = LokalizacjaPuzzla(TrzymanyIndexPrecyzyjny(i)).Location.X Dim movey As Integer = LokalizacjaPuzzla(TrzymanyIndexPrecyzyjny(i)).Location.Y + 1 LokalizacjaPuzzla(TrzymanyIndexPrecyzyjny(i)) = New Rectangle(moveX, movey, WszystkiePuzzle(TrzymanyIndexPrecyzyjny(i)).Width, WszystkiePuzzle(TrzymanyIndexPrecyzyjny(i)).Height) Next End Select Me.Invalidate() End Sub Private Sub TrackBar1_Scroll(sender As Object, e As EventArgs) Handles TrackBar1.Scroll Me.BackgroundImage = ZmienKrycie(My.Resources.sp, TrackBar1.Value / 100) End Sub Public Shared Function ZmienKrycie(ByVal img As Image, ByVal Krycie As Single) As Bitmap Dim bmp As New Bitmap(img.Width, img.Height) Dim graphics__1 As Graphics = Graphics.FromImage(bmp) Dim colormatrix As New ColorMatrix colormatrix.Matrix33 = Krycie Dim imgAttribute As New ImageAttributes imgAttribute.SetColorMatrix(colormatrix, ColorMatrixFlag.[Default], ColorAdjustType.Bitmap) If Krycie = 1 Then graphics__1.FillRectangle(New SolidBrush(Color.Red), 0, 0, img.Width, img.Height) Else graphics__1.DrawImage(img, New Rectangle(0, 0, bmp.Width, bmp.Height), 0, 0, img.Width, img.Height, GraphicsUnit.Pixel, imgAttribute) End If graphics__1.Dispose() Return bmp End Function End Class