jvgcommclasses.pas

East make Tray Icon in delphi

  inherited SetOnChanged(Value);
  FGradient.OnChanged := Value;
  FTextGradient.OnChanged := Value;
end;

procedure TJvgListBoxItemStyle.SetGradient(Value: TJvgGradient);
begin
  FGradient.Assign(Value);
end;

procedure TJvgListBoxItemStyle.SetTextGradient(Value: TJvgGradient);
begin
  FTextGradient.Assign(Value);
end;

//=== { TJvgAskListBoxItemStyle } ============================================

constructor TJvgAskListBoxItemStyle.Create;
begin
  inherited Create;
  FBtnFont := TFont.Create;
end;

destructor TJvgAskListBoxItemStyle.Destroy;
begin
  FBtnFont.Free;
  inherited Destroy;
end;

procedure TJvgAskListBoxItemStyle.Assign(Source: TPersistent);
var
  Src: TJvgAskListBoxItemStyle;
begin
  inherited Assign(Source);
  if Source is TJvgAskListBoxItemStyle then
  begin
    if Source = Self then
      Exit;
    Src := TJvgAskListBoxItemStyle(Source);
    FBtnColor := Src.BtnColor;
    FBtnTextStyle := Src.BtnTextStyle;
    BtnFont := Src.BtnFont; // calls Changed
  end;
end;

procedure TJvgAskListBoxItemStyle.SetBtnColor(Value: TColor);
begin
  if FBtnColor <> Value then
  begin
    FBtnColor := Value;
    Changed;
  end;
end;

procedure TJvgAskListBoxItemStyle.SetBtnFont(Value: TFont);
begin
  if Value <> FBtnFont then
  begin
    FBtnFont.Assign(Value);
    Changed;
  end;
end;

procedure TJvgAskListBoxItemStyle.SetBtnTextStyle(Value: TglTextStyle);
begin
  if Value <> FBtnTextStyle then
  begin
    FBtnTextStyle := Value;
    Changed;
  end;
end;

//=== { TJvgCustomBoxStyle } =================================================

constructor TJvgCustomBoxStyle.Create;
begin
  inherited Create;
  FPenStyle := psSolid;
  FHighlightColor := clBtnHighlight;
  FShadowColor := clBtnShadow;
end;

procedure TJvgCustomBoxStyle.Assign(Source: TPersistent);
var
  Src: TJvgCustomBoxStyle;
begin
  inherited Assign(Source);
  if Source is TJvgCustomBoxStyle then
  begin
    if Source = Self then
      Exit;
    Src := TJvgCustomBoxStyle(Source);
    FPenStyle := Src.PenStyle;
    FHighlightColor := Src.HighlightColor;
    FShadowColor := Src.ShadowColor;
    Changed;
  end;
end;

procedure TJvgCustomBoxStyle.SetPenStyle(Value: TPenStyle);
begin
  if Value <> FPenStyle then
  begin
    FPenStyle := Value;
    Changed;
  end;
end;

procedure TJvgCustomBoxStyle.SetHighlightColor(Value: TColor);
begin
  if Value <> FHighlightColor then
  begin
    FHighlightColor := Value;
    Changed;
  end;
end;

procedure TJvgCustomBoxStyle.SetShadowColor(Value: TColor);
begin
  if Value <> FShadowColor then
  begin
    FShadowColor := Value;
    Changed;
  end;
end;

//=== { TJvgCustomTextBoxStyle } =============================================

constructor TJvgCustomTextBoxStyle.Create;
begin
  inherited Create;
  FTextColor := clBlack;
  FBackgroundColor := clWindow;
end;

procedure TJvgCustomTextBoxStyle.Assign(Source: TPersistent);
var
  Src: TJvgCustomTextBoxStyle;
begin
  inherited Assign(Source);
  if Source is TJvgCustomTextBoxStyle then
  begin
    if Source = Self then
      Exit;
    Src := TJvgCustomTextBoxStyle(Source);
    FTextColor := Src.TextColor;
    FBackgroundColor := Src.BackgroundColor;
    Changed;
  end;
end;

procedure TJvgCustomTextBoxStyle.SetTextColor(Value: TColor);
begin
  if Value <> FTextColor then
  begin
    FTextColor := Value;
    Changed;
  end;
end;

procedure TJvgCustomTextBoxStyle.SetBackgroundColor(Value: TColor);
begin
  if Value <> FBackgroundColor then
  begin
    FBackgroundColor := Value;
    Changed;
  end;
end;

//=== { TJvgBevelLines } =====================================================

constructor TJvgBevelLines.Create;
begin
  inherited Create;
  FStyle := bvLowered;
  FThickness := 1;
end;

procedure TJvgBevelLines.Assign(Source: TPersistent);
var
  Src: TJvgBevelLines;
begin
  if Source is TJvgBevelLines then
  begin
    if Source = Self then
      Exit;
    Src := TJvgBevelLines(Source);
    FCount := Src.Count;
    FStep := Src.Step;
    FOrigin := Src.Origin;
    FStyle := Src.Style;
    FBold := Src.Bold;
    FThickness := Src.Thickness;
    FIgnoreBorder := Src.IgnoreBorder;
    Changed;
  end
  else
    inherited Assign(Source);
