1,453
社区成员
发帖
与我相关
我的任务
分享请发表友善的回复…
发表回复
closevb 2011-05-06
- 打赏
- 举报
谢谢大家给予的建议与意见，尤其是SupermanKing的源码很受用。我是新手，所以分不多，再次感谢。
closevb 2011-05-04
- 打赏
- 举报
再次感谢您无私的解析。GDI重绘，这个可能是治本的方案。我一直想找第三方控件，主要是想图省事。楼上真是技术大牛呀。太感谢了,有种顿悟的感觉。
现在还是人类 2011-05-04
- 打赏
- 举报
效果图
现在还是人类 2011-05-04
- 打赏
- 举报
只能发三贴，没发完，继续发
If Table(1).TD(nSetX).vType = CheckType Then
If IsNumeric(PrintCaption) = True Then
If Int(PrintCaption) = 1 Then
PrintCaption = 1
Else
PrintCaption = 0
End If
Else
PrintCaption = 0
End If
TmpRect.Left = DRect.Left + ((DRect.Right - DRect.Left) / 2 - Check1.Width / 2)
TmpRect.Top = DRect.Top + ((DRect.Bottom - DRect.Top) / 2 - Check1.Height / 2)
TmpRect.Right = TmpRect.Left + Check1.Width
TmpRect.Bottom = TmpRect.Top + Check1.Height
If Int(PrintCaption) = 0 Then
DrawFrameControl GDI.hdc, TmpRect, DFC_BUTTON, DFCS_BUTTONCHECK
Else
DrawFrameControl GDI.hdc, TmpRect, DFC_BUTTON, DFCS_CHECKED
End If
Else
DRect.Left = DRect.Left + 3
DRect.Top = DRect.Top + 2
DRect.Right = DRect.Right - 3
DRect.Bottom = DRect.Bottom - 2
Select Case Table(1).TD(nSetX).Alignment
Case 0: DrawText GDI.hdc, PrintCaption, LenB(StrConv(PrintCaption, vbFromUnicode)), DRect, DT_VCENTER Or DT_SINGLELINE
Case 1: DrawText GDI.hdc, PrintCaption, LenB(StrConv(PrintCaption, vbFromUnicode)), DRect, DT_RIGHT Or DT_VCENTER Or DT_SINGLELINE
Case 2: DrawText GDI.hdc, PrintCaption, LenB(StrConv(PrintCaption, vbFromUnicode)), DRect, DT_CENTER Or DT_VCENTER Or DT_SINGLELINE
End Select
End If
End If
NextX:
Next X
Next Y
Dim LeftX As Long
Dim RightX As Long
Dim TopY As Long
Dim BottomY As Long
If IsMouseSelect = True Then
If MovX < MovOverX Then
LeftX = MovX
RightX = MovOverX
Else
LeftX = MovOverX
RightX = MovX
End If
If MovY < MovOverY Then
TopY = MovY
BottomY = MovOverY
Else
TopY = MovOverY
BottomY = MovY
End If
sCoolWidth = RightX - LeftX
sCoolHeight = BottomY - TopY
CollRes.DrawLine 0, 0, sCoolWidth, sCoolHeight, m_TableColor, m_BackColor, LineTypeBf
BF.AlphaFormat = 0
BF.BlendFlags = 0
BF.BlendOp = AC_SRC_OVER
BF.SourceConstantAlpha = 60
CopyMemory lBF, BF, 4
AlphaBlend GDI.hdc, LeftX, TopY, sCoolWidth + 1, sCoolHeight + 1, CollRes.hdc, 0, 0, sCoolWidth, sCoolHeight, lBF
GDI.DrawLine LeftX, TopY, RightX, BottomY, m_TableColor, m_BackColor, LineTypeB
End If
BitBlt UserControl.hdc, 0, 0, DBGridWidth, DBGridHeight, GDI.hdc, 0, 0, vbSrcCopy
If IsEdit = True Then
If FocusRect.Left = 0 And FocusRect.Top = 0 And FocusRect.Right = 0 And FocusRect.Bottom Then
GoTo HideEdit
End If
If EditRow > memVScrollValue And EditRow <= memVScrollValue + ForData Then
RectW = FocusRect.Right - FocusRect.Left
RectH = FocusRect.Bottom - FocusRect.Top
Select Case EditType
Case DateTimeType:
If FocusRect.Left + RectW > 0 And FocusRect.Left < DBGridWidth Then
TimeText1.Move FocusRect.Left, FocusRect.Top + Int(RectH / 2 - Check1.Height / 2) - 1, RectW
TimeText1.Visible = False
TimeText1.Visible = True
TimeText1.SetFocus
Else
TimeText1.Visible = False
End If
Case CheckType:
If FocusRect.Left + Int(RectW / 2 - Check1.Width / 2) + 1 + Check1.Width > 0 And FocusRect.Left + Int(RectW / 2 - Check1.Width / 2) + 1 < DBGridWidth Then
Check1.Move FocusRect.Left + Int(RectW / 2 - Check1.Width / 2) + 1, FocusRect.Top + Int(RectH / 2 - Check1.Height / 2) + 1
Check1.Visible = False
Check1.Visible = True
Check1.SetFocus
Else
Check1.Visible = False
End If
Case ComboType:
If FocusRect.Left + RectW > 0 And FocusRect.Left < DBGridWidth Then
Combo1.Move FocusRect.Left, FocusRect.Top + Int(RectH / 2 - Check1.Height / 2) - 1, RectW
Combo1.Visible = False
Combo1.Visible = True
Else
Combo1.Visible = False
End If
Case ComboTextType:
If FocusRect.Left + RectW > 0 And FocusRect.Left < DBGridWidth Then
Combo2.Move FocusRect.Left, FocusRect.Top + Int(RectH / 2 - Check1.Height / 2) - 1, RectW
Combo2.Visible = False
Combo2.Visible = True
Combo2.SetFocus
Else
Combo2.Visible = False
End If
Case TextCoLfType:
If FocusRect.Left + RectW > 0 And FocusRect.Left + 1 < DBGridWidth Then
Text2.Move FocusRect.Left + 1, FocusRect.Top + 1, RectW - 1, RectH - 1
Text2.Visible = False
Text2.Visible = True
Text2.SetFocus
Else
Text2.Visible = False
End If
Case TextType:
If FocusRect.Left + RectW > 0 And FocusRect.Left + 1 < DBGridWidth Then
Text1.Move FocusRect.Left + 1, FocusRect.Top + 1, RectW - 1, RectH - 1
Text1.Visible = False
Text1.Visible = True
Text1.SetFocus
Else
Text1.Visible = False
End If
Case NumericType:
If (FocusRect.Left + RectW) > 0 And (FocusRect.Left + 1) < DBGridWidth Then
Text1.Move FocusRect.Left + 1, FocusRect.Top + 1, RectW - 1, RectH - 1
Text1.Visible = False
Text1.Visible = True
Text1.SetFocus
Else
Text1.Visible = False
End If
Case TextButton
If (FocusRect.Left + 1) + (RectW - 1 - TRHeight) > 0 And FocusRect.Left + 1 < DBGridWidth Then
Text1.Move FocusRect.Left + 1, FocusRect.Top + 1, RectW - 1 - TRHeight, RectH - 1
Text1.Visible = False
Text1.Visible = True
Text1.SetFocus
Else
Text1.Visible = False
End If
If (Text1.Left + Text1.Width) + TRHeight > 0 And (Text1.Left + Text1.Width) < DBGridWidth Then
Command1.Move Text1.Left + Text1.Width, Text1.Top, TRHeight, Text1.Height
Command1.Visible = False
Command1.Visible = True
Else
Command1.Visible = False
End If
End Select
Else
HideEdit:
Select Case EditType
Case DateTimeType:
TimeText1.Visible = False
Case CheckType:
Check1.Visible = False
Case ComboType:
Combo1.Visible = False
Case ComboTextType:
Combo2.Visible = False
Case TextCoLfType:
Text2.Visible = False
Case TextType:
Text1.Visible = False
Case NumericType:
Text1.Visible = False
Case TextButton
Text1.Visible = False
Command1.Visible = False
End Select
End If
End If
End Sub
closevb 2011-05-04
- 打赏
- 举报
非常谢谢您。牛人真多。我好好琢磨琢磨。.
现在还是人类 2011-05-04
- 打赏
- 举报
Else
ButtonRECT(ButtonCount).Left = DRect.Left
ButtonRECT(ButtonCount).Top = DRect.Top
ButtonRECT(ButtonCount).Right = DRect.Right
ButtonRECT(ButtonCount).Bottom = DRect.Bottom
If Table(Y + memVScrollValue).TD(X).IsRUnite = True Then
ButtonRECT(ButtonCount).Y = PrintY
nSetY = PrintY
Else
ButtonRECT(ButtonCount).Y = Y + memVScrollValue
nSetY = Y + memVScrollValue
End If
If Table(Y + memVScrollValue).TD(X).IsCUnite = True Then
ButtonRECT(ButtonCount).X = PrintX
nSetX = PrintX
Else
ButtonRECT(ButtonCount).X = X
nSetX = X
End If
If Table(nSetY).IsSelect = True Then
Select Case Table(1).TD(nSetX).Style
Case 0
sCoolWidth = DRect.Right - DRect.Left
sCoolHeight = DRect.Bottom - DRect.Top
CollRes.DrawLine 0, 0, sCoolWidth, sCoolHeight, m_TableColor, m_BackColorSelect, LineTypeBf
BF.AlphaFormat = 0
BF.BlendFlags = 0
BF.BlendOp = AC_SRC_OVER
BF.SourceConstantAlpha = CollAlpha
CopyMemory lBF, BF, 4
AlphaBlend GDI.hdc, DRect.Left, DRect.Top, sCoolWidth, sCoolHeight, CollRes.hdc, 0, 0, sCoolWidth, sCoolHeight, lBF
GDI.DrawLine DRect.Left, DRect.Top, DRect.Right - 1, DRect.Bottom - 1, m_HeadShadowColor, , LineTypeB
GDI.DrawLine DRect.Left, DRect.Top, DRect.Right - 1, DRect.Top, m_HeadBrightColor
GDI.DrawLine DRect.Left, DRect.Top, DRect.Left, DRect.Bottom - 1, m_HeadBrightColor
'GDI.DrawLine DRect.Left, DRect.Top, DRect.Right + 1, DRect.Bottom + 1,m_TableColor, m_BackColorSelect, LineTypeBF
If SelRow = nSetY Then
If SelCol = nSetX Then
FocusRect.Left = DRect.Left
FocusRect.Top = DRect.Top
FocusRect.Right = DRect.Right
FocusRect.Bottom = DRect.Bottom
DFRect.Left = DRect.Left + 2
DFRect.Top = DRect.Top + 2
DFRect.Right = DRect.Right - 1
DFRect.Bottom = DRect.Bottom - 1
'GDI.DrawLine DFRect.Left, DFRect.Top, DFRect.Right, DFRect.Bottom,m_BackColorSelect ,, LineTypeB, 2
DrawFocusRect GDI.hdc, DFRect
End If
End If
GDI.ForeColor = m_ForeColorSelect
Case 1
If HadePic = True Then
BF.AlphaFormat = 0
BF.BlendFlags = 0
BF.BlendOp = AC_SRC_OVER
BF.SourceConstantAlpha = 255
CopyMemory lBF, BF, 4
AlphaBlend GDI.hdc, DRect.Left, DRect.Top, DRect.Right - DRect.Left, DRect.Bottom - DRect.Top, HadeRes.hdc, 0, 0, HadeRes.sWidth, HadeRes.sHeight, lBF
'StretchBlt GDI.hdc, DRect.Left, DRect.Top, DRect.Right - DRect.Left, DRect.Bottom - DRect.Top, HadeRes.hdc, 0, 0, HadeRes.sWidth, HadeRes.sHeight, vbSrcCopy
Else
GDI.DrawLine DRect.Left, DRect.Top, DRect.Right, DRect.Bottom, m_TableColor, m_HeadBackColor, LineTypeBf
End If
GDI.DrawLine DRect.Left, DRect.Top, DRect.Right - 1, DRect.Bottom - 1, m_HeadShadowColor, , LineTypeB
GDI.DrawLine DRect.Left, DRect.Top, DRect.Right - 1, DRect.Top, m_HeadBrightColor
GDI.DrawLine DRect.Left, DRect.Top, DRect.Left, DRect.Bottom - 1, m_HeadBrightColor
SelectObject GDI.hdc, TableBrush
If SelRow = nSetY Then
If SelCol = nSetX Then
FocusRect.Left = DRect.Left
FocusRect.Top = DRect.Top
FocusRect.Right = DRect.Right
FocusRect.Bottom = DRect.Bottom
DFRect.Left = DRect.Left + 2
DFRect.Top = DRect.Top + 2
DFRect.Right = DRect.Right - 3
DFRect.Bottom = DRect.Bottom - 3
'GDI.DrawLine DFRect.Left, DFRect.Top, DFRect.Right, DFRect.Bottom, , m_TableColor,, LineTypeB, 2
DrawFocusRect GDI.hdc, DFRect
End If
End If
GDI.ForeColor = ForeColorHead
End Select
Else
Select Case Table(1).TD(nSetX).Style
Case 0
sCoolWidth = DRect.Right - DRect.Left
sCoolHeight = DRect.Bottom - DRect.Top
CollRes.DrawLine 0, 0, sCoolWidth, sCoolHeight, m_TableColor, m_BackColor, LineTypeBf
BF.AlphaFormat = 0
BF.BlendFlags = 0
BF.BlendOp = AC_SRC_OVER
BF.SourceConstantAlpha = CollAlpha
CopyMemory lBF, BF, 4
AlphaBlend GDI.hdc, DRect.Left, DRect.Top, sCoolWidth, sCoolHeight, CollRes.hdc, 0, 0, sCoolWidth, sCoolHeight, lBF
GDI.DrawLine DRect.Left, DRect.Top, DRect.Right - 1, DRect.Bottom - 1, m_HeadShadowColor, , LineTypeB
GDI.DrawLine DRect.Left, DRect.Top, DRect.Right - 1, DRect.Top, m_HeadBrightColor
GDI.DrawLine DRect.Left, DRect.Top, DRect.Left, DRect.Bottom - 1, m_HeadBrightColor
'Rectangle GDI.hdc, DRect.Left, DRect.Top, DRect.Right + 1, DRect.Bottom + 1
SelectObject GDI.hdc, TableBrush
If SelRow = nSetY Then
If SelCol = nSetX Then
FocusRect.Left = DRect.Left
FocusRect.Top = DRect.Top
FocusRect.Right = DRect.Right
FocusRect.Bottom = DRect.Bottom
DFRect.Left = DRect.Left + 2
DFRect.Top = DRect.Top + 2
DFRect.Right = DRect.Right - 1
DFRect.Bottom = DRect.Bottom - 1
'GDI.DrawLine DFRect.Left, DFRect.Top, DFRect.Right, DFRect.Bottom,, m_TableColor, , LineTypeB, 2
DrawFocusRect GDI.hdc, DFRect
End If
End If
GDI.ForeColor = m_ForeColor
Case 1
If SelRow = nSetY Then
If SelCol = nSetX Then
FocusRect.Left = DRect.Left
FocusRect.Top = DRect.Top
FocusRect.Right = DRect.Right
FocusRect.Bottom = DRect.Bottom
DFRect.Left = DRect.Left + 2
DFRect.Top = DRect.Top + 2
DFRect.Right = DRect.Right - 3
DFRect.Bottom = DRect.Bottom - 3
'GDI.DrawLine DFRect.Left, DFRect.Top, DFRect.Right, DFRect.Bottom,, m_TableColor, , LineTypeB, 2
DrawFocusRect GDI.hdc, DFRect
End If
End If
If HadePic = True Then
BF.AlphaFormat = 0
BF.BlendFlags = 0
BF.BlendOp = AC_SRC_OVER
BF.SourceConstantAlpha = 255
CopyMemory lBF, BF, 4
AlphaBlend GDI.hdc, DRect.Left, DRect.Top, DRect.Right - DRect.Left, DRect.Bottom - DRect.Top, HadeRes.hdc, 0, 0, HadeRes.sWidth, HadeRes.sHeight, lBF
'StretchBlt GDI.hdc, DRect.Left, DRect.Top, DRect.Right - DRect.Left, DRect.Bottom - DRect.Top, HadeRes.hdc, 0, 0, HadeRes.sWidth, HadeRes.sHeight, vbSrcCopy
Else
GDI.DrawLine DRect.Left, DRect.Top, DRect.Right, DRect.Bottom, m_HeadBackColor, m_HeadBackColor, LineTypeBf
End If
GDI.DrawLine DRect.Left, DRect.Top, DRect.Right - 1, DRect.Bottom - 1, m_HeadShadowColor, , LineTypeB
GDI.DrawLine DRect.Left, DRect.Top, DRect.Right - 1, DRect.Top, m_HeadBrightColor
GDI.DrawLine DRect.Left, DRect.Top, DRect.Left, DRect.Bottom - 1, m_HeadBrightColor
GDI.ForeColor = ForeColorHead
End Select
End If
现在还是人类 2011-05-04
- 打赏
- 举报
For Y = 1 To ForData
AddWidth = DrawXCount
For X = DrawX To DrawXEnd
If m_Check = True Then
If X = 1 Then
If Table(Y + memVScrollValue).IsHead = True Then
DRect.Left = AddWidth
DRect.Top = (Y - (1 + memVScrollValue)) * TRHeight
DRect.Right = DRect.Left + Check1.Width * 2
DRect.Bottom = DRect.Top + TRHeight
If HadePic = True Then
BF.AlphaFormat = 0
BF.BlendFlags = 0
BF.BlendOp = AC_SRC_OVER
BF.SourceConstantAlpha = 255
CopyMemory lBF, BF, 4
AlphaBlend GDI.hdc, DRect.Left, DRect.Top, DRect.Right - DRect.Left, DRect.Bottom - DRect.Top, HadeRes.hdc, 0, 0, HadeRes.sWidth, HadeRes.sHeight, lBF
'StretchBlt GDI.hdc, DRect.Left, DRect.Top, DRect.Right - DRect.Left, DRect.Bottom - DRect.Top, HadeRes.hdc, 0, 0, HadeRes.sWidth, HadeRes.sHeight, vbSrcCopy
Else
GDI.DrawLine DRect.Left, DRect.Top, DRect.Right, DRect.Bottom, m_TableColor, m_HeadBackColor, LineTypeBf
End If
GDI.DrawLine DRect.Left, DRect.Top, DRect.Right - 1, DRect.Bottom - 1, m_HeadShadowColor, , LineTypeB
GDI.DrawLine DRect.Left, DRect.Top, DRect.Right - 1, DRect.Top, m_HeadBrightColor
GDI.DrawLine DRect.Left, DRect.Top, DRect.Left, DRect.Bottom - 1, m_HeadBrightColor
Else
CheckCount = CheckCount + 1
If CheckCount = 1 Then
ReDim CheckRECT(CheckCount)
Else
ReDim Preserve CheckRECT(CheckCount)
End If
DRect.Left = AddWidth
DRect.Top = (Y - 1) * TRHeight
DRect.Right = DRect.Left + Check1.Width * 2
DRect.Bottom = DRect.Top + TRHeight
CheckRECT(CheckCount).Left = DRect.Left
CheckRECT(CheckCount).Top = DRect.Top
CheckRECT(CheckCount).Right = DRect.Right
CheckRECT(CheckCount).Bottom = DRect.Bottom
CheckRECT(CheckCount).Y = Y + memVScrollValue
CheckRECT(CheckCount).X = 0
sCoolWidth = DRect.Right + 1 - DRect.Left
sCoolHeight = DRect.Bottom + 1 - DRect.Top
If Table(Y + memVScrollValue).IsSelect = True Then
'SelectObject GDI.hdc, TableBrushSelect
CollRes.DrawLine 0, 0, sCoolWidth, sCoolHeight, m_TableColor, m_BackColorSelect, LineTypeBf
Else
'SelectObject GDI.hdc, TableBrush
CollRes.DrawLine 0, 0, sCoolWidth, sCoolHeight, , m_TableColor, m_BackColor, LineTypeBf
End If
BF.AlphaFormat = 0
BF.BlendFlags = 0
BF.BlendOp = AC_SRC_OVER
BF.SourceConstantAlpha = CollAlpha
CopyMemory lBF, BF, 4
AlphaBlend GDI.hdc, DRect.Left, DRect.Top, sCoolWidth, sCoolHeight, CollRes.hdc, 0, 0, sCoolWidth, sCoolHeight, lBF
'Rectangle GDI.hdc, DRect.Left, DRect.Top, DRect.Right + 1, DRect.Bottom + 1
DFRect.Left = Check1.Width / 2
DFRect.Top = ((Y - 1) * TRHeight) + (TRHeight / 2 - Check1.Height / 2)
DFRect.Right = DFRect.Left + Check1.Width
DFRect.Bottom = DFRect.Top + Check1.Height
If Table(Y + memVScrollValue).IsCheck = False Then
DrawFrameControl GDI.hdc, DFRect, DFC_BUTTON, DFCS_BUTTONCHECK
Else
DrawFrameControl GDI.hdc, DFRect, DFC_BUTTON, DFCS_CHECKED
End If
End If
AddWidth = AddWidth + Check1.Width * 2
End If
End If
If Table(1).TD(X).Visible = False Then
GoTo NextX
End If
PrintCaption = Table(Y + memVScrollValue).TD(X).Caption
' If InStr(1, PrintCaption, "变动情况") <> 0 Then
' PrintCaption = PrintCaption
' End If
PrintY = Y + memVScrollValue
PrintX = X
'取得目标单元格的矩形大小
DRect.Bottom = 0
If Table(Y + memVScrollValue).TD(X).IsRUnite = True Then
If Table(Y + memVScrollValue).TD(X).RowUniteCount = 0 Then
AddWidth = AddWidth + Table(1).TD(X).cWidth
GoTo NextX
End If
For I = Y To m_Rows
If Table(I + memVScrollValue).TD(X).IsRUnite = True Then
DRect.Bottom = DRect.Bottom + TRHeight
Else
Exit For
End If
Next I
Else
DRect.Bottom = TRHeight
End If
DRect.Right = 0
If Table(Y + memVScrollValue).TD(X).IsCUnite = True Then
If Table(Y + memVScrollValue).TD(X).ColUniteCount = 0 Then
AddWidth = AddWidth + Table(1).TD(X).cWidth
GoTo NextX
End If
For I = X To m_Cols
If Table(Y + memVScrollValue).TD(I).IsCUnite = True Then
DRect.Right = DRect.Right + Table(1).TD(I).cWidth
Else
X = I - 1
Exit For
End If
Next I
Else
DRect.Right = DRect.Right + Table(1).TD(X).cWidth
End If
DRect.Left = AddWidth
DRect.Top = (Y - 1) * TRHeight
AddWidth = AddWidth + DRect.Right
DRect.Right = DRect.Left + DRect.Right
DRect.Bottom = DRect.Top + DRect.Bottom
ButtonCount = ButtonCount + 1
If ButtonCount = 1 Then
ReDim ButtonRECT(ButtonCount)
Else
ReDim Preserve ButtonRECT(ButtonCount)
End If
If Table(Y + memVScrollValue).IsHead = True Then
ButtonRECT(ButtonCount).Left = DRect.Left
ButtonRECT(ButtonCount).Top = DRect.Top
ButtonRECT(ButtonCount).Right = DRect.Right
ButtonRECT(ButtonCount).Bottom = DRect.Bottom
If Table(Y + memVScrollValue).TD(X).IsRUnite = True Then
ButtonRECT(ButtonCount).Y = PrintY
Else
ButtonRECT(ButtonCount).Y = Y + memVScrollValue
End If
If Table(Y + memVScrollValue).TD(X).IsCUnite = True Then
ButtonRECT(ButtonCount).X = PrintX
Else
ButtonRECT(ButtonCount).X = X
End If
' FocusRect.Left = DRect.Left
' FocusRect.Top = DRect.Top
' FocusRect.Right = DRect.Right
' FocusRect.Bottom = DRect.Bottom
If HadePic = True Then
BF.AlphaFormat = 0
BF.BlendFlags = 0
BF.BlendOp = AC_SRC_OVER
BF.SourceConstantAlpha = 255
CopyMemory lBF, BF, 4
AlphaBlend GDI.hdc, DRect.Left, DRect.Top, DRect.Right - DRect.Left, DRect.Bottom - DRect.Top, HadeRes.hdc, 0, 0, HadeRes.sWidth, HadeRes.sHeight, lBF
'StretchBlt GDI.hdc, DRect.Left, DRect.Top, DRect.Right - DRect.Left, DRect.Bottom - DRect.Top, HadeRes.hdc, 0, 0, HadeRes.sWidth, HadeRes.sHeight, vbSrcCopy
Else
GDI.DrawLine DRect.Left, DRect.Top, DRect.Right, DRect.Bottom, m_HeadBackColor, m_HeadBackColor, LineTypeBf
End If
GDI.DrawLine DRect.Left, DRect.Top, DRect.Right - 1, DRect.Bottom - 1, m_HeadShadowColor, , LineTypeB
GDI.DrawLine DRect.Left, DRect.Top, DRect.Right - 1, DRect.Top, m_HeadBrightColor
GDI.DrawLine DRect.Left, DRect.Top, DRect.Left, DRect.Bottom - 1, m_HeadBrightColor
GDI.ForeColor = ForeColorHead
DrawText GDI.hdc, PrintCaption, LenB(StrConv(PrintCaption, vbFromUnicode)), DRect, DT_CENTER Or DT_VCENTER Or DT_SINGLELINE
现在还是人类 2011-05-04
- 打赏
- 举报
自己用 GDI 绘制，用 DrawTextW 或 TextOutW 绘制文本就可以支持多国语言。
给你看一个我的DBGrid控件刷新界面过程，应该会对你有启发
给你看一个我的DBGrid控件刷新界面过程，应该会对你有启发
Public Sub Refresh()
Dim DrawX As Long
Dim DrawXCount As Long
Dim DrawXEnd As Long
Dim DrawXEndCount As Long
Dim DRect As RECT
Dim DFRect As RECT
Dim ForData As Long
Dim AddWidth As Long
Dim X As Long
Dim Y As Long
Dim nSetX As Long
Dim nSetY As Long
Dim I As Long
Dim PrintCaption As String
Dim PrintY As Long
Dim PrintX As Long
Dim ButtonCount As Long
Dim CheckCount As Long
Dim TmpRect As RECT
Dim BackBrush As Long
Dim BF As blendFunction, lBF As Long
Dim sCoolWidth As Long
Dim sCoolHeight As Long
If IsMessageBoxFocu = True Then
Exit Sub
End If
Dim RectW As Long
Dim RectH As Long
If m_Rows < 1 Then
Exit Sub
End If
If m_Cols < 1 Then
Exit Sub
End If
If MemResize = False Then
MemRefresh = True
UserControl_Resize
MemRefresh = False
End If
GDI.Cls
If BackPic = True Then
If m_BackFillStyle = Tile_Image Then
BackBrush = CreatePatternBrush(BackRes.hBitmap)
FillRect GDI.hdc, DBGridRect, BackBrush
DeleteObject BackBrush
Else
BF.AlphaFormat = 0
BF.BlendFlags = 0
BF.BlendOp = AC_SRC_OVER
BF.SourceConstantAlpha = 255
CopyMemory lBF, BF, 4
AlphaBlend GDI.hdc, 0, 0, DBGridRect.Right, DBGridRect.Bottom, BackRes.hdc, 0, 0, BackRes.sWidth, BackRes.sHeight, lBF
End If
End If
If m_Rows < 1 Or m_Cols < 1 Then
Exit Sub
End If
DrawX = 0
DrawXCount = 0
DrawXEnd = 0
DrawXEndCount = 0
ButtonCount = 0
CheckCount = 0
'找出开始横向绘制的开始项目数
For X = 1 To Cols
DrawXCount = DrawXCount + Table(1).TD(X).cWidth
If DrawXCount >= memHScrollValue Then
DrawXCount = DrawXCount - Table(1).TD(X).cWidth
DrawX = X
Exit For
End If
Next X
DrawXCount = (DrawXCount - memHScrollValue)
DrawXEndCount = -DrawXCount
DrawXEnd = DrawX
'找出开始横向绘制的停止项目数
For X = DrawXEnd To Cols
DrawXEndCount = DrawXEndCount + Table(1).TD(X).cWidth
DrawXEnd = X
If DrawXEndCount >= DBGridWidth + Table(1).TD(DrawX).cWidth * 2 Then
Exit For
End If
Next X
If NowShowRowCount > Rows Then
ForData = Rows
Else
ForData = NowShowRowCount
End If
FocusRect.Left = 0
FocusRect.Top = 0
FocusRect.Right = 0
FocusRect.Bottom = 0
closevb 2011-05-04
- 打赏
- 举报
[Quote=引用 3 楼 chenjl1031 的回复:]
用微软扩展对象库:Microsoft Forms 2.0 Object Library,这一套控件支持Unicode.不过，好像没有表格控件，有文本框、列表框、组合框等众多控件。
[/Quote]
首先感觉您的回复，
是呀。Forms 2.0里面是没有的。
Unicode虽然可以转换显示打印到到hDc上，但就是琢磨不出怎么叫表格里显示出来。例如:"가을이오면
",我转换后赋值，放表格里还是"???"，在窗体上是能打印出来的。
用微软扩展对象库:Microsoft Forms 2.0 Object Library,这一套控件支持Unicode.不过，好像没有表格控件，有文本框、列表框、组合框等众多控件。
[/Quote]
首先感觉您的回复，
是呀。Forms 2.0里面是没有的。
Unicode虽然可以转换显示打印到到hDc上，但就是琢磨不出怎么叫表格里显示出来。例如:"가을이오면
",我转换后赋值，放表格里还是"???"，在窗体上是能打印出来的。
closevb 2011-05-04
- 打赏
- 举报
[Quote=引用 2 楼 jiashie 的回复:]
韩文环境下编程，自然就支持韩文了
[/Quote]
谢谢你。确实很多人这么说的。我现在还没有试，我不知道会不会带来更多的问题。不过至少有办法了，黑暗中有一点光明是很欣慰的。谢谢。
韩文环境下编程，自然就支持韩文了
[/Quote]
谢谢你。确实很多人这么说的。我现在还没有试，我不知道会不会带来更多的问题。不过至少有办法了，黑暗中有一点光明是很欣慰的。谢谢。
closevb 2011-05-04
- 打赏
- 举报
[Quote=引用 1 楼 li163 的回复:]
一堆都是什么？又怎么不如意？
说出来，大家才可能帮你
[/Quote]
首先谢谢你热心的回复。
手中确实使用过很多表格控件。
每一个都使用过一段很长时间，现在用得最多的还是
MSHFlexGrid ，dataGrid，DidaGrid，CoolGrid，FlexGrid8
这几个各有好处。
我现在需要用表格显示数据库里的韩文数据，
MSHFlexGrid ，dataGrid，设置字符集与字体是可以支持韩文显示的。但我不知道为什么，MSHFlexGrid总是不能显示超过二千四百多行的数据。分页吧。dataGrid，也支持，并且没有行的限制。可长得太丑了。我又没有可以美化它的技术水平。所以一直在找第三方的控件。
DidaGrid，经常用它，蛮方便的，据说支持韩文。我一次也没试成功。后来才知道，它们说的是收费版本支持。所以这次给我教训，等俺有钱了，俺一定要买原版。
总结上面的教训后，我最后终于找了一个原版的FlexGrid8，而不是破解版了。可是试了半天还是没试出来。显示出来，全是问号。
现在用的是CoolGrid第三方控件. MSHFlexGrid 的升级版，非常方便。也支持韩文。但同样，受最多行的限制。并且很杯具的是这个软件现在以经不支持升级了。所以它很多明显的bug.它也不会修正了。但没办法，只能凑合着用。
各位大牛们，你们有什么能显示韩文的表格么？在表格中显示，像显示下面的它一样：가을이오면
介绍得不太清楚的地方请多见谅。再次感谢了。
一堆都是什么？又怎么不如意？
说出来，大家才可能帮你
[/Quote]
首先谢谢你热心的回复。
手中确实使用过很多表格控件。
每一个都使用过一段很长时间，现在用得最多的还是
MSHFlexGrid ，dataGrid，DidaGrid，CoolGrid，FlexGrid8
这几个各有好处。
我现在需要用表格显示数据库里的韩文数据，
MSHFlexGrid ，dataGrid，设置字符集与字体是可以支持韩文显示的。但我不知道为什么，MSHFlexGrid总是不能显示超过二千四百多行的数据。分页吧。dataGrid，也支持，并且没有行的限制。可长得太丑了。我又没有可以美化它的技术水平。所以一直在找第三方的控件。
DidaGrid，经常用它，蛮方便的，据说支持韩文。我一次也没试成功。后来才知道，它们说的是收费版本支持。所以这次给我教训，等俺有钱了，俺一定要买原版。
总结上面的教训后，我最后终于找了一个原版的FlexGrid8，而不是破解版了。可是试了半天还是没试出来。显示出来，全是问号。
现在用的是CoolGrid第三方控件. MSHFlexGrid 的升级版，非常方便。也支持韩文。但同样，受最多行的限制。并且很杯具的是这个软件现在以经不支持升级了。所以它很多明显的bug.它也不会修正了。但没办法，只能凑合着用。
各位大牛们，你们有什么能显示韩文的表格么？在表格中显示，像显示下面的它一样：가을이오면
介绍得不太清楚的地方请多见谅。再次感谢了。
东方之珠 2011-05-04
- 打赏
- 举报
用微软扩展对象库:Microsoft Forms 2.0 Object Library,这一套控件支持Unicode.不过，好像没有表格控件，有文本框、列表框、组合框等众多控件。
jiashie 2011-05-04
- 打赏
- 举报
韩文环境下编程，自然就支持韩文了
li163 2011-05-04
- 打赏
- 举报
一堆都是什么？又怎么不如意？
说出来，大家才可能帮你
说出来，大家才可能帮你
