?? sstylepassive.pas
字號:
unit sStylePassive;
{$I sDefs.inc}
interface
uses
windows, Graphics, Classes, Controls,
sUtils, SysUtils, StdCtrls, sStyleSimply,
{$IFNDEF ALITE}
sControlsManager,
{$ENDIF}
sStyleActive,
Dialogs, Forms, Messages, sConst, extctrls, IniFiles;
type
TsPassivePaintStyle = class;
TsPassivePainting = class(TPersistent)
private
FBevel : TsControlBevel;
FColor : TColor;
FColorBorderTop : TColor;
FColorBorderBottom : TColor;
FTransparency: integer;
FOwner : TsPassivePaintStyle;
procedure SetColors (Index: Integer; Value: Graphics.TColor);
procedure SetTransparency(const Value: integer);
procedure SetBevel(const Value: TsControlBevel);
public
constructor Create(AOwner : TPersistent);
published
property Bevel : TsControlBevel read FBevel write SetBevel default cbRaisedSoft;
property Transparency: integer read FTransparency write SetTransparency default 50;
property ColorBorderTop: Graphics.TColor index 0 read FColorBorderTop write SetColors default clWhite;
property ColorBorderBottom: Graphics.TColor index 1 read FColorBorderBottom write SetColors default clBlack;
property Color: Graphics.TColor index 3 read FColor write SetColors default clMenu;
end;
TsPassiveShadow = class(TPersistent)
private
FEnabled : boolean;
FOffset : integer;
FColor : TColor;
FOwner : TsPassivePaintStyle;
FTransparency : TPercent;
FBlur : integer;
procedure SetColor(const Value: TColor);
procedure SetEnabled(const Value: boolean);
procedure SetOffset(const Value: integer);
procedure SetTransparency(const Value: TPercent);
procedure SetBlur(const Value: integer);
public
constructor Create(AOwner : TPersistent);
published
property Transparency: TPercent read FTransparency write SetTransparency default 50;
property Enabled : boolean read FEnabled write SetEnabled default True;
property Color : TColor read FColor write SetColor default clBlack;
property Offset : integer read FOffset write SetOffset default 10;
property Blur : integer read FBlur write SetBlur default 6;
end;
TsPassivePaintStyle = class(TPersistent)
private
FSkinSection: string;
procedure SetSkinSection(const Value: string);
protected
FGroupIndex : integer;
public
BorderIndex : integer;
SkinIndex : integer;
FOwner : TPersistent;
FShadow : TsPassiveShadow;
FPainting : TsPassivePainting;
FBackground : TsBackground;
FDrawingStop : boolean;
FCacheBmp : Graphics.TBitmap;
COC : integer;
sC : TPersistent;
function ActualGradPercent : integer;
constructor Create(AOwner : TPersistent); dynamic;
destructor Destroy; override;
procedure OwnerInvalidate;
function GetMaskIndex(mask : string) : integer; overload;
function GetMaskIndex(skinsection, mask : string) : integer; overload;
function GetSkinIndex : integer; overload;
function GetSkinIndex(SkinSection : string) : integer; overload;
procedure WndProc(var Message: TMessage); dynamic;
procedure PaintBG(BGBmp : TBitmap; R : TRect); dynamic;
procedure Update;
published
property Background : TsBackground read FBackground write FBackground;
property Shadow: TsPassiveShadow read FShadow write FShadow;
property Painting: TsPassivePainting read FPainting write FPainting;
property GroupIndex: integer read FGroupIndex write FGroupIndex default 0;
property SkinSection : string read FSkinSection write SetSkinSection;
end;
TsHotPaintStyle = class(TsPassivePaintStyle)
private
FHotStyle: TsHotStyle;
protected
public
constructor Create(AOwner : TPersistent); override;
destructor Destroy; override;
procedure WndProc(var Message: TMessage); override;
procedure PaintActiveBG(BGBmp : TBitmap; R : TRect; ci : TCacheInfo);
procedure sStyleMessage(var Message: TMessage);
// procedure PaintBorder(DC : longint; aRect : TsRect);
published
property HotStyle : TsHotStyle read FHotStyle write FHotStyle;
end;
implementation
uses sMessages, sGraphUtils, sGradient,
{$IFNDEF ALITE}
sHintManager,
{$ENDIF}
sMaskData, sSkinProps,
sSkinProvider, sSkinMenus, sAlphaGraph;
{ TsPassivePaintStyle }
function TsPassivePaintStyle.ActualGradPercent: integer;
begin
Result := Background.Gradient.Percent;
end;
constructor TsPassivePaintStyle.Create(AOwner: TPersistent);
begin
inherited Create;
SkinIndex := -1;
BorderIndex := -1;
FOwner := AOwner;
FCacheBmp := Graphics.TBitmap.Create;
FCacheBmp.PixelFormat := pf24bit;
FShadow := TsPassiveShadow.Create(Self);
FPainting := TsPassivePainting.Create(Self);
FBackground := TsBackground.Create(Self);
{IFNDEF ALITE
sC := GetsControlsManager(GetParentForm(TControl(AOwner)), GroupIndex);
if not Assigned(sC) then begin}
FGroupIndex := 0;
{// end;
$ELSE
FGroupIndex := 0;
$ENDIF}
{$IFDEF RUNIDEONLY}
if not IsIDERunning and not (csDesigning in TComponent(FOwner).ComponentState) and not sTerminated then begin
sTerminated := True;
ShowWarning(sIsRUNIDEONLYMessage);
end;
{$ENDIF}
end;
destructor TsPassivePaintStyle.Destroy;
begin
FreeAndNil(FPainting);
FreeAndNil(FShadow);
FreeAndNil(FBackground);
FreeAndNil(FCacheBmp);
inherited Destroy;
end;
function TsPassivePaintStyle.GetMaskIndex(mask: string): integer;
var
i, l : integer;
// s : string;
begin
Result := -1;
if not sSkinData.Active then Exit;
if skinSection = '' then Exit;
l := Length(ma);
if l > 0 then begin
for i := 0 to l - 1 do begin
if (UpperCase(ma[i].PropertyName) = mask) and
(UpperCase(ma[i].ClassName) = UpperCase(SkinSection)) then begin
Result := i;
Exit;
end;
end;
if (SkinIndex < Length(gd)) and (SkinIndex >= 0) then begin
for i := 0 to l - 1 do begin
if (UpperCase(ma[i].PropertyName) = mask) and
(UpperCase(ma[i].ClassName) = UpperCase(gd[SkinIndex].ParentClassName)) then begin
Result := i;
Exit;
end;
end
end
else begin
// ShowWarning('Undefined skin section - <' + SkinSection + '>');
end;
end;
end;
function TsPassivePaintStyle.GetMaskIndex(skinsection, mask: string): integer;
var
i, l : integer;
// s : string;
begin
Result := -1;
if not sSkinData.Active then Exit;
if skinSection = '' then Exit;
l := Length(ma);
if l > 0 then begin
for i := 0 to l - 1 do begin
if (UpperCase(ma[i].PropertyName) = mask) and
(UpperCase(ma[i].ClassName) = UpperCase(SkinSection)) then begin
Result := i;
Exit;
end;
end;
if (SkinIndex < Length(gd)) and (SkinIndex >= 0) then begin
for i := 0 to l - 1 do begin
if (UpperCase(ma[i].PropertyName) = mask) and
(UpperCase(ma[i].ClassName) = UpperCase(gd[SkinIndex].ParentClassName)) then begin
Result := i;
Exit;
end;
end
end
else begin
// ShowWarning('Undefined skin section - <' + SkinSection + '>');
end;
end;
end;
function TsPassivePaintStyle.GetSkinIndex: integer;
var
i, l : integer;
// s : string;
begin
Result := -1;
if not sSkinData.Active then Exit;
l := Length(gd);
if l > 0 then begin
for i := 0 to l - 1 do begin
if (UpperCase(gd[i].ClassName) = UpperCase(SkinSection)) then begin
Result := i;
Exit;
end;
end;
end;
end;
function TsPassivePaintStyle.GetSkinIndex(SkinSection: string): integer;
var
i, l : integer;
// s : string;
begin
Result := -1;
if not sSkinData.Active then Exit;
l := Length(gd);
if l > 0 then begin
for i := 0 to l - 1 do begin
if (UpperCase(gd[i].ClassName) = UpperCase(SkinSection)) then begin
Result := i;
Exit;
end;
end;
end;
end;
procedure TsPassivePaintStyle.OwnerInvalidate;
begin
{$IFNDEF ALITE}
Case COC of
{$IFDEF TSHINTS}
COC_TsHintManager : begin
TsHintManager(FOwner).Invalidate;
end;
{$ENDIF}
COC_TsMDIForm : begin
// TsMDIManager(FOwner).Invalidate;
end;
{$IFDEF TSMENUS}
COC_TsCustomMenuManager, COC_TsMenuManager : begin
// TsCustomMenuManager(FOwner).Invalidate;
end;
{$ENDIF}
end;
{$ENDIF}
end;
procedure TsPassivePaintStyle.PaintBG(BGBmp: TBitmap; R : TRect);
var
aRect: TRect;
i : integer;
wc: TWinControl;
sc: TsGenStyle;
bmp : TBitmap;
TransColor : TsColor;
iDrawed : boolean;
procedure FillCanvas(bmp : TBitmap); begin
BMP.Canvas.Pen.Style := psClear;
BMP.Canvas.Brush.Style := bsSolid;
BMP.Canvas.Brush.Color := ColorToRGB(Painting.Color);
BMP.Canvas.Rectangle(aRect.Left, aRect.Top, aRect.Right + 1, aRect.Bottom + 1);
end;
procedure PaintAddons; begin
iDrawed := False;
// BGImage painting
if (Background.Image.Percent > 0) then begin
if Assigned(Background.Image.Image)
and (Background.Image.Image.Width <> 0)
and (Background.Image.Image.Height <> 0) then begin
TileBitmap(BGBmp.Canvas, aRect, Background.Image.Image.Graphic);
iDrawed := True;
end
else begin
FillCanvas(BGBmp);
end;
end;
// BGGradient painting
if (Background.Gradient.Percent > 0) then begin
if iDrawed then begin
if Length(Background.Gradient.FGradArray) > 0 then begin
PaintGrad(Bmp, aRect, Background.Gradient.FGradArray);
end
else begin
FillCanvas(Bmp);
end;
TransColor.A := 0;
TransColor.R := Background.Image.Percent * 256 div 100;
TransColor.G := TransColor.R;
TransColor.B := TransColor.R;
SumBitmaps(BGBmp, Bmp, TransColor);
end
else begin
if Length(Background.Gradient.FGradArray) > 0 then begin
PaintGrad(BGBmp, aRect, Background.Gradient.FGradArray);
end
else begin
FillCanvas(BGBmp);
end;
end;
end;
if Background.Gradient.Percent + Background.Image.Percent in [1..100] then begin
BlendColorRect(BGBMP,
Rect(0,
0,
BGBMP.Width - 1,
BGBMP.Height - 1),
(Background.Gradient.Percent + Background.Image.Percent),
ColorToRGB(Painting.Color));
{ FadeRect(BGBMP.Canvas, Rect(0,
0,
BGBMP.Width,
BGBMP.Height),
BGBMP.Canvas.Handle, Point(0, 0),
(Background.Gradient.Percent + Background.Image.Percent),
ColorToRGB(Painting.Color), 0, ssRectangle);
}
end
else begin
BGBMP.Canvas.Pen.Style := psClear;
BGBMP.Canvas.Brush.Style := bsSolid;
BGBMP.Canvas.Brush.Color := ColorToRGB(Painting.Color);
BGBMP.Canvas.Rectangle(R);
end;
end;
begin
aRect := R;
bmp := TBitmap.Create;
bmp.PixelFormat := pf24bit;
bmp.Width := BGBMP.Width;
bmp.Height := BGBMP.Height;
try
PaintAddons;
finally
FreeAndNil(Bmp);
end;
if COC in sCanBeParent then begin
wc := TWinControl(FOwner);
for i := 0 to wc.ControlCount - 1 do begin
sc := GetsStyle(wc.Controls[i]);
if Assigned(sc) and (sc.COC > 0) and sc.Effects.Shadow.Enabled and wc.Controls[i].Visible then begin
sc.PaintShadow(BGBmp.Canvas, 0, 0);
end;
end;
end;
?? 快捷鍵說明
復制代碼
Ctrl + C
搜索代碼
Ctrl + F
全屏模式
F11
切換主題
Ctrl + Shift + D
顯示快捷鍵
?
增大字號
Ctrl + =
減小字號
Ctrl + -