jclqgraphics.pas

East make Tray Icon in delphi

  StartColor := ColorToRGB(StartColor);
  EndColor := ColorToRGB(EndColor);
  StartRGB[0] := GetRValue(StartColor);
  StartRGB[1] := GetGValue(StartColor);
  StartRGB[2] := GetBValue(StartColor);
  RGBKoef[0] := (GetRValue(EndColor) - StartRGB[0]) / ColorCount;
  RGBKoef[1] := (GetGValue(EndColor) - StartRGB[1]) / ColorCount;
  RGBKoef[2] := (GetBValue(EndColor) - StartRGB[2]) / ColorCount;
  AreaWidth := ARect.Right - ARect.Left;
  AreaHeight :=  ARect.Bottom - ARect.Top;
  case ADirection of
    gdHorizontal:
      RectOffset := AreaWidth / ColorCount;
    gdVertical:
      RectOffset := AreaHeight / ColorCount;
  end;
  for I := 0 to ColorCount - 1 do
  begin
    Brush := CreateSolidBrush(RGB(
      StartRGB[0] + Round((I + 1) * RGBKoef[0]),
      StartRGB[1] + Round((I + 1) * RGBKoef[1]),
      StartRGB[2] + Round((I + 1) * RGBKoef[2])));
    case ADirection of
      gdHorizontal:
        SetRect(ColorRect, Round(RectOffset * I), 0, Round(RectOffset * (I + 1)), AreaHeight);
      gdVertical:
        SetRect(ColorRect, 0, Round(RectOffset * I), AreaWidth, Round(RectOffset * (I + 1)));
    end;
    OffsetRect(ColorRect, ARect.Left, ARect.Top);
    FillRect(DC, ColorRect, Brush);
    DeleteObject(Brush);
  end;
  Result := True;
end;
{$ENDIF MSWINDOWS}



// Matrices
{ TODO -oWIMDC -cReplace : Insert JclMatrix support }
function _DET(a1, a2, b1, b2: Extended): Extended; overload;
begin
  Result := a1 * b2 - a2 * b1;
end;

function _DET(a1, a2, a3, b1, b2, b3, c1, c2, c3: Extended): Extended; overload;
begin
  Result :=
    a1 * (b2 * c3 - b3 * c2) -
    b1 * (a2 * c3 - a3 * c2) +
    c1 * (a2 * b3 - a3 * b2);
end;

procedure Adjoint(var M: TMatrix3d);
var
  a1, a2, a3: Extended;
  b1, b2, b3: Extended;
  c1, c2, c3: Extended;
begin
  a1 := M.A[0, 0];
  a2 := M.A[0, 1];
  a3 := M.A[0, 2];

  b1 := M.A[1, 0];
  b2 := M.A[1, 1];
  b3 := M.A[1, 2];

  c1 := M.A[2, 0];
  c2 := M.A[2, 1];
  c3 := M.A[2, 2];

  M.A[0, 0]:=  _DET(b2, b3, c2, c3);
  M.A[0, 1]:= -_DET(a2, a3, c2, c3);
  M.A[0, 2]:=  _DET(a2, a3, b2, b3);

  M.A[1, 0]:= -_DET(b1, b3, c1, c3);
  M.A[1, 1]:=  _DET(a1, a3, c1, c3);
  M.A[1, 2]:= -_DET(a1, a3, b1, b3);

  M.A[2, 0]:=  _DET(b1, b2, c1, c2);
  M.A[2, 1]:= -_DET(a1, a2, c1, c2);
  M.A[2, 2]:=  _DET(a1, a2, b1, b2);
end;

function Determinant(const M: TMatrix3d): Extended;
begin
  Result := _DET(
    M.A[0, 0], M.A[1, 0], M.A[2, 0],
    M.A[0, 1], M.A[1, 1], M.A[2, 1],
    M.A[0, 2], M.A[1, 2], M.A[2, 2]);
end;

procedure Scale(var M: TMatrix3d; Factor: Extended);
var
  I, J: Integer;
begin
  for I := 0 to 2 do
    for J := 0 to 2 do
      M.A[I, J] := M.A[I, J] * Factor;
end;

