No.3300 MAPIMessagesについて　　投稿者：たけすぃ [01/11/28(水)11：13分]

[VBのVer] 6.0



MAPISessionとMAPIMessagesで、開封済みのメールを別フォルダーに移動

(別フォルダーにコピーして、コピー元を削除でも)



または



開封済みのメールを削除（または削除フォルダーに移動）する方法について、

教えてください



よろしくお願いします。

No.3299 RE：VBでTiffファイルを開く方法　　投稿者：花ちゃん [01/11/28(水)10：50分]

多分これでも開くと思いますが？　Shell "kodakprv.exe C:\WINDOWS\デスクトップ\a\ア.tiff"



環境等も記入して質問された方が良いかも

No.3298 数値の移動について　　投稿者：みかん [01/11/28(水)10：19分]

こんにちは。またわからないことが出てきてしまったので

どうぞよろしくお願いします。



データが自動的に入ってくるようになっているのですが、

入ってきた数値を移動させていく方法を考えています。

今、Label1、Label2、Label3、Label4、Label5があって、

そこに自動的に入ってくるデータの

1番目をLabel１、2番目をLabel２・・と言う風に表示させていって、

５番目の数字がLabel５まではいった時に、古いデータを消していって、

６番目の数字をLabel５、Label５にあった数値をLabel４・・・と、

１秒ごとに数値をずらしていって前の数値は消していきたいのですが

何か良い方法はないでしょうか？

現在は１秒ごとに変数qが１ずつ増えていくようにして、

入ってきたデータはlog(q)に格納していくように作っています。

Private Sub Timer1_Timer()

   q = q + 1

   If q > 5 Then

   Label5.Caption = log(q)

   Label4.Caption = log(q - 1)

   Label3.Caption = log(q - 2)

   Label2.Caption = log(q - 3)

   Label1.Caption = log(q - 4)

   Else

   Label1.Caotion = log(1)

   Label2.Caption = log(2)

   Label3.Caption = log(3)

   Label4.Caption = log(4)

   Label5.Caption = log(5)

   End If  

とりあえずこれでとうまくいったのですが、これだとlog(q)のデータが

どんどん増えていってしまうので変数のqを増やさないで数値を移動させていく方法を

探しています。（古いデータは消えてしまっていいです）

何かいい方法があればどうぞよろしくお願いします。

No.3297 RE:ActiveForm ？　　投稿者：ＮＡＯ★ [01/11/28(水)10：09分]

>m11_Click() でインスタンスが生成されますが、

>m12_Click() 、m13_Click() で、ともに

>「コンパイルエラー メソッド、データメンバーが見つかりません。」



メニューはどこに作られていますか？

私が想像するに、靴下さんのプログラムではメニューがForm1にあるものと

想像しています。また、実行したときにForm1が起動するようになっている

（実行したときにすでに子フォームが一つ表示されている)と思います。

もし、そうなら次のように変えてみてください。



Project1--+--Form1

          |

          +--MDIForm1--+---m11

                       +---m12

                       +---m13



Project1のプロパティで「スタートアップの設定」で

最初に起動するフォームをMDIForm1に変えています



どちらもメニューは親フォームに表示されますが

ActiveFormプロパティはMDIForm1のものなので

親フォームにメニューを使わないとMe.ActiveForm

ではエラーになるということです。

No.3296 RE:RE:RE:ActiveForm ？　　　　　　投稿者：靴下カタオ [01/11/28(水)2：11分] http://www.KenAshizuka.com/

この件に関しては、



"ActiveForm"



の部分を



"MDIForm1.ActiveForm"



と記述することにより解決しました。

これが正しい対処法かどうかもわかりませんが、

ひとまず、解決しました。

どうもありがとうございました。

No.3295 RE:RE:ActiveForm ？　　　　投稿者：靴下カタオ [01/11/28(水)1：23分] http://www.KenAshizuka.com/

ＮＡＯ★さん、いつもありがとうございます。



Form1のMDIChildプロパティが 

False のままでしたので、True にし、

それから、教えていただいたとおりに実行したところ、

m11_Click() でインスタンスが生成されますが、

m12_Click() 、m13_Click() で、ともに

「コンパイルエラー

メソッド、データメンバーが見つかりません。」

というメッセージを表示し、

m12_Click() では、

Private Sub m12_Click() の行が黄色くなり、

.ActiveForm の部分が白抜きになっていました。　

m13_Click() では、

Private Sub m13_Click() の行が黄色くなり、

同じく .ActiveForm の部分が白抜きになっていました。 



ちなみに、現在のプロジェクトの中は、



