 |
【ExcelやPower PointのVBAを使う！】 |
最終更新日 2006/02/10 |
|
|
||
|
私設研究所Neo-Tech-Lab.com |
||
| 【ExcelやPower PointのVBAを使う！】 | ||
| 複数の組織間で仕事をしていると、お互いのソフトウェア開発ツールが違うために製作したソフトウェアのインストールがうまくいかなかったり、同じソフトウェアを購入しなければならない等、情報の共有に困難が生じることがよくあります。そこで、殆どのパソコンにインストールされているはずのMicrosoft社のExcelと、プレゼンや学会発表等で使われる機会の多いPower Pointに実装されているVisual Basic for Application (VBA)を積極的に利用する方法を考えてみました。 | ||
|
|
||
| 【目次】 ◆グラフィックスを描画するには．． ●ExcelのVBAを使うためには．． 【準備】 【ダウンロード】 【起動】 【どんなことができる？】 ●bmp形式ファイルの構造について ●ExcelのVisual Basic Editor起動方法 ●Lib_2DGraphicモジュールに用意された関数 ▲GetBitMapFile ▲BuildBitMap ▲SetBasicColor ▲FillBitMapImage ▲CreateBitMapFile ▲InitializeColorLookupTable ▲CreateColor ▲CreateGrayScale ▲CreateDipoleScale ▲CreateMonopoleScale ▲DrawPixel ▲DrawPixelWithClip ▲DrawLine ▲DrawLineWithClip ▲DrawBox ●Lib_2DGraphicモジュールの使い方 |
||
|
|
||
| ◆グラフィックスを描画するには．． | |
|
ExcelやPower Pointに標準で実装されているVBA(Visual Basic for
Application)を使う場合にまず一番問題になるのがグラフィックス描画です。DLLを使う方法ではOSのバージョンや環境設定の影響を受ける可能性があります。標準でVBAに用意されているイメージ(Image)コントロールを使えば、*.bmp、*.cur、*.gif、*.ico、*.jpg、*.wmfの形式の画像が表示できる点に着目しました。 例えば、Imageコントロールにbmp形式のファイルを読み込んで表示するには次のようにします。 Image1.Picture = LoadPicture("ファイル名.bmp") また、Imageコントロールに読み込まれている画像データは次のようにしてbmp形式でファイル化することができます。 SavePicture Image1.Picture, "ファイル名.bmp" VBAのImageコントロールで取り扱える様々な画像ファイルの形式について調べてみたところ、1670万色表示(RGB24ビット)に対応するbmp形式が簡素で目的にかなうことがわかりました。 原理について詳細に説明する前に、どんなことができるのか、まずダウンロードして試してみて下さい。 |
|
|
|
|
| ●ExcelのVBAを使うためには．． | |
| 【準備】 | |
|
ExcelやPower PointにはVBA(Visual Basic for
Application)が標準で実装されていますが、これを使うには次のようにしなければなりません。 Excelの場合には次のようにします。 １．Excelを起動直後に、ツール(T) - オプション(O)...によりオプション ダイアログ ボックスを表示し、その中の「セキュリティ」タブを選択します。 ２．「セキュリティ」タブ内にある「マクロ セキュリティ(S)...」ボタンをクリックして、セキュリティ ダイアログ ボックスを表示し、その中の「セキュリティ レベル」タブを選択して、セキュリティ レベルを「中」と設定してから「Ok」ボタンをクリックします。 ３．オプション ダイアログ ボックスの「Ok」ボタンをクリックして一旦Excelを終了します。 |
  |
|
|
|
| 【ダウンロード】 | |
|
デモンストレーション・プログラムは２種類用意しています。１つ目はBITMAP.xlsです。ここから、Excelファイルをダウンロードしてディスクに保存します。 ダウンロードを実行するには「ここ」をクリックすると「ファイルのダウンロード」ボックスが表示されますので「保存」ボタンをクリックして任意の保存ディレクトリを指定して保存します。 ダウンロードが終了すると「ダウンロードの完了」ボックスが表示されます。そのまま「キャンセル」ボタンをクリックして完了するか、「開く(O)」ボタンをクリックして保存したファイルを起動します。 さらにJPEG画像に拡散処理を施し、RGB8色画像に変換する例題の圧縮ファイル(LCD_BITMAP.lzh)を用意しました。 このLCD_BITMAP.lzhは今後他の電子工作で使うプログラム(LCD_BITMAP.xls)の圧縮ファイルです。 |
  |
