投稿時間:2004/11/20(Sat) 10:26 投稿者名:jikoryuu
Eメール:
URL :
タイトル:リストビューとリッチテキストボックスを使用できるのなら
そのような標準でできない処理をする場合には、自作するのが基本です。 この場合はなんちゃってコンボボックスを作成します。 しかし作成できるからといって、度を越すとメンテナンスが大変なので、 あまり複雑になりすぎる事はあきらめることも大切なことも付け加えておきます。
この場合は、業務などで実装ギリギリの機能なのでサンプルをご覧になってください。
新しいプロジェクトに通常フォームとその上に 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
|