Project1 (A.vbp)

 |_Form1 (A.frm）

 |_MDIForm1 (B.frm）



となっています。この定義のしかたはこれでいいのでしょうか？

できれば以上で、何か気づかれることがあれば、

お教えいただけないでしょうか。

No.3294 VBでTiffファイルを開く方法　　投稿者：helme [01/11/27(火)18：35分]

Windowsに標準で付いているイメージビューアのプレビューソフト
（確かファイル名がkodakprv.exe）を、VBで立ち上げることができたのですが、
TiffファイルをVBSで開く事ができません。

例えばデスクトップ上にある「ａ」という名前のフォルダー内に「ア」というTiffファイルが
ある場合の開き方を教えてください。

かなり困っています。宜しくお願いします。

 

No.3293 Re：テキストファイルからの選択　　投稿者：ゆう(U) [01/11/27(火)16：37分]

> テキストファイルでもAのセルが527-0036のものとして検索を行い、それに相当

> するレコードを引っ張ってくる事は出来るのでしょうか？

CSVの様なレイアウトなのですか？

固定長のレイアウトですか？



速度を気にしなければ、素直に書いていけば簡単に出来上がるともいます。

※ファイルを読み込み比較していくだけ・・・

　対象のレコードが特定できた時点でどうするかは

　貴方の仕様です



ヘルプ参照

「Input # ステートメント」

「Line Input # ステートメント」

「Get # ステートメント」

※「ランダム アクセス」も





ファイル構成にもよりますが、ISAMデータベースとして扱えるのであれば

SQLで抽出も可能だと思います。

MSDN検索

「Connect プロパティと SourceTableName プロパティの使用例」

とかから追っていく・・・

No.3292 Re：指定したファイルの絶対パスを取得したい　　投稿者：ゆう(U) [01/11/27(火)16：08分]

> うーん、どうしたらよいですか？さっぱりです(T-T)

指定したファイルとありますが、どのような方法で

指定されるのでしょうか？



どの様に指定されるかで解決方法も変わりますが…

No.3291 RE:システム日付との比較　　投稿者：ＮＡＯ★ [01/11/27(火)15：53分]

CDate関数を使ってコンボボックスの文字列を日付型に変更すれば

普通に比較できます。

例：

if Date > CDate(text1.text) then debug.print "Past"

if Date = CDate(text1.text) then debug.print "ToDay"

if Date < CDate(text1.text) then debug.print "Future"

No.3290 システム日付との比較　　投稿者：banana [01/11/27(火)15：09分]

システム日付よりコンボボックスのリストから選択した値が前の場合は、

メッセージボックスを出力したいのですが、どのように行えばよいでしょうか？

RE:RE:漢字のみ入力できるようにする　　投稿者：スゲル [01/11/27(火)15：09分]

さっそく回答していただいて助かりました。

ＮＡＯ★さんありがとうございます。

No.3289 RE:RE:漢字のみ入力できるようにする　　投稿者：スゲル [01/11/27(火)15：08分]

さっそく回答していただいて助かりました。

ＮＡＯ★さんありがとうございます。

No.3288 Re：画像を９０度回転表示する方法　　投稿者：ゆう(U) [01/11/27(火)15：01分]

Win2000で確認したのですが、やはりEXEでは正常に動作しません。

※P-CodeコンパイルではOKですが・・・



lngColorBytesがなぜ書き換えられるのかがわからない、

GetDIBitsが失敗している理由もわからない現状です。



現在確認している状況を書きます

１．元絵用のGetDIBitsを実行した時点で、lngColorBytesが

　　書き換えられる

２．加工先のGetDBitsが失敗している(２つとも)

　　元絵用のhDC、hBitmapを

    lngResult = DeleteDC(hDC)

    lngResult = DeleteObject(hBitmap)

　　をした後なら失敗しない

　　※DeleteDCを完了してからlngHDC = CreateCompatibleDC(.hDC)

　　　からの一連のコードを書くとOKでした

　　でも「インデックスが有効範囲にありません」で動作せず・・・

　　色の転記直前では配列数も正常X,Yともに0、lngColorBytesも正常なのに

３．CreateCompatibleBitmapの代わりにCreateDIBitmapでも

　　結果は同じ

４．バイト配列とlngColorBytesは隣接していない(VarPtrで確認)

５．BITBLTで元絵をhDCに設定しているのと同じように

　　StretchBltでlngHDCに絵をコピーしていても状況に変化なし





どうもお手上げって感じです。

※気分をかえてから改めて原因を調べます

No.3287 RE:漢字のみ入力できるようにする　　投稿者：ＮＡＯ★ [01/11/27(火)14：48分]

正しく動いているか不明ですが

Private Sub Text1_Change()

    Dim CharCode As Integer

    If Len(Text1.Text) > 0 Then

        CharCode = AscW(Right$(Text1.Text, 1))

        If CharCode < &H4E00 And CharCode > &H9FAF Then

            Text1.Text = Left$(Text1.Text, Len(Text1.Text) - 1)

            Text1.SelStart = Len(Text1.Text)

        End If

    End If

End Sub

No.3286 漢字のみ入力できるようにする　　投稿者：スゲル [01/11/27(火)14：19分]

こんにちは。

テキストボックスに入力する文字を漢字のみに

制限したいのですが何かよい方法はございます

でしょうか？

No.3285 RE:ActiveForm ？　　投稿者：ＮＡＯ★ [01/11/27(火)12：34分]

肝心の ActiveForm について書くのを忘れていました。



これは親フォームの中にある子フォームの内で、

アクティブ（選択されている）になっている子フォームを指すプロパティです。

No.3284 RE:ActiveForm ？　　投稿者：ＮＡＯ★ [01/11/27(火)10：29分]

ちょっと修正してみました。

Private Sub m11_Click()

    Dim f As New Form1

    f.Show

End Sub



Private Sub m12_Click()

    If Me.ActiveForm Is Nothing Then Exit Sub

    Me.ActiveForm.ActiveControl.Text = ""

End Sub



Private Sub m13_Click()

    If Me.ActiveForm Is Nothing Then Exit Sub

    Unload Me.ActiveForm

End Sub



ActiveFormの前にMeというキーワードをつけています。

Meというキーワードは親フォーム自身のオブジェクトを指しています

MDIForm1とか書くよりも移植性が良く、自分自身を指している事がわかるのでよく使われます

>    If Me.ActiveForm Is Nothing Then Exit Sub

で子フォームがないときにはプロシージャを抜ける様にして

エラーにならないようにしています。



解説

インスタンスとはコピーされたオブジェクトのことです。

>    Dim f As New Form1

この場合Newキーワードをつけて変数を宣言することで

Form1の複製(インスタンス)の実体（オブジェクト）が作られ、

fという別名(参照)で使えるようにします



私の経験でいうと、とまどうのは、

「fがプロシージャ内でしか有効でないので(General)部に記述しなくてもいいのか？」

ということと、

「fを配列にして新しく作るフォームの分だけ作らなくてもいいのか？」

ということです。

これについては、fは「フォームが作られているメモリ」（オブジェクト）への

「アドレスしか保存していない単なる別名」（参照）なので、子フォームを

作るたびに変数を増やさなくても問題ないということです。

(もちろん外部宣言の配列にしても問題ない)

No.3283 Access2000とVB6の連携　　投稿者：Quo [01/11/26(月)23：44分]

こんばんは、はじめまして。

よろしくお願いします。

今までAccess2000のみでシステムを作成してきたのですが、今回このシステムに画像加工機能を
追加することになりました。

そこで画像を加工する画面をVB6にて作成することになりました。

いままでVBAで開発をしておりVBのコーディングは大丈夫なのですが、
Access2000との連携方法をどのようにすればよいのか全くわかりません。



今行き詰まっているところは、

1.加工元画像のパスをAccessよりパラメーターでVBの画像加工画面に渡す。

2.画像加工画面が起動している時はAccessに制御が行かないようにする。

3.画像加工画面終了時に加工後の画像のパスやサムネイル画像のパスをAccessに戻す。

  (画像加工画面では、加工した画像を保存しサムネイルも同時に保存します)

以上のようなところです。



このような場合は、画像加工画面はVBのActiveXコントロール作成で開発すのかな？

と思ったりしているのですが・・・

とにかくどのようにすれば実現できるかわかりません。

どなたかご教授お願いします。

No.3282 ActiveForm ？　　投稿者：靴下カタオ [01/11/26(月)23：34分] http://www.KenAshizuka.com/

いつもお世話になっております。



技術評論社の「Visual Basic 6.0 初級プログラミング入門(上) ：河西朝雄著」



で、ActiveForm に関する例題で、

「ＭＤIフォームのメニューの『新規フォーム』で Form1 のインスタンスを生成し、

『クリア』でアクティブフォームのアクティブコントロールの内容をクリアし、

『閉じる』でアクティブフォームをアンロード」

するプログラムとして、次のようなコードを作成しました。



Private Sub m11_Click()

    Dim f As New Form1

    f.Show

End Sub



Private Sub m12_Click()

    ActiveForm.ActiveControl.Text = " "

End Sub



Private Sub m13_Click()

    Unload ActiveForm

End Sub





フォームには Text1 〜 3 を配置しました。

m11 をクリックすると、新しいフォームが現れますが、

m12、m13 をクリックすると、

「実行時エラー '424':

オブジェクトが必要です」

というエラーメッセージを発行します。

デバッグすると、それぞれ、

    ActiveForm.ActiveControl.Text = " "

と、

    Unload ActiveForm

の行が黄色くなっていました。



ActiveForm が新しく現れたフォームであることは

確かだと思いますが、

ActiveForm というプロパティが、実体と

どのようにつながるものなのか理解できません。

前にもこれと同じような質問をさせていただきましたが、

インスタンスというものの意味がつかめず、

中途半端な理解で終わっていました。



申し訳ありませんが、おわかりになることがあれば、

教えていただけないでしょうか。

No.3281 指定したファイルの絶対パスを取得したい　　投稿者：RYO [01/11/26(月)23：12分]

うーん、どうしたらよいですか？さっぱりです(T-T)

すいません、お願いしたしますm(_ _)m

No.3280 Re：画像を９０度回転表示する方法　　投稿者：ゆう(U) [01/11/26(月)17：23分]

> あれから、色々試していて、EXE　にしたところ、色の転記のところで,異常終了してしまうのですが

> 私の環境のせいでしょうか？

> Win98 VB5.0(SP3) 32Bit Color 

Win2000では試していないのですが・・・



'BITMAPINFOを取得

myBMPINFO1.bmiHeader.biSize = Len(myBMPINFO1.bmiHeader)

このあと

lngResult = GetDIBits(hDC, hBitmap, 0, lngWidth, ByVal 0&, myBMPINFO1, DIB_RGB_COLORS)

ここの関数を実行後

lngColorBytes

の値が変化しています。



そのためCopyMemoryで不正なアクセスを

行ってしまったのでしょう。



そもそも変数が途中で変化するのが異常なので

エラー個所とは別のところに問題があるようです。

※GetDIBitsなのか？



すみません、EXEでの動作確認をしなかったミスです

詳しい原因究明と解決方法はしばらくお待ち下さい。

No.3279 RE:TABキーの設定　　　　投稿者：プー。 [01/11/26(月)17：17分]

花ちゃん、NAOさんありがとうございます。

感激です・・・。本当にありがとうございました。

No.3278 RE:TABキーの設定　　投稿者：NAO★ [01/11/26(月)17：09分]

何度もすみません。どうも頭がぼけていたみたいです

こんな感じでどうでしょう？



Private Sub cbo_FinishDate_KeyPress(KeyAscii As Integer)

    'エンターキーによるフォーカス移動の設定

    If KeyAscii = 13 Then

        '変更:フォーカスを移動させてLostFocusイベントを発生させる

        cbo_FinishTime.SetFocus

    End If

End Sub

Private Sub cbo_FinishDate_LostFocus()

        If cbo_FinishDate.Text = "" Then

            Message = MsgBox("終了日時を選択して下さい", vbExclamation + vbOKOnly, _

            "エラーメッセージ")

            '追加:フォーカスを元に戻す

            cbo_FinishDate.SetFocus

        Else

            'すでに移動しているので削除: cbo_FinishTime.SetFocus

            KeZyAscii = 0

        End If

End Sub

No.3277 RE:TABキーの設定　　投稿者：ＮＡＯ★ [01/11/26(月)16：59分]

LostFocusイベントを使って処理を分けてあげれば

TabStopをいじらなくてもすみそうです



Private Sub cbo_FinishDate_KeyPress(KeyAscii As Integer)

    'エンターキーによるフォーカス移動の設定

    If KeyAscii = 13 Then

        cbo_FinishDate_Check()

    End If

End Sub

Private Sub cbo_FinishDate_LostFocus()

        cbo_FinishDate_Check()

End Sub



'コンボの入力チェックサブルーチン

Srivate Sub cbo_FinishDate_Check()

        If cbo_FinishDate.Text = "" Then

            Message = MsgBox("終了日時を選択して下さい", vbExclamation + vbOKOnly, _

            "エラーメッセージ")

        Else

            cbo_FinishTime.SetFocus

            KeZyAscii = 0

        End If

End Sub

No.3276 テキストファイルからの選択　　投稿者：banana [01/11/26(月)16：41分]

はじめて投稿します。

現在、花ちゃんのHPにある「テキストファイル読み書き色々」というページを

行っていました。無事に出来たのですが、たとえば、Accessでいうレコード

テキストファイルでもAのセルが527-0036のものとして検索を行い、それに相当

するレコードを引っ張ってくる事は出来るのでしょうか？

もし、出来るのであれば教えていただきたいと思い投稿しました。

No.3275 RE:TABキーの設定　　投稿者：花ちゃん [01/11/26(月)16：38分]

＞＞上記の方法で実行してみましたが、エラーメッセージは表示されませんでした。



＞＞でも、タブキーは認識できません。



＞TABキーの認識って出来ないんですか？



下記のコードで止るか確認して見て下さい。



If KeyAscii = vbKeyTab Then Stop



但し、フォームのすべての TabStopをFalseにする事で、イベントを発生させられますが

No.3274 VBからブラウザーを開き、印刷して、閉じるには？　　投稿者：takei [01/11/26(月)16：05分]

はじめまして。

VBからブラウザーでhtmlファイルを開き、そのページを印刷して、

閉じるようなプログラムを作りたいと思っています。

こちらのページを参考にして、「開く・閉じる」は何とかなりそう

なのですが、「開いたページを印刷する」がどうしたらいいのか

わかりません。

データコードで名付けられた2000個のフォルダー内に各１個

index.htmlファイルがあり、それをコード順に自動で拾い出して

プリントアウトしたいのです。



環境はVB6.0、ブラウザーIE6、OSWin98SEです。

よろしくお願いいたします。

No.3273 RE:TABキーの設定　　　　投稿者：プー。 [01/11/26(月)15：26分]

＞上記の方法で実行してみましたが、エラーメッセージは表示されませんでした。



＞でも、タブキーは認識できません。



TABキーの認識って出来ないんですか？





--------------------------------------------------------------------------------

No.3272 RE:TABキーの設定　　投稿者：花ちゃん [01/11/26(月)13：40分]

＞上記の方法で実行してみましたが、エラーメッセージは表示されませんでした。



でも、タブキーは認識できません。

No.3271 RE:TABキーの設定　　投稿者：プー。 [01/11/26(月)13：01分]

上記の方法で実行してみましたが、エラーメッセージは表示されませんでした。

No.3270 RE:TABキーの設定　　投稿者：ＮＡＯ★ [01/11/26(月)12：53分]

>    If KeyAscii = 13 Or Chr(9) Then

を、



    If KeyAscii = 13 Or KeyAscii = 9 Then



ではどうでしょう？

No.3269 Re：画像を９０度回転表示する方法　　投稿者：花ちゃん [01/11/26(月)10：20分]

あれから、色々試していて、EXE　にしたところ、色の転記のところで,異常終了してしまうのですが

私の環境のせいでしょうか？

Win98 VB5.0(SP3) 32Bit Color 

No.3268 TABキーの設定　　投稿者：プー。 [01/11/26(月)10：19分]

コンボボックスのリストから選択を行い、仮に未選択の場合、

エラーメッセージを出力しようと考えています。

エンターキーの場合と同様以下のように行いましたが、型が一致しない

というエラーが出力されてしまいました。どのように修正したらよいので

しょうか？

Private Sub cbo_FinishDate_KeyPress(KeyAscii As Integer)

            

    'エンターキーによるフォーカス移動の設定

    If KeyAscii = 13 Or Chr(9) Then

        If cbo_FinishDate.Text = "" Then

            Message = MsgBox("終了日時を選択して下さい", vbExclamation + vbOKOnly, _

            "エラーメッセージ")

        Else

            cbo_FinishTime.SetFocus

            KeZyAscii = 0

        End If

    End If

        

End Sub

No.3267 RE：オブジェクトの表示・非表示　　投稿者：花ちゃん [01/11/26(月)9：31分]

ありがとうございます。

追記しておきます。

No.3266 Re:RE:vbModelessの使用方法　　　　投稿者：こばん [01/11/26(月)8：54分]

ＮＡＯ★さん　ありがとうございます

早速試してみます　うまくいくといいな〜♪

また　うまくいかなかったら　相談に乗ってください

ありがとうございました　

この掲示板あったかいひとがいてくれて感激したこばんでした

No.3265 オブジェクトの表示・非表示　　投稿者：x-88 [01/11/25(日)15：50分]

このページでは

　　　　　Private Sub Command1_Click()

　　　　　　　If Label1.Visible = True Then

　　　　　　　　　Label1.Visible = False

　　　　　　　Else

　　　　　　　　　Label1.Visible = True

　　　　　　　End If

　　　　　End Sub

としていますが

Private Sub Command1_Click()

 Label1.Visible = Not Label1.visible

End Sub

とする方法もあります

No.3264 Re：画像を９０度回転表示する方法　　投稿者：花ちゃん [01/11/25(日)11：36分]

ゆう(U)さん、ワザワザ　サンプルを作って頂きありがとうございました。

Win98 VB5.0(SP3) 16Bit Color でも　バッチリでした。

No.3263 Re：画像を９０度回転表示する方法　　投稿者：ゆう(U) [01/11/24(土)18：21分]

コンテナーが「フレームコントロール」などScale系のメソッド等を

持っていない場合の処理を忘れていました・・・



その辺は

RE：縮小表示（無題)　　投稿者：ゆう(U) [01/11/24(土)11：07分]

を参考にして下さい。

No.3262 Re：画像を９０度回転表示する方法　　投稿者：ゆう(U) [01/11/24(土)18：12分]

急拵えなのでバグがあるかも・・・異常終了はしないと思います。

※Win2000/VB6.0(SP5)/32Bit Color で確認



API関連での宣言もれはAPIビューア等でお願いします。



任意の角度の場合はCreateCompatibleBitmapを最適な大きさに

設定してしまえば後は簡単な応用で可能だと思います。



サンプル）

Private Declare Function CreateCompatibleDC Lib "gdi32" _

               (ByVal hDC As Long) As Long

Private Declare Function DeleteDC Lib "gdi32" _

               (ByVal hDC As Long) As Long

Private Declare Function CreateCompatibleBitmap Lib "gdi32" _

               (ByVal hDC As Long, _

                ByVal nWidth As Long, _

                ByVal nHeight As Long) As Long

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 BitBlt Lib "gdi32" _

               (ByVal hDestDC As Long, _

                ByVal X As Long, _

                ByVal Y As Long, _

                ByVal nWidth As Long, _

                ByVal nHeight As Long, _

                ByVal hSrcDC As Long, _

                ByVal xSrc As Long, _

                ByVal ySrc As Long, _

                ByVal dwRop As Long) As Long

Private Declare Sub CopyMemory Lib "kernel32" _

                 Alias "RtlMoveMemory" _

               (ByRef pDest As Any, _

                ByRef pSource As Any, _

                Optional ByVal ByteLen As Long = 4&)

Private Declare Function GetDIBits Lib "gdi32" _

               (ByVal aHDC As Long, _

                ByVal hBitmap As Long, _

                ByVal nStartScan As Long, _

                ByVal nNumScans As Long, _

                ByRef lpBits As Any, _

                ByRef lpBI As BITMAPINFO, _

                ByVal wUsage As Long) As Long

Private Declare Function SetDIBits Lib "gdi32" _

               (ByVal hDC As Long, _

                ByVal hBitmap As Long, _

                ByVal nStartScan As Long, _

                ByVal nNumScans As Long, _

                ByRef lpBits As Any, _

                ByRef lpBI As BITMAPINFO, _

                ByVal wUsage As Long) As Long

Private Declare Function GetObject Lib "gdi32" _

                  Alias "GetObjectA" _

               (ByVal hObject As Long, _

                ByVal nCount As Long, _

                ByRef lpObject As Any) As Long



Private Type BITMAP

  bmType As Long

  bmWidth As Long

  bmHeight As Long

  bmWidthBytes As Long

  bmPlanes As Integer

  bmBitsPixel As Integer

  bmBits As Long

End Type

Private Type BITMAPINFOHEADER

  biSize As Long

  biWidth As Long

  biHeight As Long

  biPlanes As Integer

  biBitCount As Integer

  biCompression As Long

  biSizeImage As Long

  biXPelsPerMeter As Long

  biYPelsPerMeter As Long

  biClrUsed As Long

  biClrImportant As Long

End Type

Private Type RGBQUAD

  rgbBlue As Byte

  rgbGreen As Byte

  rgbRed As Byte

  rgbReserved As Byte

End Type

Private Type BITMAPINFO

  bmiHeader As BITMAPINFOHEADER

  bmiColors As RGBQUAD

End Type



Public Sub PicRotation(ByRef myPicture As PictureBox)

Const DIB_RGB_COLORS = 0&

Const SRCCOPY = &HCC0020

  Dim myBMP As BITMAP

  Dim myBMPINFO1 As BITMAPINFO

  Dim myBMPINFO2 As BITMAPINFO

  Dim hDC As Long

  Dim lngHDC As Long

  Dim hBitmap As Long

  Dim lngHBITMAP As Long

  Dim lngResult As Long

  Dim bytArray() As Byte

  Dim bytArray2() As Byte

  Dim lngColorBytes As Long

  Dim X As Long, Y As Long

  Dim lngWidth As Long, lngHeight As Long

  Dim blnReDraw As Boolean



  With myPicture

    '継続表示属性を・・・

    blnReDraw = .AutoRedraw

    .AutoRedraw = True

    'BITMAP 構造体を取得

    lngResult = GetObject(.Picture.Handle, Len(myBMP), myBMP)

    'サイズを取得

    lngWidth = myBMP.bmWidth

    lngHeight = myBMP.bmHeight

    'メモリ上にDCを作成

    hDC = CreateCompatibleDC(.hDC)

    lngHDC = CreateCompatibleDC(.hDC)

    'ビットマップオブジェクトの作成

    hBitmap = CreateCompatibleBitmap(.hDC, lngWidth, lngHeight)

    lngHBITMAP = CreateCompatibleBitmap(.hDC, lngHeight, lngWidth)

    'メモリDCへビットマップを割付

    lngResult = SelectObject(hDC, hBitmap)

    lngResult = SelectObject(lngHDC, lngHBITMAP)

    '元絵をコピー

    lngResult = BitBlt(hDC, 0&, 0&, lngWidth, lngHeight, .hDC, 0&, 0&, SRCCOPY)

    '元絵を抹消

    Set .Picture = LoadPicture("")

    'BITMAP 構造体を取得

    lngResult = GetObject(lngHBITMAP, Len(myBMP), myBMP)

    'サイズを取得

    lngWidth = myBMP.bmWidth

    lngHeight = myBMP.bmHeight

    'バイト数／ピクセルを取得

    lngColorBytes = myBMP.bmWidthBytes \ lngWidth

    '幅を４の倍数にバイト数調整

    lngResult = (lngHeight * lngColorBytes + 3) And &HFFFFFFFC

    '配列を確保(元画像用)

    ReDim bytArray(0 To lngResult - 1, 0 To lngWidth - 1)

    '幅を４の倍数にバイト数調整

    lngResult = (lngWidth * lngColorBytes + 3) And &HFFFFFFFC

    '配列を確保(加工後用)

    ReDim bytArray2(0 To lngResult - 1, 0 To lngHeight - 1)

    'BITMAPINFOを取得

    myBMPINFO1.bmiHeader.biSize = Len(myBMPINFO1.bmiHeader)

    lngResult = GetDIBits(hDC, hBitmap, 0, lngWidth, ByVal 0&, myBMPINFO1, DIB_RGB_COLORS)

    '色情報を取得

    lngResult = GetDIBits(hDC, hBitmap, 0, lngWidth, bytArray(0, 0), myBMPINFO1, DIB_RGB_COLORS)

    'BITMAPINFOを取得

    myBMPINFO2.bmiHeader.biSize = Len(myBMPINFO2.bmiHeader)

    lngResult = GetDIBits(lngHDC, lngHBITMAP, 0, lngHeight, ByVal 0&, myBMPINFO2, DIB_RGB_COLORS)

    lngResult = GetDIBits(lngHDC, lngHBITMAP, 0, lngHeight, bytArray2(0, 0), _
         myBMPINFO2, DIB_RGB_COLORS)

    '色の転記

    For Y = 0 To lngHeight - 1

      For X = 0 To lngWidth - 1

        Call CopyMemory(bytArray2(X * lngColorBytes, lngHeight - (Y + 1)), _
            bytArray(Y * lngColorBytes, X), lngColorBytes)

      Next

    Next

    '元の色情報は不要

    Erase bytArray

    '絵を作成

    lngResult = SetDIBits(lngHDC, lngHBITMAP, 0, lngHeight, bytArray2(0, 0), _
          myBMPINFO2, DIB_RGB_COLORS)

    '新しい色情報も不要

    Erase bytArray2

    '縦横を変更

    .Move .Left, .Top, _

          .Container.ScaleX(.Container.ScaleY(.Height, .Container.ScaleMode, _
               vbPixels), vbPixels, .Container.ScaleMode), _

          .Container.ScaleY(.Container.ScaleX(.Width, .Container.ScaleMode, _
               vbPixels), vbPixels, .Container.ScaleMode)

    '更新後の絵を表示

    lngResult = BitBlt(.hDC, 0&, 0&, lngWidth, lngHeight, lngHDC, 0&, 0&, SRCCOPY)

    Set .Picture = .Image

    '後始末

    lngResult = DeleteDC(hDC)

    lngResult = DeleteDC(lngHDC)

    lngResult = DeleteObject(hBitmap)

    lngResult = DeleteObject(lngHBITMAP)

    '継続表示属性を元に戻す

    .AutoRedraw = blnReDraw

  End With

End Sub

No.3261 Re：画像を９０度回転表示する方法　　投稿者：ゆう(U) [01/11/24(土)16：55分]

> ところで、長方形の画像を９０度回転させて表示するのは、無理なんでしょうか？

> 今回のサンプルは元の画像は長方形でも、回転表示する部分は、正方形のようですが

今回のテーマはGetDIBits/SetDIBitsにこだわって

画像加工をしてみたので、画像のサイズ調整はしない

事が前提にありました。



９０度回転させるのは簡単ですが、画像のサイズの

変更が伴うのであれば、CreateCompatibleBitmap

などで作成してしまった方が簡単かもしれません。

No.3260 Re：画像を９０度回転表示する方法　　投稿者：花ちゃん [01/11/24(土)13：45分]

ゆう(U)さん、いつもありがとうございます。

早速、試させて頂きました。

ところで、長方形の画像を９０度回転させて表示するのは、無理なんでしょうか？

今回のサンプルは元の画像は長方形でも、回転表示する部分は、正方形のようですが

No.3259 Re：Accessで自分のパスを知る方法　　　　投稿者：ゆうこ [01/11/24(土)12：18分]

ゆう(U) さんへ

早々のレスありがとうございました。

出来ました！。

No.3258 Re：Accessで自分のパスを知る方法　　投稿者：ゆう(U) [01/11/24(土)11：38分]

> AccessのVBAで開発しています。

> VBで言うところのApp.Path のようなものはAccessには無いのでしょうか？



Debug.? Me.Application.CurrentDb.Name

とかでは・・・









> ※なんかチョコット語間違っててすみません

書くたびに間違っていくような・・・

※読み返している「つもり」だけじゃダメですね(謝)。

No.3257 Re：画像を９０度回転表示する方法　　投稿者：ゆう(U) [01/11/24(土)11：23分]

●訂正　RE：縮小表示（無題)