end;

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

procedure TJvgBevelLines.SetCount(Value: Cardinal);
begin
  if Value <> FCount then
  begin
    FCount := Value;
    Changed;
  end;
end;

procedure TJvgBevelLines.SetStep(Value: Cardinal);
begin
  if Value <> FStep then
  begin
    FStep := Value;
    Changed;
  end;
end;

procedure TJvgBevelLines.SetOrigin(Value: TglOrigin);
begin
  if Value <> FOrigin then
  begin
    FOrigin := Value;
    Changed;
  end;
end;

procedure TJvgBevelLines.SetStyle(Value: TPanelBevel);
begin
  if Value <> FStyle then
  begin
    FStyle := Value;
    Changed;
  end;
end;

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

procedure TJvgBevelLines.SetThickness(Value: Byte);
begin
  if Value <> FThickness then
  begin
    FThickness := Value;
    Changed;
  end;
end;

procedure TJvgBevelLines.SetIgnoreBorder(Value: Boolean);
begin
  if Value <> FIgnoreBorder then
  begin
    FIgnoreBorder := Value;
    Changed;
  end;
end;

//=== { TJvgGradient } =======================================================

// { paints the gradient; 铗痂耦恹忄弪 沭噤桢眚 }

procedure TJvgGradient.Draw(DC: HDC; r: TRect; PenStyle, PenWidth: Integer);
var
  I, J, X, Y, x2, y2, h, w, NumberOfColors: Integer;
  c1F, c2F, c3F: Byte;
  c1T, c2T, c3T: Byte;
  c1D, c2D, c3D: Integer;
  _R, _G, _B: Byte;
  Pen, OldPen: HPen;
  FillBrush: HBRUSH;
  BufferBmp, OldBMP: HBITMAP;
  BufferDC, TargetDC: HDC;
  ColorR: TRect;
  LOGBRUSH: TLOGBRUSH;

  procedure SwapColors;
  var
    TempColor: Longint;
  begin
    TempColor := FRGBFromColor;
    FRGBFromColor := FRGBToColor;
    FRGBToColor := TempColor;
  end;

