tepixelt.pas

delphi2007界面效果控件源码

  LastColAdjust := (Box - (Width mod Box)) * 12;
  BGR           := PDWordArray(PChar(BGR) + ((Box - 1) * 12));

  while WIndex < RowsLimit do // Whole bitmap
  begin
    while WIndex < RowsLimit do // Rows which are complete
    begin
      BGR       := PDWordArray(PChar(BGR) + NextRowOffset);
      RowLimit  := WIndex + PixelsBytes;
      ColsLimit := WIndex + ColsLenght;
      while WIndex < ColsLimit do // Columns which are complete
      begin
        if NotFirst
        then
        begin
          BValue :=
            (
              BGR[0]                +
              BGR[-ColLenght - aux] -
              BGR[-aux]             -
              BGR[-ColLenght]
            ) div BoxPixels;
          BGR := PDWordArray(PChar(BGR) + 4);
          GValue :=
            (
              BGR[0]                +
              BGR[-ColLenght - aux] -
              BGR[-aux]             -
              BGR[-ColLenght]
            ) div BoxPixels;
          BGR := PDWordArray(PChar(BGR) + 4);
          RValue :=
            (
              BGR[0]                +
              BGR[-ColLenght - aux] -
              BGR[-aux]             -
              BGR[-ColLenght]
            ) div BoxPixels;
          BGR := PDWordArray(PChar(BGR) + NextColOffset - 8);
        end
        else
        begin
          if FirstRow
          then
          begin
            if FirstCol
            then
            begin
              BValue := BGR[0] div BoxPixels;
              GValue := BGR[1] div BoxPixels;
              RValue := BGR[2] div BoxPixels;
              BGR := PDWordArray(PChar(BGR) + NextColOffset);
              FirstCol := False;
            end
            else
            begin
              BValue :=
                (
                  BGR[0] -
                  BGR[-ColLenght]
                ) div BoxPixels;
              GValue :=
                (
                  BGR[1] -
                  BGR[1-ColLenght]
                ) div BoxPixels;
              RValue :=
                (
                  BGR[2] -
                  BGR[2-ColLenght]
                ) div BoxPixels;
              BGR := PDWordArray(PChar(BGR) + NextColOffset);
            end;
          end
          else
          begin
            FirstCol := False;
            NotFirst := True;
            BValue :=
              (
                BGR[0] -
                BGR[-aux]
              ) div BoxPixels;
            GValue :=
              (
                BGR[1] -
                BGR[1-aux]
              ) div BoxPixels;
            RValue :=
              (
                BGR[2] -
                BGR[2-aux]
              ) div BoxPixels;
            BGR := PDWordArray(PChar(BGR) + NextColOffset);
          end;
        end;
        ColLimit := WIndex + ColLenght;
        while WIndex < ColLimit do // Column
        begin
          Work[WIndex  ] := BValue;
          Work[WIndex+1] := GValue;
          Work[WIndex+2] := RValue;
          Inc(WIndex, 3);
        end;
      end;
      if WIndex < RowLimit then
      begin // Last column (incomplete)
        BGR := PDWordArray(PChar(BGR) - LastColAdjust);
        if FirstRow
        then
        begin
          BValue :=
            (
              BGR[0] -
              BGR[-ColLenght]
            ) div BoxPixels;
          GValue :=
            (
              BGR[1] -
              BGR[1-ColLenght]
            ) div BoxPixels;
          RValue :=
            (
              BGR[2] -
              BGR[2-ColLenght]
            ) div BoxPixels;
          BGR := PDWordArray(PChar(BGR) + NextColOffset);
        end
        else
        begin
          BValue :=
            (
              BGR[0]                +
              BGR[-ColLenght - aux] -
              BGR[-aux]             -
              BGR[-ColLenght]
            ) div BoxPixels;
          BGR := PDWordArray(PChar(BGR) + 4);
          GValue :=
            (
              BGR[0]                +
              BGR[-ColLenght - aux] -
              BGR[-aux]             -
              BGR[-ColLenght]
            ) div BoxPixels;
          BGR := PDWordArray(PChar(BGR) + 4);
          RValue :=
            (
              BGR[0]                +
              BGR[-ColLenght - aux] -
              BGR[-aux]             -
              BGR[-ColLenght]
            ) div BoxPixels;
          BGR := PDWordArray(PChar(BGR) + NextColOffset - 8);
        end;
        while WIndex < RowLimit do
        begin
          Work[WIndex  ] := BValue;
          Work[WIndex+1] := GValue;
          Work[WIndex+2] := RValue;
          Inc(WIndex, 3);
        end;
      end;
      Inc(WIndex, RowGap);
      BoxLimit := WIndex + (ScanLineSize * CopyRows);
      while WIndex < BoxLimit do // The other rows in the box
      begin
        Move(Work[WIndex-ScanLineSize], Work[WIndex], ScanLineSize);
        Inc(WIndex, ScanLineSize);
      end;
      FirstCol := True;
      FirstRow := False;
      NotFirst := False;
    end;

    BytesToEnd := (ScanLineSize * Height) - RowsLimit;
    if BytesToEnd > 0 then
    begin
      Inc(RowsLimit, BytesToEnd);
      Dec(CopyRows, Box - (Height mod Box));
      BGR := PDWordArray(PChar(BGR) - (Width * 12 * (Box - (Height mod Box))));
    end;
  end;
