jvdrawimage.pas

East make Tray Icon in delphi

  Canvas.FillRect(Rect(0, 0, w, Y2 - Y1));
  Canvas.FillRect(Rect(0, h - (Y2 - Y1), w, h));
  Canvas.FillRect(Rect(0, 0, X2 - X1, h));
  Canvas.FillRect(Rect(w - (X2 - X1), 0, w, h));
end;

procedure TJvDrawImage.DrawBars(X1, Y1, X2, Y2: Integer);
var
  h, w: Integer;
begin
  h := clientheight;
  w := clientwidth;
  if Y1 < 10 then
    Y1 := 0;
  if Y2 > (h - 10) then
    Y2 := h;
  X1 := 0;
  X2 := w;
  Canvas.FillRect(Rect(X1, Y1, X2, Y2));
end;

procedure TJvDrawImage.DrawSpiro(center, Radius: TPoint);
var
  X0, X1, Y0, Y1, a0, a1, da0, da1: Real;
  xs, ys, X, Y, r0, R1: Integer;
  i: Integer;
begin
  xs := Picture.Bitmap.Width div 2;
  ys := Picture.Bitmap.Height div 2;
  if xs <> ys then
  begin
    ShowMessage(RsImageMustBeSquare);
    Exit;
  end;
  r0 := Variant(Sqrt(Sqr(center.X - xs) + Sqr(center.Y - ys)));
  R1 := Variant(Sqrt(Sqr(Radius.X - center.X) + Sqr(Radius.Y - center.Y)));
  if (r0 + R1) > xs then
  begin
    ShowMessage(RsSumOfRadiTolarge);
    Exit;
  end;
  if (r0 < 5) or (R1 < 5) then
  begin
    ShowMessage(Format(RsBothRadiMustBeGr, [5]));
    Exit;
  end;
  da1 := 2 * pi / 36;
  da0 := R1 / r0 * da1;
  a0 := 0;
  a1 := 0;
  Canvas.MoveTo(xs + r0 + R1, ys);
  for i := 1 to 36 * NSpiro do
  begin
    X1 := R1 * Cos(a1);
    Y1 := R1 * Sin(a1);
    a1 := a1 + da1;
    X0 := r0 * Cos(a0);
    Y0 := r0 * Sin(a0);
    a0 := a0 + da0;
    X := Variant(xs + X0 + X1);
    Y := Variant(ys + Y0 + Y1);
    Canvas.LineTo(X, Y)
  end;
end;

procedure TJvDrawImage.Star(X, Y: Integer);
var
  i, X0, Y0, damult: Integer;
  apoint: TPoint;
  da: Real;
begin
  X0 := myorigin.X;
  Y0 := myorigin.Y;
//777  d := Abs(Y - Y0);
  damult := 1;
  if not PolygonChecked then
  begin
    case StarPoints of
      5: damult := 2;
      7: damult := 3;
      9: damult := 4;
      11: damult := 5;
    end;
  end;
  da := damult * 2 * pi / StarPoints;
  with Canvas do
  begin
    pointarray[0] := Point(X, Y);
    //   MoveTo(X,Y);
    apoint := Point(X, Y);
    for i := 1 to StarPoints - 1 do
    begin
      //      apoint:=Rotate(Point(X0,Y0),apoint,da);
      //      LineTo(apoint.X,apoint.Y);
      apoint := Rotate(Point(X0, Y0), apoint, da);
      pointarray[i] := apoint;
    end;
    //      LineTo(X,Y);
    Polygon(Slice(PointArray, StarPoints))
  end;
end;

function TJvDrawImage.ReduceVector(Origin, Endpoint: TPoint;
  Factor: 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);
  r := r * Factor;
  Result.X := Origin.X + Variant(r * Cos(a));
  Result.Y := Origin.Y + Variant(r * Sin(a));
end;
(*)
procedure TJvDrawImage.TextRotate(X, Y, Angle: Integer; aText: string;
  afont: tfont);
