cdib.pas

Delphi控件

    //Put Green into 0..255 range
    cmp   GreenAv, 255
    jl    @GreenLT255
    mov   GreenAv, 255
  @GreenLT255:
    cmp   GreenAv, 0
    jg    @GreenGT0
    mov   GreenAv, 0
  @GreenGt0:

    //Put Blue into 0..255 range
    cmp   BlueAv, 255
    jl    @BlueLT255
    mov   BlueAv, 255
  @BlueLT255:
    cmp   BlueAv, 0
    jg    @BlueGT0
    mov   BlueAv, 0
  @BlueGt0:

    pop   EDI
    pop   ESI

    ret

  @Exit:

  end;

  Dest.Opacity := AFilter.Opacity;
  Dest.Draw(0, 0, Width, Height, Self, 0, 0);
  Dest.Free;
end;

procedure TAbstractSuperDIB.AssignHeaderTo(Dest: TPersistent);
begin
  if Dest is TAbstractSuperDIB then
  begin
    TAbstractSuperDIB(Dest).FAngle := Self.FAngle;
    TAbstractSuperDIB(Dest).FAutoSize := Self.FAutoSize;
    TAbstractSuperDIB(Dest).FMasked := Self.FMasked;
    TAbstractSuperDIB(Dest).FOpacity := Self.FOpacity;
    TAbstractSuperDIB(Dest).FScaleX := Self.FScaleX;
    TAbstractSuperDIB(Dest).FScaleY := Self.FScaleY;
    TAbstractSuperDIB(Dest).FTransparent := Self.FTransparent;
    TAbstractSuperDIB(Dest).FTransparentColor := Self.FTransparentColor;
    TAbstractSuperDIB(Dest).FTransparentMode := Self.FTransparentMode;
    TAbstractSuperDIB(Dest).FBlitter := Self.FBlitter;
    if not TAbstractSuperDIB(Dest).FOwnedData then
    begin
      TAbstractSuperDIB(Dest).FWidth := Self.Width;
      TAbstractSuperDIB(Dest).FHeight := Self.Height;
    end;
  end 
  else
    raise EDIBError.Create('Cannot assign a TAbstractDIB to a ' + Dest.ClassName);
end;

procedure TAbstractSuperDIB.AssignTo(Dest: TPersistent);
begin
  if Dest is TAbstractSuperDIB then 
  begin
    TAbstractSuperDIB(Dest).CopyPicture(Self);
    AssignHeaderTo(Dest);
    TAbstractSuperDIB(Dest).Changed;
  end 
  else
    inherited;
end;

procedure TAbstractSuperDIB.ChangeBlitter;
begin
  if Opacity = 255 then 
  begin
    if Masked then
      FBlitter := MaskedBlit
    else if Transparent then
      FBlitter := TransparentBlit
    else
      FBlitter := SolidBlit;
  end 
  else
  begin
    if Masked then
      FBlitter := MaskedBlitO
    else if Transparent then
      FBlitter := TransparentBlitO
    else
      FBlitter := SolidBlitO;
  end;
end;

procedure TAbstractSuperDIB.Changed;
begin
  ChangeBlitter;
  if FUpdateCount = 0 then
    if Assigned(FOnChange) then FOnChange(Self);
end;

constructor TAbstractSuperDIB.Create;
begin
  inherited;
  FUpdateCount := 0;
  FData := nil;
  FBlitter := SolidBlit;
  FOwnedData := True;
  ResetHeader;
end;

procedure TAbstractSuperDIB.CopyPicture(Source: TAbstractSuperDIB);
begin
  Resize(Source.Width, Source.Height);
  if (Source.Width > 0) and (Source.Height > 0) then
    Move(Source.FData^, FData^, Width * Height * 4);
  Changed;
end;

constructor TAbstractSuperDIB.Create(aWidth, aHeight: Word);
begin
  Create;
  Resize(aWidth, aHeight);
  ClipRect := Rect(0, 0, aWidth, aHeight);
end;

