⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 cdib.pas

📁 Delphi控件
💻 PAS
📖 第 1 页 / 共 5 页
字号:

          mov  ESI, SourceData
          mov  EDI, DestData

          xor  EDX, EDX
  @VLoop:
          mov  ECX, NoPixels
  @HLoop:
          mov  bl, Opacity
          mov  al, [ESI+3]
          mul  bl
          mov  bh, ah
          mov  bl, ah
          not  bh

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

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

          //Red
          xor  Ah,Ah
          LodSB
          Mul  Bl
          Mov  DX, AX
          Xor  AX, AX
          Mov  Al, [EDI]
          mul  Bh
          add  Ax, Dx
          lea  EAX, [EAX+255]
          mov  Al, Ah
//          Inc  Al
          StoSB
          mov  AL, [ESI]
          cmp  [EDI], AL
          ja   @DontCopyMask
          mov  [EDI], AL
  @DontCopyMask:
//          mov  [EDI], AL
          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.QuickFill(aColor: TColor);
var
  NumOfColors: DWord;
  Area: Pointer;
begin
  Area := FData;
  aColor := TColor(ColorToPixel32(AColor));
  NumOfColors := Width * Height;
  asm
    push    EDI
    mov     eax, aColor
    mov     edi, Area
    mov     ecx, NumOfColors
    cld
    rep     StoSD
    pop     EDI
  end;
  Changed;
end;

procedure TAbstractSuperDIB.QuickFillRect(aColor: TColor; aLeft, aTop,
  aWidth, aHeight: Integer);
var
  NoLines, NoPixels, DestModulo: DWord;
  Data: Pointer;
begin
  if aWidth < 1 then exit;
  if aHeight < 1 then exit;
  if aLeft + aWidth < 0 then exit;
  if aTop + aHeight < 0 then exit;
  if aLeft >= Width then exit;
  if aTop >= Height then exit;

  if aLeft < 0 then 
  begin
    aWidth := aWidth - abs(aLeft);
    aLeft := 0;
  end;

  if aTop < 0 then 
  begin
    aHeight := aHeight - abs(aTop);
    aTop := 0;
  end;

  if aLeft + aWidth > Width then aWidth := Width - aLeft;
  if aTop + aHeight > Height then aHeight := Height - aTop;

  NoPixels := aWidth;
  NoLines := aHeight;
  aColor := ColorToRGB(aColor);

  Data := Pointer(Integer(FData) + (((Height - 1) - aTop) * Width * 4) + (aLeft * 4));
  DestModulo := (NoPixels * 4) + (Width * 4);

  asm
          push EDI
          push ESI

          mov  EDI, Data
          mov  EDX, NoLines
          mov  EAX, aColor
          bswap EAX
          SHR  EAX, 8
  @VLoop:
          mov  ECX, NoPixels
  rep     STOSD

          sub  EDI, DestModulo
          dec  EDX
          jnz  @VLoop
  @TheEnd:
          pop  ESI
          pop  EDI
  end;
end;

procedure TAbstractSuperDIB.ReSize(aWidth, aHeight: Word);
var
  FullSize: Boolean;
begin
  if (aWidth = Width) and (aHeight = Height) then exit;
  FullSize :=
    (ClipRect.Left = 0) and (ClipRect.Top = 0) and
    (ClipRect.Right = Width - 1) and (ClipRect.Bottom = Height - 1);

  FreeTheData;
  if aWidth < 1 then aWidth := 1;
  if aHeight < 1 then aHeight := 1;
  FWidth := aWidth;
  FHeight := aHeight;
  CreateTheData;
  //  QuickFill(clBlack);
  if FullSize then
    FClipRect := Rect(0, 0, Width - 1, Height - 1)
  else
    ClipRect := ClipRect;
end;


procedure TAbstractSuperDIB.RotoZoom(D: TAbstractSuperDIB);
var
  Source, Dest: PChar;
  NextPixelXInc, NextPixelYInc: Integer;
  NextLineXInc, NextLineYInc: Integer;
  NextLineXPos, NextLineYPos: Integer;
  Xpos, YPos: Integer;
  SLineSize: Integer;
  NegHalfSWidth, HalfSWidth, NegHalfSHeight, HalfSHeight: Integer;
  DestWidth, DestHeight: Integer;
  ScaleX, ScaleY: Extended;
  DestTransCol: DWORD;
