Die Community zu .NET und Classic VB.
Menü

VB 5/6-Tipp 0618: Ein Bild mithilfe von ASM drehen

 von 

Beschreibung 

VB ist nicht die schnellste Programmiersprache, auch, wenn man mit ihr viele Grafikoperationen durchführen kann. Wer es gerne schneller mag, sollte entweder eine DLL zur Hand nehmen - oder besser: mit ASM arbeiten. Dieser Source dreht eine Grafik mithilfe der zuletztgenannten Methode. Der Assembler-Code liegt bei.

Schwierigkeitsgrad:

Schwierigkeitsgrad 2

Verwendete API-Aufrufe:

CallWindowProcA (CallWindowProc), CreateDIBSection, DeleteObject, GetObjectA (GetObject), SetDIBits

Download:

Download des Beispielprojektes [156,74 KB]

'Dieser Quellcode stammt von http://www.activevb.de
'und kann frei verwendet werden. Für eventuelle Schäden
'wird nicht gehaftet.

'Um Fehler oder Fragen zu klären, nutzen Sie bitte unser Forum.
'Ansonsten viel Spaß und Erfolg mit diesem Source!

'------------- Anfang Projektdatei Projekt1.vbp -------------
'--------- Anfang Formular "Form1" alias Form1.frm  ---------
' Steuerelement: Kombinationsliste "Combo1"
' Steuerelement: Schaltfläche "Command1"
' Steuerelement: Bildfeld-Steuerelement "DestP"
' Steuerelement: Bildfeld-Steuerelement "SourceP"

'***********************************************************
'* Rotating 24Bit Bitmaps in 90° steps *very* fast via asm *
'* by Daniel Aue for activevb.de 5.8.2003                  *
'*                                                         *
'* USE ENTIRELY AT YOUR OWN RISK.                          *
'* you may publish this source as long as                  *
'* this commentblock stays in                              *
'***********************************************************
'rest of the comments are in german... it's just easier to express, sorry.

Option Explicit

Private Declare Function CreateDIBSection Lib "gdi32.dll" ( _
        ByVal hdc As Long, _
        pBitmapInfo As BITMAPINFO, _
        ByVal un As Long, _
        ByVal lplpVoid As Long, _
        ByVal handle As Long, _
        ByVal dw As Long) As Long

Private Declare Function CallWindowProc Lib "user32.dll" Alias "CallWindowProcA" _
        (ByVal lpPrevWndFunc As Long, ByVal hwnd As Long, ByVal msg As Long, _
        ByVal wParam As Long, ByVal lParam As Long) As Long

Private Declare Function DeleteObject Lib "gdi32" (ByVal hObject _
         As Long) As Long

Private Declare Function GetObject Lib "gdi32.dll" Alias "GetObjectA" ( _
        ByVal hObject As Long, _
        ByVal nCount As Long, _
        lpObject As Any) As Long
        
Private Declare Function SetDIBits Lib "gdi32" ( _
         ByVal hdc As Long, ByVal hBitmap As Long, _
         ByVal nStartScan As Long, ByVal nNumScans As Long, _
         lpBits As Any, lpBI As BITMAPINFO, ByVal wUsage As Long) _
         As Long
         
Private Type BITMAP
        bmType As Long
        bmWidth As Long
        bmHeight As Long
        bmWidthBytes As Long
        bmPlanes As Integer
        bmBitsPixel As Integer
        bmBits As Long
End Type

Private Type BITMAPINFOHEADER
    biSize As Long
    biWidth As Long
    biHeight As Long
    biPlanes As Integer
    biBitCount As Integer
    biCompression As Long
    biSizeImage As Long
    biXPelsPerMeter As Long
    biYPelsPerMeter As Long
    biClrUsed As Long
    biClrImportant As Long
End Type

Private Type RGBQUAD
    rgbBlue As Byte
    rgbGreen As Byte
    rgbRed As Byte
    rgbReserved As Byte
End Type

Private Type BITMAPINFO
    bmiHeader As BITMAPINFOHEADER
    bmiColors As RGBQUAD
End Type

Private Const BI_RGB = 0&
Private Const BI_RLE4 = 2&
Private Const BI_RLE8 = 1&
Private Const DIB_RGB_COLORS = 0

Private Const ASM_ROTATE90 = 0
Private Const ASM_ROTATE180 = 1
Private Const ASM_ROTATE270 = 2
Private Const ASM_ROTATESPECIAL = 3

