jvqdrawimage.pas

East make Tray Icon in delphi

var
  p, p0, p1: pbytearray;
  dx, X, Y, w, h, i, j, sum, c: Integer;
  cm, tm: TBitmap;
  Rs, Rd: TRect;
begin
  X := center.X;
  Y := center.Y;
  w := bm.Width;
  h := bm.Height;
  cm := TBitmap.Create;
  cm.Width := 2 * Radius;
  cm.Height := 2 * Radius;
  cm.PixelFormat := pf24bit;
  tm := TBitmap.Create;
  tm.Width := 2 * Radius;
  tm.Height := 2 * Radius;
  tm.PixelFormat := pf24bit;
  tm.Canvas.Brush.Color := clBlack;
  tm.Canvas.Ellipse(0, 0, tm.Width - 1, tm.Height - 1);
  tm.Transparent := True;
  tm.TransparentColor := clBlack;
  Rd := Rect(0, 0, cm.Width, cm.Height);
  Rs := Rect(X - Radius, Y - Radius, X + Radius, Y + Radius);
  cm.Canvas.CopyRect(Rd, bm.Canvas, RS);
  p0 := nil;
  p1 := nil;
  for j := 0 to cm.Height - 1 do
  begin
    p := cm.ScanLine[j];
    if j > 0 then
      p0 := cm.ScanLine[j - 1];
    if j < (h - 1) then
      p1 := cm.ScanLine[j + 1];
    for i := 0 to cm.Width - 1 do
    begin
      case Mode of
        0: //Blue
          begin
            p[i * 3 + 1] := 0;
            p[i * 3 + 2] := 0;
          end;
        1: //Green
          begin
            p[i * 3] := 0;
            p[i * 3 + 2] := 0;
          end;
        2: //Red
          begin
            p[i * 3] := 0;
            p[i * 3 + 1] := 0;
          end;
        3: //not Blue
          begin
            p[i * 3] := 0;
          end;
        4: //not Green
          begin
            p[i * 3 + 1] := 0;
          end;
        5: //not Red
          begin
            p[i * 3 + 2] := 0;
          end;
        6: //half Blue
          begin
            p[i * 3] := p[i * 3] * 9 div 10;
          end;
        7: //half Green
          begin
            p[i * 3 + 1] := p[i * 3 + 1] * 9 div 10;
          end;
        8: //half Red
          begin
            p[i * 3 + 2] := p[i * 3 + 2] * 9 div 10;
          end;
        9: // darker
          begin
            p[i * 3] := Round(p[i * 3] * 10 / 11);
            p[i * 3 + 1] := Round(p[i * 3 + 1] * 10 / 11);
            p[i * 3 + 2] := Round(p[i * 3 + 2] * 10 / 11);
          end;
        10: // lighter
          begin
            p[i * 3] := Round(p[i * 3] * 11 / 10);
            p[i * 3 + 1] := Round(p[i * 3 + 1] * 11 / 10);
            p[i * 3 + 2] := Round(p[i * 3 + 2] * 11 / 10);
          end;
        11: // gray
          begin
            sum := Round((p[i * 3] + p[i * 3 + 1] + p[i * 3 + 2]) / 3);
            p[i * 3] := sum;
            p[i * 3 + 1] := sum;
            p[i * 3 + 2] := sum;
          end;
        12: // mix
          begin
            c := p[i * 3];
            p[i * 3] := p[i * 3 + 1];
            p[i * 3 + 1] := p[i * 3 + 2];
            p[i * 3 + 2] := c;
          end;
        13: //Smooth
          begin
            if ((j > 0) and (j < (h - 1)) and (i > 0) and (i < (w - 1))) then
            begin
              p[i * 3] := Round((p[(i - 1) * 3] + p[(i + 1) * 3] + p0[i * 3] + p1[i * 3]) / 4);
              p[i * 3 + 1] := Round((p[(i - 1) * 3 + 1] + p[(i + 1) * 3 + 1] + p0[i * 3 + 1] + p1[i * 3 + 1]) / 4);
              p[i * 3 + 2] := Round((p[(i - 1) * 3 + 2] + p[(i + 1) * 3 + 2] + p0[i * 3 + 2] + p1[i * 3 + 2]) / 4);
            end;
          end;
      end;
    end;
  end;
  cm.Canvas.Draw(0, 0, tm);
  cm.Transparent := True;
  cm.transparentcolor := clWhite;
  bm.Canvas.Draw(X - Radius, Y - Radius, cm);
  cm.Free;
  tm.Free;
end;

procedure TJvDrawImage.DrawColorCircle(X, Y, Mode: Integer);
var
  r: Integer;
