[[20170302072133]]　『ピクセル単位で「正規分布曲線」の画像を数値化ａx（アラン）　ページの最後に飛ぶ

『ピクセル単位で「正規分布曲線」の画像を数値化したい』（アラン）

 自力では解決できないで、困ってます。ご教授願います。
 下記の【やりたいこと】の1～8のうち、とりあえず、1～3をできるようになることが当面の目標です。

 (サンプル画像1：png)

 画像形式：bmp
 画像の色：白と黒だけ（※「正規分布曲線」、「時間メモリ（メモリ上の数値）」は黒色）
 画像の概要：「正規分布曲線（★横は時間、縦は量）」の下に、「時間メモリ」

【やりたいこと】

 1.「Form1」に貼り付けた「image1」に、「時間メモリ付きの正規分布画像」を取り込む。
    (サンプル画像1)をbmpにした画像を取り込む。
 　（画面サイズより大きな画像は、とりあえずは取り扱わないことにする。）

 2.「Form1」が動かないようにする。

(サンプル画像2)←3,5,6,7をイメージした画像

 3.正規分布曲線の下側にある開始時間のメモリ（黒色）をマウスで左クリックすると、
   クリックされたことがわかるように、クリック箇所を中心に直径6ピクセルの円（★黄色）を描く。
   そして、クリック箇所の座標を取得する。終了時間のメモリ（黒色）も同様。

 4.開始時間と終了時間をinputboxに入力する（例えば、開始点：60、終了点：80）。
  キャンセルしないで、「開始時間と終了時間」を入力したら、5～8までを自動処理する。

 5.マウスで左クリックした開始時間と終了時間のポイントを線で結ぶ（★黄色の線を描く）
   線分の長さ（ピクセル単位）を◆基準の長さにする。

 6.「5の直線」と平行な線（★オレンジ色）を、時間メモリの数字の部分より上側（かつ、正規分布曲線の下側） に描く。
    （ここは、画像により調整が必要となる。）

 7.「6の直線」と垂直上方向に、黒くなっている画像の箇所を探して、
    正規分布曲線の黒い部分に辿り着いたら、数値化する（6の直線からの距離）。
    垂直の線は★赤色で、正規分布曲線の黒い部分とぶつかった箇所を直径6ピクセルの円（★赤色）を描く。
    なお、0.1分（6秒）おきに数値化する。横が時間で、縦が量。

 8.時間(x)と量(y)の数値化ﾃﾞｰﾀを、それぞれSheet1のA列、B列に記述(5行目以降)する。
   0.1分（6秒）おきに、高さを取得しするので、例えば、時間が20分（60分～80分の期間）なら、
  「x,y」の対となっているデータ200個を取得したい。
 **********************************************************************************

 ★数値化の例
      |[A] |[B]  
 [5]  |60.0|100.8
 [6]  |60.1|100.9
 [7]  |60.2|100.8
 [8]  |60.3|100.9
 [9]  |…  |…   
 [105]|70.0|586.3
 [106]|70.1|  586
 [107]|70.2|585.6

