module1.bas

石器客端图形补丁编译环境RH9,GCC

    
        .bmiColors(7).rgbBlue = 80
        .bmiColors(7).rgbGreen = 80
    
        .bmiColors(8).rgbBlue = &HC0
        .bmiColors(8).rgbGreen = &HC0
        .bmiColors(8).rgbRed = &HC0
    
        .bmiColors(9).rgbBlue = &HC0
        .bmiColors(9).rgbRed = &HC0
        .bmiColors(9).rgbGreen = &HDC
    
        .bmiColors(10).rgbBlue = &HF0
        .bmiColors(10).rgbGreen = &HCA
        .bmiColors(10).rgbRed = &HA6
    
        .bmiColors(11).rgbRed = &HDE
    
        .bmiColors(12).rgbGreen = &H5F
        .bmiColors(12).rgbRed = &HFF
    
        .bmiColors(13).rgbBlue = &HA0
        .bmiColors(13).rgbGreen = &HFF
        .bmiColors(13).rgbRed = &HFF
    
        .bmiColors(14).rgbBlue = &HD2
        .bmiColors(14).rgbGreen = &H5F
    
        .bmiColors(15).rgbBlue = &HFF
        .bmiColors(15).rgbGreen = &H50
        .bmiColors(15).rgbRed = &H50
    
        .bmiColors(16).rgbRed = &H28
        .bmiColors(16).rgbGreen = &HE1
        .bmiColors(16).rgbBlue = &H28
        
        .bmiColors(241).rgbBlue = &H96
        .bmiColors(241).rgbGreen = &HC3
        .bmiColors(241).rgbRed = &HF5
        
        .bmiColors(242).rgbBlue = &H5F
        .bmiColors(242).rgbGreen = &HA0
        .bmiColors(242).rgbRed = &H1E
        
        .bmiColors(243).rgbBlue = &H46
        .bmiColors(243).rgbGreen = &H7D
        .bmiColors(243).rgbRed = &HC3
        
        .bmiColors(244).rgbRed = &H1E
        .bmiColors(244).rgbGreen = &H55
        .bmiColors(244).rgbBlue = &H9B
        
        .bmiColors(245).rgbRed = &H37
        .bmiColors(245).rgbGreen = &H41
        .bmiColors(245).rgbBlue = &H46
        
        .bmiColors(246).rgbBlue = &H1E
        .bmiColors(246).rgbGreen = &H23
        .bmiColors(246).rgbRed = &H28
        
        .bmiColors(247).rgbBlue = &HF0
        .bmiColors(247).rgbGreen = &HFB
        .bmiColors(247).rgbRed = &HFF
        
        .bmiColors(248).rgbBlue = &HA5
        .bmiColors(248).rgbGreen = &H6E
        .bmiColors(248).rgbRed = &H3A
        
        .bmiColors(249).rgbRed = &H80
        .bmiColors(249).rgbGreen = &H80
        .bmiColors(249).rgbBlue = &H80
        
        .bmiColors(250).rgbRed = &HFF
        
        .bmiColors(251).rgbGreen = &HFF
        
        .bmiColors(252).rgbRed = &HFF
        .bmiColors(252).rgbGreen = &HFF
        
        .bmiColors(253).rgbBlue = &HFF
        
        .bmiColors(254).rgbBlue = &HFF
        .bmiColors(254).rgbGreen = &H80
        .bmiColors(254).rgbRed = &HFF
        
        .bmiColors(255).rgbBlue = &HFF
        .bmiColors(255).rgbGreen = &HFF
        
        .bmiColors(256).rgbBlue = &HFF
        .bmiColors(256).rgbGreen = &HFF
        .bmiColors(256).rgbRed = &HFF
        
    End With
    Get #100, , palbyte
    For t = 1 To 708 Step 3
        yy = yy + 1
        MyBmp_Info.bmiColors(yy + 16).rgbBlue = palbyte(t)
        MyBmp_Info.bmiColors(yy + 16).rgbGreen = palbyte(t + 1)
        MyBmp_Info.bmiColors(yy + 16).rgbRed = palbyte(t + 2)
    Next
    Close #100
    With MyBmp_Info
        .bmiColors(2).rgbRed = 80
    
        .bmiColors(3).rgbGreen = 80
    
        .bmiColors(4).rgbRed = 80
        .bmiColors(4).rgbGreen = 80
    
        .bmiColors(5).rgbBlue = 80
    
        .bmiColors(6).rgbBlue = 80
        .bmiColors(6).rgbRed = 80
    
        .bmiColors(7).rgbBlue = 80
        .bmiColors(7).rgbGreen = 80
    
        .bmiColors(8).rgbBlue = &HC0
        .bmiColors(8).rgbGreen = &HC0
        .bmiColors(8).rgbRed = &HC0
    
        .bmiColors(9).rgbBlue = &HC0
        .bmiColors(9).rgbRed = &HC0
        .bmiColors(9).rgbGreen = &HDC
    
        .bmiColors(10).rgbBlue = &HF0
        .bmiColors(10).rgbGreen = &HCA
        .bmiColors(10).rgbRed = &HA6
    
        .bmiColors(11).rgbRed = &HDE
    
        .bmiColors(12).rgbGreen = &H5F
        .bmiColors(12).rgbRed = &HFF
    
        .bmiColors(13).rgbBlue = &HA0
        .bmiColors(13).rgbGreen = &HFF
        .bmiColors(13).rgbRed = &HFF
    
        .bmiColors(14).rgbBlue = &HD2
        .bmiColors(14).rgbGreen = &H5F
    
        .bmiColors(15).rgbBlue = &HFF
        .bmiColors(15).rgbGreen = &H50
        .bmiColors(15).rgbRed = &H50
    
        .bmiColors(16).rgbRed = &H28
        .bmiColors(16).rgbGreen = &HE1
        .bmiColors(16).rgbBlue = &H28
        
        .bmiColors(241).rgbBlue = &H96
        .bmiColors(241).rgbGreen = &HC3
        .bmiColors(241).rgbRed = &HF5
        
        .bmiColors(242).rgbBlue = &H5F
        .bmiColors(242).rgbGreen = &HA0
        .bmiColors(242).rgbRed = &H1E
        
        .bmiColors(243).rgbBlue = &H46
        .bmiColors(243).rgbGreen = &H7D
        .bmiColors(243).rgbRed = &HC3
        
        .bmiColors(244).rgbRed = &H1E
        .bmiColors(244).rgbGreen = &H55
        .bmiColors(244).rgbBlue = &H9B
        
        .bmiColors(245).rgbRed = &H37
        .bmiColors(245).rgbGreen = &H41
        .bmiColors(245).rgbBlue = &H46
        
        .bmiColors(246).rgbBlue = &H1E
        .bmiColors(246).rgbGreen = &H23
        .bmiColors(246).rgbRed = &H28
        
        .bmiColors(247).rgbBlue = &HF0
        .bmiColors(247).rgbGreen = &HFB
        .bmiColors(247).rgbRed = &HFF
        
        .bmiColors(248).rgbBlue = &HA5
        .bmiColors(248).rgbGreen = &H6E
        .bmiColors(248).rgbRed = &H3A
        
        .bmiColors(249).rgbRed = &H80
        .bmiColors(249).rgbGreen = &H80
        .bmiColors(249).rgbBlue = &H80
        
        .bmiColors(250).rgbRed = &HFF
        
        .bmiColors(251).rgbGreen = &HFF
        
        .bmiColors(252).rgbRed = &HFF
        .bmiColors(252).rgbGreen = &HFF
        
        .bmiColors(253).rgbBlue = &HFF
        
        .bmiColors(254).rgbBlue = &HFF
        .bmiColors(254).rgbGreen = &H80
        .bmiColors(254).rgbRed = &HFF
        
        .bmiColors(255).rgbBlue = &HFF
        .bmiColors(255).rgbGreen = &HFF
        
        .bmiColors(256).rgbBlue = &HFF
        .bmiColors(256).rgbGreen = &HFF
        .bmiColors(256).rgbRed = &HFF
        
    End With
    MyBmp_Info.bmiHeader.biSizeImage = ImageSize
    Exit Sub