> 元投稿者の、画像を指定したピクセルの正方形になるように

「正方形に収まるように」

ですね・・・



> AutoSize、境界線(3D・フラット)、ScaleModeは

不問です。・・・・を

> Visible、コンテナーは不問です。

に書き加えて、「は」を直し忘れたり・・・



※なんかチョコット語間違っててすみません







もう流れてしまいましたが、前回の制限を減らした

コードです。



縦横サイズ制限(４の倍数も)を外しました。

※左下を基準に回転する「仕様」としてます



色数の制限は残っていますが、16Bit ColorでもOK。

※256色以下では使えません

※AutoRedraw=Falseで・・・



サンプル）

↓ここは追加

Private Declare Function GetObject Lib "gdi32" _

                  Alias "GetObjectA" _

               (ByVal hObject As Long, _

                ByVal nCount As Long, _

                ByRef lpObject As Any) As Long

Private Declare Sub CopyMemory Lib "kernel32" _

                 Alias "RtlMoveMemory" _

               (ByRef pDest As Any, _

                ByRef pSource As Any, _

                Optional ByVal ByteLen As Long = 4&)

Private Type BITMAP

  bmType As Long

  bmWidth As Long

  bmHeight As Long

  bmWidthBytes As Long

  bmPlanes As Integer

  bmBitsPixel As Integer

  bmBits As Long

