VB 可以让 command显示为2D吗?不是3D的.

Posted 2023-04-17

像平面的一样,看起来就像label.当鼠标移动在上面就会显示按纽的形状.
可以吗??
谢谢!!
SSCommand按钮控件 是不是要去下载呀
toolbar 没看见这选项呀

我公开一下我写的控件2,篇幅有点长,不过效果还是不错的，VB做界面确实不是很方便，你复制下面的代码到记事本里，保存成FlatButton.ctl，添加到VB里就能用了，可以随意换颜色，有点长，8好意思
=========开始==========
VERSION 5.00
Begin VB.UserControl FlatButton
Alignable = -1 'True
AutoRedraw = -1 'True
ClientHeight = 300
ClientLeft = 0
ClientTop = 0
ClientWidth = 990
ScaleHeight = 300
ScaleWidth = 990
Begin VB.TextBox Text1
Alignment = 2 'Center
BorderStyle = 0 'None
Height = 255
Left = 0
Locked = -1 'True
MultiLine = -1 'True
TabIndex = 0
Top = 0
Visible = 0 'False
Width = 375
End
End
Attribute VB_Name = "FlatButton"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
'版权所有 阿龙 （QQ:175147310）

Private Declare Function DrawEdge Lib "user32" (ByVal hdc As Long, qrc As RECT, ByVal edge As Long, ByVal grfFlags As Long) As Long
Private Declare Function GetClassLong Lib "user32" Alias "GetClassLongA" (ByVal hwnd As Long, ByVal nIndex As Long) As Long
Private Declare Function SetClassLong Lib "user32" Alias "SetClassLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Private Declare Function GetClientRect Lib "user32" (ByVal hwnd As Long, lpRect As RECT) As Long
Private Declare Function SetCapture Lib "user32" (ByVal hwnd As Long) As Long
Private Declare Function ReleaseCapture Lib "user32" () As Long
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
Private Declare Function DrawTextEx Lib "user32" Alias "DrawTextExA" (ByVal hdc As Long, ByVal lpsz As String, ByVal n As Long, lpRect As RECT, ByVal un As Long, lpDrawTextParams As DRAWTEXTPARAMS) As Long
Private Declare Function DrawFocusRect Lib "user32" (ByVal hdc As Long, lpRect As RECT) As Long
Private Declare Function InflateRect Lib "user32" (lpRect As RECT, ByVal x As Long, ByVal y As Long) As Long

Private Const CS_DBLCLKS = &H8
Private Const GCL_STYLE = (-26)

Private Const BF_LEFT = 1
Private Const BF_TOP = 2
Private Const BF_RIGHT = 4
Private Const BF_BOTTOM = 8
Private Const BF_RECT = BF_LEFT Or BF_TOP Or BF_RIGHT Or BF_BOTTOM
Private Const BDR_SUNKENINNER = 8
Private Const BDR_SUNKENOUTER = 2
Private Const BDR_RAISEDOUTER = 1
Private Const BDR_RAISEDINNER = 4

Private Const EM_GETLINECOUNT = &HBA

Private Const DT_CENTER = &H1
Private Const DT_WORDBREAK = &H10
Private Const DT_EDITCONTROL = &H2000&

Private Type RECT
Left As Long
Top As Long
Right As Long
Bottom As Long
End Type

Private Type DRAWTEXTPARAMS
cbSize As Long
iTabLength As Long
iLeftMargin As Long
iRightMargin As Long
uiLengthDrawn As Long
End Type

Event MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single)
Event MouseMove(Button As Integer, Shift As Integer, x As Single, y As Single)
Event MouseUp(Button As Integer, Shift As Integer, x As Single, y As Single)
Event Click()

Dim rc As RECT, h As Long, caped As Boolean, Focusing As Boolean, Pushing As Boolean, txtHeight As Long, curState As Long