Sub DoASMRotate(Angle)
    Dim SourceBMP As BITMAP
    Dim DestBMP As BITMAP
    
    'infos über das QuellBmp holen
    Call GetObject(SourceP.Picture, Len(SourceBMP), SourceBMP)
    
    If SourceBMP.bmBitsPixel <> 24 Then
        MsgBox "Geht nur mit 24bit Grafiken!"
        Exit Sub
    End If
    
    If (SourceBMP.bmWidthBytes And 3) <> 0 Then
        'is ja nicht zu fassen: GetObject liefert unter Windows 2000 bei Bitmaps
        'mit Padbytes tatsächlich eine falsche (nicht durch 4 teilbare) Breite !
        SourceBMP.bmWidthBytes = SourceBMP.bmWidthBytes + 2
    End If
    
    'DIB erstellen das Platz für die gedrehten Daten bietet:
    Dim DestBmpInfo As BITMAPINFO
    Dim PtrData As Long
    Dim hDib As Long
    
    With DestBmpInfo.bmiHeader
        .biSize = Len(DestBmpInfo.bmiHeader)
        
        If Angle = 90 Or Angle = 270 Then
        
            'Breite = Höhe des Quell BMP
            .biWidth = SourceBMP.bmHeight
            
            'Höhe = Breite des Quell BMP
            .biHeight = SourceBMP.bmWidth
            
        ElseIf Angle = 180 Then
        
            'Breite = Breite des Quell BMP
            .biWidth = SourceBMP.bmWidth
            
            'Höhe = Höhe des Quell BMP
            .biHeight = SourceBMP.bmHeight
            
        Else
            
            'Breite = Breite des Quell BMP
            .biWidth = SourceBMP.bmWidth
            
            'Höhe = Höhe des Quell BMP * 2
            .biHeight = SourceBMP.bmHeight * 2
            
        End If
            
        .biPlanes = 1
        .biBitCount = 24
        .biCompression = BI_RGB
        .biSizeImage = ((.biWidth * 3 + 3) And &HFFFFFFFC) * .biHeight
    End With

    hDib = CreateDIBSection(0, DestBmpInfo, DIB_RGB_COLORS, VarPtr(PtrData), 0, 0)

    'infos über das gerade erstellte Bmp holen
    Call GetObject(hDib, Len(DestBMP), DestBMP)
    
    If (DestBMP.bmWidthBytes And 3) <> 0 Then
        'is ja nicht zu fassen: GetObject liefert unter Windows 2000 bei Bitmaps
        'mit Padbytes tatsächlich eine falsche (nicht durch 4 teilbare) Breite !
        DestBMP.bmWidthBytes = DestBMP.bmWidthBytes + 2
    End If
    
    'Parameterstruct für den asm aufruf initialisieren:
    Dim AsmPara(8) As Long
    
    'Zeiger auf Source Daten
    AsmPara(0) = SourceBMP.bmBits
    
    'Zeiger auf Ziel Daten
    AsmPara(1) = PtrData
    
    'Breite des Source Bitmaps
    AsmPara(2) = SourceBMP.bmWidth
    
    'Höhe des Source Bitmaps
    AsmPara(3) = SourceBMP.bmHeight
    
    'Bytes pro Zeile des Source Bitmaps
    AsmPara(4) = SourceBMP.bmWidthBytes
    
    'Bytes pro Zeile des Dest Bitmaps
    AsmPara(5) = DestBMP.bmWidthBytes
    
    'Grad um die gedreht werden soll
    Select Case Angle
        Case 90
            AsmPara(6) = ASM_ROTATE90
            
            'hier könnte der dest offset per pixel angegeben werden
            AsmPara(7) = 0
            
            'hier könnte der dest offset per line angegeben werden
            AsmPara(8) = 0
        Case 180
            AsmPara(6) = ASM_ROTATE180
            
            'hier könnte der dest offset per pixel angegeben werden
            AsmPara(7) = 0
            
            'hier könnte der dest offset per line angegeben werden
            AsmPara(8) = 0
        Case 270
            AsmPara(6) = ASM_ROTATE270
            
            'hier könnte der dest offset per pixel angegeben werden
            AsmPara(7) = 0
            
            'hier könnte der dest offset per line angegeben werden
            AsmPara(8) = 0
        Case Else
            AsmPara(6) = ASM_ROTATESPECIAL
            'wird im Parameter 6 ASM_ROTATESPECIAL angegeben können mit
            'den beiden folgenden Parametern die Offsets angegeben werden
            'die einerseits nach jedem _Pixel_ zu der Zieladresse addiert
            'werden sollen (Nach dem Kopieren eines Pixels steht die
            'Ziel-Adresse automatisch am nächsten Pixel links davon),
            'anderseits der Offset der nach jeder _Zeile_ zu der Zieladresse
            'dazuaddiert werden sollen (Nach einer Zeile steht die Ziel-
            'adresse wieder am Anfang dieser Zeile).
            'Achtung: auch die Zieladresse selber muss dann natürlich auch
            'anders initialisiert werden (nicht auf das erste Byte im
            'Zielarray)

            'einen Pixel weiter links (minus 6 Bytes)
            AsmPara(7) = -6
            
            'zwei Zeilen springen
            AsmPara(8) = -DestBMP.bmWidthBytes * 2
            
            'Startadresse korrigieren
            AsmPara(1) = PtrData + DestBMP.bmWidthBytes * DestBMP.bmHeight - _
                        (DestBMP.bmWidthBytes - DestBMP.bmWidth * 3) - 3
    End Select
    
    
    'ASM code initialisieren:
    Dim asm(51) As Long
    
    'check asm.txt for the source
    asm(0) = &H90EC8B55:  asm(1) = &H8B535657
    asm(2) = &H428B0855:  asm(3) = &HF88318
    asm(4) = &HF8831C74:  asm(5) = &H83367401
    asm(6) = &H5C7402F8:  asm(7) = &H7403F883
    asm(8) = &H5F5E5B72:  asm(9) = &HFFFFB85D
    asm(10) = &HC290FFFF: asm(11) = &H7A8B0010
    asm(12) = &H8428B04:  asm(13) = &H42AF0F48
    asm(14) = &HBBF80314: asm(15) = &H3&
    asm(16) = &HB8&:      asm(17) = &H14422B00
    asm(18) = &HEB03E883: asm(19) = &H47A8B4F
    asm(20) = &HF0C428B:  asm(21) = &H31442AF
    asm(22) = &H85A8BF8:  asm(23) = &H8B5B0C8D
    asm(24) = &HD92B145A: asm(25) = &HEF83FB2B
    asm(26) = &HBB03&:    asm(27) = &H5A2B0000
    asm(28) = &HFFFAB814: asm(29) = &H24EBFFFF
    asm(30) = &H8B047A8B: asm(31) = &H48D0C5A
    asm(32) = &H83F8035B: asm(33) = &HFDBB03EF
    asm(34) = &H8BFFFFFF: asm(35) = &HE8831442
    asm(36) = &H8B09EB03: asm(37) = &H5A8B047A
    asm(38) = &H1C428B20: asm(39) = &H51104A8B
    asm(40) = &H51084A8B: asm(41) = &H528B328B
    asm(42) = &H240C8B0C: asm(43) = &HA4A45756
    asm(44) = &HE2F803A4: asm(45) = &H35E5FF9
    asm(46) = &H247403FB: asm(47) = &HE9754A04
    asm(48) = &H5E5B5858: asm(49) = &HB85D5F
    asm(50) = &H90000000: asm(51) = &H10C2&

    'drehen:
    'Achtung: Die Funktion prüft nicht auf Speichergrenzen etc.
    'wurde ein Parameter falsch initialisiert, oder beim reservieren
    'des Zielspeichers ein Fehler gemacht, so kommts jetzt unweigerlich
    'zu einem Absturz !
    Dim Result As Long
    Result = CallWindowProc(VarPtr(asm(0)), VarPtr(AsmPara(0)), 0, 0, 0)
    
    If Result <> 0 Then
        MsgBox "Fehler in den ASM Parametern!"
    End If
    
    Dim bw As Integer
    DestP.AutoRedraw = True ' wichtig
    DestP.ScaleMode = 3
    Me.ScaleMode = 3
    bw = DestP.Width - DestP.ScaleWidth
    DestP.Width = DestBmpInfo.bmiHeader.biWidth + bw
    DestP.Height = DestBmpInfo.bmiHeader.biHeight + bw
                
    DestP.Cls
    'in der picturebox anzeigen:
    Result = SetDIBits(DestP.hdc, DestP.Image.handle, 0, _
        DestBmpInfo.bmiHeader.biHeight, ByVal PtrData, DestBmpInfo, DIB_RGB_COLORS)
    DestP.Refresh
    
    DeleteObject (hDib)
