[es] - Neki problemi, naslov je tesko smisliti

hatebreeder
Sinisa Bobic
Belgrade

Član broj: 48145
Poruke: 192
*.yubc.net.

Jabber: sinisabobic@gmail.com
ICQ: 339407553
Sajt: www.sinisabobic.com

Profil

Neki problemi, naslov je tesko smisliti

^{24.06.2005. u 13:24 - pre 229 meseci}

E sad kako da pocnem. Pravio sam jednu igricu i stao, poceo drugu i opet stao, za obe mi treba pomoc.

1. Igra je klasicne memorije (odstranjivanje istih kartica) e sad potreban mi je algoritam ko ji bi nizu K (Dim K(1 to 24) as integer) dodelio brojeve od 1 do 12 al tako da bilo koja dva imaju br 1, bilo koja dva broj 2 itd...

2. Igra je zasad vojna tajna (saznace se kad je zavrsim). Za igru pravim activeX kontrolu ali tu bash i nisam isqsan:
-Pozadina activeX kontrole treba da bude transparentna
-Neke objekte koje sam definisao pomocu Line-ova treba da ispunim bojama a ne znam kako to da i zvedem

Svakog ko da bilo kakav koristan doprinos stavljam u THANKS TO!!!

Odgovor na temu

Marko_L
Beograd

Član broj: 20532
Poruke: 2885
*.yubc.net.

Jabber: Marko_L@elitesecurity.org

+828 Profil

Re: Neki problemi, naslov je tesko smisliti

^{24.06.2005. u 17:04 - pre 229 meseci}

1. Ajde da probamo nešto ovako

Code:
Dim k(1 To 24) As Integer
Private Sub Command1_Click()
Dim a As Integer
For a = LBound(k) To UBound(k)
ponovi:
DoEvents
Randomize Timer
k(a) = Int(Rnd * 12) + 1
If Triplikat(k(a), a) = True Then GoTo ponovi
Next a
End Sub
Private Function Triplikat(broj As Integer, pozicija As Integer) As Boolean
Dim b As Integer
Dim c As Integer
For b = 1 To pozicija - 1
If broj = k(b) Then c = c + 1
Next b
If c > 1 Then Triplikat = True
End Function

_{[Ovu poruku je menjao Marko_L dana 24.06.2005. u 18:41 GMT+1]}

-Odracuonogakomijedrpiorazmaknicu.
-Ne rxdi mi txstxturx, kxd god hocu dx
ukucxm "x" onx ukucx "x".
-Ko kaaz e da ja neuummem da kuuca
m.
-Piše "Insert disk 3", a jedva sam i ova
dva ugurao u drajv
-Postoje samo dve osobe kojima
verujem, jedna sam ja, a druga nisi ti

Odgovor na temu

hatebreeder
Sinisa Bobic
Belgrade

Član broj: 48145
Poruke: 192
*.yubc.net.

Jabber: sinisabobic@gmail.com
ICQ: 339407553
Sajt: www.sinisabobic.com

Profil

Re: Neki problemi, naslov je tesko smisliti

^{24.06.2005. u 17:16 - pre 229 meseci}

1. Reseno Hvala ti

2. ovo sa transparentnoscu sam resio jos samo popunjavanje praznina

Odgovor na temu

Marko_L
Beograd

Član broj: 20532
Poruke: 2885
*.yubc.net.

Jabber: Marko_L@elitesecurity.org

+828 Profil

Re: Neki problemi, naslov je tesko smisliti

^{24.06.2005. u 17:41 - pre 229 meseci}

2. Nisi dao dovoljno detalja, ali da pokušamo...
Dakle kod koji čini formu transparentnom

