データ構造のアルゴリズムの一つである二次元配列をピクチャボックスに
適用する簡単なサンプルです。APIは一切使用していませんので、
クラスとして不十分ですが理解しやすいと思います。
二次元配列についてよくわからなければ、
エクセルのような表計算ソフトのセルを想像すればわかりやすいでしょう。
 |
クラス内の全処理です。
Option Explicit
Private PaletteObje As Object 'パレット対象オブジェクト
Private tempColor() As Long 'パレットの色保管変数
Private Const GRID_WIDTH = 1 '枠線の太さ
Private Const GRID_COLOR = &H0 '枠線の色
Private Const CELL_WIDTH = 30 'セルの幅
Private Const CELL_HEIGHT = 30 'セルの高さ
Private Const X_CELL_COUNT = 8 '水平方向セルの数
Private Const Y_CELL_COUNT = 2 '垂直方向セルの数
Private Sub Class_Initialize()
ReDim tempColor(X_CELL_COUNT - 1, Y_CELL_COUNT - 1) As Long
End Sub
Private Sub Class_Terminate()
Set PaletteObje = Nothing
End Sub
'ピクチャボックス二次元配列の色参照
Public Property Get CellColor(ByVal hPosition As Long, _
ByVal vPosition As Long) _
As Long
CellColor = tempColor(hPosition, vPosition)
End Property
'ピクチャボックス二次元配列の色設定
Public Property Let CellColor(ByVal hPosition As Long, _
ByVal vPosition As Long, _
ByVal cColor As Long)
Dim sx As Long, sy As Long
'配列番号を座標に変換する
sx = hPosition * (CELL_WIDTH + GRID_WIDTH) + GRID_WIDTH
sy = vPosition * (CELL_HEIGHT + GRID_WIDTH) + GRID_WIDTH
'パレット描画
PaletteObje.Line (sx, sy)-(sx + CELL_WIDTH - 1&, _
sy + CELL_HEIGHT - 1&), cColor, BF
'その色の格納
tempColor(hPosition, vPosition) = cColor
End Property
'枠線を引く
Private Sub DrawGrid()
'Dim i As Long, j As Long
'Dim tx As Long, ty As Long
'tx = 0&
'ty = Y_CELL_COUNT * (CELL_HEIGHT + GRID_WIDTH) + GRID_WIDTH
'For i = 0& To X_CELL_COUNT
' For j = 0& To GRID_WIDTH - 1&
' PaletteObje.Line (tx, 0&)-(tx, ty), GRID_COLOR
' tx = tx + 1&
' Next j
' tx = tx + CELL_WIDTH
'Next i
'tx = X_CELL_COUNT * (CELL_WIDTH + GRID_WIDTH) + GRID_WIDTH
'ty = 0&
'For i = 0& To Y_CELL_COUNT
' For j = 0& To GRID_WIDTH - 1&
' PaletteObje.Line (0&, ty)-(tx, ty), GRID_COLOR
' ty = ty + 1&
' Next j
' ty = ty + CELL_HEIGHT
'Next i
'上のようにするよりも背景色を変更した方が簡単
PaletteObje.BackColor = GRID_COLOR
End Sub
'座標データを配列番号に変換し、その位置にある色を得る
'枠線部分を指定している場合、エラー値として-1を返す
Public Function GetColor(ByVal mousex As Long, _
ByVal mousey As Long) As Long
Dim posx As Long, posy As Long
posx = mousex \ (CELL_WIDTH + GRID_WIDTH)
posy = mousey \ (CELL_HEIGHT + GRID_WIDTH)
If (mousex < posx * (CELL_WIDTH + GRID_WIDTH) + GRID_WIDTH) Then
GetColor = -1&: Exit Function
End If
If (mousey < posy * (CELL_HEIGHT + GRID_WIDTH) + GRID_WIDTH) Then
GetColor = -1&: Exit Function
End If
GetColor = CellColor(posx, posy)
End Function
'パレット作成本体
Private Function MakePalette()
Dim i As Long, j As Long
Dim n As Long
'オブジェクトサイズの変更
PaletteObje.Width = (CELL_WIDTH + GRID_WIDTH) * X_CELL_COUNT + GRID_WIDTH
PaletteObje.Height = (CELL_HEIGHT + GRID_WIDTH) * Y_CELL_COUNT + GRID_WIDTH
'枠線の描画
Call DrawGrid
'このサンプルでは16色に限定しています
For i = 0& To X_CELL_COUNT - 1&
For j = 0& To Y_CELL_COUNT - 1&
n = i + X_CELL_COUNT * j
If n > 15& Then n = 15&
CellColor(i, j) = QBColor(n)
Next j
Next i
End Function
'パレットオブジェクトの参照
Public Property Get TargetPaletteObject() As Object
TargetPaletteObject = PaletteObje
End Property
'パレットオブジェクトの設定
Public Property Let TargetPaletteObject(ByVal tPalette As Object)
Set PaletteObje = tPalette
Call MakePalette
End Property
|
|
|
||||||||||||||
フォームに追加するコードです。
Dim cp As New CPalette
Private Sub Form_Load()
cp.TargetPaletteObject = Picture1
End Sub
Private Sub Picture1_MouseDown(Button As Integer, Shift As Integer, _
X As Single, Y As Single)
Dim ret As Long
ret = cp.GetColor(X, Y)
If ret = -1 Then Exit Sub
Label1.BackColor = ret
End Sub
|
|
次のように配列として色を設定できたり参照できたりするので、
非常に便利です。 CellColor(i, j) = QBColor(n) Col = CellColor(i, j) 上記のサンプルはごくごく単純な構造ですが、 これを利用すれば、簡単なアルゴリズムと標準のコントロールだけで 色々と面白いことができるようになります。(^^) 例えば、本サイト上の 画像のサムネイル表示 は、パレットの色の部分に『画像』を描画し、 万年カレンダー は、『文字』を描画し、1次元化したものです。 1つのアルゴリズムを適用するだけで、 難しそうな処理が単純に行えるようになり、 描画の幅も広がります。 アルゴリズムをどのようして利用するかということもプログラム設計のための 重要なファクターです。 |
| 機種 | PC-9821V13S |
| OS | Windows95 |
| 開発ツール | Visual Basic Ver.4.0 |
| 更新日 | 00/10/02 |
Visual Basic Ver.5.0,Ver.6.0でも問題なく動作すると思います。
なお、このコーナーに掲載されているプログラムコード、およびプログラムファ イルが原因で生じた損害などに関して一切の責任を負うことはできません。
★掲載されているプログラムコード、およびプログラムファイル、 ソースファイルを無断で配布・転載することは、原則として禁止です。