＜使用 Excel：Excel2013、使用 OS：Windows8 ＞

 とりあえず、できるとこまで、コードを書いてみました。
 画像の黒い部分をクリックすると、スクリーン座標を2点取得します。
 ピクセル座標とポイント座標との関係も、まだ整理できていません。

 *****************************************************************************************
 'module1に記述しているｺｰﾄﾞ
  Option Explicit

 Sub ShowForm()
     Dim tgt, Tate, Yoko
     tgt = Application.GetOpenFilename(, , , , False)
     If tgt = False Then Exit Sub

     With UserForm1
          .StartUpPosition = 0
          .Left = 0
          .Top = 0
          .Height = 500
          .Width = 1000
          .Caption = ""
          .BackColor = RGB(150, 150, 150)
          .Show vbModeless
     End With

     With UserForm1.Image1
         .Picture = LoadPicture(tgt)
          Yoko = .Picture.Width / 34.5  '★微調整(Image1に画像を納めるため)
          Tate = .Picture.Height / 34.5 '★微調整(Image1に画像を納めるため)
         .PictureAlignment = fmPictureAlignmentTopLeft
         .PictureSizeMode = 0
         .Height = Tate
         .Width = Yoko
         .Left = 0
         .Top = 0
     End With

 End Sub
  *****************************************************************************************
  'UserForm1（image1のオブジェクトを貼り付けてます）に記述しているｺｰﾄﾞ

   Option Explicit

 'APIの宣言
 '---［指定した座標のRGB値を取得する］-------------------------------------------
 Private Declare Function GetPixel Lib "gdi32" _
        (ByVal hdc As Long, ByVal X As Long, _
         ByVal Y As Long) As Long

 '---［マウスカーソルの現在の位置を､スクリーン座標で取得］-----------------------
 Private Declare Function GetCursorPos Lib "user32" _
        (lpPoint As POINTAPI) As Long
 '構造体の定義
 Private Type POINTAPI
    X As Long 'x座標格納
    Y As Long 'y座標格納
 End Type

 '---［指定ウィンドウのクライアント領域デバイスコンテキストのハンドルを取得］----
 Private Declare Function GetDC Lib "user32" _
        (ByVal hwnd As Long) As Long

 '---［デバイスコンテキストを解放します］----------------------------------------
 Private Declare Function ReleaseDC Lib "user32" _
       (ByVal hwnd As Long, _
        ByVal hdc As Long) As Long

 Private i As Integer

 Private Sub Image1_MouseDown(ByVal Button As Integer, ByVal Shift As Integer, _
                              ByVal X As Single, ByVal Y As Single)

     Dim MPt As POINTAPI
     Call GetCursorPos(MPt)
     Dim hdc As Long, Color_Code As Long
     hdc = GetDC(0)
     Color_Code = GetPixel(hdc, MPt.X, MPt.Y)
     Call ReleaseDC(0, hdc)
     Dim R As Byte, G As Byte, B As Byte
     R = Color_Code And &HFF
     G = Color_Code \ &H100 And &HFF
     B = Color_Code \ &H10000 And &HFF
     If Not (R = 0 And G = 0 And B = 0) Then Exit Sub '色が黒RGB(0,0,0)でなければ、終了

    '--- MPt.X及びMPt.Y（座標原点は、画面の左上）（単位はピクセル） ----
     Dim X1, Y1, X2, Y2
     i = i + 1
     If i = 1 Then
        X1 = MPt.X
        Y1 = MPt.Y
        MsgBox i & "点名 - " & vbCr & "X: " & X1 & vbLf & "Y: " & Y1
     ElseIf i = 2 Then
        X2 = MPt.X
        Y2 = MPt.Y
        MsgBox i & "点名 - " & vbCr & "X: " & X2 & vbLf & "Y: " & Y2
     End If
     If i = 2 Then i = 0

 End Sub

 (参考にしたサイト)
[[20060624174313]]　『excel_vbaでスクリーン上のpixelの色を拾いたい』（夕焼） 
http://suvaru.com/pg/sampl/Sample100_20.html ■マウス下の色を取得
http://www5d.biglobe.ne.jp/~tomoya03/shtml/vbapi/GetColor.htm ■[スクリーン上の指定座標の色を得る] 
（アラン） 2017/03/02(木) 07:26

画像が見えませんでした。本文だけで判断しています。

まず、標準モジュールまたはフォームモジュールは、UserForm1.Show vbModeless だけで良いと思います。
他はフォーム内の動作なので、UserForm_Initializeにでも記述すれば良いでしょう。
（というのも、With UserForm1の段階で既にフォームはメモリ上に上がってしまうから）

そして、1番の画像読み込み部分は、もう出来てますよね？
2番のフォーム固定は、以下をUserFormに貼ってみてください。。

 Private Declare Function GetActiveWindow Lib "USER32" () As Long
 Private Declare Function GetSystemMenu Lib "USER32" _
    (ByVal hWnd As Long, ByVal bRevert As Long) As Long
 Private Declare Function DeleteMenu Lib "USER32" _
    (ByVal hMenu As Long, ByVal nPosition As Long, ByVal wFlags As Long) As Long
 Private Const SC_MOVE = &HF010

 Private Sub UserForm_Activate()
    Dim hWnd As Long
    Dim hMenu As Long

    hWnd = GetActiveWindow()
    hMenu = GetSystemMenu(hWnd, 0)
    Call DeleteMenu(hMenu, SC_MOVE, 0)
 End Sub

3番の円を描く方法ですが、実際に画像編集してしまうと、消す処理が面倒です。2画面持つとか工夫が必要なので。
そこで簡単案ですが、ラベルまたは別のImageコントロールを貼り、背景透過にして、これの表示／非表示及び座標を操作してみてはいかがでしょうか。ラベルの場合は●とか○にして、文字色とフォントサイズで円を描画したように見せます。 Imageの場合、透過色が使えるGIF（PNGも透過色を使えるのですが、Imageコントロールが対応していない…）で○画像を貼っておくだけです。

5番の線は、フォームだと難しいですね。シートならば直線のシェイプが使えるのですが、マウスクリックは拾えないし…。
API、特にGDIを駆使して描画する事になると思います。調べてみてください。