End Type

↑ここまで



↓ここからは差し替え

Priavte Sub Picture1_Click()

Const DIB_RGB_COLORS = 0&

  Dim myBMP As BITMAP

  Dim myBMPINFO As BITMAPINFO

  Dim hDC As Long

  Dim hBitmap As Long

  Dim lngResult As Long

  Dim bytArray() As Byte

  Dim bytArray2() As Byte

  Dim lngColorBytes As Long

  Dim X As Long, Y As Long

  Dim lngWidth As Long, lngHeight As Long



  With Picture1

    'DCハンドルを取得

    hDC = .hDC

    'ビットマップハンドルを取得

    hBitmap = .Picture.Handle

    'BITMAP 構造体を取得

    lngResult = GetObject(hBitmap, Len(myBMP), myBMP)

    '画像の色数をチェック

    If myBMP.bmBitsPixel > 8 Then

      'サイズを取得

      lngWidth = myBMP.bmWidth

      lngHeight = myBMP.bmHeight

      '幅を４の倍数にバイト数調整

      lngColorBytes = (myBMP.bmWidthBytes + 3) And &HFFFFFFFC

      '配列を確保

      ReDim bytArray(0 To lngColorBytes - 1, 0 To lngHeight - 1)

      ReDim bytArray2(0 To lngColorBytes - 1, 0 To lngHeight - 1)

      'バイト数／ピクセルを取得

      lngColorBytes = myBMP.bmWidthBytes \ myBMP.bmWidth

    Else

      MsgBox "対象外の画像です" & vbNewLine & myBMP.bmBitsPixel & " Bits/Pixel", _

             vbExclamation, "色数不足"

      Exit Sub

    End If

    'BITMAPINFOを取得

    myBMPINFO.bmiHeader.biSize = Len(myBMPINFO.bmiHeader)

    lngResult = GetDIBits(hDC, hBitmap, 0, lngHeight, ByVal 0&, myBMPINFO, DIB_RGB_COLORS)

    '色情報を取得

    lngResult = GetDIBits(hDC, hBitmap, 0, lngHeight, bytArray(0, 0), myBMPINFO, DIB_RGB_COLORS)

    lngResult = GetDIBits(hDC, hBitmap, 0, lngHeight, bytArray2(0, 0), myBMPINFO, DIB_RGB_COLORS)

    '左下を基準に時計回りに90度回転

    If lngHeight < lngWidth Then

      '横長

      For Y = 0 To lngHeight - 1

        For X = 0 To lngHeight - 1

          Call CopyMemory(bytArray2(X * lngColorBytes, _

                          lngHeight - (Y + 1)), bytArray(Y * lngColorBytes, X), _

                          lngColorBytes)

        Next

      Next

    Else

      '縦横同じ・縦長(上付きにするならここで！)

      For Y = 0 To lngWidth - 1

        For X = 0 To lngWidth - 1

          Call CopyMemory(bytArray2(X * lngColorBytes, lngWidth - (Y + 1)), _

                          bytArray(Y * lngColorBytes, X), _

                          lngColorBytes)

        Next

      Next

    End If

    '元の色情報は不要

    Erase bytArray

    '配列の内容で更新

    lngResult = SetDIBits(hDC, hBitmap, 0, lngHeight, bytArray2(0, 0), myBMPINFO, DIB_RGB_COLORS)

    '新しい色情報も不要

    Erase bytArray2

    '更新後の絵を表示

    .Refresh

  End With

