Public Sub prCreateIni() '根据窗体控件生成ini文件,可在文件中设置窗体显示字体Dim pFileName, pstr As StringDim pFileNum, pIpFileName = App.Path & "ini" & App.EXEName & "_lang_" & Me.Name & ".ini"pFileNum = FreeFileOpen pFileName For Output As #pFileNumpstr = " "Print #pFileNum, pstr'设置节名pstr = "[" & Me.Name & "]"Print #pFileNum, pstr'设置窗体标题pstr = " Form." & Me.Name & " = Me.CaptionPrint #pFileNum, pstrDim pCtr As ControlFor Each pCtr In Me.ControlsIf (TypeOf pCtr Is Label) Or (TypeOf pCtr Is CommandButton) Or (TypeOf pCtr Is Frame) Or (TypeOf pCtr Is CheckBox) Thenpstr = " " & pCtr.Name & " = " & pCtr.CaptionPrint #pFileNum, pstrEnd IfNext pCtrClose #pFileNumMsgBox "Ini file for [" & Me.Name & "] have created success!"End Sub
Private Sub Command1_Click()form1.prCreateIniform2.prCreateIniform13.prCreateIniEnd Sub
[COMMON]'此部分为公用过程,请直接添加LANGUAGE = CHINESE'LANGUAGE = JAPANESE'系统语言WINDOWS=CHINESE'WINDOWS=JAPANESE'控件caption字符集Proportional Font = Simsun'Proportional Font = MS PGothic'控件文体内容字符集Regular Font = Simsun'Regular Font = MS Gothic[FORM1]cmdBatch = 批处理cmdCancel = 取消cmdSave = 保存lblMax = MaxlblMin = Min[FORM2]cmdBatch = BatchcmdCancel = CancelcmdSave = SavelblMax = MaxlblMin = Min
Private Sub prSetDisplay() '从INI文件中读取数据,设置窗体显示内容,需要在form_load中调用此过程'Read ini file to Set form display. ( Need add in FormLoad)'从INI文件中读取数据,设置窗体显示内容。(需要在FormLoad中调用此过程)Dim pIniFile$pIniFile = App.Path & "ini" & App.EXEName & "_Lang.ini"If Dir(pIniFile) = "" ThenMsgBox "Ini file of [" & pIniFile & "] not found!"Exit SubEnd IfDim pLang$, pPrp_Font, pReg_Font, pWin$Dim pCharset_datapLang$ = cfReadIniFile(pIniFile, "COMMON", "LANGUAGE") ' "JAPANESE" or "CHINESE"pPrp_Font = cfReadIniFile(pIniFile, "COMMON", "Proportional Font")pReg_Font = cfReadIniFile(pIniFile, "COMMON", "Regular Font")pWin$ = cfReadIniFile(pIniFile, "COMMON", "WINDOWS") ' "JAPANESE" or "CHINISE"If (pLang$ = "JAPANESE") And (pWin$ = "JAPANESE") ThenpCharset_data = 1ElseIf (pLang$ = "JAPANESE") And (pWin$ = "CHINESE") ThenpCharset_data = 1 '128ElseIf (pLang$ = "CHINESE") And (pWin$ = "CHINESE") ThenpCharset_data = 1ElseIf (pLang$ = "CHINESE") And (pWin$ = "JAPANESE") ThenpCharset_data = 128End If'使用示例'Label1(0).FontName = pPrp_Font'Label1(0).Font.Charset = pCharset_data'Label1(0).Caption = capt_data(1, 1)'txtPrt.FontName = reg_fontDim pCtr As ControlDim pSection As StringpSection = Me.Name'设置窗体标题Me.Caption = cfReadIniFile(pIniFile, pSection, "Form." & Me.Name)'设置各控件标题For Each pCtr In Me.ControlsIf (TypeOf pCtr Is Label) Or (TypeOf pCtr Is CommandButton) Or (TypeOf pCtr Is Frame) Or (TypeOf pCtr Is CheckBox) Then’pCtr.FontName = pPrp_Font’pCtr.Font.Charset = pCharset_datapCtr.Caption = cfReadIniFile(pIniFile, pSection, pCtr.Name)End If'If (TypeOf pCtr Is SSTab) Then'pCtr.FontName = pPrp_Font'pCtr.Font.Charset = pCharset_data'pCtr.Caption = cfReadIniFile(pIniFile, pSection, pCtr.Name)'End IfNext pCtrEnd Sub
Public Function cfReadIniFile(iniFile$, header$, item$) As String '从INI中读取数据Dim n As IntegerDim dat$, a$Dim flag As BooleanIf Dir(iniFile$) = "" Thenn = MsgBox("File:" + iniFile$ + " not found !!", vbCritical + vbOKOnly)EndElsen = FreeFileflag = Falsedat$ = ""Open iniFile$ For Input As nDo While Not EOF(n)Line Input #n, a$a$ = Trim(CutQuote(a$))If a$ <> "" ThenIf Not flag ThenIf UCase(a$) = "[" + UCase(header$) + "]" Then flag = TrueElseIf Left$(a$, 1) = "[" ThenExit DoElseIf UCase(GetItem(a$, 1)) = UCase(item$) Thendat$ = GetItem(a$, 2)Exit DoEnd IfEnd IfEnd IfEnd IfLoopClose #ncfReadIniFile = dat$End IfEnd FunctionPublic Function CutQuote(dat$) As StringIf Left$(dat$, 1) = "'" Thendat$ = ""End IfCutQuote = dat$End FunctionPublic Function GetItem(record$, orderNo) As String 'Get string from string which devides by commasDim a$, item$Dim j, pntDim dqflag As Booleanitem$ = "": pnt = 1: dqflag = FalseFor j = 1 To Len(record$)a$ = Mid$(record$, j, 1)If a$ = Chr$(34) Then ' chr$(34) is bouble quotaiondqflag = Not dqflagEnd IfIf dqflag Thenitem$ = item$ + a$ElseIf (a$ = ",") Or (a$ = "=") ThenIf pnt = orderNo ThenExit ForElseitem$ = "": pnt = pnt + 1End IfElseitem$ = item$ + a$End IfEnd IfNextIf pnt <> orderNo Thenitem$ = ""Elseitem$ = LTrim(RTrim(item$))If Left$(item$, 1) = Chr$(34) ThenIf Right$(item$, 1) = Chr$(34) Then item$ = Mid$(item$, 2, Len(item$) - 2)End IfEnd IfGetItem = item$End Function