Changeset 123


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

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

Location:
Include
Files:
6 edited

Legend:

Unmodified
Added
Removed

  • Include/Classes/System/String.ab

    r121 r123  
    2929
    3030    Sub ~String()
    31 '       _System_free(Chars)
     31        _System_free(Chars)
    3232        Chars = 0
    3333#ifdef _DEBUG

  • Include/api_gdi.sbp

    r121 r123  
    99Const GDI_ERROR =     &HFFFFFFFF
    1010
     11TypeDef BCHAR = TBYTE
    1112
    1213Type _System_DeclareHandle_HPALETTE:unused As DWord:End Type
    1314TypeDef HPALETTE = *_System_DeclareHandle_HPALETTE
    14 
    1515
    1616' Point/Rectangle/Size struct
    … …  
    3030    cx As Long
    3131    cy As Long
     32End Type
     33
     34' Metafile and EnhancedMetafile
     35Type EMR
     36    iType As DWord
     37    nSize As DWord
    3238End Type
    3339
    … …  
    4349TypeDef PMETAHEADER = *METAHEADER
    4450
     51Type ENHMETAHEADER
     52    iType As DWord
     53    nSize As DWord
     54    rclBounds As RECT
     55    rclFrame As RECT
     56    dSignature As DWord
     57    nVersion As DWord
     58    nBytes As DWord
     59    nRecords As DWord
     60    nHandles As Word
     61    sReserved As Word
     62    nDescription As DWord
     63    offDescription As DWord
     64    nPalEntries As DWord
     65    szlDevice As SIZE
     66    szlMillimeters As SIZE
     67    cbPixelFormat As DWord
     68    offPixelFormat As DWord
     69    bOpenGL As DWord
     70'#if WINVER >= 0x0500
     71    'szlMicrometers As SIZE
     72'#endif
     73End Type
     74TypeDef PENHMETAHEADER = *ENHMETAHEADER
     75
     76Type HANDLETABLE
     77    objectHandle[ELM(1)] As HGDIOBJ
     78End Type
     79
     80Type METARECORD
     81    rdSize As DWord
     82    rdFunction As Word
     83    rdParm[ELM(1)] As Word
     84End Type
     85
     86Type ENHMETARECORD
     87    iType As DWord
     88    nSize As DWord
     89    dParm[ELM(1)] As DWord
     90End Type
     91
     92Type METAFILEPICT
     93    mm As Long
     94    xExt As Long
     95    yExt As Long
     96    hMF As HMETAFILE
     97End Type
     98
     99TypeDef ENHMFENUMPROC = *Function(hdc As HDC, ByRef HTable As HANDLETABLE, ByRef EMFR As ENHMETARECORD, nObj As Long, lpData As LPARAM) As Long
     100TypeDef MFENUMPROC = *Function(hdc As HDC, ByRef HTable As HANDLETABLE, ByRef MFR As METARECORD, nObj As Long, lpClientData As LPARAM)
     101
     102
     103' RGB Color
    45104Const RGB(r, g, b) = ((r) As Long) Or (((g) As Long) <<8) Or (((b) As Long) <<16)
     105Const PALETTERGB(r, g, b) = (&h02000000 Or RGB(r,g,b))
     106Const PALETTEINDEX(i) = ((&h01000000 Or (i) As Word As DWord) As COLORREF)
     107
    46108Const GetRValue(rgb) = (rgb And &hff)
    47109Const GetGValue(rgb) = ((rgb >> 8) And &hff)
    … …  
    54116    rgbReserved As Byte
    55117End Type
     118
     119Type Align(1) RGBTRIPLE
     120    rgbtBlue As Byte
     121    rgbtGreen As Byte
     122    rgbtRed As Byte
     123End Type
     124
     125' CMYK Color
     126Const GetKValue(cmyk) = ((cmyk) As Byte)
     127Const GetYValue(cmyk) = (((cmyk) >> 8) As Byte)
     128Const GetMValue(cmyk) = (((cmyk) >> 16) As Byte)
     129Const GetCValue(cmyk) = (((cmyk) >> 24) As Byte)
     130
     131Const CMYK(c, m, y, k) = (( _
     132    ((k) As Byte) Or _
     133    ((y) As Byte As Word << 8) Or _
     134    ((m) As Byte As DWord << 16) Or _
     135    ((c) As Byte As DWord << 24)) As COLORREF)
     136
     137' ICM Color
     138TypeDef FXPT16DOT16 = Long
     139TypeDef FXPT2DOT30 = Long
     140
     141TypeDef LCSCSTYPE = Long
     142TypeDef LCSGAMUTMATCH = Long
     143
     144Type LOGCOLORSPACEA
     145    lcsSignature As DWord
     146    lcsVersion As DWord
     147    lcsSize As DWord
     148    lcsCSType As LCSCSTYPE
     149    lcsIntent As LCSGAMUTMATCH
     150    lcsEndpoints As CIEXYZTRIPLE
     151    lcsGammaRed As DWord
     152    lcsGammaGreen As DWord
     153    lcsGammaBlue As DWord
     154    lcsFilename[MAX_PATH] As SByte
     155End Type
     156Type LOGCOLORSPACEW
     157    lcsSignature As DWord
     158    lcsVersion As DWord
     159    lcsSize As DWord
     160    lcsCSType As LCSCSTYPE
     161    lcsIntent As LCSGAMUTMATCH
     162    lcsEndpoints As CIEXYZTRIPLE
     163    lcsGammaRed As DWord
     164    lcsGammaGreen As DWord
     165    lcsGammaBlue As DWord
     166    lcsFilename[ELM(MAX_PATH)] As WCHAR
     167End Type
     168#ifdef UNICODE
     169TypeDef LOGCOLORSPACE = LOGCOLORSPACEW
     170#else
     171TypeDef LOGCOLORSPACE = LOGCOLORSPACEA
     172#endif
     173
     174Type CIEXYZ
     175    ciexyzX As FXPT2DOT30
     176    ciexyzY As FXPT2DOT30
     177    ciexyzZ As FXPT2DOT30
     178End Type
     179
     180Type CIEXYZTRIPLE
     181    ciexyzRed As CIEXYZ
     182    ciexyzGreen As CIEXYZ
     183    ciexyzBlue As CIEXYZ
     184End Type
     185
    56186
    57187
    … …  
    101231End Type
    102232
     233Type BITMAPCOREHEADER
     234    bcSize As DWord
     235    bcWidth As Word
     236    bcHeight As Word
     237    bcPlanes As Word
     238    bcBitCount As Word
     239End Type
     240
     241Type BITMAPCOREINFO
     242    bmciHeader As BITMAPCOREHEADER
     243    bmciColors[ELM(1)] As RGBTRIPLE
     244End Type
    103245
    104246' structures for defining DIBs
    … …  
    109251Const BI_JPEG =      4
    110252Const BI_PNG =       5
     253
    111254Type BITMAPINFOHEADER
    112255    biSize As DWord
    … …  
    122265    biClrImportant As DWord
    123266End Type
     267
    124268Type BITMAPINFO
    125269    bmiHeader As BITMAPINFOHEADER
    126     bmpColors[255] As RGBQUAD
     270    bmiColors[ELM(1)] As RGBQUAD '以前はbmpColors[255] As RGBQUADだったことに注意
    127271End Type
    128272
    … …  
    137281End Type
    138282
     283Type BITMAPV4HEADER
     284    bV4Size As DWord
     285    bV4Width As Long
     286    bV4Height As Long
     287    bV4Planes As Word
     288    bV4BitCount As Word
     289    bV4V4Compression As DWord
     290    bV4SizeImage As DWord
     291    bV4XPelsPerMeter As Long
     292    bV4YPelsPerMeter As Long
     293    bV4ClrUsed As DWord
     294    bV4ClrImportant As DWord
     295    bV4RedMask As DWord
     296    bV4GreenMask As DWord
     297    bV4BlueMask As DWord
     298    bV4AlphaMask As DWord
     299    bV4CSType As DWord
     300    bV4Endpoints As CIEXYZTRIPLE
     301    bV4GammaRed As DWord
     302    bV4GammaGreen As DWord
     303    bV4GammaBlue As DWord
     304End Type
    139305
    140306' Region flags
    … …  
    327493Declare Function CancelDC Lib "gdi32" (hdc As HDC) As BOOL
    328494Declare Function Chord Lib "gdi32" (hdc As HDC, nLeftRect As Long, nTopRect As Long, nRightRect As Long, nBottomRect As Long, nXRadial1 As Long, nYRadial1 As Long, nXRadial2 As Long, nYRadial2 As Long) As BOOL
     495Declare Function CloseEnhMetaFile Lib "gdi32" (hdc As HDC) As HENHMETAFILE
    329496Declare Function CloseFigure Lib "gdi32" (hdc As HDC) As BOOL
     497Declare Function CloseMetaFile Lib "gdi32" (hdc As HDC) As HMETAFILE
    330498
    331499Const RGN_AND =  1
    … …  
    335503Const RGN_COPY = 5
    336504Declare Function CombineRgn Lib "gdi32" (hrgnDest As HRGN, hrgnSrc1 As HRGN, hrgnSrc2 As HRGN, fnCombineMode As Long) As Long
    337 
     505Declare Function CopyEnhMetaFile Lib "gdi32" Alias "CopyEnhMetaFileA" (hemfSrc As HENHMETAFILE, pszFile As PCSTR) As HENHMETAFILE
     506Declare Function CopyMetaFile Lib "gdi32" Alias "CopyMetaFileA" (hmfSrc As HMETAFILE, pszFile As PCSTR) As HMETAFILE
    338507Declare Function CreateBitmap Lib "gdi32" (nWidth As Long, nHeight As Long, cPlanes As Long, cBitsPerPel As Long, lpvBits As VoidPtr) As HBITMAP
    339508Declare Function CreateBitmapIndirect Lib "gdi32" (ByRef lpbm As BITMAP) As HBITMAP
    … …  
    376545Declare Function CreateEllipticRgn Lib "gdi32" (nLeftRect As Long, nTopRect As Long, nRightRect As Long, nBottomRect As Long) As HRGN
    377546Declare Function CreateEllipticRgnIndirect Lib "gdi32" (ByRef lpRect As RECT) As HRGN
     547Declare Function CreateEnhMetaFile Lib "gdi32" Alias "CreateEnhMetaFileA" (hdcRef As HDC, pFileName As PCTSTR, ByRef Rect As RECT, pDescription As PCTSTR) As HDC
     548Declare Function CreateMetaFile Lib "gdi32" Alias "CreateMetaFileA" (pFileName As PCTSTR) As HDC
    378549
    379550Const FW_DONTCARE =       0
    … …  
    518689Declare Function CreateSolidBrush Lib "gdi32" (crColor As COLORREF) As HBRUSH
    519690Declare Function DeleteDC Lib "gdi32" (hdc As HDC) As BOOL
     691Declare Function DeleteEnhMetaFile Lib "gdi32" (hemf As HENHMETAFILE) As BOOL
     692Declare Function DeleteMetaFile Lib "gdi32" (hmf As HMETAFILE) As BOOL
    520693Declare Function DeleteObject Lib "gdi32" (hObject As HANDLE) As BOOL
    521694Declare Function DPtoLP Lib "gdi32" (hdc As HDC, ByRef lpPoints As POINTAPI, nCount As Long) As BOOL
    … …  
    524697Declare Function EndPage Lib "gdi32" (hdc As HDC) As Long
    525698Declare Function EndPath Lib "gdi32" (hdc As HDC) As BOOL
     699Declare Function EnumEnhMetaFile Lib "gdi32" (hdc As HDC, hemf As HENHMETAFILE, pEnhMetaFunc As ENHMFENUMPROC, pData As VoidPtr, ByRef Rect As RECT) As BOOL
     700Declare Function EnumMetaFile Lib "gdi32" (hdc As HDC, hmf As HMETAFILE, pMetaFunc As MFENUMPROC, lParam As LPARAM) As BOOL
    526701Declare Function EqualRgn Lib "gdi32" (hSrcRgn1 As HRGN, hSrcRgn2 As HRGN) As BOOL
    527702Declare Function ExcludeClipRect Lib "gdi32" (hdc As HDC, nLeftRect As Long, nTopRect As Long, nRightRect As Long, nBottomRect As Long) As Long
    … …  
    552727Declare Function FillRgn Lib "gdi32" (hdc As HDC, hRgn As HRGN, hBrush As HBRUSH) As Long
    553728Declare Function FrameRgn Lib "gdi32" (hdc As HDC, hRgn As HRGN, hBrush As HBRUSH, nWidth As Long, nHeight As Long) As Long
    554 Declare Function GetBitmapBits Lib "gdi32" (hbmp As HBITMAP,  cbBuffer As Long, lpvBits As VoidPtr) As Long
     729Declare Function GdiComment Lib "gdi32" (hdc As HDC, cbSize As DWord, lpData As *Byte) As BOOL
     730Declare Function GetBitmapBits Lib "gdi32" (hbmp As HBITMAP, cbBuffer As Long, lpvBits As VoidPtr) As Long
    555731Declare Function GetBkColor Lib "gdi32" (hdc As HDC) As DWord
    556732Declare Function GetBkMode Lib "gdi32" (hdc As HDC) As Long
    … …  
    682858
    683859Declare Function GetDIBits Lib "gdi32" (hdc As HDC, hbmp As HBITMAP, uStartScan As DWord, cScanLines As DWord, lpvBits As VoidPtr, ByRef lpbi As BITMAPINFO, uUsage As DWord) As Long
     860Declare Function GetEnhMetaFile Lib "gdi32" Alias "GetEnhMetaFileA" (pszMetaFile As PCSTR) As HENHMETAFILE
     861Declare Function GetEnhMetaFileBits Lib "gdi32" (hemf As HENHMETAFILE, cbBuffer As DWord, pbBuffer As *Byte) As DWord
     862Declare Function GetEnhMetaFileDescription Lib "gdi32" Alias "GetEnhMetaFileDescriptionA" (hemf As HENHMETAFILE, cbBuffer As DWord, pszDescription As PTSTR) As DWord
     863Declare Function GetEnhMetaFileHeader Lib "gdi32" (hemf As HENHMETAFILE, cbBuffer As DWord, ByRef emh As ENHMETAHEADER) As DWord
     864Declare Function GetEnhMetaFilePaletteEntries Lib "gdi32" (hemf As HENHMETAFILE, cEntries As DWord, ByRef pe As PALETTEENTRY) As DWord
    684865
    685866Const MM_TEXT =           1
    … …  
    692873Const MM_ANISOTROPIC =    8
    693874Declare Function GetMapMode Lib "gdi32" (hdc As HDC) As Long
    694 
     875Declare Function GetMetaFileBitsEx Lib "gdi32" (hmf As HMETAFILE, nSize As DWord, pvData As VoidPtr) As DWord
    695876Declare Function GetMiterLimit Lib "gdi32" (hdc As HDC, peLimit As SinglePtr) As Long
    696877Declare Function GetObject Lib "gdi32" Alias "GetObjectA" (hgdiobj As HANDLE, cbBuffer As Long, ByRef lpvObject As Any) As Long
    … …  
    781962Declare Function GetWindowExtEx Lib "gdi32" (hdc As HDC, ByRef lpSize As SIZE) As Long
    782963Declare Function GetWindowOrgEx Lib "gdi32" (hdc As HDC, ByRef lpPoint As POINTAPI) As Long
     964Declare Function GetWinMetaFileBits Lib "gdi32" (hemf As HENHMETAFILE, cbBuffer As DWord, pbBuffer As *Byte, fnMapMode As Long, hdcRef As HDC) As DWord
    783965Declare Function IntersectClipRect Lib "gdi32" (hdc As HDC, nLeftRect As Long, nTopRect As Long, nRightRect As Long, nBottomRect As Long) As Long
    784966Declare Function InvertRgn Lib "gdi32" (hdc As HDC, hRgn As HRGN) As Long
    … …  
    794976Declare Function PathToRegion Lib "gdi32" (hdc As HDC) As HRGN
    795977Declare Function Pie Lib "gdi32" (hdc As HDC, nLeftRect As Long, nTopRect As Long, nRightRect As Long, nBottomRect As Long, nXRadial1 As Long, nYRadial1 As Long, nXRadial2 As Long, nYRadial2 As Long) As Long
     978Declare Function PlayEnhMetaFile Lib "gdi32" (hdc As HDC, hemf As HENHMETAFILE, ByRef Rect As RECT) As Long
     979Declare Function PlayEnhMetaFileRecord Lib "gdi32" (hdc As HDC, ByRef Handletable As HANDLETABLE, ByRef EnhMetaRecord As ENHMETARECORD, nHandles As DWord) As BOOL
     980Declare Function PlayMetaFile Lib "gdi32" (hdc As HDC, hmf As HMETAFILE) As BOOL
     981Declare Function PlayMetaFileRecord Lib "gdi32" (hdc As HDC, ByRef Handletable As HANDLETABLE, ByRef MetaRecord As METARECORD, nHandles As DWord) As BOOL
    796982Declare Function PlgBlt Lib "gdi32" (hdcDest As HDC, ByRef lpPoint As POINTAPI, hdcSrc As HDC, nXSrc As Long, nYSrc As Long, nWidth As Long, nHeight As Long, hbmMask As HBITMAP, xMask As Long, yMask As Long) As Long
    797983Declare Function PolyBezier Lib "gdi32" (hdc As HDC, ByRef lppt As POINTAPI, cPoints As Long) As Long
    … …  
    8241010Declare Function SetBrushOrgEx Lib "gdi32" (hdc As HDC, nXOrg As Long, nYOrg As Long, ByRef lppt As POINTAPI) As Long
    8251011Declare Function SetDIBits Lib "gdi32" (hdc As HDC, hbmp As HBITMAP, uStartScan As DWord, cScanLines As DWord, lpvBits As VoidPtr, ByRef lpbmi As BITMAPINFO, fuColorUse As DWord) As Long
     1012Declare Function SetEnhMetaFileBits Lib "gdi32" (cbBuffer As DWord, pData As *Byte) As HENHMETAFILE
    8261013Declare Function SetMapMode Lib "gdi32" (hdc As HDC, fnMapMode As Long) As Long
     1014Declare Function SetMetaFileBitsEx Lib "gdi32" (nSize As DWord, pData As *Byte) As HMETAFILE
    8271015Declare Function SetMiterLimit Lib "gdi32" (hdc As HDC, eNewLimit As Single, peOldLimit As SinglePtr) As Long
    8281016Declare Function SetPixel Lib "gdi32" (hdc As HDC, x As Long, y As Long, crColor As DWord) As DWord
    … …  
    8471035Declare Function SetWindowExtEx Lib "gdi32" (hdc As HDC, nXExtent As Long, nYExtent As Long, ByRef lpSize As SIZE) As Long
    8481036Declare Function SetWindowOrgEx Lib "gdi32" (hdc As HDC, x As Long, y As Long, ByRef lpPoint As POINTAPI) As Long
     1037Declare Function SetWinMetaFileBits Lib "gdi32" (cbBuffer As DWord, pbBuffer As *Byte, hdcRef As HDC, ByRef mfp As METAFILEPICT) As HENHMETAFILE
    8491038Declare Function StartDoc Lib "gdi32" Alias "StartDocA" (hdc As HDC, ByRef ref_di As DOCINFO) As Long
    8501039Declare Function StartPage Lib "gdi32" (hdc As HDC) As Long

  • 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.