procedure InvertMatrix(var M: TMatrix3d);
var
  Det: Extended;
begin
  Det := Determinant(M);
  if Abs(Det) < 1E-5 then
    M := IdentityMatrix
  else
  begin
    Adjoint(M);
    Scale(M, 1 / Det);
  end;
end;

function Mult(const M1, M2: TMatrix3d): TMatrix3d;
var
  I, J: Integer;
begin
  for I := 0 to 2 do
    for J := 0 to 2 do
      Result.A[I, J] :=
        M1.A[0, J] * M2.A[I, 0] +
        M1.A[1, J] * M2.A[I, 1] +
        M1.A[2, J] * M2.A[I, 2];
end;

type
  TVector3d = array [0..2] of Extended;
  TVector3i = array [0..2] of Integer;

function VectorTransform(const M: TMatrix3d; const V: TVector3d): TVector3d;
begin
  Result[0] := M.A[0, 0] * V[0] + M.A[1, 0] * V[1] + M.A[2, 0] * V[2];
  Result[1] := M.A[0, 1] * V[0] + M.A[1, 1] * V[1] + M.A[2, 1] * V[2];
  Result[2] := M.A[0, 2] * V[0] + M.A[1, 2] * V[1] + M.A[2, 2] * V[2];
end;

// TJclLinearTransformation
constructor TJclLinearTransformation.Create;
begin
  inherited Create;
  Clear;
end;

procedure TJclLinearTransformation.Clear;
begin
  FMatrix := IdentityMatrix;
end;

function TJclLinearTransformation.GetTransformedBounds(const Src: TRect): TRect;
var
  V1, V2, V3, V4: TVector3d;
begin
  V1[0] := Src.Left;
  V1[1] := Src.Top;
  V1[2] := 1;

  V2[0] := Src.Right - 1;
  V2[1] := V1[1];
  V2[2] := 1;

  V3[0] := V1[0];
  V3[1] := Src.Bottom - 1;
  V3[2] := 1;

  V4[0] := V2[0];
  V4[1] := V3[1];
  V4[2] := 1;

  V1 := VectorTransform(Matrix, V1);
  V2 := VectorTransform(Matrix, V2);
  V3 := VectorTransform(Matrix, V3);
  V4 := VectorTransform(Matrix, V4);

  Result.Left   := Round(Min(Min(V1[0], V2[0]), Min(V3[0], V4[0])) - 0.5);
  Result.Right  := Round(Max(Max(V1[0], V2[0]), Max(V3[0], V4[0])) + 0.5);
  Result.Top    := Round(Min(Min(V1[1], V2[1]), Min(V3[1], V4[1])) - 0.5);
  Result.Bottom := Round(Max(Max(V1[1], V2[1]), Max(V3[1], V4[1])) + 0.5);
end;

procedure TJclLinearTransformation.PrepareTransform;
var
  M: TMatrix3d;
begin
  M := Matrix;
  InvertMatrix(M);

  // calculate a fixed point (4096) factors
  A := Round(M.A[0, 0] * 4096);
  B := Round(M.A[1, 0] * 4096);
  C := Round(M.A[2, 0] * 4096);
  D := Round(M.A[0, 1] * 4096);
  E := Round(M.A[1, 1] * 4096);
  F := Round(M.A[2, 1] * 4096);
end;

procedure TJclLinearTransformation.Rotate(Cx, Cy, Alpha: Extended);
var
  S, C: Extended;
  M: TMatrix3d;
begin
  if (Cx <> 0) and (Cy <> 0) then
    Translate(-Cx, -Cy);
  SinCos(DegToRad(Alpha), S, C);
  M := IdentityMatrix;
  M.A[0, 0] := C;
  M.A[1, 0] := S;
  M.A[0, 1] := -S;
  M.A[1, 1] := C;
  FMatrix := Mult(M, FMatrix);
  if (Cx <> 0) and (Cy <> 0) then
    Translate(Cx, Cy);
end;

procedure TJclLinearTransformation.Scale(Sx, Sy: Extended);
var
  M: TMatrix3d;
begin
  M := IdentityMatrix;
  M.A[0, 0] := Sx;
  M.A[1, 1] := Sy;
  FMatrix := Mult(M, FMatrix);
