| 投稿日 | ： 2004/11/20(Sat) 10:26 |
| 投稿者 | ： jikoryuu |
| Ｅメール | ： |
| ＵＲＬ | ： |
| タイトル | ： リストビューとリッチテキストボックスを使用できるのなら |
そのような標準でできない処理をする場合には、自作するのが基本です。
この場合はなんちゃってコンボボックスを作成します。
しかし作成できるからといって、度を越すとメンテナンスが大変なので、
あまり複雑になりすぎる事はあきらめることも大切なことも付け加えておきます。
この場合は、業務などで実装ギリギリの機能なのでサンプルをご覧になってください。
新しいプロジェクトに通常フォームとその上に
Combo1つ、RichTextBox1つ、Command1つ、ListView1つを貼り付けてください。
そのごサンプルコードを貼り付けてください。
また、サイズ調整などは自分で行ってください。
Private Sub Command1_Click()
Dim oli As ListItem
Dim oSi As ListSubItem
Dim c1 As Single
Dim c2 As Single
Dim f As Single
Dim i As Long
With ListView1
Combo1.Clear
.ListItems.Clear
f = Font.Size
Font.Size = .Font.Size
For i = 1 To 10
Set oli = .ListItems.Add(, , "name1")
If c1 < TextWidth(oli.Text) Then c1 = TextWidth(oli.Width)
Set oSi = oli.ListSubItems.Add(, , Format(Now() + i, "yyyy/mm/dd"))
oSi.ForeColor = vbRed
If c2 < TextWidth(oSi.Text) Then c2 = TextWidth(oSi.Text) + 175
If oli.Text & " " & oSi.Text = RichTextBox1.Text Then
oli.Selected = True
End If
Combo1.AddItem oli.Text & " " & oSi.Text
Next
.ColumnHeaders(1).Width = c1 - 75
.ColumnHeaders(2).Width = c2
.Height = (i - 1) * .ListItems(1).Height
Font.Size = f
.Visible = True
On Error Resume Next
.SetFocus
End With
End Sub
Private Sub Form_Load()
With ListView1
.BorderStyle = ccNone
.View = lvwReport
.FullRowSelect = True
.GridLines = False
.HideColumnHeaders = True
.LabelEdit = lvwManual
.Top = 1200
.Left = 240
.Visible = False
End With
With RichTextBox1
.Left = 210
.Top = 870
.Width = 2745
.Height = 345
End With
With Command1
.Left = 2670
.Top = 915
.Width = 255
.Height = 255
.ZOrder 0
End With
With Combo1
.Left = 1
.Top = 300
.Width = 2745
.Height = 300
End With
Command1_Click
ListView1.Visible = False
End Sub
Private Sub Form_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
ListView1_LostFocus
End Sub
Private Sub ListView1_ItemClick(ByVal Item As MSComctlLib.ListItem)
RichTextBox1.Text = Item.Text & " " & Item.ListSubItems(1).Text
End Sub
Private Sub ListView1_LostFocus()
ListView1.Visible = False
RichTextBox1.SetFocus
End Sub
Private Sub ListView1_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
ListView1_LostFocus
End Sub
Private Sub RichTextBox1_Change()
Dim s As String
Dim i As Long
Dim j As Long
With RichTextBox1
s = .Text
j = .SelStart
.SelStart = 0
.SelLength = Len(s)
.SelColor = vbBlack
.SelStart = j
If s <> "" Then
i = InStr(1, s, " ")
If i > 0 Then
.SelStart = i
.SelLength = Len(s) - i
.SelColor = vbRed
.SelStart = j
End If
End If
End With
End Sub