'Friend Function WindowProc(ByVal hWnd As Long, _
' ByVal iMsg As Long, _
' ByVal wParam As Long, _
' ByVal lParam As Long) As Long
'Select Case iMsg
' Case WM_LBUTTONDOWN
' DrawEdge UserControl.hdc, rc, BDR_SUNKENOUTER, BF_RECT
' UserControl.Refresh
' Case WM_LBUTTONUP
' DrawEdge UserControl.hdc, rc, BDR_RAISEDINNER, BF_RECT
' UserControl.Refresh
'End Select
'WindowProc = CallWindowProc(ByVal h, ByVal hWnd, ByVal iMsg, ByVal wParam, ByVal lParam)
'End Function
'缺省属性值:
Const m_def_Caption = "1"
Const m_def_BackColorNormal = &H8000000F
Const m_def_BackColorOver = &H80C0FF
Const m_def_BackColorPush = &HE0E0E0
Const m_def_ForeColorNormal = &H80000012
Const m_def_ForeColorOver = &H80000012
Const m_def_ForeColorPush = &H80000012
'属性变量:
Dim m_Caption As String
Dim m_BackColorNormal As OLE_COLOR
Dim m_BackColorOver As OLE_COLOR
Dim m_BackColorPush As OLE_COLOR
Dim m_ForeColorNormal As OLE_COLOR
Dim m_ForeColorOver As OLE_COLOR
Dim m_ForeColorPush As OLE_COLOR

Private Function ModifyClassStyle(hwnd As Long, Value As Long, BOOL As Boolean) As Long
If hwnd <> 0 Then
If BOOL Then
SetClassLong hwnd, GCL_STYLE, GetClassLong(hwnd, GCL_STYLE) Or Value
Else
SetClassLong hwnd, GCL_STYLE, GetClassLong(hwnd, GCL_STYLE) And (Not Value)
End If
'SetWindowPos hwnd, 0, 0, 0, 0, 0, 551
End If
End Function

Private Function DrawWindow(State As Long)

Dim ST As DRAWTEXTPARAMS, Indent As Long, rcDraw As RECT
UserControl.Cls
If UserControl.Enabled Or (Not Ambient.UserMode) Then
Select Case State
Case 0
UserControl.BackColor = m_BackColorOver
UserControl.ForeColor = m_ForeColorOver
DrawEdge UserControl.hdc, rc, BDR_RAISEDINNER, BF_RECT
Case 1
UserControl.BackColor = m_BackColorPush
UserControl.ForeColor = m_ForeColorPush
DrawEdge UserControl.hdc, rc, BDR_SUNKENOUTER, BF_RECT
Indent = 1
Case Else
UserControl.BackColor = m_BackColorNormal
UserControl.ForeColor = m_ForeColorNormal
Line (0, 0)-(UserControl.Width - 15, UserControl.Height - 15), 0, B
End Select
Else
UserControl.BackColor = &H8000000F
UserControl.ForeColor = &H80000010
Line (0, 0)-(UserControl.Width - 15, UserControl.Height - 15), &H80000010, B
End If
ST.cbSize = Len(ST)
'DrawText hDC, Label1.Caption, LenB(StrConv(Label1.Caption, vbFromUnicode)), rc, DT_CENTER + DT_SINGLELINE + DT_VCENTER
If Focusing Then Drawfocus
rcDraw.Left = Text1.Left / 15 + Indent
rcDraw.Right = (Text1.Left + Text1.Width) / 15
rcDraw.Top = (rc.Bottom * 15 - txtHeight) / 30
rcDraw.Bottom = rcDraw.Top + txtHeight / 15
rcDraw.Top = rcDraw.Top + Indent
DrawTextEx hdc, m_Caption, LenB(StrConv(m_Caption, vbFromUnicode)), rcDraw, DT_CENTER + DT_EDITCONTROL + DT_WORDBREAK, ST
UserControl.Refresh
curState = State
End Function

Private Function Drawfocus()
Dim rcDraw As RECT
rcDraw.Left = rc.Left
rcDraw.Right = rc.Right
rcDraw.Top = rc.Top
rcDraw.Bottom = rc.Bottom
InflateRect rcDraw, -2, -2
DrawFocusRect hdc, rcDraw
End Function

Private Function Init() As Long
Text1.Text = m_Caption
txtHeight = SendMessage(Text1.hwnd, EM_GETLINECOUNT, 0, 0) * TextHeight(Text1.Text)
DrawWindow -1
End Function