End Sub

↑ここまで

※関数にしてもOK



以下拡張用の関数です。

使用方法は読めばわかりますよね？

※bytArray2は空(GetDIBitsしない)の方が良いかも・・・

Private Sub Rotation(ByVal Width As Long, _

                     ByVal Height As Long, _

                     ByVal BpP As Long, _

                     ByRef bytArray1() As Byte, _

                     ByRef bytArray2() As Byte, _

                     Optional ByVal Degrees As Long = -90)

  Dim dblRadian As Double

  Dim dblSin As Double, dblCos As Double

  Dim dblSinYY As Double, dblCosYY As Double

  Dim lngCenterX As Long

  Dim lngCenterY As Long

  Dim X As Long, Y As Long

  Dim XX As Long, YY As Long

  Dim fromX As Long, fromY As Long

  Dim i As Long



  'ラジアンに変換＋α

  dblRadian = ((90 - (Degrees Mod 360))) * ((Atn(1) * 4) / 180)

  'Sinを計算

  dblSin = Sin(dblRadian)

  'Cosを計算

  dblCos = Cos(dblRadian)

  '中央を取得

  lngCenterX = Int(Width / 2)

  lngCenterY = Int(Height / 2)

  '回転作業

  For Y = 0 To Height - 1

    YY = Y - lngCenterY

    dblSinYY = YY * dblSin

    dblCosYY = YY * dblCos

    For X = 0 To Width - 1

      XX = X - lngCenterX

      fromX = lngCenterX + (XX * dblSin + dblCosYY)

      fromY = lngCenterY - (XX * dblCos - dblSinYY)

      If fromX >= 0 And fromX < Width - 1 Then

        If fromY >= 0 And fromY < Height - 1 Then

          Call CopyMemory(bytArray2(X * BpP, Y), bytArray1(fromX * BpP, fromY), BpP)

        End If

      End If

    Next

  Next

