jvgutils.pas

East make Tray Icon in delphi

  if not Assigned(Font) then
    Exit;
  OldFont := SelectObject(DC, Font.Handle);
  OldBkMode := SetBkMode(DC, TRANSPARENT);

  if ADelineated then
  begin
    X1 := 4;
    Y1 := 4;
  end
  else
  begin
    X1 := 2;
    Y1 := 2;
  end;
  if Style = fstNone then
  begin
    X1 := X1 div 2 - 1;
    Y1 := Y1 div 2 - 1;
  end;
  if Style = fstShadow then
  begin
    X1 := X1 div 2 - 1;
    Y1 := Y1 div 2 - 1;
  end;
  if Assigned(Illumination) then
    ShadowDepth := Illumination.ShadowDepth
  else
    ShadowDepth := 2;
  case Style of
    fstRaised:
      begin
        if not ASupress3D then
        begin
          SetTextColor(DC, ColorToRGB(HighlightColor));
          ExtTextOut(DC, X, Y, ETO_CLIPPED, @R, PChar(Text), Length(Text), nil);
          SetTextColor(DC, ColorToRGB(ShadowColor));
          ExtTextOut(DC, X + X1, Y + Y1, ETO_CLIPPED, @R, PChar(Text), Length(Text), nil);
        end;
        DrawMain(ADelineated, 1);
      end;
    fstRecessed:
      begin
        if not ASupress3D then
        begin
          SetTextColor(DC, ColorToRGB(ShadowColor));
          ExtTextOut(DC, X, Y, ETO_CLIPPED, @R, PChar(Text), Length(Text), nil);
          SetTextColor(DC, ColorToRGB(HighlightColor));
          ExtTextOut(DC, X + X1, Y + Y1, ETO_CLIPPED, @R, PChar(Text), Length(Text), nil);
        end;
        DrawMain(ADelineated, 1);
      end;
    fstPushed:
      begin
        SetTextColor(DC, ColorToRGB(HighlightColor));
        ExtTextOut(DC, X + 1, Y + 1, ETO_CLIPPED, @R, PChar(Text), Length(Text), nil);
        SetTextColor(DC, ColorToRGB(ShadowColor));
        ExtTextOut(DC, X, Y, ETO_CLIPPED, @R, PChar(Text), Length(Text), nil);
      end;
    fstShadow:
      begin
        if not ASupress3D then
        begin
          SetTextColor(DC, ColorToRGB(ShadowColor));
          ExtTextOut(DC, X + X1 + ShadowDepth, Y + Y1 + ShadowDepth, ETO_CLIPPED, @R, PChar(Text), Length(Text), nil);
        end;
        DrawMain(ADelineated, 0);
      end;
    fstVolumetric:
      begin
        if not ASupress3D then
        begin
          SetTextColor(DC, ColorToRGB(ShadowColor));
          for I := 1 to ShadowDepth do
            ExtTextOut(DC, X + I, Y + I, ETO_CLIPPED, @R, PChar(Text), Length(Text), nil);
        end;
        DrawMain(ADelineated, 0);
      end;
  else
    DrawMain(ADelineated, 0);
    //    SetTextColor( DC , ColorToRGB(FontColor) );
    //    ExtTextOut( DC, X, Y,  ETO_CLIPPED, @R, PChar(Text), Length(Text), nil);
  end;
  SelectObject(DC, OldFont);
  SetBkMode(DC, OldBkMode);
end;

{
   Draws rect with given 3D style

   DC          - Handle of canvas
   Style       - Style (fbsFlat, fbsCtl3D, fbsStatusControl, fbsRecessed, fbsRaised, fbsRaisedFrame, fbsRecessedFrame)
   BackgrColor - Background Color if FTransparen is False
}


procedure DrawBox(DC: HDC; var R: TRect; Style: TglBoxStyle;
  BackgrColor: Longint; ATransparent: Boolean);
const
  FBorderWidth = 1;