constructor TAbstractSuperDIB.CreateReplicaOf(aSource: TAbstractSuperDIB);
begin
  inherited Create;
  PointDataAt(aSource);
end;

procedure TAbstractSuperDIB.DefineProperties(Filer: TFiler);
begin
  inherited;
  Filer.DefineBinaryProperty('Data', LoadDataFromStream, SaveDataToStream, FData <> nil);
end;



procedure TAbstractSuperDIB.Draw(DestX, DestY, DestWidth,
  DestHeight: Integer; Dest: TAbstractSuperDIB; SrcX, SrcY: Word);
var
  FirstPixel, LastPixel, FirstLine, LastLine: Integer;
  NoPixels, NoLines: Integer;
  SourceData, DestData: Pointer;
  SourceModulo, DestModulo: DWord;

  Result: TWinDib;
  RotSizes: TPoint;
begin
  //if drawn at an angle, we need to handle this first.
  if (Angle <> 0) or (ScaleX <> 100) or (ScaleY <> 100) then
  begin
    if FAutoSize then
    begin
      if Angle <> 0 then
        RotSizes := GetRotatedSize(DestWidth, DestHeight, Angle, ScaleX, ScaleY)
      else
      begin
        RotSizes.X := Ceil(DestWidth * ScaleX / 100);
        RotSizes.Y := Ceil(DestHeight * ScaleY / 100);
      end;
      Result := TWinDib.Create(RotSizes.X, RotSizes.Y);
    end
    else
    begin
      Result := TWinDib.Create(DestWidth, DestHeight);
    end;

    try
      Result.Masked := Masked;
      Result.Opacity := Opacity;
      Result.Transparent := Transparent;
      Result.TransparentMode := tmFixed;
      Result.TransparentColor := TransparentColor;

      if Angle = 0 then
        Result.StretchCopyPicture(Self)
      else
        RotoZoom(Result);

      if Transparent then
      begin
        Result.Transparent := True;
        Result.TransparentMode := tmFixed;
        Result.TransparentColor := TransparentColor;
      end;
      Result.FBlitter := FBlitter;
      Result.Draw(DestX, DestY, Result.Width, Result.Height, Dest, 0, 0);
    finally
      Result.Free;
    end;
    exit;
  end;

  SrcX := Abs(Srcx);

  if DestX < Dest.ClipRect.Left then
  begin
    DestWidth := DestWidth - (Dest.ClipRect.Left - DestX);
    SrcX := SrcX + (Dest.ClipRect.Left - DestX);
    DestX := Dest.ClipRect.Left;
  end;

  if DestY < Dest.ClipRect.Top then
  begin
    DestHeight := DestHeight - (Dest.ClipRect.Top - DestY);
    SrcY := SrcY + (Dest.ClipRect.Top - DestY);
    DestY := Dest.ClipRect.Top;
  end;

  if DestX + DestWidth > Dest.ClipRect.Right then
  begin
    Dec(DestWidth, (DestX + DestWidth) - Dest.ClipRect.Right - 1);
  end;

  if DestY + DestHeight > Dest.ClipRect.Bottom then
  begin
    Dec(DestHeight, (DestY + DestHeight) - Dest.ClipRect.Bottom - 1);
  end;

  if DestWidth + SrcX > Width then DestWidth := Width - SrcX;
  if DestHeight + SrcY > Height then DestHeight := Height - SrcY;
  if DestHeight <= 0 then exit;
  if DestWidth <= 0 then exit;

  if DestX > Dest.Width then exit;
  if DestY > Dest.Height then exit;
  if DestX + Width < 0 then exit;
  if DestY + Height < 0 then exit;

  if DestWidth + DestX > Dest.Width then
    DestWidth := Dest.Width - DestX;
  if DestHeight + DestY > Dest.Height then
    DestHeight := Dest.Height - DestY;

  //FirstPixel
  FirstPixel := SrcX;
  if DestX < 0 then
  begin
    FirstPixel := FirstPixel + Abs(DestX);
    Dec(DestWidth, FirstPixel);
    if DestWidth < 1 then exit;
    DestX := 0;
  end;

  //LastPixel
  LastPixel := FirstPixel + DestWidth;
  if LastPixel > Width then LastPixel := Width;

  //No of pixels per line
  NoPixels := LastPixel - FirstPixel;
  if NoPixels < 1 then exit;

  //First line
  FirstLine := SrcY;
  if DestY < 0 then
  begin
    FirstLine := FirstLine + Abs(DestY);
    Dec(DestHeight, FirstLine);
    if Destheight < 1 then exit;
    DestY := 0;
  end;



  //Last line
  LastLine := FirstLine + DestHeight;
  if LastLine > Height then LastLine := Height;

  //No of lines
  NoLines := LastLine - FirstLine;
  if NoLines < 1 then exit;

  //DIBS are upside down !
  FirstLine := (Height - 1) - FirstLine;
  DestY := (Dest.Height - 1) - DestY;

  //Work out memory addresses of the first pixel, in source and dest
  SourceData := Pointer(Integer(FData) + (FirstLine * Width * 4) + (FirstPixel * 4));
  DestData := Pointer(Integer(Dest.FData) + (DestY * Dest.Width * 4) + (DestX * 4));

  //Work out the modulos
  SourceModulo := (NoPixels * 4) + (Width * 4);
  DestModulo := (NoPixels * 4) + (Dest.Width * 4);

  FBlitter(SourceData, DestData, SourceModulo, DestModulo, NoPixels, NoLines);
  Dest.Changed;
