area.frm

来自「This application i made for handle simpl」· FRM 代码 · 共 242 行

VERSION 5.00
Object = "{831FDD16-0C5C-11D2-A9FC-0000F8754DA1}#2.0#0"; "mscomctl.ocx"
Begin VB.Form frmArea 
   BackColor       =   &H00FBF7F4&
   Caption         =   "Area"
   ClientHeight    =   6300
   ClientLeft      =   60
   ClientTop       =   345
   ClientWidth     =   10575
   BeginProperty Font 
      Name            =   "Verdana"
      Size            =   8.25
      Charset         =   0
      Weight          =   400
      Underline       =   0   'False
      Italic          =   0   'False
      Strikethrough   =   0   'False
   EndProperty
   Icon            =   "Area.frx":0000
   LockControls    =   -1  'True
   MDIChild        =   -1  'True
   ScaleHeight     =   420
   ScaleMode       =   3  'Pixel
   ScaleWidth      =   705
   WindowState     =   2  'Maximized
   Begin MSComctlLib.ImageList imgList 
      Left            =   9750
      Top             =   5475
      _ExtentX        =   1005
      _ExtentY        =   1005
      BackColor       =   -2147483643
      ImageWidth      =   16
      ImageHeight     =   14
      MaskColor       =   14480885
      _Version        =   393216
      BeginProperty Images {2C247F25-8591-11D1-B16A-00C0F0283628} 
         NumListImages   =   1
         BeginProperty ListImage1 {2C247F27-8591-11D1-B16A-00C0F0283628} 
            Picture         =   "Area.frx":0EBA
            Key             =   ""
         EndProperty
      EndProperty
   End
   Begin MSComctlLib.ListView lvArea 
      Height          =   6015
      Left            =   150
      TabIndex        =   0
      Top             =   150
      Width           =   10290
      _ExtentX        =   18150
      _ExtentY        =   10610
      View            =   3
      LabelEdit       =   1
      LabelWrap       =   -1  'True
      HideSelection   =   0   'False
      FullRowSelect   =   -1  'True
      GridLines       =   -1  'True
      _Version        =   393217
      SmallIcons      =   "imgList"
      ForeColor       =   -2147483640
      BackColor       =   -2147483643
      BorderStyle     =   1
      Appearance      =   0
      NumItems        =   0
   End
End
Attribute VB_Name = "frmArea"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit

Private lx As MSComctlLib.ListItem
Public sMenu As SelectedSubMenu


Private Sub Form_Activate()

  lastColumnIndex = 0
  mdiDefault.ihdDefault.Text = Me.Caption

End Sub

Private Sub Form_Load()

  sMenu = SelectedSubMenu.None
  Call SetHeader

  Call FillArea
  Call ResetMenu

End Sub

Private Sub Form_Unload(Cancel As Integer)

  mdiDefault.tmrClose.Enabled = True

End Sub

Private Sub Form_Resize()
On Error Resume Next

  lvArea.Width = Me.ScaleWidth - 20
  lvArea.Height = Me.ScaleHeight - 20

End Sub

Private Sub SetHeader()

  With lvArea.ColumnHeaders
    Call .Add(, , "Kode", 50)
    Call .Add(, , "Nama Area", 250)
  End With

End Sub

Private Sub lvArea_ColumnClick(ByVal ColumnHeader As MSComctlLib.ColumnHeader)

  Call SortColumn(lvArea, ColumnHeader.Index)

End Sub

Private Sub lvArea_KeyDown(KeyCode As Integer, Shift As Integer)

  If ((KeyCode = 93) Or ((Shift = 1) And (KeyCode = 121))) Then

    sMenu = SelectedSubMenu.None

    Call PopupMenu(mdiDefault.mnArea, , lvArea.Left + 5, lvArea.Top + 10)
    Call ShowSelectedForm

  End If

End Sub

Private Sub ResetMenu()

  If (lvArea.ListItems.Count = 0) Then
    mdiDefault.mnSubArea(1).Enabled = False
    mdiDefault.mnSubArea(2).Enabled = False
  Else
    mdiDefault.mnSubArea(1).Enabled = True
    mdiDefault.mnSubArea(2).Enabled = True
  End If

End Sub

Private Sub FillArea()
On Error GoTo NoAccout

  Call lvArea.ListItems.Clear

  comm.CommandText = "select * from AreaView;"
  comm.CommandType = CommandTypeEnum.adCmdText

  Call conn.Open
  comm.ActiveConnection = conn

    Set rs = comm.Execute()

    Do While (Not (rs.EOF()))
      Set lx = lvArea.ListItems.Add(, , CStr(rs("IdArea")), , 1)
        Call lx.ListSubItems.Add(, , CStr(rs("NamaArea")))
      Call rs.MoveNext
    Loop

  Call conn.Close

Exit Sub
NoAccout:

  Call CloseConnection(Err)

End Sub

Private Sub lvArea_MouseUp(Button As Integer, Shift As Integer, x As Single, y As Single)

  If (Button = 2) Then

    sMenu = SelectedSubMenu.None

    Call PopupMenu(mdiDefault.mnArea)
    Call ShowSelectedForm

  End If

End Sub

Private Sub ShowSelectedForm()

  Select Case (sMenu)
  Case (SelectedSubMenu.Add)
    Call frmAreaAddEdit.Show(1, mdiDefault)

  Case (SelectedSubMenu.Delete)
    Call AreaRemove(lvArea.SelectedItem.Text)
    Call lvArea.SetFocus

  Case (SelectedSubMenu.Edit)
    Call frmAreaAddEdit.Show(1, mdiDefault)

  Case (SelectedSubMenu.Refresh)
    Call FillArea

  End Select

  Call ResetMenu

End Sub

Private Sub AreaRemove(ByVal nKode As String)
On Error GoTo NoRemove

  If (Question(LoadResString(2)) = vbNo) Then
    Exit Sub
  End If

  comm.CommandText = "AreaRemove"
  comm.CommandType = CommandTypeEnum.adCmdStoredProc

  Call comm.Parameters.Append(comm.CreateParameter("@code", DataTypeEnum.adChar, , 3, nKode))

  Call conn.Open
  comm.ActiveConnection = conn

    Call comm.Execute

  Call ClearParameter(comm)
  Call conn.Close

  Call lvArea.ListItems.Remove(lvArea.SelectedItem.Index)

Exit Sub
NoRemove:

  Call CloseConnection(Err)

End Sub