begin
  Picture.Bitmap.pixelformat := pf24bit;
  Clip.Assign(Picture.Bitmap);
  Clip.PixelFormat := pf24bit;
  r := Canvas.Pen.Width;
  if r < 5 then
    r := 5;
  ColorCircle(Clip, Point(X, Y), r, Mode);
  Picture.Bitmap.Assign(Clip);
end;

procedure TJvDrawImage.DrawLightBrush(X, Y, Radius, Amount: Integer; Style: TLightBrush);
var
  Src, Dst: TBitmap;
  Rclip, Rsrc: TRect;
begin
  if X < Radius then
    X := Radius;
  if Y < Radius then
    Y := Radius;
  if (X + Radius) > Clip.Width - 1 then
    X := Clip.Width - 1 - Radius;
  if (Y + Radius) > Clip.Height - 1 then
    Y := Clip.Height - 1 - Radius;
  Src := TBitmap.Create;
  Src.PixelFormat := pf24bit;
  Dst := TBitmap.Create;
  Dst.PixelFormat := pf24bit;
  Rclip := Rect(X - Radius, Y - Radius, X + Radius, Y + Radius);
  Src.Width := Rclip.Right - Rclip.Left;
  Src.Height := RClip.Bottom - Rclip.Top;
  Dst.Width := Src.Width;
  Dst.Height := Src.Height;
  Rsrc := Rect(0, 0, Src.Width, Src.Height);
  Dst.Canvas.CopyRect(Rsrc, Clip.Canvas, Rclip);
  case Style of
    lbBrightness: FX.lightness(Dst, Amount);
    lbSaturation: FX.saturation(Dst, Amount);
    lbContrast: FX.contrast(Dst, Amount);
  end;
  // mask code
  Src.Canvas.Brush.Color := clWhite;
  Src.Canvas.FillRect(Rsrc);
  Src.Canvas.Brush.Style := bssolid;
  Src.Canvas.Brush.Color := clBlack;
  Src.Canvas.Ellipse(0, 0, Src.Width - 1, Src.Height - 1);
  Src.Transparent := True;
  Src.TransparentColor := clBlack;
  Dst.Canvas.Draw(0, 0, Src);
  Dst.Transparent := True;
  Dst.TransparentColor := clWhite;
  Canvas.Draw(0, 0, Clip);
  Canvas.Draw(X - Radius, Y - Radius, Dst);
  Src.Free;
  Dst.Free;
end;

procedure TJvDrawImage.SampleStretch(Src, Dst: TBitmap);
begin
  // use mitchelfilter from resample unit
  ImgStretch(Src, Dst,
    ResampleFilters[6].Filter, ResampleFilters[6].Width);
end;

procedure TJvDrawImage.DrawStretchBrush(X, Y, Radius: Integer; Amount: Extended; Style: TMorphBrush);
var
  Src, Dst: TBitmap;
  Rclip, Rsrc: TRect;
  dr: Integer;
begin
  if X < Radius then
    X := Radius;
  if Y < Radius then
    Y := Radius;
  if (X + Radius) > Clip.Width - 1 then
    X := Clip.Width - 1 - Radius;
  if (Y + Radius) > Clip.Height - 1 then
    Y := Clip.Height - 1 - Radius;
  Src := TBitmap.Create;
  Src.PixelFormat := pf24bit;
  Dst := TBitmap.Create;
  Dst.PixelFormat := pf24bit;
  Rclip := Rect(X - Radius, Y - Radius, X + Radius, Y + Radius);
  Dst.Width := Rclip.Right - Rclip.Left;
  Dst.Height := RClip.Bottom - Rclip.Top;
  // now Change to Reduce
  Amount := Abs(Amount);
  if Amount < 1 then
    Amount := 1;
  dr := Round(Radius * Amount / 180);
  if dr < 5 then
    dr := 5;
  if dr > Radius then
    dr := Radius;
  //(mbVerBox,mbHorBox,mbVerOval,mbHorOval);
  case Style of
    mbVerOval, mbVerbox: Rclip := Rect(X - Radius, Y - dr, X + Radius, Y + dr);
    mbHorOval, mbHorBox: Rclip := Rect(X - dr, Y - Radius, X + dr, Y + Radius);
  end;
  Src.Width := Rclip.Right - Rclip.Left;
  Src.Height := RClip.Bottom - Rclip.Top;
  Rsrc := Rect(0, 0, Src.Width, Src.Height);
  Src.Canvas.CopyRect(Rsrc, Clip.Canvas, Rclip);
  SampleStretch(Src, Dst);
  // mask code
  // reset Src dimensions for masking
  if Style in [mbHorOval, mbVerOval] then
  begin
    Src.Width := Dst.Width;
    Src.Height := Dst.Height;
    Src.Canvas.Brush.Color := clWhite;
    Src.Canvas.FillRect(Rsrc);
    Src.Canvas.Brush.Style := bssolid;
    Src.Canvas.Brush.Color := clBlack;
    Src.Canvas.Ellipse(0, 0, Src.Width - 1, Src.Height - 1);
    Src.Transparent := True;
    Src.TransparentColor := clBlack;
    Dst.Canvas.Draw(0, 0, Src);
    Dst.Transparent := True;
    Dst.TransparentColor := clWhite;
    Canvas.Draw(0, 0, Clip);
  end;
  Canvas.Draw(X - Radius, Y - Radius, Dst);
  Src.Free;
  Dst.Free;