|
|
|
| 【起動】 | |
| ダウンロードしたExcelファイルを起動すると、「セキュリティ警告」ボックスが表示されます。「マクロを有効にする(E)」ボタンをクリックしてExcelを起動します。 |
 |
|
|
|
| 【どんなことができる？】 | |
| BITMAP.xlsとLCD_BITMAP.xlsのBITMAPライブラリ・シートには、４つのボタンが用意されています。 「BitMapファイルを作成する」、「グレイスケールやカラーバーを作成」、「DrawPixelでSin関数を描画」、「等高線図を描画する」のどのボタンもクリックすると、最初は無地だったImageボックス内にグラフィックスが描画されるはずです。 My Documentsフォルダの中には幾つかのBitMapファイル(*.bmp形式)も作成されているはずです。 また、LCD_BITMAP.xlsのデモ画面シートで１２個のオプションボタンにより画像データシート内のイメージ(Image)コントロールに格納された原画像の中から１つを選択し、拡散処理を施し、RGB８色の画像に変換することができます。(簡単な画像処理の例として示しました。) 一体どのようにして描画処理がおこなわれたのか説明します。 LCD_BITMAP.xlsのデモ  ↓（拡散処理）  |
    |
|
|
|
| ●bmp形式ファイルの構造について | |
|
1670万色表示(RGB24ビット)のbmpファイルの構造を調べてみたところ、次のようなファイル構造であることがわかりました。 RGB24ビットで１画素を構成する場合の画素データの構造はRGB24bitPixelのような構造であり、ファイルのｘ方向、ｙ方向の画素数やプレーン数、1画素を構成するビット数などを定義するファイルヘッダーRGB24bitBitMapHeaderに続いて、RGB画素バッファ領域が存在するRGB24bitBitMapのような定義でした。 |
Public
Type RGB24bitPixel ' 画素ﾃﾞｰﾀの構造(RGB24bitﾀｲﾌﾟ) R As Byte ' 赤(0〜255) G As Byte ' 緑(0〜255) B As Byte ' 青(0〜255) End Type Public Type RGB24bitBitMapHeader ' RGB24bitﾀｲﾌﾟのBitMapﾌｧｲﾙのﾍｯﾀﾞｰ B As Byte ' ﾌｧｲﾙ識別子 "B" M As Byte ' : "M" FileLength As Long ' ﾌｧｲﾙの長さ = ﾍｯﾀﾞｰｻｲｽﾞ (54ﾊﾞｲﾄ) + ﾃﾞｰﾀｻｲｽﾞ( (x方向画素数×3に最も近い4の倍数)×(y方向画素数) ) Null1 As Long ' 0 HeaderSize As Long ' ﾍｯﾀﾞｰ領域のｻｲｽﾞ (54ﾊﾞｲﾄ) Offset As Long ' 画素ﾃﾞｰﾀまでのｵﾌｾｯﾄｻｲｽﾞ(40ﾊﾞｲﾄ) Nx As Long ' x方向画素数 Ny As Long ' y方向画素数 NumberOfPlanes As Integer ' ﾌﾟﾚｰﾝの数 (1ﾌﾟﾚｰﾝ) BitsOfPixel As Integer ' 1画素を構成するﾋﾞｯﾄ数 (24ﾋﾞｯﾄ) Null2 As Long ' 0 SizeOfData As Long ' 画素領域のﾊﾞｲﾄ･ｻｲｽﾞ (x方向画素数×3に最も近い4の倍数)×(y方向画素数) Null3 As Long ' 0 Null4 As Long ' 0 Null5 As Long ' 0 Null6 As Long ' 0 End Type Public Type RGB24bitBitMap Header As RGB24bitBitMapHeader ' RGB24bitﾀｲﾌﾟのBitMapﾍｯﾀﾞｰ PixelBuffer() As Byte ' RGB画素バッファ領域 End Type |
|
|
|
| ●ExcelのVisual Basic Editor起動方法 | |
| Excelの「ツール(T)」 - 「マクロ(M)」 - 「Visual Basic Editor(V)
Alt+F11」によりVisual Basic Editorが起動されます。 |
 |
