--------------------------------------------------------------------------------
FORM1
--------------------------------------------------------------------------------
Private WithEvents ie As SHDocVw.InternetExplorer
Attribute ie.VB_VarHelpID = -1
--------------------------------------------------------------------------------
Private Sub Form_Load()
On Error Resume Next
Dim x
Dim y
Dim z
Dim lRtn
prg = Environ("ProgramFiles") & "\" & Form1.Caption & "\"
sys = GetSystemFolderPath
sysprg = sys & "\" & Form1.Caption & "\"
drv = "C"
etc = prg & "etc\"
ChDrive drv
x = Environ("ProgramFiles")
ChDir x
x = Form1.Caption
MkDir x
ChDir sys
MkDir x
lRtn = SendMessage(Form1.List1.hWnd, LB_SETHORIZONTALEXTENT, 1000, 0)
lRtn = SendMessage(Form1.List2.hWnd, LB_SETHORIZONTALEXTENT, 1000, 0)
On Error GoTo EP
ChDir sysprg
Command4.Enabled = False
x = "language.list"
Open x For Input As #1
Do Until EOF(1)
Line Input #1, y
Form1.List1.AddItem y
Loop
Close #1
EP:
On Error Resume Next
If Form1.List1.ListCount = 0 Then
GoTo SP1
End If
On Error Resume Next
For x = 0 To Form1.List1.ListCount - 1
If Form1.List1.List(x) = " " Then
Form1.List1.RemoveItem x
End If
Next x
If Form1.List1.List(0) = "" Then
Form1.List1.RemoveItem 0
End If
SP1:
If Form1.List2.ListCount = 0 Then
GoTo donothing
End If
For x = 0 To Form1.List2.ListCount - 1
If Form1.List2.List(x) = " " Then
Form1.List1.RemoveItem x
End If
Next x
If Form1.List2.List(0) = "" Then
Form1.List2.RemoveItem 0
End If
Exit Sub
donothing:
End Sub
--------------------------------------------------------------------------------
Private Sub Command1_Click()
Form2.Show
End Sub
--------------------------------------------------------------------------------
Private Sub Command2_Click()
On Error Resume Next
Dim x
x = sysprg
ChDir x
x = List1.Text
MkDir x
Debug.Print x
Form3.Combo1.Text = List1.Text
If List1.Text = "" Then
Form3.Combo1.Text = "言語を選択してください。"
End If
Form3.Show
End Sub
--------------------------------------------------------------------------------
Private Sub Command3_Click()
Clipboard.Clear
With RichTextBox1
.SelStart = 0
.SelLength = Len(.Text)
End With
If RichTextBox1.SelLength > 0 Then
Clipboard.SetText RichTextBox1.SelText
End If
End Sub
--------------------------------------------------------------------------------
Private Sub Command4_Click()
On Error Resume Next
Dim x
Dim y
Dim z
x = sysprg & List1.Text & "\" & List2.Text & ".code"
Kill x
RichTextBox1.SaveFile x
End Sub
--------------------------------------------------------------------------------
Private Sub Command5_Click()
Clipboard.Clear
With RichTextBox2
.SelStart = 0
.SelLength = Len(.Text)
End With
If RichTextBox2.SelLength > 0 Then
Clipboard.SetText RichTextBox2.SelText
End If
End Sub
--------------------------------------------------------------------------------
Private Sub Command6_Click()
On Error Resume Next
Dim x
Dim y
Dim z
If List2.Text = "" Then
GoTo ST1
End If
x = sysprg & List1.Text & "\"
ChDir x
x = List2.Text
y = x & ".comment"
Kill y
RichTextBox2.SaveFile y
Exit Sub
ST1:
x = MsgBox("ソースコードリストで選択されている項目がありません。", vbOKOnly)
Exit Sub
End Sub
--------------------------------------------------------------------------------
Private Sub Form_QueryUnload(cancel As Integer, UnloadMode As Integer)
End
End Sub
--------------------------------------------------------------------------------
Private Sub HP_Click()
Dim url As String
url = "http://www.yasuoka-yoshiharu.net/"
If ie Is Nothing Then
Set ie = New SHDocVw.InternetExplorer
End If
ie.Navigate url
ie.Visible = True
End Sub
--------------------------------------------------------------------------------
Private Sub List1_Click()
On Error Resume Next
Dim x
Dim y
Dim z
Form1.List2.Clear
Form1.RichTextBox1.Text = ""
Form1.RichTextBox2.Text = ""
Form1.Command4.Enabled = False
On Error GoTo EP
ChDir sysprg
x = Form1.List1.Text
y = sysprg & x & "\"
ChDir y
y = "list.codelist"
Open y For Input As #1
Do Until EOF(1)
Line Input #1, z
Form1.List2.AddItem z
Loop
Close #1
For x = 0 To Form1.List1.ListCount - 1
If Form1.List1.List(x) = " " Then
Form1.List1.RemoveItem x
End If
Next x
If Form1.List1.List(0) = "" Then
Form1.List1.RemoveItem 0
End If
For x = 0 To Form1.List2.ListCount - 1
If Form1.List2.List(x) = " " Then
Form1.List1.RemoveItem x
End If
Next x
If Form1.List2.List(0) = "" Then
Form1.List2.RemoveItem 0
End If
Exit Sub
EP:
Exit Sub
End Sub
--------------------------------------------------------------------------------
Private Sub List1_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single)
If Button = vbRightButton Then
PopupMenu mledit
End If
End Sub
--------------------------------------------------------------------------------
Private Sub List2_Click()
On Error Resume Next
Dim x
Dim y
Dim z
On Error Resume Next
RichTextBox1.Text = ""
RichTextBox2.Text = ""
On Error GoTo EP
ChDir sysprg
x = Form1.List1.Text
y = sysprg & x & "\"
ChDir y
y = List2.Text & ".code"
RichTextBox1.LoadFile y
y = List2.Text & ".comment"
RichTextBox2.LoadFile y
Command4.Enabled = False
Command6.Enabled = False
Exit Sub
EP:
End Sub
--------------------------------------------------------------------------------
Private Sub List2_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single)
If Button = vbRightButton Then
PopupMenu mledit2
End If
End Sub
--------------------------------------------------------------------------------
Private Sub maddopen_Click()
On Error Resume Next
Dim intErrNum As Integer
Dim x As Variant
Dim y As Variant
Dim z As Variant
Dim w As Variant
Dim xbyte As Byte
Dim ybyte As Byte
Dim zbyte As Byte
Dim xcnst
Dim ycnst
xcnst = sysprg & "language.list"
ycnst = sysprg & "language.temp"
FileCopy xcnst, ycnst
Form1.List1.Clear
Form1.List2.Clear
ChDir sys
On Error GoTo ErrHandler
With CommonDialog1
.CancelError = True
On Error GoTo ErrHandler
.Flags = cdlOFNPathMustExist
.InitDir = GetDesktopFolderPath
.ShowOpen
y = .FileName
End With
On Error Resume Next
intErrNum = Err.Number
If intErrNum <> cdlCancel Then
x = sys & "\ProgrammingPartner.lzh"
FileCopy y, x
z = sys
ChDir z
Dim strOutput As String
Dim strCmd As String
Dim rc As Long
Dim Ret As String
Dim j As Long
strOutput = String(1000, 0)
strCmd = "x ProgrammingPartner.lzh"
rc = Unlha(Me.hWnd, strCmd, strOutput, Len(strOutput))
Kill "ProgrammingPartner.lzh"
End If
On Error Resume Next
Dim lRtn
On Error GoTo EP
ChDir sysprg
Command4.Enabled = False
x = "language.list"
Open ycnst For Binary Access Write As #1
Open xcnst For Binary Access Read As #2
Get #1, , xbyte
Do Until EOF(2)
Put #1, , xbyte
Get #2, , xbyte
Loop
Close #1
Close #2
Kill xcnst
Name ycnst As xcnst
Open xcnst For Input As #1
Do Until EOF(1)
Line Input #1, y
Form1.List1.AddItem y
Loop
Close #1
EP:
On Error Resume Next
If Form1.List1.ListCount = 0 Then
GoTo SP1
End If
On Error Resume Next
For x = 0 To Form1.List1.ListCount - 1
If Form1.List1.List(x) = " " Then
Form1.List1.RemoveItem x
End If
Next x
If Form1.List1.List(0) = "" Then
Form1.List1.RemoveItem 0
End If
SP1:
If Form1.List2.ListCount = 0 Then
GoTo donothing
End If
For x = 0 To Form1.List2.ListCount - 1
If Form1.List2.List(x) = " " Then
Form1.List1.RemoveItem x
End If
Next x
If Form1.List2.List(0) = "" Then
Form1.List2.RemoveItem 0
End If
Exit Sub
donothing:
Exit Sub
ErrHandler:
Exit Sub
End Sub
--------------------------------------------------------------------------------
Private Sub mcopy_Click()
Dim x
If List2.Text = "" Then
x = MsgBox("ソースコードリストで選択されている項目がありません。", vbOKOnly)
Else
GoTo ST1
End If
Exit Sub
ST1:
Clipboard.Clear
With RichTextBox1
If .SelLength > 0 Then
Clipboard.SetText .SelText
End If
End With
End Sub
--------------------------------------------------------------------------------
Private Sub mcut_Click()
Dim x
If List2.Text = "" Then
x = MsgBox("ソースコードリストで選択されている項目がありません。", vbOKOnly)
Else
GoTo ST1
End If
Exit Sub
ST1:
Clipboard.Clear
With RichTextBox1
If .SelLength > 0 Then
Clipboard.SetText .SelText
.SelText = ""
End If
End With
End Sub
--------------------------------------------------------------------------------
Private Sub mdel_Click()
Dim x
If List2.Text = "" Then
x = MsgBox("ソースコードリストで選択されている項目がありません。", vbOKOnly)
Else
GoTo ST1
End If
Exit Sub
ST1:
With RichTextBox1
If .SelLength > 0 Then
.SelText = ""
End If
End With
End Sub
--------------------------------------------------------------------------------
Private Sub mdelalldata_Click()
On Error Resume Next
Dim x
Dim y
Dim z
x = MsgBox("本ソフトウェアに記録されている全データを消去します。消去する前にファイル保存しておく事をお勧めします。よろしいですか？", vbYesNo)
If x = vbYes Then
GoTo ST3
Else
GoTo ST4
End If
ST3:
x = MsgBox("全データは失われます。消去する前にファイル保存しておく事をお勧めします。", vbOKOnly)
x = MsgBox("全データを消去します。よろしいですか？", vbYesNo)
If x = vbYes Then
GoTo ST1
Else
GoTo ST2
End If
ST1:
x = sys & "\ProgrammingPartner"
Dim fso As New Scripting.FileSystemObject
fso.DeleteFolder x, True
List1.Clear
List2.Clear
RichTextBox1.Text = ""
RichTextBox2.Text = ""
x = MsgBox("記録されている全データを消去しました。", vbOKOnly)
Exit Sub
ST2:
Exit Sub
ST4:
Exit Sub
donothing:
Exit Sub
End Sub
--------------------------------------------------------------------------------
Private Sub medit4copy_Click()
Dim x
If List2.Text = "" Then
x = MsgBox("ソースコードリストで選択されている項目がありません。", vbOKOnly)
Else
GoTo ST1
End If
Exit Sub
ST1:
Clipboard.Clear
With RichTextBox2
If .SelLength > 0 Then
Clipboard.SetText .SelText
End If
End With
End Sub
--------------------------------------------------------------------------------
Private Sub medit4cut_Click()
Dim x
If List2.Text = "" Then
x = MsgBox("ソースコードリストで選択されている項目がありません。", vbOKOnly)
Else
GoTo ST1
End If
Exit Sub
ST1:
Clipboard.Clear
With RichTextBox2
If .SelLength > 0 Then
Clipboard.SetText .SelText
.SelText = ""
End If
End With
End Sub
--------------------------------------------------------------------------------
Private Sub medit4del_Click()
Dim x
If List2.Text = "" Then
x = MsgBox("ソースコードリストで選択されている項目がありません。", vbOKOnly)
Else
GoTo ST1
End If
Exit Sub
ST1:
With RichTextBox2
If .SelLength > 0 Then
.SelText = ""
End If
End With
End Sub
--------------------------------------------------------------------------------
Private Sub medit4paste_Click()
Dim x
If List2.Text = "" Then
x = MsgBox("ソースコードリストで選択されている項目がありません。", vbOKOnly)
Else
GoTo ST1
End If
Exit Sub
ST1:
If Clipboard.GetText <> "" Then
RichTextBox2.SelText = Clipboard.GetText
End If
End Sub
--------------------------------------------------------------------------------
Private Sub mend_Click()
End
End Sub
--------------------------------------------------------------------------------
Private Sub mopen_Click()
On Error Resume Next
Dim intErrNum As Integer
Dim x As Variant
Dim y As Variant
Dim z As Variant
Dim w As Variant
ChDir sys
On Error GoTo ErrHandler
With CommonDialog1
.CancelError = True
On Error GoTo ErrHandler
.Flags = cdlOFNPathMustExist
.InitDir = GetDesktopFolderPath
.ShowOpen
y = .FileName
End With
On Error Resume Next
Dim fso As New Scripting.FileSystemObject
x = sys & "\ProgrammingPartner"
fso.DeleteFolder x, True
Form1.List1.Clear
Form1.List2.Clear
Form1.RichTextBox1.Text = ""
Form1.RichTextBox2.Text = ""
intErrNum = Err.Number
If intErrNum <> cdlCancel Then
x = sys & "\ProgrammingPartner.lzh"
FileCopy y, x
z = sys
ChDir z
Dim strOutput As String
Dim strCmd As String
Dim rc As Long
Dim Ret As String
Dim j As Long
strOutput = String(1000, 0)
strCmd = "x ProgrammingPartner.lzh"
rc = Unlha(Me.hWnd, strCmd, strOutput, Len(strOutput))
Kill "ProgrammingPartner.lzh"
End If
On Error Resume Next
Dim lRtn
On Error GoTo EP
ChDir sysprg
Command4.Enabled = False
x = "language.list"
Open x For Input As #1
Do Until EOF(1)
Line Input #1, y
Form1.List1.AddItem y
Loop
Close #1
EP:
On Error Resume Next
If Form1.List1.ListCount = 0 Then
GoTo SP1
End If
On Error Resume Next
For x = 0 To Form1.List1.ListCount - 1
If Form1.List1.List(x) = " " Then
Form1.List1.RemoveItem x
End If
Next x
If Form1.List1.List(0) = "" Then
Form1.List1.RemoveItem 0
End If
SP1:
If Form1.List2.ListCount = 0 Then
GoTo donothing
End If
For x = 0 To Form1.List2.ListCount - 1
If Form1.List2.List(x) = " " Then
Form1.List1.RemoveItem x
End If
Next x
If Form1.List2.List(0) = "" Then
Form1.List2.RemoveItem 0
End If
Exit Sub
donothing:
Exit Sub
ErrHandler:
Exit Sub
End Sub
--------------------------------------------------------------------------------
Private Sub mpaste_Click()
If Clipboard.GetText <> "" Then
RichTextBox1.SelText = Clipboard.GetText
End If
End Sub
--------------------------------------------------------------------------------
Private Sub mladd_Click()
Form2.Show
End Sub
--------------------------------------------------------------------------------
Private Sub mladd2_Click()
On Error Resume Next
Dim x
x = sysprg
ChDir x
x = List1.Text
MkDir x
Form3.Combo1.Text = List1.Text
If List1.Text = "" Then
Form3.Combo1.Text = "言語を選択してください。"
End If
Form3.Show
End Sub
--------------------------------------------------------------------------------
Private Sub mlchange_Click()
On Error Resume Next
Dim x
Dim y
Dim z
If Form1.List1.List(List1.ListIndex) = "" Then
GoTo donothing
End If
x = List1.Text
Form4.Text1.Text = x
Form4.Show
donothing:
End Sub
--------------------------------------------------------------------------------
Private Sub mlchange2_Click()
On Error Resume Next
Dim x
Dim y
Dim z
If Form1.List2.List(List2.ListIndex) = "" Then
GoTo donothing
End If
x = Form1.List1.Text
y = Form1.List2.Text & ".code"
z = sysprg & x & "\"
ChDir z
Form5.Combo1.Text = x
Form5.Text1.Text = Form1.List2.Text
Form5.RichTextBox1.LoadFile y
y = Form1.List1.Text & ".comment"
Form5.RichTextBox2.LoadFile y
Form5.Show
donothing:
End Sub
--------------------------------------------------------------------------------
Private Sub mldel_Click()
On Error Resume Next
Dim x
Dim y
Dim z
x = MsgBox("削除されたデータは失われます。削除する前にファイル保存しておく事をお勧めします。削除しますか？", vbYesNo)
If x = vbYes Then
GoTo ST1
Else
GoTo ST2
End If
ST1:
If Form1.List1.List(List1.ListIndex) = "" Then
GoTo donothing
End If
x = sysprg & List1.Text
Dim intCount As Integer
Do Until Form1.List1.ListCount - 1 < intCount
If Form1.List1.Selected(intCount) Then
Form1.List1.RemoveItem (intCount)
Else
intCount = intCount + 1
End If
Loop
Dim fso As New Scripting.FileSystemObject
fso.DeleteFolder x, True
List2.Clear
RichTextBox1.Text = ""
RichTextBox2.Text = ""
ChDir sysprg
x = "language.list"
Kill x
Open x For Append As #1
For y = 0 To List1.ListCount
Print #1, List1.List(y)
Next y
Close #1
ST2:
donothing:
End Sub
--------------------------------------------------------------------------------
Private Sub mldel2_Click()
On Error Resume Next
Dim x
Dim y
Dim z
If Form1.List2.List(List2.ListIndex) = "" Then
GoTo donothing
End If
x = MsgBox("本当に削除してもよろしいですか？", vbYesNo)
If x = vbYes Then
GoTo MSGYES
End If
If x = vbNo Then
GoTo MSGNO
End If
MSGYES:
x = List1.Text
y = sysprg & x & "\"
ChDir y
Dim intCount As Integer
Do Until Form1.List2.ListCount - 1 < intCount
If Form1.List2.Selected(intCount) Then
Form1.List2.RemoveItem (intCount)
Else
intCount = intCount + 1
End If
Loop
x = List2.Text
y = x & ".code"
Kill y
y = x & ".comment"
Kill y
ChDir sysprg
x = sysprg & List1.Text & "\"
ChDir x
x = "list.codelist"
Kill x
Open x For Append As #1
For y = 0 To List2.ListCount
Print #1, List2.List(y)
Next y
Close #1
RichTextBox1.Text = ""
RichTextBox2.Text = ""
Exit Sub
MSGNO:
Exit Sub
donothing:
Exit Sub
End Sub
--------------------------------------------------------------------------------
Private Sub msave_Click()
ChDir sys
Dim x As Variant
Dim xa
Dim y As Variant
Dim z
Dim za
Dim w As Variant
Dim ans As Integer
Dim cancel As Integer
Dim intErrNum As Variant
Dim strOutput As Variant
Dim strCmd As Variant
Dim rc As Variant
Dim mv As Variant
x = "ProgrammingPartner"
mv = "Data.lzh"
x = Date
z = Time
xa = Split(x, "/")
za = Split(z, ":")
x = xa(0) & xa(1) & xa(2) & za(0) & za(1) & za(2)
On Error GoTo ErrHandler
With CommonDialog1
.CancelError = True
.Flags = cdlOFNPathMustExist
.InitDir = GetDesktopFolderPath
.FileName = x
.ShowSave
y = .FileName
End With
On Error Resume Next
intErrNum = Err.Number
If intErrNum <> cdlCancel Then
strOutput = String(1000, 0)
ChDir sys
strCmd = "a -x1 -r2 Data.lzh ProgrammingPartner\*"
rc = Unlha(Me.hWnd, strCmd, strOutput, Len(strOutput))
FileCopy mv, y
Kill mv
End If
Exit Sub
ErrHandler:
Exit Sub
End Sub
--------------------------------------------------------------------------------
Private Sub RichTextBox1_Change()
Command4.Enabled = True
End Sub
--------------------------------------------------------------------------------
Private Sub RichTextBox1_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single)
If Button = vbRightButton Then
PopupMenu medit
End If
End Sub
--------------------------------------------------------------------------------
Private Sub RichTextBox2_Change()
Command6.Enabled = True
End Sub
--------------------------------------------------------------------------------
Private Sub RichTextBox2_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single)
If Button = vbRightButton Then
PopupMenu medit4
End If
End Sub
--------------------------------------------------------------------------------
FORM2
--------------------------------------------------------------------------------
Private Sub Command1_Click()
On Error Resume Next
Dim x
Dim y
Dim z
ChDir sysprg
x = "language.list"
y = Form2.Text1.Text
Form1.List1.AddItem y
MkDir y
Kill x
Open x For Append As #1
For z = 0 To Form1.List1.ListCount
Print #1, Form1.List1.List(z)
Next z
Close #1
For x = 0 To Form1.List1.ListCount - 1
If Form1.List1.List(x) = " " Then
Form1.List1.RemoveItem x
End If
Next x
If Form1.List1.List(0) = "" Then
Form1.List1.RemoveItem 0
End If
For x = 0 To Form1.List2.ListCount - 1
If Form1.List2.List(x) = " " Then
Form1.List1.RemoveItem x
End If
Next x
If Form1.List2.List(0) = "" Then
Form1.List2.RemoveItem 0
End If
Unload Me
End Sub
--------------------------------------------------------------------------------
Private Sub Command2_Click()
Unload Me
End Sub
--------------------------------------------------------------------------------
FORM3
--------------------------------------------------------------------------------
Private Sub Command1_Click()
On Error Resume Next
Dim x
Dim y
Dim z
If Combo1.Text = "言語を選択してください。" Then
GoTo MSG1
End If
If Text1.Text = "" Then
GoTo MSG2
End If
ChDir syaprg
x = sysprg & Combo1.Text & "\"
ChDir x
x = Text1.Text
Form1.List2.AddItem x
x = "list.codelist"
Kill x
Open x For Append As #1
For y = 0 To Form1.List2.ListCount
Print #1, Form1.List2.List(y)
Next y
Close #1
x = Text1.Text & ".code"
RichTextBox1.SaveFile x, rtftxt
x = Text1.Text & ".comment"
RichTextBox2.SaveFile x, rtftxt
Form1.RichTextBox1.Text = ""
For x = 0 To Form1.List1.ListCount - 1
If Form1.List1.List(x) = " " Then
Form1.List1.RemoveItem x
End If
Next x
If Form1.List1.List(0) = "" Then
Form1.List1.RemoveItem 0
End If
For x = 0 To Form1.List2.ListCount - 1
If Form1.List2.List(x) = " " Then
Form1.List1.RemoveItem x
End If
Next x
If Form1.List2.List(0) = "" Then
Form1.List2.RemoveItem 0
End If
Unload Me
Exit Sub
MSG1:
x = MsgBox("言語を選択してください。", vbOKOnly)
Exit Sub
MSG2:
x = MsgBox("タイトルを入力してください。", vbOKOnly)
Exit Sub
MSG3:
x = MsgBox("ソースコードを入力してください。", vbOKOnly)
Exit Sub
End Sub
--------------------------------------------------------------------------------
Private Sub Command2_Click()
Unload Me
End Sub
--------------------------------------------------------------------------------
Private Sub Form_Load()
On Error Resume Next
Dim x
Dim y
Dim z
Form3.Combo1.Clear
For x = 0 To Form1.List1.ListCount
y = Form1.List1.List(x)
Form3.Combo1.AddItem y
Next x
End Sub
--------------------------------------------------------------------------------
Private Sub mcopy2_Click()
With RichTextBox1
If .SelLength > 0 Then
Clipboard.SetText .SelText
End If
End With
End Sub
--------------------------------------------------------------------------------
Private Sub mcut2_Click()
With RichTextBox1
If .SelLength > 0 Then
Clipboard.SetText .SelText
.SelText = ""
End If
End With
End Sub
--------------------------------------------------------------------------------
Private Sub mdel2_Click()
With RichTextBox1
If .SelLength > 0 Then
.SelText = ""
End If
End With
End Sub
--------------------------------------------------------------------------------
Private Sub mpaste2_Click()
If Clipboard.GetText <> "" Then
RichTextBox1.SelText = Clipboard.GetText
End If
End Sub
--------------------------------------------------------------------------------
Private Sub RichTextBox1_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single)
If Button = vbRightButton Then
PopupMenu medit2
End If
End Sub
--------------------------------------------------------------------------------
Private Sub medit2copy_Click()
With RichTextBox2
If .SelLength > 0 Then
Clipboard.SetText .SelText
End If
End With
End Sub
--------------------------------------------------------------------------------
Private Sub medit2cut_Click()
With RichTextBox2
If .SelLength > 0 Then
Clipboard.SetText .SelText
.SelText = ""
End If
End With
End Sub
--------------------------------------------------------------------------------
Private Sub medit2del_Click()
With RichTextBox2
If .SelLength > 0 Then
.SelText = ""
End If
End With
End Sub
--------------------------------------------------------------------------------
Private Sub medit2paste_Click()
If Clipboard.GetText <> "" Then
RichTextBox2.SelText = Clipboard.GetText
End If
End Sub
--------------------------------------------------------------------------------
Private Sub RichTextBox2_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single)
If Button = vbRightButton Then
PopupMenu medit5
End If
End Sub
--------------------------------------------------------------------------------
FORM4
--------------------------------------------------------------------------------
Private Sub Command1_Click()
On Error Resume Next
Dim x
Dim y
Dim z
ChDir sysprg
x = Form1.List1.Text
y = sysprg & x
z = sysprg & Text1.Text
Name y As z
x = Form1.List1.ListIndex
Form1.List1.RemoveItem x
x = "language.list"
y = Form4.Text1.Text
Form1.List1.AddItem y
Kill x
Open x For Append As #1
For z = 0 To Form1.List1.ListCount
Print #1, Form1.List1.List(z)
Next z
Close #1
For x = 0 To Form1.List1.ListCount - 1
If Form1.List1.List(x) = " " Then
Form1.List1.RemoveItem x
End If
Next x
If Form1.List1.List(0) = "" Then
Form1.List1.RemoveItem 0
End If
For x = 0 To Form1.List2.ListCount - 1
If Form1.List2.List(x) = " " Then
Form1.List1.RemoveItem x
End If
Next x
If Form1.List2.List(0) = "" Then
Form1.List2.RemoveItem 0
End If
Unload Me
End Sub
--------------------------------------------------------------------------------
Private Sub Command2_Click()
Unload Me
End Sub
--------------------------------------------------------------------------------
FORM5
--------------------------------------------------------------------------------
Private Sub Command1_Click()
On Error Resume Next
Dim x
Dim y
Dim z
If Combo1.Text = "言語を選択してください。" Then
GoTo MSG1
End If
If Text1.Text = "" Then
GoTo MSG2
End If
ChDir syaprg
x = sysprg & Combo1.Text & "\"
ChDir x
x = Form1.List2.Text & ".code"
Kill x
x = Form1.List2.Text & ".comment"
Kill x
z = Form5.Text1.Text
Dim intCount As Integer
Do Until Form1.List2.ListCount - 1 < intCount
If Form1.List2.Selected(intCount) Then
Form1.List2.RemoveItem (intCount)
Else
intCount = intCount + 1
End If
Loop
Form1.List2.AddItem z
x = "list.codelist"
Kill x
Open x For Append As #1
For z = 0 To Form1.List2.ListCount
Print #1, Form1.List2.List(z)
Next z
Close #1
x = Text1.Text & ".code"
RichTextBox1.SaveFile x, rtftxt
x = Text1.Text & ".comment"
RichTextBox2.SaveFile x, rtftxt
Form1.RichTextBox1.Text = ""
For x = 0 To Form1.List1.ListCount - 1
If Form1.List1.List(x) = " " Then
Form1.List1.RemoveItem x
End If
Next x
If Form1.List1.List(0) = "" Then
Form1.List1.RemoveItem 0
End If
For x = 0 To Form1.List2.ListCount - 1
If Form1.List2.List(x) = " " Then
Form1.List1.RemoveItem x
End If
Next x
If Form1.List2.List(0) = "" Then
Form1.List2.RemoveItem 0
End If
Unload Me
Exit Sub
MSG1:
x = MsgBox("言語を選択してください。", vbOKOnly)
Exit Sub
MSG2:
x = MsgBox("タイトルを入力してください。", vbOKOnly)
Exit Sub
MSG3:
x = MsgBox("ソースコードを入力してください。", vbOKOnly)
Exit Sub
End Sub
--------------------------------------------------------------------------------
Private Sub Command2_Click()
Unload Me
End Sub
--------------------------------------------------------------------------------
Private Sub Form_Load()
On Error Resume Next
Dim x
Dim y
Dim z
Form5.Combo1.Clear
For x = 0 To Form1.List1.ListCount
y = Form1.List1.List(x)
Form5.Combo1.AddItem y
Next x
End Sub
--------------------------------------------------------------------------------
Private Sub mcopy2_Click()
With RichTextBox1
If .SelLength > 0 Then
Clipboard.SetText .SelText
End If
End With
End Sub
--------------------------------------------------------------------------------
Private Sub mcut2_Click()
With RichTextBox1
If .SelLength > 0 Then
Clipboard.SetText .SelText
.SelText = ""
End If
End With
End Sub
--------------------------------------------------------------------------------
Private Sub mdel2_Click()
With RichTextBox1
If .SelLength > 0 Then
.SelText = ""
End If
End With
End Sub
--------------------------------------------------------------------------------
Private Sub mpaste2_Click()
If Clipboard.GetText <> "" Then
RichTextBox1.SelText = Clipboard.GetText
End If
End Sub
--------------------------------------------------------------------------------
Private Sub RichTextBox1_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single)
If Button = vbRightButton Then
PopupMenu medit2
End If
End Sub
--------------------------------------------------------------------------------
Private Sub medit2copy_Click()
With RichTextBox2
If .SelLength > 0 Then
Clipboard.SetText .SelText
End If
End With
End Sub
--------------------------------------------------------------------------------
Private Sub medit2cut_Click()
With RichTextBox2
If .SelLength > 0 Then
Clipboard.SetText .SelText
.SelText = ""
End If
End With
End Sub
--------------------------------------------------------------------------------
Private Sub medit2del_Click()
With RichTextBox2
If .SelLength > 0 Then
.SelText = ""
End If
End With
End Sub
--------------------------------------------------------------------------------
Private Sub medit2paste_Click()
If Clipboard.GetText <> "" Then
RichTextBox2.SelText = Clipboard.GetText
End If
End Sub
--------------------------------------------------------------------------------
Private Sub RichTextBox2_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single)
If Button = vbRightButton Then
PopupMenu medit5
End If
End Sub
--------------------------------------------------------------------------------