Private Sub UserControl_AmbientChanged(PropertyName As String)
Debug.Print PropertyName
End Sub

Private Sub UserControl_Click()
DrawWindow -1
RaiseEvent Click
End Sub

Private Sub UserControl_EnterFocus()
Focusing = True
DrawWindow curState
'Debug.Print "UserControl_EnterFocus"
End Sub

Private Sub UserControl_ExitFocus()
Focusing = False
Debug.Print "UserControl_ExitFocus"
DrawWindow curState
End Sub

Private Sub UserControl_Initialize()
ModifyClassStyle UserControl.hwnd, CS_DBLCLKS, False
'ModifyStyle UserControl.hwnd, WS_TABSTOP, True
'h = ezSubclass(Me, UserControl.hWnd)
End Sub

Private Sub UserControl_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single)
RaiseEvent MouseDown(Button, Shift, x, y)
DrawWindow 1
Pushing = True
UserControl.Refresh
End Sub

Private Sub UserControl_MouseMove(Button As Integer, Shift As Integer, x As Single, y As Single)
RaiseEvent MouseMove(Button, Shift, x, y)
If x > 0 And x < UserControl.Width And y > 0 And y < UserControl.Height Then
If Not v Then
SetCapture UserControl.hwnd
If Pushing Then
DrawWindow 1
Else
DrawWindow 0
End If
caped = True
End If
Else
DrawWindow -1
If Not Pushing Then
caped = False
ReleaseCapture
End If
Debug.Print "Leave"
End If
End Sub

Private Sub UserControl_MouseUp(Button As Integer, Shift As Integer, x As Single, y As Single)
Pushing = False
UserControl_MouseMove Button, Shift, x, y
RaiseEvent MouseUp(Button, Shift, x, y)
End Sub

Private Sub UserControl_Resize()
On Error Resume Next
Static FirstResize As Boolean
GetClientRect UserControl.hwnd, rc
Text1.Move 45, 45, UserControl.Width - 90, UserControl.Height - 90
If Not FirstResize Then
FirstResize = True
Init
End If
DrawWindow -1
End Sub

Private Sub UserControl_Terminate()
'ezUnSubclass UserControl.hWnd, h
End Sub

'注意！不要删除或修改下列被注释的行！
'MemberInfo=10,0,0,0
Public Property Get BackColorOver() As OLE_COLOR
BackColorOver = m_BackColorOver
End Property

Public Property Let BackColorOver(ByVal New_BackColorOver As OLE_COLOR)
m_BackColorOver = New_BackColorOver
PropertyChanged "BackColorOver"
End Property

'注意！不要删除或修改下列被注释的行！
'MemberInfo=10,0,0,0
Public Property Get BackColorPush() As OLE_COLOR
BackColorPush = m_BackColorPush
End Property

Public Property Let BackColorPush(ByVal New_BackColorPush As OLE_COLOR)
m_BackColorPush = New_BackColorPush
PropertyChanged "BackColorPush"
End Property

'注意！不要删除或修改下列被注释的行！
'MemberInfo=10,0,0,0
Public Property Get ForeColorNormal() As OLE_COLOR
ForeColorNormal = m_ForeColorNormal
End Property

Public Property Let ForeColorNormal(ByVal New_ForeColorNormal As OLE_COLOR)
m_ForeColorNormal = New_ForeColorNormal
PropertyChanged "ForeColorNormal"
End Property

'注意！不要删除或修改下列被注释的行！
'MemberInfo=10,0,0,0
Public Property Get ForeColorOver() As OLE_COLOR
ForeColorOver = m_ForeColorOver
End Property

Public Property Let ForeColorOver(ByVal New_ForeColorOver As OLE_COLOR)
m_ForeColorOver = New_ForeColorOver
PropertyChanged "ForeColorOver"
End Property

'注意！不要删除或修改下列被注释的行！
'MemberInfo=10,0,0,0
Public Property Get ForeColorPush() As OLE_COLOR
ForeColorPush = m_ForeColorPush
End Property

Public Property Let ForeColorPush(ByVal New_ForeColorPush As OLE_COLOR)
m_ForeColorPush = New_ForeColorPush
PropertyChanged "ForeColorPush"
End Property

