jvqdrawimage.pas

East make Tray Icon in delphi

var
  R, R1, R2, G, G1, G2, B, B1, B2: Integer;
begin
  Opacity := Abs(Opacity);
  if Opacity > 100 then
    Opacity := 100;
  R1 := GetRValue(ColorToRGB(Color1));
  G1 := GetGValue(ColorToRGB(Color1));
  B1 := GetBValue(ColorToRGB(Color1));
  R2 := GetRValue(ColorToRGB(Color2));
  G2 := GetGValue(ColorToRGB(Color2));
  B2 := GetBValue(ColorToRGB(Color2));
  R := trunc(R1 * Opacity / 100) + trunc(R2 * (100 - Opacity) / 100);
  G := trunc(G1 * Opacity / 100) + trunc(G2 * (100 - Opacity) / 100);
  B := trunc(B1 * Opacity / 100) + trunc(B2 * (100 - Opacity) / 100);
  Result := RGB(R, G, B);
end; { BlendColors }

function TJvDrawImage.TexHighlight(Colr: Longint): Longint;
var
  avg, r, g, b: Integer;
  tmp: Longint;
begin
  r := GetRValue(Colr);
  g := GetGValue(Colr);
  b := GetBValue(Colr);
  avg := (r + g + b) div 3;
  r := (255 + 255 + avg + r) div 4;
  g := (255 + 255 + avg + g) div 4;
  b := (255 + 255 + avg + b) div 4;
  tmp := RGB(r, g, b);
  Result := BlendColors(Colr, tmp, WeakBlend);
end; { Highlight }

function TJvDrawImage.TexShadow(Colr: Longint): Longint;
var
  r, g, b: Integer;
  tmp: Longint;
begin
  r := GetRValue(Colr);
  g := GetGValue(Colr);
  b := GetBValue(Colr);
  tmp := RGB(trunc(DarkStrength * r), trunc(DarkStrength * g),
    trunc(DarkStrength * b));
  Result := BlendColors(Colr, tmp, StrongBlend);
end; { Shadow }

procedure TJvDrawImage.DrawTexLines(X0, Y0, X, Y: Integer);
var
  dx, dy, xr, yr, X1, Y1, X2, Y2, i, w, h, xi, yi: Integer;
  pcolor, hcolor, scolor: TColor;
begin
  w := Width;
  h := Height;
  pcolor := Canvas.Pen.Color;
  hcolor := Texhighlight(pcolor);
  scolor := TexShadow(pcolor);
  xr := Abs(Round(Sqrt(Sqr(X - X0) + Sqr(Y - Y0))));
  dx := Abs(X - X0);
  dy := Abs(Y - Y0);
  if dy = 0 then
    dy := 1;
  if dx = 0 then
    dx := 1;
//  tx := w div dx;
//  ty := h div dy;
  yr := Round(dy / dx * xr);
  yi := 0;
  repeat
    xi := 0;
    repeat
      for i := 1 to 10 do
        with Canvas do
        begin
          X1 := xi + random(xr);
          Y1 := yi + random(yr);
          X2 := xi + random(xr);
          Y2 := yi + random(yr);
          Pen.Color := pcolor;
          MoveTo(X1, Y1);
          LineTo(X2, Y2);
          Pen.Color := hcolor;
          MoveTo(X1 - 1, Y1 - 1);
          LineTo(X2 - 1, Y2 - 1);
          Pen.Color := scolor;
          MoveTo(X1 + 1, Y1 + 1);
          LineTo(X2 + 1, Y2 + 1);
        end;
      inc(xi, dx);
    until xi > w - 1;
    inc(yi, dy);
  until yi > h - 1;
  Canvas.Pen.Color := pcolor;
end;

procedure TJvDrawImage.DrawSyms(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);
  for i := 0 to StarPoints - 1 do
  begin
    with Canvas do
    begin
      MoveTo(pointarray[i].X, pointarray[i].Y);
      LineTo(apoint.X, apoint.Y);
      pointarray[i] := apoint;
      apoint := Rotate(Point(X0, Y0), apoint, da);
    end;
  end;
end;

