jvshapedbutton.pas

East make Tray Icon in delphi

    // do not fill any more
    Brush.Style := bsClear;
    // draw border if default
    if Default or OdsFocus then
    begin
      Pen.Color := clWindowFrame;
      if not ActionFocus then
      begin
        Ellipse(R.Left, R.Top, R.Right, R.Bottom);
        Ellipse(Ri.Left, Ri.Top, Ri.Right, Ri.Bottom);
      end;
      // reduce the area for further operations
      InflateRect(R, -1, -1);
      InflateRect(Ri, 1, 1);
    end;

    if OdsDown then
    begin
      // draw gray border all around
      Pen.Color := clBtnShadow;
      if not ActionFocus then
      begin
        Ellipse(R.Left, R.Top, R.Right, R.Bottom);
        Ellipse(Ri.Left, Ri.Top, Ri.Right, Ri.Bottom);
      end;
      // white border (Bottom-Right)
      Pen.Color := clBtnHighlight;
      Arc(R.Left, R.Top, R.Right, R.Bottom, // ellipse
        R.Left, R.Bottom, // start
        R.Right, R.Top); // end
      Pen.Color := clBtnShadow;
      Arc(Ri.Left, Ri.Top, Ri.Right, Ri.Bottom, // ellipse
        R.Left, R.Bottom, // start
        R.Right, R.Top); // end

      // gray border (Top-Left)
      Pen.Color := clBtnShadow;
      Arc(R.Left, R.Top, R.Right, R.Bottom, // ellipse
        R.Right, R.Top, // start
        R.Left, R.Bottom); // end
      Pen.Color := clBtnHighlight;
      Arc(Ri.Left, Ri.Top, Ri.Right, Ri.Bottom, // ellipse
        R.Right, R.Top, // start
        R.Left, R.Bottom); // end

      // gray border (Top-Left, internal)
      Pen.Color := clBtnShadow;
      InflateRect(R, -1, -1);
      InflateRect(Ri, 1, 1);
      //      Arc (Rect.Left, Rect.Top, Rect.Right, Rect.Bottom, // ellipse
      //        Rect.Right, Rect.Top, // start
      //        Rect.Left, Rect.Bottom); // end
    end
    else
    if not ActionFocus then
    begin
      // gray border (Bottom-Right)
      Pen.Color := clWindowFrame;
      Arc(R.Left, R.Top, R.Right, R.Bottom, // ellipse
        R.Left, R.Bottom, // start
        R.Right, R.Top); // end
      Pen.Color := clBtnHighlight;
      Arc(Ri.Left, Ri.Top, Ri.Right, Ri.Bottom, // ellipse
        R.Left, R.Bottom, // start
        R.Right, R.Top); // end

      // white border (Top-Left)
      Pen.Color := clBtnHighlight;
      Arc(R.Left, R.Top, R.Right, R.Bottom, // ellipse
        R.Right, R.Top, // start
        R.Left, R.Bottom); // end
      Pen.Color := clBtnShadow;
      Arc(Ri.Left, Ri.Top, Ri.Right, Ri.Bottom, // ellipse
        R.Right, R.Top, // start
        R.Left, R.Bottom); // end

      // gray border (Bottom-Right, internal)
      Pen.Color := clBtnShadow;
      InflateRect(R, -1, -1);
      InflateRect(Ri, 1, 1);
      Arc(R.Left, R.Top, R.Right, R.Bottom, // ellipse
        R.Left, R.Bottom, // start
        R.Right, R.Top); // end
      Pen.Color := clBtnHighlight;
      Arc(Ri.Left, Ri.Top, Ri.Right, Ri.Bottom, // ellipse
        R.Left, R.Bottom, // start
        R.Right, R.Top); // end

    end;
    // smooth edges
    DoAntiAlias(FBmp);
    // draw the caption
{    InflateRect (Rect, - Width div 5, - Height div 5);
    if OdsDown then
    begin
      Inc (Rect.Left, 2);
      Inc (Rect.Top, 2);
    end;
    Font := Self.Font;
    if not ActionFocus then
      DrawText(FBmp.Canvas, Caption, -1,
        Rect, DT_SINGLELINE or DT_CENTER or DT_VCENTER);

    // draw the focus Rect around the text
    Brush.Style := bsSolid;
    Pen.Color:= clBlack;
    Brush.Color := clWhite;
    if FIsFocused or OdsFocus or ActionFocus then
      DrawFocusRect (Rect);}
  end;
  FBmp.Transparent := True;
  FBmp.TransparentColor := Self.Color;
  FCanvas.Draw(0, 0, FBmp);
  FCanvas.Handle := 0;
  Msg.Result := 1; // message handled
