• ベストアンサー

この型変換の内容がわかりません(LSet）

こんにちわ。以下のプログラムを解読しているのですが、型変換がどう行われているのかがわからなくて困っています。 『←ココ！！』となっているところの型変換です。PのLong型をByte型へ変換しているとは思うのですが、内容をみるとどうなってそうなったのかわからないのです。『←ココ！！』の後の値を見てみると、 bP.bP(3)は「0」 bP.bP(2)は「188」 bP.bP(1)は「97」 bP.bP(0)は「78」 となっています。LSetで「P：12345678」がどうなってこうなったのでしょうか？ 教えていただけるとうれしいです。宜しくお願いしまっす。 ***プログラム*** ’宣言 Const P As Long =12345678 Private Type bytP bP(3) As Byte End Type Private Type lngP lP As Long End Type Dim bytB(4) As Byte ’mainの中 lP.lP = P LSet bP = lP　『←ココ！！』 bytB(0) = bP.bP(3) bytB(1) = bP.bP(2) bytB(2) = bP.bP(1) bytB(3) = bP.bP(0) ******************

質問者が選んだベストアンサー

  • ベストアンサー
  • BLUEPIXY
  • ベストアンサー率50% (3003/5914)
回答No.3

LSet は、既に説明があるとおり、 ユーザー定義型のメモリ領域のコピー なんで 12345678 を１６進表現にすると、００ＢＣ６１４Ｅですから ００＝０ ＢＣ＝１８８ ６１＝９７ ４Ｅ＝７８ ですね。 やってることは、ＬｏｎｇをＢｙｔｅに切り分けているということだと思います。 単に代入するだけでいいので楽ということでしょうね。 ちょうど、Ｃ言語で言うunion みたいな感じの使い方ですね。

oxox_monkey
質問者

お礼

ありがとうございます！ そういうことですかっ！LSetの中身がよくわかりました。ありがとうございました！

その他の回答 (2)

回答No.2

いえいえ Dim bytB(4) As Byte が Dim bytB(3) As Byte ですね。 ではなく、 bP(3) As Byte を bP(4) As Byte です。 lset ですが、 http://www.microsoft.com/japan/msdn/vbasic/techinfo/upgrade/transition/default.asp にかいてあるとおり、 　 　またはユーザー定義型の変数を別のユーザー定義型変数にコピーします。 です。 C言語で言うところの memset と同じイメージですね。 ただなんでこんな面倒くさいことをしているのか意味不明です。 単に、 　long型変数P を 1byte ずつ bytB(0)->(3)へ入れているだけですから、ビット演算をしてしまえばこんなユーザ定義型など使わなくてもいいのに。 では。

oxox_monkey
質問者

お礼

ありがとうございました！

oxox_monkey
質問者

補足

ありがとうございます！ bytB(0) = bP.bP(3) bytB(1) = bP.bP(2) bytB(2) = bP.bP(1) bytB(3) = bP.bP(0) で箱が４つだから３の間違いかな。と思ったのですが。。 LSetの意味は、memsetと聞いてなんとなくわかってきました。確かになんでこんなことをしているのか不思議ですね。

回答No.1

ぱっとみて、 Private Type bytP bP(3) As Byte End Type ですが、3->4ではありませんか？ その後の 　Dim bytB(4) As Byte は４ですから。 抜粋ではなく、動くようなプログラムで載せてくれると検証しやすいのですが。

oxox_monkey
質問者

お礼

ありがとうございました！

oxox_monkey
質問者

補足

ありがとうございます！ Dim bytB(4) As Byte が Dim bytB(3) As Byte ですね。人のプログラムを解読しています。 動くプログラムはめちゃくちゃ長いんです。 LSetの構造について教えていただければ光栄です。

  1. カテゴリ
  2. [技術者向] コンピューター
  3. プログラミング・開発
  4. Visual Basic

関連するQ&A

  • 画面ハードコピーのプログラム

    　お世話になります。 　株チャートの動きを確認する為、ボタンをクリックすると、モニタに映ってるモノ全体が、瞬時に、BMPで保存されるというプログラムを作ってます。 キーボードの PrtScSysRq を押して、エクセルなどに貼付け保存という手作業をエクセルではなく BMP に置き換えて保存という事です。 　過去の類似質問を見てみますと、「ピクチャーボックスの画像を保存」はありましたが、「モニタの画像」は見当たらず、グーグルなどで検索して、ムリヤリ作ってみました。下記参照。 　しかし、実際動かしてみると、「名前がついて保存されてるが何も映っていない」「瞬時ではなく、30秒～２分くらい前の画像が保存される」という不具合になってます。 　 　この場合の正しいプログラムを教えて欲しいです。 　御教授御願いします。 form1 に　.Command1　.Picture1　を貼り付けます。 Private Type tagKEYBDINPUT wVk As Integer wScan As Integer dwFlags As Long time As Long dwExtraInfo As Long bytUnusedPadding(7) As Byte End Type Private Type tagINPUT type As Long ki As tagKEYBDINPUT End Type Private Const INPUT_KEYBOARD = 1 Private Const VK_LMENU = &HA4& Private Declare Function SendInput Lib "user32.dll" (ByVal nInputs As Long, pInputs As tagINPUT, ByVal cbSize As Long) As Long Private Declare Sub keybd_event Lib "user32.dll" (ByVal bVk As Byte, ByVal bScan As Byte, ByVal dwFlags As Long, ByVal dwExtraInfo As Long) Private Const VK_SNAPSHOT = &H2C Private Const KEYEVENTF_KEYUP = &H2 Private Const KEYEVENTF_EXTENDEDKEY = &H1 Private IYI As String, G_CC As Integer Private Sub Command1_Click() G_CC = G_CC + 1 Call keybd_event(VK_SNAPSHOT, 0, KEYEVENTF_EXTENDEDKEY, 0) Call keybd_event(VK_SNAPSHOT, 0, KEYEVENTF_EXTENDEDKEY Or KEYEVENTF_KEYUP, 0) Picture1.Picture = Clipboard.GetData IYI = "C:\test\" & G_CC & "_SAMP.BMP" Call SavePicture(Picture1.Image, IYI) Clipboard.Clear End Sub Private Sub Form_Load() With Me .ScaleMode = vbPixels With .Picture1 .Appearance = 0 .AutoRedraw = True .AutoSize = True .BorderStyle = 0 .Visible = False End With End With G_CC = 0 End Sub

  • VB6 APIを使った文字印刷について

    VB6でAPI(TextOut)を使って印刷する必要があるのですが、インターネットで調べたらサンプルがあってそれを参考にさせてもらおうと思っています。 ただ、当方としては、印刷位置と印刷文字サイズをmmで指定したく、色々試しているのですがうまくいきません。お分かりになる方どこがおかしいかご教示願えないでしょうか？ サンプルのソースコードを以下に張っておきます。formにCommandボタンを一つ張ってください。 Option Explicit Dim FX As Integer 'フォントの横サイズ Dim FY As Integer 'フォントの縦サイズ Dim cx As Long '表示X座標 Dim cy As Long '表示Y座標 Private Const DEFAULT_CHARSET = 1 Private Const OUT_DEFAULT_PRECIS = 0 Private Const DEFAULT_QUALITY = 0 Private Const DEFAULT_PITCH = 0 Private Const FF_DONTCARE = 0 Private Const LF_FACESIZE = 32 Private Type Size cx As Long cy As Long End Type Private Type LOGFONT lfHeight As Long lfWidth As Long lfEscapement As Long lfOrientation As Long lfWeight As Long lfItalic As Byte lfUnderline As Byte lfStrikeOut As Byte lfCharSet As Byte lfOutPrecision As Byte lfClipPrecision As Byte lfQuality As Byte lfPitchAndFamily As Byte lfFaceName(LF_FACESIZE) As Byte End Type Private Declare Function SelectObject Lib "gdi32" (ByVal hdc As Long, ByVal hObject As Long) As Long Private Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long Private Declare Function CreateFontIndirect Lib "gdi32" Alias "CreateFontIndirectA" (lpLogFont As LOGFONT) As Long Private Declare Function TextOut Lib "gdi32" Alias "TextOutA" (ByVal hdc As Long, ByVal x As Long, ByVal y As Long, ByVal lpString As String, ByVal nCount As Long) As Long Private Declare Function GetTextExtentPoint32 Lib "gdi32" Alias "GetTextExtentPoint32A" (ByVal hdc As Long, ByVal lpsz As String, ByVal cbString As Long, lpSize As Size) As Long Private Sub Command1_Click() Printer.Print "" '文字印刷位置縦0mm 文字幅6mm、文字高6mmで印刷 FX = 6: FY = 6 cx = 0: cy = 0 PrintText "testてすと1" '文字印刷位置縦50mm 文字幅6mm、文字高12mmで印刷 FX = 6: FY = 12 cx = 0: cy = 50 PrintText "testてすと2" '縦倍角 '文字印刷位置縦200mm 文字幅12mm、文字高6mmで印刷 FX = 12: FY = 6 cx = 0: cy = 100 PrintText "testてすと3" '横倍角 Printer.EndDoc End Sub Sub PrintText(text As String) Dim LF As LOGFONT Dim IX As Integer Dim TempByteArray() As Byte Dim ByteArrayLimit As Long Dim OldFT As Long Dim NewFT As Long Dim rtn As Long Dim hdc As Long Dim PX As Long Dim PY As Long hdc = Printer.hdc '↓(1)ここで文字印刷位置をmmかTwipに変換しているつもりなのですが・・・ PX = Printer.ScaleX(cx, vbMillimeters, vbTwips) PY = Printer.ScaleY(cy, vbMillimeters, vbTwips) With LF .lfEscapement = 0 '文字の回転角度(角度*10) '↓(2)ここで文字サイズをmmかTwipに変換しているつもりなのですが・・・ .lfHeight = Printer.ScaleY(FY, vbMillimeters, vbTwips) '文字の高さ .lfWidth = Printer.ScaleX(FX, vbMillimeters, vbTwips) '文字の幅 .lfWeight = 400 '文字の太さ .lfItalic = False '斜体 .lfUnderline = False '下線 .lfStrikeOut = False '取り消し線 .lfCharSet = DEFAULT_CHARSET .lfOutPrecision = OUT_DEFAULT_PRECIS .lfClipPrecision = OUT_DEFAULT_PRECIS .lfQuality = DEFAULT_QUALITY .lfPitchAndFamily = DEFAULT_PITCH Or FF_DONTCARE TempByteArray = StrConv("ＭＳ ゴシック", vbFromUnicode) ByteArrayLimit = UBound(TempByteArray) For IX = 0 To ByteArrayLimit .lfFaceName(IX) = TempByteArray(IX) Next End With NewFT = CreateFontIndirect(LF) OldFT = SelectObject(hdc, NewFT) TextOut hdc, PX, PY, text, LenB(StrConv(text, vbFromUnicode)) rtn = SelectObject(hdc, OldFT) rtn = DeleteObject(NewFT) End Sub 以上よろしくおねがいします。

  • タスクトレイからアイコンを削除したい

    VB6.0にて、自作のアプリ「zisaku.exe」から、タスクトレイ常駐型の他アプリケーション「aiueo.exe」を再起動したいと考えています。 しかし、色々調べて試してみたのですが、Shell_NotifyIconに設定する設定値が分からず困っています。教えていただけないでしょうか。 (「aiueo.exe」はウィンドウを持たない) 動作フロー (1)「aiueo.exe」のプロセスを削除する。(タスクマネージャにて確認。動作OK) (2)「aiueo.exe」のタスクトレイアイコンを削除する。(設定値が分からない) (3)「aiueo.exe」を起動する。(起動後は自動でタスクトレイに入る) 開発環境 WindowsXP SP2 VB6.0-SP6 コード 'タスクトレイ関連の構造体と定数 Private Type NOTIFYICONDATA cbSize As Long hWnd As Long uID As Long uFlags As Long uCallbackMessage As Long hIcon As Long szTip As String * 64 dwState As Long dwStateMask As Long End Type Private Const NIF_ICON = &H2 Private Const NIF_MESSAGE = &H1 Private Const NIF_TIP = &H4 Private Const NIM_ADD = &H0 Private Const NIM_DELETE = &H2 Private Const NIM_MODIFY = &H1 Private Const WM_MOUSEMOVE = &H200 Private Const WM_LBUTTONDBLCLK = &H203 Private Const WM_LBUTTONDOWN = &H201 Private Const WM_LBUTTONUP = &H202 Private Const WM_RBUTTONDBLCLK = &H206 Private Const WM_RBUTTONDOWN = &H204 Private Const WM_RBUTTONUP = &H205 Private Sub aiueoReStart() Dim intCnt As Integer Dim lngRet As Long Dim strBuf As String Dim strSql As String Dim lobjProcess As Object Dim lstrModule As String Dim NID As NOTIFYICONDATA lstrModule = "aiueo.exe" 'プロセスを削除する。 strSql = "SELECT * FROM win32_process WHERE name='" & lstrModule & "'" For Each lobjProcess In GetObject("winmgmts:").ExecQuery(strSql) If lstrModule = lobjProcess.Name Then lobjProcess.Terminate End If Next 'Shell_NotifyIconを使ってタスクトレイより削除する。 'NIDの設定値が分からない。 '色々試して見たけど巧くいかなかった。 Shell_NotifyIcon NIM_DELETE, NID lngRet = Shell("C:\Program Files\aiueo.exe", vbNormalNoFocus) If lngRet = 0 Then lngRet = MsgBox("起動失敗！", vbCritical) End If Exit Sub End Sub 以上です。 どうかよろしくお願い致します。 (質問するカテゴリを間違えていたため、一時削除しました。申し訳ありません。)

  • 10進を2進（32ビット）に変換

    VB2008を使っています。 10進を2進（16ビット）に変換するプログラムがあったので、 それを利用して32ビット対応にしたいのですが、 以下のプログラムの☆☆の位置でオーバーフローが発生してしまします。解決法をぜひ教えてください！！ wave1は配列で、数字データが格納されています。 100 29584 12 489 ： ここで、このデータを２進（32ビット）に変換し、 wave2という新しい配列に格納したいです。 Public Class Form1 (一部省略) 　　Const WD As Long = 300000 Private wave1(WD) As Integer 　　Private wave2(WD) As Long (一部省略) For i = 0 To 10 dec2bit = dec(wave1(i)) ☆☆ここでオーバーフロー発生 wave2(i) = dec2bit Next Private Function dec(ByRef decNum0 As Integer) Dim i As Integer Dim ret As Long Dim decNum As Long Dim dec2bit As String If decNum0 >= 0 Then '正、０はそのままセット decNum = decNum0 Else '負のときは、そのビットイメージをセット（例-1なら4294967296） decNum = 4294967296 + decNum0 End If dec2bit = "" '文字列を作成 For i = 1 To 32 '最上位ビット(最も左側のビット)が１か０か判定 ret = decNum And 2147483648 '2147483648は符号無しの&H80000000に相当 If ret <> 0 Then dec2bit = dec2bit & "1" Else dec2bit = dec2bit & "0" End If '左へ１ビットシフトする 'シフト演算子 decNum = decNum << 1 'オーバーフロー防止 If decNum >= 4294967296 Then decNum = decNum - 4294967296 End If Next Return dec2bit End Function End Class

  • VB6で他のアプリへ左右のCTRLキーを送る方法

    先に「Excel VBA で　CTRLキーを送る方法」と題して質問したものです。 VB6でSendInputを使うアドバイスを頂きCTRLを送ることが出来たので解決したと思っていましたが、左右のキーの判断が出来ていないようです。 下記のコードを実行形式にしてたとき、引数の如何にかかわらず、受け取る側（YourAppli.ws）では右のCTRLを受け取った動作をします。左のCTRL（Zキーに近い方）を受け取った動作をしてくれません。 アプリケーションに左右のCTRLを認識させる方法をご教示お願いします。 コードの作成は　http://mt-soft.sakura.ne.jp/web_dl/vb-parts/key_sendinput/​を参考に致しました。 Option Explicit Private Type KEYBDINPUT wVk As Integer wScan As Integer dwFlags As Long time As Long dwExtraInfo As Long no_use1 As Long no_use2 As Long End Type Private Type INPUT_TYPE dwType As Long xi As KEYBDINPUT End Type '仮想キーコード Private Const KEYEVENTF_KEYUP = &H2 'キーアップ Private Const KEYEVENTF_EXTENDEDKEY = &H1 'スキャンコードは拡張コード Private Const INPUT_KEYBOARD = 1 '入力タイプ：キーボード Private Const VK_CTRL = &H11 'Contorol Private Const VK_LCONTROL = &HA2 'Left_Contorol Private Const VK_RCONTROL = &HA3 'Right_Contorol Private Const VK_RETURN = &HD 'Right_Contorol Private Const KEY_DOWN = 0 'キー押し下げ Private Const KEY_UP = 1 'キーアップ '仮想キーコード・ASCII値・スキャンコード間でコードを変換する Private Declare Function MapVirtualKey Lib "user32" _ Alias "MapVirtualKeyA" (ByVal wCode As Long, _ ByVal wMapType As Long) As Long 'キーストローク、マウスの動作、ボタンのクリックをシミュレートする Private Declare Function SendInput Lib "user32.dll" _ (ByVal nInputs As Long, pInputs As INPUT_TYPE, _ ByVal cbsize As Long) As Long ' 指定時間Wait（ミリ秒） Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long) Sub Main() Const AppID = "YourAppli.ws" Dim i As Integer AppActivate AppID Select Case Command Case "L", "l" Send_LCtrl Case "R", "r" Send_RCtrl Case "" Send_Ctrl Case Else MsgBox ("Error") End Select Sleep 50 End Sub Private Sub Send_LCtrl() Call KeyEvent(VK_LCONTROL, KEY_DOWN) Call KeyEvent(VK_LCONTROL, KEY_UP) End Sub Private Sub Send_RCtrl() Call KeyEvent(VK_RCONTROL, KEY_DOWN) Call KeyEvent(VK_RCONTROL, KEY_UP) End Sub Private Sub Send_Ctrl() Call KeyEvent(VK_CTRL, KEY_DOWN) Call KeyEvent(VK_CTRL, KEY_UP) End Sub Sub KeyEvent(VkKey As Integer, UpDown As Integer) ' VkKey:仮想キーコード ' UpDown:動作(KEY_DOWN/KEY_UP) ' Dim inputevents As INPUT_TYPE With inputevents .dwType = INPUT_KEYBOARD With .xi .wVk = VkKey '操作キーコード .wScan = MapVirtualKey(VkKey, 0) 'スキャンコード If UpDown = KEY_DOWN Then 'キーDown .dwFlags = KEYEVENTF_EXTENDEDKEY Or 0 Else 'キーＵＰ .dwFlags = KEYEVENTF_EXTENDEDKEY Or KEYEVENTF_KEYUP End If .time = 0 .dwExtraInfo = 0 End With End With Call SendInput(1, inputevents, Len(inputevents)) End Sub

  • Ctrl＋Vのキーストロークを合成したいのですが

    Ctrl＋Vのキーストロークを合成して、クリップボードの内容を貼り付けたいと考えています。 いろいろ調べた結果、大体以下のように記述すればよいのではないかとおもったのですが記述に間違いがあるようです。（form上のText１内に張り付けることができません。）恐れ入りますが、何卒ご教授いただきたくお願いいたします。 Option Explicit Private Declare Sub keybd_event Lib "user32" (ByVal bVk As Byte, _ ByVal bScan As Byte, _ ByVal dwFlags As Long, _ ByVal dwExtraInfo As Long) Private Const KEYEVENTF_EXTENDEDKEY = &H1 Private Const KEYEVENTF_KEYUP = &H2 Private Const VK_CONTROL = &H11 Private Sub Command1_Click() Call keybd_event(VK_CONTROL, 0, 0, 0) Call keybd_event(Asc("V"), 0, 0, 0) Call keybd_event(Asc("V"), 0, KEYEVENTF_KEYUP, 0) Call keybd_event(VK_CONTROL, 0, KEYEVENTF_KEYUP, 0) End Sub ちなみに使用目的につきましては、form1上のWebBrowser1に開いた入力フォームの<input type="file" >に（JavaScriptでフォーカスを移したうえで）ファイルのパスを貼り付けることです。 <input type="file" >はvalueを指定できないようなので、色々考えた結果、上記のようにするしかないかと考えました。もしもほかによい方法があったら恐れ入りますがご教授いただけると大変ありがたいです。よろしくお願いします。

  • 秒数変換

    秒数を入力してそれが何日、何時間、何分、何秒に変換するプログラムを作りたいのですが Sub 秒数変換() Dim tt As Long, dd As Long, hh As Long, mm As Long, ss As Long tt = ("秒数を入力してください") mm = tt \ 60: ss = tt Mod 60 hh = mm \ 60: mm = mm Mod 60 dd = hh \ 24: hh = hh Mod 24 MsgBox tt & "秒は" & dd & "日" & hh & "時間" & mm & "分" & ss & "秒です" End Sub 自分で考えてこう作成したのですが、実行すると型があっていませんと表示がでます。なぜでしょう？

  • VB2010 CreateMailslot失敗

    お世話になります。 VB6.0→VB2010の移行をしております。 中にメールスロットを使用して通信を行っている部分があり、 その処理の移行で詰まっております。 作成したモジュール： --------------------- Private Declare Function CreateMailslot Lib "kernel32" Alias "CreateMailslotA" ( _ ByVal lpName as String, _ ByVal nMaxMessageSize As Long, _ ByVal lReadTimeout As Long, _ ByVal lpSecurityAttributes As Long) As Long Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long Private Const MAILSLOT_WAIT_FOREVER = (-1) Private Const WIN_POP_SLOT = "\\.\mailslot\MS6001" Private P_hMailslot As Long 'メールスロットOPEN Public Function SlotOpen() As Long SlotOpen = -1 '前回のクローズチェック If P_hMailslot <> 0 Then Call CloseHandle(P_hMailslot) P_hMailslot = 0 End If '★ここでエラーになります。 P_hMailslot = CreateMailslot(WIN_POP_SLOT,0,MAILSLOT_WAIT_FOREVER,0) '......続く End Function --------------------- 「デバッグ開始」よりコードを実行しており、SlotOpen()関数を呼ぶと、 ★部で「AccessViolationExceptionはハンドルされませんでした。保護されているメモリに読み取りまたは書き込み操作を行おうとしました。他のメモリが壊れていることが考えられます。」と エラーが出ます。 どこかが根本的に違うのだと思うのですが、どなたか切り分けのヒントを頂けませんか。 よろしくお願いいたします。

  • Excel2016 VBA

    Windows10 ,Excel2016 バージョン1809 , VBA7.1を使用しています。 下記のコード(ホームページに掲載されているコードを写して実行しようとした。)で、 Attributeの箇所に、　コンパイルエラーと構文エラーが出ます。 Module1をaaaにしたり、Attributesと書き換えたりしてもエラーが消えません。 どなたか正常にコンパイルする書き方を教えてください。 お願いします。 Attribute VB_Name = "Module1" '************************************ 'ラベル発行のサンプル '************************************ Option Explicit ' 各項目の配置定義用ユーザー定義 Private Type typLocation X As Long Y As Long COL As Long End Type Private Const cnsSH1 = "DATA" Private Const cnsSH2 = "LABEL" Private Const cnsSH1 = "設定" Private Const cnsOMIT = "除外" '******************************************************************************* ' ラベル発行 '******************************************************************************* Sub PrintLabels() Dim xlApp As Application Dim WBK As Workbook '本ブック Dim SH1 As Worksheet 'DATA Dim SH2 As Worksheet 'LABEL Dim SH3 As Worksheet '設定 Dim tblLoc(1 To 10) As typLocation '項目配置定義(ユーザー定義を配列化) End Sub

  • ExcelVBAで初期値のセット

    ExcelVBAで初期値のセット Typeで定義したデータタイプの変数にConstで初期値をセットしたいのですがどのようにしたら良いのでしょうか。 例えば Public Const Sdata As String = "AAAAA" Public Const Idata As Long = 1 これはできますが、 Type typeA Sdata As String Idata As Long End Type Public Const Adata As typeA = "AAAAA",1 これはできません。 Typeで定義したデータ型にいるれ方法をお教えください。 ExcelVBA Type Const で検索してみましたが見つけきれませんでした。

注目のQ&A

カテゴリ

専門家に質問してみよう

職業から探して質問する

あなたにピッタリな商品が見つかる！ OKWAVEセレクト

質問する