[API]
GetObjectA
CreateCompatibleDC
GetDIBits
DeleteDC
LocalAlloc
RtlMoveMemory

[INCLUDE]
RegionSet_Free

[DEFINE]
#If RegionSet_DebugDraw Then
  Public RegionSetDebugCol As Long
  #End If

[CODE]
Public Function RegionSet_FromBitmap(ByVal hBitmap As Long) As Long
  Dim hDC As Long
  Dim hBmpOld As Long
  Dim xLongA1(265) As Long
  Dim Width As Long
  Dim WidthS As Long
  Dim Height As Long
  Dim xX1 As Long 'real pos
  Dim xY1 As Long
  Dim xX2 As Long 'in line +/-
  'Dim xY2 As Long
  Dim xX3 As Long
  Dim xY3 As Long
  Dim xX4 As Long 'all rect check
  'Dim xY4 As Long
  Dim xX5 As Long
  Dim xY5 As Long
  Dim xX6 As Long
  Dim xY6 As Long
  
  Dim xLong1 As Long
  #If RegionSet_FromBitmapTrueColor Then
    Dim xByteA1() As Long
    #Else
    Dim xByteA1() As Byte
    #End If
  Dim xBestC As Long
  Dim xBestD As Long
  Dim xBestX1 As Long
  Dim xBestX2 As Long
  Dim xBestY As Long
  Dim xNewC As Long
  Dim xAdditive As Long
  Dim xStyle As Long
  Dim xRgn(1) As String
  Dim xPxl(1, 4&) As String

  If Not hBitmap = 0& Then
    If Not GetObjectA(hBitmap, 28&, ByVal VarPtr(xLongA1(0))) = 0& Then
      Width = xLongA1(1)
      Height = xLongA1(2)
      If Width > 0& And Height > 0& Then
        hDC = CreateCompatibleDC(0&)
        If Not hDC = 0& Then
          'RegionSet_Create=
          WidthS = Width
          #If Not RegionSet_FromBitmapTrueColor Then
            If Width And &H3& Then
              WidthS = (Width And &HFFFFFFFC) + 4&
              End If
            #End If
          If Width > 0& And Height > 0& Then
            #If RegionSet_FromBitmapTrueColor Then
              ReDim xByteA1(Height * WidthS - 1&)
              #Else
              ReDim xByteA1(Height * WidthS - 1&)
              #End If
            xLongA1(0) = 40&
            'xLongA1(1) = Width
            'xLongA1(2) = Height
            #If RegionSet_FromBitmapTrueColor Then
              xLongA1(3) = &H200001
              #Else
              xLongA1(3) = &H80001
              #End If
            xLongA1(4) = 0&
#If RegionSet_FromBitmapTrueColor Then
            If GetDIBits(hDC, hBitmap, 0&, Height, xByteA1(0), ByVal VarPtr(xLongA1(0)), 0&) Then
#Else
            If GetDIBits(hDC, hBitmap, 0&, Height, xByteA1(0), ByVal VarPtr(xLongA1(0)), 0&) Then
#End If
              For xAdditive = 0& To 1&
                If xAdditive = 0& Then
                  For xLong1 = 0& To WidthS * Height - 1&
                    If Not xByteA1(xLong1) = 0& Then xByteA1(xLong1) = 2&
                    Next
                  xRgn(xAdditive) = Chr(2&) + _
                                    Chr(0&) + Chr(0&) + _
                                    Chr(0&) + Chr(0&) + _
                                    Chr(Width And &HFF&) + Chr((Width And &HFF00) / &H100&) + _
                                    Chr(Height And &HFF&) + Chr((Height And &HFF00) / &H100&)
                  xStyle = 4&
                  Else
                  For xLong1 = 0& To WidthS * Height - 1&
                    If xByteA1(xLong1) = 2& Then
                      xByteA1(xLong1) = 0&
                      Else
                      xByteA1(xLong1) = 2&
                      End If
                    Next
                  xX1 = 0&
                  xY1 = 0&
                  xStyle = 2&
                  End If
              
                Do While (xY1 < Height)
                  'Debug.Print xX1, xY1
                  'Stop
                  If xByteA1(xY1 * WidthS + xX1) = 0& Then
                    xBestC = -1&
                    xBestD = -1&
                    xBestX1 = xX1
                    xBestX2 = xX1
                    xBestY = xY1
                    xX2 = xX1
                    Do While (xX2 > 0&)
                      If xByteA1(xY1 * WidthS + xX2 - 1&) = 2& Then Exit Do
                      xX2 = xX2 - 1&
                      Loop
                    xX3 = xX1
  '                  Stop
                    Do While (xX3 < Width - 1&)
                      If xByteA1(xY1 * WidthS + xX3 + 1&) = 2& Then Exit Do
                      xX3 = xX3 + 1&
                      Loop
                    'xY2 = xY1
                    'Do While xY2 > 0&
                    '  If xByteA1((xY2 - 1&) * WidthS + xX1) = 2& Then Exit Do
                    '  xY2 = xY2 + 1&
                    '  Loop
                    xY3 = xY1
                    Do While (xY3 < Height - 1&)
                      If xByteA1((xY3 + 1&) * WidthS + xX1) = 2& Then Exit Do
                      xY3 = xY3 + 1&
                      Loop
                    For xX4 = xX2 To xX1
                      For xX5 = xX1 To xX3
                        For xY5 = xY1 To xY3
                          xNewC = 0&
                          For xX6 = xX4 To xX5
                            For xY6 = xY1 To xY5
                              xLong1 = xByteA1(xY6 * WidthS + xX6)
                              If xLong1 = 2& Then
                                GoTo NoVRect
                                ElseIf xLong1 = 0& Then
                                xNewC = xNewC + 1&
                                End If
                              Next
                            Next
                          If xX4 <= xX1 And xX5 >= xX1 Then
                            Else
                            Stop
                            End If
                          'If xX1 = 5 And xY1 = 0& Then
                            'Debug.Print "Rect", xX4, xX5, xY5, xNewC, xLong1
                          '  End If
                          xLong1 = (xX5 - xX4) + (xY5 - xY1)
                          If xNewC > xBestC Or xNewC = xBestC And xLong1 > xBestD Then
                            xBestC = xNewC
                            xBestD = xLong1
                            xBestX1 = xX4
                            xBestX2 = xX5
                            xBestY = xY5
                            End If
