frmmain.frm

一个关于电脑管理汽车的软件

 If ExistBS = False Then
  VarInitData.InitBSE BSE1, 0
  VarInitData.InitBSE2 BSE21, 0
  VarInitData.InitString
 ' With Screen
 '  i = .Width / .TwipsPerPixelX
 '  If .Width / .TwipsPerPixelX > 800 Then
 '   frmMain.Picture = LoadPicture(App.Path & "\1024.jpg")
 '  Else
 '   frmMain.Picture = LoadPicture(App.Path & "\800.jpg")
 '  End If
 ' End With
  PicHdc(0).Picture = LoadPicture(App.Path & "\1024.jpg")
  'SureBackPicSize
  VarPic.CreateFormPic Me, PicHdc(0), PicHdc(1), True
  'PicHdc(0).Width = 0
  With status
   .Panels(2).Text = "操作员：" & CurrentOperate
   .Panels(3).Text = Date & "    " & "星期" & VarInitData.SureWeekDay & "    " & "启动时间：" & Time
  End With
  Set cP = New cPopupMenu
  ' Make sure you set this up before trying any menus
  cP.hWndOwner = Me.hWnd
  
  ' Make sure the ImageList has icons before setting
  ' this if it is a MS ImageList:
  cP.ImageList = ilsIcons16
  cP.HeaderStyle = ecnmHeaderSeparator
  cP.GradientHighlight = True
  ' Create some menus and store them:
  createMenus
  '  chkVisual(2).Value = Checked
  '  chkVisual(5).Value = Checked
  picSideBar.Height = 3000
    With MenuHeadColor
      ' .DrawingObject = picSideBar
       .StartColor = &H3399&
       .EndColor = &H0&
       .Caption = "进 销 存"
       ilsIcons16.ListImages(1).Draw 0, 0, 0
       .hImageList = ilsIcons16.hImageList
       .IconIndex = 12
     '  .Draw
    End With
    VarInitData.InitSQLStr
    SystemSet.LoadData True
    ExistBS = True
    VarCrystal.DispalyTestReport
 End If
End Sub

Private Sub MDIForm_QueryUnload(Cancel As Integer, UnloadMode As Integer)
    Select Case UnloadMode
        Case vbFormControlMenu
            If MsgBox("      确定退出吗？", vbOKCancel, VarInitData.SysPrompt) = vbCancel Then
              Cancel = 1
            End If
        Case vbFormCode
          
    End Select
End Sub

Private Sub MDIForm_Resize()
 'If Me.WindowState = 2 Then
  VarPic.CreateFormPic Me, PicHdc(0), PicHdc(1), True
 'End If
End Sub

Private Sub MDIForm_Unload(Cancel As Integer)
 If ChangeOperateBS = False Then
  If Not gCnn Is Nothing Then
   'If MsgBox("      确定退出吗？", vbOKCancel, VarInitData.SysPrompt) = vbOK Then
    ExitJXC
   'Else
   ' Cancel = True
   'End If
  End If
 Else
  ChangeOperateBS = False
  gCnn.CloseConnection
  Set gCnn = Nothing
  oCnn.Close
  Set oCnn = Nothing
 ' ExitJXC
  Cancel = True
 End If
End Sub

