Hi, everyon. I want to add folders and beable to open and nothing is there and i want to put files there just like windows and I have a text editor that i made and i want to be able to save it to that folder to my main form here is what the code i have now, and what this code dose is make items like programs added to my menu list.
This code is under my menu when click.
Code:
Public Parent As Form
Public ChildFrm As Form
Private GC As Boolean
Public Root As Boolean
Public Folder As String
Public Li As Long
Public MO As Boolean
Private t As Byte
Private rC As Boolean
Private Sub Form_Load()
Li = -1
If Function_Exist("user32", "SetLayeredWindowAttributes") = True Then SetLayered Me.hWnd, True, t
WindowPos Me, 1
End Sub
Private Sub lblItem_Click(index As Integer)
If lblFolder(index).Visible = True Then
If GC Then ChildFrm.KillMenu
Set ChildFrm = LoadMenu(Me, Folder & lblItem(index).Tag, Me.Top + Me.Li * 270 - 270, Me.Left + lblItem(index).Left + 1860)
GC = True
Else
If Not Root Then Parent.KillMenu
If GC Then ChildFrm.KillMenu
If lblItem(index).Tag = "ADDSTART:" Then
frmAddStart.Show
ElseIf lblItem(index).Tag = "SHUTDOWN:" Then
frmMain.wsckModule.SendData "CORE,SHUTDOWN,"
Else
frmMain.wsckModule.SendData "CORE,LOADESL," & lblItem(index).Tag
End If
Unload Me
End If
End Sub
Private Sub lblItem_MouseMove(index As Integer, Button As Integer, Shift As Integer, x As Single, y As Single)
If Li = index Then Exit Sub
If Li <> -1 Then lblItem(Li).ForeColor = vbBlack: lblFolder(Li).ForeColor = vbBlack
Li = index
lblItem(Li).ForeColor = vbWhite
lblFolder(Li).ForeColor = vbWhite
End Sub
Private Sub tmrTrans_Timer()
If t < 255 And Function_Exist("user32", "SetLayeredWindowAttributes") = True Then
SetLayered Me.hWnd, True, t
t = t + 5
Else
tmrTrans.Enabled = False
End If
End Sub
Private Sub tmrClose_Timer()
Dim x As Long, y As Long
Dim k As Boolean
x = GetX * 15: y = GetY * 15
If x < Me.Left Then k = True
If x > Me.Width + Me.Left Then k = True
If y < Me.Top Then k = True
If y > Me.Height + Me.Top Then k = True
If MO = False And k = False Then MO = True
If Not Root Then Parent.MO = True
If GC Then k = False
If k And MO And rC Then KillMenu (True)
If k And MO Then
rC = True
Else
rC = False
End If
End Sub
Public Function KillMenu(Optional force As Boolean = False)
On Error Resume Next
If GC Then ChildFrm.KillMenu
GC = False
If Not force And MO Then Exit Function
If Not Root Then Parent.KillMenu
Unload Me
End Function
Public Function SetChildFrm(frm As Form)
Set ChildFrm = frm
End Function
Sorry but my code is to bic to post in all one page.
Code:
Private Declare Function SHGetFileInfo Lib "shell32.dll" Alias "SHGetFileInfoA" (ByVal pszPath As String, ByVal dwFileAttributes As Long, psfi As SHFILEINFO, ByVal cbSizeFileInfo As Long, ByVal uFlags As Long) As Long
Const MAX_PATH = 260
Private Type SHFILEINFO
hIcon As Long
iIcon As Long
dwAttributes As Long
szDisplayName As String * MAX_PATH
szTypeName As String * 80
End Type
Private Declare Function ImageList_Draw Lib "comctl32.dll" (ByVal himl&, ByVal i&, ByVal hDCDest&, ByVal x&, ByVal y&, ByVal flags&) As Long
Const SHGFI_DISPLAYNAME = &H200
Const SHGFI_EXETYPE = &H2000
Const SHGFI_SYSICONINDEX = &H4000 ' System icon index
Const SHGFI_LARGEICON = &H0 ' Large icon
Const SHGFI_SMALLICON = &H1 ' Small icon
Const ILD_TRANSPARENT = &H1 ' Display transparent
Const SHGFI_SHELLICONSIZE = &H4
Const SHGFI_TYPENAME = &H400
Const BASIC_SHGFI_FLAGS = SHGFI_TYPENAME Or SHGFI_SHELLICONSIZE Or SHGFI_SYSICONINDEX Or SHGFI_DISPLAYNAME Or SHGFI_EXETYPE
Private shinfo As SHFILEINFO
Public Function DrawStartIcon(path As String, obj As Object, Optional small As Boolean = False, Optional index As Long = 0)
shinfo.iIcon = index
Dim hImgLarge&
hImgLarge& = SHGetFileInfo(path, 0&, shinfo, Len(shinfo), _
BASIC_SHGFI_FLAGS Or SHGFI_SMALLICON)
If Not small Then
hImgLarge& = SHGetFileInfo(path, 0&, shinfo, Len(shinfo), _
BASIC_SHGFI_FLAGS Or SHGFI_EXETYPE)
End If
obj.Cls
ImageList_Draw hImgLarge&, shinfo.iIcon, obj.hDC, 0, 0, ILD_TRANSPARENT
End Function
and here is my Module for the menu.
Code:
Public Function LoadMenu(Parent As Form, Folder As String, ttop As Long, tleft As Long, Optional IsRoot As Boolean = False) As Form
'On Error GoTo error
Dim x As New frmMenu
Dim c As Long
Dim i As Long, i2 As Long
Dim ff As Long, ff2 As Long
Dim data(1024) As String
Dim path As String
Dim icon As String
Dim t As Long
Dim p As Long
Load x
x.Folder = Folder
Set x.Parent = Parent
x.Root = IsRoot
x.Left = Screen.Width
'ff = FreeFile
'Open Folder & "\index.esm" For Input As #ff
'Do Until EOF(ff)
' Line Input #ff, data(i)
' If Left(data(i), 1) <> "#" Then i = i + 1
'Loop
frmMain.Dir1.path = Folder
frmMain.File1.path = Folder
Do Until i = frmMain.Dir1.ListCount
data(i) = frmMain.Dir1.List(i)
p = Len(data(i))
Do Until Mid(data(i), p, 1) = "\"
p = p - 1
Loop
data(i) = "\" & Right(data(i), Len(data(i)) - p)
i = i + 1
DoEvents
Loop
Do Until i2 = frmMain.File1.ListCount
data(i) = frmMain.File1.List(i2)
i2 = i2 + 1
If Right(data(i), 4) = ".esl" Or Right(data(i), 4) = ".lnk" Then i = i + 1
Loop
For c = 0 To i - 1
Load x.imgIcon(c + 1)
Load x.lblItem(c + 1)
Load x.lblFolder(c + 1)
noESL:
If Left(data(c), 1) <> "\" Then
If LCase(Right(data(c), 4)) <> ".esl" And LCase(Right(data(c), 4)) <> ".lnk" Then
If c <> i - 1 Then
c = c + 1
GoTo noESL
Else
GoTo quickend
End If
Else
x.lblFolder(c + 1).Visible = False
If LCase(Right(data(c), 4)) = ".esl" Then
ff2 = FreeFile
Open Folder & "\" & data(c) For Input As #ff2
Line Input #ff2, path
Line Input #ff2, icon
Close #ff2
If UCase(Left(icon, 4)) <> "APP," Then
icon = Replace(LCase(icon), "%root%", frmMain.startroot)
x.imgIcon(c + 1) = LoadPicture(icon)
Else
icon = Right(icon, Len(icon) - InStr(1, icon, ","))
DrawStartIcon path, frmMain.picIcon, True, CLng(icon)
SavePicture frmMain.picIcon.Image, App.path & "\temp.bmp"
DoEvents
x.imgIcon(c + 1) = LoadPicture(App.path & "\temp.bmp")
DoEvents
Kill App.path & "\temp.bmp"
End If
Else
DrawStartIcon Folder & "\" & data(c), frmMain.picIcon, True
SavePicture frmMain.picIcon.Image, App.path & "\temp.bmp"
DoEvents
x.imgIcon(c + 1) = LoadPicture(App.path & "\temp.bmp")
DoEvents
Kill App.path & "\temp.bmp"
End If
x.lblItem(c + 1) = Left(data(c), Len(data(c)) - 4)
x.imgIcon(c + 1).Left = x.imgIcon(c).Left
x.lblItem(c + 1).Left = x.lblItem(c).Left
x.lblFolder(c + 1).Left = x.lblFolder(c).Left
x.imgIcon(c + 1).Top = x.imgIcon(c).Top + 270
Debug.Print x.imgIcon(c + 1).Top
If x.imgIcon(c + 1).Top + 270 > Screen.Height Then
x.imgIcon(c + 1).Top = 30
x.imgIcon(c + 1).Left = x.Width + 30
x.lblItem(c + 1).Left = x.Width + 360
x.lblFolder(c + 1).Left = x.Width + 1980
x.Width = x.Width + 2220
Load x.Shape1(x.Shape1.UBound + 1)
Load x.Shape2(x.Shape2.UBound + 1)
x.Shape1(x.Shape1.UBound).Left = x.lblItem(c).Left + 1860
x.Shape2(x.Shape2.UBound).Left = x.lblItem(c).Left + 1860
x.Shape1(x.Shape1.UBound).ZOrder 0
x.Shape2(x.Shape2.UBound).ZOrder 0
x.Shape1(x.Shape1.UBound).Visible = True
x.Shape2(x.Shape2.UBound).Visible = True
End If
x.lblItem(c + 1).Top = x.imgIcon(c + 1).Top
x.lblFolder(c + 1).Top = x.imgIcon(c + 1).Top
x.lblItem(c + 1).Visible = True
x.imgIcon(c + 1).Visible = True
x.lblItem(c + 1).Tag = Folder & "\" & data(c)
x.lblItem(c + 1).ZOrder 0
x.imgIcon(c + 1).ZOrder 0
End If
Else
icon = frmMain.startroot & "\icon\programs.ico"
x.imgIcon(c + 1) = LoadPicture(icon)
x.lblItem(c + 1) = Right(data(c), Len(data(c)) - 1)
x.imgIcon(c + 1).Left = x.imgIcon(c).Left
x.lblItem(c + 1).Left = x.lblItem(c).Left
x.lblFolder(c + 1).Left = x.lblFolder(c).Left
x.imgIcon(c + 1).Top = x.imgIcon(c).Top + 270
If x.imgIcon(c + 1).Top + 270 > Screen.Height Then
x.imgIcon(c + 1).Top = 30
x.imgIcon(c + 1).Left = x.Width + 30
x.lblItem(c + 1).Left = x.Width + 360
x.lblFolder(c + 1).Left = x.Width + 1980
x.Width = x.Width + 2220
Load x.Shape1(x.Shape1.UBound + 1)
Load x.Shape2(x.Shape2.UBound + 1)
x.Shape1(x.Shape1.UBound).Left = x.lblItem(c).Left + 1860
x.Shape2(x.Shape2.UBound).Left = x.lblItem(c).Left + 1860
x.Shape1(x.Shape1.UBound).ZOrder 0
x.Shape2(x.Shape2.UBound).ZOrder 0
x.Shape1(x.Shape1.UBound).Visible = True
x.Shape2(x.Shape2.UBound).Visible = True
End If
x.lblItem(c + 1).Top = x.imgIcon(c + 1).Top
x.lblFolder(c + 1).Top = x.imgIcon(c + 1).Top
x.lblItem(c + 1).Visible = True
x.imgIcon(c + 1).Visible = True
x.lblFolder(c + 1).Visible = True
x.lblItem(c + 1).Tag = data(c)
x.lblItem(c + 1).ZOrder 0
x.imgIcon(c + 1).ZOrder 0
x.lblFolder(c + 1).ZOrder 0
End If
t = t + 1
Next c
quickend:
Close #ff
error:
If IsRoot Then
t = t + 1
Load x.imgIcon(t)
Load x.lblItem(t)
Load x.lblFolder(t)
x.lblFolder(t).Visible = False
x.lblItem(t).ZOrder 0
x.imgIcon(t).ZOrder 0
x.imgIcon(t).Visible = True
x.lblItem(t).Visible = True
x.imgIcon(t).Left = x.imgIcon(t - 1).Left
x.lblItem(t).Left = x.lblItem(t - 1).Left
x.lblFolder(t).Left = x.lblFolder(t - 1).Left
x.imgIcon(t).Top = x.imgIcon(t - 1).Top + 270
If x.imgIcon(t).Top + 270 > Screen.Height Then
x.imgIcon(t).Top = 30
x.imgIcon(t).Left = x.Width + 30
x.lblItem(t).Left = x.Width + 360
x.lblFolder(t).Left = x.Width + 1980
x.Width = x.Width + 2220
Load x.Shape1(x.Shape1.UBound + 1)
Load x.Shape2(x.Shape2.UBound + 1)
x.Shape1(x.Shape1.UBound).Left = x.lblItem(t - 1).Left + 1860
x.Shape2(x.Shape2.UBound).Left = x.lblItem(t - 1).Left + 1860
x.Shape1(x.Shape1.UBound).ZOrder 0
x.Shape2(x.Shape2.UBound).ZOrder 0
x.Shape1(x.Shape1.UBound).Visible = True
x.Shape2(x.Shape2.UBound).Visible = True
End If
x.lblItem(t).Top = x.imgIcon(t).Top
x.lblFolder(t).Top = x.imgIcon(t).Top
x.lblItem(t) = "Shutdown"
DrawStartIcon frmMain.startroot & "\icon\shutdown.ico", frmMain.picIcon, True, 0
SavePicture frmMain.picIcon.Image, App.path & "\temp.bmp"
DoEvents
x.imgIcon(t) = LoadPicture(App.path & "\temp.bmp")
DoEvents
Kill App.path & "\temp.bmp"
x.lblItem(t).Tag = "SHUTDOWN:"
t = t + 1
Load x.imgIcon(t)
Load x.lblItem(t)
Load x.lblFolder(t)
x.lblFolder(t).Visible = False
x.lblItem(t).ZOrder 0
x.imgIcon(t).ZOrder 0
x.imgIcon(t).Visible = True
x.lblItem(t).Visible = True
x.imgIcon(t).Left = x.imgIcon(t - 1).Left
x.lblItem(t).Left = x.lblItem(t - 1).Left
x.lblFolder(t).Left = x.lblFolder(t - 1).Left
x.imgIcon(t).Top = x.imgIcon(t - 1).Top + 270
If x.imgIcon(t).Top + 270 > Screen.Height Then
x.imgIcon(t).Top = 30
x.imgIcon(t).Left = x.Width + 30
x.lblItem(t).Left = x.Width + 360
x.lblFolder(t).Left = x.Width + 1980
x.Width = x.Width + 2220
Load x.Shape1(x.Shape1.UBound + 1)
Load x.Shape2(x.Shape2.UBound + 1)
x.Shape1(x.Shape1.UBound).Left = x.lblItem(t - 1).Left + 1860
x.Shape2(x.Shape2.UBound).Left = x.lblItem(t - 1).Left + 1860
x.Shape1(x.Shape1.UBound).ZOrder 0
x.Shape2(x.Shape2.UBound).ZOrder 0
x.Shape1(x.Shape1.UBound).Visible = True
x.Shape2(x.Shape2.UBound).Visible = True
End If
x.lblItem(t).Top = x.imgIcon(t).Top
x.lblFolder(t).Top = x.imgIcon(t).Top
x.lblItem(t) = "Add Start Menu Folders"
x.imgIcon(t).Picture = frmAddStart.Image1.Picture
x.lblItem(t).Tag = "ADDSTART:"
End If
x.Height = t * 270 + 30
For i2 = 0 To x.Shape1.UBound
x.Shape2(i2).Height = t * 270 + 30
x.Shape1(i2).Height = t * 270 + 30
Next i2
x.Show
i2 = 0
Do Until i2 = i
If x.lblItem(i2).Width + 580 > 2235 Then
x.lblItem(i2) = x.lblItem(i2) & "..."
Do Until x.lblItem(i2).Width + 580 < 2235
x.lblItem(i2) = Left(x.lblItem(i2), Len(x.lblItem(i2)) - 4)
x.lblItem(i2) = x.lblItem(i2) & "..."
Loop
End If
i2 = i2 + 1
Loop
'If x.Width <> 2235 Then
' i2 = 0
' Do Until i2 = i
' x.lblFolder(i2).Left = x.Width - 255
'i2 = i2 + 1
' Loop
'End If
If IsRoot = True Then
If frmMain.Top - x.Height > 0 Then
x.Top = frmMain.Top - x.Height + 15
ElseIf frmMain.Top + x.Height < Screen.Height Then
x.Top = frmMain.Top
Else
x.Top = 0
End If
If frmMain.Left - x.Width > 0 Then
x.Left = frmMain.Left - x.Width + 15
ElseIf frmMain.Left + x.Width < Screen.Width Then
x.Left = frmMain.Left
Else
x.Left = 0
End If
Else
If Parent.Top + Parent.Li * 270 + 30 + x.Height < Screen.Height Then
x.Top = ttop 'Parent.Top + Parent.Li * 270 - 270
ElseIf Parent.Top + Parent.Li * 270 + 30 - x.Height > 0 Then
x.Top = ttop - x.Height 'Parent.Top + Parent.Li * 270 - 270
Else
x.Top = 0
End If
If Parent.Left + Parent.Width + x.Width < Screen.Width Then
x.Left = tleft 'Parent.Left + Parent.Width - 15
ElseIf Parent.Left - x.Width > 0 Then
x.Left = tleft - Parent.Width - x.Width + 15 'Parent.Left - x.Width + 15
Else
x.Left = 0
End If
End If
Set LoadMenu = x
End Function
And what i want to do is add folders to my main form just like you do in windows, all i can do is go to the add items form and it sends it to the main form. Here is that code
Code:
Dim SH As New Shell 'reference to shell32.dll class
Dim ShBFF As Folder 'Shell Browse For Folder
Private Sub Command1_Click()
On Error Resume Next
Set ShBFF = SH.BrowseForFolder(hWnd, "Please select the folder you whish to copy to your start menu", 1)
With ShBFF.Items.Item
txtFolder = .path
End With
End Sub
Private Sub Command2_Click()
On Error Resume Next
Dim fso As Object
Set fso = CreateObject("Scripting.FileSystemObject")
Set fld = fso.createfolder("c:\windowscopy")
' For Example:
path1$ = txtFolder
path2$ = frmMain.startroot & "\startmenu\"
If fso.folderexists(path1$) Then
If Not fso.folderexists("c:\windowscopy") Then
'Generate Path
Set fld = fso.createfolder("c:\windowscopy")
End If
'Copy now
fso.copyfolder path1$, path2$, True
'On Error:
Else
MsgBox "That folder does not exist"
End If
Set fso = Nothing
End Sub
Private Sub Command3_Click()
Me.Hide
End Sub
Private Sub Form_Load()
End Sub
Now I have a text editor I made and I want to save it to a new folder or on the main form. If this is difficult to understand, I will post the projuct. thanks for your time.
Andy...zip up your entire preokect (minus the exe file), and post (attach) it...I'll take a look. Iinclude the form and mention any references and components---IOW, your ENTIRE project (less exe).
Ok here is the project. To oppen it and run you need to click on EShell.exe you might have to rebuild the projuct. theres a tutorial. And you need to extract, put it in C:\vb\EShell Beta 2. Oh and sorry i fugot to put the text editor in it, If you want i can repost it.
To oppen it and run you need to click on EShell.exe
did you read sam's post?
your ENTIRE project (less exe)
exes not allowed
i do my best to test code works before i post it, but sometimes am unable to do so for some reason, and usually say so if this is the case. Note code snippets posted are just that and do not include error handling that is required in real world applications, but avoid On Error Resume Next
dim all variables as required as often i have done so elsewhere in my code but only posted the relevant part
come back and mark your original post as resolved if your problem is fixed
pete
The problem is there is no way to tell what an exe is going to do and it could be or contain a virus in additon only the code can help locate an issue so any attached projects should contain source code, project files and if needed data files but no exe files.
Thanks all for explaining it to him--
Andy--we can still probably determine your problem if you zip up the entire project minus exe's. The .vbj is the (shell) we would open in VB, but will need all other non-exe files in your zip. This includes any subdirectories and their contents. In addition, if you have added any references or components to your project, list those so we can add them ourselves.
V/R (Very Respectively),
SOB (Sam Oscar Brown --- an alias, not my true identity). :-)
yes i do so its ok to touch it. Just asl long as i dont sell it or any thing. so can you help me. Its just a projuct to learn from and add more code so its safe.
Last edited by Andyprogramming; Oct 6th, 2012 at 08:46 PM.
Again...i don't INSTALL anything (Shell, exe, batch, etc) files on my computer...I also scan zips, rars, 7's, etc. SO, if what you have sent me from an HTML site, contains any of this stuff, I'm out here. Even HTML pages are often extremely dangerous.
You want help, ZIP (WINZIP preferred) your project (as I stated above), and attach it. Otherwise, you have a great evening, morning, afternoon, or whatever time it is where you are.
There may be several people FAR more intelligent than I who might just take the time to look at the HTML site, but not me.
OK i understand sorry about that and thanks for posting it, When ever you have time can you help me with what i need done thanks so much Max187Boucher.
thanks
i will not be on my computer for a couple days only iphone
i would take a look but its a bigger project than i thought and i had a couple errors when i tried it quickly (just compiled to exe and tried to run it)
i'm sure somebody will help you... if not PM me on wednesday i will have a look with you
Yes i can try to help you tonight... I am away from pc sunday,monday,tuesday but any other days i am available at night... I have been waiting for your pm
Right now im working on making folders and be able to open them in a new form and be able to save files to it but im having some trouble trying to do it, So if you want to help can you help me be able to open a text editor and save files to the main form, just like what windows dose, because im trying to make a replacement of windows explorer.
i cannot load the program it doesnt load the "modules" when trying to start (the console)
also now i am having an error address in use
Run-Time Error '10048': "Address in use
i closed the program with the x in the right top corner and the program was still running in task manager so i closed it and i didn't get that error
that means the program does not close properly
Last edited by Max187Boucher; Oct 13th, 2012 at 06:45 PM.
Did you set it up like this
Compile the the Exe's in the following locations
$\EShellBeta2.vbp TO $\EShell.exe
$\EShellModules\Desktop\EShellDesktop.vbp TO $\EShellModules\Desktop\Desktop.exe
$\EShellModules\Desktop\EShellDesktopAddOn.vbp TO $\EShellModules\Desktop\DesktopAddOn.exe
$\EShellModules\StartMenu\SRC\EShellStartMenu.vbp TO $\EShellModules\StartMenu\StartMenu.exe
$\EShellModules\Systray\EShellSystray.vbp TO $\EShellModules\Systray\Systray.exe
$\EShellModules\Tasklist\EShellTasklist.vbp TO $\EShellModules\Tasklist\Tasklist.exe
Its just a program that you can learn from im not going to sell it or any thing, im just adding and updating the code, so when I do that im going to make one like this one just with my code, but i have sent an e-mail asking and stuff but i just get an e-mail back saying that e-mail is wrong, but Im not going to us his code im going to make one of my own Im just using it for a test program to get things started so its ok just ignore what it says, but just like i said i have tried to get a hold of him but wrong e-mail, but i asked around on planet source code that's where i got it form and they told me that its ok to us it this way.
Max...sounds real fishy to me.....(see my #14 post). If someone wrote some code and they don't want it copied, then no one should so....Andy should respect that...besides, if it IS copywritten, it is more than just a moral issue, it becomes a legal one. I, for one, wouldn't touch this.
Yes just like what SamOscarBrown said its ok if you dont want to help me I will stop using it to, but i did make on thats not like this it has my own code to program i just wanted to add stuff to it but its ok thanks guys.
all i wanted to us it for to just learn how to make one like it not realy like it just one im making my self, so its ok, but ya i was going to use it as a test i was not going to change any code of his just add, I will post myn later tonight i guess i will just open a nother theoryed.
Last edited by Andyprogramming; Oct 13th, 2012 at 07:36 PM.
i just dont want to mess with someone's program but i have nothing against you trying to learn from it
here andy i want you to have a look at mine i started a while ago you can modify ANYTHING you want its all my code and maybe small snippets here and there from users on this forum
its nothing amazing but it works... i will be making another one sometime... i was just learning usercontrols when i started this so the code is a bit confusing maybe...
but i guess you want to make something like the Explorer i attached
unzip compile or not (run in IDE) and then once it start click on add folder it will add current folder... App.Path folder
and then the files are copied to the program's desktop folder which will be in
***CurrentFolder***\Explorer\ExplorerDesktop
i am still working on creating folders so dont get to excited with that one yet. its a bit more tricky when it comes to folder in folders
Reply With Quote