end;

procedure TAbstractSuperDIB.DrawAll(DestX, DestY, DestWidth,
  DestHeight: Integer; Dest: TAbstractSuperDIB; SrcX, SrcY: Word);
var
  OrigBlitter: TBlitterProc;
  OrigAngle: Extended;
  OrigScaleX: Extended;
  OrigScaleY: Extended;
begin
  OrigBlitter := FBlitter;
  OrigAngle := FAngle;
  OrigScaleX := FScaleX;
  OrigScaleY := FScaleY;
  try
    FBlitter := SolidBlit;
    FAngle := 0;
    FScaleX := 100;
    FScaleY := 100;
    Draw(DestX, DestY, DestWidth, DestHeight, Dest, SrcX, SrcY);
  finally
    FBlitter := OrigBlitter;
    FAngle := OrigAngle;
    FScaleX := OrigScaleX;
    FScaleY := OrigScaleY;
  end;
end;

procedure TAbstractSuperDIB.DrawMask(DestX, DestY, DestWidth,
  DestHeight: Integer; Dest: TAbstractSuperDIB; SrcX, SrcY: Word);
var
  OrigBlitter: TBlitterProc;
begin
  OrigBlitter := FBlitter;
  try
    FBlitter := BlitMaskOnly;
    Draw(DestX, DestY, DestWidth, DestHeight, Dest, SrcX, SrcY);
  finally
    FBlitter := OrigBlitter;
  end;
end;

function TAbstractSuperDIB.GetTransparentColor: TColor;
begin
  if TransparentMode = tmFixed then
    Result := Pixel32ToColor(FTransparentColor)
  else
    Result := Pixel32ToColor(TPixel32(FData^));
//    Result := TColor(FData^) and $00FFFFFF + $01000000;
end;

procedure TAbstractSuperDIB.ImportMask(AFilename: string);
var
  PixelCount: Cardinal;
  Source1, Source2: TWinDIB;
  SrcData, DestData: Pointer;
begin
  if (Width = 0) or (Height = 0) then
    raise EDIBError.Create('You cannot import a mask until you have an image.');

  Source1 := TWinDib.Create;
  Source2 := TWinDib.Create(Width, Height);
  SrcData := Source2.FData;
  DestData := FData;
  PixelCount := Width * Height;
  try
    Source1.ImportPicture(AFilename);
    StretchBlt(Source2.Handle, 0, 0, Width, Height, Source1.Handle, 0,
      0, Source1.Width, Source1.Height, SrcCopy);
    asm
          push EDI
          push ESI

          mov  ESI, SrcData
          mov  EDI, DestData
          mov  ECX, PixelCount

    @Loop:
          Mov  al, [ESI]
          mov  [EDI+3], al
          lea  ESI, [ESI+4]
          lea  EDI, [EDI+4]
          dec  ECX
          jnz  @Loop

          pop  ESI
          pop  EDI
    end;
  finally
    Source1.Free;
    Source2.Free;
  end;
  FMasked := True;
  Changed;