end;

procedure TJvShapedButton.CNDrawItemRound(var Msg: TWMDrawItem);
var
  OdsDown, OdsFocus, ActionFocus: Boolean;
  Rect: TRect;
begin
  if csDestroying in ComponentState then
    Exit;
  // initialize
  FCanvas.Handle := Msg.DrawItemStruct^.hDC;
  Rect := ClientRect;
  Dec(Rect.Right);
  Dec(Rect.Bottom);
  with Msg.DrawItemStruct^ do
  begin
    OdsDown := itemState and ODS_SELECTED <> 0;
    OdsFocus := itemState and ODS_FOCUS <> 0;
    ActionFocus := ItemAction = ODA_FOCUS;
  end;

  FBmp.Width := Width;
  FBmp.Height := Height;
  FBmp.PixelFormat := pf24bit;

  with FBmp.Canvas do
  begin
    Pen.Width := 2;
    Brush.Color := Color;
    if not ActionFocus then
    begin
      // fill with current Color
      Brush.Style := bsSolid;
      FillRect(Rect);
    end;
    // do not fill any more
    Brush.Style := bsClear;
    // draw border if default
    if Default or OdsFocus then
    begin
      Pen.Color := clWindowFrame;
      if not ActionFocus then
        Ellipse(Rect.Left, Rect.Top,
          Rect.Right, Rect.Bottom);
      // reduce the area for further operations
      InflateRect(Rect, -1, -1);
    end;

    if OdsDown then
    begin
      // draw gray border all around
      Pen.Color := clBtnShadow;
      if not ActionFocus then
        Ellipse(Rect.Left, Rect.Top, Rect.Right, Rect.Bottom);
      // white border (Bottom-Right)
      Pen.Color := clBtnHighlight;
      Arc(Rect.Left, Rect.Top, Rect.Right, Rect.Bottom, // ellipse
        Rect.Left, Rect.Bottom, // start
        Rect.Right, Rect.Top); // end
      // gray border (Top-Left)
      Pen.Color := clBtnShadow;
      Arc(Rect.Left, Rect.Top, Rect.Right, Rect.Bottom, // ellipse
        Rect.Right, Rect.Top, // start
        Rect.Left, Rect.Bottom); // end
      // gray border (Top-Left, internal)
      Pen.Color := clBtnShadow;
      InflateRect(Rect, -1, -1);
      //      Arc (Rect.Left, Rect.Top, Rect.Right, Rect.Bottom, // ellipse
      //        Rect.Right, Rect.Top, // start
      //        Rect.Left, Rect.Bottom); // end
    end
    else
    if not ActionFocus then
    begin
      // gray border (Bottom-Right)
      Pen.Color := clWindowFrame;
      Arc(Rect.Left, Rect.Top, Rect.Right, Rect.Bottom, // ellipse
        Rect.Left, Rect.Bottom, // start
        Rect.Right, Rect.Top); // end
      // white border (Top-Left)
      Pen.Color := clBtnHighlight;
      Arc(Rect.Left, Rect.Top, Rect.Right, Rect.Bottom, // ellipse
        Rect.Right, Rect.Top, // start
        Rect.Left, Rect.Bottom); // end
      // gray border (Bottom-Right, internal)
      Pen.Color := clBtnShadow;
      InflateRect(Rect, -1, -1);
      Arc(Rect.Left, Rect.Top, Rect.Right, Rect.Bottom, // ellipse
        Rect.Left, Rect.Bottom, // start
        Rect.Right, Rect.Top); // end
    end;
    // smooth edges
    DoAntiAlias(FBmp);
    // draw the caption
    InflateRect(Rect, -Width div 5, -Height div 5);
    if OdsDown then
    begin
      Inc(Rect.Left, 2);
      Inc(Rect.Top, 2);
    end;
    Font := Self.Font;
    if not ActionFocus then
      DrawText(FBmp.Canvas, Caption, -1,
        Rect, DT_SINGLELINE or DT_CENTER or DT_VCENTER);

    // draw the focus Rect around the text
    Brush.Style := bsSolid;
    Pen.Color := clBlack;
    Brush.Color := clWhite;
    if FIsFocused or OdsFocus or ActionFocus then
      DrawFocusRect(Rect);
  end;
  FCanvas.Draw(0, 0, FBmp);
  FCanvas.Handle := 0;
  Msg.Result := 1; // message handled