Private Sub createMenus()
Dim i As Long
Dim j As Long
Dim K As Long
Dim l As Long
Dim iIndex As Long
Dim lIcon As Long
Dim sKey As String
Dim sCap As String
   
   ' Create the Maintenance menu:
        With cP
         .Clear
         .AddItem "更换操作员", , , , 1
         .OwnerDraw(.Count) = True
         .AddItem "-"
         .OwnerDraw(.Count) = True
         .AddItem "操作员设置", , , , 2
         .OwnerDraw(.Count) = True
         .AddItem "工作人员设置", , , , 3
         .OwnerDraw(.Count) = True
         .AddItem "系统设置", , , , 4
         .OwnerDraw(.Count) = True
         .AddItem "-"
         .OwnerDraw(.Count) = True
         .AddItem "退出系统", , , , 5
         .OwnerDraw(.Count) = True
         .Store "Maintenance"
      
      ' create a customise menu
      .Clear
         .AddItem "零件基本数据设置"
         .OwnerDraw(.Count) = True
         .AddItem "货品资料设置"
         .OwnerDraw(.Count) = True
         .AddItem "词组简码设置"
         .OwnerDraw(.Count) = True
         .AddItem "-"
         .OwnerDraw(.Count) = True
         .AddItem "维修基本数据设置"
         .OwnerDraw(.Count) = True
         .AddItem "维修项目设置"
         .OwnerDraw(.Count) = True
         .AddItem "附加项目设置"
         .OwnerDraw(.Count) = True
         .AddItem "-"
         .OwnerDraw(.Count) = True
         .AddItem "供应商资料设置"
         .OwnerDraw(.Count) = True
         .AddItem "客户资料设置"
         .OwnerDraw(.Count) = True
         .AddItem "客户需求信息"
         .OwnerDraw(.Count) = True
         .AddItem "-"
         .OwnerDraw(.Count) = True
         .AddItem "车辆档案"
         .OwnerDraw(.Count) = True
         .AddItem "通讯录"
         .OwnerDraw(.Count) = True
      .Store "Data"
      
      
      ' Create the Stock menu:
      .Clear
         .AddItem "进货单"
         .OwnerDraw(.Count) = True
         .AddItem "进货退货处理"
         .OwnerDraw(.Count) = True
         .AddItem "-"
         .OwnerDraw(.Count) = True
         .AddItem "进（退）货历史单据"
         .OwnerDraw(.Count) = True
      .Store "StockTable"
      
      ' 创建库存菜单
      .Clear
         .AddItem "库存汇总"
         .OwnerDraw(.Count) = True
         .AddItem "库存盘点单"
         .OwnerDraw(.Count) = True
         .AddItem "-"
         .OwnerDraw(.Count) = True
         .AddItem "盘点修改历史单"
         .OwnerDraw(.Count) = True
      .Store "StoreGoods"
      
      .Clear
         .AddItem "销售单"
         .OwnerDraw(.Count) = True
         .AddItem "报价单"
         .OwnerDraw(.Count) = True
         .AddItem "-"
         .OwnerDraw(.Count) = True
         .AddItem "维修件领用单"
         .OwnerDraw(.Count) = True
         .AddItem "-"
         .OwnerDraw(.Count) = True
         .AddItem "销售退货处理"
         .OwnerDraw(.Count) = True
         .AddItem "-"
         .OwnerDraw(.Count) = True
         .AddItem "销售历史单"
         .OwnerDraw(.Count) = True
      .Store "SellTable"
      
      .Clear
         .AddItem "前台接车管理"
         .OwnerDraw(.Count) = True
         .AddItem "-"
         .OwnerDraw(.Count) = True
         .AddItem "施工项目作业"
         .OwnerDraw(.Count) = True
         .AddItem "-"
         .OwnerDraw(.Count) = True
         .AddItem "维修单结算"
         .OwnerDraw(.Count) = True
         .AddItem "-"
         .OwnerDraw(.Count) = True
         .AddItem "维修档案"
         .OwnerDraw(.Count) = True
      .Store "Maintain"
      
      .Clear
         .AddItem "每日统计"
         .OwnerDraw(.Count) = True
         .AddItem "-"
         .OwnerDraw(.Count) = True
         .AddItem "货物综合参考表"
         .OwnerDraw(.Count) = True
         .AddItem "销售业务综合统计"
         .OwnerDraw(.Count) = True
         .AddItem "进货业务综合统计"
         .OwnerDraw(.Count) = True
         .AddItem "库存无动态分析"
         .OwnerDraw(.Count) = True
         .AddItem "进销存报表"
         .OwnerDraw(.Count) = True
         .AddItem "-"
         .OwnerDraw(.Count) = True
         .AddItem "客户挂帐分析"
         .OwnerDraw(.Count) = True
         .AddItem "库存报警"
         .OwnerDraw(.Count) = True
         .AddItem "维修统计"
         .OwnerDraw(.Count) = True
      .Store "Stat"
      
       .Clear
        ' .AddItem "帐目管理"
        ' .OwnerDraw(.Count) = True
        ' .AddItem "-"
        ' .OwnerDraw(.Count) = True
         .AddItem "客户往来帐管理"
         .OwnerDraw(.Count) = True
         .AddItem "月度报表"
         .OwnerDraw(.Count) = True
        ' .AddItem "-"
        ' .OwnerDraw(.Count) = True
        ' .AddItem "帐务简要设置"
        ' .OwnerDraw(.Count) = True
      .Store "Account"
   
   End With
   
End Sub