end;

procedure TJclLinearTransformation.Skew(Fx, Fy: Extended);
var
  M: TMatrix3d;
begin
  M := IdentityMatrix;
  M.A[1, 0] := Fx;
  M.A[0, 1] := Fy;
  FMatrix := Mult(M, FMatrix);
end;

procedure TJclLinearTransformation.Transform(DstX, DstY: Integer;
  out SrcX, SrcY: Integer);
begin
  SrcX := Sar(DstX * A + DstY * B + C, 12);
  SrcY := Sar(DstX * D + DstY * E + F, 12);
end;

procedure TJclLinearTransformation.Transform256(DstX, DstY: Integer;
  out SrcX256, SrcY256: Integer);
begin
  SrcX256 := Sar(DstX * A + DstY * B + C, 4);
  SrcY256 := Sar(DstX * D + DstY * E + F, 4);
end;

procedure TJclLinearTransformation.Translate(Dx, Dy: Extended);
var
  M: TMatrix3d;
begin
  M := IdentityMatrix;
  M.A[2, 0] := Dx;
  M.A[2, 1] := Dy;
  FMatrix := Mult(M, FMatrix);
end;

// PolyLines and Polygons

procedure QSortLine(const ALine: TScanLine; L, R: Integer);
var
  I, J, P: Integer;
begin
  repeat
    I := L;
    J := R;
    P := ALine[(L + R) shr 1];
    repeat
      while ALine[I] < P do
        Inc(I);
      while ALine[J] > P do
        Dec(J);
      if I <= J then
      begin
        SwapOrd(ALine[I], ALine[J]);
        Inc(I);
        Dec(J);
      end;
    until I > J;
    if L < J then
      QSortLine(ALine, L, J);
    L := I;
  until I >= R;
end;

procedure SortLine(const ALine: TScanLine);
var
  L: Integer;
begin
  L := Length(ALine);
  Assert(not Odd(L));
  if L = 2 then
    TestSwap(ALine[0], ALine[1])
  else
  if L > 2 then
    QSortLine(ALine, 0, L - 1);
end;

procedure SortLines(const ScanLines: TScanLines);
var
  I: Integer;
begin
  for I := 0 to High(ScanLines) do
    SortLine(ScanLines[I]);
end;

procedure AddPolygon(const Points: TDynPointArray; BaseY: Integer;
  MaxX, MaxY: Integer; var ScanLines: TScanLines; SubSampleX: Boolean);
var
  I, X1, Y1, X2, Y2: Integer;
  Direction, PrevDirection: Integer; // up = 1 or down = -1

  procedure AddEdgePoint(X, Y: Integer);
  var
    L: Integer;
  begin
    if (Y < 0) or (Y > MaxY) then
      Exit;
    X := Constrain(X, 0, MaxX);
    L := Length(ScanLines[Y - BaseY]);
    SetLength(ScanLines[Y - BaseY], L + 1);
    ScanLines[Y - BaseY][L] := X;
  end;

  procedure DrawEdge(X1, Y1, X2, Y2: Integer);
  var
    X, Y, I: Integer;
    Dx, Dy, Sx, Sy: Integer;
    Delta: Integer;
  begin
    // this function 'renders' a line into the edge (ScanLines) buffer
    if Y2 = Y1 then
      Exit;

    Dx := X2 - X1;
    Dy := Y2 - Y1;

    if Dy > 0 then
      Sy := 1
    else
    begin
      Sy := -1;
      Dy := -Dy;
    end;
    if Dx > 0 then
      Sx := 1
    else
    begin
      Sx := -1;
      Dx := -Dx;
    end;
    Delta := (Dx mod Dy) shr 1;
    X := X1;
    Y := Y1;
    for I := 0 to Dy - 1 do
    begin
      AddEdgePoint(X, Y);
      Inc(Y, Sy);
      Inc(Delta, Dx);
      while Delta > Dy do
      begin
        Inc(X, Sx);
        Dec(Delta, Dy);
      end;
    end;
  end;