begin

  case Style of
    fbsFlat:
      begin
      end;
    fbsCtl3D:
      begin
        R.Top := R.Top + 2;
        R.Left := R.Left + 2;
        R.Right := R.Right - 2;
        R.Bottom := R.Bottom - 1;
        //  Frame3D(Canvas, R,clBtnShadow,clBtnHighlight,1);
      end;
    //    fbsStatusControl:
    fbsRaised:
      begin
        InflateRect(R, -2, -2);
        DrawEdge(DC, R, BDR_RAISEDOUTER, BF_BOTTOMRIGHT); // black
        Dec(R.Bottom);
        Dec(R.Right);
        DrawEdge(DC, R, BDR_RAISEDINNER, BF_TOPLEFT); // btnhilite
        Inc(R.Top);
        Inc(R.Left);
        DrawEdge(DC, R, BDR_RAISEDINNER, BF_BOTTOMRIGHT or BF_MIDDLE); // btnshadow
      end;
    fbsRecessed:
      begin
        R.Bottom := R.Bottom - 1;
        DrawEdge(DC, R, BDR_SUNKENINNER, BF_TOPLEFT); // black
        DrawEdge(DC, R, BDR_SUNKENOUTER, BF_BOTTOMRIGHT); // btnhilite
        Dec(R.Bottom);
        Dec(R.Right);
        Inc(R.Top);
        Inc(R.Left);
        DrawEdge(DC, R, BDR_SUNKENOUTER, BF_TOPLEFT or BF_MIDDLE); // btnshadow
        Inc(R.Top);
        Inc(R.Left);
      end;
    fbsRaisedFrame:
      begin
        DrawEdge(DC, R, BDR_RAISEDOUTER, BF_BOTTOMRIGHT); // black
        Dec(R.Bottom);
        Dec(R.Right);
        DrawEdge(DC, R, BDR_RAISEDINNER, BF_TOPLEFT); // btnhilite
        Inc(R.Top);
        Inc(R.Left);
        DrawEdge(DC, R, BDR_RAISEDINNER, BF_BOTTOMRIGHT or BF_MIDDLE); // btnshadow

        InflateRect(R, -FBorderWidth, -FBorderWidth);

        DrawEdge(DC, R, BDR_SUNKENINNER, BF_TOPLEFT); // black
        DrawEdge(DC, R, BDR_SUNKENOUTER, BF_BOTTOMRIGHT); // btnhilite
        Dec(R.Bottom);
        Dec(R.Right);
        Inc(R.Top);
        Inc(R.Left);
        DrawEdge(DC, R, BDR_SUNKENOUTER, BF_TOPLEFT or BF_MIDDLE); // btnshadow
        Inc(R.Top);
        Inc(R.Left);
      end;
    fbsRecessedFrame:
      begin
        DrawEdge(DC, R, BDR_SUNKENINNER, BF_TOPLEFT); // black
        DrawEdge(DC, R, BDR_SUNKENOUTER, BF_BOTTOMRIGHT); // btnhilite
        Dec(R.Bottom);
        Dec(R.Right);
        Inc(R.Top);
        Inc(R.Left);
        DrawEdge(DC, R, BDR_SUNKENOUTER, BF_TOPLEFT or BF_MIDDLE); // btnshadow
        Inc(R.Top);
        Inc(R.Left);

        InflateRect(R, -FBorderWidth, -FBorderWidth);

        DrawEdge(DC, R, BDR_RAISEDOUTER, BF_BOTTOMRIGHT); // black
        Dec(R.Bottom);
        Dec(R.Right);
        DrawEdge(DC, R, BDR_RAISEDINNER, BF_TOPLEFT); // btnhilite
        Inc(R.Top);
        Inc(R.Left);
        DrawEdge(DC, R, BDR_RAISEDINNER, BF_BOTTOMRIGHT or BF_MIDDLE); // btnshadow
      end;
  end;
end;

{
  Draws rect with given 3D style and specifing borders

  DC          - Handle of canvas
  Borders     - Borders for drawing
  BevelInner, BevelOuter - Borders' styles
  Bold        - Bold border(frame)
  BackgrColor - Background Color if ATransparent is False
}

function DrawBoxEx(DC: HDC; ARect: TRect; Borders: TglSides;
  BevelInner, BevelOuter: TPanelBevel; Bold: Boolean; BackgrColor: Longint;
  ATransparent: Boolean): TRect;
