'daca data sistemului este returnata cu PM adaugam 12 altfel o lasam asa
ora = Now.Hour + 12
Else
ora = Now.Hour
End If
If Me.ClientSize.Width > Me.ClientSize.Height Then 'setam unghiul care va determina ce tip de brat este
R = (Me.ClientSize.Height / 2) - 35
Else
R = (Me.ClientSize.Width / 2) - 35
End If
unghi = ora * ora1 - (3.2 * ora1) 'variabila unghi retine unghiul de miscare si se calculeaza astfel:
' unghi = ora * ora1 - (3.2 * ora1)
' unghi = ora * ora1 - (2.8 * ora1)
' unghi = ora * ora1 - (3 * ora1)
' punctul de incepere al cercului este pozitia orei 3
X = Cos(unghi) * (R - 20) 'valoarea lui X pentru punctul din stanga
Y = (Sin(unghi) * (R - 20)) * AspectRatio ' valoarea lui Y pentru punctul din stanga
fp(0) = New Point(XC, YC)
fp(1) = New Point(XC + X, YC + Y)
unghi = ora * ora1 - (2.8 * ora1)
X = Cos(unghi) * (R - 20)
Y = (Sin(unghi) * (R - 20)) * AspectRatio
fp(3) = New Point(XC + X, YC + Y)
unghi = ora * ora1 - (3 * ora1)
X = Cos(unghi) * R
Y = (Sin(unghi) * R) * AspectRatio
fp(2) = New Point(XC + X, YC + Y)
fp(4) = fp(0)
g.FillPolygon(MyBrush, fp)
g.DrawLine(Pens.Black, fp(0), fp(1))
g.DrawLine(Pens.Black, fp(1), fp(2))
g.DrawLine(Pens.Black, fp(2), fp(3))
g.DrawLine(Pens.Black, fp(3), fp(4))
'desenarea minutarului
unghi = MIN * SS - (16 * SS)
X = Cos(unghi) * (R - 40)
Y = (Sin(unghi) * (R - 40)) * AspectRatio
fp(0) = New Point(XC, YC)
fp(1) = New Point(XC + X, YC + Y)
unghi = MIN * SS - (14 * SS)
X = Cos(unghi) * (R - 40)
Y = (Sin(unghi) * (R - 40)) * AspectRatio
fp(3) = New Point(XC + X, YC + Y)
unghi = MIN * SS - (15 * SS)
X = Cos(unghi) * (R - 30)
Y = (Sin(unghi) * (R - 30)) * AspectRatio
fp(2) = New Point(XC + X, YC + Y)
fp(4) = fp(0)
g.FillPolygon(MyBrush, fp)
g.DrawLine(Pens.Black, fp(0), fp(1))
g.DrawLine(Pens.Black, fp(1), fp(2))
g.DrawLine(Pens.Black, fp(2), fp(3))
g.DrawLine(Pens.Black, fp(3), fp(4))
'secundarul
unghi = SEC * SS - (15 * SS)
X = Cos(unghi) * R
Y = (Sin(unghi) * R) * AspectRatio
fp(0) = New Point(XC, YC)
fp(1) = New Point(XC + X, YC + Y)
g.DrawLine(Pens.Black, fp(0), fp(1))
Array.Clear(fp, 0, fp.GetUpperBound(0))
fp = Nothing
MyBrush.Dispose()
MyBrush = Nothing
End Sub
Private Sub Draw_Clock_Markers()
Dim index As Integer
If Me.ClientSize.Width > Me.ClientSize.Height Then
R = (Me.ClientSize.Height / 2) - 25
Else
R = (Me.ClientSize.Width / 2) - 25
End If
index = 0
For unghi = 0 To 2 * PI Step (2 * PI) / 60
X = Cos(unghi) * R
Y = (Sin(unghi) * R) * AspectRatio
If index / 5 = Int(index / 5) Then
g.FillEllipse(Brushes.Firebrick, XC + X - 5, YC + Y - 5, 10, 10)
g.DrawEllipse(Pens.Black, XC + X - 5, YC + Y - 5, 10, 10)
Else
g.FillEllipse(Brushes.Firebrick, XC + X - 2, YC + Y - 2, 4, 4)
g.DrawEllipse(Pens.Black, XC + X - 2, YC + Y - 2, 4, 4)
End If
index += 1
Next
g.FillEllipse(Brushes.Black, XC - 5, YC - 5, 10, 10)
index = Nothing
End Sub
Private Sub Draw_Clock_Face()
Dim gp As New Drawing2D.GraphicsPath
Dim fp(1) As Point
Dim index As Integer
If Me.ClientSize.Width > Me.ClientSize.Height Then
R = (Me.ClientSize.Height / 2) - 15
Else
R = (Me.ClientSize.Width / 2) - 15
End If
index = 1
For unghi = 0 To 2 * PI Step 0.1
X = Cos(unghi) * R
Y = (Sin(unghi) * R) * AspectRatio
If X <> 0 And Y <> 0 Then
If index - 1 > fp.GetUpperBound(0) Then
ReDim Preserve fp(index)
End If
fp(index - 1) = New System.Drawing.Point(XC + X, YC + Y)
index += 1
End If
Next
gp.AddCurve(fp)
gp.CloseFigure()
g.FillPath(Brushes.GhostWhite, gp)
g.DrawPath(Pens.Black, gp)
Array.Clear(fp, 0, fp.GetUpperBound(0))
fp = Nothing
gp.Dispose()
gp = Nothing
index = Nothing
End Sub
Private Sub Form1_Closing(ByVal sender As Object, ByVal e As System.ComponentModel.CancelEventArgs) Handles MyBase.Closing
bm.Dispose()
g.Dispose()
bm = Nothing
g = Nothing
PI = Nothing
XC = Nothing
YC = Nothing
X = Nothing
Y = Nothing
R = Nothing
unghi = Nothing
Secundac = Nothing
AspectRatio = Nothing
End Sub
Private Sub Timer1_Tick(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Timer1.Tick
If Secundac <> Now.Second Then
Secundac = Now.Second
Draw_Graphics()
Me.BackgroundImage = bm
Me.Refresh()
End If
End Sub
Private Sub Form1_Activated(ByVal sender As Object, ByVal e As System.EventArgs) Handles MyBase.Activated
If Timer1.Enabled = False Then Timer1.Enabled = True
End Sub
End Class
17. Să se proiecteze şi să se realizeze efectiv o interfaţă gen “Windows Explorer “ pentru vizualizarea structurii de foldere şi fişiere şi unităţile de disc disponibile. Un dublu click pe un fişier îl va deschide cu aplicaţia asociată (va lansa în execuţie un fişier executabil sau va deschide pentru lucru un fişier sub Word, Excel etc).
Sugestie de rezolvare:
Codul sursa al programului este urmatorul:
Imports ExpTreeLib
Imports ExpTreeLib.CShItem
Imports ExpTreeLib.SystemImageListManager
Imports System.IO
Imports System.Text
Imports System.Text.RegularExpressions
Imports System.Threading
#Const Ver = 2005
Public Class frmDragDrop
Inherits System.Windows.Forms.Form
Dim testTime As New DateTime(1, 1, 1, 0, 0, 0)
Private LastSelectedCSI As CShItem
Friend WithEvents txtDropOn As System.Windows.Forms.TextBox
Friend WithEvents mnuChangeRoot As System.Windows.Forms.MenuItem
Friend WithEvents mnuRefreshTree As System.Windows.Forms.MenuItem
Friend WithEvents mnuSetToDesktop As System.Windows.Forms.MenuItem
Friend WithEvents mnuExit As System.Windows.Forms.MenuItem
Friend WithEvents MenuItem1 As System.Windows.Forms.MenuItem
Friend WithEvents mnuViewLargeIcons As System.Windows.Forms.MenuItem
Friend WithEvents mnuViewSmallIcons As System.Windows.Forms.MenuItem
Friend WithEvents mnuViewList As System.Windows.Forms.MenuItem
Friend WithEvents mnuViewDetails As System.Windows.Forms.MenuItem
Friend WithEvents MenuItem2 As System.Windows.Forms.MenuItem
Friend WithEvents MainMenu1 As System.Windows.Forms.MainMenu
Private Shared Event1 As New ManualResetEvent(True)
#Region " Windows Form Designer generated code "
Public Sub New()
MyBase.New()
InitializeComponent()
SystemImageListManager.SetListViewImageList(lv1, False, False)
SystemImageListManager.SetListViewImageList(lv1, True, False)
#If Ver = 2005 Then
Control.CheckForIllegalCrossThreadCalls = False
#End If
End Sub
Protected Overloads Overrides Sub Dispose(ByVal disposing As Boolean)
If disposing Then
If Not (components Is Nothing) Then
components.Dispose()
End If
End If
MyBase.Dispose(disposing)
End Sub
Private components As System.ComponentModel.IContainer
Friend WithEvents Panel1 As System.Windows.Forms.Panel
Friend WithEvents ExpTree1 As ExpTreeLib.ExpTree
Friend WithEvents Splitter1 As System.Windows.Forms.Splitter
Friend WithEvents Panel2 As System.Windows.Forms.Panel
Friend WithEvents cmdExit As System.Windows.Forms.Button
Friend WithEvents sbr1 As System.Windows.Forms.StatusBar
Friend WithEvents lv1 As System.Windows.Forms.ListView
Friend WithEvents ColumnHeaderName As System.Windows.Forms.ColumnHeader
Friend WithEvents ColumnHeaderSize As System.Windows.Forms.ColumnHeader
Friend WithEvents ColumnHeaderType As System.Windows.Forms.ColumnHeader
Friend WithEvents ColumnHeaderModifyDate As System.Windows.Forms.ColumnHeader
Friend WithEvents ColumnHeaderAttributes As System.Windows.Forms.ColumnHeader
Private Sub InitializeComponent()
Me.SuspendLayout()
'
'frmDragDrop
'
Me.ClientSize = New System.Drawing.Size(560, 363)
Me.Name = "frmDragDrop"
Me.ResumeLayout(False)
End Sub
#End Region
#Region "Form Exit Methods"
Private Sub cmdExit_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles cmdExit.Click
mnuExit_Click(sender, e)
End Sub
Private Sub mnuExit_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles mnuExit.Click
Me.Close()
End Sub
#End Region
#Region "Form Load"
Private Sub Form1_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load
#If Ver = 2005 Then
Control.CheckForIllegalCrossThreadCalls = False
#End If
End Sub
#End Region
#Region " ExplorerTree Event Handling"
Private Sub AfterNodeSelect(ByVal pathName As String, ByVal CSI As CShItem) Handles ExpTree1.ExpTreeNodeSelected
Dim dirList As New ArrayList()
Dim fileList As New ArrayList()
Dim TotalItems As Integer
LastSelectedCSI = CSI
If CSI.DisplayName.Equals(CShItem.strMyComputer) Then
dirList = CSI.GetDirectories
Else
dirList = CSI.GetDirectories
fileList = CSI.GetFiles
End If
Event1.WaitOne()
TotalItems = dirList.Count + fileList.Count
If TotalItems > 0 Then
Dim item As CShItem
dirList.Sort()
fileList.Sort()
Me.Text = pathName
sbr1.Text = pathName & " " & _
dirList.Count & " Directories " & fileList.Count & " Files"
Dim combList As New ArrayList(TotalItems)
combList.AddRange(dirList)
combList.AddRange(fileList)
lv1.BeginUpdate()
lv1.Items.Clear()
lv1.Refresh()
For Each item In combList
Dim lvi As New ListViewItem(item.DisplayName)
With lvi
If Not item.IsDisk And item.IsFileSystem Then
Dim attr As FileAttributes
attr = GetAttr(item.Path)
Dim SB As New StringBuilder()
If (attr And FileAttributes.System) = FileAttributes.System Then SB.Append("S")
If (attr And FileAttributes.Hidden) = FileAttributes.Hidden Then SB.Append("H")
If (attr And FileAttributes.ReadOnly) = FileAttributes.ReadOnly Then SB.Append("R")
If (attr And FileAttributes.Archive) = FileAttributes.Archive Then SB.Append("A")
.SubItems.Add(SB.ToString)
Else : .SubItems.Add("")
End If
If Not item.IsDisk And item.IsFileSystem And Not item.IsFolder Then
If item.Length > 1024 Then
.SubItems.Add(Format(item.Length / 1024, "#,### KB"))
Else
.SubItems.Add(Format(item.Length, "##0 Bytes"))
End If
Else
.SubItems.Add("")
End If
.SubItems.Add(item.TypeName)
If item.IsDisk Then
.SubItems.Add("")
Else
If item.LastWriteTime = testTime Then
.SubItems.Add("")
Else
.SubItems.Add(item.LastWriteTime)
End If
End If
.Tag = item
End With
lv1.Items.Add(lvi)
Next
lv1.EndUpdate()
LoadLV1Images()
Else
lv1.Items.Clear()
sbr1.Text = pathName & " Has No Items"
End If
End Sub
#End Region
#Region " IconIndex Loading Thread"
Private Sub LoadLV1Images()
Dim ts As New ThreadStart(AddressOf DoLoadLv)
Dim ot As New Thread(ts)
#If Ver = 2005 Then
ot.SetApartmentState(ApartmentState.STA)
#Else
ot.ApartmentState = ApartmentState.STA
#End If
Event1.Reset()
ot.Start()
End Sub
Private Sub DoLoadLv()
Dim lvi As ListViewItem
For Each lvi In lv1.Items
lvi.ImageIndex = SystemImageListManager.GetIconIndex(lvi.Tag, False)
Next
Event1.Set()
End Sub
#End Region
#Region " Drag From Routines"
Private Sub lv1_ItemDrag(ByVal sender As Object, ByVal e As System.Windows.Forms.ItemDragEventArgs) Handles lv1.ItemDrag
With lv1
If .SelectedItems.Count > 0 Then
Dim toDrag As New ArrayList()
Dim lvItem As ListViewItem
Dim strD(.SelectedItems.Count - 1) As String
Dim i As Integer
For Each lvItem In .SelectedItems
toDrag.Add(lvItem.Tag)
strD(i) = CType(lvItem.Tag, CShItem).Path
i += 1
Next
Dim Dobj As New DataObject()
Dim ms As MemoryStream
ms = CProcDataObject.MakeShellIDArray(toDrag)
With Dobj
If Not ms Is Nothing Then
.SetData("Shell IDList Array", True, ms)
End If
.SetData("FileDrop", True, strD)
.SetData(toDrag)
End With
Dim dEff As DragDropEffects
If e.Button = Windows.Forms.MouseButtons.Right Then
dEff = DragDropEffects.Copy Or DragDropEffects.Move Or DragDropEffects.Link
Else
dEff = DragDropEffects.Copy Or DragDropEffects.Move
End If
Dim res As DragDropEffects = .DoDragDrop(Dobj, dEff)
End If
End With
End Sub
#End Region
Private Sub lv1_DoubleClick(ByVal sender As Object, ByVal e As System.EventArgs) Handles lv1.DoubleClick
Dim csi As CShItem = lv1.SelectedItems(0).Tag
If csi.IsFolder Then
ExpTree1.ExpandANode(csi)
Else
Try
Process.Start(csi.Path)
Catch ex As Exception
MsgBox(ex.Message, MsgBoxStyle.OkOnly, "Error in starting application")
End Try
End If
End Sub
Private Sub txtDropOn_DragEnter(ByVal sender As Object, ByVal e As System.Windows.Forms.DragEventArgs) Handles txtDropOn.DragEnter
If e.Data.GetDataPresent("FileDrop", True) And _
((e.AllowedEffect And DragDropEffects.Copy) = DragDropEffects.Copy) Then
e.Effect = DragDropEffects.Copy
Else
e.Effect = DragDropEffects.None
End If
End Sub
Private Sub txtDropOn_DragDrop(ByVal sender As Object, ByVal e As System.Windows.Forms.DragEventArgs) Handles txtDropOn.DragDrop
Dim fList() As String = e.Data.GetData("FileDrop", True)
txtDropOn.Text = ""
Dim S As String
For Each S In fList
txtDropOn.Text += S & vbCrLf
Next
e.Effect = DragDropEffects.None
End Sub
Private Sub SAY(ByVal S As String)
txtDropOn.Text += S & vbCrLf
Debug.WriteLine(S)
End Sub
Private Sub mnuRefreshTree_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles mnuRefreshTree.Click
ExpTree1.RefreshTree()
End Sub
Private Sub mnuChangeRoot_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles mnuChangeRoot.Click
ExpTree1.RootItem = ExpTree1.SelectedItem
End Sub
Private Sub mnuSetToDesktop_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles mnuSetToDesktop.Click
ExpTree1.RootItem = CShItem.GetDeskTop
End Sub
#Region " Test Routines"
Private Sub mnuShowSpecial_Click(ByVal sender As System.Object, ByVal e As System.EventArgs)
Dim eNames() As String = [Enum].GetNames(GetType(ExpTree.StartDir))
Dim eNums() As ShellDll.CSIDL = [Enum].GetValues(GetType(ExpTree.StartDir))
Dim CSI As CShItem
Dim i As Integer
For i = 0 To eNames.Length - 1
Debug.WriteLine("Getting Item for -- " & eNames(i))
Try
CSI = New CShItem(eNums(i))
CSI.DebugDump() : CShItem.DumpPidl(CSI.PIDL)
Catch ex As Exception
Debug.WriteLine("Error on making new CShitem")
End Try
Debug.WriteLine("")
Next
End Sub
Private Sub mnuMakeDigest_Click(ByVal sender As System.Object, ByVal e As System.EventArgs)
Dim SR As New StreamReader("F:\DragNDropV4\LegalCSIDL.txt")
Dim SW As New StreamWriter("F:\DragNDropV4\LegalCSIDLDigest.txt", False)
Dim PidlOne As Boolean = False
Do While SR.Peek <> -1
Dim inp As String = SR.ReadLine()
Dim tInp As String = inp.Trim
If tInp.Length > 0 Then
If tInp.StartsWith("Getting") OrElse _
tInp.StartsWith("Error") OrElse _
tInp.StartsWith("DisplayName") OrElse _
tInp.StartsWith("Path") OrElse _
tInp.StartsWith("IsFileSystem") OrElse _
tInp.StartsWith("PIDL") OrElse _
tInp.StartsWith("TypeName") Then
SW.WriteLine(inp)
Debug.WriteLine(inp)
PidlOne = False
ElseIf tInp.StartsWith("ItemID #1") Then
PidlOne = True
SW.WriteLine(inp)
Debug.WriteLine(inp)
ElseIf tInp.StartsWith("ItemID") Then
SW.WriteLine(inp)
Debug.WriteLine(inp)
PidlOne = False
ElseIf PidlOne Then
SW.WriteLine(inp)
Debug.WriteLine(inp)
End If
End If
Loop
SR.Close()
SW.Close()
End Sub
Private Sub mnuTestcPidl_Click(ByVal sender As System.Object, ByVal e As System.EventArgs)
Dim CSI As CShItem = CShItem.GetDeskTop
dumpCPidl(CSI)
CSI = New CShItem(ShellDll.CSIDL.DESKTOPDIRECTORY)
dumpCPidl(CSI)
CSI = New CShItem("C:\Temp")
dumpCPidl(CSI)
CSI = New CShItem("F:\DragNDropV4\ClipSpy\src")
dumpCPidl(CSI)
CSI = New CShItem(ShellDll.CSIDL.NETHOOD)
dumpCPidl(CSI)
Dim b(14) As Byte
b(0) = 43
Debug.WriteLine("An Invalid Pidl Tests" & IIf(IsValidPidl(b), " IsValid", " Is NOT Valid"))
End Sub
Private Sub dumpCPidl(ByVal CSI As CShItem)
Dim cp As cPidl = CSI.clsPidl
Dim o() As Object = cp.Decompose
Debug.WriteLine(CSI.DisplayName)
DumpPidl(CSI.PIDL)
Dim b() As Byte
Dim i As Integer = 1
For Each b In o
Debug.Write("cPidl Item #" & i & IIf(IsValidPidl(b), " IsValid", " Is NOT Valid"))
DumpHex(b)
i += 1
Next
End Sub
Private Sub mnuTestFindCShItem_Click(ByVal sender As System.Object, ByVal e As System.EventArgs)
ExpTreeLib.Tests.TestFindCShItem()
End Sub
Private Sub MenuItem4_Click(ByVal sender As System.Object, ByVal e As System.EventArgs)
Dim xxx As CShItem = GetCShItem("C:\")
testJoinBytes(xxx)
xxx = GetCShItem(CType(GetDeskTop.GetItems()(3), CShItem).Path)
testJoinBytes(xxx)
Dim yyy As CShItem = GetCShItem(ShellDll.CSIDL.APPDATA)
xxx = CType(yyy.GetDirectories()(3), CShItem)
testJoinBytes(xxx)
End Sub
Private Sub testJoinBytes(ByVal xxx As CShItem)
Debug.WriteLine("Testing PIDL of -- " & xxx.DisplayName)
DumpPidl(xxx.PIDL)
Dim o() As Object = xxx.clsPidl.Decompose
Dim R() As Byte = o(0)
Debug.WriteLine("Joining Pidls, Step 0")
DumpHex(R)
Dim i As Integer
For i = 1 To o.Length - 1
R = cPidl.JoinPidlBytes(R, o(i))
Debug.WriteLine("Joining Pidls, Step " & i)
DumpHex(R)
Next
End Sub
#End Region
End Class
Dostları ilə paylaş: |