NoVRect:
                          Next
                        Next
                      Next
  Const Z As Long = 6&
  '                  Stop
                    For xX2 = xBestX1 To xBestX2
                      For xY3 = xY1 To xBestY
                        xByteA1(xY3 * WidthS + xX2) = 1&
                        Next
                      Next
                    
  'Debug.Print Timer, xBestX1, xY1, xBestX2, xBestY, xBestC, xBestD
                    
                    
                    xBestY = Height - xBestY - 1&
                    xY1 = Height - xY1 - 1&
                    If xBestX1 = xBestX2 And xY1 = xBestY Then
                      xPxl(xAdditive, xStyle) = xPxl(xAdditive, xStyle) + _
                                                Chr(xBestX1 And &HFF&) + Chr((xBestX1 And &HFF00) / &H100&) + _
                                                Chr(xBestY And &HFF&) + Chr((xBestY And &HFF00) / &H100&)
                      Else
                      xBestX2 = xBestX2 + 1&
                      xY1 = xY1 + 1&
                      xRgn(xAdditive) = xRgn(xAdditive) + Chr(xStyle) + _
                                            Chr(xBestX1 And &HFF&) + Chr((xBestX1 And &HFF00) / &H100&) + _
                                            Chr(xBestY And &HFF&) + Chr((xBestY And &HFF00) / &H100&) + _
                                            Chr(xBestX2 And &HFF&) + Chr((xBestX2 And &HFF00) / &H100&) + _
                                            Chr(xY1 And &HFF&) + Chr((xY1 And &HFF00) / &H100&)
                      xBestX2 = xBestX2 - 1&
                      xY1 = xY1 - 1&
                      End If

                    
#If RegionSet_DebugDraw Then
                    RegionSetDebugCol = (RegionSetDebugCol + 1&) Mod 8
                    'If xBestY = 0& Then Stop
                    'If xY1 = 0& Then Stop
'                    Stop
                    Form1.Picture2.Line (xBestX1 * Z, xBestY * Z)-(xBestX2 * Z + Z - 1, xY1 * Z + Z - 1), Fix(RegionSetDebugCol * 127 / 8& + 128) * (xAdditive * &HFF& + 1&), BF
                    Form1.Picture2.Picture = Form1.Picture2.Image
                    DoEventsEx_SleepPeriodical
#End If
                    xBestY = Height - xBestY - 1&
                    xY1 = Height - xY1 - 1&
                    
                    End If
                  xX1 = xX1 + 1&
                  If xX1 = Width - 1& Then
                    xY1 = xY1 + 1&
                    xX1 = 0&
                    End If
                  Loop
                'xSet(xAdditive) = Chr(xX1 And &HFF&) + Chr((xX1 And &HFF00) / &H100&) + xSet(xAdditive)
                'Picture2.Picture = Picture2.Image
                xX1 = Len(xRgn(xAdditive)) / 9&
                xX2 = Len(xPxl(xAdditive, 0&)) / 4&
                xX3 = Len(xPxl(xAdditive, 1&)) / 4&
                xX4 = Len(xPxl(xAdditive, 2&)) / 4&
                xX5 = Len(xPxl(xAdditive, 3&)) / 4&
                xX6 = Len(xPxl(xAdditive, 4&)) / 4&
                'Stop
                xRgn(xAdditive) = Chr(xX1 And &HFF&) + Chr((xX1 And &HFF00) / &H100&) + _
                                  Chr(xX2 And &HFF&) + Chr((xX1 And &HFF00) / &H100&) + _
                                  Chr(xX3 And &HFF&) + Chr((xX1 And &HFF00) / &H100&) + _
                                  Chr(xX4 And &HFF&) + Chr((xX1 And &HFF00) / &H100&) + _
                                  Chr(xX5 And &HFF&) + Chr((xX1 And &HFF00) / &H100&) + _
                                  Chr(xX6 And &HFF&) + Chr((xX1 And &HFF00) / &H100&) + _
                                  xRgn(xAdditive) + _
                                  xPxl(xAdditive, 0&) + _
                                  xPxl(xAdditive, 1&) + _
                                  xPxl(xAdditive, 2&) + _
                                  xPxl(xAdditive, 3&) + _
                                  xPxl(xAdditive, 4&)
                Next
              End If
            End If
          Call DeleteDC(hDC)
          End If
        End If
      End If
    End If
  DoEvents
  'Call RegionSet_Apply(Form2.hWnd, xSet(0&), Z * (Width + 1), Z)
  'Call RegionSet_Apply(Form3.hWnd, xSet(1&), Z * 2& * (Width + 1), Z)
  
  If Len(xRgn(0&)) < Len(xRgn(1&)) Then
    xAdditive = 0&
    Else
    xAdditive = 1&
    End If
  RegionSet_FromBitmap = LocalAlloc(0&, Len(xRgn(xAdditive)))
  If Not RegionSet_FromBitmap = 0& Then
    Call RtlMoveMemory(ByVal RegionSet_FromBitmap, ByVal xRgn(xAdditive), Len(xRgn(xAdditive)))
    End If
  End Function


