jvshapedbutton.pas

East make Tray Icon in delphi

      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];
      Polyline(PolyBR);
      // white border (Top-Left)
      Pen.Color := clWindowFrame;
      PolyTL[0] := Poly[2];
      PolyTL[1] := Poly[0];
      PolyTL[2] := 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];
      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];
      Polyline(PolyBR);
      // white border (Top-Left)
      Pen.Color := clBtnHighlight;
      PolyTL[0] := Poly[2];
      PolyTL[1] := Poly[0];
      PolyTL[2] := 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];
      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.CNDrawItemTriangleDown(var Msg: TWMDrawItem);
var
  OdsDown, OdsFocus, ActionFocus: Boolean;
  Rect: TRect;
  Poly: array [0..3] of TPoint;
  PolyBR: array [0..1] 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, Rect.Top);
    Poly[1] := Point(Rect.Right, Rect.Top);
    Poly[2] := Point(Rect.Left + x2, Rect.Bottom);
    Poly[3] := 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];
      Polyline(PolyBR);
      // white border (Top-Left)
      Pen.Color := clWindowFrame;
      PolyTL[0] := Poly[2];
      PolyTL[1] := Poly[0];
      PolyTL[2] := 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];
      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];
      Polyline(PolyBR);
      // white border (Top-Left)
      Pen.Color := clBtnHighlight;
      PolyTL[0] := Poly[2];
      PolyTL[1] := Poly[0];
      PolyTL[2] := 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];
      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.CNDrawItemPar(var Msg: TWMDrawItem);
var
  OdsDown, OdsFocus, ActionFocus: Boolean;
  Rect: TRect;
  Poly: array [0..4] of TPoint;
  PolyBR: array [0..2] of TPoint;
  PolyTL: array [0..2] of TPoint;
  x4, y2, w, h: Integer;

  procedure SetPoly;
  begin
    w := Rect.Right - Rect.Left + 1;
    h := Rect.Bottom - Rect.Top + 1;
    x4 := w div 4;
    y2 := h div 2;
    Poly[0] := Point(Rect.Left + x4, Rect.Top);
    Poly[1] := Point(Rect.Right, Rect.Top);
    Poly[2] := Point(Rect.Right - x4, Rect.Bottom);
    Poly[3] := Point(Rect.Left, Rect.Bottom);
    Poly[4] := 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];
      Polyline(PolyBR);
      // white border (Top-Left)
      Pen.Color := clWindowFrame;
      PolyTL[0] := Poly[3];
      PolyTL[1] := Poly[0];
      PolyTL[2] := 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];
      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];
      Polyline(PolyBR);
      // white border (Top-Left)
      Pen.Color := clBtnHighlight;
      PolyTL[0] := Poly[3];
      PolyTL[1] := Poly[0];
      PolyTL[2] := 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];
      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.SetRegionPar(ALeft, ATop, AWidth, AHeight: Integer);
var
  hRegion: HRGN;
  Poly: array [0..3] of TPoint;
  x4: Integer;
begin
  x4 := Width div 4;
  //  y2:=AHeight div 2;
  Poly[0] := Point(x4, 0);
  Poly[1] := Point(AWidth, 0);
  Poly[2] := Point(AWidth - x4, AHeight);
  Poly[3] := Point(0, AHeight);
  hRegion := CreatePolygonRgn(Poly, 4, WINDING);
  SetWindowRgn(Handle, hRegion, True);
end;

procedure TJvShapedButton.SetRegionDiamond(ALeft, ATop, AWidth,
  AHeight: Integer);
var
  hRegion: HRGN;
  Poly: array [0..3] of TPoint;
  x2, y2: Integer;
begin
  x2 := AWidth div 2;
  y2 := AHeight div 2;
  Poly[0] := Point(x2, 0);
  Poly[1] := Point(AWidth, y2);
  Poly[2] := Point(x2, AHeight);
  Poly[3] := Point(0, y2);
  hRegion := CreatePolygonRgn(Poly, 4, WINDING);
  SetWindowRgn(Handle, hRegion, True);
end;

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

procedure TJvShapedButton.SetRegionLeftArrow(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(0, 0);
  Poly[1] := Point(AWidth - x8, 0);
  Poly[2] := Point(AWidth, y2);
  Poly[3] := Point(AWidth - x8, AHeight);
  Poly[4] := Point(0, AHeight);
  Poly[5] := Point(x8, y2);
  hRegion := CreatePolygonRgn(Poly, 6, WINDING);
  SetWindowRgn(Handle, hRegion, True);
end;

procedure TJvShapedButton.SetRegionPentagon(ALeft, ATop, AWidth,
  AHeight: Integer);
var