var
  I: Word;
  BPen, LPen, SPen, OldPen: HPEN;
  HBackgrBrush, HOldBrush: HBRUSH;
  R, R1: TRect;
  BColor, HColor, SColor: Longint;
  LogOldPen: TLOGPEN;
  PenWidth: UINT;

  procedure SetDefColors;
  begin
    BColor := GetSysColor(COLOR_3DDKSHADOW);
    HColor := GetSysColor(COLOR_3DHILIGHT);
    SColor := GetSysColor(COLOR_3DSHADOW);
  end;

  procedure DrawBevel(Bevel: TPanelBevel);
  begin
    if fsdLeft in Borders then
    begin
      case Bevel of
        bvRaised:
          begin
            SelectObject(DC, LPen);
            MoveToEx(DC, R.Left, R.Top, nil);
            LineTo(DC, R.Left, R.Bottom + 1);
            Inc(R1.Left);
            //.if Bold then Inc(R1.Left);
          end;
        bvLowered:
          if Bold then
          begin
            SelectObject(DC, BPen);
            MoveToEx(DC, R.Left, R.Top, nil);
            LineTo(DC, R.Left, R.Bottom);
            Inc(R1.Left);
            SelectObject(DC, SPen);
            if fsdBottom in Borders then
              I := 0
            else
              I := 1;
            MoveToEx(DC, R.Left + 1, R.Top + 1, nil);
            LineTo(DC, R.Left + 1, R.Bottom + I);
            //SetPixel(DC, R.Left, R.Bottom-1, SColor);
            Inc(R1.Left);
          end
          else
          begin
            SelectObject(DC, SPen);
            MoveToEx(DC, R.Left, R.Top, nil);
            LineTo(DC, R.Left, R.Bottom);
            Inc(R1.Left);
          end;
        bvSpace:
          begin
            SelectObject(DC, SPen);
            MoveToEx(DC, R.Left, R.Top, nil);
            LineTo(DC, R.Left, R.Bottom);
            Inc(R1.Left);
          end;
      end;
    end;
    if fsdTop in Borders then
    begin
      case Bevel of
        bvRaised:
          begin
            SelectObject(DC, LPen);
            MoveToEx(DC, R.Left, R.Top, nil);
            LineTo(DC, R.Right, R.Top);
            Inc(R1.Top);
            //.if Bold then Inc(R1.Top);
          end;
        bvLowered:
          if Bold then
          begin
            SelectObject(DC, BPen);
            MoveToEx(DC, R.Left, R.Top, nil);
            LineTo(DC, R.Right, R.Top);
            Inc(R1.Top);
            SelectObject(DC, SPen);
            MoveToEx(DC, R.Left + 1, R.Top + 1, nil);
            LineTo(DC, R.Right, R.Top + 1);
            //SetPixel(DC, R.Right-1, R.Top+1, SColor);
            Inc(R1.Top);
          end
          else
          begin
            SelectObject(DC, SPen);
            MoveToEx(DC, R.Left, R.Top, nil);
            LineTo(DC, R.Right, R.Top);
            Inc(R1.Top);
          end;
        bvSpace:
          begin
            SelectObject(DC, SPen);
            MoveToEx(DC, R.Left, R.Top, nil);
            LineTo(DC, R.Right, R.Top);
            Inc(R1.Top);
          end;
      end;
    end;
    if fsdRight in Borders then
    begin
      case Bevel of
        bvRaised:
          if Bold then
          begin
            SelectObject(DC, BPen);
            MoveToEx(DC, R.Right, R.Top, nil);
            LineTo(DC, R.Right, R.Bottom + 1);
            Dec(R1.Right);
            SelectObject(DC, SPen);
            MoveToEx(DC, R.Right - 1, R.Top + 1, nil);
            LineTo(DC, R.Right - 1, R.Bottom + 1);
            //SetPixel(DC, R.Right-1, R.Bottom-1, SColor);
            Dec(R1.Right);
          end
          else
          begin
            SelectObject(DC, SPen);
            MoveToEx(DC, R.Right, R.Top, nil);
            LineTo(DC, R.Right, R.Bottom + 1);
            Dec(R1.Right);
          end;
        bvLowered:
          begin
            SelectObject(DC, LPen);
            MoveToEx(DC, R.Right, R.Top, nil);
            LineTo(DC, R.Right, R.Bottom);
            Dec(R1.Right);
            //. if Bold then Dec(R1.Right);
          end;
        bvSpace:
          begin
            SelectObject(DC, SPen);
            MoveToEx(DC, R.Right, R.Top, nil);
            LineTo(DC, R.Right, R.Bottom);
            Dec(R1.Right);
          end;
      end;
    end;
    if fsdBottom in Borders then
    begin
      case Bevel of
        bvRaised:
          if Bold then
          begin
            SelectObject(DC, BPen);
            if fsdLeft in Borders then
              I := 1
            else
              I := 0;
            MoveToEx(DC, R.Left {+1}, R.Bottom, nil);
            LineTo(DC, R.Right, R.Bottom);
            Dec(R1.Bottom);
            SelectObject(DC, SPen);
            MoveToEx(DC, R.Left + I {+I}, R.Bottom - 1, nil);
            LineTo(DC, R.Right, R.Bottom - 1);
            //SetPixel(DC, R.Right-1+I, R.Bottom-1, SColor);
            Dec(R1.Bottom);
          end
          else
          begin
            SelectObject(DC, SPen);
            MoveToEx(DC, R.Left, R.Bottom, nil);
            LineTo(DC, R.Right, R.Bottom);
            Dec(R1.Bottom);
          end;
        bvLowered:
          begin
            SelectObject(DC, LPen);
            //    if Borders.Left then I:=1 else I:=0;
            MoveToEx(DC, R.Left, R.Bottom {-1}, nil);
            LineTo(DC, R.Right + 1, R.Bottom {-1});
            Dec(R1.Bottom);
            //. if Bold then Dec(R1.Bottom);
            //Dec(R1.Bottom);
          end;
        bvSpace:
          begin
            SelectObject(DC, SPen);
            MoveToEx(DC, R.Left, R.Bottom {-1}, nil);
            LineTo(DC, R.Right + 1, R.Bottom {-1});
            Dec(R1.Bottom);
          end;
      end;
    end;
  end;

