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

📄 cdib.pas

📁 Delphi控件
💻 PAS
📖 第 1 页 / 共 5 页
字号:
          mul  Bh
          add  Ax, Dx
          lea  EAX, [EAX+255]
          mov  Al, Ah
          StoSB
          mov  AL, [ESI]
          Inc  ESI
          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.TransparentBlit(SourceData, DestData: Pointer;
  SourceModulo, DestModulo: DWord; NoPixels, NoLines: Integer);
var
  TransColor: TPixel32;
begin
  TransColor := FTransparentColor;
  //  if TransparentMode = tmFixed then
  //     TransColor := FTransparentColor
  //  else
  //    TransColor := TColor(FData^);
  asm
          push EDI
          push ESI
          push EBX

          mov  ESI, SourceData
          mov  EDI, DestData

          mov  EDX, TransColor
          and  EDX, $00ffffff
  @VLoop:
          mov  ECX, NoPixels
  @HLoop:
          Mov  EAX, [ESI]
          and  EAX, $00ffffff
          cmp  EAX, EDX
          je   @SkipPixel
          mov  [EDI], EAX
  @SkipPixel:
          lea  ESI, [ESI+4]
          lea  EDI, [EDI+4]
          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.TransparentBlitO(SourceData, DestData: Pointer;
  SourceModulo, DestModulo: DWord; NoPixels, NoLines: Integer);
var
  TransColor: TPixel32;
  Opacity: Byte;
begin
  Opacity := FOpacity;
  TransColor := FTransparentColor;
  //  if TransparentMode = tmFixed then
  //     TransColor := FTransparentColor
  //  else
  //    TransColor := TColor(FData^);

  asm
          push EDI
          push ESI
          push EBX

          mov  EDX, TransColor
          and  EDX, $00ffffff
          mov  TransColor, EDX

          mov  bh,  Opacity
          mov  bl,  Opacity

          mov  ESI, SourceData
          mov  EDI, DestData

          xor  EDX, EDX

          not  bh
  @VLoop:
          mov  ECX, NoPixels
  @HLoop:
          mov  EAX, [ESI]
          and  EAX, $00ffffff
          cmp  EAX, TransColor
          je   @SkipPixel


          //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
          StoSB
          mov  AL, [ESI]
          Inc  ESI
          mov  [EDI], AL
          Inc  EDI

          Jmp  @NextPixel

  @SkipPixel:
          //Next pixel
          lea  ESI, [ESI+4]
          lea  EDI, [EDI+4]
  @NextPixel:
          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.PointDataAt(aSource: TAbstractSuperDIB);
begin
  FreeTheData;
  FOwnedData := False;
  aSource.AssignHeaderTo(Self);
  FData := aSource.FData;
end;

function TAbstractSuperDIB.Valid: Boolean;
begin
  Result := (FData <> nil) or not FOwnedData;
end;

destructor TAbstractSuperDIB.Destroy;
begin
  FreeTheData;
  inherited;
end;

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

          mov  ESI, SourceData
          mov  EDI, DestData
          lea  ESI, [ESI+3]
          lea  EDI, [EDI+3]

          mov  EDX, NoLines
  @VLoop:
          mov  ECX, NoPixels
  @HLoop:
          mov  al, [ESI]
          lea  ESI, [ESI+4]
          mov  [EDI], al
          lea  EDI, [EDI+4]
          dec  ECX
          jnz  @HLoop

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

procedure TAbstractSuperDIB.CreateTheData;
begin
  if FOwnedData then CreateData;
  FClipRect := Rect(0, 0, Width - 1, Height - 1);
end;

procedure TAbstractSuperDIB.FreeTheData;
begin
  if FOwnedData and (FData <> nil) then FreeData;
end;

procedure TAbstractSuperDIB.ResetHeader;
begin
  FAngle := 0;
  FMasked := False;
  FOpacity := 255;
  FScaleX := 100;
  FScaleY := 100;
  FTransparent := False;
end;

procedure TAbstractSuperDIB.SetClipRect(const aRect: TRect);
var
  Temp: Integer;
begin
  FClipRect := aRect;
  with FClipRect do 
  begin
    if Left > Right then 
    begin
      Temp := Left;
      Left := Right;
      Right := Temp;
    end;

    if Top > Bottom then 
    begin
      Temp := Top;
      Top := Bottom;
      Bottom := Temp;
    end;

    if Right >= Width then Right := Width - 1;
    if Left < 0 then Left := 0;
    if Bottom >= Height then Bottom := Height - 1;
    if Top < 0 then Top := 0;
  end;
end;

procedure TAbstractSuperDIB.StretchCopyPicture(Source: TAbstractSuperDIB);
var
  SWidth, SHeight, DWidth, DHeight: DWord;
  XInt, YInt: DWord;
  XFactor, YFactor: Word;
  SCurrentLine, DCurrentLine: Pointer;
  SLineSize, DLineSize: DWord;
begin
  SWidth := Source.Width;
  SHeight := Source.Height;
  DWidth := Width;
  DHeight := Height;

  XInt := (SWidth shl 16) div (DWidth shl 16);
  XFactor := (SWidth shl 16) div DWidth;
  YInt := (SHeight shl 16) div (DHeight shl 16);
  YFactor := (SHeight shl 16) div DHeight;


  SCurrentLine := Source.FData;
  DCurrentLine := FData;

  SLineSize := Source.Width * 4;
  DLineSize := Width * 4;
  XInt := XInt * 4;
  YInt := YInt * SLineSize;

  asm
        push ESI
        push EDI
        push EBX

        //Current X and Y factor in EDX
        mov  DX, YFactor
        BSWAP EDX
        mov  DX, XFactor

        //X and Y factor in EBX
        mov  BX, 65535
        BSWAP EBX

        //For Y := 0 to dst.height -1
        mov  ECX, DHeight

  @VLoop:

        //CurrentFactX := 65535;
        mov  BX, 65535
        //SData := SCurrentLine;
        mov  ESI, SCurrentLine
        //DData := DCurrentLine;
        mov  EDI, DCurrentLine

        //For X:=0 to Dst.Width-1
        push ECX
        mov  ECX, DWidth
  @HLoop:
        //DWord(DData^) := DWord(SData^);
        mov  EAX, [ESI]
        mov  [EDI], EAX

        //SData := Pointer(Cardinal(SData) + XInt);
        add  ESI, XInt
        //DData := Pointer(Cardinal(DData) + 4);
        lea  EDI, [EDI+4]

        //Check the XFactor
        sub  BX, DX
        jae  @NoWrapX
        lea  ESI, [ESI+4]
  @NoWrapX:
        dec  ECX
        jnz  @HLoop

        //Switch to Factors for Y loop
        BSWAP EBX
        BSWAP EDX

        //SCurrentLine := Pointer(Cardinal(SCurrentLine) + YInt);
        mov  EAX, YInt
        add  SCurrentLine, EAX
        //DCurrentLine := Pointer(Cardinal(DCurrentLine) + DLineSize);
        mov  EAX, DLineSize
        add  DCurrentLine, EAX

        //Check the Y Factor
        sub  BX, DX
        jae  @NoWrapY
        mov  EAX, SLineSize
        add  SCurrentLine, EAX
  @NoWrapY:
        //Switch back to Factors for X loop
        BSWAP EBX
        BSWAP EDX

        pop  ECX
        dec  ECX
        jnz  @VLoop

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

procedure TAbstractSuperDIB.Render8Bit(DestDC: HDC; X, Y, aWidth,
  aHeight: Integer; XSrc, YSrc: Word; ROP: Cardinal; Palette: TDIBPalette);
var
  SourceModulo, DestModulo: Integer;
  BitInfo: PBitmapInfo;
  DestData, SourceData: Pointer;
  FirstLine, LineSize: Integer;
  Table: Pointer;
  //For temp DIB
  Data: Pointer;
  DC: HDC;
  OldBitmap, Bitmap: HBitmap;