Code:
Option Explicit
Private Declare Function CreateRectRgn Lib "gdi32" (ByVal X1 As Long, ByVal Y1 As Long, _
ByVal X2 As Long, ByVal Y2 As Long) As Long
Private Declare Function CombineRgn Lib "gdi32" (ByVal hDestRgn As Long, _
ByVal hSrcRgn1 As Long, ByVal hSrcRgn2 As Long, ByVal nCombineMode As Long) As Long
Private Declare Function SetWindowRgn Lib "user32" (ByVal hwnd As Long, ByVal hRgn As Long, _
ByVal bRedraw As Boolean) As Long
Private Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long
Dim mFormRegion As Long
Private Const RGN_OR = 2
Private Const RGN_DIFF = 4

Private Sub Command1_Click()
Me.ScaleMode = vbPixels
    Dim w As Single, h As Single
    Dim edge As Single, topEdge As Single
    Dim mLeft, mTop
    Dim i As Integer
    Dim r As Long
    Dim outer As Long, inner As Long

    w = ScaleX(Width, vbTwips, vbPixels)
    h = ScaleY(Height, vbTwips, vbPixels)
        mFormRegion = CreateRectRgn(0, 0, 0, 0)

    edge = (w - ScaleWidth) / 2
    topEdge = h - edge - ScaleHeight

       outer = CreateRectRgn(0, 0, w, h)
       inner = CreateRectRgn(edge, topEdge, w - edge, h - edge)
       CombineRgn mFormRegion, outer, inner, RGN_DIFF

    For i = 0 To Me.Controls.Count - 1
        If Me.Controls(i).Visible = True Then
            mLeft = ScaleX(Me.Controls(i).Left, Me.ScaleMode, vbPixels) + edge
            mTop = ScaleX(Me.Controls(i).Top, Me.ScaleMode, vbPixels) + topEdge
            r = CreateRectRgn(mLeft, mTop, _
                mLeft + ScaleX(Me.Controls(i).Width, Me.ScaleMode, vbPixels), _
                mTop + ScaleY(Me.Controls(i).Height, Me.ScaleMode, vbPixels))
            CombineRgn mFormRegion, r, mFormRegion, RGN_OR
        End If
    Next

    SetWindowRgn hwnd, mFormRegion, True
End Sub
Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
SetWindowRgn hwnd, 0, False
    DeleteObject mFormRegion
End Sub

Pa ti to kombinuj i iskoristi u svojoj kontroli.A što se tiče ovog drugog, ne znam kako tačno izgleda to što praviš, ali zar ne bi umesto Line kontrola mogao da iskoristiš Shape kontrolu kojima možeš da podešavaš svojstva kao što su transparentnost, boja...

Odgovor na temu

hatebreeder
Sinisa Bobic
Belgrade

Član broj: 48145
Poruke: 192
*.yubc.net.

Jabber: sinisabobic@gmail.com
ICQ: 339407553
Sajt: www.sinisabobic.com

Profil

Re: Neki problemi, naslov je tesko smisliti

^{25.06.2005. u 12:23 - pre 229 meseci}

http://i.domaindlx.com/hatebreeder/hex.ctl

ovde sam ti uploadovao kontrolu sve je resheno samo trebaju tih 6 podeljaka shestougla da mogu da se farbaju u boje (inace bice svake razlicite)

Odgovor na temu

Marko_L
Beograd

Član broj: 20532
Poruke: 2885
*.yubc.net.

Jabber: Marko_L@elitesecurity.org

+828 Profil

Re: Neki problemi, naslov je tesko smisliti

^{25.06.2005. u 21:01 - pre 229 meseci}

Ne valja to što si okačio.Prazan fajl.

Odgovor na temu

hatebreeder
Sinisa Bobic
Belgrade

Član broj: 48145
Poruke: 192
*.yubc.net.

Jabber: sinisabobic@gmail.com
ICQ: 339407553
Sajt: www.sinisabobic.com

Profil

Re: Neki problemi, naslov je tesko smisliti

^{25.06.2005. u 22:01 - pre 229 meseci}

evo valjda sad radi

http://uploadhtb.250m.com/hex.ctl

Odgovor na temu

Marko_L
Beograd