end;

procedure TJvShapedButton.CNDrawItemPentagon(var Msg: TWMDrawItem);
var
  OdsDown, OdsFocus, ActionFocus: Boolean;
  Rect: TRect;
  Poly: array [0..5] of TPoint;
  PolyBR: array [0..3] of TPoint;
  PolyTL: array [0..2] of TPoint;
  x2, y2, w, h: Integer;

  procedure SetPoly;
  begin
    w := Rect.Right - Rect.Left + 1;
    h := Rect.Bottom - Rect.Top + 1;
    x2 := w div 2;
    y2 := h div 2;
    Poly[0] := Point(Rect.Left + x2, Rect.Top);
    Poly[1] := Point(Rect.Right, Rect.Top + FYP);
    Poly[2] := Point(Rect.Right - FXP, Rect.Bottom);
    Poly[3] := Point(Rect.Left + FXP, Rect.Bottom);
    Poly[4] := Point(Rect.Left, Rect.Top + FYP);
    Poly[5] := Poly[0];
  end;

begin
  if csDestroying in ComponentState then
    Exit;
  // initialize
  FCanvas.Handle := Msg.DrawItemStruct^.hDC;
  Rect := ClientRect;
  Dec(Rect.Right);
  Dec(Rect.Bottom);
  SetPoly;
  with Msg.DrawItemStruct^ do
  begin
    OdsDown := itemState and ODS_SELECTED <> 0;
    OdsFocus := itemState and ODS_FOCUS <> 0;
    ActionFocus := ItemAction = ODA_FOCUS;
  end;
  FBmp.Width := Width;
  FBmp.Height := Height;

  with FBmp.Canvas do
  begin
    Pen.Width := 2;
    Brush.Color := Color;
    if not ActionFocus then
    begin
      // fill with current Color
      Brush.Style := bsSolid;
      FillRect(Rect);
    end;
    // do not fill any more
    Brush.Style := bsClear;
    // draw border if default

