Changeset 123 for Include/basic


Ignore:
Timestamp:
Mar 1, 2007, 12:31:13 AM (17 years ago)
Author:
イグトランス (egtra)
Message:

(拡張)メタファイル関数（全部）・構造体（一部）、BITMAPV4HEADERとそれに関連する型などの宣言

Location:
Include/basic
Files:
4 edited

Legend:

Unmodified
Added
Removed

  • Include/basic/command.sbp

    r121 r123  
    8080Macro INSMENU(hMenu As HMENU, PosID As Long, flag As Long)(lpString As String, id As Long, hSubMenu As HMENU, state As Long)
    8181    Dim mii As MENUITEMINFO
    82 
    83     FillMemory(VarPtr(mii),Len(mii),0)
    84     mii.cbSize=Len(mii)
    85     mii.fMask=MIIM_TYPE
    86 
    87     If lpString.Length=0 Then
    88         mii.fType=MFT_SEPARATOR
    89     Else
    90         mii.fType=MFT_STRING
    91         mii.fMask=mii.fMask or MIIM_STATE or MIIM_ID
    92         mii.dwTypeData=StrPtr(lpString)
    93         mii.wID=id
    94         If hSubMenu Then
    95             mii.fMask=mii.fMask or MIIM_SUBMENU
    96             mii.hSubMenu=hSubMenu
     82    ZeroMemory(VarPtr(mii), Len(mii))
     83    With mii
     84        .cbSize = Len(mii)
     85        .fMask = MIIM_TYPE
     86
     87        If lpString.Length = 0 Then
     88            mii.fType = MFT_SEPARATOR
     89        Else
     90            .fType = MFT_STRING
     91            .fMask = .fMask or MIIM_STATE or MIIM_ID
     92            .dwTypeData = StrPtr(lpString)
     93            .wID = id
     94            If hSubMenu Then
     95                .fMask = .fMask or MIIM_SUBMENU
     96                .hSubMenu = hSubMenu
     97            End If
     98            .fState=state
    9799        End If
    98         mii.fState=state
    99     End If
    100 
    101     InsertMenuItem(hMenu,PosID,flag,mii)
     100    End With
     101    InsertMenuItem(hMenu, PosID, flag, mii)
    102102End Macro
    103103
    … …  
    220220End Sub
    221221
    222 Function _System_Input_SetArgument(arg As VoidPtr, dataType As DWord, ByRef buf As String, bufLen As Long)
     222Sub _System_Input_SetArgument(arg As VoidPtr, dataType As DWord, ByRef buf As String, bufLen As Long)
    223223    Select Case dataType
    224224        Case _System_Type_Double
    … …  
    243243            pTempStr->Chars[pTempStr->Length] = 0
    244244    End Select
    245 End Function
     245End Sub
    246246
    247247Sub PRINT_ToFile(FileNumber As Long, buf As String)
    248248    Dim dwAccessByte As DWord
    249     FileNumber=FileNumber-1
     249    FileNumber--
    250250
    251251    WriteFile(_System_hFile(FileNumber),buf,Len(buf),VarPtr(dwAccessByte),ByVal NULL)
    … …  
    320320            If length_buf>=length_num Then
    321321                '通常時
    322                 FillMemory(StrPtr(buffer)+i3,length_buf-length_num,Asc(" "))
     322                _System_FillChar(VarPtr(buffer[i3]), length_buf - length_num, &h20) 'Asc(" ")
     323
    323324                i3 += length_buf - length_num
    324325
    325326                If sign Then
    326                     buffer[i3]=Asc("-")
     327                    buffer[i3] = Asc("-")
    327328                    i3++
    328329
    … …  
    330331                End If
    331332
    332                 If dec>0 Then
    333                     memcpy(StrPtr(buffer)+i3,temp2,length_num)
     333                If dec > 0 Then
     334                    memcpy(VarPtr(buffer[i3]), temp2, SizeOf (Char) * length_num)
    334335                Else
    335                     buffer[i3]=&H30
     336                    buffer[i3] = &H30
    336337                End If
    337338
    … …  
    339340            Else
    340341                '表示桁が足りないとき
    341                 FillMemory(StrPtr(buffer)+i3,length_buf,Asc("#"))
     342                _System_FillChar(VarPtr(buffer[i3]), length_buf,&h23) 'Asc("#")
    342343                i3 += length_buf
    343344            End If
    344345
    345             If UsingStr[i2]=Asc(".") Then
    346                 buffer[i3]=UsingStr[i2]
     346            If UsingStr[i2] = Asc(".") Then
     347                buffer[i3] = UsingStr[i2]
    347348                i2++
    348349                i3++
    349350
    350351                i4=dec
    351                 While UsingStr[i2]=Asc("#")
     352                While UsingStr[i2] = Asc("#")
    352353                    If i4<0 Then
    353354                        buffer[i3]=&H30
    … …  
    364365            i2++
    365366
    366             lstrcat(StrPtr(buffer)+i3,_System_UsingStrData[ParmNum])
    367             i3=i3+lstrlen(_System_UsingStrData[ParmNum])
     367            'lstrcat(StrPtr(buffer)+i3,_System_UsingStrData[ParmNum])
     368            memcpy(VarPtr(buffer[i3 + lstrlen(VarPtr(buffer[i3]))]), _System_UsingStrData[ParmNum], _
     369                SizeOf (Char) * lstrlen(_System_UsingStrData[ParmNum]))
     370            i3 += lstrlen(_System_UsingStrData[ParmNum])
    368371        ElseIf UsingStr[i2]=Asc("&") Then
    369372            i4=0
    … …  
    380383                    i5=i4
    381384                Else
    382                     FillMemory(StrPtr(buffer)+i3,i4,Asc(" "))
     385                    _System_FillChar(VarPtr(buffer[i3]), i4, &h20) 'Asc(" ")
    383386                End If
    384                 memcpy(StrPtr(buffer)+i3,_System_UsingStrData[ParmNum],i5)
     387                memcpy(VarPtr(buffer[i3]), _System_UsingStrData[ParmNum], SizeOf (Char) * i5)
    385388                i3 += i4
    386389            Else
    387390                i2 -= i4
    388                 buffer[i3]=Asc("&")
     391                buffer[i3] = Asc("&")
    389392                i2++
    390393                i3++
    … …  
    396399    Wend
    397400
    398     _System_GetUsingFormat=Left$(buffer,lstrlen(buffer))
     401    _System_GetUsingFormat = Left$(buffer, lstrlen(buffer))
    399402End Function
    400403Sub PRINTUSING_ToFile(FileNumber As Long, UsingStr As String)

  • Include/basic/dos_console.sbp

    r110 r123  
    5555        Wend
    5656
    57         Select Case _System_InputDataType[i]
    58             Case _System_Type_Double
    59                 SetDouble(_System_InputDataPtr[i],Val(buf))
    60             Case _System_Type_Single
    61                 SetSingle(_System_InputDataPtr[i],Val(buf))
    62             Case _System_Type_Int64,_System_Type_QWord
    63                 SetQWord(_System_InputDataPtr[i],Val(buf))
    64             Case _System_Type_Long,_System_Type_DWord
    65                 SetDWord(_System_InputDataPtr[i],Val(buf))
    66             Case _System_Type_Integer,_System_Type_Word
    67                 SetWord(_System_InputDataPtr[i],Val(buf))
    68             Case _System_Type_Char,_System_Type_Byte
    69                 SetByte(_System_InputDataPtr[i],Val(buf))
    70             Case _System_Type_String
    71                 Dim pTempStr As *String
    72                 pTempStr=_System_InputDataPtr[i] As *String
    73                 pTempStr->Assign(buf, i3)
    74         End Select
     57        _System_Input_SetArgument(_System_InputDataPtr[i], _System_InputDataType[i], buf, i3)
    7558
    7659        i++

  • Include/basic/function.sbp

    r121 r123  
    502502    i2=0
    503503    Do
    504         Oct$[i2]=Asc("0")+((num\CDWord(8^i)) And &H07)
     504        Oct$[i2] = &h30 +((num \ CDWord(8 ^ i)) And &H07) ' &h30 = Asc("0")
    505505        If i=0 Then Exit Do
    506506        i--
    … …  
    522522
    523523Function Space$(length As Long) As String
    524     Space$=ZeroString(length)
    525     FillMemory(StrPtr(Space$),length,&H20)
     524    Space$.ReSize(length, &H20 As Char)
    526525End Function
    527526
    … …  
    540539        End If
    541540    Else
    542         _System_ecvt_buffer[count]=_System_ecvt_buffer[count]+1 As Char
     541        _System_ecvt_buffer[count]++
    543542    End If
    544543End Sub
    … …  
    551550    '値が0の場合
    552551    If value=0 Then
    553         FillMemory(_System_ecvt_buffer,count,&H30)
    554         _System_ecvt_buffer[count]=0
    555         dec=0
    556         sign=0
     552        _System_FillChar(_System_ecvt_buffer, count, &H30)
     553        _System_ecvt_buffer[count] = 0
     554        dec = 0
     555        sign = 0
    557556        Exit Function
    558557    End If
    … …  
    627626        buffer[i]=Asc(".")
    628627        i++
    629         memcpy(buffer+i,temp+1,14)
     628        memcpy(VarPtr(buffer[i]), VarPtr(temp[1]), SizeOf (Char) * 14)
    630629        i+=14
    631630        buffer[i]=Asc("e")
    632631        i++
    633         wsprintf(buffer+i,"+%03d",dec-1)
     632        _stprintf(VarPtr(buffer[i]), "+%03d", dec-1)
    634633
    635634        Return MakeStr(buffer)
    … …  
    642641        buffer[i]=Asc(".")
    643642        i++
    644         memcpy(buffer+i,temp+1,14)
     643        memcpy(VarPtr(buffer[i]), VarPtr(temp[1]), SizeOf (Char) * 14)
    645644        i+=14
    646645        buffer[i]=Asc("e")
    647646        i++
    648         wsprintf(buffer+i,"%03d",dec-1)
     647        _stprintf(VarPtr(buffer[i]), "+%03d", dec-1)
    649648
    650649        Return MakeStr(buffer)
    … …  
    714713    Dim i As Long
    715714    For i=0 To num-1
    716         memcpy(VarPtr(String$[i*length]),StrPtr(buf),SizeOf (Char) * length)
     715        memcpy(VarPtr(String$[i*length]), StrPtr(buf), SizeOf (Char) * length)
    717716    Next
    718717End Function
    … …  
    760759
    761760    If buf[0]=Asc("&") Then
    762         temporary=buf
    763         TempPtr=StrPtr(temporary)
    764         CharUpper(TempPtr)
     761        temporary = buf
     762        temporary.ToUpper()
     763        TempPtr = StrPtr(temporary)
    765764        If TempPtr(1)=Asc("O") Then
    766765            '8進数
    … …  
    778777            i64data=1
    779778            While i>=2
    780                 Val=Val+i64data*TempPtr[i]
    781 
    782                 i64data=i64data*&O10
     779                Val += i64data * TempPtr[i]
     780
     781                i64data *= &O10
    783782                i--
    784783            Wend
    … …  
    948947'--------
    949948
    950 Sub _splitpath(path As BytePtr, drive As BytePtr, dir As BytePtr, fname As BytePtr, ext As BytePtr)
     949Sub _splitpath(path As PCSTR, drive As PSTR, dir As PSTR, fname As PSTR, ext As PSTR)
    951950    Dim i As Long, i2 As Long, i3 As Long, length As Long
    952951    Dim buffer[MAX_PATH] As Char
    … …  
    966965    i2=0
    967966    Do
    968 #ifdef UNICODE
    969 ' ToDo: サロゲートペアの認識
    970 #else
    971         If IsDBCSLeadByte(path[i])=TRUE and path[i+1]<>0 Then
     967'#ifdef UNICODE
     968'       If _System_IsSurrogatePair(path[i], path[i + 1]) Then
     969'#else
     970        If IsDBCSLeadByte(path[i]) <> FALSE and path[i + 1] <> 0 Then
     971'#endif
    972972            If dir Then
    973973                dir[i2]=path[i]
    … …  
    979979            Continue
    980980        End If
    981 #endif
    982981
    983982        If path[i]=0 Then Exit Do
    … …  
    1000999    i3=-1
    10011000    Do
    1002         If IsDBCSLeadByte(path[i])=TRUE and path[i+1]<>0 Then
     1001'#ifdef UNICODE
     1002'       If _System_IsSurrogatePair(path[i], path[i + 1]) Then
     1003'#else
     1004        If IsDBCSLeadByte(path[i]) <> FALSE and path[i + 1] <> 0 Then
     1005'#endif
    10031006            If fname Then
    10041007                fname[i2]=path[i]
    … …  
    10651068End Function
    10661069
     1070Function _System_FillChar(p As *Char, n As SIZE_T, c As Char)
     1071    Dim i As SIZE_T
     1072    For i = 0 To ELM(n)
     1073        p[i] = c
     1074    Next
     1075End Function
     1076
    10671077#endif '_INC_FUNCTION

  • Include/basic/prompt.sbp

    r121 r123  
    3838
    3939_PromptSys_bInitFinish=0
    40 CreateThread( _
    41     0,
    42     0,
    43     AddressOf(PromptMain) As LPTHREAD_START_ROUTINE,
    44     0 As VoidPtr,
    45     0,
    46     _PromptSys_dwThreadID)
     40CreateThread(0, 0, AddressOf(PromptMain) As LPTHREAD_START_ROUTINE, 0, 0, _PromptSys_dwThreadID)
    4741Do
    4842    Sleep(20)
    … …  
    135129            If buf[i2] = 9 Then 'tab
    136130                i3 = 8 - (.x And 7) '(.x mod 8)
    137                 Dim j As Long
    138                 Dim p = VarPtr(_PromptSys_Buffer[.y][.x]) As *Char
    139                 ' FillMemory(_PromptSys_Buffer[.y]+.x, i3, Asc(" "))
    140                 For j = 0 To ELM(i3)
    141                     p[j] = &h20 'Asc(" ")
    142                 Next
     131                _System_FillChar(VarPtr(_PromptSys_Buffer[.y][.x]), i3, &h20) 'Asc(" ")
    143132                i2++
    144133                .x += i3
    … …  
    194183            Dim tm As TEXTMETRIC
    195184            Dim hOldFont=SelectObject(_PromptSys_hMemDC, _PromptSys_hFont) As HFONT
    196             GetTextExtentPoint32(_PromptSys_hMemDC, Ex" " As PCTSTR, 1, _PromptSys_FontSize)
     185            GetTextExtentPoint32(_PromptSys_hMemDC, " " As PCTSTR, 1, _PromptSys_FontSize)
    197186            GetTextMetrics(_PromptSys_hMemDC, tm)
    198187            SelectObject(_PromptSys_hMemDC, hOldFont)
    … …  
    215204                    With CompForm
    216205                        .dwStyle = CFS_POINT
    217                         .ptCurrentPos.x = _PromptSys_CurPos.x*_PromptSys_FontSize.cx
    218                         .ptCurrentPos.y = _PromptSys_CurPos.y*_PromptSys_FontSize.cy
     206                        .ptCurrentPos.x = _PromptSys_CurPos.x * _PromptSys_FontSize.cx
     207                        .ptCurrentPos.y = _PromptSys_CurPos.y * _PromptSys_FontSize.cy
    219208                    End With
    220209                    ImmSetCompositionWindow(hIMC, CompForm)
    … …  
    223212                ImmReleaseContext(hWnd, hIMC)
    224213
    225                 CreateCaret(hWnd,NULL,9,6)
     214                CreateCaret(hWnd, NULL, 9, 6)
    226215                SetCaretPos(_PromptSys_CurPos.x*_PromptSys_FontSize.cx, _
    227216                    (_PromptSys_CurPos.y+1)*_PromptSys_FontSize.cy-7)
    … …  
    256245                    Dim pTemp = GlobalLock(hGlobal) As PCSTR
    257246#ifdef UNICODE 'A版ウィンドウプロシージャ用
    258                     Dim tempSizeW = MultiByteToWideChar(CP_ACP, 0, pTemp, -1, 0, 0) + 1
     247                    Dim tempSizeA = lstrlenA(pTemp)
     248                    Dim tempSizeW = MultiByteToWideChar(CP_ACP, 0, pTemp, tempSizeA, 0, 0) + 1
    259249                    TempStr = ZeroString(tempSizeW)
    260                     MultiByteToWideChar(CP_ACP, 0, pTemp, -1, StrPtr(TempStr), tempSizeW)
     250                    MultiByteToWideChar(CP_ACP, 0, pTemp, tempSizeA, StrPtr(TempStr), tempSizeW)
    261251#else
    262252                    TempStr = ZeroString(lstrlen(pTemp) + 1)
    … …  
    335325    'Regist Prompt Class
    336326    Dim wcl As WNDCLASSEX
    337     FillMemory(VarPtr(wcl),Len(wcl),0)
    338     wcl.cbSize=Len(wcl)
    339     wcl.hInstance=GetModuleHandle(0)
    340     wcl.style=CS_HREDRAW or CS_VREDRAW or CS_DBLCLKS
    341     wcl.hIcon=LoadIcon(NULL,MAKEINTRESOURCE(IDI_APPLICATION))
    342     wcl.hIconSm=LoadIcon(NULL,MAKEINTRESOURCE(IDI_WINLOGO))
    343     wcl.hCursor=LoadCursor(NULL,MAKEINTRESOURCE(IDC_ARROW))
    344     wcl.lpszClassName="PROMPT"
    345     wcl.lpfnWndProc=AddressOf(PromptProc)
    346     wcl.hbrBackground=GetStockObject(BLACK_BRUSH)
     327    ZeroMemory(VarPtr(wcl), Len(wcl))
     328    With wcl
     329        .cbSize = Len(wcl)
     330        .hInstance = GetModuleHandle(0)
     331        .style = CS_HREDRAW or CS_VREDRAW' or CS_DBLCLKS
     332        .hIcon = LoadIcon(NULL, MAKEINTRESOURCE(IDI_APPLICATION))
     333        .hIconSm = LoadIcon(NULL, MAKEINTRESOURCE(IDI_WINLOGO))
     334        .hCursor = LoadCursor(NULL, MAKEINTRESOURCE(IDC_ARROW))
     335        .lpszClassName = "PROMPT"
     336        .lpfnWndProc = AddressOf(PromptProc)
     337        .hbrBackground = GetStockObject(BLACK_BRUSH)
     338    End With
    347339    Dim atom = RegisterClassEx(wcl)
    348340
    349341    'Create Prompt Window
    350342    _PromptSys_hWnd=CreateWindowEx(WS_EX_CLIENTEDGE,atom As ULONG_PTR As PCSTR,"BASIC PROMPT",WS_OVERLAPPEDWINDOW,CW_USEDEFAULT,CW_USEDEFAULT,CW_USEDEFAULT,CW_USEDEFAULT,0,0,GetModuleHandle(0),0)
    351     ShowWindow(_PromptSys_hWnd,SW_SHOW)
     343    ShowWindow(_PromptSys_hWnd, SW_SHOW)
    352344    UpdateWindow(_PromptSys_hWnd)
    353345
    354     Dim msg As MSG, iResult As Long
     346    Dim msg As MSG
    355347    Do
    356         iResult=GetMessage(msg,0,0,0)
    357         If iResult=0 or iResult=-1 Then Exit Do
     348        Dim iResult = GetMessage(msg, 0, 0, 0)
     349        If iResult = 0 or iResult = -1 Then Exit Do
    358350        TranslateMessage(msg)
    359351        DispatchMessage(msg)
    … …  
    392384    If num=1 or num=3 Then
    393385        'Clear the text screen
    394         For i=0 To 100
    395             FillMemory(_PromptSys_Buffer[i],255,0)
     386        For i = 0 To 100
     387            _System_FillChar(_PromptSys_Buffer[i],255,0)
    396388        Next
    397         _PromptSys_CurPos.x=0
    398         _PromptSys_CurPos.y=0
     389        With _PromptSys_CurPos
     390            .x = 0
     391            .y = 0
     392        End With
    399393    End If
    400394
    … …  
    488482    If y<0 Then y=0
    489483    If y>100 Then y=100
    490 
    491     _PromptSys_CurPos.x=x
    492     _PromptSys_CurPos.y=y
    493 
     484    With _PromptSys_CurPos
     485        .x = x
     486        .y = y
     487    End With
    494488    i=0
    495489    While _PromptSys_Buffer[y][i]
    … …  
    497491    Wend
    498492
    499     If i<x Then
    500         FillMemory(_PromptSys_Buffer[y]+i,x-i,Asc(" "))
    501         For i2=i To x-1
    502             _PromptSys_BackColor[y][i2]=-1
     493    If i < x Then
     494        _System_FillChar(VarPtr(_PromptSys_Buffer[y][i]), x - i, &h20) 'Asc(" ")
     495        For i2 = i To x - 1
     496            _PromptSys_BackColor[y][i2] = -1
    503497        Next
    504498    End If
Note: See TracChangeset for help on using the changeset viewer.