Private Sub menuAll_Click(Index As Integer)
Dim iIndex As Long
 Dim TempCount As Long
 Dim i As Long
 Dim lHeight As Long
 Dim TempBase As Long
   With cP
      'If Not .CurrentlyRestoredKey = "Demo" Then
       Select Case Index
         Case 0
          .Restore "Maintenance"
          TempCount = .Count
          For i = 1 To TempCount
           If .hMenu(i) = .hMenu(1) Then
            lHeight = lHeight + .MenuItemHeight(i)
           End If
          Next i
         Case 2
          .Restore "Data"
          TempCount = .Count
          For i = 1 To TempCount
           If .hMenu(i) = .hMenu(1) Then
            lHeight = lHeight + .MenuItemHeight(i)
           End If
          Next i
         Case 4
          .Restore "StockTable"
          TempCount = .Count
          For i = 1 To TempCount
           If .hMenu(i) = .hMenu(1) Then
            lHeight = lHeight + .MenuItemHeight(i)
           End If
          Next i
         Case 6
          .Restore "StoreGoods"
          TempCount = .Count
          For i = 1 To TempCount
           If .hMenu(i) = .hMenu(1) Then
            lHeight = lHeight + .MenuItemHeight(i)
           End If
          Next i
         Case 8
          .Restore "SellTable"
          TempCount = .Count
          For i = 1 To TempCount
           If .hMenu(i) = .hMenu(1) Then
            lHeight = lHeight + .MenuItemHeight(i)
           End If
          Next i
         Case 10
          .Restore "Maintain"
          TempCount = .Count
          For i = 1 To TempCount
           If .hMenu(i) = .hMenu(1) Then
            lHeight = lHeight + .MenuItemHeight(i)
           End If
          Next i
         Case 12
          .Restore "Stat"
          TempCount = .Count
          For i = 1 To TempCount
           If .hMenu(i) = .hMenu(1) Then
            lHeight = lHeight + .MenuItemHeight(i)
           End If
          Next i
         Case 14
          .Restore "Account"
          TempCount = .Count
          For i = 1 To TempCount
           If .hMenu(i) = .hMenu(1) Then
            lHeight = lHeight + .MenuItemHeight(i)
           End If
          Next i
       End Select
       picSideBar.Height = lHeight * Screen.TwipsPerPixelY + 100
       With MenuHeadColor
        .DrawingObject = picSideBar
        .Draw
       End With
      'End If
      If Len(frmMain.Caption) > 12 Then
       TempBase = 700
      Else
       TempBase = 400
      End If
      TempCount = Index \ 2
      TempCount = TempBase + TempCount * 800
      iIndex = .ShowPopupMenu(TempCount, 0)
   End With
End Sub
Private Sub ExitJXC()
 gCnn.CloseConnection
 Set gCnn = Nothing
 oCnn.Close
 Set oCnn = Nothing
 If BSE1.EngineStarted Then BSE1.EndSubClassing
 End
 
End Sub
Private Sub SureBackPicSize()
 Dim OrgWidth As Long, OrgHeight As Long
 Dim DeWidth As Long, DeHeight As Long
     Dim hNew As Long
    DeWidth = frmMain.Width '/ Screen.TwipsPerPixelX
    DeHeight = frmMain.Height '/ Screen.TwipsPerPixelY
    'create an exact copy of the picture
  '  hNew = CopyImage(LoadPicture(App.Path & "\1024.jpg"), IMAGE_BITMAP, 0, 0, LR_COPYRETURNORG)
    'open the clipboard
  '  OpenClipboard Me.hwnd
    'clear the clipboard
 '   EmptyClipboard
    'put the picture on the clipboard
 '   SetClipboardData CF_BITMAP, hNew
    'close the clipboard
 '   CloseClipboard
    'note that we don't have to call DeleteObject(hNew)
    'from now on, the clipboard takes care of the bitmap

 
 'Me.Picture.Width = frmMain.Width '/ Screen.TwipsPerPixelX
' Me.Picture.Height = frmMain.Height ' / Screen.TwipsPerPixelY
 'OrgWidth = frmMain.Picture.Width / Screen.TwipsPerPixelX
 'OrgWidth = frmMain.Picture.Height / Screen.TwipsPerPixelY
 'DeWidth = frmMain.Width / Screen.TwipsPerPixelX
 'DeHeight = frmMain.Height / Screen.TwipsPerPixelY
 'StretchBlt frmMain.Picture, 0, 0, DeWidth, DeHeight, Me.hd, 0, 0, OrgWidth, OrgHeight, ScrCopy
End Sub