'为用户控件初始化属性
Private Sub UserControl_InitProperties()
m_BackColorOver = m_def_BackColorOver
m_BackColorPush = m_def_BackColorPush
m_ForeColorNormal = m_def_ForeColorNormal
m_ForeColorOver = m_def_ForeColorOver
m_ForeColorPush = m_def_ForeColorPush
m_BackColorNormal = m_def_BackColorNormal
Set UserControl.Font = Ambient.Font
m_Caption = Ambient.DisplayName
End Sub

'从存贮器中加载属性值
Private Sub UserControl_ReadProperties(PropBag As PropertyBag)
m_BackColorOver = PropBag.ReadProperty("BackColorOver", m_def_BackColorOver)
m_BackColorPush = PropBag.ReadProperty("BackColorPush", m_def_BackColorPush)
m_ForeColorNormal = PropBag.ReadProperty("ForeColorNormal", m_def_ForeColorNormal)
m_ForeColorOver = PropBag.ReadProperty("ForeColorOver", m_def_ForeColorOver)
m_ForeColorPush = PropBag.ReadProperty("ForeColorPush", m_def_ForeColorPush)
m_BackColorNormal = PropBag.ReadProperty("BackColorNormal", m_def_BackColorNormal)
UserControl.Enabled = PropBag.ReadProperty("Enabled", True)
Set UserControl.Font = PropBag.ReadProperty("Font", Ambient.Font)
m_Caption = PropBag.ReadProperty("Caption", m_def_Caption)
Init
End Sub

'将属性值写到存储器
Private Sub UserControl_WriteProperties(PropBag As PropertyBag)

Call PropBag.WriteProperty("BackColorOver", m_BackColorOver, m_def_BackColorOver)
Call PropBag.WriteProperty("BackColorPush", m_BackColorPush, m_def_BackColorPush)
Call PropBag.WriteProperty("ForeColorNormal", m_ForeColorNormal, m_def_ForeColorNormal)
Call PropBag.WriteProperty("ForeColorOver", m_ForeColorOver, m_def_ForeColorOver)
Call PropBag.WriteProperty("ForeColorPush", m_ForeColorPush, m_def_ForeColorPush)
Call PropBag.WriteProperty("BackColorNormal", m_BackColorNormal, m_def_BackColorNormal)
Call PropBag.WriteProperty("Enabled", UserControl.Enabled, True)
Call PropBag.WriteProperty("Font", UserControl.Font, Ambient.Font)
Call PropBag.WriteProperty("Caption", m_Caption, m_def_Caption)
End Sub

'注意！不要删除或修改下列被注释的行！
'MemberInfo=10,0,0,0
Public Property Get BackColorNormal() As OLE_COLOR
BackColorNormal = m_BackColorNormal
End Property

Public Property Let BackColorNormal(ByVal New_BackColorNormal As OLE_COLOR)
m_BackColorNormal = New_BackColorNormal
PropertyChanged "BackColorNormal"
End Property

'注意！不要删除或修改下列被注释的行！
'MappingInfo=UserControl,UserControl,-1,Enabled
Public Property Get Enabled() As Boolean
Attribute Enabled.VB_Description = "返回/设置一个值，决定一个对象是否响应用户生成事件。"
Enabled = UserControl.Enabled
Init
DrawWindow -1
End Property

Public Property Let Enabled(ByVal New_Enabled As Boolean)
UserControl.Enabled() = New_Enabled
PropertyChanged "Enabled"
DrawWindow curState
End Property

'注意！不要删除或修改下列被注释的行！
'MappingInfo=UserControl,UserControl,-1,Font
Public Property Get Font() As Font
Attribute Font.VB_Description = "返回一个 Font 对象。"
Attribute Font.VB_UserMemId = -512
Set Font = UserControl.Font
End Property

Public Property Set Font(ByVal New_Font As Font)
Set UserControl.Font = New_Font
Set Text1.Font = New_Font
PropertyChanged "Font"
Init
End Property

'注意！不要删除或修改下列被注释的行！
'MemberInfo=13,0,0,
Public Property Get Caption() As String
Caption = m_Caption
End Property