begin
  if Palette.UseTable = False then
    raise EDIBError.Create('Render8Bit can only be used with a palette containing a lookup table');
  if GetDeviceCaps(DestDC, BITSPixel) <> 8 then
    raise EDIBError.Create('Render8Bit can only be used to blit to an 8 bit DC');


  if XSrc >= Width then exit;
  if YSrc >= Height then exit;

  if X < 0 then 
  begin
    aWidth := Width - Abs(X);
    X := 0;
  end;
  if Y < 0 then 
  begin
    aHeight := Height - Abs(Y);
    Y := 0;
  end;
  if aWidth < 1 then exit;
  if aHeight < 1 then exit;

  if XSrc + aWidth > Width then aWidth := Width - (aWidth - XSrc);
  if YSrc + aHeight > Height then aHeight := Height - (aHeight - YSrc);

  //Make the 8 bit DIB
  DC := CreateCompatibleDC(DestDC);
  GetMem(BitInfo, SizeOf(TBitmapInfo) + 1024);
  with BitInfo.bmiHeader do
  begin
    biSize := SizeOf(TBitmapInfoHeader);
    biPlanes := 1;
    biBitCount := 8;
    biCompression := BI_RGB;
    biWidth := aWidth;
    biHeight := aHeight;
    biSizeImage := 0;
    biXPelsPerMeter := 0;
    biYPelsPerMeter := 0;
    biClrUsed := 0;
    biClrImportant := 0;
  end;
  GetPaletteEntries(Palette.Palette, 0, 235, BitInfo.bmiColors[0]);
  SetLastError(0);
  Bitmap := CreateDIBSection(DC, BitInfo^, DIB_PAL_COLORS, Data, 0, 0);
  if Bitmap = 0 then
    raise Exception.Create('Windows error (' + IntToStr(GetLastError) + ') ' + LastError);
  GDIFlush;
  OldBitmap := SelectObject(DC, Bitmap);

  //We now should have the bits in DATA
  LineSize := aWidth;
  if LineSize mod 4 > 0 then
    LineSize := LineSize + (4 - (LineSize mod 4));  //Increase to DWord

  DestModulo := aWidth + LineSize;
  SourceModulo := (aWidth * 4) + (Width * 4);

  FirstLine := (Height - 1) - YSrc;
  SourceData := Pointer(Integer(FData) + (FirstLine * Width * 4) + (XSrc * 4));
  DestData := Pointer(Integer(Data) + (LineSize * (aHeight - 1)));
  Table := @Palette.ColorTable[0];

  asm
      push ESI
      push EDI
      push EBX

      mov  EBX, Table
      mov  ESI, SourceData
      mov  EDI, DestData

      mov  ECX, aHeight
  @YLoop:
      push ECX
      mov  ECX, aWidth
  @XLoop:
      xor  EAX, EAX
      LodSB
      shr  EAX, 2
//      shl  eax, 12
      mov  EDX, EAX

      xor  EAX, EAX
      LodSB //Green
      shr  EAX, 2
      shl  EAX, 6
      add  EDX, EAX

      xor  EAX, EAX
      LodSB //Blue
      shr  EAX, 2
      shl  EAX, 12
      Add  EDX, EAX

      LodSB  //Ignore the mask

      //Get the index number
      mov  al, [EBX+EDX]

      StoSB //Put the result into the 8bit bitmap

      dec  ECX
      Jnz  @XLoop

      Sub  ESI, SourceModulo
      Sub  EDI, DestModulo

      pop  ECX
      dec  ECX
      jnz  @YLoop

  @TheEnd:
      pop  EBX
      pop  EDI
      pop  ESI
  end;

  SetDIBitsToDevice(DestDC, X, Y, aWidth, aHeight, 0, 0, 0, aHeight,
    Data, BitInfo^, DIB_RGB_COLORS);
  //  bitblt(destdc,x,y,awidth,aheight,dc,0,0,rop);
  SelectObject(DC, OldBitmap);
  DeleteObject(Bitmap);
  DeleteDC(DC);
  FreeMem(BitInfo);
end;

//MakeRGN and MakeRGNFromColor are almost identical.  A b

⌨️ 快捷键说明

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