End Sub

※当然ですが、繰り返すと荒れていきます

No.3256 RE：縮小表示（無題)　　投稿者：ゆう(U) [01/11/24(土)11：07分]

元投稿者の、画像を指定したピクセルの正方形になるように

拡大・縮小するサンプルを作成してみました。



ピクチャーボックスコントロール１個だけで行うコードです。

※「Picture プロパティ」と「Image プロパティ」で

　処理しているだけですけど・・・





仕様）

AutoSize、境界線(3D・フラット)、ScaleModeは

Visible、コンテナーは不問です。

継続表示属性はコード内で変更後、元に戻します。



ファイルのチェックはしていないので、パスを

渡す場合は正常な物のみ引数にして下さい。



画像ファイルは「LoadPicture 関数」で読み込む

事が出来る物は全て指定できます。

※GIFに関してはライセンスに注意してください



画像ファイルへのパスを省略する場合は、

「Picture プロパティ」を参照します。

※どちらも未設定の場合は何もしません



加工前の絵には戻せません。



サンプル）

引数　myPicture  ：ピクチャーボックスコントロール

　　　FileName   ：画像ファイルへのフルパス(LoadPicture使用)

　　　SquarSize  ：正方形の１辺の長さ(ピクセル)

　　　ShowPicture：加工後に表示するか(Visible)