Public Property Let Caption(ByVal New_Caption As String)
m_Caption = New_Caption
Init
PropertyChanged "Caption"
End Property

=========结束========== 参考技术A 据说界面美化方便VB是很弱的，所以这个很难！

试试这个：

Private Sub command1_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
Command1.BackColor = &H80000018
End Sub

Private Sub Form_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
Command1.BackColor = Me.BackColor
End Sub 参考技术B 用toolbar有一样的效果 - -
你windows资源管理器的菜单栏就是这个控件，要是只要commandbutton有这样的效果的话，你可以搜搜，用代码可以做到，不过很长，并不实用

新建工程的时候选"vb enterprise edition controls"里面就有了，或者去components里添加"microsoft windows common controls 5.0或6.0"

从 VB6 到 WCF 的命名管道

【中文标题】从 VB6 到 WCF 的命名管道

【英文标题】：Named Pipes from VB6 to WCF

【发布时间】：2010-09-21 15:12:14

【问题描述】：

我可以让 VB6 应用调用命名管道连接到使用 C# 编写的带有 WCF 端点的服务吗？

VB6 项目利用命名管道与用 C++ 编写的服务进行通信。我想将 C++ 服务转换为 C#（最好是 .NET 4.0）。

VB6 项目使用 Win32 调用 CallNamedPipes 向服务器发送消息。消息的有效负载是一个字符串，由以下结构组成。

 [command][data length][data if approprate to the message]

此时我无法转换应用程序的 VB6 端，但我想知道是否可以依靠 CallNamedPipe 函数向新的 WCF 服务发送消息，以及它们是否能很好地协同工作。我会看到 WCF 服务的合同方面基本上是一种接受我将解析的字符串的方法。

另外，由于 CallNamedPipes 可以在 outputBuffer 参数中接收返回数据，WCF 是否能够适应这一点？合同会是这样吗……

string DoSomething(string command)

感谢您的帮助！

布赖恩

【参考方案1】：

WCF 非常好，但在通信通道的两边都使用 WCF 时真的很出色。尝试将遗留代码连接到 WCF 服务充其量是棘手的。

让您的 C# 服务直接使用 NamedPipeServerStream 可能会更容易。这将使您完全控制如何处理连接和传输。话虽如此，没有什么可以阻止您同时执行这两种操作（在同一程序中实现自定义 NamedPipeServerStream 通道，以及公开一个或多个 WCF 端点）。如果您还想升级客户端，这将提供一种前进的方式。

【讨论】：

使用 NamedPipeServerStream，我可以发回返回数据还是基本上在管道上进行某种类型的双向通信，以便客户端需要“监听”返回数据？我很想升级客户端，但现在它不在范围内，也不确定是否会升级。

@Brian：您基本上只需执行您的 C++ 程序当前正在执行的任何操作 - 可以在单个管道中进行双向通信 - 但我不确定您当前的程序期望什么.

目前 VB6 代码使用类似“GiveMeSomeInfo”的命令调用服务，该服务返回 CallNamedPipe 提供的 outputBuffer 中的信息。所以实际上它就像远程方法调用一样使用。就像你说的，我可以做 C++ 代码正在做的事情，然后 PInvoke Win32 代码来设置命名管道并返回数据。我有点希望让 WCF 工作。

@Brian：我更认为你可以在 C# 端使用 NamedPipeServerStream 来模仿 C++ 代码对 Win32 API 所做的事情......它确实是一个相当薄的 API 包装器（它让您使用 Stream 类等）。

不幸的是，WCF 确实规定了格式（在通道的两侧），因此要使其与遗留代码一起干净地工作并非易事..

【参考方案2】：

为什么不编写一个包装 WCF 客户端代理的 ComVisible 类，您的 VB6 代码可以像调用任何其他 COM 库组件一样调用它。

【参考方案3】：

您能否使用 PInvoke 直接从您的 C# 代码调用 C++ 命名管道应用程序

然后将 pinvoke 服务包装在 WCF 服务周围以便于互操作。

【讨论】：

我想从 VB6 调用一个新的 C# 应用程序。目标是摆脱 C++ 代码。