Error:
    MsgBox Err.Description
End Sub

Sub SaveBmpFile(Path As String)
    If CdPath <> "" Then
        Path = CdPath & Path
    Else
        Path = App.Path & "\pic" & Path
    End If

    If MyBmp_Info.bmiHeader.biSizeImage = 0 Then Exit Sub
    Dim MyFs As New FileSystemObject, MyTxtS As TextStream
    Dim buff200() As Byte

    Open Path For Binary Access Write As #200
    Put #200, , MyBmp_Header
    Put #200, , MyBmp_Info
    ReDim buff2000(1 To MyBmp_Info.bmiHeader.biSizeImage) As Byte
    CopyMemory buff2000(1), BmpData_Byte(0), MyBmp_Info.bmiHeader.biSizeImage
    Put #200, , buff2000
    Close #200
End Sub

Sub CdFile(Path As String)
Dim attribut As SECURITY_ATTRIBUTES
attribut.nLength = Len(attribut)
attribut.lpSecurityDescriptor = &O0
attribut.bInheritHandle = False
   Dim counter As Long
   Dim tnew As String
   Dim onew As String
   Dim i As Long
   Dim lnew As Long
   Dim tx As String
   Dim mi As String
   Dim minstra As Long
   Dim A As String
   A = Path
   counter = 0
   If Right(A, 1) <> "\" Then
   A = A & "\"
   End If
   lnew = Len(A)
    For i = 1 To lnew
     tx = Left(A, i)
     If Len(tx) > 3 Then
      mi = Right(tx, 1)
      If mi = "\" Then
      Call CreateDirectory(tx, attribut)
      End If
     End If
    Next i
