| 投稿日 | ： 2003/04/05(Sat) 22:51 |
| 投稿者 | ： 花ちゃん |
| Ｅメール | ： |
| ＵＲＬ | ： |
| タイトル | ： Re^2: グリッドのBackColorについて |
表示する数だけPictureBoxがいるのかな思ったのですが１個で出来るようなので
結構使えるかも知れません。
但し、その部分は強調表示されなかったり、セルのサイズ変更があれば再度塗りつぶし処理が
必要になったりと欠点もありますが、下記のようにして編集中は解除するようにして、セルの
サイズが変更されたら、再表示する等にすれば有る程度解決できるかと思います。
その他十分なテストやエラーチェックが出来ていませんので他に問題が発生するかも知れませんが
一度試して見て下さい。うまくいったら教えて下さい。
Option Explicit
Private Sub Command1_Click()
'パターンによる塗りつぶしのテスト
Dim i As Long, Pt As Long
With MSFlexGrid1
For i = .FixedCols To .Cols - 1
'１行すべて表示
Call SetPattern(5, 2, i)
If Pt < 8 Then
'全パターン表示
Call SetPattern(Pt, 3, i)
End If
Pt = Pt + 1
Next i
'表示してからセルにデータを表示した場合のテスト
.TextMatrix(2, 4) = "後で記入"
End With
'Row=4 Col=3 に VbCross 6 クロス で表示
Call SetPattern(6, 4, 3)
End Sub
Private Sub Command2_Click()
'パターンを解除
Dim i As Long, Pt As Long
With MSFlexGrid1
For i = .FixedCols To .Cols - 1
Call SetPattern(8, 2, i)
If Pt < 8 Then
Call SetPattern(8, 3, i)
End If
Pt = Pt + 1
Next i
End With
Call SetPattern(8, 4, 3)
End Sub
Private Sub SetPattern(ByVal FiSty As Integer, ByVal Ro As Long, ByVal Co As Long)
'パターンの作成と塗りつぶし処理
With MSFlexGrid1
.Row = Ro
.Col = Co
Picture1.Cls
'ピクチャーのサイズをセルと同一に
Picture1.Height = .CellHeight
Picture1.Width = .CellWidth
If FiSty >= 8 Or FiSty < 0 Then
'パターンの解除(Picture をクリア）
Set .CellPicture = LoadPicture()
Exit Sub
End If
'パターンの設定
Picture1.FillStyle = FiSty
'枠の罫線が見えないように
Picture1.Line (-10, -10)-(.CellWidth, .CellHeight), QBColor(0), B
'セルにピクチャーを表示
Set .CellPicture = Picture1.Image
End With
End Sub
Private Sub Form_Load()
'MSFlexGridの初期設定
With MSFlexGrid1
.Cols = 10
.Rows = 6
.ColWidth(-1) = 900
.ColWidth(5) = 1400
.RowHeight(-1) = 350
.Font.Bold = True
.TextMatrix(2, 2) = "先に記入"
End With
With Picture1 '別途プロパティで設定して下さい
.AutoRedraw = True
.Appearance = 0
.BorderStyle = vbBSNone
.Visible = False
End With
End Sub