procedure TJvDrawImage.PutClip(M: TRect);
var
  dest: TRect;
begin
  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 := cmsrccopy;
  Clip.pixelformat := Picture.Bitmap.pixelformat;
  Clip.Canvas.CopyRect(dest, Canvas, m);
end;

procedure TJvDrawImage.DrawTriangle;
begin
  with Canvas do
  begin
    MoveTo(myskew[0].X, myskew[0].Y);
    LineTo(myskew[1].X, myskew[1].Y);
    LineTo(myskew[2].X, myskew[2].Y);
    LineTo(myskew[0].X, myskew[0].Y);
  end;
end;

procedure TJvDrawImage.DrawSkew;
begin
  with Canvas do
  begin
    MoveTo(myskew[0].X, myskew[0].Y);
    LineTo(myskew[1].X, myskew[1].Y);
    LineTo(myskew[2].X, myskew[2].Y);
    LineTo(myskew[3].X, myskew[3].Y);
    LineTo(myskew[0].X, myskew[0].Y);
  end;
end;

function TJvDrawImage.PointToBlock(X, Y: Integer): TRect;
var
  xb, yb, w, h: Integer;
begin
  w := Picture.Bitmap.Width;
  h := Picture.Bitmap.Height;
  xb := w div Blocks;
  yb := h div Blocks;
  Result.Left := (X div xb) * xb;
  Result.Top := (Y div yb) * yb;
  Result.Right := Result.Left + xb;
  Result.Bottom := Result.Top + yb;
end;

procedure TJvDrawImage.DrawCube;
var
  dx, dy: Integer;
begin
  with Canvas do
  begin
    dx := myskew[4].X - myskew[2].X;
    dy := myskew[4].Y - myskew[2].Y;
    MoveTo(myskew[0].X, myskew[0].Y);
    LineTo(myskew[1].X, myskew[1].Y);
    LineTo(myskew[2].X, myskew[2].Y);
    LineTo(myskew[3].X, myskew[3].Y);
    LineTo(myskew[0].X, myskew[0].Y);
    if (dx >= 0) and (dy <= 0) then
    begin
      MoveTo(myskew[0].X, myskew[0].Y);
      LineTo(myskew[0].X + dx, myskew[0].Y + dy);
      LineTo(myskew[1].X + dx, myskew[1].Y + dy);
      LineTo(myskew[2].X + dx, myskew[2].Y + dy);
      LineTo(myskew[2].X, myskew[2].Y);
      MoveTo(myskew[1].X, myskew[1].Y);
      LineTo(myskew[1].X + dx, myskew[1].Y + dy);
    end
    else
    if (dx >= 0) and (dy > 0) then
    begin
      MoveTo(myskew[1].X, myskew[1].Y);
      LineTo(myskew[1].X + dx, myskew[1].Y + dy);
      LineTo(myskew[2].X + dx, myskew[2].Y + dy);
      LineTo(myskew[3].X + dx, myskew[3].Y + dy);
      LineTo(myskew[3].X, myskew[3].Y);
      MoveTo(myskew[2].X, myskew[2].Y);
      LineTo(myskew[2].X + dx, myskew[2].Y + dy);
    end
    else
    if (dx < 0) and (dy > 0) then
    begin
      MoveTo(myskew[0].X, myskew[0].Y);
      LineTo(myskew[0].X + dx, myskew[0].Y + dy);
      LineTo(myskew[3].X + dx, myskew[3].Y + dy);
      LineTo(myskew[2].X + dx, myskew[2].Y + dy);
      LineTo(myskew[2].X, myskew[2].Y);
      MoveTo(myskew[3].X, myskew[3].Y);
      LineTo(myskew[3].X + dx, myskew[3].Y + dy);
    end
    else
    if (dx < 0) and (dy < 0) then
    begin
      MoveTo(myskew[1].X, myskew[1].Y);
      LineTo(myskew[1].X + dx, myskew[1].Y + dy);
      LineTo(myskew[0].X + dx, myskew[0].Y + dy);
      LineTo(myskew[3].X + dx, myskew[3].Y + dy);
      LineTo(myskew[3].X, myskew[3].Y);
      MoveTo(myskew[0].X, myskew[0].Y);
      LineTo(myskew[0].X + dx, myskew[0].Y + dy);
    end;
  end;