※myPicture以外は省略可能です

Public Sub PicReSize(ByRef myPicture As PictureBox, _

                     Optional ByVal FileName As String = vbNullString, _

                     Optional ByVal SquareSize As Long = 120, _

                     Optional ByVal ShowPicture As Boolean = True)

  Dim myContainer As Object

  Dim blnReDraw As Boolean

  Dim dblZoom As Double

  Dim sngWidth As Long

  Dim sngHeight As Long

  Dim sngFrameWidth As Single

  Dim sngFrameHeight As Single



  With myPicture

    '加工中は非表示

    .Visible = False

    '継続表示属性を・・・

    blnReDraw = .AutoRedraw

    .AutoRedraw = True

    'コンテナーがピクチャーボックス・フォーム以外なら

    If Not (TypeOf .Container Is PictureBox Or .Container Is .Parent) Then

      'コンテナーを待避

      Set myContainer = .Container

      'フォームをコンテナーにしておく(Scale系メソッド等を使うため)

      Set .Container = .Parent

    End If

    '絵を読み込む

    If Len(FileName) > 0 Then

      Set .Picture = LoadPicture(FileName)

    ElseIf .Picture Is Nothing Then

      '絵がない！

      Exit Sub

    End If

    '絵のサイズを求める(ピクセル)

    sngWidth = .ScaleX(.Picture.Width, 8, vbPixels)

    sngHeight = .ScaleY(.Picture.Height, 8, vbPixels)

    '境界線のサイズを求める(境界なしでもOK)

    sngFrameWidth = .ScaleX(.ScaleWidth, .ScaleMode, vbPixels)

    sngFrameHeight = .ScaleY(.ScaleHeight, .ScaleMode, vbPixels)

    With .Container

      sngFrameWidth = .ScaleX(sngFrameWidth, vbPixels, .ScaleMode)

      sngFrameHeight = .ScaleY(sngFrameHeight, vbPixels, .ScaleMode)

    End With

    sngFrameWidth = .Width - sngFrameWidth

    sngFrameHeight = .Height - sngFrameHeight

    '比率を求める

    If sngWidth > sngHeight Then

      dblZoom = SquareSize / sngWidth

    Else

      dblZoom = SquareSize / sngHeight

    End If

    'サイズ調整

    .Move .Left, .Top, _

          sngFrameWidth _

        + .Container.ScaleX(sngWidth * dblZoom, vbPixels, .Container.ScaleMode), _

          sngFrameHeight _

        + .Container.ScaleY(sngHeight * dblZoom, vbPixels, .Container.ScaleMode)

    '拡大・縮小コピー

    .PaintPicture .Picture, .ScaleLeft, .ScaleTop, .ScaleWidth, .ScaleHeight

    'Pictureを更新

    Set .Picture = .Image

    '元のコンテナーに戻す(Left/Topは元のまま)

    If Not (myContainer Is Nothing) Then

      Set .Container = myContainer

      Set myContainer = Nothing

    End If

    '非表示？

    .Visible = ShowPicture

    '継続表示属性を元に戻す

    .AutoRedraw = blnReDraw

  End With