{    if Default or OdsFocus then
    begin
      Pen.Color := clWindowFrame;
      if not ActionFocus then
        Polyline(Poly);
      // reduce the area for further operations
      InflateRect (Rect, -1, -1);
    end;}
    // test code:
    //InflateRect (Rect, -1, -1);

    if FFlat and (not OdsDown) and (not FIsHot) and (not (csDesigning in ComponentState)) then
    begin
      Pen.Color := FFlatBorderColor;
      Polyline(Poly);
    end
    else
    if OdsDown then
    begin
      // draw gray border all around
      Pen.Color := clBtnShadow;
      if not ActionFocus then
        Polyline(Poly);
      // gray border (Bottom-Right)
      Pen.Color := clBtnHighlight;
      SetPoly;
      PolyBR[0] := Poly[0];
      PolyBR[1] := Poly[1];
      PolyBR[2] := Poly[2];
      PolyBR[3] := Poly[3];
      Polyline(PolyBR);
      // white border (Top-Left)
      Pen.Color := clWindowFrame;
      PolyTL[0] := Poly[3];
      PolyTL[1] := Poly[4];
      PolyTL[2] := Poly[0];
      Polyline(PolyTL);
      // gray border (Bottom-Right, internal)
      Pen.Color := clBtnShadow;
      InflateRect(Rect, -1, -1);
      SetPoly;
      PolyBR[0] := Poly[0];
      PolyBR[1] := Poly[1];
      PolyBR[2] := Poly[2];
      PolyBR[3] := Poly[3];
      Polyline(PolyBR);
    end
    else
    if not ActionFocus then
    begin
      // gray border (Bottom-Right)
      Pen.Color := clWindowFrame;
      SetPoly;
      PolyBR[0] := Poly[0];
      PolyBR[1] := Poly[1];
      PolyBR[2] := Poly[2];
      PolyBR[3] := Poly[3];
      Polyline(PolyBR);
      // white border (Top-Left)
      Pen.Color := clBtnHighlight;
      PolyTL[0] := Poly[3];
      PolyTL[1] := Poly[4];
      PolyTL[2] := Poly[0];
      Polyline(PolyTL);
      // gray border (Bottom-Right, internal)
      Pen.Color := clBtnShadow;
      InflateRect(Rect, -1, -1);
      SetPoly;
      PolyBR[0] := Poly[0];
      PolyBR[1] := Poly[1];
      PolyBR[2] := Poly[2];
      PolyBR[3] := Poly[3];
      Polyline(PolyBR);
    end;
    // smooth edges
    DoAntiAlias(FBmp);
    // draw the caption
    InflateRect(Rect, -Width div 5, -Height div 5);
    if OdsDown then
    begin
      Inc(Rect.Left, 2);
      Inc(Rect.Top, 2);
    end;
    Font := Self.Font;
    if FIsHot and not OdsDown then
      Font.Color := FHotColor;
    if not ActionFocus then
      DrawText(FBmp.Canvas, Caption, -1,
        Rect, DT_SINGLELINE or DT_CENTER or DT_VCENTER);

    // draw the focus Rect around the text
    Brush.Style := bsSolid;
    Pen.Color := clBlack;
    Brush.Color := clWhite;
    if FIsFocused or OdsFocus or ActionFocus then
      DrawFocusRect(Rect);
  end;
  FCanvas.Draw(0, 0, FBmp);
  FCanvas.Handle := 0;
  Msg.Result := 1; // message handled
end;

procedure TJvShapedButton.CNDrawItemRevPentagon(var Msg: TWMDrawItem);
var
  OdsDown, OdsFocus, ActionFocus: Boolean;
  Rect: TRect;
  Poly: array [0..5] of TPoint;
  PolyBR: array [0..2] of TPoint;
  PolyTL: array [0..3] of TPoint;
  x2, y2, w, h: Integer;

  procedure SetPoly;
  begin
    w := Rect.Right - Rect.Left + 1;
    h := Rect.Bottom - Rect.Top + 1;
    x2 := w div 2;
    y2 := h div 2;
    Poly[0] := Point(Rect.Left + FXP, Rect.Top);
    Poly[1] := Point(Rect.Right - FXP, Rect.Top);
    Poly[2] := Point(Rect.Right, Rect.Bottom - FYP);
    Poly[3] := Point(Rect.Left + x2, Rect.Bottom);
    Poly[4] := Point(Rect.Left, Rect.Bottom - FYP);
    Poly[5] := Poly[0];
  end;

begin
  if csDestroying in ComponentState then
    Exit;
  // initialize
  FCanvas.Handle := Msg.DrawItemStruct^.hDC;
  Rect := ClientRect;
  Dec(Rect.Right);
  Dec(Rect.Bottom);
  SetPoly;
  with Msg.DrawItemStruct^ do
  begin
    OdsDown := itemState and ODS_SELECTED <> 0;
    OdsFocus := itemState and ODS_FOCUS <> 0;
    ActionFocus := ItemAction = ODA_FOCUS;
  end;
  FBmp.Width := Width;
  FBmp.Height := Height;
  with FBmp.Canvas do
  begin
    Pen.Width := 2;
    Brush.Color := Color;
    if not ActionFocus then
    begin
      // fill with current Color
      Brush.Style := bsSolid;
      FillRect(Rect);
    end;
    // do not fill any more
    Brush.Style := bsClear;
    // draw border if default

{    if Default or OdsFocus then
    begin
      Pen.Color := clWindowFrame;
      if not ActionFocus then
        Polyline(Poly);
      // reduce the area for further operations
      InflateRect (Rect, -1, -1);
    end;}
    // test code:
    //InflateRect (Rect, -1, -1);

    if FFlat and (not OdsDown) and (not FIsHot) and (not (csDesigning in ComponentState)) then
    begin
      Pen.Color := FFlatBorderColor;
      Polyline(Poly);
    end
    else
    if OdsDown then
    begin
      // draw gray border all a