mboost-dp1

Overskrivning i Visualbasic


Gå til bund
Gravatar #1 - kristofferj
22. mar. 2004 19:57
Jeg har lavet et mindre program i Visual basic, men jeg er stødt ind i et problem. Jeg vil gerne have mulighed for at slette et bestemt antal tegn i en tekstfil, efter jeg har fundet placeringen af det første tegn med "seek" kommandoen.
Helt præcist drejer det sig altså om at slette 9 tegn fra en given placering i en tekstfil.
Nogen der kan give mig et hint, jeg har gennemsøgt hjælp funktionen og google uden held.
På forhånd tak.

Ps. Titlen skulle have været sletning i stedet for overskrivning, men det kan åbentbart ikke rettes her på siden...
Gravatar #2 - kristofferj
22. mar. 2004 20:00
her er koden for "hele" programmet som er en afstemning:

Option Explicit
Dim stemme As Integer
Dim stemt As Integer
Dim nymulig1 As Double
Dim nymulig2 As Double
Dim nymulig3 As Double
Dim nymulig4 As Double
Dim mulig1 As Variant
Dim mulig2 As Variant
Dim mulig3 As Variant
Dim mulig4 As Variant
Dim ialt As Double
Dim Prores1 As Currency
Dim Prores2 As Currency
Dim Prores3 As Currency
Dim Prores4 As Currency
Dim user As String
Dim pass As String
Dim question As String
Dim Answer1 As String
Dim Answer2 As String
Dim Answer3 As String
Dim Answer4 As String
Dim bgcolor As String
Dim newbgcolor As String
Dim elementcolor As String
Dim newelementcolor As String
Dim roed As Integer
Dim groen As Integer
Dim blaa As Integer
Dim blandfarve As Variant
Dim hexblandfarve As Variant
Dim tekstcolor As String
Dim newtekstcolor As String
Dim nulstil As Integer
Dim fil As Integer
Dim status As Boolean
Dim idcount As Integer
Dim id As String
Dim deletestatus As Boolean
Dim error As String


Private Sub cmdadmin_Click()
user = "user"
pass = "pass"
If txtuser.Text = user And txtpass.Text = pass Then
txtquest.Text = question
txtsvar1.Text = Answer1
txtsvar2.Text = Answer2
txtsvar3.Text = Answer3
txtsvar4.Text = Answer4
txtbgcolor.Text = bgcolor
txtelement.Text = elementcolor
txttekstfarve.Text = tekstcolor
synligt (True)
frmafstem.Width = 9390
cmdadmin.Enabled = False
Else
MsgBox ("Ugyldigt login")
End If
End Sub

Private Sub cmdadmingem_Click()
Open "setup.txt" For Output As #2
question = txtquest.Text
Answer1 = txtsvar1.Text
Answer2 = txtsvar2.Text
Answer3 = txtsvar3.Text
Answer4 = txtsvar4.Text
Print #2, question
Print #2, Answer1
Print #2, Answer2
Print #2, Answer3
Print #2, Answer4
Close #2
lblover.Caption = question
opt(0).Caption = Answer1
opt(1).Caption = Answer2
opt(2).Caption = Answer3
opt(3).Caption = Answer4
newbgcolor = txtbgcolor.Text
newelementcolor = txtelement.Text
If txttekstfarve.Text = "" Then
newtekstcolor = "&H80000007"
Else
newtekstcolor = txttekstfarve.Text
End If
Open "udseende.txt" For Output As #3
Print #3, newbgcolor
Print #3, newelementcolor
Print #3, newtekstcolor
Close #3
farve newelementcolor, newbgcolor
frmafstem.ForeColor = newtekstcolor
tekstfarve newtekstcolor
End Sub

Private Sub cmdluk_Click()
End
End Sub

Private Sub cmdnulstil_Click()
nulstil = 0
Open "stemfil.txt" For Output As #1
Print #1, nulstil
Print #1, nulstil
Print #1, nulstil
Print #1, nulstil
Close #1
End Sub