begin
  try
    if Assigned(glGlobalData.lp3DColors) then
      with TJvg3DColors(glGlobalData.lp3DColors) do
      begin
        BColor := ColorToRGB(DkShadow);
        HColor := ColorToRGB(Highlight);
        SColor := ColorToRGB(Shadow);
      end
    else
      SetDefColors;
  except
  end;

  LPen := CreatePen(PS_SOLID, 1, HColor);
  OldPen := SelectObject(DC, LPen);
  DeleteObject(SelectObject(DC, OldPen));

  FillChar(LogOldPen, SizeOf(LogOldPen), 0);
  GetObject(OldPen, SizeOf(LogOldPen), @LogOldPen);
  if LogOldPen.lopnWidth.X = 0 then
    PenWidth := 1
  else
    PenWidth := LogOldPen.lopnWidth.X;
  BPen := CreatePen(LogOldPen.lopnStyle, PenWidth, BColor);
  LPen := CreatePen(LogOldPen.lopnStyle, PenWidth, HColor);
  SPen := CreatePen(LogOldPen.lopnStyle, PenWidth, SColor);
  SelectObject(DC, LPen);
  R1 := ARect;
  R := ARect;
  if BevelOuter <> bvNone then
    DrawBevel(BevelOuter);
  R := R1;
  //  if (BevelOuter = bvRaised)and(BevelInner = bvLowered)and Bold then
  //  begin Dec(R.Top); Dec(R.Left); end;

  if BevelInner <> bvNone then
    DrawBevel(BevelInner);

  SelectObject(DC, OldPen);
  DeleteObject(BPen);
  DeleteObject(LPen);
  DeleteObject(SPen);

  if not ATransparent then
  begin
    HBackgrBrush := CreateSolidBrush(ColorToRGB(BackgrColor));
    HOldBrush := SelectObject(DC, HBackgrBrush);
    R := R1; {Dec(R.Top);Dec(R.Left);}
    Inc(R.Right);
    Inc(R.Bottom);
    FillRect(DC, R, HBackgrBrush);
    DeleteObject(SelectObject(DC, HOldBrush));
  end;

  Result := R1;
end;

{ Draws TJvgGradient gradient }

procedure GradientBox(DC: HDC; R: TRect; Gradient: TJvgGradient; PenStyle, PenWidth: Integer);
begin
  Gradient.Draw(DC, R, PenStyle, PenWidth);
end;

{ Replaces bitmap's color }

procedure ChangeBitmapColor(Bitmap: TBitmap; FromColor, ToColor: TColor);
var
  IWidth, IHeight: Integer;
  DRect, SRect: TRect;
  MonoBMP, OldBMP: HBITMAP;
  MonoDC: HDC;
begin
  if (Bitmap.Width or Bitmap.Height) = 0 then
    Exit;
  IWidth := Bitmap.Width;
  IHeight := Bitmap.Height;
  DRect := Rect(0, 0, IWidth, IHeight);
  SRect := DRect;

  MonoDC := CreateCompatibleDC(Bitmap.Canvas.Handle);
  MonoBMP := CreateBitmap(IWidth, IHeight, 1, 1, nil);
  OldBMP := SelectObject(MonoDC, MonoBMP);

  try
    with Bitmap.Canvas do { Convert FromColor to ToColor }
    begin
      Bitmap.Canvas.Brush.Color := FromColor;
      {copy Bitmap to MonoBMP}
      BitBlt(MonoDC, 0, 0, IWidth, IHeight, Handle, 0, 0, cmSrcCopy);
      Brush.Color := ToColor;
      SetTextColor(Handle, clBlack);
      SetBkColor(Handle, clWhite);
      BitBlt(Handle, 0, 0, IWidth, IHeight, MonoDC, 0, 0, ROP_DSPDxax);
    end;
  finally
    DeleteObject(SelectObject(MonoDC, OldBMP));
    DeleteDC(MonoDC);
  end;
end;

{ Paints bitmap. Transparent, disabled, multiplied, etc }

procedure DrawBitmapExt(DC: HDC; { DC - background & result}
  SourceBitmap: TBitmap; R: TRect;
  X, Y: Integer; //...X,Y _in_ rect!
  BitmapOption: TglWallpaperOption; DrawState: TglDrawState;
  ATransparent: Boolean; TransparentColor: TColor; DisabledMaskColor: TColor);
begin