End Sub

Private Sub Command1_Click()
    DoASMRotate Combo1.Text
End Sub
'---------- Ende Formular "Form1" alias Form1.frm  ----------
'-------------- Ende Projektdatei Projekt1.vbp --------------

Tipp-Kompatibilität:

Windows/VB-VersionWin32sWin95Win98WinMEWinNT4Win2000WinXP
VB4
VB5
VB6

Hat dieser Tipp auf Ihrem Betriebsystem und mit Ihrer VB-Version funktioniert?

Ja, funktioniert!

Nein, funktioniert nicht bei mir!

VB-Version:

Windows-Version:

Ihre Meinung  

Falls Sie Fragen zu diesem Artikel haben oder Ihre Erfahrung mit anderen Nutzern austauschen möchten, dann teilen Sie uns diese bitte in einem der unten vorhandenen Themen oder über einen neuen Beitrag mit. Hierzu können sie einfach einen Beitrag in einem zum Thema passenden Forum anlegen, welcher automatisch mit dieser Seite verknüpft wird.

Archivierte Nutzerkommentare 

Klicken Sie diesen Text an, wenn Sie die 7 archivierten Kommentare ansehen möchten.
Diese stammen noch von der Zeit, als es noch keine direkte Forenunterstützung für Fragen und Kommentare zu einzelnen Artikeln gab.
Aus Gründen der Vollständigkeit können Sie sich die ausgeblendeten Kommentare zu diesem Artikel aber gerne weiterhin ansehen.

Kommentar von Christophberninger am 05.01.2006 um 19:06

Wenn man dem winkel des Bildes nicht genau um 90 C drehen will stürtzt das Programm ab, Kann in Powerpoint ein bild drehen mit einfacheren Mitteln und dazu noch stufenlos grad genau geht das mit ASM auch, finde die geschwindigkeit nicht langsam beim drehen. Habe mit VBa von Powerpoint ohne ASM Programmiert

Kommentar von Florian Rittmeier am 13.01.2005 um 23:46

Hallo Matthias,

deine Frage solltest Du im Forum nochmal stellen. Allerdings vielleicht mit einger genaueren Beschreibung von "Beispiel", denn es gibt viele Themenbereiche...

Gruß Florian

Kommentar von Timo am 13.01.2005 um 15:17

Kommt drauf an mit was Du programmierst. Onlinespiele gibts zB auf: http://www.rpfingst.de/index.html

Wenn Du mit VB Unterstützung von mir Rechnen willst, geh auf: www.goldengel.ch

Timo

PS: Die Fehlermeldung war nach Umschalten des Bildschirms weiterhin. Nach Neustart nicht mehr. Danke

Kommentar von matthias mögele am 13.01.2005 um 14:51

wir haben in einigen wochen eine informatikschularbeit und ich wollte fragen, wo man im internet beispiele für "Anfänger" finden kann.

schöne grüße

Kommentar von Florian Rittmeier am 06.01.2005 um 12:10

Hallo Timo,

zur Frage vom 07.12.04 um 13:28 Uhr
Wenn Du Dir die Datei ASM.TXT im ZIP-Archiv zum Tipp anschaust, findest Du ein paar Kommentare.

zur Frage vom 07.12.04 um 13:31 Uhr
Das liegt daran, dass Du deinen Bildschirm mit einer Farbtiefe von 16-Bit betreibst. VB wandelt Grafiken immer automatisch in die Bildschirmfarbtiefe um.
Alternative zum Ändern deiner Farbtiefe kannst Du auch mal bei den anderen ASM-Tipps stöbern. Udo Schmidt hat meines Wissens auch mal eine Konvertierung zwischen verschiedenen Farbtiefen implementiert.

Gruß Florian

Kommentar von Timo am 07.12.2004 um 13:31

Bei mir kommt immer die Fehlermeldung "Funktioniert nur mit 24Bit Bildern". Es ist aber das Original VBP Projekt. SourceBMP.bmBitsPixel ist immer 16 statt 24. Timo

Kommentar von Timo am 07.12.2004 um 13:28

Gibs es ne kurze Zusammenfassung wie der ASM Code zugreifft auf das Bild? Werden die einzelnen Winkel aus einer Tabelle gelesen? Ich sehe nirgens eine Winkelfunktion. Kann durch einfache Deklaration in der Initialisierung auch ein 8Bit Bild genommen werden? Timo