Private Sub cmdopdater_Click()
hexblandfarve = Hex(blandfarve)
If optfarvevalg(0).Value = False And optfarvevalg(1).Value = False And optfarvevalg(2).Value = False Then
MsgBox ("Du skal vælge hvilken del af programmet du vil definere farven for")
End If
If optfarvevalg(0).Value = True Then
txtbgcolor.Text = "&H00" & hexblandfarve
End If
If optfarvevalg(1).Value = True Then
txtelement.Text = "&H00" & hexblandfarve
End If
If optfarvevalg(2).Value = True Then
txttekstfarve.Text = "&H00" & hexblandfarve
End If
End Sub

Private Sub cmdskjul_Click()
frmafstem.Width = 5655
synligt (False)
txtuser.Text = ""
txtpass.Text = ""
cmdadmin.Enabled = True
End Sub

Private Sub cmdstem_Click()
voteid
If status = True Then
If opt(0).Value = True Then
stemme = 1
End If
If opt(1).Value = True Then
stemme = 2
End If
If opt(2).Value = True Then
stemme = 3
End If
If opt(3).Value = True Then
stemme = 4
End If
Open "stemfil.txt" For Input As #1
Line Input #1, mulig1
Line Input #1, mulig2
Line Input #1, mulig3
Line Input #1, mulig4
Close #1

If stemme = 1 Then
nymulig1 = mulig1 + 1
Else
nymulig1 = mulig1
End If
If stemme = 2 Then
nymulig2 = mulig2 + 1
Else
nymulig2 = mulig2
End If
If stemme = 3 Then
nymulig3 = mulig3 + 1
Else
nymulig3 = mulig3
End If
If stemme = 4 Then
nymulig4 = mulig4 + 1
Else
nymulig4 = mulig4
End If
Open "stemfil.txt" For Output As #1
Print #1, nymulig1
Print #1, nymulig2
Print #1, nymulig3
Print #1, nymulig4
Close #1
ialt = nymulig1 + nymulig2 + nymulig3 + nymulig4
Prores1 = (nymulig1 / ialt) * 100
Prores2 = (nymulig2 / ialt) * 100
Prores3 = (nymulig3 / ialt) * 100
Prores4 = (nymulig4 / ialt) * 100
lblres1.Caption = Answer1 & ": " & nymulig1 & " = " & Prores1 & " %"
lblres2.Caption = Answer2 & ": " & nymulig2 & " = " & Prores2 & " %"
lblres3.Caption = Answer3 & ": " & nymulig3 & " = " & Prores3 & " %"
lblres4.Caption = Answer4 & ": " & nymulig4 & " = " & Prores4 & " %"
lblialt.Caption = "Antal stemmer ialt: " & ialt
Else
MsgBox ("Stemmeid ikke korrekt eller allerede brugt, prøv igen.")
End If
status = False
End Sub

Private Sub Form_Load()
error = 12345678
frmafstem.Width = 5655
Open "udseende.txt" For Input As #3
Line Input #3, bgcolor
Line Input #3, elementcolor
Line Input #3, tekstcolor
Close #3
tekstfarve tekstcolor
farve elementcolor, bgcolor
Open "setup.txt" For Input As #2
Line Input #2, question
Line Input #2, Answer1
Line Input #2, Answer2
Line Input #2, Answer3
Line Input #2, Answer4
Close #2
lblover.Caption = question
opt(0).Caption = Answer1
opt(1).Caption = Answer2
opt(2).Caption = Answer3
opt(3).Caption = Answer4
picfarve.BackColor = elementcolor
End Sub

Private Sub hscblaa_Change()
txtfarveblaa.Text = hscblaa.Value
blaa = hscblaa.Value
blandfarve = RGB(roed, groen, blaa)
picfarve.BackColor = blandfarve
End Sub

