Spørsmål om picture1

[Jonas]

Hallo

 

Sitter her nå og prøver med på en tegneprogram og har et par problemer.. Når jeg tegner en strek e.l. med denne kommandoen og minimerer vinduet så viskes alt ut igjen! denne koden det er snakk om:

Picture1.DrawWidth = Slider1.Value
Picture1.PSet (Label1.Caption, Label2.Caption)

 

Og en ting til.. For å skifte lysstyrke på bilde så trenger jeg å ha to eksemplarer av bildet og da lurer jeg på hvordan jeg kan få alt som tegner e.l. fra picture1 over til picture2. noen som vet?

 

takk

[aadnk]

Sett AutoRedraw til True for å fikse problemet:

 

Picture1.AutoRedraw = True

 

For å kopiere innholdet fra en PictureBox til en annen:

 

Picture1.PaintPicture Picture2.Picture, 0, 0

[Jonas]

Autoredraw funka flott, mend en andre hadde jeg litt problemer med.. Jeg får bare error når koden utføres: Invalid picture! Hva gjør jeg galt? jeg tegner noe i picture1 og det skal overføres til 2. Jeg har prøvd å gjøre det omvendt i koden, men det funka ikke..

[aadnk]

Hmm... du må bruke Image propertyen:

 

Picture2.PaintPicture Picture1.Image, 0, 0

[Jonas]

Ser ikke ut som det virker her Har lagt u prosjektet her. Koden gir ikke error så dette skjønner jeg ikke

[aadnk]

Noen ganger er VB totalt idiotisk. Løsningen var denne:

 

Private Sub Command1_Click()

Set Picture1.Picture = Picture1.Image

Picture2.PaintPicture Picture1.Picture, 0, 0, Picture1.Width, Picture1.Height, 0, 0, Picture1.Width, Picture1.Height, vbSrcCopy
Picture1.Visible = False

End Sub

 

Hva som skjer er at Picture nå peker på den samme dataen som Image. Hvorfor du absolutt må gjøre det slik er helt uforstålig. Jeg for min del har forlengst forkastet PaintPicture til fordel for BitBlt eller StretchBlt, men jeg tenkte det var likegreit å bruke VB funskjonen denne gangen for å gjøre det "enkelt"

 

Interessant prosjekt uansett. Jeg ser du skal endre brightness med å tweake en VB ARRAY til å pointe på begynnelsen av dataen i et bilde. En ganske rask metode.

[Jonas]

Noen ganger er VB totalt idiotisk.

sitter med denne og en brightnes kode som ikke funker når jeg legger det i et nytt prosjekt.. i det jeg lasta ned funker det

[Jonas]

det er vel ikke noen som vet hvordan farge-koden til draw-greia er og hvordan man lagrer bildet?

 

edit: ja den brightnes greia fikk jeg fra deg eneste problemet er at den ikke vil virke i mitt prosjekt

 

Edit: Gjett hvem som har klart å lage det!!!!!! Men jeg har problem med lagringa av bildet.. Jeg vet ikke hvilket format det lagres i! IE klarer ikke å vise bildet.. Noen som vet?

Endret 22. februar 2004 av jonas22282460

[aadnk]

Jeg opplevde det selv også. Jeg kunne bare ta i bruk den metoden når bildet ble lastet inn fra en fil. Jeg tror imidlertid ikke det er vits å først lagre bildet på harddisken for å så åpne det. Du du må nok lage en DIB source (Device Independed Bitmap):

 

Option Explicit

Private Declare Function CreateCompatibleDC Lib "gdi32" (ByVal hdc As Long) As Long
Private Declare Function CreateDIBSection Lib "gdi32" (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 SelectObject Lib "gdi32" (ByVal hdc As Long, ByVal hObject As Long) As Long
Private Declare Function DeleteDC Lib "gdi32" (ByVal hdc As Long) As Long
Private Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long
Private Declare Function BitBlt Lib "gdi32" (ByVal hDestDC 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 dwRop As Long) As Long
Private Declare Function GetDC Lib "user32" (ByVal hwnd As Long) As Long

Private Declare Function VarPtrArray Lib "msvbvm50.dll" Alias "VarPtr" (Ptr() As Any) As Long
Private Declare Function GetObjectAPI Lib "gdi32" Alias "GetObjectA" (ByVal hObject As Long, ByVal nCount As Long, lpObject As Any) As Long
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (pDst As Any, pSrc As Any, ByVal ByteLen As Long)

Private Type SAFEARRAYBOUND
cElements As Long
lLbound As Long
End Type

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 SAFEARRAY1D
cDims As Integer
fFeatures As Integer
cbElements As Long
cLocks As Long
pvData As Long
Bounds(0) As SAFEARRAYBOUND
End Type

Private Type BITMAPINFOHEADER '40 bytes
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 DIB_RGB_COLORS = 0 '  color table in RGBs

Dim iBitmap As Long, iDC As Long

Private Sub Form_Paint()

Dim bi24BitInfo As BITMAPINFO, bBytes() As Byte, Cnt As Long
Dim sa As SAFEARRAY1D, bmp As BITMAP

With bi24BitInfo.bmiHeader
.biBitCount = 24
.biCompression = BI_RGB
.biPlanes = 1
.biSize = Len(bi24BitInfo.bmiHeader)
.biWidth = 100
.biHeight = 100
End With

iDC = CreateCompatibleDC(0)
iBitmap = CreateDIBSection(iDC, bi24BitInfo, DIB_RGB_COLORS, ByVal 0&, ByVal 0&, ByVal 0&)
SelectObject iDC, iBitmap

BitBlt iDC, 0, 0, bi24BitInfo.bmiHeader.biWidth, bi24BitInfo.bmiHeader.biHeight, GetDC(0), 0, 0, vbSrcCopy

GetObjectAPI iBitmap, Len(bmp), bmp

With sa
.cDims = 1
.Bounds(0).cElements = bmp.bmHeight * bmp.bmWidthBytes
.pvData = bmp.bmBits
End With

CopyMemory ByVal VarPtrArray(bBytes), VarPtr(sa), 4

For Cnt = LBound(bBytes) To UBound(bBytes)
bBytes(Cnt) = Not bBytes(Cnt)
Next

CopyMemory ByVal VarPtrArray(bBytes), 0&, 4

BitBlt Me.hdc, 0, 0, bmp.bmHeight, bmp.bmWidth, iDC, 0, 0, vbSrcCopy

DeleteDC iDC
DeleteObject iBitmap

End Sub