end;

procedure TJvDrawImage.Rimple(Src, Dst: TBitmap; Amount: Extended);
var
  ca, sa, a, dx, dy, r, sr, fr: Extended;
  w, h, X, Y, cx, cy, i, j, c, ci: Integer;
  p1, p2: pbytearray;
begin
  w := Src.Width;
  h := Src.Height;
  cx := w div 2;
  cy := h div 2;
  if Amount < 1 then
    Amount := 1;
  fr := cx / Amount;
  for Y := 0 to h - 1 do
  begin
    p1 := Src.ScanLine[Y];
    for X := 0 to w - 1 do
    begin
      dx := X - cx;
      dy := -(Y - cx);
      r := Sqrt(Sqr(dx) + Sqr(dy));
      sr := fr * Sin(r / cx * Amount * 2 * pi);
      if (r + sr < cx) and (r + sr > 0) then
      begin
        a := ArcTan2(dy, dx);
        sincos(a, sa, ca);
        i := cx + Round((r + sr) * ca);
        j := cy + Round((r + sr) * sa);
        p2 := Dst.ScanLine[j];
        c := X * 3;
        ci := i * 3;
        p2[ci] := p1[c];
        p2[ci + 1] := p1[c + 1];
        p2[ci + 2] := p1[c + 2];
      end;
    end;
  end;
end;

procedure TJvDrawImage.DrawEffectBrush(X, Y, Radius: Integer; Amount: Extended; Style: TLightBrush);
var
  Src, Dst: TBitmap;
  Rclip, Rsrc: TRect;
begin
  if X < Radius then
    X := Radius;
  if Y < Radius then
    Y := Radius;
  if (X + Radius) > Clip.Width - 1 then
    X := Clip.Width - 1 - Radius;
  if (Y + Radius) > Clip.Height - 1 then
    Y := Clip.Height - 1 - Radius;
  Src := TBitmap.Create;
  Src.PixelFormat := pf24bit;
  Dst := TBitmap.Create;
  Dst.PixelFormat := pf24bit;
  Rclip := Rect(X - Radius, Y - Radius, X + Radius, Y + Radius);
  Src.Width := Rclip.Right - Rclip.Left;
  Src.Height := RClip.Bottom - Rclip.Top;
  Dst.Width := Src.Width;
  Dst.Height := Src.Height;
  Rsrc := Rect(0, 0, Src.Width, Src.Height);
  Src.Canvas.CopyRect(Rsrc, Clip.Canvas, Rclip);
  case Style of
    lbfisheye: FX.fisheye(Src, Dst, Amount);
    lbrotate: FX.smoothrotate(Src, Dst, Src.Width div 2, Src.Height div 2, Amount);
    lbtwist: FX.twist(Src, Dst, Round(Amount));
    lbrimple: Rimple(Src, Dst, Amount);
    mbHor, mbTop, mbBottom, mbDiamond, mbWaste, mbRound, mbRound2:
      FX.SqueezeHor(Src, Dst, Round(Amount), Style);
    mbSplitRound, mbSplitWaste:
      FX.SplitRound(Src, Dst, Round(Amount), Style);
  end;
  // mask code
  Src.Canvas.Brush.Color := clWhite;
  Src.Canvas.FillRect(Rsrc);
  Src.Canvas.Brush.Style := bssolid;
  Src.Canvas.Brush.Color := clBlack;
  Src.Canvas.Ellipse(0, 0, Src.Width - 1, Src.Height - 1);
  Src.Transparent := True;
  Src.TransparentColor := clBlack;
  Dst.Canvas.Draw(0, 0, Src);
  Dst.Transparent := True;
  Dst.TransparentColor := clWhite;
  Canvas.Draw(0, 0, Clip);
  Canvas.Draw(X - Radius, Y - Radius, Dst);
  Src.Free;
  Dst.Free;
end;

procedure TJvDrawImage.DrawPlasma(X, Y: Integer; Amount: Extended);
var
  Src: TBitmap;
  Rs: TRect;
  h, w, ra: Integer;