Private Sub hscgroen_Change()
txtfarvegroen.Text = hscgroen.Value
groen = hscgroen
blandfarve = RGB(roed, groen, blaa)
picfarve.BackColor = blandfarve
End Sub

Private Sub hscroed_Change()
txtfarveroed.Text = hscroed.Value
roed = hscroed.Value
blandfarve = RGB(roed, groen, blaa)
picfarve.BackColor = blandfarve
End Sub

Private Sub optfarvevalg_Click(index As Integer)
If optfarvevalg(0).Value = True Then
End If
If optfarvevalg(1).Value = True Then

End If
If optfarvevalg(2).Value = True Then

End If
End Sub

Private Sub Text1_Change()

End Sub

Private Sub txtfarveblaa_Change()
If Not IsNumeric(txtfarveblaa.Text) Then
txtfarveblaa.Text = "0"
End If
If Val(txtfarveblaa.Text) > -1 And Val(txtfarveblaa.Text) -1 And Val(txtfarvegroen.Text) -1 And Val(txtfarveroed.Text)
Gravatar #3 - kristofferj
22. mar. 2004 20:01
Der var vist en max længde så her er resten:

hscroed.Value = Val(txtfarveroed.Text)
roed = txtfarveroed.Text
blandfarve = RGB(roed, groen, blaa)
picfarve.BackColor = blandfarve
Else
MsgBox ("Du skal skrive et tal mellem 0 og 255")
End If
End Sub

Public Sub farve(x As Variant, Y As Variant)
If Y = "" Then
Y = "&H00FFFFFF"
End If
If x = "" Then
x = "&H00FFFFFF"
End If
frmafstem.BackColor = Y
frmoverskrift.BackColor = x
frmbgcolor.BackColor = x
frmelement.BackColor = x
frmoverskrift.BackColor = x
frmpass.BackColor = x
frmquest.BackColor = x
frmsvar1.BackColor = x
frmsvar2.BackColor = x
frmsvar3.BackColor = x
frmsvar4.BackColor = x
frmuser.BackColor = x
frmadmin.BackColor = x
lbladminover.BackColor = x
lblialt.BackColor = x
lblover.BackColor = x
lblres.BackColor = x
lblres1.BackColor = x
lblres2.BackColor = x
lblres3.BackColor = x
lblres4.BackColor = x
opt(0).BackColor = x
opt(1).BackColor = x
opt(2).BackColor = x
opt(3).BackColor = x
txtbgcolor.BackColor = x
txtelement.BackColor = x
txtpass.BackColor = x
txtquest.BackColor = x
txtsvar1.BackColor = x
txtsvar2.BackColor = x
txtsvar3.BackColor = x
txtsvar4.BackColor = x
txtuser.BackColor = x
frmmul.BackColor = x
cmdstem.BackColor = x
cmdluk.BackColor = x
cmdadmin.BackColor = x
cmdadmingem.BackColor = x
frmfarvevalg.BackColor = x
optfarvevalg(0).BackColor = x
optfarvevalg(1).BackColor = x
optfarvevalg(2).BackColor = x
txtfarveroed.BackColor = x
txtfarvegroen.BackColor = x
txtfarveblaa.BackColor = x
cmdopdater.BackColor = x
lblroed.BackColor = x
lblgroen.BackColor = x
lblblaa.BackColor = x
frmtekstfarve.BackColor = x
txttekstfarve.BackColor = x
cmdskjul.BackColor = x
cmdnulstil.BackColor = x
frmvoteid.BackColor = x
txtvoteid.BackColor = x
End Sub

