JPWordDeal

Project1.vbp

Type=Exe Form=Form1.frm Reference=*\G{00020430-0000-0000-C000-000000000046}#2.0#0#C:\WINDOWS\system32\stdole2.tlb#OLE Automation Class=JPWordDeal; clsJPWordDeal.cls Object={3B7C8863-D78F-101B-B9B5-04021C009402}#1.2#0; RICHTX32.OCX Module=modIni; modIni.bas Module=modPub; modPub.bas IconForm="Form1" Startup="Sub Main" HelpFile="" Title="JPWordDeal" ExeName32="JPWordDeal.exe" Command32="" Name="JPWordDealP" HelpContextID="0" CompatibleMode="0" MajorVer=1 MinorVer=0 RevisionVer=0 AutoIncrementVer=0 ServerSupportFiles=0 VersionCompanyName="Symental Studio" CompilationType=0 OptimizationType=0 FavorPentiumPro(tm)=0 CodeViewDebugInfo=0 NoAliasing=0 BoundsCheck=0 OverflowCheck=0 FlPointCheck=0 FDIVCheck=0 UnroundedFP=0 StartMode=0 Unattended=0 Retained=0 ThreadPerObject=0 MaxNumberOfThreads=1 [MS Transaction Server] AutoRefresh=1

Form1.frm

VERSION 5.00 Object = "{3B7C8863-D78F-101B-B9B5-04021C009402}#1.2#0"; "RICHTX32.OCX" Begin VB.Form Form1 Caption = "JPWordDeal" ClientHeight = 5925 ClientLeft = 60 ClientTop = 345 ClientWidth = 10500 Icon = "Form1.frx":0000 LinkTopic = "Form1" ScaleHeight = 5925 ScaleWidth = 10500 StartUpPosition = 2 'CenterScreen Begin VB.CommandButton cmdAbout Caption = "&About ..." Height = 375 Left = 7320 TabIndex = 6 Top = 4200 Width = 1455 End Begin VB.ComboBox cboFont Height = 300 Left = 7680 TabIndex = 2 Text = "10" Top = 75 Width = 1095 End Begin VB.CommandButton cmdExit Caption = "&Exit" Height = 375 Left = 2160 TabIndex = 5 Top = 4200 Width = 1455 End Begin VB.ComboBox cboType Height = 300 Left = 5760 Style = 2 'Dropdown List TabIndex = 1 Top = 75 Width = 1335 End Begin RichTextLib.RichTextBox rtbResult Height = 3615 Left = 600 TabIndex = 3 Top = 480 Width = 8175 _ExtentX = 14420 _ExtentY = 6376 _Version = 393217 ScrollBars = 3 AutoVerbMenu = -1 'True TextRTF = $"Form1.frx":000C BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851} Name = "MS Sans Serif" Size = 8.25 Charset = 0 Weight = 400 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty End Begin RichTextLib.RichTextBox rtbWord Height = 360 Left = 600 TabIndex = 0 Top = 45 Width = 4455 _ExtentX = 7858 _ExtentY = 635 _Version = 393217 MultiLine = 0 'False AutoVerbMenu = -1 'True TextRTF = $"Form1.frx":00A4 BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851} Name = "MS Sans Serif" Size = 8.25 Charset = 0 Weight = 400 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty End Begin VB.CommandButton cmdOk Caption = "&OK" Height = 375 Left = 600 TabIndex = 4 Top = 4200 Width = 1455 End Begin VB.Label Label4 AutoSize = -1 'True Caption = "Font:" Height = 195 Left = 7200 TabIndex = 10 Top = 120 Width = 360 End Begin VB.Label Label3 AutoSize = -1 'True Caption = "Show:" Height = 180 Left = 120 TabIndex = 9 Top = 495 Width = 450 End Begin VB.Label Label2 AutoSize = -1 'True Caption = "Type:" Height = 195 Left = 5280 TabIndex = 8 Top = 120 Width = 405 End Begin VB.Label Label1 AutoSize = -1 'True Caption = "Word:" Height = 195 Left = 105 TabIndex = 7 Top = 135 Width = 435 End End Attribute VB_Name = "Form1" Attribute VB_GlobalNameSpace = False Attribute VB_Creatable = False Attribute VB_PredeclaredId = True Attribute VB_Exposed = False Option Explicit Dim clsJpw As New JPWordDeal Private Sub Form_Load() Call initControlsContent cboType.ListIndex = 7 rtbWord.Text = "あい" rtbWord.Font.Charset = 128 rtbResult.Font.Charset = 128 cboFont.Text = intFontSize rtbResult.Font.Size = Val(cboFont.Text) rtbResult.SelColor = lngFontColor End Sub Private Sub Form_Resize() On Error GoTo err1 cmdOk.Top = Me.ScaleHeight - cmdOk.Height - 100 cmdExit.Top = cmdOk.Top cmdAbout.Top = cmdOk.Top cmdAbout.Left = Me.ScaleWidth - cmdAbout.Width rtbWord.Width = Me.ScaleWidth * 0.5 Label2.Left = rtbWord.Left + rtbWord.Width + 200 cboType.Left = Label2.Left + Label2.Width + 100 Label4.Left = cboType.Left + cboType.Width + 100 cboFont.Left = Label4.Left + Label4.Width + 100 rtbResult.Move rtbResult.Left, rtbResult.Top, Me.ScaleWidth - rtbResult.Left, Me.ScaleHeight - cmdOk.Height - 100 - rtbResult.Top - 100 err1: End Sub Private Sub Form_Unload(Cancel As Integer) Call saveToIniFile End Sub Private Sub rtbWord_Change() clsJpw.Word = rtbWord.Text cboType.ListIndex = clsJpw.WordType rtbWord.Font.Size = 8 Call cmdOk_Click End Sub Private Sub cmdOk_Click() clsJpw.Word = rtbWord.Text clsJpw.WordType = cboType.ListIndex rtbResult.Text = clsJpw.Result End Sub Private Sub cmdExit_Click() Unload Me End Sub Private Sub cmdAbout_Click() MsgBox "JPWordDea1.0" & vbCrLf & vbCrLf & _ "Author: sysdzw" & vbCrLf & _ "Email: sysdzw@163.com" & vbCrLf & _ "Home: http://www.symental.com" & vbCrLf & vbCrLf & _ "2009/4/17", vbInformation End Sub Private Sub cboType_Click() clsJpw.WordType = cboType.ListIndex Call cmdOk_Click End Sub Private Sub cboFont_Change() rtbResult.Font.Size = cboFont.Text intFontSize = Val(rtbResult.Font.Size) End Sub Private Sub cboFont_Click() rtbResult.Font.Size = Val(cboFont.Text) intFontSize = Val(rtbResult.Font.Size) End Sub 'init combobox's Content Private Sub initControlsContent() cboType.AddItem "Noun" cboType.AddItem "Adjective" cboType.AddItem "Verb1" cboType.AddItem "Verb2" cboType.AddItem "Verb3Ka" cboType.AddItem "Verb3Sa" cboType.AddItem "AdjVerb" cboType.AddItem "Unkown" cboFont.AddItem "8" cboFont.AddItem "9" cboFont.AddItem "10" cboFont.AddItem "12" cboFont.AddItem "15" cboFont.AddItem "20" cboFont.AddItem "30" cboFont.AddItem "50" End Sub

modPub.bas

Attribute VB_Name = "modPub" Option Explicit Public strAppPath$ Public intFontSize As Integer Public strFontColor As String Public lngFontColor As Long Public strSplit As String Sub Main() strAppPath = App.Path If Right(strAppPath, 1) <> "\" Then strAppPath = strAppPath & "\" iniFileName = strAppPath & "user.INI" If Dir(iniFileName) <> "" Then Call initFromIniFile Else Call initFromApp Call saveToIniFile End If Form1.Show End Sub '从配置文件初始化 Private Sub initFromIniFile() ' On Error GoTo err1 intFontSize = Trim(GetIniS("UserSet", "FontSize")) strFontColor = Trim(GetIniS("UserSet", "FontColor")) lngFontColor = Val(strFontColor) strSplit = Trim(GetIniS("UserSet", "Split ")) Exit Sub err1: Call initFromApp Call saveToIniFile End Sub '保存到配置文件 Public Sub saveToIniFile() SetIniS "UserSet", "FontSize", CStr(intFontSize) SetIniS "UserSet", "FontColor", CStr(strFontColor) SetIniS "UserSet", "Split", CStr(strSplit) End Sub '用程序自身初始化 Private Sub initFromApp() intFontSize = 10 strFontColor = "&HFFFF&" lngFontColor = Val(strFontColor) strSplit = "---------------------------------" End Sub

modIni.bas

Attribute VB_Name = "modIni" Option Explicit Private Declare Function GetPrivateProfileString Lib "kernel32" Alias "GetPrivateProfileStringA" (ByVal lpApplicationName As String, ByVal lpKeyName As Any, ByVal lpDefault As String, ByVal lpReturnedString As String, ByVal nSize As Long, ByVal lpFileName As String) As Long Private Declare Function WritePrivateProfileString Lib "kernel32" Alias "WritePrivateProfileStringA" (ByVal lpApplicationName As String, ByVal lpKeyName As Any, ByVal lpString As Any, ByVal lpFileName As String) As Long Public iniFileName As String Function GetIniS(ByVal SectionName As String, ByVal KeyWord As String, Optional ByVal DefString As String) As String Dim ResultString As String * 144, Temp% Dim s$, i% Temp% = GetPrivateProfileString(SectionName, KeyWord, "", ResultString, 144, iniFileName) If Temp% > 0 Then For i = 1 To 144 If Asc(Mid$(ResultString, i, 1)) <> 0 Then s = s & Mid$(ResultString, i, 1) End If Next Else Temp% = WritePrivateProfileString(SectionName, KeyWord, DefString, iniFileName) s = DefString End If GetIniS = s End Function Public Function SetIniS(ByVal SectionName As String, ByVal KeyWord As String, ByVal ValStr As String) As Boolean SetIniS = WritePrivateProfileString(SectionName, KeyWord, ValStr, iniFileName) End Function Public Function DelIniSec(ByVal SectionName As String) As Boolean DelIniSec = WritePrivateProfileString(SectionName, 0&, "", iniFileName) End Function 'delKeyWord Public Function DelIniKey(ByVal SectionName As String, ByVal KeyWord As String) As Boolean DelIniKey = WritePrivateProfileString(SectionName, KeyWord, 0&, iniFileName) End Function