begin
  X1 := Points[0].X;
  Y1 := Points[0].Y;
  if SubSampleX then
    X1 := X1 shl 8;

  // find the last Y different from Y1 and assign it to Y0
  PrevDirection := 0;
  for I := High(Points) downto 1 do
  begin
    if Points[I].Y > Y1 then
      PrevDirection := -1
    else
    if Points[I].Y < Y1 then
      PrevDirection := 1
    else
      Continue;
    Break;
  end;
  Assert(PrevDirection <> 0);

  for I := 1 to High(Points) do
  begin
    X2 := Points[I].X;
    Y2 := Points[I].Y;
    if SubSampleX then
      X2 := X2 shl 8;
    if Y1 <> Y2 then
    begin
      DrawEdge(X1, Y1, X2, Y2);
      if Y2 > Y1 then
        Direction := 1 // up
      else
        Direction := -1; // down
      if Direction <> PrevDirection then
      begin
        AddEdgePoint(X1, Y1);
        PrevDirection := Direction;
      end;
    end;
    X1 := X2;
    Y1 := Y2;
  end;
  X2 := Points[0].X;
  Y2 := Points[0].Y;
  if SubSampleX then
    X2 := X2 shl 8;
  if Y1 <> Y2 then
  begin
    DrawEdge(X1, Y1, X2, Y2);
    if Y2 > Y1 then
      Direction := 1
    else
      Direction := -1;
    if Direction <> PrevDirection then
      AddEdgePoint(X1, Y1);
  end;
end;

// Gamma table support for opacities
procedure SetGamma(Gamma: Single);
var
  I: Integer;
begin
  for I := Low(GAMMA_TABLE) to High(GAMMA_TABLE) do
    GAMMA_TABLE[I] := Round(255 * Power(I / 255, Gamma));
end;

//  modify Jan 28, 2001 for use under BCB5
//         the compiler show error 245 "language feature ist not available"
//         we must take a record and under this we can use the static array

procedure SetIdentityMatrix;
begin
  IdentityMatrix.A[0, 0] := 1.0;
  IdentityMatrix.A[0, 1] := 0.0;
  IdentityMatrix.A[0, 2] := 0.0;
  IdentityMatrix.A[1, 0] := 0.0;
  IdentityMatrix.A[1, 1] := 1.0;
  IdentityMatrix.A[1, 2] := 0.0;
  IdentityMatrix.A[2, 0] := 0.0;
  IdentityMatrix.A[2, 1] := 0.0;
  IdentityMatrix.A[2, 2] := 1.0;
end;

// Initialization and Finalization
initialization
  SetIdentityMatrix;
  SetGamma(0.7);

// History:
// Revision 1.18  2004/11/14 06:05:05  rrossmair
// - some source formatting
//
// Revision 1.17  2004/11/06 02:19:45  mthoma
// history cleaning.
//
// Revision 1.16  2004/10/17 20:54:14  mthoma
// cleaning
//
// Revision 1.15  2004/07/28 07:40:41  marquardt
// remove comiler warnings
//
// Revision 1.14  2004/07/16 03:50:35  rrossmair
// fixed "not accesssible with BCB" warning for TJclRegion.CreateRect
//
// Revision 1.13  2004/07/15 05:15:41  rrossmair
// TJclRegion: Handle ownership management added, some refactoring
//
// Revision 1.12  2004/07/12 02:54:33  rrossmair
// TJclRegion.Create fixed
//
// Revision 1.11  2004/06/14 13:05:19  marquardt
// style cleaning ENDIF, Tabs
//
// Revision 1.10  2004/05/14 15:20:44  rrossmair
// added Marcin Wieczorek to Contributors list
//
// Revision 1.9  2004/05/05 22:16:40  rrossmair
// header updated according to new policy: initial developers & contributors listed
//
// Revision 1.8  2004/04/18 06:32:07  rrossmair
// replaced symbol "Develop" by jpp-pre-undefined "PROTOTYPE"; protected CVS key words by "PROTOTYPE" symbol
//
// Revision 1.7  2004/04/08 19:44:30  mthoma
// Fixed 0001513: CheckParams at the beginning of ApplyLut is: CheckParams(Src, Dst) but should be CheckParams(Dst, Src)
//
// Revision 1.6  2004/04/06 05:01:54  
// adapt compiler conditions, add log entry

end.