end;

procedure TJvDrawImage.VerGradientLine(Bitmap: TBitmap;
  YOrigin, YFinal, X: Integer; R1, G1, B1, R2, G2, B2: Byte; Smooth: Boolean);
var
  r, g, b, i: Integer;
  valueR, ValueG, ValueB, advalR, advalB, advalG: single;
  Line: PByteArray;
begin
  if (X >= 0) and (X < Bitmap.Width) then
  begin
    if YOrigin > YFinal then
    begin
      i := YOrigin;
      YOrigin := YFinal;
      YFinal := i;
    end;
    if YFinal <> YOrigin then
    begin
      advalR := (R2 - R1) / (YFinal - YOrigin);
      advalG := (G2 - G1) / (YFinal - YOrigin);
      advalB := (B2 - B1) / (YFinal - YOrigin);
    end
    else
    begin
      advalR := 0;
      advalG := 0;
      advalB := 0;
    end;

    valueR := R1;
    valueG := G1;
    valueB := B1;

    for i := YOrigin to YFinal do
    begin
      Line := Bitmap.ScanLine[i];
      valueR := valueR + advalR;
      r := Round(ValueR);
      if r > 255 then
        r := 255;
      if r < 0 then
        r := 0;
      valueG := valueG + advalG;
      g := Round(ValueG);
      if g > 255 then
        g := 255;
      if g < 0 then
        g := 0;
      valueB := valueB + advalB;
      b := Round(ValueB);
      if b > 255 then
        b := 255;
      if b < 0 then
        b := 0;
      if (X >= 0) and (X < Bitmap.Width) then
      begin
        Line[X * 3] := b;
        Line[X * 3 + 1] := g;
        Line[X * 3 + 2] := r;
      end;
    end;
    if Smooth then
    begin
      SmoothPnt(Bitmap, X, YOrigin - 1);
      SmoothPnt(Bitmap, X, YFinal + 1);
    end;
  end;
end;

procedure TJvDrawImage.DrawVGradientBrush(Color1, Color2: TColor; Y1, Y2, X: Integer);
var
  R1, G1, B1, R2, G2, B2: Byte;
begin
  Picture.Bitmap.pixelformat := pf24bit;
  Clip.Assign(Picture.Bitmap);
  Clip.PixelFormat := pf24bit;
  Color1 := ColorToRGB(Color1);
  R1 := GetRValue(Color1);
  G1 := GetGValue(Color1);
  B1 := GetBValue(Color1);
  Color2 := ColorToRGB(Color2);
  R2 := GetRValue(Color2);
  G2 := GetGValue(Color2);
  B2 := GetBValue(Color2);
  vergradientline(Clip, Y1, Y2, X, R1, G1, B1, R2, G2, B2, True);
  Picture.Bitmap.Assign(Clip);
end;

procedure TJvDrawImage.SmoothPnt(Bitmap: TBitmap; xk, yk: Integer);
type
  TFColor = record b, g, r: Byte
  end;
var
  Bleu, Vert, Rouge: Integer;
  Color: TFColor;
  BB, GG, RR: array[1..5] of Integer;
  Line: pbytearray;
