jvgcommclasses.pas

East make Tray Icon in delphi

    property Count: Cardinal read FCount write SetCount default 0;
    property Step: Cardinal read FStep write SetStep default 0;
    property Origin: TglOrigin read FOrigin write SetOrigin default forLeftTop;
    property Style: TPanelBevel read FStyle write SetStyle default bvLowered;
    property Bold: Boolean read FBold write SetBold default False;
    property Thickness: Byte read FThickness write SetThickness default 1;
    property IgnoreBorder: Boolean read FIgnoreBorder write SetIgnoreBorder default False;
  end;

{$IFDEF USEJVCL}
{$IFDEF UNITVERSIONING}
const
  UnitVersioning: TUnitVersionInfo = (
    RCSfile: '$RCSfile: JvgCommClasses.pas,v $';
    Revision: '$Revision: 1.26 $';
    Date: '$Date: 2005/02/17 10:21:20 $';
    LogPath: 'JVCL\run'
    );
{$ENDIF UNITVERSIONING}
{$ENDIF USEJVCL}

implementation

uses
  Math,
  JvgUtils;

//=== { TJvgTwainColors } ====================================================

constructor TJvgTwainColors.Create;
begin
  inherited Create;
  //...set defaults
  FFromColor := clGray;
  FRGBFromColor := ColorToRGB(FFromColor);
  FToColor := clBlack;
  FRGBToColor := ColorToRGB(FToColor);
end;

procedure TJvgTwainColors.Assign(Source: TPersistent);
var
  Src: TJvgTwainColors;
begin
  if Source is TJvgTwainColors then
  begin
    if Source = Self then
      Exit;
    Src := TJvgTwainColors(Source);
    FromColor := Src.FromColor;
    ToColor := Src.ToColor;
  end
  else
    inherited Assign(Source);
end;

procedure TJvgTwainColors.Changed;
begin
  if Assigned(FOnChanged) then
    FOnChanged(Self);
end;

procedure TJvgTwainColors.SetFromColor(Value: TColor);
begin
  if FFromColor <> Value then
  begin
    FFromColor := Value;
    FRGBFromColor := ColorToRGB(Value);
    Changed;
  end;
end;

procedure TJvgTwainColors.SetToColor(Value: TColor);
begin
  if FToColor <> Value then
  begin
    FToColor := Value;
    FRGBToColor := ColorToRGB(Value);
    Changed;
  end;
end;

//=== { TJvgCustomGradient } =================================================

constructor TJvgCustomGradient.Create;
begin
  inherited Create;
  //...set defaults
  FActive := False;
  FBufferedDraw := False;
  FOrientation := fgdHorizontal;
  FSteps := 255;
  FPercentFilling := 100;
  FBrushStyle := bsSolid;
end;

procedure TJvgCustomGradient.Assign(Source: TPersistent);
var
  sourceGradient: TJvgCustomGradient;
begin
  // always call inherited, because TJvgTwainColors copies some data as well
  inherited Assign(Source);
  if Source is TJvgCustomGradient then
  begin
    if Source = Self then
      Exit;
    sourceGradient := TJvgCustomGradient(Source);
    FActive := sourceGradient.Active;
    FBufferedDraw := sourceGradient.BufferedDraw;
    FOrientation := sourceGradient.Orientation;
    FSteps := sourceGradient.Steps;
    FPercentFilling := sourceGradient.PercentFilling;
    FBrushStyle := sourceGradient.BrushStyle;
    Changed;
  end;
end;

procedure TJvgCustomGradient.SetActive(Value: Boolean);
begin
  if FActive <> Value then
  begin
    FActive := Value;
    Changed;
  end;
end;

procedure TJvgCustomGradient.SetOrientation(Value: TglGradientDir);
begin
  if FOrientation <> Value then
  begin
    FOrientation := Value;
    Changed;
  end;
end;

procedure TJvgCustomGradient.SetSteps(Value: Integer);
begin
  if Value > 255 then
    Value := 255
  else
    if Value < 1 then
      Value := 1;
  if FSteps <> Value then
  begin
    FSteps := Value;
    Changed;
  end;
end;

procedure TJvgCustomGradient.SetPercentFilling(Value: TPercentRange);
begin
  if FPercentFilling <> Value then
  begin
    FPercentFilling := Value;
    Changed;
  end;
end;

procedure TJvgCustomGradient.SetBrushStyle(Value: TBrushStyle);
begin
  if Value <> FBrushStyle then
  begin
    FBrushStyle := Value;
    Changed;
  end;
end;