begin
  if (not Active) or glGlobalData.fSuppressGradient then
    Exit;
  if (Steps = 1) or (GetDeviceCaps(DC, BITSPIXEL) < 16) then
  begin
    Exit;
    FillBrush := CreateSolidBrush(ColorToRGB(FromColor));
    FillRect(DC, r, FillBrush);
    DeleteObject(FillBrush);
    Exit;
  end;
  X := r.Left;
  Y := r.Top;
  h := r.Bottom - r.Top;
  w := r.Right - r.Left;
  x2 := 0;
  y2 := 0;
  Pen := 0;
  OldPen := 0;
  BufferDC := 0;

  if Orientation = fgdHorzConvergent then
  begin
    FOrientation := fgdHorizontal;
    Draw(DC, Rect(r.Left, r.Top, r.Right, r.Bottom - h div 2), PenStyle, PenWidth);
    SwapColors;
    Draw(DC, Rect(r.Left, r.Top + h div 2, r.Right, r.Bottom), PenStyle, PenWidth);
    SwapColors;
    FOrientation := fgdHorzConvergent;
    Exit;
  end;
  if Orientation = fgdVertConvergent then
  begin
    FOrientation := fgdVertical;
    Draw(DC, Rect(r.Left, r.Top, r.Right - w div 2, r.Bottom), PenStyle, PenWidth);
    SwapColors;
    Draw(DC, Rect(r.Left + w div 2, r.Top, r.Right, r.Bottom), PenStyle, PenWidth);
    SwapColors;
    FOrientation := fgdVertConvergent;
    Exit;
  end;

  //...r._ data no more useful
  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);
  c1D := c1T - c1F;
  c2D := c2T - c2F;
  c3D := c3T - c3F;

  if BufferedDraw then
  begin
    BufferDC := CreateCompatibleDC(DC);
    BufferBmp := CreateBitmap(w, h, GetDeviceCaps(DC, Planes), GetDeviceCaps(DC, BITSPIXEL), nil);
    OldBMP := SelectObject(BufferDC, BufferBmp);
    SetMapMode(BufferDC, GetMapMode(DC));
    TargetDC := BufferDC;
  end
  else
    TargetDC := DC;

  case Orientation of
    fgdHorizontal:
      begin
        NumberOfColors := Min(Steps, h);
        ColorR.Left := r.Left;
        ColorR.Right := r.Right;
      end;
    fgdVertical:
      begin
        NumberOfColors := Min(Steps, w);
        ColorR.Top := r.Top;
        ColorR.Bottom := r.Bottom;
      end;
    fgdLeftBias, fgdRightBias:
      begin
        NumberOfColors := Min(Steps, w + h);
        if PenStyle = 0 then
          PenStyle := PS_SOLID;
        if PenWidth = 0 then
          PenWidth := 1;
        Pen := CreatePen(PenStyle, PenWidth, 0);
        OldPen := SelectObject(TargetDC, Pen);
        y2 := Y;
        if Orientation = fgdLeftBias then
          x2 := X
        else
        begin
          X := r.Right;
          x2 := r.Right;
        end;
      end;
  else {fgdRectangle}
    begin
      h := h div 2;
      w := w div 2;
      NumberOfColors := Min(Steps, Min(w, h));
    end;
  end;
  LOGBRUSH.lbStyle := BS_HATCHED;
  LOGBRUSH.lbHatch := Ord(BrushStyle) - Ord(bsHorizontal);
  for I := 0 to NumberOfColors - 1 do
  begin
    _R := c1F + MulDiv(I, c1D, NumberOfColors - 1);
    _G := c2F + MulDiv(I, c2D, NumberOfColors - 1);
    _B := c3F + MulDiv(I, c3D, NumberOfColors - 1);

    case Orientation of
      fgdHorizontal, fgdVertical, fgdRectangle:
        begin
          if BrushStyle = bsSolid then
            FillBrush := CreateSolidBrush(RGB(_R, _G, _B))
          else
          begin
            LOGBRUSH.lbColor := RGB(_R, _G, _B);
            FillBrush := CreateBrushIndirect(LOGBRUSH);
          end;

          case Orientation of
            fgdHorizontal:
              begin
                if FReverse then
                begin
                  ColorR.Top := r.Bottom - MulDiv(I, h, NumberOfColors);
                  ColorR.Bottom := r.Bottom - MulDiv(I + 1, h, NumberOfColors);
                end
                else
                begin
                  ColorR.Top := r.Top + MulDiv(I, h, NumberOfColors);
                  ColorR.Bottom := r.Top + MulDiv(I + 1, h, NumberOfColors);
                end;
              end;
            fgdVertical:
              begin
                if FReverse then
                begin
                  ColorR.Left := r.Right - MulDiv(I, w, NumberOfColors);
                  ColorR.Right := r.Right - MulDiv(I + 1, w, NumberOfColors);
                end
                else
                begin
                  ColorR.Left := r.Left + MulDiv(I, w, NumberOfColors);
                  ColorR.Right := r.Left + MulDiv(I + 1, w, NumberOfColors);
                end;
              end;
            fgdRectangle:
              begin
                ColorR.Top := r.Top + MulDiv(I, h, NumberOfColors);
                ColorR.Bottom := r.Bottom - MulDiv(I, h, NumberOfColors);
                ColorR.Left := r.Left + MulDiv(I, w, NumberOfColors);
                ColorR.Right := r.Right - MulDiv(I, w, NumberOfColors);
              end;
          end;
          FillRect(TargetDC, ColorR, FillBrush);
          DeleteObject(FillBrush);
        end;
    else {fgdLeftBias, fgdRightBias:}
      begin
        if Pen <> 0 then
          DeleteObject(SelectObject(TargetDC, OldPen)); //...cant delete selected!

        Pen := CreatePen(PenStyle, PenWidth, RGB(_R, _G, _B));

        OldPen := SelectObject(TargetDC, Pen);
        for J := 1 to MulDiv(I + 1, h + w, NumberOfColors) - MulDiv(I, h + w, NumberOfColors) do
        begin
          case Orientation of
            fgdLeftBias:
              begin
                if Y >= r.Bottom then
                  Inc(X, PenWidth)
                else
                  Y := Y + PenWidth;
                if x2 >= r.Right then
                  Inc(y2, PenWidth)
                else
                  x2 := x2 + PenWidth;
                MoveToEx(TargetDC, X, Y, nil);
                LineTo(TargetDC, x2, y2);
              end;
          else {fgdRightBias:}
            begin
              if X <= r.Left then
                Inc(Y, PenWidth)
              else
                X := X - PenWidth;
              if y2 >= r.Bottom then
                dec(x2, PenWidth)
              else
                y2 := y2 + PenWidth;
              MoveToEx(TargetDC, X, Y, nil);
              LineTo(TargetDC, x2, y2);
            end;
          end;
        end;
        DeleteObject(SelectObject(TargetDC, OldPen));
      end;
    end;
    //    if NumberOfColors=0 then exit;
    if I / NumberOfColors * 100 > PercentFilling then
      Break;
  end;

  if BufferedDraw then
  begin
    BitBlt(DC, 0, 0, r.Right - r.Left, r.Bottom - r.Top, BufferDC, 0, 0, SRCCOPY);
    DeleteObject(SelectObject(BufferDC, OldBMP));
    DeleteDC(BufferDC);
  end;
end;

{$IFDEF USEJVCL}
{$IFDEF UNITVERSIONING}
initialization
  RegisterUnitVersion(HInstance, UnitVersioning);

finalization
  UnregisterUnitVersion(HInstance);
{$ENDIF UNITVERSIONING}
{$ENDIF USEJVCL}

end.