⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 jvgholeshape.pas

📁 East make Tray Icon in delphi
💻 PAS
📖 第 1 页 / 共 2 页
字号:
{-----------------------------------------------------------------------------
The contents of this file are subject to the Mozilla Public License
Version 1.1 (the "License"); you may not use this file except in compliance
with the License. You may obtain a copy of the License at
http://www.mozilla.org/MPL/MPL-1.1.html

Software distributed under the License is distributed on an "AS IS" basis,
WITHOUT WARRANTY OF ANY KIND, either expressed or implied. See the License for
the specific language governing rights and limitations under the License.

The Original Code is: JvgHoleShape.PAS, released on 2003-01-15.

The Initial Developer of the Original Code is Andrey V. Chudin,  [chudin att yandex dott ru]
Portions created by Andrey V. Chudin are Copyright (C) 2003 Andrey V. Chudin.
All Rights Reserved.

Contributor(s):
Michael Beck [mbeck att bigfoot dott com].

You may retrieve the latest version of this file at the Project JEDI's JVCL home page,
located at http://jvcl.sourceforge.net

Known Issues:
-----------------------------------------------------------------------------}
// $Id: JvgHoleShape.pas,v 1.18 2005/02/17 10:21:20 marquardt Exp $

unit JvgHoleShape;

{$I jvcl.inc}

interface

uses
  {$IFDEF USEJVCL}
  {$IFDEF UNITVERSIONING}
  JclUnitVersioning,
  {$ENDIF UNITVERSIONING}
  {$ENDIF USEJVCL}
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms,
  Dialogs, ExtCtrls,
  {$IFDEF USEJVCL}
  JvComponent,
  {$ENDIF USEJVCL}
  JvgTypes, JvgCommClasses;

type
  TRGNCombineMode = (cmAND, cmCOPY, cmDIFF, cmOR, cmXOR);
  THoleShapeType = (stRectangle, stSquare, stRoundRect, stRoundSquare,
    stEllipse, stCircle);

  {$IFDEF USEJVCL}
  TJvgHoleShape = class(TJvGraphicControl)
  {$ELSE}
  TJvgHoleShape = class(TGraphicControl)
  {$ENDIF USEJVCL}
  private
    FCombineMode: TRGNCombineMode;
    FEnabledAllInDesignTime: Boolean;
    FEnabled: Boolean;
    FShape: THoleShapeType;
    FShapeBitmap: TBitmap;
    FBevelInner: TPanelBevel;
    FBevelOuter: TPanelBevel;
    FBevelInnerBold: Boolean;
    FBevelOuterBold: Boolean;
    FRectEllipse: TJvgPointClass;
    FBevelOffset: Integer;
    FNeedUpdateRgn: Boolean;
    FNeedRebuildBitmapShape: Boolean;
    FRGNInner: HRGN;
    FRGNOuter: HRGN;
    FOldX: Integer;
    FOldY: Integer;
    FOldW: Integer;
    FOldH: Integer;
    procedure SetEnabledAllInDesignTime(Value: Boolean);
    procedure SetShape(Value: THoleShapeType);
    procedure SetShapeBitmap(Value: TBitmap);
    procedure SetBevelInner(Value: TPanelBevel);
    procedure SetBevelOuter(Value: TPanelBevel);
    procedure SetBevelInnerBold(Value: Boolean);
    procedure SetBevelOuterBold(Value: Boolean);
    procedure SetCombineMode(Value: TRGNCombineMode);
    procedure SetBevelOffset(Value: Integer);
    procedure InternalUpdate;
    procedure CalcRGNs;
    procedure SmthChanged(Sender: TObject);
    procedure SayAllDTEnabledState(EnabledDT: Boolean);
  protected
    procedure SetEnabled(Value: Boolean); override;
    procedure Paint; override;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure UpdateRGN;
    procedure Loaded; override;
    property RGNInner: HRGN read FRGNInner write FRGNInner;
    property RGNOuter: HRGN read FRGNOuter write FRGNOuter;
  published
    property Enabled: Boolean read FEnabled write SetEnabled default True;
    property EnabledAllInDesignTime: Boolean read FEnabledAllInDesignTime
      write SetEnabledAllInDesignTime default True;
    property Shape: THoleShapeType read FShape write SetShape default stEllipse;
    property BevelInner: TPanelBevel read FBevelInner write SetBevelInner default bvNone;
    property BevelOuter: TPanelBevel read FBevelOuter write SetBevelOuter default bvLowered;
    property BevelInnerBold: Boolean read FBevelInnerBold write SetBevelInnerBold default True;
    property BevelOuterBold: Boolean read FBevelOuterBold write SetBevelOuterBold default True;
    property CombineMode: TRGNCombineMode read FCombineMode write SetCombineMode default cmDIFF;
    property BevelOffset: Integer read FBevelOffset write SetBevelOffset default 0;
    property RectEllipse: TJvgPointClass read FRectEllipse write FRectEllipse;
    property ShapeBitmap: TBitmap read FShapeBitmap write SetShapeBitmap;
    property Align;
    property ShowHint;
    property ParentShowHint;
    property PopupMenu;
    // property Visible;
  end;

{$IFDEF USEJVCL}
{$IFDEF UNITVERSIONING}
const
  UnitVersioning: TUnitVersionInfo = (
    RCSfile: '$RCSfile: JvgHoleShape.pas,v $';
    Revision: '$Revision: 1.18 $';
    Date: '$Date: 2005/02/17 10:21:20 $';
    LogPath: 'JVCL\run'
  );
{$ENDIF UNITVERSIONING}
{$ENDIF USEJVCL}

implementation

uses
  Math,
  JvgUtils;

constructor TJvgHoleShape.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FShapeBitmap := TBitmap.Create;
  FEnabled := (Owner is TWinControl);

  ControlStyle := ControlStyle - [csOpaque];
  FEnabledAllInDesignTime := FEnabled;
  FRectEllipse := TJvgPointClass.Create;
  FRectEllipse.X := 30;
  FRectEllipse.Y := 30;
  FRectEllipse.OnChanged := SmthChanged;
  FShape := stEllipse;
  FBevelOuter := bvLowered;
  FBevelInner := bvNone;
  FCombineMode := cmDIFF;
  FBevelInnerBold := True;
  FBevelOuterBold := True;
  FRectEllipse.Y := 45;
  FRectEllipse.X := 45;
  FBevelOffset := 0;
  Width := 112;
  Height := 112;
  FNeedUpdateRgn := False;
end;

destructor TJvgHoleShape.Destroy;
begin
  FShapeBitmap.Free;
  FRectEllipse.Free;
  if not (csDestroying in Owner.ComponentState) then
  begin
    FEnabledAllInDesignTime := False;
    FEnabled := False;
    UpdateRGN;
  end;
  inherited Destroy;
end;

procedure TJvgHoleShape.Loaded;
begin
  inherited Loaded;
  FNeedRebuildBitmapShape := True;
  UpdateRGN;
  Refresh;
end;

procedure TJvgHoleShape.Paint;
var
  R: TRect;
  H, W, EH, EW, I: Integer;

  procedure DrawShape(Bevel: TPanelBevel; ABold, ARect: Boolean);

    procedure SetPenAndBrush(C: TColor);
    begin
      Canvas.Pen.Color := C;
      if ARect and ((EW and EH) = 0) then
        Canvas.Brush.Style := bsClear
      else
        Canvas.Brush.Color := C;
    end;

  begin
    Canvas.Brush.Style := bsClear; //bsSolid;//bsClear;
    I := Integer(ABold);
    with Canvas do
      case Bevel of
        bvLowered:
          begin
            SetPenAndBrush(clBtnHighlight);
            if ARect then
              RoundRect(R.Left, R.Top, R.Right, R.Bottom, EW, EH)
            else
              Ellipse(R.Left, R.Top, R.Right, R.Bottom);
            SetPenAndBrush(clBtnShadow);
            if ARect then
              RoundRect(R.Left, R.Top, R.Right - 1, R.Bottom - 1, EW, EH)
            else
              Ellipse(R.Left, R.Top, R.Right - 1, R.Bottom - 1);
            if ABold then
            begin
              SetPenAndBrush(cl3DDkShadow);
              if ARect then
                RoundRect(R.Left + 1, R.Top + 1, R.Right - 1, R.Bottom - 1, EW, EH)
              else
                Ellipse(R.Left + 1, R.Top + 1, R.Right - 1, R.Bottom - 1);
            end;
            InflateRect(R, -1, -1);
            Inc(R.Left, I);
            Inc(R.Top, I);
          end;
        bvRaised:
          begin
            SetPenAndBrush(clBtnHighlight);
            if ARect then
              RoundRect(R.Left, R.Top, R.Right, R.Bottom, EW, EH)
            else
              Ellipse(R.Left, R.Top, R.Right, R.Bottom);
            if ABold then
            begin
              SetPenAndBrush(cl3DDkShadow);
              if ARect then
                RoundRect(R.Left + 1, R.Top + 1, R.Right, R.Bottom, EW, EH)
              else
                Ellipse(R.Left + 1, R.Top + 1, R.Right, R.Bottom);
            end;
            SetPenAndBrush(clBtnShadow);
            if ARect then
              RoundRect(R.Left + 1, R.Top + 1, R.Right - I, R.Bottom - I, EW, EH)
            else
              Ellipse(R.Left + 1, R.Top + 1, R.Right - I, R.Bottom - I);
            InflateRect(R, -1, -1);
            Dec(R.Right, I);
            Dec(R.Bottom, I);
          end;
      else
        begin
          //Brush.Color:=clBlack;
          //FrameRect( Rect(Left, Top, Left+W, Top+H) );
        end;
      end;
    SetPenAndBrush(clBtnFace);
  end;

begin
  FNeedUpdateRgn := FNeedUpdateRgn or (FOldX <> Left) or (FOldY <> Top) or
    (FOldW <> Width) or (FOldH <> Height);

  if FNeedUpdateRgn then
    UpdateRGN;
  FOldX := Left;
  FOldY := Top;
  FOldW := Width;
  FOldH := Height;

  if IsItAFilledBitmap(FShapeBitmap) then
  begin
    BitBlt(Canvas.Handle, -1, -1, Width, Height, FShapeBitmap.Canvas.Handle,
      0, 0, SRCCopy);
    Exit;
  end;

  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);
  with Canvas do
    case FShape of
      stRectangle, stSquare, stRoundRect, stRoundSquare:
        begin
          if (FShape = stRectangle) or (FShape = stSquare) then
          begin
            EW := 0;
            EH := 0;
          end;
          if (FShape = stRoundRect) or (FShape = stRoundSquare) then
          begin
            EW := FRectEllipse.X;
            EH := FRectEllipse.Y;
          end;

          DrawShape(FBevelOuter, FBevelOuterBold, True);
          InflateRect(R, -FBevelOffset, -FBevelOffset);
          DrawShape(FBevelInner, FBevelInnerBold, True);

          //Pen.Color:=clBtnFace;
          //Rect( R.Left, R.Top, R.Right, R.Bottom );
        end;
      stEllipse, stCircle:
        begin
          DrawShape(FBevelOuter, FBevelOuterBold, False);
          InflateRect(R, -FBevelOffset, -FBevelOffset);
          DrawShape(FBevelInner, FBevelInnerBold, False);
        end;
    end;
end;

procedure TJvgHoleShape.CalcRGNs;
var

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -