''This Macro is to create automatically translations for a traditional Chinese target list
''from the corresponding simplified Chinese translation list.
''idea and implemented by gnatix 2007.03.18
''-----------------------------------------------------------------------------------------
''
Private Const STARTF_USESHOWWINDOW& = &H1
Private Const NORMAL_PRIORITY_CLASS = &H20&
Private Const INFINITE = -1&

Private Type STARTUPINFO
    cb As Long
    lpReserved As String
    lpDesktop As String
    lpTitle As String
    dwX As Long
    dwY As Long
    dwXSize As Long
    dwYSize As Long
    dwXCountChars As Long
    dwYCountChars As Long
    dwFillAttribute As Long
    dwFlags As Long
    wShowWindow As Integer
    cbReserved2 As Integer
    lpReserved2 As Long
    hStdInput As Long
    hStdOutput As Long
    hStdError As Long
End Type

Private Type PROCESS_INFORMATION
    hProcess As Long
    hThread As Long
    dwProcessID As Long
    dwThreadID As Long
End Type

Private Declare Function WaitForSingleObject Lib "kernel32" (ByVal _
    hHandle As Long, ByVal dwMilliseconds As Long) As Long

Private Declare Function CreateProcessA Lib "kernel32" (ByVal _
    lpApplicationName As Long, ByVal lpCommandLine As String, ByVal _
    lpProcessAttributes As Long, ByVal lpThreadAttributes As Long, _
    ByVal bInheritHandles As Long, ByVal dwCreationFlags As Long, _
    ByVal lpEnvironment As Long, ByVal lpCurrentDirectory As Long, _
    lpStartupInfo As STARTUPINFO, lpProcessInformation As _
    PROCESS_INFORMATION) As Long

Private Declare Function CloseHandle Lib "kernel32" (ByVal _
    hObject As Long) As Long

Public Sub ShellWait(Pathname As String, Optional WindowStyle As Long)
    Dim proc As PROCESS_INFORMATION
    Dim start As STARTUPINFO
    Dim ret As Long
    ' Initialize the STARTUPINFO structure:
    With start
        .cb = Len(start)
        If Not IsMissing(WindowStyle) Then
            .dwFlags = STARTF_USESHOWWINDOW
            .wShowWindow = WindowStyle
        End If
    End With
    ' Start the shelled application:
    ret& = CreateProcessA(0&, Pathname, 0&, 0&, 1&, _
            NORMAL_PRIORITY_CLASS, 0&, 0&, start, proc)
    ' Wait for the shelled application to finish:
    ret& = WaitForSingleObject(proc.hProcess, INFINITE)
    ret& = CloseHandle(proc.hProcess) 
End Sub
'' Code above Courtesy of Terry Kreft
Sub main
Dim trn As PslTransList
Dim trns As PslTransLists
Dim big5trn As PslTransList
Dim prj As PslProject
Dim addinid As String
Dim concmd As String

Set prj = PSL.ActiveProject
If prj Is Nothing Then
	MsgBox "目前没有打开方案！",vbOkOnly+vbInformation,"信息"
	Exit Sub
End If

Set trns = prj.TransLists
If trns Is Nothing Then
	MsgBox "方案中没有翻译列表！",vbOkOnly+vbInformation,"信息"
	Exit Sub
End If

Set trn = PSL.ActiveTransList
If trn Is Nothing Then
	MsgBox "请选择一个简体中文翻译列表！",vbOkOnly+vbInformation,"信息"
	Exit Sub
End If

If trn.Language.LangID <> 2052 Then
	MsgBox "请选择一个简体中文翻译列表！",vbOkOnly+vbInformation,"信息"
	Exit Sub
End If

concmd = GetSetting("gb2big5", "settings", "concmd", "C:\Program Files\ConCMD")
If PSL.Option(pslOptionSystemLanguage) = 2052 Then
	addinid = "PASSOLO 文本格式"
Else
	addinid = "PASSOLO text format"
End If

Set big5trn = trns(trn.SourceList, 1028)

If Not big5trn Is Nothing Then
	If Not Dir(concmd & "\concmd.exe") > "" Then
		MsgBox "找不到转换内码所需要的程序:" & Chr$(13) & "  " & concmd & "\ConCmd.exe" & Chr$(13)&Chr$(13) & _
		 "请将它安装到指定文件夹！",vbOkOnly+vbInformation,"信息"
		Exit Sub
	End If

	Dim MsgText As String
	MsgText = "您选择了: 翻译列表 - " & trn.SourceList.Title & ":" & PSL.GetLangCode(trn.Language.LangID,pslCodeText) & Chr$(13)&Chr$(13) & _
		"这将复制该翻译列表中的所有字串到相应的繁体中文翻译列表。" & Chr$(13) & _
		"提示: 复制字串时其内码将自动从简体转换为繁体。" & Chr$(13) & _
		"      繁体中文翻译列表中现有的翻译将被覆盖！" & Chr$(13)&Chr$(13) & _
		"您想要继续吗？"

	Begin Dialog UserDialog 520,188, "确认"
		CheckBox 120,114,280,21,"转换内码时调整繁体中文词汇(&A)",.CheckBox
		Text 40,21,460,112,MsgText,.Text1
		OKButton 140,156,110,21
		CancelButton 290,156,120,21
	End Dialog
    Dim dlg As UserDialog
    dlg.CheckBox = 1
    If Dialog(dlg) = 0 Then Exit Sub

	Dim gbkTrnListID As String
	Dim big5TrnListID As String
	gbkTrnListID = "@ID" & Str(trn.ListID)
	big5TrnListID = "@ID" & Str(big5trn.ListID)

	big5trn.Update

	If big5trn.IsOpen Then big5trn.Close(pslSaveChanges)

	Dim prjFolder As String
	prjFolder = prj.Location

	trn.Export(addinid, prjFolder & "\~psltms.txt", pslAll)

	Open prjFolder & "\~psltms.txt" For Input As #1
    Open prjFolder & "\~psltmp.txt" For Output As #2
	PSL.Output("正在复制和转码字串，请稍候...")
	While Not EOF(1)
        Line Input #1, L$
        If L$ = gbkTrnListID Then L$ = big5TrnListID
		If InStr(L$,"@CodePage1") = 1 Then L$ = "@CodePage1 1252"
		If InStr(L$,"@CodePage2") = 1 Then L$ = "@CodePage2 950"
        Print #2, L$
    Wend
    Close #1
    Close #2

	If dlg.CheckBox = 0 Then Name concmd & "\B5fix.dat" As concmd & "\B5fix.das"
	ShellWait("""" & concmd & "\ConCmd.exe"" /i:gbk /o:big5 """ & prjFolder & "\~psltmp.txt""")
	If dlg.CheckBox = 0 Then Name concmd & "\B5fix.das" As concmd & "\B5fix.dat"

	PSL.Import(addinid, prjFolder & "\~psltmp.txt", pslImportValidate)
	Kill prjFolder & "\~psltms.txt"
	Kill prjFolder & "\~psltmp.txt"
Else
	MsgBox "您的方案中没有 [中文(繁体/台湾)] 语言，请先添加！",vbOkOnly+vbInformation,"信息"
End If
End Sub