Public Sub synligt(v)
txtquest.Visible = v
txtsvar1.Visible = v
txtsvar2.Visible = v
txtsvar3.Visible = v
txtsvar4.Visible = v
frmquest.Visible = v
frmsvar1.Visible = v
frmsvar2.Visible = v
frmsvar3.Visible = v
frmsvar4.Visible = v
frmbgcolor.Visible = v
txtbgcolor.Visible = v
cmdadmingem.Visible = v
lbladminover.Visible = v
lndel.Visible = v
frmelement.Visible = v
txtelement.Visible = v
frmfarvevalg.Visible = v
optfarvevalg(0).Visible = v
optfarvevalg(1).Visible = v
optfarvevalg(2).Visible = v
txtfarveroed.Visible = v
txtfarvegroen.Visible = v
txtfarveblaa.Visible = v
cmdopdater.Visible = v
lblroed.Visible = v
lblgroen.Visible = v
lblblaa.Visible = v
frmtekstfarve.Visible = v
txttekstfarve.Visible = v
hscroed.Visible = v
hscgroen.Visible = v
hscblaa.Visible = v
picfarve.Visible = v
cmdskjul.Visible = v
cmdnulstil.Visible = v
End Sub

Public Sub tekstfarve(x As String)
frmoverskrift.ForeColor = x
frmbgcolor.ForeColor = x
frmelement.ForeColor = x
frmoverskrift.ForeColor = x
frmpass.ForeColor = x
frmquest.ForeColor = x
frmsvar1.ForeColor = x
frmsvar2.ForeColor = x
frmsvar3.ForeColor = x
frmsvar4.ForeColor = x
frmuser.ForeColor = x
frmadmin.ForeColor = x
lbladminover.ForeColor = x
lblialt.ForeColor = x
lblover.ForeColor = x
lblres.ForeColor = x
lblres1.ForeColor = x
lblres2.ForeColor = x
lblres3.ForeColor = x
lblres4.ForeColor = x
opt(0).ForeColor = x
opt(1).ForeColor = x
opt(2).ForeColor = x
opt(3).ForeColor = x
txtbgcolor.ForeColor = x
txtelement.ForeColor = x
txtpass.ForeColor = x
txtquest.ForeColor = x
txtsvar1.ForeColor = x
txtsvar2.ForeColor = x
txtsvar3.ForeColor = x
txtsvar4.ForeColor = x
txtuser.ForeColor = x
frmmul.ForeColor = x
frmfarvevalg.ForeColor = x
optfarvevalg(0).ForeColor = x
optfarvevalg(1).ForeColor = x
optfarvevalg(2).ForeColor = x
txtfarveroed.ForeColor = x
txtfarvegroen.ForeColor = x
txtfarveblaa.ForeColor = x
lblroed.ForeColor = x
lblgroen.ForeColor = x
lblblaa.ForeColor = x
frmtekstfarve.ForeColor = x
txttekstfarve.ForeColor = x
lndel.BorderColor = x
shpramme.BorderColor = x
txtvoteid.ForeColor = x
frmvoteid.ForeColor = x
End Sub

Public Sub voteid()
Open "id.txt" For Input As #5
fil = LOF(5)
idcount = 1
Do While status = False And idcount
Gravatar #4 - kristofferj
22. mar. 2004 20:02
Og det sidste:

Seek #5, idcount
id = Input$(8, #5)
If id = txtvoteid.Text Then
status = True
Else
idcount = idcount + 9
End If
Loop

Public Sub voteiddel()

Close #5
End Sub


ps. OMG jeg får svineren for denne tråd ;-)
Gravatar #5 - 2C
15. apr. 2004 21:30
Hvis ingen ved det her, kan du spørge på eksperten.dk. Det er et rigtigt godt it forum.
Gravatar #6 - fix
15. apr. 2004 22:17
En metode som sikkert ikke er særlig smuk er:

1. Læs filen indtil den tekst der skal fjernes mødes. (=tekst1)
2. Læs 9 tegn og smid dem ud.
3. Læs resten. (tekst2).
4. lav ny tekst: tekst=tekst1+tekst2
5. Overskriv filen med den færdige tekst.
Gå til top

Opret dig som bruger i dag

Det er gratis, og du binder dig ikke til noget.

Når du er oprettet som bruger, får du adgang til en lang række af sidens andre muligheder, såsom at udforme siden efter eget ønske og deltage i diskussionerne.

Opret Bruger Login