| BitMap.xlsにはAutoRun, Lib_2DGraphic, Lib_ContourMap,
Win32APIという標準モジュールが付帯しています。 AutoRunはExcelファイルの起動とともにマクロを自動的にスタートさせるためのものです。Auto_Startという関数のみ定義されており、起動とともにSheet5をアクティブ状態にします。 Sub Auto_Start() Sheet5.Activate End Sub Win32APIモジュールが付帯していますがプログラム中では使用していません。 |
 |
|
|
|
| ●Lib_2DGraphicモジュールに用意された関数 | |
| ▲GetBitMapFile RGB24bitBitMap構造体に指定ファイルからヘッダー情報を読み込みます。同時に描画処理で使うことができる基本色も構造体内に定義されます。 BitMapのx方向、y方向の画素数は継承されます。 |
'########################################################### '### 指定画像ファイル(RGB24bit BMP形式)を読み込む '########################################################### Public Sub GetBitMapFile(cg As RGB24bitBitMap, FileName As String) Open FileName For Binary Access Read As #1 Get #1, , cg.Header ReDim cg.PixelBuffer(cg.Header.SizeOfData - 1) Get #1, 55, cg.PixelBuffer Close #1 cg.Nw = GetNw(cg.Header.Nx) '【x方向画素数×3に最も近い4の倍数を求める】 SetBasicColor cg '【基本色を設定する】 End Sub |
| ▲BuildBitMap 指定したx方向、y方向の画素数を持った構造体が作られます。同時に描画処理で使うことができる基本色も構造体内に定義されます。画素データは全て白色(基本色)に初期化されます。 x座標は左方向が減少方向、右方向が増加方向となり、y座標は下方向が減少方向、上方向が増加方向となる。 |
'########################################################### '### 指定サイズ,指定色の画像ファイル(RGB24bit BMP形式)を作る '########################################################### Public Sub BuildBitMap(Nx As Long, Ny As Long, cg As RGB24bitBitMap) Dim i As Long, j As Long cg.Nw = GetNw(Nx) SetBasicColor cg With cg.Header . B = Asc("B") . M = Asc("M") . FileLength = 54& + cg.Nw * Ny .Null1 = 0& .HeaderSize = 54 . Offset = 40 .Nx = Nx .Ny = Ny .NumberOfPlanes = 1 . BitsOfPixel = 24 .Null2 = 0& .SizeOfData = cg.Nw * Ny .Null3 = 0& .Null4 = 0& .Null5 = 0& .Null6 = 0& End With ReDim cg.PixelBuffer(cg.Header.SizeOfData - 1) FillBitMapImage cg, cg.White End Sub |
| ▲SetBasicColor 指定したRGB24bitBitMap構造体内に基本色を定義します。White(白), Black(黒), Red(赤), Yellow(黄), Green(緑), Cyan(シアン), Blue(青), Magenta(マゼンタ), Orange(橙), Violet(紫), Brown(茶), Gray(灰), DarkGray(濃灰), LightGray(淡灰), DarkGreen(濃緑)の15色が定義されます。 |
'%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% '%%% 基本色を作る '%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% Public Sub SetBasicColor(cg As RGB24bitBitMap) ' 色 R G B cg.White.R = 255 ' 白 255 255 255 cg.White.G = 255 ' cg.White.B = 255 ' cg.Black.R = 0 ' 黒 0 0 0 cg.Black.G = 0 ' cg.Black.B = 0 ' cg.Red.R = 255 ' 赤 255 0 0 cg.Red.G = 0 ' cg.Red.B = 0 ' cg.Yellow.R = 255 ' 黄 255 255 0 cg.Yellow.G = 255 ' cg.Yellow.B = 0 ' cg.Green.R = 0 ' 緑 0 255 0 cg.Green.G = 255 ' cg.Green.B = 0 ' cg.Cyan.R = 0 ' ｼｱﾝ 0 255 255 cg.Cyan.G = 255 ' cg.Cyan.B = 255 ' cg.Blue.R = 0 ' 青 0 0 255 cg.Blue.G = 0 ' cg.Blue.B = 255 ' cg.Magenta.R = 255 ' ﾏｾﾞﾝﾀ 255 0 255 cg.Magenta.G = 0 ' cg.Magenta.B = 255 ' cg.Orange.R = 255 ' ｵﾚﾝｼﾞ 255 128 0 cg.Orange.G = 128 ' cg.Orange.B = 0 ' cg.Violet.R = 128 ' 紫 128 0 255 cg.Violet.G = 0 ' cg.Violet.B = 128 ' cg.Brown.R = 128 ' 茶 128 0 0 cg.Brown.G = 0 ' cg.Brown.B = 0 ' cg.Gray.R = 128 ' 灰 128 128 128 cg.Gray.G = 128 ' cg.Gray.B = 128 ' cg.DarkGray.R = 50 ' 濃灰 50 50 50 cg.DarkGray.G = 50 ' cg.DarkGray.B = 50 ' cg.LightGray.R = 200 ' 淡灰 200 200 200 cg.LightGray.G = 200 ' cg.LightGray.B = 200 ' cg.DarkGreen.R = 0 ' 濃緑 0 128 0 cg.DarkGreen.G = 128 ' cg.DarkGreen.B = 0 ' End Sub |
| ▲FillBitMapImage 指定したRGB24bitBitMap構造体のカレントイメージを指定したRGB形式(RGB24bitPixel構造体)の色で塗りつぶし、クリアする。 |
'########################################################### '### カレントイメージをクリアする '########################################################### Public Sub FillBitMapImage(cg As RGB24bitBitMap, P As RGB24bitPixel) Dim i As Long, j As Long For j = 0 To cg.Header.Ny * cg.Nw - 1 Step cg.Nw For i = j + 0 * 3& To j + (cg.Header.Nx - 1&) * 3& Step 3& cg.PixelBuffer(i) = P.B cg.PixelBuffer(i + 1) = P.G cg.PixelBuffer(i + 2) = P.R Next i Next j End Sub |
| ▲CreateBitMapFile 指定したRGB24bitBitMap構造体のカレントイメージを指定名称のbmp形式ファイルにする。 |
'########################################################### '### カレントイメージをファイル化する '########################################################### Public Sub CreateBitMapFile(cg As RGB24bitBitMap, FileName As String) Open FileName For Binary Access Write As #1 Put #1, 1, cg.Header Put #1, 55, cg.PixelBuffer Close #1 End Sub |
|
▲InitializeColorLookupTable 指定したRGB24bitBitMap構造体内に指定サイズのカラールックアップテーブル(カラーパレット)領域を確保する。 |
'########################################################### '### ｶﾗｰLookupﾃｰﾌﾞﾙを初期化する '########################################################### Public Sub InitializeColorLookupTable(cg As RGB24bitBitMap, n As Long) cg.nC = n ReDim cg.Color(n - 1) End Sub |
| ▲CreateColor 指定したRGB24bitBitMap構造体内に確保済みのカラールックアップテーブル(カラーパレット)領域の色番号(i1)から色番号(i2)までを指定色(P1)から指定色(P2)まで色補間を行いながら定義する。 色補間方法は「直線補間」で行われる。 |
'########################################################### '### ｶﾗｰﾊﾟﾚｯﾄの指定色間を補間した色を作る '########################################################### Public Sub CreateColor(cg As RGB24bitBitMap, i1 As Long, P1 As RGB24bitPixel, i2 As Long, P2 As RGB24bitPixel) Dim P As RGB24bitPixel, dR As Double, dG As Double, dB As Double, i As Long, j As Long dR = (CDbl(P2.R) - CDbl(P1.R)) / (i2 - i1) dG = (CDbl(P2.G) - CDbl(P1.G)) / (i2 - i1) dB = (CDbl(P2.B) - CDbl(P1.B)) / (i2 - i1) For i = i1 To i2 Step Sgn(i2 - i1) cg.Color(i).R = P1.R + dR * (i - i1) cg.Color(i).G = P1.G + dG * (i - i1) cg.Color(i).B = P1.B + dB * (i - i1) Next i End Sub |
| ▲CreateGrayScale 指定したRGB24bitBitMap構造体内にｎ色分のカラールックアップテーブル(カラーパレット)領域を確保し、色番号(0)が黒、色番号(n-1)が白となるように色補間を行う。即ち、ｎ色分のグレイスケールを定義する。  |
'########################################################### '### ｶﾗｰﾊﾟﾚｯﾄを作る(ｸﾞﾚｲ･ｽｹｰﾙ) '########################################################### Public Sub CreateGrayScale(cg As RGB24bitBitMap, n As Long) InitializeColorLookupTable cg, n CreateColor cg, 0, cg.Black, n - 1, cg.White End Sub |
| ▲CreateDipoleScale 指定したRGB24bitBitMap構造体内にｎ色分のカラールックアップテーブル(カラーパレット)領域を確保し、正負の値を表現するのに適したカラーパレットを作成する。領域を６等分して、色番号(n-1)から色番号(0)に向かって色が赤⇒橙⇒黄⇒緑⇒白⇒濃緑⇒シアン⇒青⇒紫となるように色補間を行う。  |
'########################################################### '### ｶﾗｰﾊﾟﾚｯﾄを作る(正負) '########################################################### Public Sub CreateDipoleScale(cg As RGB24bitBitMap, n As Long) Dim C0 As Long, C1 As Long, C2 As Long, C3 As Long, C4 As Long, C5 As Long C0 = n - 1 C1 = n * 0.84 C2 = n * 0.67 C3 = n * 0.5 C4 = n * 0.33 C5 = n * 0.17 InitializeColorLookupTable cg, n CreateColor cg, C0, cg.Red, C1, cg.Orange CreateColor cg, C1, cg.Orange, C2, cg.Yellow CreateColor cg, C2, cg.Yellow, C3, cg.Green CreateColor cg, C3, cg.DarkGreen, C4, cg.Cyan CreateColor cg, C4, cg.Cyan, C5, cg.Blue CreateColor cg, C5, cg.Blue, 0, cg.Violet cg.Color(C3) = cg.White End Sub |
| ▲CreateMonopoleScale 指定したRGB24bitBitMap構造体内にｎ色分のカラールックアップテーブル(カラーパレット)領域を確保し、絶対値を表現するのに適したカラーパレットを作成する。領域を７等分して、色番号(n-1)から色番号(0)に向かって色が赤⇒橙⇒黄⇒緑⇒淡青⇒青⇒濃灰⇒灰⇒淡灰⇒白となるように色補間を行う。  |
'########################################################### '### ｶﾗｰﾊﾟﾚｯﾄを作る(絶対値) '########################################################### Public Sub CreateMonopoleScale(cg As RGB24bitBitMap, n As Long) Dim C0 As Long, C1 As Long, C2 As Long, C3 As Long, C4 As Long, C5 As Long, C6 As Long C0 = n - 1 C1 = n * 10 / 12 C2 = n * 8 / 12 C3 = n * 6 / 12 C4 = n * 5 / 12 C5 = n * 4 / 12 C6 = n * 2 / 12 InitializeColorLookupTable cg, n ' 表示色数 赤⇒橙⇒黄⇒緑⇒淡青⇒青⇒濃灰⇒灰⇒淡灰⇒白 CreateColor cg, C0, cg.Red, C1, cg.Orange CreateColor cg, C1, cg.Orange, C2, cg.Yellow CreateColor cg, C2, cg.Yellow, C3, cg.Green CreateColor cg, C3, cg.Green, C4, cg.DarkGreen CreateColor cg, C4, cg.DarkGreen, C5, cg.Blue CreateColor cg, C5, cg.Blue, C6, cg.Violet CreateColor cg, C6, cg.DarkGray, 0, cg.White End Sub |
| ▲DrawPixel 指定したRGB24bitBitMap構造体のカレントイメージの指定座標(x,y)に指定色の点を描画する。 この関数は速度重視で、指定座標がカレントイメージの領域内にあることを前提としており、エラーチェックを行っていない。 |
'########################################################### '### カレントイメージに指定色で点を描画する '########################################################### Public Sub DrawPixel(cg As RGB24bitBitMap, X As Long, Y As Long, P As RGB24bitPixel) Dim L As Long L = X * 3& + Y * cg.Nw cg.PixelBuffer(L) = P.B cg.PixelBuffer(L + 1) = P.G cg.PixelBuffer(L + 2) = P.R End Sub |
| ▲DrawPixelWithClip 指定したRGB24bitBitMap構造体のカレントイメージの指定座標(x,y)に指定色の点を描画する。 この関数は、指定座標がカレントイメージの領域内にある場合に限り描画を行う。 |
'########################################################### '### カレントイメージに指定色で点を描画する(簡易ｸﾘｯﾌﾟ) '########################################################### Public Sub DrawPixelWithClip(cg As RGB24bitBitMap, X As Long, Y As Long, P As RGB24bitPixel) Dim L As Long If (X >= 0) And (X < cg.Header.Nx) And (Y >= 0) And (Y < cg.Header.Ny) Then L = X * 3& + Y * cg.Nw cg.PixelBuffer(L) = P.B cg.PixelBuffer(L + 1) = P.G cg.PixelBuffer(L + 2) = P.R End If End Sub |
| ▲DrawLine 指定したRGB24bitBitMap構造体のカレントイメージの指定座標(x,y)に指定色の線分を描画する。 この関数は速度重視で、指定座標がカレントイメージの領域内にあることを前提としており、エラーチェックを行っていない。 |
'########################################################### '### カレントイメージに指定色で直線を描画する '########################################################### Public Sub DrawLine(cg As RGB24bitBitMap, X1 As Long, Y1 As Long, X2 As Long, Y2 As Long, P As RGB24bitPixel) Dim i As Long, j As Long, k As Long, L As Long, dx As Long, Dy As Long, Sx As Long, Sy As Long dx = X2 - X1 ' 3+ Dy = Y2 - Y1 ' | Sx = Sgn(dx) * 3& ' 2+ If Sx = 0 Then Sx = 3& ' | Sy = Sgn(Dy) * cg.Nw ' 1+ If Sy = 0 Then Sy = cg.Nw ' | dx = Abs(dx) ' 0+---+---+---+---+ Dy = Abs(Dy) ' 0 1 2 3 4 If dx > Dy Then ' Major=X, Minor=Y k = Y1 * cg.Nw ' Minorの初期値 j = 0 For i = X1 * 3& To X2 * 3& Step Sx j = j + Dy ' Minor増加分だけ加算 If j > dx Then ' Major分を超えたらMajor分だけ減算 j = j - dx ' k = k + Sy ' Minor座標方向の移動バイト数を計算 End If L = i + k cg.PixelBuffer(L) = P.B cg.PixelBuffer(L + 1) = P.G cg.PixelBuffer(L + 2) = P.R Next i Else ' Major=Y, Mior=X k = X1 * 3& ' Minorの初期値 j = 0 For i = Y1 * cg.Nw To Y2 * cg.Nw Step Sy j = j + dx ' Minor増加分だけ加算 If j > Dy Then ' Major分を超えたらMajor分だけ減算 j = j - Dy ' k = k + Sx ' Minor座標方向の移動バイト数を計算 End If L = i + k cg.PixelBuffer(L) = P.B cg.PixelBuffer(L + 1) = P.G cg.PixelBuffer(L + 2) = P.R Next i End If End Sub |
| ▲DrawLineWithClip 指定したRGB24bitBitMap構造体のカレントイメージの指定座標(x,y)に指定色の線分を描画する。 この関数は、指定座標がカレントイメージの領域内にある場合に限り描画を行う。 |
'########################################################### '### カレントイメージに指定色で直線を描画する(簡易ｸﾘｯﾌﾟ) '########################################################### Public Sub DrawLineWithClip(cg As RGB24bitBitMap, X1 As Long, Y1 As Long, X2 As Long, Y2 As Long, P As RGB24bitPixel) Dim i As Long, j As Long, k As Long, L As Long, dx As Long, Dy As Long, Sx As Long, Sy As Long, Nw As Long, NwNy As Long Nw = cg.Nw NwNy = cg.Header.Ny * Nw dx = X2 - X1 ' 3+ Dy = Y2 - Y1 ' | Sx = Sgn(dx) * 3& ' 2+ If Sx = 0 Then Sx = 3& ' | Sy = Sgn(Dy) * Nw ' 1+ If Sy = 0 Then Sy = Nw ' | dx = Abs(dx) ' 0+---+---+---+---+ Dy = Abs(Dy) ' 0 1 2 3 4 If dx > Dy Then ' Major=X, Minor=Y k = Y1 * Nw ' Minorの初期値 j = 0 For i = X1 * 3& To X2 * 3& Step Sx j = j + Dy ' Minor増加分だけ加算 If j > dx Then ' Major分を超えたらMajor分だけ減算 j = j - dx ' k = k + Sy ' Minor座標方向の移動バイト数を計算 End If If (i >= 0) And (i < Nw) And (k >= 0) And (k < NwNy) Then L = i + k cg.PixelBuffer(L) = P.B cg.PixelBuffer(L + 1) = P.G cg.PixelBuffer(L + 2) = P.R End If Next i Else ' Major=Y, Mior=X k = X1 * 3& ' Minorの初期値 j = 0 For i = Y1 * Nw To Y2 * Nw Step Sy j = j + dx ' Minor増加分だけ加算 If j > Dy Then ' Major分を超えたらMajor分だけ減算 j = j - Dy ' k = k + Sx ' Minor座標方向の移動バイト数を計算 End If If (k >= 0) And (k < Nw) And (i >= 0) And (i < NwNy) Then L = i + k cg.PixelBuffer(L) = P.B cg.PixelBuffer(L + 1) = P.G cg.PixelBuffer(L + 2) = P.R End If Next i End If End Sub |
| ▲DrawBox 指定したRGB24bitBitMap構造体のカレントイメージの指定座標(x1,y1)-(x2,y2)に指定色(P1)の線分でボックス枠線を描画し、指定色(P2)で枠線内を塗り潰す。 この関数は速度重視で、指定座標がカレントイメージの領域内にあることを前提としており、エラーチェックを行っていない。 |
'########################################################### '### カレントイメージにボックスを描画する '########################################################### Public Sub DrawBox(cg As RGB24bitBitMap, X1 As Long, Y1 As Long, X2 As Long, Y2 As Long, P1 As RGB24bitPixel, P2 As RGB24bitPixel) Dim i As Long, j As Long, k As Long, L As Long If X1 > X2 Then i = X1 X1 = X2 X2 = i End If If Y1 > Y2 Then i = Y1 Y1 = Y2 Y2 = i End If j = Y1 * cg.Nw k = Y2 * cg.Nw For i = X1 * 3& To X2 * 3& Step 3& L = i + j cg.PixelBuffer(L) = P1.B cg.PixelBuffer(L + 1) = P1.G cg.PixelBuffer(L + 2) = P1.R L = i + k cg.PixelBuffer(L) = P1.B cg.PixelBuffer(L + 1) = P1.G cg.PixelBuffer(L + 2) = P1.R Next i j = X1 * 3& k = X2 * 3& For i = Y1 * cg.Nw To Y2 * cg.Nw Step cg.Nw L = i + j cg.PixelBuffer(L) = P1.B cg.PixelBuffer(L + 1) = P1.G cg.PixelBuffer(L + 2) = P1.R L = i + k cg.PixelBuffer(L) = P1.B cg.PixelBuffer(L + 1) = P1.G cg.PixelBuffer(L + 2) = P1.R Next i For i = (X1 + 1) * 3& To (X2 - 1) * 3& Step 3& For j = (Y1 + 1) * cg.Nw To (Y2 - 1) * cg.Nw Step cg.Nw L = i + j cg.PixelBuffer(L) = P2.B cg.PixelBuffer(L + 1) = P2.G cg.PixelBuffer(L + 2) = P2.R Next j Next i End Sub |
|
|
|
| ●Lib_2DGraphicモジュールの使い方 | |
| サイズ480x400画素のイメージにsin関数を描画する。 １．RGB24bitBitMap構造体MyPicを使います。 ２．イメージサイズを480x400画素(dx=480, Dy=400)とし、 関数BuildBitMapにより画素領域を確保されるとともに基本色が定義される。イメージは基本色白でクリアされる。 ３．関数FillBitMapImageにより基本色黄でクリアされる。 ４．カラーパレット数は300色(nColor=300)とし、関数CreateMonopoleScaleでパレットが定義される。 (ただし、このパレットは以降の処理で未使用。) ５．関数DrawLineを使って基本色黒でx軸を描画する。 ６．関数DrawPixelで480x400画素のイメージスクリーンに Sin関数を描画する。 ７．関数CreateBitMapFileによりカレントディレクトリ内に ファイル名s="Wave480×400.bmp"のbmp形式ファイル を作ります。 ８．作成したbmp形式ファイルデータをImageコントロール に読み込みます。 |
Private
MyPic As
RGB24bitBitMap
' RGB24bit形式のBITMAP構造体(Colorﾃｰﾌﾞﾙも含む) Private s As String ' BITMAPﾌｧｲﾙ名称を格納するための文字列型変数 Private Sub CommandButton3_Click() Dim i As Double Const dx As Long = 480 ' x方向画素数 Const Dy As Long = 400 ' y方向画素数 Const nColor As Long = 300 ' ｶﾗｰﾊﾟﾚｯﾄの色数 s = CurDir + "\SinWave480×400.bmp" BuildBitMap dx, Dy, MyPic FillBitMapImage MyPic, MyPic.Yellow CreateMonopoleScale MyPic, nColor DrawLine MyPic, 0, 200, 479, 200, MyPic.Black For i = 0 To 479 Step 0.05 DrawPixel MyPic, CLng(i), CLng(200 + 190 * Sin(3.14 * i * 0.02)), MyPic.Blue Next i CreateBitMapFile MyPic, s Image15.Picture = LoadPicture(s) End Sub |
|
カラーパレットを使った描画を行う場合はデモプログラムBITMAP.xlsの中に用意した等高線図を描画するデモで使っています。具体的にはLib_ContourMapモジュール内にあるDrawContourルーチンのようにします。 カラーパレットは予めCreateGrayScale, CreateDipoleScale, CreateMonopoleScale等を使ってRGB24bitBitMap構造体内のColor配列に使用する色を定義しておきます。 DrawPixelやDrawLineの最後のパラメータRGB24bitPixel構造体は描画時に使う色コードとして使用されます。右例では、配列cMap()は各画素に対応した濃淡補間値データです。0〜255までの256階調におさまるように量子化が施されており、描画時に選択する色を指定するために使われています。 このような描画方法はカラー･ルックアップ･テーブル方式と呼ばれています。 |
予めメインルーチン等で以下のようにカラーパレットを作っておく。 Const nColor As Long = 256 ' ｶﾗｰﾊﾟﾚｯﾄのｻｲｽﾞを256色とする InitializeColorLookupTable MyPic, nColor ' 指定色数(nColor=256)のｶﾗｰﾊﾟﾚｯﾄ領域を確保する 予め作っておいたカラーパレットを用いて描画する事例。 '########################################################### '### 量子化後、等高線図を描画する '########################################################### Public Sub DrawContour(cg As RGB24bitBitMap, vQuantum As Double, Offset As Long, P As RGB24bitPixel) Dim i As Long, j As Long, k As Long For j = 0 To nBy - 1 For i = 0 To nBx - 1 cMap(i + j * nBx) = CLng(Map(i + j * nBx) / vQuantum) + Offset Next i Next j For j = 0 To nBy - 2 For i = 0 To nBx - 2 k = i + j * nBx If cMap(k) = cMap(k + 1) And cMap(k) = cMap(k + nBx) Then DrawPixel cg, i, j, cg.Color(cMap(k)) Else DrawPixel cg, i, j, P End If Next i Next j End Sub |
|
私設研究所Neo-Tech-Lab.com 私設研究所Neo-Tech-Lab.com 私設研究所Neo-Tech-Lab.com 私設研究所Neo-Tech-Lab.com 私設研究所Neo-Tech-Lab.com 私設研究所Neo-Tech-Lab.com |
|
| 検索キーワード | Neo-Tech-Lab NeoTechLab 上田智章 電子工作とソフトウェアのページ |