8番の値取得ですが、単なる画像上で処理しているので、例えばX座標からグラフ元のデータ位置を求め、元データから数値を持ってくることになるかと思います。

○や線を描く以外は、Excel標準のグラフのまま使う方が良かったりしませんかね？または、Excelではなく、ちゃんとした高級言語でプログラム作成するとか。
（???） 2017/03/02(木) 09:56

 ??? 様

 回答頂きまして、ありがとうございます。
 完成まで、遠き道のりになりそうですが、ゆっくり作成していきたいと思います。

 >画像が見えませんでした。本文だけで判断しています。

 失礼いたしました。コチラなら、見えますでしょうか？
 (サンプル画像1：png)
http://imgur.com/2kEm0I9
 (サンプル画像2)←3,5,6,7をイメージした画像 
http://imgur.com/3vdoZDM

 *******
 >まず、～UserForm_Initializeにでも記述すれば良いでしょう。 
 そのように変更してみました。

 *******
 >そして、1番の画像読み込み部分は、もう出来てますよね？

 はい、できています。
 ただ、なんで、Yoko、Tateともに、34.5で割ると、
 UserForm1.Image1の大きさが
 調整されるのかについては、根拠が不明です。
 ↓こちらのサイトで、35.2734で割ってることを拝見して、適当に34.5としてみました。
http://detail.chiebukuro.yahoo.co.jp/qa/question_detail/q12137293657?__ysp=LlBpY3R1cmVBbGlnbm1lbnQgPSBmbVBpY3R1cmVBbGlnbm1lbnRUb3BMZWZ0

 bmp画像で取り扱われる「ピクセル単位」と、
 UserForm1.Image1などのオブジェクトで取り扱われる単位（不明）
 との関係は、どうなっているんでしょうか？
 分かりましたら、教えてください。

 *******
 >2番のフォーム固定は、以下をUserFormに貼ってみてください。。

 思った通りになりました。ありがとうございます。
 調べても、よくわからないところだったので、感激しました！！

 *******
 >3番の円を描く方法ですが、実際に画像編集してしまうと、消す処理が面倒です。

 実際に画像編集した例を見つけました。
http://www5a.biglobe.ne.jp/~kkw_pl2/kkwvbs/vbabitmap.htm
 ↑コチラのPrivate Sub CommandButton2_Click()
 がヒントになりそうですが、複雑ですね…。どうしようか、迷ってます。

 なるべくなら、別素材のGIF（円とか線とか）とかは使いたくありません。
 エクセルファイル1つだけにしておきたいです。
 エクセルファイルと同じ階層にﾌｫﾙﾀﾞ（例えば、フォルダ名を画像）
 を作って、その中に、いろんな色のGIF画像（円とか線）を
 入れておくんでしょうか？

 仮に、オブジェクトを使用して円（や線）を描く場合は、
 ピクセル単位で、大きさや位置を
 制御できますでしょうか？？
[[20091127170833]]
 などを見ていると、msoShapeOvalなどのオブジェクトは、
 ピクセル単位での制御が難しいのでは、と思ってしまいます。
 わがまま、ばっかり言って、すいません。

 ******* 
 >5番の線は、フォームだと難しいですね。
 >シートならば直線のシェイプが使えるのですが、

 シートの直線のシェイプは、描画後に、マウスで動かせてしまう
 のではないかと思って、ｼｰﾄ上でなくて、Formを使用することにしました。

 *******
 >API、特にGDIを駆使して描画する事になると思います。調べてみてください。

 3,5,6,7の描画処理は、難しそうですね。
 API、GDIで、調べ直してみます。

 >8番の値取得ですが
 円や線の描画ができて、座標の関係性を理解できれば、
 8は、なんとかなりそうなのですが…。

 *******
 >○や線を描く以外は、Excel標準のグラフのまま使う方が良かったりしませんかね？

 Excel標準のグラフのまま使う？
 どういうことでしょうか？

 ******* 
 >または、Excelではなく、ちゃんとした高級言語でプログラム作成するとか。

 Excel以外もっていません。
 なにか、本事案を作成するのに、おすすめの高級言語プログラムありますか？

 ******* 
 やりたいことは、下記のフリーソフトに近いのですが、…。
 （開始時間と終了時間を、これでは正確に設定できません。）

 フリーソフトの名前：DigitalCurveTracer(windows8で動作確認済み)
 フリーソフトの概要：画像化されたグラフの座標を自動で読みとる