Član broj: 20532
Poruke: 2885
*.yubc.net.

Jabber: Marko_L@elitesecurity.org

+828 Profil

Re: Neki problemi, naslov je tesko smisliti

^{25.06.2005. u 23:27 - pre 229 meseci}

Nop, neće.A što jednostavno ne okačiš taj fajl ovde na forumu ? Ne verujem da je "teži" od 200KB ?

Odgovor na temu

hatebreeder
Sinisa Bobic
Belgrade

Član broj: 48145
Poruke: 192
*.yubc.net.

Jabber: sinisabobic@gmail.com
ICQ: 339407553
Sajt: www.sinisabobic.com

Profil

Re: Neki problemi, naslov je tesko smisliti

^{27.06.2005. u 17:10 - pre 229 meseci}

Ovu poruku posle obrisi al reci mi gde da okacim na ES

ja dugme trazim vec nekih 3h :)

Odgovor na temu

Marko_L
Beograd

Član broj: 20532
Poruke: 2885
*.yubc.net.

Jabber: Marko_L@elitesecurity.org

+828 Profil

Re: Neki problemi, naslov je tesko smisliti

^{27.06.2005. u 17:27 - pre 229 meseci}

Imaš ispod svakog tvog posta sledeće opcije | Upload uz poruku |Izmena/Brisanje | Odgovor na temu ]
Tebi treba ova prva "Upload uz poruku".

Odgovor na temu

hatebreeder
Sinisa Bobic
Belgrade

Član broj: 48145
Poruke: 192
*.yubc.net.

Jabber: sinisabobic@gmail.com
ICQ: 339407553
Sajt: www.sinisabobic.com

Profil

Re: Neki problemi, naslov je tesko smisliti

^{27.06.2005. u 17:54 - pre 229 meseci}

Nadam se da ce sad da radi

Prikačeni fajlovi

hex.ctl - 2.49k

Odgovor na temu

hatebreeder
Sinisa Bobic
Belgrade

Član broj: 48145
Poruke: 192
*.yubc.net.

Jabber: sinisabobic@gmail.com
ICQ: 339407553
Sajt: www.sinisabobic.com

Profil

Re: Neki problemi, naslov je tesko smisliti

^{28.06.2005. u 20:54 - pre 228 meseci}

evo ideje samo ne znam kako da je ostvarim, imamo 3 duzi takve
da je
line1.x2=line2.x1
line1.x1=line3.x2
line2.x2=line3.x1

i

line1.y2=line2.y1
line1.y1=line3.y2
line2.y2=line3.y1

treba na neki nacin ofarbati unutrasnjost (ja sam probao preko API ja al mi nije islo)

Odgovor na temu

Marko_L
Beograd

Član broj: 20532
Poruke: 2885
*.yubc.net.

Jabber: Marko_L@elitesecurity.org

+828 Profil

Re: Neki problemi, naslov je tesko smisliti

^{29.06.2005. u 22:39 - pre 228 meseci}

Ajde ovako, ako ti odgovara da zaboravimo na Line kontrole (ako ti odgovara tako) i nacrtamo svoj objekat na formi (tako ćemo lakše da ga definišemo) od linija, tačku po tačku.A onda ćemo da odredimo posebno svaki trougao, recimo klikom miša u određeni trougao on se oboji u određenu boju.Ja sam radi lakšeg definisanja površine za bojenje, napravio da svi trouglovi budu istog oblika, mada uz malo matematike može da se napravi i drugačije, no to ostavljam tebi, ja ću ti samo dati ideju.Dakle, evo koda uz komentar

Code:
Option Explicit
Private Type NAS_POINT
    X As Long
    Y As Long
End Type

Private Declare Function FloodFill Lib "gdi32" (ByVal hdc As Long, _
ByVal X As Long, ByVal Y As Long, ByVal crColor As Long) As Long
Private Declare Function CreateSolidBrush Lib "gdi32" (ByVal crColor As Long) As Long
Private Declare Function SelectObject Lib "gdi32" (ByVal hdc As Long, _
ByVal hObject As Long) As Long
Private Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long

