View Single Post
Staro 06.02.2006., 11:10   #19
gremlin33
just like Registered User
Moj komp
 
gremlin33's Avatar
 
Datum registracije: Jul 2004
Lokacija: zagreb
Postovi: 166
kao što i rekoh onaj output u Irfan je svašta radio pa sam ja na kraju zmrljao nešto u VB-u i kao što obetjah evo koda....

Private oGdPicture As Gdpicture.cGdPicture
Private nPreviewHandle As Long
Private nNativeImageHandle As Long
Const strStaza As String = "D:\Rotate\"
Const strStaza_Input As String = "Rotate\"
Const strStaza_Drive As String = "D:\"
Public lngSec As Long, lng_Slikica As Long
Public p ' datoeka
Public intDirektorija As Integer, strFolder_trenutni As String, intPocetak As Integer
Public int_min As Integer, int_sat As Integer
Public intTip_rotacije As Integer, sk As Long

Private Sub cmdIzlaz_Click()
Unload Me
End Sub

Private Sub cmdUcitaj_Click()
If opt90(0) = True Then intTip_rotacije = 1
If opt90(1) = True Then intTip_rotacije = 3
zakljucaj
Timer.Enabled = True

lngSec = 0
int_min = 0
int_sat = 0

intDirektorija = Dir1.ListCount
For intPocetak = 0 To intDirektorija - 1
strFolder_trenutni = Dir1.List(intPocetak) & "\" '-1 je root folder
ucitaj_slike (strFolder_trenutni)
Next intPocetak
Timer.Enabled = False
lblVrijeme_Potrebno = Int(txtUkupnoSlika / sk)
otkljucaj
End Sub
Function zbroj_sve_slikice(strFolder_trenutni As String, intDirektorija As Integer)
Dim lngSlika As Long
For intPocetak = 0 To intDirektorija
strFolder_trenutni = Dir1.List(intPocetak) & "\" '-1 je root folder
p = Dir(strFolder_trenutni, vbNormal) ' čita 1 fajlu
Do While p <> "" ' kreće petlja
If p <> "." And p <> ".." Then '
If (GetAttr(strFolder_trenutni & p) And vbNormal) = vbNormal And Right(strFolder_trenutni & p, 3) = "tif" Then
lngSlika = lngSlika + 1
End If
Else
End If
p = Dir
Loop
Next intPocetak
zbroj_sve_slikice = lngSlika
Set p = Nothing
End Function

'lng_Slikica = 0
Function ucitaj_slike(strSto2 As String)
p = Dir(strSto2, vbNormal) ' čita 1 fajlu
Do While p <> "" ' kreće petlja
If p <> "." And p <> ".." Then '
If (GetAttr(strSto2 & p) And vbNormal) = vbNormal And Right(p, 3) = "tif" Then
Rotiraj_Sliku (strSto2 & p)
End If
End If
p = Dir
Loop
Set p = Nothing
End Function

Private Sub Dir1_Change()
txtUkupnoSlika = zbroj_sve_slikice(Dir1 & "\", Dir1.ListCount)
txtTray = Dir1.ListCount
End Sub

Private Sub drivee_Change()
Dir1.Path = drivee
End Sub

Private Sub Form_Load()
Dim tt As String
Timer.Enabled = False
Set oGdPicture = New Gdpicture.cGdPicture
Call oGdPicture.SetLicenceNumber("nnnnnnnnnnnnnn) 'licence key koji dobijete na njihovoj stranici
Call oGdViewer.SetLicenceNumber("nnnnnnnnnn") 'licence key koji dobijete na njihovoj stranici
oGdViewer.SetIsedQuickPDFLicenceNumber ("nnnnnnnnnnnnnnn") 'licence key koji dobijete na njihovoj stranici za pdf
nPreviewHandle = 0
nNativeImageHandle = 0
drivee = strStaza_Drive
tt = strStaza_Drive & strStaza_Input
Dir1.Path = tt

End Sub
Function Rotiraj_Sliku(strSto3 As String)
lng_Slikica = lng_Slikica + 1
DoEvents
txtStaza = strSto3
txtSlikica = lng_Slikica
oGdPicture.LoadFromFile (strSto3)
oGdPicture.Rotate (intTip_rotacije)
oGdPicture.SaveAsTiff strSto3, 4
oGdPicture.CloseNativeImage
End Function

Private Sub Timer_Timer()

lngSec = lngSec + 1
If lngSec = 60 Then
int_min = int_min + 1
lngSec = 0
End If
If int_min = 60 Then
int_sat = int_sat + 1
int_min = 0
End If
lblVrijeme = int_sat & " : " & int_min & " : " & lngSec
sk = sk + 1
End Sub
Function zakljucaj()
Dim intControla As Integer
lblkraj.Caption = " Rotiram Slike !!!"
For intControla = 0 To opt90.Count - 1
opt90(intControla).Enabled = False
Next intControla
cmdUcitaj.Enabled = False
drivee.Enabled = False
Dir1.Enabled = False
cmdIzlaz.Enabled = False
End Function

Function otkljucaj()
Dim intControla As Integer
For intControla = 0 To opt90.Count - 1
opt90(intControla).Enabled = True
Next intControla
cmdUcitaj.Enabled = True
drivee.Enabled = True
Dir1.Enabled = True
lblkraj.Caption = " Rotiranje Slika gotovo !!"
cmdIzlaz.Enabled = True
End Function

Na formi se nalazi:
oGdViewer
driveListBox=drivee
dirListBox=dir1
gumb : cmdUcitaj i cmdIzlaz
txtBox:
txtTray=kolko foldera
txtUkupnoSlika=ukupno slika
txtSlikica= trenutno obrađeno slikica
lblVrijeme=proteklo vrijeme
lblVrijeme_Potrebno=prosjek slika po sec
txtStaza= prikazuje full path i slikicu koju hendla
i timer

znam da nije sve optimizirano ali kolko se ja kužim i kak sam to navrat nanos delal..ja happy...a i svima hvala...
pizza stoji
__________________
što me snađe da se ovdje nađe!
gremlin33 je offline   Reply With Quote