End Sub

Function RealToBmp(ByRef Target() As Byte, ByRef Source() As Byte, RDDataLen As Long)
    On Error Resume Next
    Dim DecryptFillPieceLen As Long
    
    Dim SourceCurrent As Long
    Dim TargetCurrent As Long
    
    Dim RealToBmp_For1 As Long
    
    Dim TempD As Byte
    
    Do
        TempD = Target(TargetCurrent)
        TargetCurrent = TargetCurrent + 1
        If TargetCurrent > RDDataLen Then
            Exit Do
        End If
        If (TempD And &H80) = 0 Then
            If (TempD And &H10) <> 0 Then
                '7x、5x、3x、1x aa bb
                '填充xaa个bb颜色点
                DecryptFillPieceLen = ((TempD And &HF) * 256) + Target(TargetCurrent)
                TargetCurrent = TargetCurrent + 1
            Else
                '6x、4x、2x、0x aa
                '填充x个aa颜色点
                DecryptFillPieceLen = (TempD And &HF)
            End If
            If DecryptFillPieceLen <= &HFFFFF And DecryptFillPieceLen > 0 Then
            For RealToBmp_For1 = 1 To DecryptFillPieceLen
                Source(SourceCurrent) = Target(TargetCurrent)
                TargetCurrent = TargetCurrent + 1
                SourceCurrent = SourceCurrent + 1
            Next
            End If
        Else
            Dim TempC As Byte
    
            If (TempD And &H40) = 0 Then
                TempC = Target(TargetCurrent)
                TargetCurrent = TargetCurrent + 1
            Else
                TempC = 0
            End If
            
            If (TempD And &H20) <> 0 Then
                DecryptFillPieceLen = ((TempD And &HF) * 256) + Target(TargetCurrent)
                TargetCurrent = TargetCurrent + 1
                DecryptFillPieceLen = (DecryptFillPieceLen * 256) + Target(TargetCurrent)
                TargetCurrent = TargetCurrent + 1
            Else
                If (TempD And &H10) <> 0 Then
                    DecryptFillPieceLen = ((TempD And &HF) * 256) + Target(TargetCurrent)
                    TargetCurrent = TargetCurrent + 1
                Else
                    DecryptFillPieceLen = (TempD And &HF)
                End If
            End If
                
                For RealToBmp_For1 = 0 To DecryptFillPieceLen
                    Source(SourceCurrent + RealToBmp_For1) = TempC
                Next
                SourceCurrent = SourceCurrent + DecryptFillPieceLen
        End If
    Loop
End Function