function TJvgCustomGradient.GetColorFromGradientLine(GradientLineWidth, Position: Word): COLORREF;
var
  c1F, c2F, c3F: Byte;
  c1T, c2T, c3T: Byte;
  Step1, Step2, Step3: Single;
begin
  c1F := Byte(Self.FRGBFromColor);
  c2F := Byte(Word(Self.FRGBFromColor) shr 8);
  c3F := Byte(Self.FRGBFromColor shr 16);
  c1T := Byte(Self.FRGBToColor);
  c2T := Byte(Word(Self.FRGBToColor) shr 8);
  c3T := Byte(Self.FRGBToColor shr 16);

  Step1 := (c1T - c1F) / GradientLineWidth;
  Step2 := (c2T - c2F) / GradientLineWidth;
  Step3 := (c3T - c3F) / GradientLineWidth;

  Result := RGB(Trunc(c1F + Step1 * Position),
    Trunc(c2F + Step2 * Position),
    Trunc(c3F + Step3 * Position));
end;

procedure TJvgCustomGradient.TextOut(DC: HDC; const Str: string; TextR: TRect; X, Y: Integer);
var
  I, Steps: Integer;
  r: TRect;
  c1F, c2F, c3F: Byte;
  c1T, c2T, c3T: Byte;
  c1, c2, c3: Single;
  Step1, Step2, Step3: Single;
  OldTextColor: TCOLORREF;
begin
  if (not Active) or (GetDeviceCaps(DC, BITSPIXEL) < 16) then
  begin
    Windows.TextOut(DC, X, Y, PChar(Str), Length(Str));
    Exit;
  end;
  r := TextR;
  c1F := Byte(FRGBFromColor);
  c2F := Byte(Word(FRGBFromColor) shr 8);
  c3F := Byte(FRGBFromColor shr 16);
  c1T := Byte(FRGBToColor);
  c2T := Byte(Word(FRGBToColor) shr 8);
  c3T := Byte(FRGBToColor shr 16);

  c1 := c1F;
  c2 := c2F;
  c3 := c3F;
  if FOrientation = fgdVertical then
    Steps := r.Right - r.Left
  else
    Steps := r.Bottom - r.Top;
  Step1 := (c1T - c1F) / Steps;
  Step2 := (c2T - c2F) / Steps;
  Step3 := (c3T - c3F) / Steps;

  OldTextColor := SetTextColor(DC, 0);
  Steps := MulDiv(Steps, PercentFilling, 100);
  for I := 0 to Steps do
  begin
    SetTextColor(DC, RGB(Trunc(c1), Trunc(c2), Trunc(c3)));

    if FOrientation = fgdVertical then
    begin
      r.Left := I;
      r.Right := r.Left + 1;
    end
    else
    begin
      r.Top := I;
      r.Bottom := r.Top + 1;
    end;

    Windows.ExtTextOut(DC, X, Y, ETO_CLIPPED, @r,
      PChar(Str), Length(Str), nil);
    c1 := c1 + Step1;
    c2 := c2 + Step2;
    c3 := c3 + Step3;
  end;
  SetTextColor(DC, OldTextColor);
end;

//=== { TJvg3DGradient } =====================================================

constructor TJvg3DGradient.Create;
begin
  inherited Create;
  Depth := 16;
  FGType := fgtFlat;
  FActive := True;
end;

procedure TJvg3DGradient.Assign(Source: TPersistent);
var
  Src: TJvg3DGradient;
begin
  inherited Assign(Source);
  if Source is TJvg3DGradient then
  begin
    if Source = Self then
      Exit;
    Src := TJvg3DGradient(Source);
    FDepth := Src.Depth;
    FGType := Src.GType;
    Changed;
  end;
end;

procedure TJvg3DGradient.SetGType(Value: TThreeDGradientType);
begin
  if FGType <> Value then
  begin
    FGType := Value;
    Changed;
  end;
end;

procedure TJvg3DGradient.SetDepth(Value: Word);
begin
  if FDepth <> Value then
  begin
    FDepth := Value;
    Changed;
  end;
end;

//=== { TJvg2DAlign } ========================================================

constructor TJvg2DAlign.Create;
begin
  inherited Create;
  //...set defaults
  FHorizontal := fhaLeft;
  FVertical := fvaTop;
end;

procedure TJvg2DAlign.Assign(Source: TPersistent);
var
  Src: TJvg2DAlign;
begin
  if Source is TJvg2DAlign then
  begin
    if Source = Self then
      Exit;
    Src := TJvg2DAlign(Source);
    FHorizontal := Src.Horizontal;
    FVertical := Src.Vertical;
    Changed;
  end
  else
    inherited Assign(Source);