Private Sub Form_Load()
Dim Point(0 To 10) As NAS_POINT
Dim i As Integer

    ' definisemo tacke za crtanje objekta
    Point(0).X = 100: Point(0).Y = 80
    Point(1).X = 40: Point(1).Y = 80
    Point(2).X = 100: Point(2).Y = 20
    Point(3).X = 40: Point(3).Y = 20
    Point(4).X = 10: Point(4).Y = 50
    Point(5).X = 130: Point(5).Y = 50
    Point(6).X = 100: Point(6).Y = 20
    Point(7).X = 40: Point(7).Y = 80
    Point(8).X = 10: Point(8).Y = 50
    Point(9).X = 130: Point(9).Y = 50
    Point(10).X = 100: Point(10).Y = 80

    ' definisemo pocetne koordinate (pocetna tacka)
    CurrentX = 40
    CurrentY = 20

    ' crtamo objekat liniju po liniju
    ' na osnovu definisanih tacki
    For i = LBound(Point) To UBound(Point)
        Line -(Point(i).X, Point(i).Y)
    Next i
End Sub

Private Sub Form_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
Dim color As Long
Dim brush As Long
Dim trougao As Integer

'odredjujemo gde je kliknuto misem na osnovu x i y koordinate
If X > 39 + (Y - 20) And X < 101 - (Y - 20) And Y > 20 And Y < 50 Then trougao = 1 'gornji trougao
If X > 69 - (Y - 50) And X < 71 + (Y - 50) And Y > 50 And Y < 80 Then trougao = 2 ' donji trougao
If X > 39 - (Y - 20) And X < 41 + (Y - 20) And Y > 20 And Y < 50 Then trougao = 3 ' gornji levi
If X > 99 - (Y - 20) And X < 101 + (Y - 20) And Y > 20 And Y < 50 Then trougao = 4 ' gornji desni
If X > 9 + (Y - 50) And X < 71 - (Y - 50) And Y > 50 And Y < 80 Then trougao = 5 ' donji levi
If X > 69 + (Y - 50) And X < 131 - (Y - 50) And Y > 50 And Y < 80 Then trougao = 6 ' donji desni

Select Case trougao
Case 1 ' ako je kliknuto na trougao 1
color = RGB(255, 0, 0) ' oboji u crveno
Case 2 ' ako je kliknuto na trougao 2
color = RGB(0, 255, 0) ' oboji u zeleno
Case 3 ' ako je kliknuto na trougao 3
color = RGB(0, 0, 255) ' oboji u plavo
Case 4 ' ako je kliknuto na trougao 4
color = RGB(255, 255, 0) ' oboji u zuto
Case 5 ' ako je kliknuto na trougao 5
color = RGB(255, 0, 255) ' oboji u ljubicasto
Case 6 ' ako je kliknuto na trougao 6
color = RGB(0, 255, 255) ' oboji u zeleno-plavo
Case Else ' ako je kliknuto van objekta
Exit Sub
End Select
    brush = CreateSolidBrush(color) ' pravimo brush na osnovu odabrane boje
    SelectObject hdc, brush ' selektujemo objekat
    FloodFill hdc, X, Y, vbBlack ' popunjavamo objekat bojom tacku po tacku
                    ' unutar crnog okvira (linije kojima smo crtali objekat)
    DeleteObject brush ' brisemo kreitani brush
    Refresh ' refresujemo prikaz kako bi se prikazao obojen trougao
End Sub

Dakle, iskopiraj ovaj kod u formu i startuj program, pa isprobaj šta se dešava kada klikneš na neki trougao u objektu, pa reci da li je to ono što tebi treba.

_{[Ovu poruku je menjao Marko_L dana 29.06.2005. u 23:42 GMT+1]}

Odgovor na temu