begin
  if Masked then
    DestTransCol := DWORD(cNullPixel32)
  else
    DestTransCol := DWORD(FTransparentColor);

  Source := FData;
  Dest := D.FData;
  SLineSize := Width * 4;

  NegHalfSWidth := -(Width div 2);
  NegHalfSHeight := -(Height div 2);
  HalfSWidth := Width div 2;
  HalfSHeight := Height div 2;


  DestWidth := D.Width;
  DestHeight := D.Height;

  ScaleX := FScaleX / 100;
  ScaleY := FScaleY / 100;

  if (Width * ScaleX = 0) or (Height * ScaleY = 0) then
    Exit;

  NextPixelXInc := Round(((CosTable1(Angle)) * Width) / (Width * ScaleX));
  NextPixelYInc := Round(((SinTable1(Angle)) * Height) / (Height * ScaleY));

  NextLineXInc := Round(((CosTable2(Angle)) * Width) / (Width * ScaleX));
  NextLineYInc := Round(((SinTable2(Angle)) * Height) / (Height * ScaleY));

  NextLineXPos := ((-NextPixelXInc) * (DestWidth div 2)) - (NextLineXInc * (DestHeight div 2));
  NextLineYPos := ((-NextPixelYInc) * (DestWidth div 2)) - (NextLineYInc * (DestHeight div 2));

  Source := Source + (HalfSHeight * SLineSize) + (HalfSWidth * 4);

  asm
          push EDI
          push ESI
          push EBX

          mov  EDI, Dest
          mov  ESI, Source

          mov  ECX, DestHeight// for VLoop := 0 to D.Height -1 do begin
  @VLoop:
          mov  EAX, NextLineXPos
          mov  EBX, NextLineYPos
          mov  XPos, EAX      // XPos := NextLineXPos
          mov  YPos, EBX      // YPos := NextLineYPos

          push ECX
          mov  ECX, DestWidth //for HLoop:=0 to D.Width -1 do begin

  @HLoop:
          //Calculate offset using int(YPos)
          Mov  EAX, YPos
          test EAX, EAX
          jns  @ActualYGTZero

  @ActualYGTZero:
          sar  EAX, $10       // ActualY := YPos div 256;

          cmp  EAX, HalfSHeight
          Jge  @SkipPixel     // If ActualY > (S.Height div 2) then skip

          mov  EBX, NegHalfSHeight
          cmp  EAX, EBX
          jle  @SkipPixel     // If ActualY < -(S.Height div 2) then skip

          mov  EBX, SLineSize
          imul EBX
          mov  EDX, EAX       // Offset := (ActualY * SLineSize)

          //Calculate offset using ActualX
          mov  EAX, XPos
          test EAX, EAX
          jns  @ActualXGTZero

  @ActualXGTZero:
          sar  EAX, $10       // ActualX := XPos div 256;

          cmp  EAX, HalfSWidth
          Jge  @SkipPixel     //if ActualX > (S.Width div 2) then skip

          mov  EBX, NegHalfSWidth
          cmp  EAX, EBX
          Jle  @SkipPixel

          lea  EAX, [EAX*4+EDX]  //EAX := EAX * 4; {4 bytes per pixel}

          mov  EAX, [ESI +EAX]
          mov  [EDI], EAX

          jmp  @NextPixel

  @SkipPixel:
          mov  EAX, DestTransCol
          mov  [EDI], EAX

  @NextPixel:
          lea  EDI, [EDI+4]
          mov  EAX, NextPixelXInc
          mov  EBX, NextPixelYInc
          add  XPos, EAX      //XPos := XPos + NextPixelXInc;
          add  YPos, EBX      //Ypos := YPos + NextPixelYInc;
          dec  ECX
          jnz  @HLoop         //end; //for HLoop

  @NextLine:
          pop  ECX
          mov  EAX, NextLineXInc
          mov  EBX, NextLineYInc
          add  NextLineXPos, EAX         //I := NextLineXPos + NextLineXInc;
          add  NextLineYPos, EBX         //J := NextLineYPos + NextLineYInc;

          dec  ECX
          jnz  @Vloop         //end; //for VLoop

  @TheEnd:
          pop  EBX
          pop  ESI
          pop  EDI
  end;
  D.Changed;
