jvshapedbutton.pas

East make Tray Icon in delphi

  hRegion: HRGN;
  Poly: array [0..4] of TPoint;
  x2: Integer;
begin
  x2 := AWidth div 2;
  CalcPentagon(AWidth, AHeight);
  Poly[0] := Point(x2, 0);
  Poly[1] := Point(AWidth, FYP);
  Poly[2] := Point(AWidth - FXP, AHeight);
  Poly[3] := Point(FXP, AHeight);
  Poly[4] := Point(0, FYP);
  hRegion := CreatePolygonRgn(Poly, 5, WINDING);
  SetWindowRgn(Handle, hRegion, True);
end;

procedure TJvShapedButton.SetRegionRevPentagon(ALeft, ATop, AWidth,
  AHeight: Integer);
var
  hRegion: HRGN;
  Poly: array [0..4] of TPoint;
  x2: Integer;
begin
  x2 := AWidth div 2;
  CalcPentagon(AWidth, AHeight);
  Poly[0] := Point(FXP, 0);
  Poly[1] := Point(AWidth - FXP, 0);
  Poly[2] := Point(AWidth, AHeight - FYP);
  Poly[3] := Point(x2, AHeight);
  Poly[4] := Point(0, AHeight - FYP);

  hRegion := CreatePolygonRgn(Poly, 5, WINDING);
  SetWindowRgn(Handle, hRegion, True);
end;

procedure TJvShapedButton.SetRegionRightArrow(ALeft, ATop, AWidth,
  AHeight: Integer);
var
  hRegion: HRGN;
  Poly: array [0..5] of TPoint;
  x8, y2: Integer;
begin
  if FFlatArrow then
    x8 := Width div 16
  else
    x8 := Width div 8;
  y2 := AHeight div 2;
  Poly[0] := Point(x8, 0);
  Poly[1] := Point(AWidth, 0);
  Poly[2] := Point(AWidth - x8, y2);
  Poly[3] := Point(AWidth, AHeight);
  Poly[4] := Point(x8, AHeight);
  Poly[5] := Point(0, y2);
  hRegion := CreatePolygonRgn(Poly, 6, WINDING);
  SetWindowRgn(Handle, hRegion, True);
end;

procedure TJvShapedButton.SetRegionRing(ALeft, ATop, AWidth,
  AHeight: Integer);
var
  rgn1, rgn2, rgn3: HRGN;
  x4, y4: Integer;
begin
  x4 := AWidth div 4 ;
  y4 := AHeight div 4;
  rgn1 := CreateEllipticRgn(0, 0, AWidth+1, AHeight+1);
  rgn2 := CreateEllipticRgn(x4, y4, AWidth - x4, AHeight - x4);
  rgn3 := 0; // Remove Warning
  Combinergn(rgn3, rgn1, rgn2, RGN_XOR);
  SetWindowRgn(Handle, rgn3, True);
end;

procedure TJvShapedButton.SetRegionRound(ALeft, ATop, AWidth,
  AHeight: Integer);
var
  hRegion: HRGN;
begin
  hRegion := CreateEllipticRgn(0, 0, AWidth, AHeight);
  SetWindowRgn(Handle, hRegion, True);
end;

procedure TJvShapedButton.CalcPentagon(AWidth, AHeight: Integer);
var
  x2, y2, R: Integer;
  A: Extended;
begin
  A := Pi / 2 - (2 * Pi / 5);
  x2 := AWidth div 2;
  y2 := AHeight div 2;
  R := Round(x2 / Cos(A));
  FYP := y2 - Round(R * Sin(A));
  A := Pi - (4 * Pi / 5);
  FXP := Round(x2 - R * Sin(A));
end;

procedure TJvShapedButton.SetFlatArrow(const Value: Boolean);
begin
  if Value <> FFlatArrow then
  begin
    FFlatArrow := Value;
    SetBounds(Left, Top, Width, Height);
    Invalidate;
  end;
