Trenger hjelp til optimalisering av kode

[Degeim]

Jeg har følgende kode:

BitBlt tempzoom.hdc, 0, 0, 20, 20, gnotat.hdc, x / 15 - 8, y / 15 - 8, vbSrcCopy ' Kopierer området (20x20 pixler) rundt musen til en picturebox med samme størrelse
For i = 1 To 80 Step 4
   For a = 1 To 80 Step 4
       zoom.Line (a, i)-(a + 3, i + 3), tempzoom.Point(a / 4, i / 4), BF ' Tar for seg hver eneste pixel (20x20=400 pixler, altså 400 operasjoner) og lager en firkant på 4x4 pixler i en picturebox som er 4 ganger større enn den med området rundt musen
   Next a
Next i
zoom.Refresh

 

Det som alstå skjer er at området rundt musen blir forstørret 4 ganger, og vist i en picturebox. Men problemet er at når denne koden blir kjørt samtidig med en som legger musens koordinater i statusbaren i programmet mitt, og man tegner i pictureboxen som så kjører denne koden ved mousemove så hakker streken som blir tegnet bortover...

 

Er det noen som kan hjelpe meg å optimalisere denne kodesnutten slik at jeg slipper denne hakkingen?

 

Jeg vil dessverre ikke legge ut kildekoden (enda), siden dette er et veldig stort prosjekt, så om dere trenger mer informasjon, bare spør.

[aadnk]

Årsaken til ytelsestapene er på grunn av de gjentatte kallene til Line-funksjonen. Det er mye bedre å benytte en egen funksjon til skalering av bilder (eller evt. skrive sin egen i C++). Eksempelvis ved hjelp av StretchBlt eller VBs egen PaintPicture (skjønt, i dette tilfellet er det nok bedre å benytte førstnevnte, ettersom du ikke arbeider med bilder i VB-applikasjonens minne). Eksempel er som følger:

 

Option Explicit

 

' Nødvendige API-kall

Private Declare Function StretchBlt Lib "gdi32" (ByVal hdc As Long, ByVal X As Long, ByVal Y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal hSrcDC As Long, ByVal xSrc As Long, ByVal ySrc As Long, ByVal nSrcWidth As Long, ByVal nSrcHeight As Long, ByVal dwRop As Long) As Long

Private Declare Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long

Private Declare Function GetDesktopWindow Lib "user32" () As Long

Private Declare Function GetDC Lib "user32" (ByVal hwnd As Long) As Long

Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)

 

Private Type POINTAPI

    X As Long

    Y As Long

End Type

 

Dim bExit As Boolean

 

Private Sub Form_Load()

 

    Dim curPos As POINTAPI

 

    ' Benytt pikselskalering

    Me.ScaleMode = vbPixels

 

    ' Vis form

    Show

   

    ' Gjenta følgende operasjoner inntil applikasjonen avsluttes

    Do Until bExit

   

        ' Hent pekerposisjonen

        GetCursorPos curPos

       

        ' Utfør tegneoperasjon

        StretchBlt destPic.hdc, 0, 0, destPic.Width, destPic.Height, GetDC(GetDesktopWindow), _

        curPos.X, curPos.Y, destPic.Width / 4, destPic.Height / 4, vbSrcCopy

       

        ' Lar andre hendelser bli eksekvert

        DoEvents

       

        ' Vent en stund for å ikke overforbruke alle tilgjengelige ressurser

        Sleep 10

 

    Loop

 

End Sub

 

Private Sub Form_Unload(Cancel As Integer)

 

    ' Avslutt løkke i overenstående prosedyre

    bExit = True

 

End Sub

[Degeim]

Det var nesten akkurat hva jeg måtte ha, og etter litt småprat med Mesteren selv fikk jeg nøyaktig det jeg vil ha. Nok en gang har Aadnk reddet dagen min! Tusen takk!

 

I stedet for...

BitBlt tempzoom.hdc, 0, 0, 20, 20, gnotat.hdc, x / 15 - 8, y / 15 - 8, vbSrcCopy ' Kopierer området (20x20 pixler) rundt musen til en picturebox med samme størrelse
For i = 1 To 80 Step 4
  For a = 1 To 80 Step 4
      zoom.Line (a, i)-(a + 3, i + 3), tempzoom.Point(a / 4, i / 4), BF ' Tar for seg hver eneste pixel (20x20=400 pixler, altså 400 operasjoner) og lager en firkant på 4x4 pixler i en picturebox som er 4 ganger større enn den med området rundt musen
  Next a
Next i
zoom.Refresh

...bruker jeg nå...

StretchBlt zoom.hdc, 0, 0, zoom.Width, zoom.Height, gnotat.hdc, X / Screen.TwipsPerPixelX - 10, Y / Screen.TwipsPerPixelY - 10, 20, 20, vbSrcCopy
zoom.Refresh

...og det fungerer utmerket!

Endret 30. desember 2005 av Degeim