dotNETportal.cz

Tak tu je celý program. Na formuláři je nabídka. Volbou Akce proběhne prolínání obrázků z Resource, nebo se dají obrázky načíst ze souborů.

Dále je na formuláři PictureBox, do kterého se vykresluje a HScrollBar, kterým lze prolínání ovládat ručně. Formulář i PictureBox mají AutoSize.

No, s výkonem nevím, tak na malé obrázky anebo našlapaném počítači.

Imports System.Drawing.Imaging

Public Class Form1
  Dim soub1 As String = ""
  Dim soub2 As String = ""
  Dim stuj As Boolean

  Public Sub Prolinacka(ByVal pozice As Double)
    Dim obr1 As Image
    Dim obr2 As Image
    If soub1 <> "" And soub2 <> "" Then
      obr1 = Image.FromFile(soub1)
      obr2 = Image.FromFile(soub2)
    Else
      obr1 = My.Resources.scena2
      obr2 = My.Resources.scena1
    End If
    Dim obr = New Bitmap(obr1.Width, obr1.Height)
    Dim gr As Graphics = Graphics.FromImage(obr)
    Dim rect As Rectangle = Rectangle.Round(obr1.GetBounds(GraphicsUnit.Pixel))
    Dim imgAttr As New ImageAttributes
    Dim cM As Imaging.ColorMatrix
    Dim mA As Double = 0
    mA = pozice / 1000
    cM = New ColorMatrix(New Single()() { _
        New Single() {1.0, 0.0, 0.0, 0.0, 0.0}, _
        New Single() {0.0, 1.0, 0.0, 0.0, 0.0}, _
        New Single() {0.0, 0.0, 1.0, 0.0, 0.0}, _
        New Single() {0.0, 0.0, 0.0, 0.0, 0.0}, _
        New Single() {0.0, 0.0, 0.0, mA, 1.0}})
    imgAttr.SetColorMatrix(cM)
    gr.DrawImage(obr1, rect, 0, 0, obr1.Width, obr1.Height, GraphicsUnit.Pixel, imgAttr)
    cM = New ColorMatrix(New Single()() { _
        New Single() {1.0, 0.0, 0.0, 0.0, 0.0}, _
        New Single() {0.0, 1.0, 0.0, 0.0, 0.0}, _
        New Single() {0.0, 0.0, 1.0, 0.0, 0.0}, _
        New Single() {0.0, 0.0, 0.0, 0.0, 0.0}, _
        New Single() {0.0, 0.0, 0.0, 1 - mA, 1.0}})
    imgAttr.SetColorMatrix(cM)
    gr.DrawImage(obr2, rect, 0, 0, obr2.Width, obr2.Height, GraphicsUnit.Pixel, imgAttr)
    PictureBox1.Image = obr
    PictureBox1.Refresh()

  End Sub
  Private Sub HScrollBar1_Scroll(ByVal sender As System.Object, ByVal e As System.Windows.Forms.ScrollEventArgs) Handles HScrollBar1.Scroll
    stuj = True
    Dim hdn As Integer = HScrollBar1.Value
    Me.Text = hdn
    Prolinacka(hdn)
  End Sub

  Private Sub KonecToolStripMenuItem_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles KonecToolStripMenuItem.Click
    Me.Close()
    End
  End Sub

  Private Sub AutomatToolStripMenuItem_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles AutomatToolStripMenuItem.Click
    If AutomatToolStripMenuItem.Text = "Stop" Then
      stuj = True
    Else
      AutomatToolStripMenuItem.Text = "Stop"
      stuj = False
      HScrollBar1.Value = 0
    End If
    For i As Double = 0 To 1000 Step 10
      Me.Text = i
      HScrollBar1.Value = i
      Prolinacka(i)
      'System.Threading.Thread.Sleep(100)
      Application.DoEvents()
      If stuj Then
        AutomatToolStripMenuItem.Text = "Akce"
        Exit For
      End If
    Next
    AutomatToolStripMenuItem.Text = "Akce"
  End Sub

  Private Sub NačtiObr1ToolStripMenuItem_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles NačtiObr1ToolStripMenuItem.Click
    NactiObr(1)
  End Sub

  Private Sub NačtiObr2ToolStripMenuItem_Click_1(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles NačtiObr2ToolStripMenuItem.Click
    NactiObr(2)
    Me.Height = 200
    Me.Width = 300
    PictureBox1.Height = 80
    PictureBox1.Width = 100
  End Sub

  Private Sub NactiObr(ByVal i As Integer)
    stuj = True
    OpenFileDialog1.FileName = ""
    OpenFileDialog1.Filter = "Obrazové soubory|*.bmp;*.jpg;*.jpeg;*.gif|Bitmap Files" & _
        "*.bmp)|*.bmp|GIF (*.gif)|*.gif|JPEG (*.jpg)|*.jpg;*.jpeg|Všechny soubory|*.*"
    If OpenFileDialog1.ShowDialog() <> DialogResult.OK Then
      soub1 = "" : soub2 = ""
      PictureBox1.Image = Nothing
      Exit Sub
    End If
    Me.Height = 200
    Me.Width = 300
    PictureBox1.Height = 80
    PictureBox1.Width = 100
    Me.Text = OpenFileDialog1.FileName
    Try
      PictureBox1.Image = Image.FromFile(OpenFileDialog1.FileName)
      If i = 1 Then
        soub1 = OpenFileDialog1.FileName
      Else
        soub2 = OpenFileDialog1.FileName
      End If
    Catch ex As Exception
      MsgBox(ex.ToString, MsgBoxStyle.Critical, " Chyba při načítání souboru: ")
    End Try
  End Sub

End Class