📄 jvgholeshape.pas
字号:
{-----------------------------------------------------------------------------
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 + -