'   文字の均等割り付け
'       filename:kinto.bas
'
'   Created by K.Nose
'   Created on 1999-2-3

Sub main()
    Dim saveErrMsgs As Integer, saveMsgs As Integer

    Dim elem            As New MbeElement
    Dim filePos         As Long
    Dim point           As MbePoint
    Dim orgPoint        As MbePoint
    Dim firstScreenPt   As MbePoint
    Dim stat            As Integer
    Dim view            As Integer
    Dim continueLocate  As Integer

    Dim el_level        As Integer
    Dim el_fileNum      As Integer
    Dim el_text         As String
    Dim cmdString       As String
    Dim act_level       As String

    Dim kinto_No        As Double
    Dim text_width      As Double
    Dim total_lenght    As Double
    Dim current_lenght  As Double
    Dim full_no         As integer
    Dim half_no         As integer

    Dim save_levellk    As Long
    Dim save_gglk       As Long

    Dim saveTextHeight As Double, saveTextWidth As Double
    Dim saveTextPich As Long

    saveErrMsgs = MbeState.errorMessages
    saveMsgs = MbeState.messages
    save_levellk = MbeCExpressionLong("tcb->fbfdcn.levellk")
    save_gglk = MbeCExpressionLong("tcb->fbfdcn.gglk")

    saveTextHeight = MbeSettings.TextHeight
    saveTextWidth = MbeSettings.TextWidth
    saveTextPich = MbeCExpressionLong("tcb->textAboveSpacing")
    
    MbeState.errorMessages = 0
    MbeState.messages = 0

    MbeSetAppVariable "MGDSHOOK", "tcb->fbfdcn.levellk", 0&
    MbeSetAppVariable "MGDSHOOK", "tcb->fbfdcn.gglk", 0&

    MbeSendCommand "NULL"
    kinto_No = 1
init:
    actionButton = mbeOpenModalDialog(1)
    If actionButton = 4 Then GoTo finish

    MbeSetAppVariable "MODIFY", "msToolSettings.changeText.font", 0&
    MbeSetAppVariable "MODIFY", "msToolSettings.changeText.height", 0&
    MbeSetAppVariable "MODIFY", "msToolSettings.changeText.width", 0&
    MbeSetAppVariable "MODIFY", "msToolSettings.changeText.linespace", 0&
    MbeSetAppVariable "MODIFY", "msToolSettings.changeText.interchar", 0&
    MbeSetAppVariable "MODIFY", "msToolSettings.changeText.slant", 0&
    MbeSetAppVariable "MODIFY", "msToolSettings.changeText.linelength", 0&
    MbeSetAppVariable "MODIFY", "msToolSettings.changeText.underline", 0&
    MbeSetAppVariable "MODIFY", "msToolSettings.changeText.vertical", 0&
    MbeSetAppVariable "MODIFY", "msToolSettings.changeText.viewind", 0&
    MbeSetAppVariable "MODIFY", "msToolSettings.changeText.just", 0&

    MbeSetAppVariable "MODIFY", "msToolSettings.changeText.width", 1&
    MbeSetAppVariable "MODIFY", "msToolSettings.changeText.interchar", 1&

start:
    MbeState.messages = 0
    el_fileNum = 0
    MbeStartLocate 1, 0, 1, continueLocate
    MbeWriteCommand ("文字の均等割り付け >")
    MbeWritePrompt ("D:要素を指定/R:戻る")
    MbeGetInput MBE_DataPointInput, MBE_ResetInput, MBE_CommandInput

    Select Case MbeState.inputType
        Case MBE_DataPointInput
            stat = MbeState.getInputDataPoint(point, view, firstScreenPt)
            MbeState.messages = 1
            MbeSendLastInput
        Case MBE_ResetInput
            GoTo init
        Case MBE_CommandInput
            status = MbeState.getInputCommand(cmdString)
            CmdFlag% = 1
            GoTo menu
    End Select

Locate:

    filePos = elem.fromLocate()
    
    If MbeState.cmdResult = MBE_ElementNotFound Then GoTo start

    If elem.Type <> MBE_Text Then
        elem.display MBE_NormalDraw
        MbeState.messages = 1
        MbeSendReset
        GoTo Locate
    End If
    
    elem.display MBE_Hilite
    
    MbeState.messages = 0
    MbeWriteCommand ("文字の均等割り付け >")
    MbeWritePrompt ("D:ＯＫ/R:戻る")
    MbeGetInput MBE_DataPointInput, MBE_ResetInput, MBE_CommandInput

    Select Case MbeState.inputType
        Case MBE_DataPointInput
            elem.display MBE_NormalDraw
        Case MBE_ResetInput
            elem.display MBE_NormalDraw
            MbeState.messages = 1
            MbeSendReset
            GoTo Locate
        Case MBE_CommandInput
            status = MbeState.getInputCommand(cmdString)
            CmdFlag% = 1
            GoTo menu
    End Select
    
    If elem.getString(el_text) = MBE_Success Then
        If elem.getOrigin(orgPoint) = MBE_Success Then
        End If
    End If
    
    full_No = Full_count%(el_text)
    half_No = len(el_text) - full_No * 2
    if full_No + half_No < 2 then goto start
    
    If elem.charWidth > elem.charHeight Then
        text_width = elem.charWidth
    Else
        text_width = elem.charHeight
    End If

    total_lenght = text_width * kinto_No
    current_lenght = (half_No/2) * text_width + full_No * text_width  
     
    
    If current_lenght > total_lenght Then
        MbeSettings.TextWidth = total_lenght / (full_No + half_No/2)
        MbeSetScaledAppVar "MODIFY", "tcb->textAboveSpacing", 0
    Else
        MbeSettings.TextWidth = text_width
        text_pitch = (total_lenght - current_lenght) /(full_No+half_No-1)
        MbeSetScaledAppVar "MODIFY", "tcb->textAboveSpacing", text_pitch
    End If
    
    MbeSendCommand "MODIFY TEXT "
    MbeSendDataPoint orgPoint, 1
    MbeSendDataPoint orgPoint, 1
    MbeSendCommand "NULL "
    

    GoTo start
menu:
finish:
    MbeSettings.TextHeight = saveTextHeight
    MbeSettings.TextWidth = saveTextWidth
    MbeSetAppVariable "MGDSHOOK", "tcb->textAboveSpacing", saveTextPich

    MbeSetAppVariable "MODIFY", "msToolSettings.changeText.width", 0&
    MbeSetAppVariable "MODIFY", "msToolSettings.changeText.interchar", 0&
    MbeSetAppVariable "MGDSHOOK", "tcb->fbfdcn.levellk", save_levellk
    MbeSetAppVariable "MGDSHOOK", "tcb->fbfdcn.gglk", save_gglk
    MbeState.errorMessages = 1
    MbeState.messages = 1
    MbeSendCommand "NULL"
    If CmdFlag% = 1 Then
        MbeSendKeyin cmdString$
    End If
    
End Sub
 

'文字列内の全角文字の文字数をカウントする
Function Full_count%(a$)
    num% = 0
    for j% = 1 to len(a$) 
'        print asc(mid$(a$,j%,1)) , asc(mid$(a$,j%+1,1))
        if (asc(mid$(a$,j%,1)) > 127 and asc(mid$(a$,j%,1)) < 160) or (asc(mid$(a$,j%,1)) > 223 and asc(mid$(a$,j%,1)) < 253)then
              num% = num% + 1
              j = j + 1  
         end if
    next j%        
    
    Full_count = num

end function

 