end;

procedure TPixelateTransition.Paint2x2Pixelate(Work: PByteArray;
  ScanLineSize, RowGap, Width, Height: Integer; BGR: PDWordArray);
var
  WIndex,
  aux,
  ColsLenght,
  RowsLimit,
  PixelsBytes,
  ColsLimit,
  RowLimit,
  LastColAdjust,
  NextRowOffset: Integer;
  BValue,
  GValue,
  RValue: Byte;
  NotFirst,
  FirstCol,
  FirstRow: Boolean;
begin
  BValue        := 0;
  GValue        := 0;
  RValue        := 0;
  NotFirst      := False;
  FirstRow      := True;
  FirstCol      := True;
  WIndex        := 0;
  ColsLenght    := 6 * (Width shr 1);
  RowsLimit     := ScanLineSize * (Height shr 1) shl 1;
  PixelsBytes   := Width * 3;
  aux           := PixelsBytes shl 1;
  NextRowOffset := aux shl 1;
  LastColAdjust := (2 - (Width mod 2)) * 12;
  BGR           := PDWordArray(PChar(BGR) - 12);

  while WIndex < RowsLimit do // Rows which are complete
  begin
    BGR       := PDWordArray(PChar(BGR) + NextRowOffset);
    RowLimit  := WIndex + PixelsBytes;
    ColsLimit := WIndex + ColsLenght;
    while WIndex < ColsLimit do // Columns which are complete
    begin
      if NotFirst
      then
      begin
        BValue :=
          (
            BGR[6]     +
            BGR[-aux]  -
            BGR[6-aux] -
            BGR[0]
          ) shr 2;
        BGR := PDWordArray(PChar(BGR) + 4);
        GValue :=
          (
            BGR[6]     +
            BGR[-aux]  -
            BGR[6-aux] -
            BGR[0]
          ) shr 2;
        BGR := PDWordArray(PChar(BGR) + 4);
        RValue :=
          (
            BGR[6]     +
            BGR[-aux]  -
            BGR[6-aux] -
            BGR[0]
          ) shr 2;
        BGR := PDWordArray(PChar(BGR) + 16);
      end
      else
      begin
        if FirstRow
        then
        begin
          if FirstCol
          then
          begin
            BValue := BGR[6] shr 2;
            GValue := BGR[7] shr 2;
            RValue := BGR[8] shr 2;
            BGR := PDWordArray(PChar(BGR) + 24);
            FirstCol := False;
          end
          else
          begin
            BValue :=
              (
                BGR[6] -
                BGR[0]
              ) shr 2;
            GValue :=
              (
                BGR[7] -
                BGR[1]
              ) shr 2;
            RValue :=
              (
                BGR[8] -
                BGR[2]
              ) shr 2;
            BGR := PDWordArray(PChar(BGR) + 24);
          end;
        end
        else
        begin
          FirstCol := False;
          NotFirst := True;
          BValue :=
            (
              BGR[6] -
              BGR[6-aux]
            ) shr 2;
          GValue :=
            (
              BGR[7] -
              BGR[7-aux]
            ) shr 2;
          RValue :=
            (
              BGR[8] -
              BGR[8-aux]
            ) shr 2;
          BGR := PDWordArray(PChar(BGR) + 24);
        end;
      end;
      Work[WIndex  ] := BValue;
      Work[WIndex+3] := BValue;
      Work[WIndex+1] := GValue;
      Work[WIndex+4] := GValue;
      Work[WIndex+2] := RValue;
      Work[WIndex+5] := RValue;
      Inc(WIndex, 6);
    end;
    if WIndex < RowLimit then
    begin // Last column (incomplete)
      BGR := PDWordArray(PChar(BGR) - LastColAdjust + 24);
      Work[WIndex  ] := BValue;
      Work[WIndex+1] := GValue;
      Work[WIndex+2] := RValue;
      Inc(WIndex, 3);
    end;
    Inc(WIndex, RowGap);
    Move(Work[WIndex-ScanLineSize], Work[WIndex], ScanLineSize);
    Inc(WIndex, ScanLineSize);
    FirstCol := True;
    FirstRow := False;
    NotFirst := False;
  end;

  if(ScanLineSize * Height) > RowsLimit then
    Move(Work[WIndex-ScanLineSize], Work[WIndex], ScanLineSize);
end;

destructor TPixelateData.Destroy;
begin
  FreeMem(BGRImg);

  inherited;
end;

initialization

  TERegisterTransition(TPixelateTransition);
  RegisterClasses([TPixelateTransition]);

end.