http://www.vector.co.jp/soft/dl/win95/business/se174822.html

 試した操作方法：画像読み込み後、座標設定で、x=1000,y=1000にした後、
 「トレーススタート」(ヘルプ タブの下)ボタンを押す。

 インストール後に、フリーソフトのアプリケーションがある場所
 C:\Program Files (x86)\DigitalCurveTracer\DCT10.exe

（アラン） 2017/03/02(木) 16:56

 34.5で、割っていたところの謎がとけたかもしれません。

 ■Excel VBAの場合
 ・LoadPictureで、取り込まれる画像の大きさの単位は、[HIMETRIC]
    1[HIMETRIC]=(96/2540)[pixcel]≒0.03779…[pixcel]

 ・UserFormやオブジェクトの大きさの単位は、[Point]
 ・bmp画像などの大きさの単位は[pixcel]

    |[A]     |[B]      |[C]    |[D]     
 [1]|    -   |pixcel   |point  |HIMETRIC
 [2]|pixcel  |    -    |★72/96|2540/96
 [3]|point   |96/72    |    -  |2540/72
 [4]|HIMETRIC|★96/2540|72/2540|    -

 次のように変更してみました。

 '------- 変更前 -------
 With UserForm1.Image1
         .Picture = LoadPicture(tgt)
          Yoko = .Picture.Width / 34.5  '★
          Tate = .Picture.Height / 34.5 '★
         .PictureAlignment = fmPictureAlignmentTopLeft
         .PictureSizeMode = 0
         .Height = Tate
         .Width = Yoko
         .Left = 0
         .Top = 0
 End With

 '------- 変更後 -------
     Dim pWidth As Long, pHeight As Long'★
     With UserForm1.Image1
         .Picture = LoadPicture(tgt)
          pWidth = CLng(.Picture.Width * (96 / 2540))'★
          pHeight = CLng(.Picture.Height * (96 / 2540))'★
          Yoko = pWidth * (72 / 96)'★
          Tate = pHeight * (72 / 96)'★
         .PictureAlignment = fmPictureAlignmentTopLeft
         .PictureSizeMode = 0
         .Height = Tate
         .Width = Yoko
         .Left = 0
         .Top = 0
     End With

 *************
 ただ、UserForm1.Image1の枠線の太さ(※仮に1ポイントだとする)
 を考慮すると、
 Yoko = pWidth * (72 / 96)+2'★
 Tate = pHeight * (72 / 96)+2'★
 と、それぞれに「+2」した方がいいのかもしれませんが…。

 *************
 引用元：VBAからGDI+を使う資料集
http://gdipluscode.sakura.ne.jp/etc/picsizenotes.html
http://officetanaka.net/excel/vba/tips/tips87.htm

    |[A]     |[B]    |[C]    |[D]   |[E]     |[F]    |[G]    
 [1]|-       |pixcel |point  |inch  |HIMETRIC|mm     |cm     
 [2]|pixcel  |-      |72/96  |1/96  |2540/96 |25.4/96|2.54/96
 [3]|point   |96/72  |-      |1/72  |2540/72 |25.4/72|2.54/72
 [4]|inch    |     96|     72|-     |    2540|   25.4|   2.54
 [5]|HIMETRIC|96/2540|72/2540|1/2540|-       |   0.01|  0.001
 [6]|mm      |96/25.4|72/25.4|1/25.4|     100|-      |    0.1
 [7]|cm      |96/2.54|72/2.54|1/2.54|    1000|     10|-

（アラン） 2017/03/02(木) 19:28

HIMETRIC単位まで理解されたのはさすがですね。APIも普通に使っていますし、何でも自力解決できそうです。以下は、補足情報です。
・LoadPictureで得られる値は、おっしゃるとおりHIMETRIC単位（0.01mm単位）。
・Excel上のセルサイズ等はpoint単位。72DPI。
・DPIは、ドット/インチ。1インチは25.4mm。
・画面解像度は一般的に96DPI。（最近の高解像度ディスプレイ等だと、100を超える場合あり）
・LoadPictureから得られるサイズを96/2540倍すると、pixel単位になる。（とりあえず96DPIと仮定）
・通分して、0.038倍、とかいてあるページも多い。（なぜこの値なのか書いていないページが多いですが）

なので、96/2540倍に変えたのは正しいです。が、今後はシステム情報から画面のDPIを得るべき時がくるだろう事を覚えておいてください。ちょっと取得が面倒なので、現状は96固定で十分ですが、予備知識として、解像度を得るコードを書いておきますね。（新しい4Kディスプレイにしたら表示が…、とかになったときに思い出してください）

 Sub test()
    Dim OBJ As Object

    With CreateObject("WbemScripting.SWbemLocator")
        For Each OBJ In .ConnectServer.ExecQuery("Select * From Win32_DisplayConfiguration")
            MsgBox OBJ.LogPixels & " DPI", vbInformation, "画面解像度"
        Next OBJ
    End With
 End Sub

次に、GIF画像の使い方ですが、予めExcelシートに画像の挿入で貼っておくと、1つのExcelブック内のオブジェクトになりますので、外に置いておく必要はありません。（今後の変更用に、元画像は残す必要がありますが）貼った後に非表示にしておき、マクロで必要なときだけ移動、表示するのです。複数点ならば、オブジェクトをコピーするコードにすればOK。

高級言語は、例えばVB.NETならば少しだけVBAと似ているし、Express版なら無料で入手、使用できますので、お薦めです。 JAVAやC#にも似ているので、これらの言語に接した事があれば、理解は早いでしょう。C言語からだとかなり遠い感じ。C++なら少し近い感じ。
（???） 2017/03/03(金) 09:35

 >??? 様

 >次に、GIF画像の使い方ですが、予めExcelシートに画像の挿入
 で貼っておくと、1つのExcelブック内のオブジェクトになりますので、

 画像シート「シート名：画像」に、Shapes.AddPictureのコードを利用
 して、透過処理をしたGIF画像を貼ってみました。
 オブジェクトのタイプは、13のmsoPicture(画像)です。
http://imgur.com/U7aORZ1

 今まで内容をファイルにしてみました。
https://box.yahoo.co.jp/guest/viewer?sid=box-l-pp7su7e6fv3ifex7u4gfkjjjpm-1001&uniqid=214f1d4b-1760-4839-b300-d62ac8502086&viewtype=detail

 *****************************************************************
 【やりたいこと】
 VBAのFormに作成したImageコントロール上で、
 背景として使用する「サンプル画像.bmp」(829ピクセル×314ピクセル)
 を表示した後に、その画像上に、
 透過処理をした「R.gif」(9ピクセル×9ピクセル)を重ねて表示したい。

 ご教授お願い致します。Formで表示できれば、どんなやり方でもいいの
 ですが…。

 Form上のImageコントロールは、画像を重ねて表示することは、
 そもそもできないのではないかと思われます…？

 VB.NETでは、　背景画像とキャラクター画像を合成する方法
http://note.chiebukuro.yahoo.co.jp/detail/n56798
 のように、画像を重ねて表示することが、できるようなのですが。

 VBAでは、画像の重ね合わせ表示は、難しいのでしょうか？
 上記URL先のコードをVBAに貼り付けても、moduleのｺｰﾄﾞ記述欄内で
 赤文字になるので、そのままでは、使えません。

 こちらは、visual basic 6.0での
 キャラと背景の合成（重ね合わせ）のようですが、使えませんかね…？
http://hp.vector.co.jp/authors/VA014315/vb3.htm

 >高級言語は、例えばVB.NETならば少しだけVBAと似ているし、Express版なら無料で入手、使用できますので、お薦めです。

 VBAの限界なのでしょうか…？  VB.NETに乗り換えるべきなのでしょうか…？

（アラン） 2017/03/06(月) 19:03

GIF画像による重ね合わせは、GIF画像を貼る方のImageコントロールのプロパティを、以下に設定してみてください。

 BackStyle: 0 - fmBackStyleTransparent
 BordderStyle: 0 - fmBorderStyleNone

VB.NETならば、PNGの透過も扱えたはずですが、VB6と同時期のVBAではPNG対応していないのが惜しいところです。
ここまではできるのですが、VBAは線の描画ができないんですよねぇ。縦または横の直線なら細くしたラベルとかで可能ですが、
グラフのような斜め線を実現できるコントロールが実装されていないのです。所詮は表計算アプリであって、言語じゃないですからね。（無茶な方法ならば、1ドットサイズまで小さくしたラベルを沢山貼る事で、直線でも曲線でも描けますが…）

斜線を引く別案として、BMP画像ならば座標換算が簡単なので、画像のバイナリ中に自前で点を打っていき線にする事です。
消すときは元の画像に戻す、と。GDIの方がまだ楽かもですけどね。
（???） 2017/03/07(火) 09:11

コメント返信：

[ 一覧(最新更新順) ]

[[20170302072133]] 『 ピクセル単位で「正規分布曲線」の画像を数値化ａx（アラン） ページの最後に飛ぶ

[[20170302072133]]　『ピクセル単位で「正規分布曲線」の画像を数値化ａx（アラン）　ページの最後に飛ぶ