begin
  Src := TBitmap.Create;
  ra := Round(Amount);
  zoomrect := Rect(X - ra, Y - ra, X + ra, Y + ra);
  if zoomrect.Left < 0 then
    zoomrect.Left := 0;
  if zoomrect.Top < 0 then
    zoomrect.Top := 0;
  if zoomrect.Right > (FZoomClip.Width - 1) then
    zoomrect.Right := FZoomClip.Width - 1;
  if zoomrect.Bottom > (FZoomClip.Height - 1) then
    zoomrect.Bottom := FZoomClip.Height - 1;
  w := zoomrect.Right - zoomrect.Left + 1;
  h := zoomrect.Bottom - zoomrect.Top + 1;
  Src.Width := w;
  Src.Height := h;
  Src.PixelFormat := pf24bit;
  Rs := Rect(0, 0, w, h);
  Src.Canvas.CopyRect(Rs, FZoomClip.Canvas, zoomrect);
  Canvas.stretchDraw(Rect(0, 0, FZoomClip.Width, FZoomClip.Height), Src);
  Src.Free;
end;

function TJvDrawImage.Rotate(Origin, Endpoint: TPoint; Angle: Real): TPoint;
var
  a, d, r: Real;
begin
  r := Sqrt(Sqr(Endpoint.X - Origin.X) + Sqr(Endpoint.Y - Origin.Y));
  d := Endpoint.X - Origin.X;
  if (d >= 0) and (d < 0.001) then
    d := 0.001;
  if (d < 0) and (d > -0.001) then
    d := -0.001;
  a := ArcTan2((Endpoint.Y - Origin.Y), d);
  a := a + Angle;
  Result.X := Origin.X + Variant(r * Cos(a));
  Result.Y := Origin.Y + Variant(r * Sin(a));
end;

procedure TJvDrawImage.SetSyms(X, Y: Integer);
var
  X0, Y0, i: Integer;
  da: Real;
  apoint: TPoint;
begin
  X0 := Picture.Bitmap.Width div 2;
  Y0 := Picture.Bitmap.Height div 2;
  da := 2 * pi / StarPoints;
  apoint := Point(X, Y);
  pointarray[0] := apoint;
  for i := 1 to StarPoints - 1 do
  begin
    apoint := Rotate(Point(X0, Y0), apoint, da);
    pointarray[i] := apoint;
  end;
end;

function TJvDrawImage.GetBlue(AColor: TColor): Byte;
begin
  Result := GetBValue(ColorToRGB(AColor));
end;

function TJvDrawImage.GetGreen(AColor: TColor): Byte;
begin
  Result := GetGValue(ColorToRGB(AColor));
end;

function TJvDrawImage.GetRed(AColor: TColor): Byte;
begin
  Result := GetRValue(ColorToRGB(AColor));
end;

function TJvDrawImage.MixColors(Color1, Color2: TColor): TColor;
var
  R1, G1, B1: Byte;
begin
  Color1 := ColorToRGB(Color1);
  Color2 := ColorToRGB(Color2);
  R1 := (GetRed(Color1) + GetRed(Color2)) div 2;
  G1 := (GetGreen(Color1) + GetGreen(Color2)) div 2;
  B1 := (GetBlue(Color1) + GetBlue(Color2)) div 2;
  Result := rgb(R1, G1, B1);
end;

procedure TJvDrawImage.InitPlasma;
var
  w, h: Integer;
begin
  with Picture.Bitmap do
  begin
    w := Width;
    h := Height;
    FZoomClip.Width := w;
    FZoomClip.Height := h;
  end;
  FZoomClip.PixelFormat := pf24bit;
  FZoomClip.Canvas.Draw(0, 0, Picture.Bitmap);
end;

procedure TJvDrawImage.CopyClip;
var
  m, dest: TRect;
begin
  m := mycliprect;
  Clip.Width := m.Right - m.Left + 1;
  Clip.Height := m.Bottom - m.Top + 1;
  dest := Rect(0, 0, Clip.Width, Clip.Height);
  Clip.Canvas.CopyMode := clipcm;
  Clip.Canvas.CopyRect(dest, Canvas, m);
  Clip.pixelformat := pf24bit;
end;

procedure TJvDrawImage.ClipAll;
begin
  mycliprect := Rect(0, 0, Picture.Bitmap.Width - 1, Picture.Bitmap.Height - 1);
  clipcm := cmsrccopy;
  SetClip(clWhite);
  CopyClip;
end;

procedure TJvDrawImage.SetClip(AColor: TColor);
var
  m, dest: TRect;
begin
  m := mycliprect;
  Clip.Width := (m.Right - m.Left) + 1;
  Clip.Height := (m.Bottom - m.Top) + 1;
  dest := Rect(0, 0, Clip.