本人以前在国内是从事ASP网站工作的,前2个月申请来新工作.用的是VB语言.因为大学只用了一点点VB,所以现在遇到了困难.恳请大家帮个忙.老板给我的工作是要我做一个餐厅桌子方面的模块
(1:大厅桌子排列,不同的状态用不一样的图片显示.(每日经理可以允许对桌子进行重新排列(桌子可以移动)).
一桌可以多人坐(一桌多单).一单多桌(合单).)VB+ACCESS/MYSQL的.已经2个月了.现在我是一点头绪也没有,在CSDN希望能有人帮我.谢谢大家!
(1:大厅桌子排列,不同的状态用不一样的图片显示.(每日经理可以允许对桌子进行重新排列(桌子可以移动)).
一桌可以多人坐(一桌多单).一单多桌(合单).)VB+ACCESS/MYSQL的.已经2个月了.现在我是一点头绪也没有,在CSDN希望能有人帮我.谢谢大家!
临时应急关键词：form/picture/imgage/rgn/dragdrop
给主form一个俯拍的餐厅图做背景图，用picture放桌子图片，image或picture放客户图片，实现拖拽移动以后有时间慢慢搞：
---MDI窗口做餐厅，子窗口做桌子（可以做异形窗口完全呈现桌子形状）
或者用一个普通FORM做父窗口，其他的“桌子”窗口全部用setParent成为其子窗口，这样移动问题就不用考虑了
。
ImageList控件先在imagelist中添加好图片~双击listview的自定义。之后在属性页中设置图象列表由无改成imagelist1最后用ListView1.ListItems.Add , , "项目名字", 1来增加项目就或以了 后面的1是代码imagelist1里的图标编号提问人的追问 2009-05-23 10:39 谢谢,这次程序没有报错了~~~但是为什么我还是不能显示图片呢?
回答人的补充 2009-05-23 14:01 应 不会不显示图片的呀..会不会是你把view属性改了呢..选中listview控件.之后在右边的属性页里把view改成0
2:每天经理都可以对餐厅的桌子进行重新排列.
3:餐厅要随时刷新餐厅桌子状态.
设计要求:1:建数据库表site(桌子ID,桌子名称number,包厢费price,状态sitestatus(0表示空闲,1表示使用,2表示预定),菜单价格totalprice)
2:通过判断桌子状态sitestatus的值
If optSelect(1).Value = True Then sWhere = " Where SiteStatus like = '%0%'",来显示.
3.界面美观.图片真实(个人觉的是用2个FRAME来实现(一个装查询条件(opt),一个装显示图片的控件(picturebox)))
个人感觉跟QQ游戏里面有点相同,用图片控件来实现(不过我不会).郁闷中!!
新加坡客户要求一大堆...自己水平不够呀.
数据库设计：(桌子ID,桌子名称number,包厢费price,状态sitestatus(0表示空闲,1表示使用,2表示预定),菜单价格totalprice)
现在先能做到这个就可以了，其他的那些以后慢慢来做。
Option Explicit
Dim cX As Long
Dim cY As LongPrivate Sub Form_DragDrop(Source As Control, X As Single, Y As Single)
Source.Move X - cX, Y - cY
End SubPrivate Sub Picture1_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
Picture1.Drag 1
cX = X: cY = Y
End SubPrivate Sub Picture1_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
Picture1.Drag 2
End Sub
2、支持用户手工移动桌子的位置（排列桌子）第一部分是比较简单的。你就在数据库里记录桌子的状态，每次用户更改了桌子的状态后你实时更新数据和显示就可以了。第二部分初看起来有点麻烦。相当于你要实现一个类似VISIO那样的画图程序，用户可以把里面的形状拖来拖去。不过的话，也许你可以用控件数组或者控件类来实现多个桌子，这样你只要写好一个桌子的拖拽代码就好了。设计时先手工做一个和饭店内部格局的底图作为form的底图，然后在上面放上等比例缩放的桌子image.我开发经验很少，说的不一定对，供你参考。
Private Sub Timer1_Timer()
yibiao_weizhi(0) = Picture1.Top
yibiao_weizhi(1) = Picture1.Left
yibiao_weizhi(2) = Picture2.Top
yibiao_weizhi(3) = Picture2.Left
Open App.Path & "\data.txt" For Output As #1
For main_i = 0 To 3
Write #1, yibiao_weizhi(main_i)
Next
Close
Timer1.Enabled = False
End SubPrivate Sub Form_Load()
frmYibiao.Show
frmYibiao.Width = Me.ScaleWidth
frmYibiao.Height = Me.ScaleHeight
frmYibiao.Top = 0
frmYibiao.Left = 0
On Error GoTo uerror
Open App.Path & "\data.txt" For Input As #1
For main_i = 0 To 3
Input #1, yibiao_weizhi(main_i)
Next
Close
Picture1.Top = yibiao_weizhi(0)
Picture1.Left = yibiao_weizhi(1)
Picture2.Top = yibiao_weizhi(2)
Picture2.Left = yibiao_weizhi(3)
Exit Sub
uerror:
End Sub
Option ExplicitDim cX As Long, cY As LongPrivate Type PointAPI
X As Long
Y As Long
End TypePrivate mbActive As Boolean
Private mlCurThumb As Long
Private Const SRCCOPY As Long = &HCC0020
Private Const STRETCH_HALFTONE As Long = &H4&
Private Const SW_RESTORE As Long = &H9&Private Declare Function CreateSolidBrush Lib "gdi32" (ByVal crColor As Long) As Long
Private Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long
Private Declare Function SelectObject Lib "gdi32" (ByVal hdc As Long, ByVal hObject As Long) As Long
Private Declare Function SetBrushOrgEx Lib "gdi32" (ByVal hdc As Long, ByVal nXOrg As Long, ByVal nYOrg As Long, lpPt As PointAPI) As Long
Private Declare Function SetStretchBltMode Lib "gdi32" (ByVal hdc As Long, ByVal nStretchMode As Long) As Long
Private Declare Function StretchBlt Lib "gdi32" (ByVal hdc As Long, ByVal X As Long, ByVal Y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal hSrcDC As Long, ByVal xSrc As Long, ByVal ySrc As Long, ByVal nSrcWidth As Long, ByVal nSrcHeight As Long, ByVal dwRop As Long) As Long
Private Declare Function UnrealizeObject Lib "gdi32" (ByVal hObject As Long) As Long
Private Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" (ByVal Hwnd As Long, ByVal lpOperation As String, ByVal lpFile As String, ByVal lpParameters As String, ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long
'´òÓ¡×ÖÄ»
Private Declare Function TextOut& Lib "gdi32" Alias "TextOutA" (ByVal hdc As Long, ByVal X As Long, ByVal Y As Long, ByVal lpString As String, ByVal nCount As Long)Dim lCount As Long 'ͼƬ×ÜÊý
Dim sWhere As String 'Ìõ¼þ×Ö·û´®Private Sub cmdClose_Click()
Unload Me
End SubPrivate Sub Form_DragDrop(Source As Control, X As Single, Y As Single)
Source.Move X - cX, Y - cY
End SubPrivate Sub Form_Load()
On Error Resume Next
picFrame.Visible = False
If optSelect(0).Value = True Then sWhere = ""
If optSelect(1).Value = True Then sWhere = " Where SiteStatus like = '%0%'"
If optSelect(2).Value = True Then sWhere = " Where SiteStatus like = '%1%'"
If optSelect(3).Value = True Then sWhere = " Where SiteStatus like = '%2%'"
Me.MousePointer = 11
Browse 'ä¯ÀÀ²Í×À
Me.MousePointer = 0
End SubPublic Sub Form_Resize()
If Me.ScaleWidth > 0 Then
Frame1.Width = Me.ScaleWidth - 6
cmdClose.Left = Me.Width - cmdClose.Width - 320
If Me.Width < 346 * Screen.TwipsPerPixelX Then
Me.Width = 346 * Screen.TwipsPerPixelX
ElseIf Me.Height < 378 * Screen.TwipsPerPixelY Then
Me.Height = 378 * Screen.TwipsPerPixelY
Else
End If
End If
End SubPrivate Sub optSelect_Click(Index As Integer) On Error Resume Next
'ËùÓв˵¥ÎÞЧ
mnuBookthis.Enabled = False
mnuCancelBook.Enabled = False
mnuViewBOOK.Enabled = False
mnuInfo.Enabled = False
mnuTable.Enabled = False
mnuCheckOut.Enabled = False
mnuChange.Enabled = False
Select Case Index
Case 0
sWhere = ""
Case 1
sWhere = " Where SiteStatus=0"
Case 2
sWhere = " Where SiteStatus=1"
Case 3
sWhere = " Where SiteStatus=2"
End Select
'Ë¢ÐÂÅÅÁÐ
Me.MousePointer = 11
Browse 'ä¯ÀÀ²Í×À
Me.MousePointer = 0
Call Form_ResizeEnd SubPrivate Sub optThumb_DragDrop(Index As Integer, Source As Control, X As Single, Y As Single)
Source.Move X + optThumb(Index).Left - cX, Y + optThumb(Index).Top - cY
End Sub'Private Sub optThumb_Click(Index As Integer)
'
' On Error Resume Next
' mnuBookthis.Enabled = False
' mnuTable.Enabled = False
' mnuInfo.Enabled = False
' mnuCheckOut.Enabled = False
' mnuChange.Enabled = False
' mnuViewBOOK.Enabled = False
' mnuCancelBook.Enabled = False
' mnuCopy.Enabled = False
' mnuMaintenans.Enabled = False
' mnuCancelMaintenans.Enabled = False
' mnuClean.Enabled = False
' mnuOpen.Enabled = False
'
' Select Case Left(optThumb(Index).Tag, 1)
' 'Ô¤¶©²Ù×÷........................................
' Case "1"
' mnuViewBOOK.Enabled = True
' mnuTable.Enabled = True
' mnuCancelBook.Enabled = True
' mnuOpen.Enabled = True
' mnuBookthis.Enabled = True
' 'ʹÓÃÖÐ...........................................
' Case "2"
' mnuBookthis.Enabled = True
' mnuInfo.Enabled = True
' mnuCheckOut.Enabled = True
' mnuChange.Enabled = True
' mnuCopy.Enabled = True
' mnuClean.Enabled = True
' mnuTable.Enabled = True
' '¿ÕÏÐ...........................................¿ÕÏÐʱ£¬²ÅÄÜÉèÖÃΪάÐÞ״̬.
' Case "0"
' mnuBookthis.Enabled = True
' mnuTable.Enabled = True
' mnuMaintenans.Enabled = True
' mnuOpen.Enabled = True
' '»Ö¸´Î¬ÐÞµÄ×ÀºÅΪÕý³£
' Case "4"
' mnuCancelMaintenans.Enabled = True
' 'ÒѾ½áÕÊ£¬µ«ÊÇûÓÐÀë×Àʱ
' Case "3"
' mnuClean.Enabled = True
' Case Else
' End Select
' '¸ø³ö×ùλID
' 'sPubSite = GetBookID(optThumb(Index).Tag)
'
' 'ÏÔʾ²Ù×÷²Ëµ¥
' PopupMenu mnuBook
'
'End Sub
optThumb(Index).Drag 1
cX = X: cY = Y
If Button = 2 Then
mnuBookthis.Enabled = False
mnuTable.Enabled = False
mnuInfo.Enabled = False
mnuCheckOut.Enabled = False
mnuChange.Enabled = False
mnuViewBOOK.Enabled = False
mnuCancelBook.Enabled = False
mnuCopy.Enabled = False
mnuMaintenans.Enabled = False
mnuCancelMaintenans.Enabled = False
mnuClean.Enabled = False
mnuOpen.Enabled = False Select Case Left(optThumb(Index).Tag, 1)
'Ô¤¶©²Ù×÷........................................
Case "1"
mnuViewBOOK.Enabled = True
mnuTable.Enabled = True
mnuCancelBook.Enabled = True
mnuOpen.Enabled = True
mnuBookthis.Enabled = True
'ʹÓÃÖÐ...........................................
Case "2"
mnuBookthis.Enabled = True
mnuInfo.Enabled = True
mnuCheckOut.Enabled = True
mnuChange.Enabled = True
mnuCopy.Enabled = True
mnuClean.Enabled = True
mnuTable.Enabled = True
'¿ÕÏÐ...........................................¿ÕÏÐʱ£¬²ÅÄÜÉèÖÃΪάÐÞ״̬.
Case "0"
mnuBookthis.Enabled = True
mnuTable.Enabled = True
mnuMaintenans.Enabled = True
mnuOpen.Enabled = True
'»Ö¸´Î¬ÐÞµÄ×ÀºÅΪÕý³£
Case "4"
mnuCancelMaintenans.Enabled = True
'ÒѾ½áÕÊ£¬µ«ÊÇûÓÐÀë×Àʱ
Case "3"
mnuClean.Enabled = True
Case Else
End Select
'¸ø³ö×ùλID
'sPubSite = GetBookID(optThumb(Index).Tag)
'ÏÔʾ²Ù×÷²Ëµ¥
PopupMenu mnuBook
End If
End SubPrivate Sub optThumb_MouseUp(Index As Integer, Button As Integer, Shift As Integer, X As Single, Y As Single)
optThumb(Index).Drag 2
End Sub
Private Sub vsbSlide_Change() On Error Resume Next
'picSlide.Top = -vsbSlide.Value
picFrame.SetFocus
End SubPrivate Sub vsbSlide_Scroll() On Error Resume Next vsbSlide_ChangeEnd SubPublic Sub Browse()
On Error GoTo GetERR
'·ÅÖÃͼƬ
lCount = 0
Dim EF As Recordset, HH As Integer
Set EF = CreateObject("ADODB.Recordset")
EF.Open "Select Count(*) From SiteType" & sWhere, DB, adOpenStatic, adLockReadOnly, adCmdText
If EF.EOF And EF.BOF Then 'ûÓвúƷʱ
EF.Close
Set EF = Nothing
'´ò¿ªÍ¼Æ¬
CreateThumbs
'MsgBox "ûÓÐÕÒµ½ÓÐЧ×ùλ(²Í×À),ÇëÔÚ»ù±¾ÅäÖÃÖÐÉèÖúó¼ÌÐø£¿ ", vbInformation, "Design By jj."
Exit Sub
Else
lCount = EF.Fields(0)
If lCount = 0 Then
EF.Close
Set EF = Nothing
'´ò¿ªÍ¼Æ¬
CreateThumbs
Exit Sub
Else
EF.Close
Set EF = Nothing
'´ò¿ªÍ¼Æ¬
CreateThumbs
End If
End If
Exit Sub
GetERR:
MsgBox "¸ø³ö²Í×ÀÁбí´íÎó:" & Err.Description & vbCrLf & vbCrLf _
& "Çë¹Ø±Õä¯ÀÀ´°¿Ú,ÖØдò¿ªÊÔÊÔ¡£ ", vbCritical
Exit Sub
End SubPrivate Sub CreateThumbPic(picSource As PictureBox, picThumb As PictureBox) Dim lRet As Long
Dim lLeft As Long
Dim lTop As Long
Dim lWidth As Long
Dim lHeight As Long
Dim lForeColor As Long
Dim hBrush As Long
Dim hDummyBrush As Long
Dim lOrigMode As Long
Dim fScale As Single
Dim uBrushOrigPt As PointAPI picThumb.Width = 64
picThumb.Height = 64
picThumb.BackColor = vbButtonFace
picThumb.AutoRedraw = True
picThumb.Cls
If picSource.Width <= picThumb.Width - 2 And picSource.Height <= picThumb.Height - 2 Then
fScale = 1
Else
fScale = IIf(picSource.Width > picSource.Height, (picThumb.Width - 2) / picSource.Width, (picThumb.Height - 2) / picSource.Height)
End If
lWidth = picSource.Width * fScale
lHeight = picSource.Height * fScale
lLeft = Int((picThumb.Width - lWidth) / 2)
lTop = Int((picThumb.Height - lHeight) / 2)
lForeColor = picThumb.ForeColor
lOrigMode = SetStretchBltMode(picThumb.hdc, STRETCH_HALFTONE)
hDummyBrush = CreateSolidBrush(lForeColor)
hBrush = SelectObject(picThumb.hdc, hDummyBrush)
lRet = UnrealizeObject(hBrush)
lRet = SetBrushOrgEx(picThumb.hdc, lLeft, lTop, uBrushOrigPt)
hDummyBrush = SelectObject(picThumb.hdc, hBrush)
'ÀÉìͼƬ
lRet = StretchBlt(picThumb.hdc, lLeft, lTop, lWidth, lHeight, _
picSource.hdc, 0, 0, picSource.Width, picSource.Height, SRCCOPY)
lRet = SetStretchBltMode(picThumb.hdc, lOrigMode)
hBrush = SelectObject(picThumb.hdc, hDummyBrush)
lRet = UnrealizeObject(hBrush)
lRet = SetBrushOrgEx(picThumb.hdc, uBrushOrigPt.X, uBrushOrigPt.Y, uBrushOrigPt)
hDummyBrush = SelectObject(picThumb.hdc, hBrush)
lRet = DeleteObject(hDummyBrush)
picThumb.ForeColor = lForeColor
picThumb.Line (lLeft - 1, lTop - 1)-Step(lWidth + 1, lHeight + 1), &H0&, B
End Sub
On Error Resume Next
Dim iMaxLen As Integer
Dim X As Long
Dim Y As Long
Dim lIdx As Long
Dim lPicCnt As Long
Dim lFilCnt As Long
Dim sPath As String
Dim sText As String Dim HH As Integer
Set EF = New ADODB.Recordset
EF.Open "Select * From SiteType" & sWhere & " Order By Class ASC", DB, adOpenStatic, adLockReadOnly, adCmdText
'picSlide.Move 0, 0, optThumb(0).Width, optThumb(0).Height
'picSlide.Visible = False
'picSlide.BackColor = vbButtonFace
'Set picSlide.Font = optThumb(0).Font
While optThumb.Count > 1
Unload optThumb(optThumb.Count - 1)
Wend
DoEvents
Dim retVal As Long
On Error Resume Next
If EF.EOF Then
MsgBox "δÕÒµ½Êý¾Ý£¡", vbExclamation, "Ìáʾ£º"
Exit Sub
End If
lFilCnt = lCount
Dim sPD, sPN
If lCount > 0 Then
Call StartProgress
Dim sFieldValue As String
For lIdx = 0 To lCount - 1
'Ãû³Æ
sPD = EF.Fields("Class")
'װͼƬ
Call UpdateProgress((CSng(lIdx + 1) / CSng(lFilCnt)) * 100, sFieldValue)
Set picLoad.Picture = LoadPicture()
picLoad.Cls
Err.Clear
Select Case EF("SiteStatus")
Case 0
picLoad.Picture = picIde.Picture
Case 1
picLoad.Picture = PicBook.Picture
Case 2
picLoad.Picture = PicBusy.Picture
Case 3
picLoad.Picture = picCheck.Picture
Case 4
picLoad.Picture = picMaintenance.Picture
End Select
If Err.Number = 0 Then
Call CreateThumbPic(picLoad, picThumb)
'д×ÀºÅ
retVal = TextOut(picThumb.hdc, 3, 2, sPD, LenB(StrConv(sPD, vbFromUnicode)))
If lPicCnt > 0 Then
Load optThumb(lPicCnt)
'Set optThumb(lPicCnt).Container = picSlide
End If
'1±íʾΪԤ¶©£¬2 ΪʹÓÃÖÐ
optThumb(lPicCnt).Tag = Trim(Str(EF("SiteStatus"))) & sPD
'Set optThumb(lPicCnt).Picture = picThumb.Image 'ÏÔʾ²úƷͼƬ
Set optThumb(lPicCnt).Picture = picLoad.Picture 'ÏÔʾ²úƷͼƬ
Select Case EF("SiteStatus")
Case 0
optThumb(lPicCnt).ForeColor = &H8000&
sText = "¡ð" & sPD & vbCrLf & "°üÏá·Ñ" & sPN & "Ôª" 'ÏÔʾ±¸×¢
optThumb(lPicCnt).ToolTipText = sText
Case 1
optThumb(lPicCnt).ForeColor = &H800000
sText = "¡ò" & sPD & vbCrLf & "°üÏá·Ñ" & sPN & "Ôª" 'ÏÔʾ±¸×¢
optThumb(lPicCnt).ToolTipText = sText
Case 2
optThumb(lPicCnt).ForeColor = &H40C0&
sText = "¡ñ" & sPD & vbCrLf & "°üÏá·Ñ" & sPN & "Ôª" 'ÏÔʾ±¸×¢
optThumb(lPicCnt).ToolTipText = sText
Case 3
optThumb(lPicCnt).ForeColor = &H40C0&
sText = "¡ñ" & sPD & vbCrLf & "ÒѾ½áÕÊ" 'ÏÔʾ±¸×¢
optThumb(lPicCnt).ToolTipText = sText
Case 4
optThumb(lPicCnt).ForeColor = &H0&
sText = "¡ñ" & sPD & vbCrLf & "άÐÞ ÔÝÍ£" 'ÏÔʾάÐÞÐÅÏ¢
optThumb(lPicCnt).ToolTipText = sText
End Select
iMaxLen = optThumb(lPicCnt).Width - 8
' If picSlide.TextWidth(sText) > iMaxLen Then
' iMaxLen = iMaxLen - picSlide.TextWidth("...")
' End If
' While picSlide.TextWidth(sText) > iMaxLen
' sText = Left$(sText, Len(sText) - 1)
' Wend
If iMaxLen < optThumb(lPicCnt).Width - 8 Then
sText = sText & "..."
End If
optThumb(lPicCnt).Caption = sText
optThumb(lPicCnt).Visible = True
optThumb(lPicCnt).Left = optThumb(lPicCnt - 1).Left + 1280
lPicCnt = lPicCnt + 1
End If
EF.MoveNext
Next lIdx
picProgress.Visible = False
Set picLoad.Picture = LoadPicture()
Set picThumb.Picture = LoadPicture()
' picSlide.Visible = True
End If
Screen.MousePointer = vbDefault
EF.Close Set EF = Nothing
End SubPrivate Sub StartProgress() With picProgress
.Cls
.BackColor = vbButtonFace
.ForeColor = vbButtonText
End With
With picProgressSlide
.Cls
.BackColor = vbHighlight
.ForeColor = vbHighlightText
End With
picProgress.Visible = True
End SubPrivate Sub UpdateProgress(ByVal iPercent As Integer, ByVal sCaption As String)Dim lTextTop As Long picProgress.Cls
picProgressSlide.Cls
picProgressSlide.Width = picProgress.ScaleWidth * (CSng(iPercent) / 100!)
lTextTop = (picProgress.ScaleHeight - picProgress.TextHeight(sCaption)) / 2
picProgress.CurrentX = 3
picProgress.CurrentY = lTextTop
picProgress.Print sCaption
picProgressSlide.CurrentX = 3
picProgressSlide.CurrentY = lTextTop
picProgressSlide.Print sCaption
DoEvents
End Sub