title image


Smiley Re: Zwei Bilder in ein neues Bild einfügen
Zwei Bilder in ein neues Bild einfügen



Ich möchte gerne zwei Bilder in ein neues Bild einfügen.

Die beiden Bilder überlappen sich in einem Bereich. Beide können dabei auch eine unterschiedliche Größe haben.

Wie erzeuge ich nun ein neues Bild mit der Größe Bild1 + Bild2 - Überlappungsbereich, und wie kann ich die beiden Bilder in das neue grosse Bild an der richtigen Position einfügen ??



Anleitung:

Erstelle ein neues Visual Basic Projekt.

Füge dem standardmäßig erstellten Formular folgende Steuerelemente hinzu:



4 Befehlsschaltflächen (Command1 bis Command4).

3 PictureBox Steuerelemente (Picture1 bis Picture3).

1 Common-Dialog Steuerelement (CommonDialog1), zu finden unter Projekt -> Komponenten -> Microsoft Common Dialog Control.





Dem Formular fügst Du folgenden Code hinzu:

Option Explicit Private mfMoving As BooleanPrivate msngStartX As Single, msngStartY As Single Private Sub Command1_Click()    ' Bmp - Datei öffnen und in Picture3 speichern.    ' Der Anwender kann dann das Bild mit der Maus positionieren    ' und es schließlich in seine Datei übernehmen    Dim sMsg As StringOn Error GoTo Err_Sub     If Picture3.Picture.Handle <> 0 Then        sMsg = "Es befindet sich noch ein Bild im Buffer." & vbCrLf & _               "Möchten Sie dieses Bild verwerfen?"        If MsgBox(sMsg, vbExclamation + vbYesNo) = vbYes Then            Picture3.Picture = LoadPicture()            Picture3.Visible = False            Command2.Enabled = False        Else            GoTo Exit_Sub        End If    End If      With CommonDialog1        .DialogTitle = "Bitmap hinzufügen"        .Filter = "Bitmaps (*.bmp)|*.bmp|Alle Dateien (*.*)|*.*"        .FilterIndex = 1        .Flags = cdlOFNFileMustExist Or _                 cdlOFNHideReadOnly Or _                 cdlOFNExplorer        .InitDir = App.Path        .CancelError = True        .ShowOpen        Picture3.Picture = LoadPicture(.FileName)    End With     mfMoving = False    Picture3.Move 0, 0     Picture3.Visible = True    Command2.Enabled = True     MsgBox "Bewegen Sie das Bild nun mit der Maus an die gewünschte Stelle " & _           "und übernehmen es dann.", vbInformation Exit_Sub:    Exit Sub Err_Sub:    If Err.Number = cdlCancel Then        ' Abbruch durch Anwender        Resume Exit_Sub    Else        MsgBox Err.Description, vbCritical    End IfEnd Sub'-------------------------------------------------- Private Sub Command2_Click()    ' Übernehmen des in Picture3 angebotenen Bildes nach Picture2On Error GoTo Err_Sub     Picture2.AutoRedraw = True    Picture2.PaintPicture Picture3.Picture, Picture3.Left, Picture3.Top    Picture2.AutoRedraw = False     Picture3.Picture = LoadPicture()    Picture3.Visible = False    Command2.Enabled = False    Command3.Enabled = True Exit_Sub:    Exit Sub Err_Sub:    MsgBox Err.Description, vbCriticalEnd Sub'-------------------------------------------------- Private Sub Command3_Click()    ' Inhalt von Picture2 speichern.    Dim sMsg As StringOn Error GoTo Err_Sub     If Picture3.Picture.Handle <> 0 Then        sMsg = "Es befindet sich noch ein Bild im Buffer." & vbCrLf & _               "Möchten Sie dieses Bild verwerfen?"        If MsgBox(sMsg, vbExclamation + vbYesNo) = vbYes Then            Picture3.Picture = LoadPicture()            Picture3.Visible = False            Command2.Enabled = False        Else            GoTo Exit_Sub        End If    End If     With CommonDialog1        .DialogTitle = "Bitmap speichern"        .Filter = "Bitmaps (*.bmp)|*.bmp|Alle Dateien (*.*)|*.*"        .FilterIndex = 1        .Flags = cdlOFNPathMustExist Or _                 cdlOFNHideReadOnly Or _                 cdlOFNOverwritePrompt        .InitDir = App.Path        .CancelError = True        .ShowSave        ' Falls die Größe des Formulares geändert wurde, enthalten die        ' Eigenschften .Image und .Picture unterschiedlich große Bilder.        ' Es soll aber das sichtbare Bild (also die Image-Eigenschaft)        ' gespeichert werden.        Set Picture2.Picture = Picture2.Image        SavePicture Picture2.Image, .FileName    End With Exit_Sub:    Exit Sub Err_Sub:    If Err.Number = cdlCancel Then        ' Abbruch durch Anwender        Resume Exit_Sub    Else        MsgBox Err.Description, vbCritical    End IfEnd Sub'-------------------------------------------------- Private Sub Command4_Click()    ' Alles löschen ("Neue Datei".)    Picture3.Picture = LoadPicture()    Picture3.Visible = False    Picture2.Picture = LoadPicture()    Command2.Enabled = FalseEnd Sub'-------------------------------------------------- Private Sub Form_Load()    Me.Caption = "Bitmaps zusammenfügen"     Command1.Caption = "Bild hinzufügen..."    Command2.Caption = "Bild übernehmen"    Command3.Caption = "Datei speichern..."    Command4.Caption = "Alles Löschen"     Command1.Width = 1620    Command1.Height = 420    Command2.Width = Command1.Width    Command2.Height = Command1.Height    Command3.Width = Command1.Width    Command3.Height = Command1.Height    Command4.Width = Command1.Width    Command4.Height = Command1.Height     Picture1.Appearance = 1 ' 3d    Picture2.Appearance = 0 ' 2D    Picture3.Appearance = 0 ' 2D     Picture1.BorderStyle = vbFixedSingle    Picture2.BorderStyle = vbFixedSingle    Picture3.BorderStyle = vbBSNone     Picture1.BackColor = vbApplicationWorkspace    Picture2.BackColor = vbWindowBackground    Picture3.BackColor = vbWindowBackground     Picture1.AutoSize = False    Picture2.AutoSize = False    Picture3.AutoSize = True     Set Picture2.Container = Picture1    Set Picture3.Container = Picture2     Picture3.Visible = False    Picture3.MousePointer = vbSizeAll     Me.ScaleMode = vbTwips    Picture1.ScaleMode = vbTwips    Picture2.ScaleMode = vbTwips    Picture3.ScaleMode = vbTwips     Me.Width = 6000    Me.Height = 4800     Me.Show     Command1.SetFocus    Command2.Enabled = False    Command3.Enabled = FalseEnd Sub'-------------------------------------------------- Private Sub Form_Resize()    Const RAND = 60On Error Resume Next     Command1.Top = RAND    Command2.Top = Command1.Top + Command1.Height + RAND    Command3.Top = Command2.Top + Command2.Height + RAND    Command4.Top = Command3.Top + Command3.Height + RAND     Picture1.Move 0, _                  RAND, _                  Me.ScaleWidth - Command1.Width - 2 * RAND, _                  Me.ScaleHeight - RAND     Picture2.Move 0, _                  0, _                  Picture1.ScaleWidth * 0.7, _                  Picture1.ScaleHeight * 0.7     Command1.Left = Picture1.Left + Picture1.Width + RAND    Command2.Left = Command1.Left    Command3.Left = Command1.Left    Command4.Left = Command1.LeftEnd Sub'-------------------------------------------------- ' Positionieren des BildesPrivate Sub Picture3_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)    If Shift = 0 Then        mfMoving = True        msngStartX = X        msngStartY = Y    End IfEnd Sub'-------------------------------------------------- Private Sub Picture3_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)    If mfMoving Then        Picture3.Move Picture3.Left + X - msngStartX, Picture3.Top + Y - msngStartY    End IfEnd Sub'-------------------------------------------------- Private Sub Picture3_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)    mfMoving = FalseEnd Sub'--------------------------------------------------

Ausprobieren!


Thomas Prötzsch

geschrieben von

Login

E-Mail:
  

Passwort:
  

Beitrag anfügen

Symbol:
 
 
 
 
 
 
 
 
 
 
 
 
 

Überschrift: