lbmorphbmp.pas

天涯進銷存系統

  end;
  FreeMem(Line,Width*3);
end;

procedure TEffectBmp.AddMiddleColorInRect(Color: TColor; Rct: TRect);
var
  x,y,r,g,b: Integer;
  Line: PLine;
  _r, _g, _b: byte;
begin
  GetMem(Line,Width*3);
  _r := GetRValue(ColorToRGB(Color));
  _g := GetGValue(ColorToRGB(Color));
  _b := GetBValue(ColorToRGB(Color));
  for y := Rct.Top to Rct.Bottom do
  begin
    GetScanLine(y,Line);
    for x := Rct.Left to Rct.Right do
    begin
      r:=(Line^[x].r + _r) div 2;
      g:=(Line^[x].g + _g) div 2;
      b:=(Line^[x].b + _b) div 2;
      if r > 255 then r := 255 else if r < 0 then r := 0;
      if g > 255 then g := 255 else if g < 0 then g := 0;
      if b > 255 then b := 255 else if b < 0 then b := 0;
      Line^[x].r := r;
      Line^[x].g := g;
      Line^[x].b := b;
    end;
    ScanLines[y] := Line;
  end;
  FreeMem(Line,Width*3);
end;

procedure TEffectBmp.SplitBlur(Amount:Integer);
var
  Lin, Lin1, Lin2: PLine;
  cx, x,y: Integer;
  Buf: array[0..3]of TFColor;
  Tmp: TFColor;
begin
  if Amount = 0 then Exit;
  for y := 0 to Height-1 do
  begin
    Lin := ScanLines[y];

    if y - Amount < 0
    then
      Lin1:=ScanLines[y]
    else
      Lin1:=ScanLines[y-Amount];

    if y + Amount < Height
    then
      Lin2:=ScanLines[y+Amount]
    else
      Lin2:=ScanLines[Height-y];

    for x := 0 to Width-1 do
    begin
      if x - Amount<0
      then
        cx := x
      else
        cx := x-Amount;

      Buf[0] := Lin1^[cx];
      Buf[1] := Lin2^[cx];
      if x + Amount < Width
      then
        cx := x + Amount
      else
        cx:=Width-x;

      Buf[2]:= Lin1^[cx];
      Buf[3] := Lin2^[cx];
      Tmp.r := (Buf[0].r+Buf[1].r+Buf[2].r+Buf[3].r)div 4;
      Tmp.g := (Buf[0].g+Buf[1].g+Buf[2].g+Buf[3].g)div 4;
      Tmp.b := (Buf[0].b+Buf[1].b+Buf[2].b+Buf[3].b)div 4;
      Lin^[x] := Tmp;
    end;
  end;
end;

procedure TEffectBmp.Blur(Amount: integer);
 function MiddleColor(color1, color2: TColor): TColor;
 var
   R, C1, C2: TFColor;
 begin
   move(color1, C1, 3);
   move(color2, C2, 3);
   R.r := (C1.r + C2.r) div 2;
   R.g := (C1.g + C2.g) div 2;
   R.b := (C1.b + C2.b) div 2;
   result := 0;
   move(R, result, 3);
 end;
var
  col, row: integer;
  CelCol, CelRow: Integer;
  NewColor: TColor;
begin
  for row := 0 to Height - 1 do
  begin
    for Col := 0 to Width - 1 do
    begin
      NewColor := pixels[col,row];
      for CelCol := -Amount to Amount do
          For CelRow := -Amount to Amount do
          begin
            if (Col + CelCol < 0) or (Col + CelCol > Width-1) or
               (Row + CelRow < 0) or (Row + CelRow > Height-1) then Continue;
            NewColor := MiddleColor(NewColor,
                     Pixels[col + Celcol, row + Celrow]);
          end;
      pixels[col,row] := NewColor;
    end;
  end;
end;

procedure TEffectBmp.Wave(XDIV,YDIV,RatioVal:Integer);
var
  Tmp: TEffectBmp;
  i,j,
  XSrc, YSrc: Integer;
begin
  Tmp := TEffectBmp.CreateCopy(Self);
  for i := 0 to Width-1 do
  for j := 0 to Height-1 do
  begin
    if (YDiv=0)or(XDiv=0) then Exit;
    XSrc := Round(i+RatioVal*Sin(j/YDiv));
    YSrc := Round(j+RatioVal*Sin(i/XDiv));
    if XSrc<0 then XSrc:=0 else if XSrc>=Tmp.Width then XSrc:=Tmp.Width-1;
    if YSrc<0 then YSrc:=0 else if YSrc>=Tmp.Height then YSrc:=Tmp.Height-1;
    Pixels[i,j] := Tmp.Pixels[XSrc,YSrc];
  end;
  Tmp.Free;
end;

procedure TEffectBmp.MaskSplitBlur(Msk: TEffectBmp; Amount:Integer);
var
  Lin, Lin1, Lin2, MskLine: PLine;
  cx, x,y: Integer;
  Buf: array[0..3]of TFColor;
  Tmp: TFColor;
begin
  if Amount = 0 then Exit;
  if (Width <> Msk.Width) or (Height > Msk.Height) then Exit;

  for y := 0 to Height-1 do
  begin
    Lin := ScanLines[y];

    if y - Amount < 0
    then
      Lin1:=ScanLines[y]
    else
      Lin1:=ScanLines[y-Amount];

    if y + Amount < Height
    then
      Lin2:=ScanLines[y+Amount]
    else
      Lin2:=ScanLines[Height-y];

    MskLine := Msk.ScanLines[y];

    for x := 0 to Width-1 do
    if (MskLine^[x].r = 0) and (MskLine^[x].g = 0)  and (MskLine^[x].b = 0)
    then
    begin
      if x - Amount<0
      then
        cx := x
      else
        cx := x-Amount;

      Buf[0] := Lin1^[cx];
      Buf[1] := Lin2^[cx];
      if x + Amount < Width
      then
        cx := x + Amount
      else
        cx:=Width-x;

      Buf[2]:= Lin1^[cx];
      Buf[3] := Lin2^[cx];
      Tmp.r := (Buf[0].r+Buf[1].r+Buf[2].r+Buf[3].r) div 4;
      Tmp.g := (Buf[0].g+Buf[1].g+Buf[2].g+Buf[3].g) div 4;
      Tmp.b := (Buf[0].b+Buf[1].b+Buf[2].b+Buf[3].b) div 4;
      Lin^[x] := Tmp;
    end;
  end;
end;

procedure TEffectBmp.MiddleBMP(EB:TEffectBmp);
var
  x,y: Integer;
  R, G, B: Byte;
  L1, L2: PLine;
begin
  if (EB.Width <> Width) or (EB.Height <> Height) then Exit;
  for y := 0 to Height - 1 do
  begin
    L1 := ScanLines[y];
    L2 := EB.ScanLines[y];
    for x := 0 to Width - 1 do
    begin
      R := (L1^[x].r + L2^[x].r) div 2;
      G := (L1^[x].g + L2^[x].g) div 2;
      B := (L1^[x].b + L2^[x].b) div 2;
      L1^[x].r := R;
      L1^[x].g := G;
      L1^[x].b := B;
    end;
  end;
end;

procedure TEffectBmp.AddGradColor(Color: TColor; Kind: TGradKind);
var
  x,y,r,g,b: Integer;
  Line: PLine;
  _r, _g, _b: byte;
  kf: Double;
  step: Double;
begin
  GetMem(Line,Width*3);
  _r := GetRValue(ColorToRGB(Color));
  _g := GetGValue(ColorToRGB(Color));
  _b := GetBValue(ColorToRGB(Color));
  case Kind of
    gdLeft:
       begin
         Step := 1 / (Width - 1);
         for y := 0 to Height-1 do
         begin
           GetScanLine(y,Line);
           kf := 0;
           for x := 0 to Width - 1 do
           begin
             r := Round(Line^[x].r * kf + _r * (1 - kf));
             g := Round(Line^[x].g * kf + _g * (1 - kf));
             b := Round(Line^[x].b * kf + _b * (1 - kf));
             if r > 255 then r := 255 else if r < 0 then r := 0;
             if g > 255 then g := 255 else if g < 0 then g := 0;
             if b > 255 then b := 255 else if b < 0 then b := 0;
             Line^[x].r := r;
             Line^[x].g := g;
             Line^[x].b := b;
             kf := kf + Step;
         end;
         ScanLines[y] := Line;
       end;
     end;
    gdRight:
       begin
         Step := 1 / (Width - 1);
         for y := 0 to Height-1 do
         begin
           GetScanLine(y,Line);
           kf := 0;
           for x := Width - 1 downto 0 do
           begin
             r := Round(Line^[x].r * kf + _r * (1 - kf));
             g := Round(Line^[x].g * kf + _g * (1 - kf));
             b := Round(Line^[x].b * kf + _b * (1 - kf));
             if r > 255 then r := 255 else if r < 0 then r := 0;
             if g > 255 then g := 255 else if g < 0 then g := 0;
             if b > 255 then b := 255 else if b < 0 then b := 0;
             Line^[x].r := r;
             Line^[x].g := g;
             Line^[x].b := b;
             kf := kf + Step;
          end;
          ScanLines[y] := Line;
        end;
      end;
    gdTop:
       begin
         Step := 1 / (Height - 1);
         kf := 0;
         for y := 0 to Height-1 do
         begin
           GetScanLine(y,Line);
           for x := 0 to Width - 1 do
           begin
             r := Round(Line^[x].r * kf + _r * (1 - kf));
             g := Round(Line^[x].g * kf + _g * (1 - kf));
             b := Round(Line^[x].b * kf + _b * (1 - kf));
             if r > 255 then r := 255 else if r < 0 then r := 0;
             if g > 255 then g := 255 else if g < 0 then g := 0;
             if b > 255 then b := 255 else if b < 0 then b := 0;
             Line^[x].r := r;
             Line^[x].g := g;
             Line^[x].b := b;
          end;
          ScanLines[y] := Line;
          kf := kf + Step;
        end;
     end;

    gdBottom:
       begin
         Step := 1 / (Height - 1);
         kf := 0;
         for y := Height - 1 downto 0 do
         begin
           GetScanLine(y,Line);
           for x := 0 to Width - 1 do
           begin
             r := Round(Line^[x].r * kf + _r * (1 - kf));
             g := Round(Line^[x].g * kf + _g * (1 - kf));
             b := Round(Line^[x].b * kf + _b * (1 - kf));
             if r > 255 then r := 255 else if r < 0 then r := 0;
             if g > 255 then g := 255 else if g < 0 then g := 0;
             if b > 255 then b := 255 else if b < 0 then b := 0;
             Line^[x].r := r;
             Line^[x].g := g;
             Line^[x].b := b;
          end;
          ScanLines[y] := Line;
          kf := kf + Step;
        end;
     end;

    gdHCenter:
       begin
         Step := 1 / ((Height - 1) div 2);
         kf := 0;
         for y := Height div 2 to height - 1 do
         begin
           GetScanLine(y,Line);
           for x := 0 to Width - 1 do
           begin
             r := Round(Line^[x].r * kf + _r * (1 - kf));
             g := Round(Line^[x].g * kf + _g * (1 - kf));
             b := Round(Line^[x].b * kf + _b * (1 - kf));
             if r > 255 then r := 255 else if r < 0 then r := 0;
             if g > 255 then g := 255 else if g < 0 then g := 0;
             if b > 255 then b := 255 else if b < 0 then b := 0;
             Line^[x].r := r;
             Line^[x].g := g;
             Line^[x].b := b;
          end;
          ScanLines[y] := Line;
          kf := kf + Step;
        end;
        kf := 0;
        for y := Height div 2 - 1 downto 0 do
         begin
           GetScanLine(y,Line);
           for x := 0 to Width - 1 do
           begin
             r := Round(Line^[x].r * kf + _r * (1 - kf));
             g := Round(Line^[x].g * kf + _g * (1 - kf));
             b := Round(Line^[x].b * kf + _b * (1 - kf));
             if r > 255 then r := 255 else if r < 0 then r := 0;
             if g > 255 then g := 255 else if g < 0 then g := 0;
             if b > 255 then b := 255 else if b < 0 then b := 0;
             Line^[x].r := r;
             Line^[x].g := g;
             Line^[x].b := b;
          end;
          ScanLines[y] := Line;
          kf := kf + Step;
        end;
     end;

    gdVCenter:
       begin
         Step := 1 / ((Width - 1) div 2);
         for y := 0 to Height - 1 do
         begin
           GetScanLine(y,Line);
           kf := 0;
           for x := Width div 2 downto 0 do
           begin
             r := Round(Line^[x].r * kf + _r * (1 - kf));
             g := Round(Line^[x].g * kf + _g * (1 - kf));
             b := Round(Line^[x].b * kf + _b * (1 - kf));
             if r > 255 then r := 255 else if r < 0 then r := 0;
             if g > 255 then g := 255 else if g < 0 then g := 0;
             if b > 255 then b := 255 else if b < 0 then b := 0;