begin
  if (xk > 0) and (yk > 0) and (xk < Bitmap.Width - 1) and (yk < Bitmap.Height - 1) then
  begin
    line := Bitmap.ScanLine[yk - 1];
    Color.r := line[xk * 3];
    Color.g := line[xk * 3 + 1];
    Color.b := line[xk * 3 + 2];
    RR[1] := Color.r;
    GG[1] := Color.g;
    BB[1] := Color.b;
    line := Bitmap.ScanLine[yk];
    Color.r := line[(xk + 1) * 3];
    Color.g := line[(xk + 1) * 3 + 1];
    Color.b := line[(xk + 1) * 3 + 2];
    RR[2] := Color.r;
    GG[2] := Color.g;
    BB[2] := Color.b;
    line := Bitmap.ScanLine[yk + 1];
    Color.r := line[xk * 3];
    Color.g := line[xk * 3 + 1];
    Color.b := line[xk * 3 + 2];
    RR[3] := Color.r;
    GG[3] := Color.g;
    BB[3] := Color.b;
    line := Bitmap.ScanLine[yk];
    Color.r := line[(xk - 1) * 3];
    Color.g := line[(xk - 1) * 3 + 1];
    Color.b := line[(xk - 1) * 3 + 2];
    RR[4] := Color.r;
    GG[4] := Color.g;
    BB[4] := Color.b;
    Bleu := (BB[1] + (BB[2] + BB[3] + BB[4])) div 4; (* Valeur moyenne *)
    Vert := (GG[1] + (GG[2] + GG[3] + GG[4])) div 4; (* en cours d'倂aluation        *)
    Rouge := (RR[1] + (RR[2] + RR[3] + RR[4])) div 4;
    Color.r := rouge;
    Color.g := vert;
    Color.b := bleu;
    line := Bitmap.ScanLine[yk];
    line[xk * 3] := Color.r;
    line[xk * 3 + 1] := Color.g;
    line[xk * 3 + 2] := Color.b;
  end;
end;

procedure TJvDrawImage.HorGradientLine(Bitmap: TBitmap;
  XOrigin, XFinal, Y: Integer; R1, G1, B1, R2, G2, B2: Byte; Smooth: Boolean);
var
  r, g, b, i: Integer;
  valueR, ValueG, ValueB, advalR, advalB, advalG: single;
  Line: PByteArray;
begin
  if (Y >= 0) and (Y < Bitmap.Height) then
  begin
    if XOrigin > XFinal then
    begin
      i := XOrigin;
      XOrigin := XFinal;
      XFinal := i;
    end;
    if XFinal <> XOrigin then
    begin
      advalR := (R2 - R1) / (XFinal - XOrigin);
      advalG := (G2 - G1) / (XFinal - XOrigin);
      advalB := (B2 - B1) / (XFinal - XOrigin);
    end
    else
    begin
      advalR := 0;
      advalG := 0;
      advalB := 0;
    end;

    valueR := R1;
    valueG := G1;
    valueB := B1;
    Line := Bitmap.ScanLine[Y];
    for i := XOrigin to XFinal do
    begin
      valueR := valueR + advalR;
      r := Round(ValueR);
      if r > 255 then
        r := 255;
      if r < 0 then
        r := 0;
      valueG := valueG + advalG;
      g := Round(ValueG);
      if g > 255 then
        g := 255;
      if g < 0 then
        g := 0;
      valueB := valueB + advalB;
      b := Round(ValueB);
      if b > 255 then
        b := 255;
      if b < 0 then
        b := 0;
      if (i >= 0) and (i < Bitmap.Width) then
      begin
        Line[i * 3] := b;
        Line[i * 3 + 1] := g;
        Line[i * 3 + 2] := r;
      end;
    end;
    if Smooth then
    begin
      SmoothPnt(Bitmap, XOrigin - 1, Y);
      SmoothPnt(Bitmap, XFinal + 1, Y);
    end;
  end;
end;

procedure TJvDrawImage.DrawGradientBrush(Color1, Color2: TColor; X1, X2, Y: Integer);
var
  R1, G1, B1, R2, G2, B2: Byte;
begin
  Picture.Bitmap.pixelformat := pf24bit;
  Clip.Assign(Picture.Bitmap);
  Clip.PixelFormat := pf24bit;
  Color1 := ColorToRGB(Color1);
  R1 := GetRValue(Color1);
  G1 := GetGValue(Color1);
  B1 := GetBValue(Color1);
  Color2 := ColorToRGB(Color2);
  R2 := GetRValue(Color2);
  G2 := GetGValue(Color2);
  B2 := GetBValue(Color2);
  horgradientline(Clip, X1, X2, Y, R1, G1, B1, R2, G2, B2, True);
  Picture.Bitmap.Assign(Clip);
end;

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

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

end;

procedure TJvDrawImage.ColorCircle(var bm: TBitmap; center: TPoint; Radius, Mode: Integer);