Changeset 123
- Timestamp:
- Mar 1, 2007, 12:31:13 AM (18 years ago)
- Location:
- Include
- Files:
-
- 6 edited
Legend:
- Unmodified
- Added
- Removed
-
Include/Classes/System/String.ab
r121 r123 29 29 30 30 Sub ~String() 31 '_System_free(Chars)31 _System_free(Chars) 32 32 Chars = 0 33 33 #ifdef _DEBUG -
Include/api_gdi.sbp
r121 r123 9 9 Const GDI_ERROR = &HFFFFFFFF 10 10 11 TypeDef BCHAR = TBYTE 11 12 12 13 Type _System_DeclareHandle_HPALETTE:unused As DWord:End Type 13 14 TypeDef HPALETTE = *_System_DeclareHandle_HPALETTE 14 15 15 16 16 ' Point/Rectangle/Size struct … … 30 30 cx As Long 31 31 cy As Long 32 End Type 33 34 ' Metafile and EnhancedMetafile 35 Type EMR 36 iType As DWord 37 nSize As DWord 32 38 End Type 33 39 … … 43 49 TypeDef PMETAHEADER = *METAHEADER 44 50 51 Type 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 73 End Type 74 TypeDef PENHMETAHEADER = *ENHMETAHEADER 75 76 Type HANDLETABLE 77 objectHandle[ELM(1)] As HGDIOBJ 78 End Type 79 80 Type METARECORD 81 rdSize As DWord 82 rdFunction As Word 83 rdParm[ELM(1)] As Word 84 End Type 85 86 Type ENHMETARECORD 87 iType As DWord 88 nSize As DWord 89 dParm[ELM(1)] As DWord 90 End Type 91 92 Type METAFILEPICT 93 mm As Long 94 xExt As Long 95 yExt As Long 96 hMF As HMETAFILE 97 End Type 98 99 TypeDef ENHMFENUMPROC = *Function(hdc As HDC, ByRef HTable As HANDLETABLE, ByRef EMFR As ENHMETARECORD, nObj As Long, lpData As LPARAM) As Long 100 TypeDef MFENUMPROC = *Function(hdc As HDC, ByRef HTable As HANDLETABLE, ByRef MFR As METARECORD, nObj As Long, lpClientData As LPARAM) 101 102 103 ' RGB Color 45 104 Const RGB(r, g, b) = ((r) As Long) Or (((g) As Long) <<8) Or (((b) As Long) <<16) 105 Const PALETTERGB(r, g, b) = (&h02000000 Or RGB(r,g,b)) 106 Const PALETTEINDEX(i) = ((&h01000000 Or (i) As Word As DWord) As COLORREF) 107 46 108 Const GetRValue(rgb) = (rgb And &hff) 47 109 Const GetGValue(rgb) = ((rgb >> 8) And &hff) … … 54 116 rgbReserved As Byte 55 117 End Type 118 119 Type Align(1) RGBTRIPLE 120 rgbtBlue As Byte 121 rgbtGreen As Byte 122 rgbtRed As Byte 123 End Type 124 125 ' CMYK Color 126 Const GetKValue(cmyk) = ((cmyk) As Byte) 127 Const GetYValue(cmyk) = (((cmyk) >> 8) As Byte) 128 Const GetMValue(cmyk) = (((cmyk) >> 16) As Byte) 129 Const GetCValue(cmyk) = (((cmyk) >> 24) As Byte) 130 131 Const 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 138 TypeDef FXPT16DOT16 = Long 139 TypeDef FXPT2DOT30 = Long 140 141 TypeDef LCSCSTYPE = Long 142 TypeDef LCSGAMUTMATCH = Long 143 144 Type 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 155 End Type 156 Type 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 167 End Type 168 #ifdef UNICODE 169 TypeDef LOGCOLORSPACE = LOGCOLORSPACEW 170 #else 171 TypeDef LOGCOLORSPACE = LOGCOLORSPACEA 172 #endif 173 174 Type CIEXYZ 175 ciexyzX As FXPT2DOT30 176 ciexyzY As FXPT2DOT30 177 ciexyzZ As FXPT2DOT30 178 End Type 179 180 Type CIEXYZTRIPLE 181 ciexyzRed As CIEXYZ 182 ciexyzGreen As CIEXYZ 183 ciexyzBlue As CIEXYZ 184 End Type 185 56 186 57 187 … … 101 231 End Type 102 232 233 Type BITMAPCOREHEADER 234 bcSize As DWord 235 bcWidth As Word 236 bcHeight As Word 237 bcPlanes As Word 238 bcBitCount As Word 239 End Type 240 241 Type BITMAPCOREINFO 242 bmciHeader As BITMAPCOREHEADER 243 bmciColors[ELM(1)] As RGBTRIPLE 244 End Type 103 245 104 246 ' structures for defining DIBs … … 109 251 Const BI_JPEG = 4 110 252 Const BI_PNG = 5 253 111 254 Type BITMAPINFOHEADER 112 255 biSize As DWord … … 122 265 biClrImportant As DWord 123 266 End Type 267 124 268 Type BITMAPINFO 125 269 bmiHeader As BITMAPINFOHEADER 126 bm pColors[255] As RGBQUAD270 bmiColors[ELM(1)] As RGBQUAD '以前はbmpColors[255] As RGBQUADだったことに注意 127 271 End Type 128 272 … … 137 281 End Type 138 282 283 Type 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 304 End Type 139 305 140 306 ' Region flags … … 327 493 Declare Function CancelDC Lib "gdi32" (hdc As HDC) As BOOL 328 494 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 495 Declare Function CloseEnhMetaFile Lib "gdi32" (hdc As HDC) As HENHMETAFILE 329 496 Declare Function CloseFigure Lib "gdi32" (hdc As HDC) As BOOL 497 Declare Function CloseMetaFile Lib "gdi32" (hdc As HDC) As HMETAFILE 330 498 331 499 Const RGN_AND = 1 … … 335 503 Const RGN_COPY = 5 336 504 Declare Function CombineRgn Lib "gdi32" (hrgnDest As HRGN, hrgnSrc1 As HRGN, hrgnSrc2 As HRGN, fnCombineMode As Long) As Long 337 505 Declare Function CopyEnhMetaFile Lib "gdi32" Alias "CopyEnhMetaFileA" (hemfSrc As HENHMETAFILE, pszFile As PCSTR) As HENHMETAFILE 506 Declare Function CopyMetaFile Lib "gdi32" Alias "CopyMetaFileA" (hmfSrc As HMETAFILE, pszFile As PCSTR) As HMETAFILE 338 507 Declare Function CreateBitmap Lib "gdi32" (nWidth As Long, nHeight As Long, cPlanes As Long, cBitsPerPel As Long, lpvBits As VoidPtr) As HBITMAP 339 508 Declare Function CreateBitmapIndirect Lib "gdi32" (ByRef lpbm As BITMAP) As HBITMAP … … 376 545 Declare Function CreateEllipticRgn Lib "gdi32" (nLeftRect As Long, nTopRect As Long, nRightRect As Long, nBottomRect As Long) As HRGN 377 546 Declare Function CreateEllipticRgnIndirect Lib "gdi32" (ByRef lpRect As RECT) As HRGN 547 Declare Function CreateEnhMetaFile Lib "gdi32" Alias "CreateEnhMetaFileA" (hdcRef As HDC, pFileName As PCTSTR, ByRef Rect As RECT, pDescription As PCTSTR) As HDC 548 Declare Function CreateMetaFile Lib "gdi32" Alias "CreateMetaFileA" (pFileName As PCTSTR) As HDC 378 549 379 550 Const FW_DONTCARE = 0 … … 518 689 Declare Function CreateSolidBrush Lib "gdi32" (crColor As COLORREF) As HBRUSH 519 690 Declare Function DeleteDC Lib "gdi32" (hdc As HDC) As BOOL 691 Declare Function DeleteEnhMetaFile Lib "gdi32" (hemf As HENHMETAFILE) As BOOL 692 Declare Function DeleteMetaFile Lib "gdi32" (hmf As HMETAFILE) As BOOL 520 693 Declare Function DeleteObject Lib "gdi32" (hObject As HANDLE) As BOOL 521 694 Declare Function DPtoLP Lib "gdi32" (hdc As HDC, ByRef lpPoints As POINTAPI, nCount As Long) As BOOL … … 524 697 Declare Function EndPage Lib "gdi32" (hdc As HDC) As Long 525 698 Declare Function EndPath Lib "gdi32" (hdc As HDC) As BOOL 699 Declare Function EnumEnhMetaFile Lib "gdi32" (hdc As HDC, hemf As HENHMETAFILE, pEnhMetaFunc As ENHMFENUMPROC, pData As VoidPtr, ByRef Rect As RECT) As BOOL 700 Declare Function EnumMetaFile Lib "gdi32" (hdc As HDC, hmf As HMETAFILE, pMetaFunc As MFENUMPROC, lParam As LPARAM) As BOOL 526 701 Declare Function EqualRgn Lib "gdi32" (hSrcRgn1 As HRGN, hSrcRgn2 As HRGN) As BOOL 527 702 Declare Function ExcludeClipRect Lib "gdi32" (hdc As HDC, nLeftRect As Long, nTopRect As Long, nRightRect As Long, nBottomRect As Long) As Long … … 552 727 Declare Function FillRgn Lib "gdi32" (hdc As HDC, hRgn As HRGN, hBrush As HBRUSH) As Long 553 728 Declare 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 729 Declare Function GdiComment Lib "gdi32" (hdc As HDC, cbSize As DWord, lpData As *Byte) As BOOL 730 Declare Function GetBitmapBits Lib "gdi32" (hbmp As HBITMAP, cbBuffer As Long, lpvBits As VoidPtr) As Long 555 731 Declare Function GetBkColor Lib "gdi32" (hdc As HDC) As DWord 556 732 Declare Function GetBkMode Lib "gdi32" (hdc As HDC) As Long … … 682 858 683 859 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 860 Declare Function GetEnhMetaFile Lib "gdi32" Alias "GetEnhMetaFileA" (pszMetaFile As PCSTR) As HENHMETAFILE 861 Declare Function GetEnhMetaFileBits Lib "gdi32" (hemf As HENHMETAFILE, cbBuffer As DWord, pbBuffer As *Byte) As DWord 862 Declare Function GetEnhMetaFileDescription Lib "gdi32" Alias "GetEnhMetaFileDescriptionA" (hemf As HENHMETAFILE, cbBuffer As DWord, pszDescription As PTSTR) As DWord 863 Declare Function GetEnhMetaFileHeader Lib "gdi32" (hemf As HENHMETAFILE, cbBuffer As DWord, ByRef emh As ENHMETAHEADER) As DWord 864 Declare Function GetEnhMetaFilePaletteEntries Lib "gdi32" (hemf As HENHMETAFILE, cEntries As DWord, ByRef pe As PALETTEENTRY) As DWord 684 865 685 866 Const MM_TEXT = 1 … … 692 873 Const MM_ANISOTROPIC = 8 693 874 Declare Function GetMapMode Lib "gdi32" (hdc As HDC) As Long 694 875 Declare Function GetMetaFileBitsEx Lib "gdi32" (hmf As HMETAFILE, nSize As DWord, pvData As VoidPtr) As DWord 695 876 Declare Function GetMiterLimit Lib "gdi32" (hdc As HDC, peLimit As SinglePtr) As Long 696 877 Declare Function GetObject Lib "gdi32" Alias "GetObjectA" (hgdiobj As HANDLE, cbBuffer As Long, ByRef lpvObject As Any) As Long … … 781 962 Declare Function GetWindowExtEx Lib "gdi32" (hdc As HDC, ByRef lpSize As SIZE) As Long 782 963 Declare Function GetWindowOrgEx Lib "gdi32" (hdc As HDC, ByRef lpPoint As POINTAPI) As Long 964 Declare Function GetWinMetaFileBits Lib "gdi32" (hemf As HENHMETAFILE, cbBuffer As DWord, pbBuffer As *Byte, fnMapMode As Long, hdcRef As HDC) As DWord 783 965 Declare Function IntersectClipRect Lib "gdi32" (hdc As HDC, nLeftRect As Long, nTopRect As Long, nRightRect As Long, nBottomRect As Long) As Long 784 966 Declare Function InvertRgn Lib "gdi32" (hdc As HDC, hRgn As HRGN) As Long … … 794 976 Declare Function PathToRegion Lib "gdi32" (hdc As HDC) As HRGN 795 977 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 978 Declare Function PlayEnhMetaFile Lib "gdi32" (hdc As HDC, hemf As HENHMETAFILE, ByRef Rect As RECT) As Long 979 Declare Function PlayEnhMetaFileRecord Lib "gdi32" (hdc As HDC, ByRef Handletable As HANDLETABLE, ByRef EnhMetaRecord As ENHMETARECORD, nHandles As DWord) As BOOL 980 Declare Function PlayMetaFile Lib "gdi32" (hdc As HDC, hmf As HMETAFILE) As BOOL 981 Declare Function PlayMetaFileRecord Lib "gdi32" (hdc As HDC, ByRef Handletable As HANDLETABLE, ByRef MetaRecord As METARECORD, nHandles As DWord) As BOOL 796 982 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 797 983 Declare Function PolyBezier Lib "gdi32" (hdc As HDC, ByRef lppt As POINTAPI, cPoints As Long) As Long … … 824 1010 Declare Function SetBrushOrgEx Lib "gdi32" (hdc As HDC, nXOrg As Long, nYOrg As Long, ByRef lppt As POINTAPI) As Long 825 1011 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 1012 Declare Function SetEnhMetaFileBits Lib "gdi32" (cbBuffer As DWord, pData As *Byte) As HENHMETAFILE 826 1013 Declare Function SetMapMode Lib "gdi32" (hdc As HDC, fnMapMode As Long) As Long 1014 Declare Function SetMetaFileBitsEx Lib "gdi32" (nSize As DWord, pData As *Byte) As HMETAFILE 827 1015 Declare Function SetMiterLimit Lib "gdi32" (hdc As HDC, eNewLimit As Single, peOldLimit As SinglePtr) As Long 828 1016 Declare Function SetPixel Lib "gdi32" (hdc As HDC, x As Long, y As Long, crColor As DWord) As DWord … … 847 1035 Declare Function SetWindowExtEx Lib "gdi32" (hdc As HDC, nXExtent As Long, nYExtent As Long, ByRef lpSize As SIZE) As Long 848 1036 Declare Function SetWindowOrgEx Lib "gdi32" (hdc As HDC, x As Long, y As Long, ByRef lpPoint As POINTAPI) As Long 1037 Declare Function SetWinMetaFileBits Lib "gdi32" (cbBuffer As DWord, pbBuffer As *Byte, hdcRef As HDC, ByRef mfp As METAFILEPICT) As HENHMETAFILE 849 1038 Declare Function StartDoc Lib "gdi32" Alias "StartDocA" (hdc As HDC, ByRef ref_di As DOCINFO) As Long 850 1039 Declare Function StartPage Lib "gdi32" (hdc As HDC) As Long -
Include/basic/command.sbp
r121 r123 80 80 Macro INSMENU(hMenu As HMENU, PosID As Long, flag As Long)(lpString As String, id As Long, hSubMenu As HMENU, state As Long) 81 81 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 97 99 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) 102 102 End Macro 103 103 … … 220 220 End Sub 221 221 222 Function_System_Input_SetArgument(arg As VoidPtr, dataType As DWord, ByRef buf As String, bufLen As Long)222 Sub _System_Input_SetArgument(arg As VoidPtr, dataType As DWord, ByRef buf As String, bufLen As Long) 223 223 Select Case dataType 224 224 Case _System_Type_Double … … 243 243 pTempStr->Chars[pTempStr->Length] = 0 244 244 End Select 245 End Function245 End Sub 246 246 247 247 Sub PRINT_ToFile(FileNumber As Long, buf As String) 248 248 Dim dwAccessByte As DWord 249 FileNumber =FileNumber-1249 FileNumber-- 250 250 251 251 WriteFile(_System_hFile(FileNumber),buf,Len(buf),VarPtr(dwAccessByte),ByVal NULL) … … 320 320 If length_buf>=length_num Then 321 321 '通常時 322 FillMemory(StrPtr(buffer)+i3,length_buf-length_num,Asc(" ")) 322 _System_FillChar(VarPtr(buffer[i3]), length_buf - length_num, &h20) 'Asc(" ") 323 323 324 i3 += length_buf - length_num 324 325 325 326 If sign Then 326 buffer[i3] =Asc("-")327 buffer[i3] = Asc("-") 327 328 i3++ 328 329 … … 330 331 End If 331 332 332 If dec >0 Then333 memcpy( StrPtr(buffer)+i3,temp2,length_num)333 If dec > 0 Then 334 memcpy(VarPtr(buffer[i3]), temp2, SizeOf (Char) * length_num) 334 335 Else 335 buffer[i3] =&H30336 buffer[i3] = &H30 336 337 End If 337 338 … … 339 340 Else 340 341 '表示桁が足りないとき 341 FillMemory(StrPtr(buffer)+i3,length_buf,Asc("#"))342 _System_FillChar(VarPtr(buffer[i3]), length_buf,&h23) 'Asc("#") 342 343 i3 += length_buf 343 344 End If 344 345 345 If UsingStr[i2] =Asc(".") Then346 buffer[i3] =UsingStr[i2]346 If UsingStr[i2] = Asc(".") Then 347 buffer[i3] = UsingStr[i2] 347 348 i2++ 348 349 i3++ 349 350 350 351 i4=dec 351 While UsingStr[i2] =Asc("#")352 While UsingStr[i2] = Asc("#") 352 353 If i4<0 Then 353 354 buffer[i3]=&H30 … … 364 365 i2++ 365 366 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]) 368 371 ElseIf UsingStr[i2]=Asc("&") Then 369 372 i4=0 … … 380 383 i5=i4 381 384 Else 382 FillMemory(StrPtr(buffer)+i3,i4,Asc(" "))385 _System_FillChar(VarPtr(buffer[i3]), i4, &h20) 'Asc(" ") 383 386 End If 384 memcpy( StrPtr(buffer)+i3,_System_UsingStrData[ParmNum],i5)387 memcpy(VarPtr(buffer[i3]), _System_UsingStrData[ParmNum], SizeOf (Char) * i5) 385 388 i3 += i4 386 389 Else 387 390 i2 -= i4 388 buffer[i3] =Asc("&")391 buffer[i3] = Asc("&") 389 392 i2++ 390 393 i3++ … … 396 399 Wend 397 400 398 _System_GetUsingFormat =Left$(buffer,lstrlen(buffer))401 _System_GetUsingFormat = Left$(buffer, lstrlen(buffer)) 399 402 End Function 400 403 Sub PRINTUSING_ToFile(FileNumber As Long, UsingStr As String) -
Include/basic/dos_console.sbp
r110 r123 55 55 Wend 56 56 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) 75 58 76 59 i++ -
Include/basic/function.sbp
r121 r123 502 502 i2=0 503 503 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") 505 505 If i=0 Then Exit Do 506 506 i-- … … 522 522 523 523 Function Space$(length As Long) As String 524 Space$=ZeroString(length) 525 FillMemory(StrPtr(Space$),length,&H20) 524 Space$.ReSize(length, &H20 As Char) 526 525 End Function 527 526 … … 540 539 End If 541 540 Else 542 _System_ecvt_buffer[count] =_System_ecvt_buffer[count]+1 As Char541 _System_ecvt_buffer[count]++ 543 542 End If 544 543 End Sub … … 551 550 '値が0の場合 552 551 If value=0 Then 553 FillMemory(_System_ecvt_buffer,count,&H30)554 _System_ecvt_buffer[count] =0555 dec =0556 sign =0552 _System_FillChar(_System_ecvt_buffer, count, &H30) 553 _System_ecvt_buffer[count] = 0 554 dec = 0 555 sign = 0 557 556 Exit Function 558 557 End If … … 627 626 buffer[i]=Asc(".") 628 627 i++ 629 memcpy( buffer+i,temp+1,14)628 memcpy(VarPtr(buffer[i]), VarPtr(temp[1]), SizeOf (Char) * 14) 630 629 i+=14 631 630 buffer[i]=Asc("e") 632 631 i++ 633 wsprintf(buffer+i,"+%03d",dec-1)632 _stprintf(VarPtr(buffer[i]), "+%03d", dec-1) 634 633 635 634 Return MakeStr(buffer) … … 642 641 buffer[i]=Asc(".") 643 642 i++ 644 memcpy( buffer+i,temp+1,14)643 memcpy(VarPtr(buffer[i]), VarPtr(temp[1]), SizeOf (Char) * 14) 645 644 i+=14 646 645 buffer[i]=Asc("e") 647 646 i++ 648 wsprintf(buffer+i,"%03d",dec-1)647 _stprintf(VarPtr(buffer[i]), "+%03d", dec-1) 649 648 650 649 Return MakeStr(buffer) … … 714 713 Dim i As Long 715 714 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) 717 716 Next 718 717 End Function … … 760 759 761 760 If buf[0]=Asc("&") Then 762 temporary =buf763 TempPtr=StrPtr(temporary)764 CharUpper(TempPtr)761 temporary = buf 762 temporary.ToUpper() 763 TempPtr = StrPtr(temporary) 765 764 If TempPtr(1)=Asc("O") Then 766 765 '8進数 … … 778 777 i64data=1 779 778 While i>=2 780 Val =Val+i64data*TempPtr[i]781 782 i64data =i64data*&O10779 Val += i64data * TempPtr[i] 780 781 i64data *= &O10 783 782 i-- 784 783 Wend … … 948 947 '-------- 949 948 950 Sub _splitpath(path As BytePtr, drive As BytePtr, dir As BytePtr, fname As BytePtr, ext As BytePtr)949 Sub _splitpath(path As PCSTR, drive As PSTR, dir As PSTR, fname As PSTR, ext As PSTR) 951 950 Dim i As Long, i2 As Long, i3 As Long, length As Long 952 951 Dim buffer[MAX_PATH] As Char … … 966 965 i2=0 967 966 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 972 972 If dir Then 973 973 dir[i2]=path[i] … … 979 979 Continue 980 980 End If 981 #endif982 981 983 982 If path[i]=0 Then Exit Do … … 1000 999 i3=-1 1001 1000 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 1003 1006 If fname Then 1004 1007 fname[i2]=path[i] … … 1065 1068 End Function 1066 1069 1070 Function _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 1075 End Function 1076 1067 1077 #endif '_INC_FUNCTION -
Include/basic/prompt.sbp
r121 r123 38 38 39 39 _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) 40 CreateThread(0, 0, AddressOf(PromptMain) As LPTHREAD_START_ROUTINE, 0, 0, _PromptSys_dwThreadID) 47 41 Do 48 42 Sleep(20) … … 135 129 If buf[i2] = 9 Then 'tab 136 130 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(" ") 143 132 i2++ 144 133 .x += i3 … … 194 183 Dim tm As TEXTMETRIC 195 184 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) 197 186 GetTextMetrics(_PromptSys_hMemDC, tm) 198 187 SelectObject(_PromptSys_hMemDC, hOldFont) … … 215 204 With CompForm 216 205 .dwStyle = CFS_POINT 217 .ptCurrentPos.x = _PromptSys_CurPos.x *_PromptSys_FontSize.cx218 .ptCurrentPos.y = _PromptSys_CurPos.y *_PromptSys_FontSize.cy206 .ptCurrentPos.x = _PromptSys_CurPos.x * _PromptSys_FontSize.cx 207 .ptCurrentPos.y = _PromptSys_CurPos.y * _PromptSys_FontSize.cy 219 208 End With 220 209 ImmSetCompositionWindow(hIMC, CompForm) … … 223 212 ImmReleaseContext(hWnd, hIMC) 224 213 225 CreateCaret(hWnd, NULL,9,6)214 CreateCaret(hWnd, NULL, 9, 6) 226 215 SetCaretPos(_PromptSys_CurPos.x*_PromptSys_FontSize.cx, _ 227 216 (_PromptSys_CurPos.y+1)*_PromptSys_FontSize.cy-7) … … 256 245 Dim pTemp = GlobalLock(hGlobal) As PCSTR 257 246 #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 259 249 TempStr = ZeroString(tempSizeW) 260 MultiByteToWideChar(CP_ACP, 0, pTemp, -1, StrPtr(TempStr), tempSizeW)250 MultiByteToWideChar(CP_ACP, 0, pTemp, tempSizeA, StrPtr(TempStr), tempSizeW) 261 251 #else 262 252 TempStr = ZeroString(lstrlen(pTemp) + 1) … … 335 325 'Regist Prompt Class 336 326 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 347 339 Dim atom = RegisterClassEx(wcl) 348 340 349 341 'Create Prompt Window 350 342 _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) 352 344 UpdateWindow(_PromptSys_hWnd) 353 345 354 Dim msg As MSG , iResult As Long346 Dim msg As MSG 355 347 Do 356 iResult=GetMessage(msg,0,0,0)357 If iResult =0 or iResult=-1 Then Exit Do348 Dim iResult = GetMessage(msg, 0, 0, 0) 349 If iResult = 0 or iResult = -1 Then Exit Do 358 350 TranslateMessage(msg) 359 351 DispatchMessage(msg) … … 392 384 If num=1 or num=3 Then 393 385 'Clear the text screen 394 For i =0 To 100395 FillMemory(_PromptSys_Buffer[i],255,0)386 For i = 0 To 100 387 _System_FillChar(_PromptSys_Buffer[i],255,0) 396 388 Next 397 _PromptSys_CurPos.x=0 398 _PromptSys_CurPos.y=0 389 With _PromptSys_CurPos 390 .x = 0 391 .y = 0 392 End With 399 393 End If 400 394 … … 488 482 If y<0 Then y=0 489 483 If y>100 Then y=100 490 491 _PromptSys_CurPos.x=x492 _PromptSys_CurPos.y=y493 484 With _PromptSys_CurPos 485 .x = x 486 .y = y 487 End With 494 488 i=0 495 489 While _PromptSys_Buffer[y][i] … … 497 491 Wend 498 492 499 If i <x Then500 FillMemory(_PromptSys_Buffer[y]+i,x-i,Asc(" "))501 For i2 =i To x-1502 _PromptSys_BackColor[y][i2] =-1493 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 503 497 Next 504 498 End If
Note:
See TracChangeset
for help on using the changeset viewer.