End Sub

No.3255 Accessで自分のパスを知る方法　　投稿者：ゆうこ [01/11/24(土)10：52分]

こんにちわ



AccessのVBAで開発しています。

VBで言うところのApp.Path のようなものはAccessには無いのでしょうか？

どなたか　ご存知でしたら教えてください。

No.3254 RE:vbModelessの使用方法　　投稿者：ＮＡＯ★ [01/11/24(土)0：21分]

私はあんまりVBAはいじったことがないのでExcelではダメかもしれません



多分こばんさんの現状はボタンかメニューをクリックすると

フォームが表示されるようになっていて、次のような構造になっていると想像してます。



Private Sub Command1_Click()

  別のフォームを表示

  処理の続き

End Sub



これを以下のようにすればいいかと思います

（呼び出し側のフォームを「フォーム１」

　呼び出された別のフォームを「フォーム２」とします）

まずフォーム１に見えない(Visible=False) ラベル(Label1)を作ってください

その後、フォーム１とフォーム２を次のような感じでプログラムします

--------------------------

'フォーム１に記述

Private Sub Command1_Click()

  フォーム2を表示

End Sub



Private Sub Label1_Change()

    If Label1.Text = "OK" Then

　　  処理の続き

      Label1.Text=""   'テキストをを初期化

    End IF

End Sub

-------------------



'フォーム2に記述

Private Sub OKボタンをクリック

        フォーム１のLabel1のTextを変更する（例えば"OK"を代入する)

End Sub

-------------------



流れをしては次のようになります

１：フォームを表示

        ２：（フォーム２の）OKボタンが押されたらフォーム１の見えないラベルに文字を代入

３：ラベルが変更されたときのイベントプロシージャに処理が移動する

４：処理の続きを処理する

No.3253 Re:IEの終了方法　(RE:ほかのプロセスの終了)　　　投稿者：Local [01/11/23(金)22：05分]

>>★Naoさん

　ありがとうございます。

　早速試してみたところうまいこといきました

　本当にありがとうございました

No.3252 IEの終了方法　(RE:ほかのプロセスの終了)　　投稿者：ＮＡＯ★ [01/11/23(金)21：50分]

IEを終了するときは SendMessage ではなくて PostMessage 関数を使うと終了できます



Option Explicit

Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" _

        (ByVal lpClassName As String, ByVal lpWindowName As String) As Long

Private Declare Function PostMessage Lib "user32" Alias "PostMessageA" _

        (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, _
           ByVal lParam As Long) As Long

Private Const WM_CLOSE As Long = &H10



Private Sub Command1_Click()

Dim hwnd As Long

Dim Ret As Long



    hwnd = FindWindow("IEFrame", vbNullString)

    Ret = PostMessage(hwnd, WM_CLOSE, 0&, 0&)

End Sub

No.3251 ほかのプロセスの終了　　投稿者：Local [01/11/23(金)15：34分]

ほかのプロセスを終了させる方法は逆引きにあったのですが

なぜかIEだけ終了させることが出来ません。



既に出ている質問かもしれないかと思い

ログ調べたところ　No.183で素人工房さんでサンプルがあると書いてあったのですが

素人工房さんへのリンクが既に無くなっておられました（＾＾；



どなたか、この現象が解る方おられましたら回答お願いします。

VBレスキュー(花ちゃん)
Visual Basic6.0　 VB6.0