end;

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

  procedure SetPoly;
  begin
    w := Rect.Right - Rect.Left + 1;
    h := Rect.Bottom - Rect.Top + 1;
    if FFlatArrow then
      x8 := w div 16
    else
      x8 := w div 8;
    y2 := h div 2;
    Poly[0] := Point(Rect.Left, Rect.Top);
    Poly[1] := Point(Rect.Right - x8, Rect.Top);
    Poly[2] := Point(Rect.Right, y2);
    Poly[3] := Point(Rect.Right - x8, Rect.Bottom);
    Poly[4] := Point(0, Rect.Bottom);
    Poly[5] := Point(x8, y2);
    Poly[6] := 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[1];
      PolyBR[1] := Poly[2];
      PolyBR[2] := Poly[3];
      PolyBR[3] := Poly[4];
      Polyline(PolyBR);
      // white border (Top-Left)
      Pen.Color := clWindowFrame;
      PolyTL[0] := Poly[4];
      PolyTL[1] := Poly[5];
      PolyTL[2] := Poly[0];
      PolyTL[3] := Poly[1];
      Polyline(PolyTL);
      // gray border (Bottom-Right, internal)
      Pen.Color := clBtnShadow;
      InflateRect(Rect, -1, -1);
      SetPoly;
      PolyBR[0] := Poly[1];
      PolyBR[1] := Poly[2];
      PolyBR[2] := Poly[3];
      PolyBR[3] := Poly[4];
      Polyline(PolyBR);
    end
    else
    if not ActionFocus then
    begin
      // gray border (Bottom-Right)
      Pen.Color := clWindowFrame;
      SetPoly;
      PolyBR[0] := Poly[1];
      PolyBR[1] := Poly[2];
      PolyBR[2] := Poly[3];
      PolyBR[3] := Poly[4];
      Polyline(PolyBR);
      // white border (Top-Left)
      Pen.Color := clBtnHighlight;
      PolyTL[0] := Poly[4];
      PolyTL[1] := Poly[5];
      PolyTL[2] := Poly[0];
      PolyTL[3] := Poly[1];
      Polyline(PolyTL);
      // gray border (Bottom-Right, internal)
      Pen.Color := clBtnShadow;
      InflateRect(Rect, -1, -1);
      SetPoly;
      PolyBR[0] := Poly[1];
      PolyBR[1] := Poly[2];
      PolyBR[2] := Poly[3];
      PolyBR[3] := Poly[4];
      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.CNDrawItemRightArrow(var Msg: TWMDrawItem);
var
  OdsDown, OdsFocus, ActionFocus: Boolean;
  Rect: TRect;
  Poly: array [0..6] of TPoint;
  PolyBR: array [0..3] of TPoint;
  PolyTL: array [0..3] of TPoint;
  x8, y2, w, h: Integer;

  procedure SetPoly;
  begin
    w := Rect.Right - Rect.Left + 1;
    h := Rect.Bottom - Rect.Top + 1;
    if FFlatArrow then
      x8 := w div 16
    else
      x8 := w div 8;
    y2 := h div 2;
    Poly[0] := Point(Rect.Left + x8, Rect.Top);
    Poly[1] := Point(Rect.Right, Rect.Top);
    Poly[2] := Point(Rect.Right - x8, y2);
    Poly[3] := Point(Rect.Right, Rect.Bottom);
    Poly[4] := Point(Rect.Left + x8, Rect.Bottom);
    Poly[5] := Point(Rect.Left, y2);
    Poly[6] := 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[1];
      PolyBR[1] := Poly[2];
      PolyBR[2] := Poly[3];
      PolyBR[3] := Poly[4];
      Polyline(PolyBR);
      // white border (Top-Left)
      Pen.Color := clWindowFrame;
      PolyTL[0] := Poly[4];
      PolyTL[1] := Poly[5];
      PolyTL[2] := Poly[0];
      PolyTL[3] := Poly[1];
      Polyline(PolyTL);
      // gray border (Bottom-Right, internal)
      Pen.Color := clBtnShadow;
      InflateRect(Rect, -1, -1);
      SetPoly;
      PolyBR[0] := Poly[1];
      PolyBR[1] := Poly[2];
      PolyBR[2] := Poly[3];
      PolyBR[3] := Poly[4];
      Polyline(PolyBR);
    end
    else
    if not ActionFocus then
    begin
      // gray border (Bottom-Right)
      Pen.Color := clWindowFrame;
      SetPoly;
      PolyBR[0] := Poly[1];
      PolyBR[1] := Poly[2];
      PolyBR[2] := Poly[3];
      PolyBR[3] := Poly[4];
      Polyline(PolyBR);
      // white border (Top-Left)
      Pen.Color := clBtnHighlight;
      PolyTL[0] := Poly[4];
      PolyTL[1] := Poly[5];
      PolyTL[2] := Poly[0];
      PolyTL[3] := Poly[1];
      Polyline(PolyTL);
      // gray border (Bottom-Right, internal)
      Pen.Color := clBtnShadow;
      InflateRect(Rect, -1, -1);
      SetPoly;
      PolyBR[0] := Poly[1];
      PolyBR[1] := Poly[2];
      PolyBR[2] := Poly[3];
      PolyBR[3] := Poly[4];
      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.CNDrawItemRing(var Msg: TWMDrawItem);
var
  OdsDown, OdsFocus, ActionFocus: Boolean;
  R, Ri: TRect;
  x4, y4: Integer;
begin
  if csDestroying in ComponentState then
    Exit;
  // initialize
  x4 := (Width div 4) - 1;
  y4 := (Height div 4) - 1;
  FCanvas.Handle := Msg.DrawItemStruct^.hDC;
  R := ClientRect;
  Ri := Rect(R.Left + x4, R.Top + y4, R.Right - x4, R.Bottom - y4);
  with Msg.DrawItemStruct^ do
  begin
    OdsDown := itemState and ODS_SELECTED <> 0;
    OdsFocus := itemState and ODS_FOCUS <> 0;
    ActionFocus := ItemAction = ODA_FOCUS;
  end;

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

  with FBmp.Canvas do
  begin
    Pen.Width := 2;
    Brush.Color := Self.Color;
    if not ActionFocus then
    begin
      // fill with current Color
      Brush.Style := bsSolid;
      FillRect(R);
    end;
    Dec(R.Right);
    Dec(R.Bottom);