Index: /Include/Classes/System/String.ab =================================================================== --- /Include/Classes/System/String.ab (revision 122) +++ /Include/Classes/System/String.ab (revision 123) @@ -29,5 +29,5 @@ Sub ~String() -' _System_free(Chars) + _System_free(Chars) Chars = 0 #ifdef _DEBUG Index: /Include/api_gdi.sbp =================================================================== --- /Include/api_gdi.sbp (revision 122) +++ /Include/api_gdi.sbp (revision 123) @@ -9,8 +9,8 @@ Const GDI_ERROR = &HFFFFFFFF +TypeDef BCHAR = TBYTE Type _System_DeclareHandle_HPALETTE:unused As DWord:End Type TypeDef HPALETTE = *_System_DeclareHandle_HPALETTE - ' Point/Rectangle/Size struct @@ -30,4 +30,10 @@ cx As Long cy As Long +End Type + +' Metafile and EnhancedMetafile +Type EMR + iType As DWord + nSize As DWord End Type @@ -43,5 +49,61 @@ TypeDef PMETAHEADER = *METAHEADER +Type ENHMETAHEADER + iType As DWord + nSize As DWord + rclBounds As RECT + rclFrame As RECT + dSignature As DWord + nVersion As DWord + nBytes As DWord + nRecords As DWord + nHandles As Word + sReserved As Word + nDescription As DWord + offDescription As DWord + nPalEntries As DWord + szlDevice As SIZE + szlMillimeters As SIZE + cbPixelFormat As DWord + offPixelFormat As DWord + bOpenGL As DWord +'#if WINVER >= 0x0500 + 'szlMicrometers As SIZE +'#endif +End Type +TypeDef PENHMETAHEADER = *ENHMETAHEADER + +Type HANDLETABLE + objectHandle[ELM(1)] As HGDIOBJ +End Type + +Type METARECORD + rdSize As DWord + rdFunction As Word + rdParm[ELM(1)] As Word +End Type + +Type ENHMETARECORD + iType As DWord + nSize As DWord + dParm[ELM(1)] As DWord +End Type + +Type METAFILEPICT + mm As Long + xExt As Long + yExt As Long + hMF As HMETAFILE +End Type + +TypeDef ENHMFENUMPROC = *Function(hdc As HDC, ByRef HTable As HANDLETABLE, ByRef EMFR As ENHMETARECORD, nObj As Long, lpData As LPARAM) As Long +TypeDef MFENUMPROC = *Function(hdc As HDC, ByRef HTable As HANDLETABLE, ByRef MFR As METARECORD, nObj As Long, lpClientData As LPARAM) + + +' RGB Color Const RGB(r, g, b) = ((r) As Long) Or (((g) As Long) <<8) Or (((b) As Long) <<16) +Const PALETTERGB(r, g, b) = (&h02000000 Or RGB(r,g,b)) +Const PALETTEINDEX(i) = ((&h01000000 Or (i) As Word As DWord) As COLORREF) + Const GetRValue(rgb) = (rgb And &hff) Const GetGValue(rgb) = ((rgb >> 8) And &hff) @@ -54,4 +116,72 @@ rgbReserved As Byte End Type + +Type Align(1) RGBTRIPLE + rgbtBlue As Byte + rgbtGreen As Byte + rgbtRed As Byte +End Type + +' CMYK Color +Const GetKValue(cmyk) = ((cmyk) As Byte) +Const GetYValue(cmyk) = (((cmyk) >> 8) As Byte) +Const GetMValue(cmyk) = (((cmyk) >> 16) As Byte) +Const GetCValue(cmyk) = (((cmyk) >> 24) As Byte) + +Const CMYK(c, m, y, k) = (( _ + ((k) As Byte) Or _ + ((y) As Byte As Word << 8) Or _ + ((m) As Byte As DWord << 16) Or _ + ((c) As Byte As DWord << 24)) As COLORREF) + +' ICM Color +TypeDef FXPT16DOT16 = Long +TypeDef FXPT2DOT30 = Long + +TypeDef LCSCSTYPE = Long +TypeDef LCSGAMUTMATCH = Long + +Type LOGCOLORSPACEA + lcsSignature As DWord + lcsVersion As DWord + lcsSize As DWord + lcsCSType As LCSCSTYPE + lcsIntent As LCSGAMUTMATCH + lcsEndpoints As CIEXYZTRIPLE + lcsGammaRed As DWord + lcsGammaGreen As DWord + lcsGammaBlue As DWord + lcsFilename[MAX_PATH] As SByte +End Type +Type LOGCOLORSPACEW + lcsSignature As DWord + lcsVersion As DWord + lcsSize As DWord + lcsCSType As LCSCSTYPE + lcsIntent As LCSGAMUTMATCH + lcsEndpoints As CIEXYZTRIPLE + lcsGammaRed As DWord + lcsGammaGreen As DWord + lcsGammaBlue As DWord + lcsFilename[ELM(MAX_PATH)] As WCHAR +End Type +#ifdef UNICODE +TypeDef LOGCOLORSPACE = LOGCOLORSPACEW +#else +TypeDef LOGCOLORSPACE = LOGCOLORSPACEA +#endif + +Type CIEXYZ + ciexyzX As FXPT2DOT30 + ciexyzY As FXPT2DOT30 + ciexyzZ As FXPT2DOT30 +End Type + +Type CIEXYZTRIPLE + ciexyzRed As CIEXYZ + ciexyzGreen As CIEXYZ + ciexyzBlue As CIEXYZ +End Type + @@ -101,4 +231,16 @@ End Type +Type BITMAPCOREHEADER + bcSize As DWord + bcWidth As Word + bcHeight As Word + bcPlanes As Word + bcBitCount As Word +End Type + +Type BITMAPCOREINFO + bmciHeader As BITMAPCOREHEADER + bmciColors[ELM(1)] As RGBTRIPLE +End Type ' structures for defining DIBs @@ -109,4 +251,5 @@ Const BI_JPEG = 4 Const BI_PNG = 5 + Type BITMAPINFOHEADER biSize As DWord @@ -122,7 +265,8 @@ biClrImportant As DWord End Type + Type BITMAPINFO bmiHeader As BITMAPINFOHEADER - bmpColors[255] As RGBQUAD + bmiColors[ELM(1)] As RGBQUAD '以前はbmpColors[255] As RGBQUADだったことに注意 End Type @@ -137,4 +281,26 @@ End Type +Type BITMAPV4HEADER + bV4Size As DWord + bV4Width As Long + bV4Height As Long + bV4Planes As Word + bV4BitCount As Word + bV4V4Compression As DWord + bV4SizeImage As DWord + bV4XPelsPerMeter As Long + bV4YPelsPerMeter As Long + bV4ClrUsed As DWord + bV4ClrImportant As DWord + bV4RedMask As DWord + bV4GreenMask As DWord + bV4BlueMask As DWord + bV4AlphaMask As DWord + bV4CSType As DWord + bV4Endpoints As CIEXYZTRIPLE + bV4GammaRed As DWord + bV4GammaGreen As DWord + bV4GammaBlue As DWord +End Type ' Region flags @@ -327,5 +493,7 @@ Declare Function CancelDC Lib "gdi32" (hdc As HDC) As BOOL Declare 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 +Declare Function CloseEnhMetaFile Lib "gdi32" (hdc As HDC) As HENHMETAFILE Declare Function CloseFigure Lib "gdi32" (hdc As HDC) As BOOL +Declare Function CloseMetaFile Lib "gdi32" (hdc As HDC) As HMETAFILE Const RGN_AND = 1 @@ -335,5 +503,6 @@ Const RGN_COPY = 5 Declare Function CombineRgn Lib "gdi32" (hrgnDest As HRGN, hrgnSrc1 As HRGN, hrgnSrc2 As HRGN, fnCombineMode As Long) As Long - +Declare Function CopyEnhMetaFile Lib "gdi32" Alias "CopyEnhMetaFileA" (hemfSrc As HENHMETAFILE, pszFile As PCSTR) As HENHMETAFILE +Declare Function CopyMetaFile Lib "gdi32" Alias "CopyMetaFileA" (hmfSrc As HMETAFILE, pszFile As PCSTR) As HMETAFILE Declare Function CreateBitmap Lib "gdi32" (nWidth As Long, nHeight As Long, cPlanes As Long, cBitsPerPel As Long, lpvBits As VoidPtr) As HBITMAP Declare Function CreateBitmapIndirect Lib "gdi32" (ByRef lpbm As BITMAP) As HBITMAP @@ -376,4 +545,6 @@ Declare Function CreateEllipticRgn Lib "gdi32" (nLeftRect As Long, nTopRect As Long, nRightRect As Long, nBottomRect As Long) As HRGN Declare Function CreateEllipticRgnIndirect Lib "gdi32" (ByRef lpRect As RECT) As HRGN +Declare Function CreateEnhMetaFile Lib "gdi32" Alias "CreateEnhMetaFileA" (hdcRef As HDC, pFileName As PCTSTR, ByRef Rect As RECT, pDescription As PCTSTR) As HDC +Declare Function CreateMetaFile Lib "gdi32" Alias "CreateMetaFileA" (pFileName As PCTSTR) As HDC Const FW_DONTCARE = 0 @@ -518,4 +689,6 @@ Declare Function CreateSolidBrush Lib "gdi32" (crColor As COLORREF) As HBRUSH Declare Function DeleteDC Lib "gdi32" (hdc As HDC) As BOOL +Declare Function DeleteEnhMetaFile Lib "gdi32" (hemf As HENHMETAFILE) As BOOL +Declare Function DeleteMetaFile Lib "gdi32" (hmf As HMETAFILE) As BOOL Declare Function DeleteObject Lib "gdi32" (hObject As HANDLE) As BOOL Declare Function DPtoLP Lib "gdi32" (hdc As HDC, ByRef lpPoints As POINTAPI, nCount As Long) As BOOL @@ -524,4 +697,6 @@ Declare Function EndPage Lib "gdi32" (hdc As HDC) As Long Declare Function EndPath Lib "gdi32" (hdc As HDC) As BOOL +Declare Function EnumEnhMetaFile Lib "gdi32" (hdc As HDC, hemf As HENHMETAFILE, pEnhMetaFunc As ENHMFENUMPROC, pData As VoidPtr, ByRef Rect As RECT) As BOOL +Declare Function EnumMetaFile Lib "gdi32" (hdc As HDC, hmf As HMETAFILE, pMetaFunc As MFENUMPROC, lParam As LPARAM) As BOOL Declare Function EqualRgn Lib "gdi32" (hSrcRgn1 As HRGN, hSrcRgn2 As HRGN) As BOOL Declare Function ExcludeClipRect Lib "gdi32" (hdc As HDC, nLeftRect As Long, nTopRect As Long, nRightRect As Long, nBottomRect As Long) As Long @@ -552,5 +727,6 @@ Declare Function FillRgn Lib "gdi32" (hdc As HDC, hRgn As HRGN, hBrush As HBRUSH) As Long Declare Function FrameRgn Lib "gdi32" (hdc As HDC, hRgn As HRGN, hBrush As HBRUSH, nWidth As Long, nHeight As Long) As Long -Declare Function GetBitmapBits Lib "gdi32" (hbmp As HBITMAP, cbBuffer As Long, lpvBits As VoidPtr) As Long +Declare Function GdiComment Lib "gdi32" (hdc As HDC, cbSize As DWord, lpData As *Byte) As BOOL +Declare Function GetBitmapBits Lib "gdi32" (hbmp As HBITMAP, cbBuffer As Long, lpvBits As VoidPtr) As Long Declare Function GetBkColor Lib "gdi32" (hdc As HDC) As DWord Declare Function GetBkMode Lib "gdi32" (hdc As HDC) As Long @@ -682,4 +858,9 @@ Declare 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 +Declare Function GetEnhMetaFile Lib "gdi32" Alias "GetEnhMetaFileA" (pszMetaFile As PCSTR) As HENHMETAFILE +Declare Function GetEnhMetaFileBits Lib "gdi32" (hemf As HENHMETAFILE, cbBuffer As DWord, pbBuffer As *Byte) As DWord +Declare Function GetEnhMetaFileDescription Lib "gdi32" Alias "GetEnhMetaFileDescriptionA" (hemf As HENHMETAFILE, cbBuffer As DWord, pszDescription As PTSTR) As DWord +Declare Function GetEnhMetaFileHeader Lib "gdi32" (hemf As HENHMETAFILE, cbBuffer As DWord, ByRef emh As ENHMETAHEADER) As DWord +Declare Function GetEnhMetaFilePaletteEntries Lib "gdi32" (hemf As HENHMETAFILE, cEntries As DWord, ByRef pe As PALETTEENTRY) As DWord Const MM_TEXT = 1 @@ -692,5 +873,5 @@ Const MM_ANISOTROPIC = 8 Declare Function GetMapMode Lib "gdi32" (hdc As HDC) As Long - +Declare Function GetMetaFileBitsEx Lib "gdi32" (hmf As HMETAFILE, nSize As DWord, pvData As VoidPtr) As DWord Declare Function GetMiterLimit Lib "gdi32" (hdc As HDC, peLimit As SinglePtr) As Long Declare Function GetObject Lib "gdi32" Alias "GetObjectA" (hgdiobj As HANDLE, cbBuffer As Long, ByRef lpvObject As Any) As Long @@ -781,4 +962,5 @@ Declare Function GetWindowExtEx Lib "gdi32" (hdc As HDC, ByRef lpSize As SIZE) As Long Declare Function GetWindowOrgEx Lib "gdi32" (hdc As HDC, ByRef lpPoint As POINTAPI) As Long +Declare Function GetWinMetaFileBits Lib "gdi32" (hemf As HENHMETAFILE, cbBuffer As DWord, pbBuffer As *Byte, fnMapMode As Long, hdcRef As HDC) As DWord Declare Function IntersectClipRect Lib "gdi32" (hdc As HDC, nLeftRect As Long, nTopRect As Long, nRightRect As Long, nBottomRect As Long) As Long Declare Function InvertRgn Lib "gdi32" (hdc As HDC, hRgn As HRGN) As Long @@ -794,4 +976,8 @@ Declare Function PathToRegion Lib "gdi32" (hdc As HDC) As HRGN Declare 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 +Declare Function PlayEnhMetaFile Lib "gdi32" (hdc As HDC, hemf As HENHMETAFILE, ByRef Rect As RECT) As Long +Declare Function PlayEnhMetaFileRecord Lib "gdi32" (hdc As HDC, ByRef Handletable As HANDLETABLE, ByRef EnhMetaRecord As ENHMETARECORD, nHandles As DWord) As BOOL +Declare Function PlayMetaFile Lib "gdi32" (hdc As HDC, hmf As HMETAFILE) As BOOL +Declare Function PlayMetaFileRecord Lib "gdi32" (hdc As HDC, ByRef Handletable As HANDLETABLE, ByRef MetaRecord As METARECORD, nHandles As DWord) As BOOL Declare 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 Declare Function PolyBezier Lib "gdi32" (hdc As HDC, ByRef lppt As POINTAPI, cPoints As Long) As Long @@ -824,5 +1010,7 @@ Declare Function SetBrushOrgEx Lib "gdi32" (hdc As HDC, nXOrg As Long, nYOrg As Long, ByRef lppt As POINTAPI) As Long Declare 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 +Declare Function SetEnhMetaFileBits Lib "gdi32" (cbBuffer As DWord, pData As *Byte) As HENHMETAFILE Declare Function SetMapMode Lib "gdi32" (hdc As HDC, fnMapMode As Long) As Long +Declare Function SetMetaFileBitsEx Lib "gdi32" (nSize As DWord, pData As *Byte) As HMETAFILE Declare Function SetMiterLimit Lib "gdi32" (hdc As HDC, eNewLimit As Single, peOldLimit As SinglePtr) As Long Declare Function SetPixel Lib "gdi32" (hdc As HDC, x As Long, y As Long, crColor As DWord) As DWord @@ -847,4 +1035,5 @@ Declare Function SetWindowExtEx Lib "gdi32" (hdc As HDC, nXExtent As Long, nYExtent As Long, ByRef lpSize As SIZE) As Long Declare Function SetWindowOrgEx Lib "gdi32" (hdc As HDC, x As Long, y As Long, ByRef lpPoint As POINTAPI) As Long +Declare Function SetWinMetaFileBits Lib "gdi32" (cbBuffer As DWord, pbBuffer As *Byte, hdcRef As HDC, ByRef mfp As METAFILEPICT) As HENHMETAFILE Declare Function StartDoc Lib "gdi32" Alias "StartDocA" (hdc As HDC, ByRef ref_di As DOCINFO) As Long Declare Function StartPage Lib "gdi32" (hdc As HDC) As Long Index: /Include/basic/command.sbp =================================================================== --- /Include/basic/command.sbp (revision 122) +++ /Include/basic/command.sbp (revision 123) @@ -80,24 +80,24 @@ Macro INSMENU(hMenu As HMENU, PosID As Long, flag As Long)(lpString As String, id As Long, hSubMenu As HMENU, state As Long) Dim mii As MENUITEMINFO - - FillMemory(VarPtr(mii),Len(mii),0) - mii.cbSize=Len(mii) - mii.fMask=MIIM_TYPE - - If lpString.Length=0 Then - mii.fType=MFT_SEPARATOR - Else - mii.fType=MFT_STRING - mii.fMask=mii.fMask or MIIM_STATE or MIIM_ID - mii.dwTypeData=StrPtr(lpString) - mii.wID=id - If hSubMenu Then - mii.fMask=mii.fMask or MIIM_SUBMENU - mii.hSubMenu=hSubMenu + ZeroMemory(VarPtr(mii), Len(mii)) + With mii + .cbSize = Len(mii) + .fMask = MIIM_TYPE + + If lpString.Length = 0 Then + mii.fType = MFT_SEPARATOR + Else + .fType = MFT_STRING + .fMask = .fMask or MIIM_STATE or MIIM_ID + .dwTypeData = StrPtr(lpString) + .wID = id + If hSubMenu Then + .fMask = .fMask or MIIM_SUBMENU + .hSubMenu = hSubMenu + End If + .fState=state End If - mii.fState=state - End If - - InsertMenuItem(hMenu,PosID,flag,mii) + End With + InsertMenuItem(hMenu, PosID, flag, mii) End Macro @@ -220,5 +220,5 @@ End Sub -Function _System_Input_SetArgument(arg As VoidPtr, dataType As DWord, ByRef buf As String, bufLen As Long) +Sub _System_Input_SetArgument(arg As VoidPtr, dataType As DWord, ByRef buf As String, bufLen As Long) Select Case dataType Case _System_Type_Double @@ -243,9 +243,9 @@ pTempStr->Chars[pTempStr->Length] = 0 End Select -End Function +End Sub Sub PRINT_ToFile(FileNumber As Long, buf As String) Dim dwAccessByte As DWord - FileNumber=FileNumber-1 + FileNumber-- WriteFile(_System_hFile(FileNumber),buf,Len(buf),VarPtr(dwAccessByte),ByVal NULL) @@ -320,9 +320,10 @@ If length_buf>=length_num Then '通常時 - FillMemory(StrPtr(buffer)+i3,length_buf-length_num,Asc(" ")) + _System_FillChar(VarPtr(buffer[i3]), length_buf - length_num, &h20) 'Asc(" ") + i3 += length_buf - length_num If sign Then - buffer[i3]=Asc("-") + buffer[i3] = Asc("-") i3++ @@ -330,8 +331,8 @@ End If - If dec>0 Then - memcpy(StrPtr(buffer)+i3,temp2,length_num) + If dec > 0 Then + memcpy(VarPtr(buffer[i3]), temp2, SizeOf (Char) * length_num) Else - buffer[i3]=&H30 + buffer[i3] = &H30 End If @@ -339,15 +340,15 @@ Else '表示桁が足りないとき - FillMemory(StrPtr(buffer)+i3,length_buf,Asc("#")) + _System_FillChar(VarPtr(buffer[i3]), length_buf,&h23) 'Asc("#") i3 += length_buf End If - If UsingStr[i2]=Asc(".") Then - buffer[i3]=UsingStr[i2] + If UsingStr[i2] = Asc(".") Then + buffer[i3] = UsingStr[i2] i2++ i3++ i4=dec - While UsingStr[i2]=Asc("#") + While UsingStr[i2] = Asc("#") If i4<0 Then buffer[i3]=&H30 @@ -364,6 +365,8 @@ i2++ - lstrcat(StrPtr(buffer)+i3,_System_UsingStrData[ParmNum]) - i3=i3+lstrlen(_System_UsingStrData[ParmNum]) + 'lstrcat(StrPtr(buffer)+i3,_System_UsingStrData[ParmNum]) + memcpy(VarPtr(buffer[i3 + lstrlen(VarPtr(buffer[i3]))]), _System_UsingStrData[ParmNum], _ + SizeOf (Char) * lstrlen(_System_UsingStrData[ParmNum])) + i3 += lstrlen(_System_UsingStrData[ParmNum]) ElseIf UsingStr[i2]=Asc("&") Then i4=0 @@ -380,11 +383,11 @@ i5=i4 Else - FillMemory(StrPtr(buffer)+i3,i4,Asc(" ")) + _System_FillChar(VarPtr(buffer[i3]), i4, &h20) 'Asc(" ") End If - memcpy(StrPtr(buffer)+i3,_System_UsingStrData[ParmNum],i5) + memcpy(VarPtr(buffer[i3]), _System_UsingStrData[ParmNum], SizeOf (Char) * i5) i3 += i4 Else i2 -= i4 - buffer[i3]=Asc("&") + buffer[i3] = Asc("&") i2++ i3++ @@ -396,5 +399,5 @@ Wend - _System_GetUsingFormat=Left$(buffer,lstrlen(buffer)) + _System_GetUsingFormat = Left$(buffer, lstrlen(buffer)) End Function Sub PRINTUSING_ToFile(FileNumber As Long, UsingStr As String) Index: /Include/basic/dos_console.sbp =================================================================== --- /Include/basic/dos_console.sbp (revision 122) +++ /Include/basic/dos_console.sbp (revision 123) @@ -55,22 +55,5 @@ Wend - Select Case _System_InputDataType[i] - Case _System_Type_Double - SetDouble(_System_InputDataPtr[i],Val(buf)) - Case _System_Type_Single - SetSingle(_System_InputDataPtr[i],Val(buf)) - Case _System_Type_Int64,_System_Type_QWord - SetQWord(_System_InputDataPtr[i],Val(buf)) - Case _System_Type_Long,_System_Type_DWord - SetDWord(_System_InputDataPtr[i],Val(buf)) - Case _System_Type_Integer,_System_Type_Word - SetWord(_System_InputDataPtr[i],Val(buf)) - Case _System_Type_Char,_System_Type_Byte - SetByte(_System_InputDataPtr[i],Val(buf)) - Case _System_Type_String - Dim pTempStr As *String - pTempStr=_System_InputDataPtr[i] As *String - pTempStr->Assign(buf, i3) - End Select + _System_Input_SetArgument(_System_InputDataPtr[i], _System_InputDataType[i], buf, i3) i++ Index: /Include/basic/function.sbp =================================================================== --- /Include/basic/function.sbp (revision 122) +++ /Include/basic/function.sbp (revision 123) @@ -502,5 +502,5 @@ i2=0 Do - Oct$[i2]=Asc("0")+((num\CDWord(8^i)) And &H07) + Oct$[i2] = &h30 +((num \ CDWord(8 ^ i)) And &H07) ' &h30 = Asc("0") If i=0 Then Exit Do i-- @@ -522,6 +522,5 @@ Function Space$(length As Long) As String - Space$=ZeroString(length) - FillMemory(StrPtr(Space$),length,&H20) + Space$.ReSize(length, &H20 As Char) End Function @@ -540,5 +539,5 @@ End If Else - _System_ecvt_buffer[count]=_System_ecvt_buffer[count]+1 As Char + _System_ecvt_buffer[count]++ End If End Sub @@ -551,8 +550,8 @@ '値が0の場合 If value=0 Then - FillMemory(_System_ecvt_buffer,count,&H30) - _System_ecvt_buffer[count]=0 - dec=0 - sign=0 + _System_FillChar(_System_ecvt_buffer, count, &H30) + _System_ecvt_buffer[count] = 0 + dec = 0 + sign = 0 Exit Function End If @@ -627,9 +626,9 @@ buffer[i]=Asc(".") i++ - memcpy(buffer+i,temp+1,14) + memcpy(VarPtr(buffer[i]), VarPtr(temp[1]), SizeOf (Char) * 14) i+=14 buffer[i]=Asc("e") i++ - wsprintf(buffer+i,"+%03d",dec-1) + _stprintf(VarPtr(buffer[i]), "+%03d", dec-1) Return MakeStr(buffer) @@ -642,9 +641,9 @@ buffer[i]=Asc(".") i++ - memcpy(buffer+i,temp+1,14) + memcpy(VarPtr(buffer[i]), VarPtr(temp[1]), SizeOf (Char) * 14) i+=14 buffer[i]=Asc("e") i++ - wsprintf(buffer+i,"%03d",dec-1) + _stprintf(VarPtr(buffer[i]), "+%03d", dec-1) Return MakeStr(buffer) @@ -714,5 +713,5 @@ Dim i As Long For i=0 To num-1 - memcpy(VarPtr(String$[i*length]),StrPtr(buf),SizeOf (Char) * length) + memcpy(VarPtr(String$[i*length]), StrPtr(buf), SizeOf (Char) * length) Next End Function @@ -760,7 +759,7 @@ If buf[0]=Asc("&") Then - temporary=buf - TempPtr=StrPtr(temporary) - CharUpper(TempPtr) + temporary = buf + temporary.ToUpper() + TempPtr = StrPtr(temporary) If TempPtr(1)=Asc("O") Then '8進数 @@ -778,7 +777,7 @@ i64data=1 While i>=2 - Val=Val+i64data*TempPtr[i] - - i64data=i64data*&O10 + Val += i64data * TempPtr[i] + + i64data *= &O10 i-- Wend @@ -948,5 +947,5 @@ '-------- -Sub _splitpath(path As BytePtr, drive As BytePtr, dir As BytePtr, fname As BytePtr, ext As BytePtr) +Sub _splitpath(path As PCSTR, drive As PSTR, dir As PSTR, fname As PSTR, ext As PSTR) Dim i As Long, i2 As Long, i3 As Long, length As Long Dim buffer[MAX_PATH] As Char @@ -966,8 +965,9 @@ i2=0 Do -#ifdef UNICODE -' ToDo: サロゲートペアの認識 -#else - If IsDBCSLeadByte(path[i])=TRUE and path[i+1]<>0 Then +'#ifdef UNICODE +' If _System_IsSurrogatePair(path[i], path[i + 1]) Then +'#else + If IsDBCSLeadByte(path[i]) <> FALSE and path[i + 1] <> 0 Then +'#endif If dir Then dir[i2]=path[i] @@ -979,5 +979,4 @@ Continue End If -#endif If path[i]=0 Then Exit Do @@ -1000,5 +999,9 @@ i3=-1 Do - If IsDBCSLeadByte(path[i])=TRUE and path[i+1]<>0 Then +'#ifdef UNICODE +' If _System_IsSurrogatePair(path[i], path[i + 1]) Then +'#else + If IsDBCSLeadByte(path[i]) <> FALSE and path[i + 1] <> 0 Then +'#endif If fname Then fname[i2]=path[i] @@ -1065,3 +1068,10 @@ End Function +Function _System_FillChar(p As *Char, n As SIZE_T, c As Char) + Dim i As SIZE_T + For i = 0 To ELM(n) + p[i] = c + Next +End Function + #endif '_INC_FUNCTION Index: /Include/basic/prompt.sbp =================================================================== --- /Include/basic/prompt.sbp (revision 122) +++ /Include/basic/prompt.sbp (revision 123) @@ -38,11 +38,5 @@ _PromptSys_bInitFinish=0 -CreateThread( _ - 0, - 0, - AddressOf(PromptMain) As LPTHREAD_START_ROUTINE, - 0 As VoidPtr, - 0, - _PromptSys_dwThreadID) +CreateThread(0, 0, AddressOf(PromptMain) As LPTHREAD_START_ROUTINE, 0, 0, _PromptSys_dwThreadID) Do Sleep(20) @@ -135,10 +129,5 @@ If buf[i2] = 9 Then 'tab i3 = 8 - (.x And 7) '(.x mod 8) - Dim j As Long - Dim p = VarPtr(_PromptSys_Buffer[.y][.x]) As *Char - ' FillMemory(_PromptSys_Buffer[.y]+.x, i3, Asc(" ")) - For j = 0 To ELM(i3) - p[j] = &h20 'Asc(" ") - Next + _System_FillChar(VarPtr(_PromptSys_Buffer[.y][.x]), i3, &h20) 'Asc(" ") i2++ .x += i3 @@ -194,5 +183,5 @@ Dim tm As TEXTMETRIC Dim hOldFont=SelectObject(_PromptSys_hMemDC, _PromptSys_hFont) As HFONT - GetTextExtentPoint32(_PromptSys_hMemDC, Ex" " As PCTSTR, 1, _PromptSys_FontSize) + GetTextExtentPoint32(_PromptSys_hMemDC, " " As PCTSTR, 1, _PromptSys_FontSize) GetTextMetrics(_PromptSys_hMemDC, tm) SelectObject(_PromptSys_hMemDC, hOldFont) @@ -215,6 +204,6 @@ With CompForm .dwStyle = CFS_POINT - .ptCurrentPos.x = _PromptSys_CurPos.x*_PromptSys_FontSize.cx - .ptCurrentPos.y = _PromptSys_CurPos.y*_PromptSys_FontSize.cy + .ptCurrentPos.x = _PromptSys_CurPos.x * _PromptSys_FontSize.cx + .ptCurrentPos.y = _PromptSys_CurPos.y * _PromptSys_FontSize.cy End With ImmSetCompositionWindow(hIMC, CompForm) @@ -223,5 +212,5 @@ ImmReleaseContext(hWnd, hIMC) - CreateCaret(hWnd,NULL,9,6) + CreateCaret(hWnd, NULL, 9, 6) SetCaretPos(_PromptSys_CurPos.x*_PromptSys_FontSize.cx, _ (_PromptSys_CurPos.y+1)*_PromptSys_FontSize.cy-7) @@ -256,7 +245,8 @@ Dim pTemp = GlobalLock(hGlobal) As PCSTR #ifdef UNICODE 'A版ウィンドウプロシージャ用 - Dim tempSizeW = MultiByteToWideChar(CP_ACP, 0, pTemp, -1, 0, 0) + 1 + Dim tempSizeA = lstrlenA(pTemp) + Dim tempSizeW = MultiByteToWideChar(CP_ACP, 0, pTemp, tempSizeA, 0, 0) + 1 TempStr = ZeroString(tempSizeW) - MultiByteToWideChar(CP_ACP, 0, pTemp, -1, StrPtr(TempStr), tempSizeW) + MultiByteToWideChar(CP_ACP, 0, pTemp, tempSizeA, StrPtr(TempStr), tempSizeW) #else TempStr = ZeroString(lstrlen(pTemp) + 1) @@ -335,25 +325,27 @@ 'Regist Prompt Class Dim wcl As WNDCLASSEX - FillMemory(VarPtr(wcl),Len(wcl),0) - wcl.cbSize=Len(wcl) - wcl.hInstance=GetModuleHandle(0) - wcl.style=CS_HREDRAW or CS_VREDRAW or CS_DBLCLKS - wcl.hIcon=LoadIcon(NULL,MAKEINTRESOURCE(IDI_APPLICATION)) - wcl.hIconSm=LoadIcon(NULL,MAKEINTRESOURCE(IDI_WINLOGO)) - wcl.hCursor=LoadCursor(NULL,MAKEINTRESOURCE(IDC_ARROW)) - wcl.lpszClassName="PROMPT" - wcl.lpfnWndProc=AddressOf(PromptProc) - wcl.hbrBackground=GetStockObject(BLACK_BRUSH) + ZeroMemory(VarPtr(wcl), Len(wcl)) + With wcl + .cbSize = Len(wcl) + .hInstance = GetModuleHandle(0) + .style = CS_HREDRAW or CS_VREDRAW' or CS_DBLCLKS + .hIcon = LoadIcon(NULL, MAKEINTRESOURCE(IDI_APPLICATION)) + .hIconSm = LoadIcon(NULL, MAKEINTRESOURCE(IDI_WINLOGO)) + .hCursor = LoadCursor(NULL, MAKEINTRESOURCE(IDC_ARROW)) + .lpszClassName = "PROMPT" + .lpfnWndProc = AddressOf(PromptProc) + .hbrBackground = GetStockObject(BLACK_BRUSH) + End With Dim atom = RegisterClassEx(wcl) 'Create Prompt Window _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) - ShowWindow(_PromptSys_hWnd,SW_SHOW) + ShowWindow(_PromptSys_hWnd, SW_SHOW) UpdateWindow(_PromptSys_hWnd) - Dim msg As MSG, iResult As Long + Dim msg As MSG Do - iResult=GetMessage(msg,0,0,0) - If iResult=0 or iResult=-1 Then Exit Do + Dim iResult = GetMessage(msg, 0, 0, 0) + If iResult = 0 or iResult = -1 Then Exit Do TranslateMessage(msg) DispatchMessage(msg) @@ -392,9 +384,11 @@ If num=1 or num=3 Then 'Clear the text screen - For i=0 To 100 - FillMemory(_PromptSys_Buffer[i],255,0) + For i = 0 To 100 + _System_FillChar(_PromptSys_Buffer[i],255,0) Next - _PromptSys_CurPos.x=0 - _PromptSys_CurPos.y=0 + With _PromptSys_CurPos + .x = 0 + .y = 0 + End With End If @@ -488,8 +482,8 @@ If y<0 Then y=0 If y>100 Then y=100 - - _PromptSys_CurPos.x=x - _PromptSys_CurPos.y=y - + With _PromptSys_CurPos + .x = x + .y = y + End With i=0 While _PromptSys_Buffer[y][i] @@ -497,8 +491,8 @@ Wend - If i