var
  dc: hdc;
  fnt: LogFont;
  hfnt, hfntPrev: hfont;
  i: Integer;
  fname, s: string;
begin
  s := aText;
  fnt.lfEscapement := Angle * 10;
  fnt.lfOrientation := Angle * 10;
  if fsbold in afont.Style then
    fnt.lfWeight := FW_Bold
  else
    fnt.lfWeight := FW_NORMAL;
  if fsitalic in afont.Style then
    fnt.lfItalic := 1
  else
    fnt.lfItalic := 0;
  if fsunderline in afont.Style then
    fnt.lfUnderline := 1
  else
    fnt.lfUnderline := 0;
  fnt.lfStrikeOut := 0;
  fnt.lfHeight := Abs(afont.Height);
  fname := afont.Name;
  for i := 1 to length(fname) do
    fnt.lffacename[i - 1] := fname[i];
  fnt.lfFaceName[length(fname)] := #0;
  hfnt := CreateFontIndirect(fnt);
  dc := Canvas.handle;
  SetBkMode(dc, windows.TRANSPARENT);
  SetTextColor(dc, afont.Color);
  hfntPrev := SelectObject(dc, hfnt);
  //Textout(dc,X,Y,@aText[1],length(aText));
  Textout(dc, X, Y, @s[1], length(s));
  SelectObject(dc, hfntPrev);
  DeleteObject(hfnt);
  Repaint;
end;
(*)
(*)
function TJvDrawImage.GetAngle(Origin, Endpoint: TPoint): Integer;
var
  a, d: 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 * 360 / (2 * pi);
  Result := Variant(-a);
end;
(*)
procedure TJvDrawImage.DrawRisingWaveSphere(Color1, Color2: TColor; X1, Y1, X2, Y2: Integer);
var
  t, xcenter, a, ycenter, b: Integer;
  R1, G1, B1, R2, G2, B2: Byte;
  i, dx, dy, xo, yo, r, bl: Integer;
begin
  Picture.Bitmap.pixelformat := pf24bit;
  Clip.Assign(Picture.Bitmap);
  Clip.PixelFormat := pf24bit;
  if X1 > X2 then
  begin
    t := X1;
    X1 := X2;
    X2 := t;
  end;
  if Y1 > Y2 then
  begin
    t := Y1;
    Y1 := Y2;
    Y2 := t;
  end;
  a := (X2 - X1) div 2;
  b := (Y2 - Y1) div 2;
  if a > b then
    bl := a div (b + 1)
  else
    bl := b div (a + 1);

  xcenter := X1 + a;
  ycenter := Y1 + b;

  dx := (X2 - X1) div bl;
  dy := (Y2 - Y1) div bl;
  if dx > dy then
  begin
    a := (dx div 2) * 4 div 5;
    ycenter := Y1 + b;
    b := a;
  end
  else
  begin
    b := (dy div 2) * 4 div 5;
    xcenter := X1 + a;
    a := b;
  end;
  Color1 := ColorToRGB(Color1);
  R1 := GetRValue(Color1);
  G1 := GetGValue(Color1);
  B1 := GetBValue(Color1);
  Color2 := ColorToRGB(Color2);
  R2 := GetRValue(Color2);
  G2 := GetGValue(Color2);
  B2 := GetBValue(Color2);
  for i := 0 to bl - 1 do
  begin
    if dx > dy then
    begin
      xo := i * dx + a;
      r := Abs(Round(a * Sin(pi * xo / (X2 - X1))));
      Sphere(Clip, X1 + xo, r, ycenter, r, R1, G1, B1, R2, G2, B2, True);
    end
    else
    begin
      yo := i * dy + b;
      r := Abs(Round(b * Sin(pi * yo / (Y2 - Y1) - pi / 2)));
      Sphere(Clip, xcenter, r, Y1 + yo, r, R1, G1, B1, R2, G2, B2, True);
    end;
  end;
  Picture.Bitmap.Assign(Clip);
end;