end;

procedure TJvg2DAlign.Changed;
begin
  if Assigned(FOnChanged) then
    FOnChanged(Self);
end;

procedure TJvg2DAlign.SetHorizontal(Value: TglHorAlign);
begin
  if FHorizontal <> Value then
  begin
    FHorizontal := Value;
    Changed;
  end;
end;

procedure TJvg2DAlign.SetVertical(Value: TglVertAlign);
begin
  if FVertical <> Value then
  begin
    FVertical := Value;
    Changed;
  end;
end;

//=== { TJvgPointClass } =====================================================

procedure TJvgPointClass.Assign(Source: TPersistent);
var
  Src: TJvgPointClass;
begin
  if Source is TJvgPointClass then
  begin
    if Source = Self then
      Exit;
    Src := TJvgPointClass(Source);
    FX := Src.X;
    FY := Src.Y;
    Changed;
  end
  else
    inherited Assign(Source);
end;

procedure TJvgPointClass.Changed;
begin
  if Assigned(FOnChanged) then
    FOnChanged(Self);
end;

procedure TJvgPointClass.SetX(Value: Integer);
begin
  if FX <> Value then
  begin
    FX := Value;
    Changed;
  end;
end;

procedure TJvgPointClass.SetY(Value: Integer);
begin
  if FY <> Value then
  begin
    FY := Value;
    Changed;
  end;
end;

//=== { TJvgBevelOptions } ===================================================

constructor TJvgBevelOptions.Create;
begin
  inherited Create;
  FSides := ALLGLSIDES;
end;

procedure TJvgBevelOptions.Assign(Source: TPersistent);
var
  Src: TJvgBevelOptions;
begin
  if Source is TJvgBevelOptions then
  begin
    if Source = Self then
      Exit;
    Src := TJvgBevelOptions(Source);
    FInner := Src.Inner;
    FOuter := Src.Outer;
    FSides := Src.Sides;
    FBold := Src.Bold;
    Changed;
  end
  else
    inherited Assign(Source);
end;

procedure TJvgBevelOptions.Changed;
begin
  if Assigned(FOnChanged) then
    FOnChanged(Self);
end;

procedure TJvgBevelOptions.SetOuter(Value: TPanelBevel);
begin
  if FOuter <> Value then
  begin
    FOuter := Value;
    Changed;
  end;
end;

procedure TJvgBevelOptions.SetInner(Value: TPanelBevel);
begin
  if FInner <> Value then
  begin
    FInner := Value;
    Changed;
  end;
end;

procedure TJvgBevelOptions.SetSides(Value: TglSides);
begin
  if FSides <> Value then
  begin
    FSides := Value;
    Changed;
  end;
end;

procedure TJvgBevelOptions.SetBold(Value: Boolean);
begin
  if FBold <> Value then
  begin
    FBold := Value;
    Changed;
  end;
end;

function TJvgBevelOptions.BordersHeight: Integer;
begin
  Result := 0;
  if Inner <> bvNone then
  begin
    if fsdTop in Sides then
      Inc(Result);
    if fsdBottom in Sides then
      if Bold then
        Inc(Result, 1)
      else
        Inc(Result);
  end;
  if Outer <> bvNone then
  begin
    if fsdTop in Sides then
      Inc(Result);
    if fsdBottom in Sides then
      if Bold then
        Inc(Result, 1)
      else
        Inc(Result);
  end;
end;

function TJvgBevelOptions.BordersWidth: Integer;
begin
  Result := 0;
  if Inner <> bvNone then
  begin
    if fsdLeft in Sides then
      Inc(Result);
    if fsdRight in Sides then
      if Bold then
        Inc(Result, 1)
      else
        Inc(Result);
  end;
  if Outer <> bvNone then
  begin
    if fsdLeft in Sides then
      Inc(Result);
    if fsdRight in Sides then
      if Bold then
        Inc(Result, 1)
      else
        Inc(Result);
  end;
end;

//=== { TJvgIllumination } ===================================================

constructor TJvgIllumination.Create;
begin
  inherited Create;
  FShadowDepth := 2;
end;

procedure TJvgIllumination.Assign(Source: TPersistent);
var
  Src: TJvgIllumination;
begin
  inherited Assign(Source);
  if Source is TJvgIllumination then
  begin
    if Source = Self then
      Exit;
    Src := TJvgIllumination(Source);
    FShadowDepth := Src.ShadowDepth;
    Changed;
  end;