Strona: [  << <   1   > >>  ]  z  1     
Autor Temat: Mapa monochromatyczna
mikmas
From Łódź Stadt




Typ: neutral
Postów: 772
Zarejestrowany: Apr 2003
Mapa monochromatyczna

Jak zapisać obraz z picturebox'a w 2 kolorach??

[Post edytowany dnia 21-05-2004 20:23 przez mikmas]


_____________________________________________
4C;65;70;69;65;6A;20;62;79;9C;20;73;69;EA;20;
62;61;72;64;7A;69;65;6A;20;73;6B;6F;6E;63;65;
6E;74;72;6F;77;61;B3;20;6E;61;20;6F;64;70;6F;
77;69;65;64;7A;69;2C;20;61;20;6E;69;65;20;6E;
61;20;72;6F;7A;73;7A;79;66;72;6F;77;79;77;61;
6E;69;75;20;3A;50

21-05-2004 20:23
Pokaż profil mikmas  Wyślij email do mikmas   Odwiedź stronę mikmas       3632553
m-a-x



Typ: neutral
Postów: 366
Zarejestrowany: Jan 2003

Jeżeli nie przeszkadza Ci fakt że bedziesz musiał użyć dodatkowego dll'a to mam pewnego sampla (wraz z tym dll'em). Jak chcesz moge Ci wysłać.


_____________________________________________

Problemem zazwyczaj nie jest brak osób znających odpowiedź a zadanie właściwego pytania!

21-05-2004 22:35
Pokaż profil m-a-x  Wyślij email do m-a-x   
bisiek




Typ: neutral
Postów: 487
Zarejestrowany: Jul 2003

Spróbuj to zrobić tak: ustaw w pictureboxie AutoRedraw na True, potem zmień kolory na czarne i białe i zapisz poleceniem SavePicture.


_____________________________________________
www.mob.abc.pl - moja strona o VB

22-05-2004 10:11
Pokaż profil bisiek  Wyślij email do bisiek   Odwiedź stronę bisiek       3380672
bisiek




Typ: neutral
Postów: 487
Zarejestrowany: Jul 2003

Przykładowy kod zamiany na czarno/biały i zapisanie do pliku:

For i = 0 To Picture1.Width 'Step 15 'dla twipów
For j = 0 To Picture1.Height 'Step 15 'dla twipów
c = Picture1.Point(i, j)
r = c And 255
g = Int(c / 256) And 255
b = Int(c / 65536) And 255
If r + g + b > 138 * 3 Then c = RGB(255, 255, 255) Else c = 0
Picture1.PSet (i, j), c
Next j
Next i
SavePicture Picture1.Image, "C:\abcdef.bmp"


_____________________________________________
www.mob.abc.pl - moja strona o VB

22-05-2004 10:16
Pokaż profil bisiek  Wyślij email do bisiek   Odwiedź stronę bisiek       3380672
hicks
raptor user



Typ: moderator
Postów: 279
Zarejestrowany: Apr 2003

Kurcze bisiek mnie wyprzedził, ale i tak podam swoją wersję

Private Declare Function GetPixel Lib "gdi32" (ByVal hdc As Long, ByVal X As Long, ByVal Y As Long) As Long
Private Declare Function SetPixel Lib "gdi32" (ByVal hdc As Long, ByVal X As Long, ByVal Y As Long, ByVal crColor As Long) As Long

Private Type COLOR_TYPE
    lngRed As Long
    lngGreen As Long
    lngBlue As Long
End Type

Private Sub ConvertToBW(picSrc As PictureBox, picDest As PictureBox, lngLightValue As Long)
    Dim lngKolor As Long, TColor As COLOR_TYPE
    lngLightValue = lngLightValue * 3
    For petlaX = 0 To picSrc.Width / 15
        For petlaY = 0 To picSrc.Height / 15
            ' pobieramy kolor
            lngKolor = GetPixel(picSrc.hdc, petlaX, petlaY)

            TColor = GetRGBColor(lngKolor)
            If TColor.lngRed + TColor.lngGreen + TColor.lngBlue >= lngLightValue Then
                SetPixel picDest.hdc, petlaX, petlaY, RGB(255, 255, 255)
            ElseIf TColor.lngRed + TColor.lngGreen + TColor.lngBlue < lngLightValue Then
                SetPixel picDest.hdc, petlaX, petlaY, RGB(0, 0, 0)
            End If
            DoEvents
        Next petlaY
    Next petlaX
End Sub

Private Function GetRGBColor(Color) As COLOR_TYPE
    B = (Color / &H10000) And &HFF
    G = (Color / &H100) And &HFF
    R = Color And &HFF
    GetRGBColor.lngRed = R
    GetRGBColor.lngGreen = G
    GetRGBColor.lngBlue = B
End Function

Już objaśniam:

ConvertToBW(picSrc As PictureBox, picDest As PictureBox, lngLightValue As Long)

picSrc to picturebox źródłowy...
picDest to picbox docelowy,
lngLightValue to współczynnik światła przyjmuje wartośc od 0 do 255, zależnie od niego obrazek będzie bardziej czarny lub biały...

[Post edytowany dnia 22-05-2004 10:44 przez hicks]


_____________________________________________
TLHW Clan member

22-05-2004 10:40
Pokaż profil hicks  Wyślij email do hicks   Odwiedź stronę hicks       2511367
mikmas
From Łódź Stadt




Typ: neutral
Postów: 772
Zarejestrowany: Apr 2003

Dzięki wszystkim!! . Bardzo mi pomogliście


_____________________________________________
4C;65;70;69;65;6A;20;62;79;9C;20;73;69;EA;20;
62;61;72;64;7A;69;65;6A;20;73;6B;6F;6E;63;65;
6E;74;72;6F;77;61;B3;20;6E;61;20;6F;64;70;6F;
77;69;65;64;7A;69;2C;20;61;20;6E;69;65;20;6E;
61;20;72;6F;7A;73;7A;79;66;72;6F;77;79;77;61;
6E;69;75;20;3A;50

23-05-2004 18:23
Pokaż profil mikmas  Wyślij email do mikmas   Odwiedź stronę mikmas       3632553
Wszystkich odpowiedzi: 5 :: Maxymalnie na stronę: 20
Strona: [  << <   1   > >>  ]  z  1