procedure TJvDrawImage.DrawWaveSphere(Color1, Color2: TColor; X1, Y1, X2, Y2: Integer);
var
  t, xcenter, a, ycenter, b: Integer;
  R1, G1, B1, R2, G2, B2: Byte;
  i, dx, dy, xo, yo, r, bl: Integer;
begin
  Picture.Bitmap.pixelformat := pf24bit;
  Clip.Assign(Picture.Bitmap);
  Clip.PixelFormat := pf24bit;
  if X1 > X2 then
  begin
    t := X1;
    X1 := X2;
    X2 := t;
  end;
  if Y1 > Y2 then
  begin
    t := Y1;
    Y1 := Y2;
    Y2 := t;
  end;
  a := (X2 - X1) div 2;
  b := (Y2 - Y1) div 2;
  if a > b then
    bl := a div (b + 1)
  else
    bl := b div (a + 1);

  xcenter := X1 + a;
  ycenter := Y1 + b;

  dx := (X2 - X1) div bl;
  dy := (Y2 - Y1) div bl;
  if dx > dy then
  begin
    a := (dx div 2) * 4 div 5;
    ycenter := Y1 + b;
    b := a;
  end
  else
  begin
    b := (dy div 2) * 4 div 5;
    xcenter := X1 + a;
    a := b;
  end;
  Color1 := ColorToRGB(Color1);
  R1 := GetRValue(Color1);
  G1 := GetGValue(Color1);
  B1 := GetBValue(Color1);
  Color2 := ColorToRGB(Color2);
  R2 := GetRValue(Color2);
  G2 := GetGValue(Color2);
  B2 := GetBValue(Color2);
  for i := 0 to bl - 1 do
  begin
    if dx > dy then
    begin
      xo := i * dx + a;
      r := Abs(Round(a * Sin(pi * xo / (X2 - X1) - pi / 2)));
      Sphere(Clip, X1 + xo, r, ycenter, r, R1, G1, B1, R2, G2, B2, True);
    end
    else
    begin
      yo := i * dy + b;
      r := Abs(Round(b * Sin(pi * yo / (Y2 - Y1) - pi / 2)));
      Sphere(Clip, xcenter, r, Y1 + yo, r, R1, G1, B1, R2, G2, B2, True);
    end;
  end;
  Picture.Bitmap.Assign(Clip);
end;

procedure TJvDrawImage.DrawDropletSphere(Color1, Color2: TColor; X1, Y1, X2, Y2: Integer);
var
  t, xcenter, a, ycenter, b: Integer;
  R1, G1, B1, R2, G2, B2: Byte;
  i, dx, dy, bl: Integer;
begin
  Picture.Bitmap.pixelformat := pf24bit;
  Clip.Assign(Picture.Bitmap);
  Clip.PixelFormat := pf24bit;
  if X1 > X2 then
  begin
    t := X1;
    X1 := X2;
    X2 := t;
  end;
  if Y1 > Y2 then
  begin
    t := Y1;
    Y1 := Y2;
    Y2 := t;
  end;
  a := (X2 - X1) div 2;
  b := (Y2 - Y1) div 2;
  if a > b then
    bl := a div (b + 1)
  else
    bl := b div (a + 1);

  xcenter := X1 + a;
  ycenter := Y1 + b;

  dx := (X2 - X1) div bl;
  dy := (Y2 - Y1) div bl;
  if dx > dy then
  begin
    a := (dx div 2) * 4 div 5;
    ycenter := Y1 + b;
  end
  else
  begin
    b := (dy div 2) * 4 div 5;
    xcenter := X1 + a;
  end;
  Color1 := ColorToRGB(Color1);
  R1 := GetRValue(Color1);
  G1 := GetGValue(Color1);
  B1 := GetBValue(Color1);
  Color2 := ColorToRGB(Color2);
  R2 := GetRValue(Color2);
  G2 := GetGValue(Color2);
  B2 := GetBValue(Color2);
  for i := 0 to bl - 1 do
  begin
    if dx > dy then
      Sphere(Clip, X1 + i * dx + a, a, ycenter, a, R1, G1, B1, R2, G2, B2, True)
    else
      Sphere(Clip, xcenter, b, Y1 + i * dy + b, b, R1, G1, B1, R2, G2, B2, True);
  end;
  Picture.Bitmap.Assign(Clip);