end;

procedure TAbstractSuperDIB.ImportPicture(AFilename: string);
var
  Pic: TPicture;
  WinDIB: TWinDIB;
begin
  Pic := TPicture.Create;
  WinDIB := TWinDib.Create;
  try
    Pic.LoadFromFile(AFilename);
    Resize(Pic.Width, Pic.Height);
    WinDIB.ReSize(Width, Height);
    WinDib.Canvas.Draw(0, 0, Pic.Graphic);
    CopyPicture(WinDIB);
    if (Pic.Bitmap = nil) or (Pic.Bitmap.PixelFormat <> pf32Bit) then
      SetMaskedValues(255)
    else
      Masked := True;
  finally
    WinDIB.Free;
    Pic.Free;
  end;
  Changed;
end;

procedure TAbstractSuperDIB.LoadDataFromStream(S: TStream);
var
  W, H: Word;
  MS: TMemoryStream;
begin
  MS := TMemoryStream.Create;
  try
    Decompress(Self, S, MS);
    with MS do 
    begin
      Seek(0, soFromBeginning);
      Read(W, SizeOf(W));
      Read(H, SizeOf(H));
      Resize(W, H);
      Read(FData^, Width * Height * 4);
    end;
    Changed;
  finally
    MS.Free;
  end;
end;

procedure TAbstractSuperDIB.MaskedBlit(SourceData, DestData: Pointer;
  SourceModulo, DestModulo: DWord; NoPixels, NoLines: Integer);
begin
  asm
          push EDI
          push ESI
          push EBX

          mov  ESI, SourceData
          mov  EDI, DestData
          xor  EDX, EDX

  @VLoop:
          mov  ECX, NoPixels
  @HLoop:
          mov  bh, [ESI+3]
          mov  bl, [ESI+3]
          not bh

  @StartGreen:
          //Green
          xor  Ah,Ah
          LodSB
          Mul  Bl
          Mov  DX, AX

          Xor  Ah, Ah
          Mov  Al, [EDI]
          mul  Bh
          add  Ax, Dx
          lea  EAX, [EAX+255]
          mov  Al, Ah
//          inc  Al
          StoSB
          
          //Blue
          xor  Ah,Ah
          LodSB
          Mul  Bl
          Mov  DX, AX

          Xor  Ah, Ah
          Mov  Al, [EDI]
          mul  Bh
          add  Ax, Dx
          lea  EAX, [EAX+255]
          mov  Al, Ah
//          Inc  Al
          StoSB
          
          //Red
          xor  Ah,Ah
          LodSB
          Mul  Bl
          Mov  DX, AX

          Xor  Ah, Ah
          Mov  Al, [EDI]
          mul  Bh
          add  Ax, Dx
          lea  EAX, [EAX+255]
          mov  Al, Ah
//          Inc  Al
          StoSB
          mov  AL, [ESI]
          Inc  ESI
//          mov  [EDI], AL
          cmp  [EDI], AL
          ja   @DontCopyMask
          mov  [EDI], AL
  @DontCopyMask:
          Inc  EDI

          dec  ECX
          jnz  @HLoop

          sub  ESI, SourceModulo
          sub  EDI, DestModulo
          dec  NoLines
          jnz  @VLoop
  @TheEnd:
          pop  EBX
          pop  ESI
          pop  EDI
  end;
end;

procedure TAbstractSuperDIB.MaskedBlitO(SourceData, DestData: Pointer;
  SourceModulo, DestModulo: DWord; NoPixels, NoLines: Integer);
var
  Opacity: Byte;
begin
  Opacity := FOpacity;
  asm
          push EDI
          push ESI
          push EBX