jvgholeshape.pas

East make Tray Icon in delphi

  H, W, xOffs, yOffs: Integer;
  R: TRect;
  BmpInfo: Windows.TBitmap;
  BorderStyle: TFormBorderStyle;

  procedure CalcShape(Bevel: TPanelBevel; ABold: Boolean);
  var
    I: Integer;
  begin
    I := Integer(ABold);
    case Bevel of
      bvLowered:
        begin
          InflateRect(R, -1, -1);
          Inc(R.Left, I);
          Inc(R.Top, I);
        end;
      bvRaised:
        begin
          InflateRect(R, -1, -1);
          Dec(R.Right, I);
          Dec(R.Bottom, I);
        end;
    end;
  end;

  procedure CalcBmpRgn(var Rgn: HRGN);
  var
    I, J: Integer;
    Rgn2: HRGN;
    TransparentColor: TColor;
  begin
    TransparentColor := FShapeBitmap.Canvas.Pixels[0, FShapeBitmap.Height - 1];
    for J := 0 to FShapeBitmap.Height do
      for I := 0 to FShapeBitmap.Width do
        if FShapeBitmap.Canvas.Pixels[I, J] = TransparentColor then
        begin
          Rgn2 := CreateRectRgn(I, J, I + 1, J + 1);
          CombineRgn(Rgn, Rgn2, Rgn, RGN_OR);
          DeleteObject(Rgn2);
        end;
  end;

begin
  if not FShapeBitmap.Empty then
  begin
    {if FNeedRebuildBitmapShape then}
    with FShapeBitmap do
    begin
      GetObject(FShapeBitmap.Handle, SizeOf(Windows.TBitmap), @BmpInfo);
      DeleteObject(RGNOuter);
      DeleteObject(RGNInner);
      RGNInner := CreateRectRgn(0, 0, 0, 0);
      CalcBmpRgn(FRGNInner);
      FNeedRebuildBitmapShape := False;
    end;
  end
  else
  begin
    case FShape of
      stRectangle, stRoundRect, stEllipse:
        begin
          H := Height;
          W := Width;
        end
    else
      H := Min(Height, Width);
      W := H;
    end;
    R := Bounds(0, 0, W, H);
    DeleteObject(RGNOuter);
    DeleteObject(RGNInner);

    if FBevelOffset <> 0 then
    begin
      CalcShape(FBevelOuter, FBevelOuterBold);
      OffsetRect(R, 1, 1);
    end;
    case FShape of
      stRectangle, stSquare:
        RGNOuter := CreateRectRgn(R.Left, R.Top, R.Right, R.Bottom);
      stRoundRect, stRoundSquare:
        RGNOuter := CreateRoundRectRgn(R.Left, R.Top, R.Right, R.Bottom,
          FRectEllipse.X, FRectEllipse.Y);
      stEllipse, stCircle:
        RGNOuter := CreateEllipticRgn(R.Left, R.Top, R.Right, R.Bottom);
    end;
    if FBevelOffset = 0 then
      CalcShape(FBevelOuter, FBevelOuterBold);
    InflateRect(R, -FBevelOffset, -FBevelOffset);
    if FBevelOffset = 0 then
      CalcShape(FBevelInner, FBevelInnerBold)
    else
      OffsetRect(R, -1, -1);
    case FShape of
      stRectangle, stSquare:
        RGNInner := CreateRectRgn(R.Left + 1, R.Top + 1, R.Right + 1,
          R.Bottom + 1);
      stRoundRect, stRoundSquare:
        RGNInner := CreateRoundRectRgn(R.Left + 1, R.Top + 1, R.Right + 2,
          R.Bottom + 2, FRectEllipse.X, FRectEllipse.Y);
      stEllipse, stCircle:
        RGNInner := CreateEllipticRgn(R.Left + 1, R.Top + 1, R.Right + 2,
          R.Bottom + 2);
    end;
  end;

  { calc offsets }
  if Owner is TForm then
  begin
    if csDesigning in ComponentState then
      BorderStyle := bsSizeable
    else
      BorderStyle := TForm(Owner).BorderStyle;
    case BorderStyle of
      bsSizeable:
        begin
          xOffs := GetSystemMetrics(SM_CXFRAME) - 1;
          yOffs := GetSystemMetrics(SM_CYFRAME) - 1;
          Inc(yOffs, GetSystemMetrics(SM_CYCAPTION));
        end;
      bsDialog:
        begin
          xOffs := GetSystemMetrics(SM_CXDLGFRAME) - 1;
          yOffs := GetSystemMetrics(SM_CYDLGFRAME) - 1;
          Inc(yOffs, GetSystemMetrics(SM_CYCAPTION));
        end;
      bsSingle:
        begin
          xOffs := GetSystemMetrics(SM_CXBORDER);
          yOffs := GetSystemMetrics(SM_CYBORDER);
          Inc(yOffs, GetSystemMetrics(SM_CYCAPTION));
        end;
      bsToolWindow:
        begin
          xOffs := GetSystemMetrics(SM_CXBORDER);
          yOffs := GetSystemMetrics(SM_CYBORDER);
          Inc(yOffs, GetSystemMetrics(SM_CYSMCAPTION));
        end;
      bsSizeToolWin:
        begin
          xOffs := GetSystemMetrics(SM_CXSIZEFRAME);
          yOffs := GetSystemMetrics(SM_CYSIZEFRAME);
          Inc(yOffs, GetSystemMetrics(SM_CYSMCAPTION));
        end;
    else
      begin
        xOffs := -1;
        yOffs := -1;
      end;
    end;

    OffsetRgn(RGNInner, Left + xOffs, Top + yOffs);
    OffsetRgn(RGNOuter, Left + xOffs, Top + yOffs);
  end;
end;

//...set all enabled/disabled in design time

procedure TJvgHoleShape.SayAllDTEnabledState(EnabledDT: Boolean);
var
  I: Integer;
begin
  for I := 0 to TWinControl(Owner).ControlCount - 1 do
    with TWinControl(Owner) do
      if Controls[I] is TJvgHoleShape then
        TJvgHoleShape(Controls[I]).FEnabledAllInDesignTime := EnabledDT;
end;

procedure TJvgHoleShape.UpdateRGN;
const
  cCombMode: array [0..4] of Integer =
    (RGN_AND, RGN_COPY, RGN_DIFF, RGN_OR, RGN_XOR);
var
  I: Integer;
  NewRGN: HRGN;
begin
  if not (Owner is TWinControl) then
    Exit;
  NewRGN := CreateRectRgn(0, 0, 2000, 1000);

  for I := 0 to TWinControl(Owner).ControlCount - 1 do
    with TWinControl(Owner) do
      if Controls[I] is TJvgHoleShape then
        with TJvgHoleShape(Controls[I]) do
          if ((csDesigning in ComponentState) and FEnabledAllInDesignTime) or
            ((not (csDesigning in ComponentState)) and FEnabled) then
          begin
            CalcRGNs;
            CombineRgn(NewRGN, NewRGN, RGNInner, cCombMode[Integer(FCombineMode)]);
          end;

  SetWindowRgn(TWinControl(Owner).Handle, NewRGN, True);
  FNeedUpdateRgn := False;
end;

procedure TJvgHoleShape.InternalUpdate;
begin
  if not (csLoading in ComponentState) then
  begin
    UpdateRGN;
    Refresh;
  end;
end;

procedure TJvgHoleShape.SmthChanged(Sender: TObject);
begin
  InternalUpdate;
end;

procedure TJvgHoleShape.SetEnabled(Value: Boolean);
begin
  if (FEnabled <> Value) and (Owner is TWinControl) then
  begin
    FEnabled := Value;
    InternalUpdate;
  end;
end;

procedure TJvgHoleShape.SetEnabledAllInDesignTime(Value: Boolean);
begin
  if (FEnabledAllInDesignTime <> Value) and (Owner is TWinControl) then
  begin
    FEnabledAllInDesignTime := Value;
    SayAllDTEnabledState(FEnabledAllInDesignTime);
    InternalUpdate;
  end;
end;

procedure TJvgHoleShape.SetShape(Value: THoleShapeType);
begin
  if FShape <> Value then
  begin
    FShape := Value;
    InternalUpdate;
  end;
end;

procedure TJvgHoleShape.SetShapeBitmap(Value: TBitmap);
begin
  if FShapeBitmap <> Value then
  begin
    FNeedRebuildBitmapShape := True;
    FShapeBitmap.Assign(Value);
    if Assigned(FShapeBitmap) then
    begin
      Width := FShapeBitmap.Width;
      Height := FShapeBitmap.Width;
    end;
    InternalUpdate;
  end;
end;

procedure TJvgHoleShape.SetBevelInner(Value: TPanelBevel);
begin
  if FBevelInner <> Value then
  begin
    FBevelInner := Value;
    InternalUpdate;
  end;
end;

procedure TJvgHoleShape.SetBevelOuter(Value: TPanelBevel);
begin
  if FBevelOuter <> Value then
  begin
    FBevelOuter := Value;
    InternalUpdate;
  end;
end;

procedure TJvgHoleShape.SetBevelInnerBold(Value: Boolean);
begin
  if FBevelInnerBold <> Value then
  begin
    FBevelInnerBold := Value;
    InternalUpdate;
  end;
end;

procedure TJvgHoleShape.SetBevelOuterBold(Value: Boolean);
begin
  if FBevelOuterBold <> Value then
  begin
    FBevelOuterBold := Value;
    InternalUpdate;
  end;
end;

procedure TJvgHoleShape.SetCombineMode(Value: TRGNCombineMode);
begin
  if FCombineMode <> Value then
  begin
    FCombineMode := Value;
    InternalUpdate;
  end;
end;

procedure TJvgHoleShape.SetBevelOffset(Value: Integer);
begin
  if (FBevelOffset <> Value) and (Value >= 0) then
  begin
    if (Value > Width - 2) or (Value > Height - 2) then
      Value := Min(Width, Height) - 2;
    FBevelOffset := Value;
    InternalUpdate;
  end;
end;

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

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

end.