end;

procedure TJvDrawImage.DrawMultiSphere(Color1, Color2: TColor; X1, Y1, X2, Y2: Integer);
var
  t, xcenter, a, ycenter, b: Integer;
  R1, G1, B1, R2, G2, B2: Byte;
  i, dx, dy, bl: Integer;
begin
  Picture.Bitmap.pixelformat := pf24bit;
  Clip.Assign(Picture.Bitmap);
  Clip.PixelFormat := pf24bit;
  if X1 > X2 then
  begin
    t := X1;
    X1 := X2;
    X2 := t;
  end;
  if Y1 > Y2 then
  begin
    t := Y1;
    Y1 := Y2;
    Y2 := t;
  end;
  a := (X2 - X1) div 2;
  b := (Y2 - Y1) div 2;
  xcenter := X1 + a;
  ycenter := Y1 + b;
  if a > b then
    bl := a div (b + 1)
  else
    bl := b div (a + 1);
  dx := (X2 - X1) div bl;
  dy := (Y2 - Y1) div bl;
  if dx > dy then
  begin
    a := dx div 2;
    ycenter := Y1 + b;
  end
  else
  begin
    b := dy div 2;
    xcenter := X1 + a;
  end;
  Color1 := ColorToRGB(Color1);
  R1 := GetRValue(Color1);
  G1 := GetGValue(Color1);
  B1 := GetBValue(Color1);
  Color2 := ColorToRGB(Color2);
  R2 := GetRValue(Color2);
  G2 := GetGValue(Color2);
  B2 := GetBValue(Color2);
  for i := 0 to bl - 1 do
  begin
    if dx > dy then
      Sphere(Clip, X1 + i * dx + a, a, ycenter, a, R1, G1, B1, R2, G2, B2, True)
    else
      Sphere(Clip, xcenter, b, Y1 + i * dy + b, b, R1, G1, B1, R2, G2, B2, True);
  end;
  Picture.Bitmap.Assign(Clip);
end;

procedure TJvDrawImage.Sphere(Bitmap: TBitmap;
  xcenter, a, ycenter, b: Integer; R1, G1, B1, R2, G2, B2: Byte; Smooth: Boolean);
var (* Dessine un disque Color *)
  xx, yy: Integer; (* par remplissage avec Couleur1-2 *)
  compt, x_ll, y_ll, x_ray, y_ray: Longint;
begin
  xx := 0;
  yy := b;
  x_ray := 2 * a * a;
  y_ray := 2 * b * b;
  x_ll := 1;
  y_ll := x_ray * b - 1;
  compt := y_ll div 2;
  while yy >= 0 do
  begin
    HorGradientLine(Bitmap, xcenter - xx, xcenter + xx, ycenter + yy, R1, G1, B1, R2, G2, B2, Smooth);
    HorGradientLine(Bitmap, xcenter - xx, xcenter + xx, ycenter - yy, R1, G1, B1, R2, G2, B2, Smooth);
    if compt >= 0 then
    begin
      x_ll := x_ll + y_ray;
      compt := compt - x_ll - 1;
      xx := xx + 1;
    end;
    if compt < 0 then
    begin
      y_ll := y_ll - x_ray;
      compt := compt + y_ll - 1;
      yy := yy - 1;
    end;
  end;
end;

procedure TJvDrawImage.DrawSphere(Color1, Color2: TColor; X1, Y1, X2, Y2: Integer);
var
  t, xcenter, a, ycenter, b: Integer;
  R1, G1, B1, R2, G2, B2: Byte;
begin
  Picture.Bitmap.pixelformat := pf24bit;