end;

procedure TAbstractSuperDIB.SaveDataToStream(S: TStream);
var
  MS: TMemoryStream;
begin
  MS := TMemoryStream.Create;
  try
    with MS do
    begin
      Write(FWidth, SizeOf(FWidth));
      Write(FHeight, SizeOf(FHeight));
      Write(FData^, Width * Height * 4);
      Seek(0, soFromBeginning);
      Compress(Self, MS, S);
    end;
  finally
    MS.Free;
  end;
end;

procedure TAbstractSuperDIB.SetAngle(const Value: Extended);
begin
  if SafeAngle(Value) = FAngle then exit;
  FAngle := SafeAngle(Value);
  Changed;
end;

procedure TAbstractSuperDIB.SetAutoSize(const Value: Boolean);
begin
  if Value = FAutosize then exit;
  FAutoSize := Value;
  Changed;
end;

procedure TAbstractSuperDIB.SetHeight(const aValue: Word);
begin
  Resize(Width, aValue);
end;

procedure TAbstractSuperDIB.SetMasked(const Value: Boolean);
begin
  if Value = FMasked then exit;
  FMasked := Value;
  if FMasked then
    FTransparent := False;
  Changed;
end;

procedure TAbstractSuperDIB.SetMaskedValues(const Opacity: Byte);
var
  PixelCount: Cardinal;
  Data: PByteArray;
begin
  PixelCount := FWidth * FHeight;
  Data := PByteArray(FData);
  asm
          push EDI

          mov  EDI, Data
          mov  al,  Opacity
          mov  ECX, PixelCount
    @Loop:
          mov  [EDI+3], al
          lea  EDI, [EDI+4]
          dec  ECX
          jnz  @Loop

          pop  EDI
  end;
  Changed;
end;

procedure TAbstractSuperDIB.SetOpacity(const Value: Byte);
begin
  if Value = FOpacity then exit;
  FOpacity := Value;
  Changed;
end;

procedure TAbstractSuperDIB.SetScale(const Value: Extended);
begin
  if (Value = ScaleX) and (Value = ScaleY) then exit;
  FScaleX := Value;
  FScaleY := Value;
  Changed;
end;

procedure TAbstractSuperDIB.SetScaleX(const Value: Extended);
begin
  if Value = ScaleX then exit;
  FScaleX := Value;
  Changed;
end;

procedure TAbstractSuperDIB.SetScaleY(const Value: Extended);
begin
  if Value = ScaleY then exit;
  FScaleY := Value;
  Changed;
end;


procedure TAbstractSuperDIB.SetTransparent(const Value: Boolean);
begin
  if Value = FTransparent then exit;
  FTransparent := Value;
  if Transparent then
    FMasked := False;
  Changed;
end;

procedure TAbstractSuperDIB.SetTransparentColor(Value: TColor);
begin
  if Value = Pixel32ToColor(FTransparentColor) then exit;
  FTransparentColor := ColorToPixel32(Value);
  Changed;
end;

procedure TAbstractSuperDIB.SetTransparentMode(const Value: TTransparentMode);
begin
  if Value = TransparentMode then exit;
  FTransparentMode := Value;
  Changed;
end;

procedure TAbstractSuperDIB.SetWidth(const aValue: Word);
begin
  ReSize(aValue, Height);
end;

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

          mov  ESI, SourceData
          mov  EDI, DestData

          mov  EDX, NoLines
  @VLoop:
          mov  ECX, NoPixels
  rep     MOVSD

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

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

          mov  bh,  Opacity
          mov  bl,  Opacity

          mov  ESI, SourceData
          mov  EDI, DestData

          not  bh
          xor  EDX, EDX
  @VLoop:
          mov  ECX, NoPixels

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

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

          //Red
          xor  Ah,Ah
          LodSB
          Mul  Bl
          Mov  DX, AX
          Xor  AX, AX
          Mov  Al, [EDI]

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -