dib.pas

传奇服务端Delphi7编译必需的全部第三方控件！！！！！

    Clear;
    Exit;
  end;

  TempImage := TDIBSharedImage.Create;
  try
    TempImage.NewImage(AWidth, AHeight, ABitCount,
      PixelFormat, ColorTable, FImage.FMemoryImage, False);
  except
    TempImage.Free;
    raise;
  end;
  SetImage(TempImage);

  PaletteModified := True;
end;

procedure TDIB.UpdatePalette;
var
  Col: TRGBQuads;
begin
  if CompareMem(@ColorTable, @FImage.FColorTable, SizeOf(ColorTable)) then Exit;

  Col := ColorTable;
  Changing(True);
  ColorTable := Col;
  FImage.SetColorTable(ColorTable);

  PaletteModified := True;
end;

procedure TDIB.ConvertBitCount(ABitCount: Integer);
var
  Temp: TDIB;

  procedure CreateHalftonePalette(R, G, B: Integer);
  var
    i: Integer;
  begin
    for i:=0 to 255 do
      with ColorTable[i] do
      begin
        rgbRed   := ((i shr (G+B-1)) and (1 shl R-1)) * 255 div (1 shl R-1);
        rgbGreen := ((i shr (B-1)) and (1 shl G-1)) * 255 div (1 shl G-1);
        rgbBlue  := ((i shr 0) and (1 shl B-1)) * 255 div (1 shl B-1);
      end;
  end;

  procedure PaletteToPalette_Inc;
  var
    x, y: Integer;
    i: DWORD;
    SrcP, DestP: Pointer;
    P: PByte;
  begin
    i := 0;

    for y:=0 to Height-1 do
    begin
      SrcP := Temp.ScanLine[y];
      DestP := ScanLine[y];

      for x:=0 to Width-1 do
      begin
        case Temp.BitCount of
          1 : begin
                i := (PArrayByte(SrcP)[X shr 3] and Mask1[X and 7]) shr Shift1[X and 7];
              end;
          4 : begin
                i := (PArrayByte(SrcP)[X and 1] and Mask4[X and 1]) shr Shift4[X and 1];
              end;
          8 : begin
                i := PByte(SrcP)^;
                Inc(PByte(SrcP));
              end;
        end;

        case BitCount of
          1 : begin
                P := @PArrayByte(DestP)[X shr 3];
                P^ := (P^ and Mask1n[X and 7]) or (i shl Shift1[X shr 3]);
              end;
          4 : begin
                P := @PArrayByte(DestP)[X shr 1];
                P^ := (P^ and Mask4n[X and 1]) or (i shl Shift4[X and 1]);
              end;
          8 : begin
                PByte(DestP)^ := i;
                Inc(PByte(DestP));
              end;
        end;
      end;
    end;
  end;

  procedure PaletteToRGB_or_RGBToRGB;
  var
    x, y: Integer;
    SrcP, DestP: Pointer;
    cR, cG, cB: Byte;
  begin
    cR := 0;
    cG := 0;
    cB := 0;

    for y:=0 to Height-1 do
    begin
      SrcP := Temp.ScanLine[y];
      DestP := ScanLine[y];

      for x:=0 to Width-1 do
      begin
        case Temp.BitCount of
          1 : begin
                with Temp.ColorTable[(PArrayByte(SrcP)[X shr 3] and Mask1[X and 7]) shr Shift1[X and 7]] do
                begin
                  cR := rgbRed;
                  cG := rgbGreen;
                  cB := rgbBlue;
                end;
              end;
          4 : begin
                with Temp.ColorTable[(PArrayByte(SrcP)[X shr 1] and Mask4[X and 1]) shr Shift4[X and 1]] do
                begin
                  cR := rgbRed;
                  cG := rgbGreen;
                  cB := rgbBlue;
                end;
              end;
          8 : begin
                with Temp.ColorTable[PByte(SrcP)^] do
                begin
                  cR := rgbRed;
                  cG := rgbGreen;
                  cB := rgbBlue;
                end;
                Inc(PByte(SrcP));
              end;
          16: begin
                pfGetRGB(Temp.NowPixelFormat, PWord(SrcP)^, cR, cG, cB);
                Inc(PWord(SrcP));
              end;
          24: begin
                with PBGR(SrcP)^ do
                begin
                  cR := R;
                  cG := G;
                  cB := B;
                end;

                Inc(PBGR(SrcP));
              end;
          32: begin
                pfGetRGB(Temp.NowPixelFormat, PDWORD(SrcP)^, cR, cG, cB);
                Inc(PDWORD(SrcP));
              end;
        end;

        case BitCount of
          16: begin
                PWord(DestP)^ := pfRGB(NowPixelFormat, cR, cG, cB);
                Inc(PWord(DestP));
              end;
          24: begin
                with PBGR(DestP)^ do
                begin
                  R := cR;
                  G := cG;
                  B := cB;
                end;
                Inc(PBGR(DestP));
              end;
          32: begin
                PDWORD(DestP)^ := pfRGB(NowPixelFormat, cR, cG, cB);
                Inc(PDWORD(DestP));
              end;
        end;
      end;
    end;
  end;

begin
  if Size=0 then exit;

  Temp := TDIB.Create;
  try
    Temp.Assign(Self);
    SetSize(Temp.Width, Temp.Height, ABitCount);

    if FImage=Temp.FImage then Exit;

    if (Temp.BitCount<=8) and (BitCount<=8) then
    begin
      {  The image is converted from the palette color image into the palette color image.  }
      if Temp.BitCount<=BitCount then
      begin
        PaletteToPalette_Inc;
      end else
      begin
        case BitCount of
          1: begin
               ColorTable[0] := RGBQuad(0, 0, 0);
               ColorTable[1] := RGBQuad(255, 255, 255);
             end;
          4: CreateHalftonePalette(1, 2, 1);
          8: CreateHalftonePalette(3, 3, 2);
        end;
        UpdatePalette;

        Canvas.Draw(0, 0, Temp);
      end;
    end else
    if (Temp.BitCount<=8) and (BitCount>8) then
    begin
      {  The image is converted from the palette color image into the rgb color image.  }
      PaletteToRGB_or_RGBToRGB;
    end else
    if (Temp.BitCount>8) and (BitCount<=8) then
    begin
      {  The image is converted from the rgb color image into the palette color image.  }
      case BitCount of
        1: begin
             ColorTable[0] := RGBQuad(0, 0, 0);
             ColorTable[1] := RGBQuad(255, 255, 255);
           end;
        4: CreateHalftonePalette(1, 2, 1);
        8: CreateHalftonePalette(3, 3, 2);
      end;
      UpdatePalette;

      Canvas.Draw(0, 0, Temp);
    end else
    if (Temp.BitCount>8) and (BitCount>8) then
    begin
      {  The image is converted from the rgb color image into the rgb color image.  }
      PaletteToRGB_or_RGBToRGB;
    end;
  finally
    Temp.Free;
  end;
end;

{  Special effect  }

procedure TDIB.StartProgress(const Name: string);
begin
  FProgressName := Name;
  FProgressOld := 0;
  FProgressOldTime := GetTickCount;
  FProgressY := 0;
  FProgressOldY := 0;
  Progress(Self, psStarting, 0, False, Rect(0, 0, Width, Height), FProgressName);
end;

procedure TDIB.EndProgress;
begin
  Progress(Self, psEnding, 100, True, Rect(0, FProgressOldY, Width, Height), FProgressName);
end;

procedure TDIB.UpdateProgress(PercentY: Integer);
var
  Redraw: Boolean;
  Percent: DWORD;
begin
  Redraw := (GetTickCount-FProgressOldTime>200) and (FProgressY-FProgressOldY>32) and
    (((Height div 3>Integer(FProgressY)) and (FProgressOldY=0)) or (FProgressOldY<>0));

  Percent := PercentY*100 div Height;

  if (Percent<>FProgressOld) or (Redraw) then
  begin
    Progress(Self, psRunning, Percent, Redraw,
      Rect(0, FProgressOldY, Width, FProgressY), FProgressName);
    if Redraw then
    begin
      FProgressOldY := FProgressY;
      FProgressOldTime := GetTickCount;
    end;

    FProgressOld := Percent;
  end;

  Inc(FProgressY);
end;

procedure TDIB.Blur(ABitCount: Integer; Radius: Integer);
type
  TAve = record
    cR, cG, cB: DWORD;
    c: DWORD;
  end;
  TArrayAve = array[0..0] of TAve;

var
  Temp: TDIB;

  procedure AddAverage(Y, XCount: Integer; var Ave: TArrayAve);
  var
    X: Integer;
    SrcP: Pointer;
    AveP: ^TAve;
    R, G, B: Byte;
  begin
    case Temp.BitCount of
      1 : begin
            SrcP := Pointer(Integer(Temp.TopPBits)+Y*Temp.NextLine);
            AveP := @Ave;
            for x:=0 to XCount-1 do
            begin
              with Temp.ColorTable[(PByte(Integer(SrcP)+X shr 3)^ and Mask1[x and 7]) shr Shift1[x and 7]], AveP^ do
              begin
                Inc(cR, rgbRed);
                Inc(cG, rgbGreen);
                Inc(cB, rgbBlue);
                Inc(c);
              end;
              Inc(AveP);
            end;
          end;
      4 : begin
            SrcP := Pointer(Integer(Temp.TopPBits)+Y*Temp.NextLine);
            AveP := @Ave;
            for x:=0 to XCount-1 do
            begin
              with Temp.ColorTable[(PByte(Integer(SrcP)+X shr 1)^ and Mask4[x and 1]) shr Shift4[x and 1]], AveP^ do
              begin
                Inc(cR, rgbRed);
                Inc(cG, rgbGreen);
                Inc(cB, rgbBlue);
                Inc(c);
              end;
              Inc(AveP);
            end;
          end;
      8 : begin
            SrcP := Pointer(Integer(Temp.TopPBits)+Y*Temp.NextLine);
            AveP := @Ave;
            for x:=0 to XCount-1 do
            begin
              with Temp.ColorTable[PByte(SrcP)^], AveP^ do
              begin
                Inc(cR, rgbRed);
                Inc(cG, rgbGreen);
                Inc(cB, rgbBlue);
                Inc(c);
              end;
              Inc(PByte(SrcP));
              Inc(AveP);
            end;
          end;
      16: begin
            SrcP := Pointer(Integer(Temp.TopPBits)+Y*Temp.NextLine);
            AveP := @Ave;
            for x:=0 to XCount-1 do
            begin
              pfGetRGB(Temp.NowPixelFormat, PWord(SrcP)^, R, G, B);
              with AveP^ do
              begin
                Inc(cR, R);
                Inc(cG, G);
                Inc(cB, B);
                Inc(c);
              end;
              Inc(PWord(SrcP));
              Inc(AveP);
            end;
          end;
      24: begin
            SrcP := Pointer(Integer(Temp.TopPBits)+Y*Temp.NextLine);
            AveP := @Ave;
            for x:=0 to XCount-1 do
            begin
              with PBGR(SrcP)^, AveP^ do
              begin
                Inc(cR, R);
                Inc(cG, G);
                Inc(cB, B);
                Inc(c);
              end;
              Inc(PBGR(SrcP));
              Inc(AveP);
            end;
          end;
      32: begin
            SrcP := Pointer(Integer(Temp.TopPBits)+Y*Temp.NextLine);
            AveP := @Ave;
            for x:=0 to XCount-1 do
            begin
              pfGetRGB(Temp.NowPixelFormat, PDWORD(SrcP)^, R, G, B);
              with AveP^ do
              begin
                Inc(cR, R);
                Inc(cG, G);
                Inc(cB, B);
                Inc(c);
              end;
              Inc(PDWORD(SrcP));
              Inc(AveP);
            end;
          end;
    end;
  end;

  procedure DeleteAverage(Y, XCount: Integer; var Ave: TArrayAve);
  var
    X: Integer;
    SrcP: Pointer;
    AveP: ^TAve;
    R, G, B: Byte;
  begin
    case Temp.BitCount of
      1 : begin
            SrcP := Pointer(Integer(Temp.TopPBits)+Y*Temp.NextLine);
            AveP := @Ave;
            for x:=0 to XCount-1 do
            begin
              with Temp.ColorTable[(PByte(Integer(SrcP)+X shr 3)^ and Mask1[x and 7]) shr Shift1[x and 7]], AveP^ do
              begin
                Dec(cR, rgbRed);
                Dec(cG, rgbGreen);
                Dec(cB, rgbBlue);
                Dec(c);
              end;
              Inc(AveP);
            end;
          end;
      4 : begin
            SrcP := Pointer(Integer(Temp.TopPBits)+Y*Temp.NextLine);
            AveP := @Ave;
            for x:=0 to XCount-1 do
            begin
              with Temp.ColorTable[(PByte(Integer(SrcP)+X shr 1)^ and Mask4[x and 1]) shr Shift4[x and 1]], AveP^ do
              begin
                Dec(cR, rgbRed);
                Dec(cG, rgbGreen);
                Dec(cB, rgbBlue);
                Dec(c);
              end;
              Inc(AveP);
            end;
          end;
      8 : begin
            SrcP := Pointer(Integer(Temp.TopPBits)+Y*Temp.NextLine);
            AveP := @Ave;
            for x:=0 to XCount-1 do
            begin
              with Temp.ColorTable[PByte(SrcP)^], AveP^ do
              begin
                Dec(cR, rgbRed);
                Dec(cG, rgbGreen);
                Dec(cB, rgbBlue);
                Dec(c);
              end;
              Inc(PByte(SrcP));
              Inc(AveP);
            end;
          end;
      16: begin
            SrcP := Pointer(Integer(Temp.TopPBits)+Y*Temp.NextLine);
            AveP := @Ave;
            for x:=0 to XCount-1 do
            begin
              pfGetRGB(Temp.NowPixelFormat, PWord(SrcP)^, R, G, B);
              with AveP^ do
              begin
                Dec(cR, R);
                Dec(cG, G);
                Dec(cB, B);
                Dec(c);
              end;
              Inc(PWord(SrcP));
              Inc(AveP);
            end;
          end;
      24: begin
            SrcP := Pointer(Integer(Temp.TopPBits)+Y*Temp.NextLine);
            AveP := @Ave;
            for x:=0 to XCount-1 do
            begin
              with PBGR(SrcP)^, AveP^ do
              begin
                Dec(cR, R);
                Dec(cG, G);
                Dec(cB, B);
                Dec(c);
              end;
              Inc(PBGR(SrcP));
              Inc(AveP);
            end;
          end;
      32: begin
            SrcP := Pointer(Integer(Te