freepascal.ru

Brainenjii писал(а):Если убрать StretchDraw - будет пробегаться не по 400 пикселям, а по 307200.

• без scanline'а:
  

  Код: Выделить всё

  Function TForm1.BruteCompare(Const aHTTP: String;
    Var aBuffer: TPicture): Integer;
  Var
    i, j: Integer;
    aPicture: TPicture;
    aStream: TMemoryStream;
    aPixel, aBufferedPixel: TFPColor;
  Begin
    Result := -1;
    aStream := TMemoryStream.Create;;
    HttpGetBinary(aHTTP, aStream);
    aStream.Seek(0, soFromBeginning);
    aPicture := TPicture.Create;
    aPicture.LoadFromStream(aStream);
    If aBuffer = nil Then
      Begin
        aBuffer := aPicture;
        Exit;
      End;
    Result := 0;
    For i := 0 To aPicture.Height - 1 Do
      For j := 0 To aPicture.Width - 1 Do
        Begin
          aPixel := TColorToFPColor(aPicture.Bitmap.Canvas.Pixels[j, i]);
          aBufferedPixel := 
  TColorToFPColor(aBuffer.Bitmap.Canvas.Pixels[j, i]);
          Result := Abs(aPixel.red - aBufferedPixel.Red) +
            Abs(aPixel.green - aBufferedPixel.green) +
            Abs(aPixel.blue - aBufferedPixel.blue);
        End;
    aBuffer.Free;
    aBuffer := aPicture;
  End;
  

  
  

  atop 10 писал(а):project1: 94% // UPD: было 24%
  

• со scanline'ом:
  

  Код: Выделить всё

  Function TForm1.NonStretchompare(Const aHTTP: String;
    Var aBuffer: TLazIntfImage): Integer;
  Var
    i, j: Integer;
    aPicture: TPicture;
    aImage: TLazIntfImage;
    aStream: TMemoryStream;
    aRow, aBufferedRow: pBruteArray;
  Begin
    Result := -1;
    aStream := TMemoryStream.Create;;
    HttpGetBinary(aHTTP, aStream);
    aStream.Seek(0, soFromBeginning);
    aPicture := TPicture.Create;
    aPicture.LoadFromStream(aStream);
    aImage := aPicture.Bitmap.CreateIntfImage;
    aPicture.Free;
    If aBuffer = nil Then
      Begin
        aBuffer := aImage;
        Exit;
      End;
    Result := 0;
    For i := 0 To aImage.Height - 1 Do
      Begin
        aRow := aImage.GetDataLineStart(i);
        aBufferedRow := aBuffer.GetDataLineStart(i);
        For j := 0 To aImage.Width - 1 Do
          Begin
            Result += Abs(aRow^[j].rgbtBlue - aBufferedRow^[j].rgbtBlue) +
              Abs(aRow^[j].rgbtGreen - aBufferedRow^[j].rgbtGreen) +
              Abs(aRow^[j].rgbtRed - aBufferedRow^[j].rgbtRed);
          End;
      End;
    aBuffer.Free;
    aBuffer := aImage;
  End;
  

  
  

  atop 10 писал(а):project1: 23%
  

  
  
• и stretch:
  

  Код: Выделить всё

  Function TForm1.CycleCompare(Const aHTTP: String;
    Var aBuffer: TLazIntfImage): Integer;
  Var
    i, j: Integer;
    aBitmap: TBitmap;
    aPicture: TPicture;
    aImage: TLazIntfImage;
    aStream: TMemoryStream;
    aRow, aBufferedRow: pRGBArray;
  Begin
    Result := -1;
    aStream := TMemoryStream.Create;;
    HttpGetBinary(aHTTP, aStream);
    aStream.Seek(0, soFromBeginning);
    aPicture := TPicture.Create;
    aPicture.LoadFromStream(aStream);
    aStream.Free;
    aBitmap := TBitmap.Create;
    aBitmap.SetSize(20, 20);
    aBitmap.Canvas.StretchDraw(Rect(0, 0, 20, 20) , aPicture.Bitmap);
    aPicture.Free;
    aImage := aBitmap.CreateIntfImage;
    aBitmap.Free;
    If aBuffer = nil Then
      Begin
        aBuffer := aImage;
        Exit;
      End;
    Result := 0;
    For i := 0 To aImage.Height - 1 Do
      Begin
        aRow := aImage.GetDataLineStart(i);
        aBufferedRow := aBuffer.GetDataLineStart(i);
        For j := 0 To aImage.Width - 1 Do
          Begin
            Result += Abs(aRow^[j].rgbtBlue - aBufferedRow^[j].rgbtBlue) +
              Abs(aRow^[j].rgbtGreen - aBufferedRow^[j].rgbtGreen) +
              Abs(aRow^[j].rgbtRed - aBufferedRow^[j].rgbtRed);
          End;
      End;
    aBuffer.Free;
    aBuffer := aImage;
  End;
  

  
  

  atop 10 писал(а):project1: 19%
  

Function TForm1.CycleCompare(Const aHTTP: String;
  Var aBuffer: TLazIntfImage): Integer;
Var
  i, j: Integer;
  aBitmap: TBitmap;
  aPicture: TPicture;
  aImage: TLazIntfImage;
  aStream: TMemoryStream;
  aRow, aBufferedRow: pRGBArray;
Begin
  Result := -1;
  aStream := TMemoryStream.Create;;
  HttpGetBinary(aHTTP, aStream);
  aStream.Seek(0, soFromBeginning);
  aPicture := TPicture.Create;
  aPicture.LoadFromStream(aStream);
  aStream.Free;
  aPicture.Free;
End;

atop 10 писал(а):project1: 19%

olegy123 писал(а):Самое простое: перевести картинку RGB в Gray и каждый пиксел двух картинок сравнивать на их разницу значение (diff) [+/-]..
Если во всем массиве diff не было abs(x)>некого порогового значения - значит картинки равны.

Result:= CompareByte(B1.RawImage.Data^,b2.RawImage.Data^,b1.RawImage.DataSize) = 0;