ksskinprogress.pas
来自「小区水费管理系统源代码水费收费管理系统 水费收费管理系统」· PAS 代码 · 共 266 行
PAS
266 行
{==============================================================================
SkinEngine's ProgressBar
Copyright (C) 2000-2002 by Evgeny Kryukov
All rights reserved
All conTeThements of this file and all other files included in this archive
are Copyright (C) 2002 Evgeny Kryukov. Use and/or distribution of
them requires acceptance of the License Agreement.
See License.txt for licence information
$Id: KsSkinProgress.pas,v 1.1.1.1 2002/08/05 12:12:13 Evgeny Exp $
===============================================================================}
unit KsSkinProgress;
{$I se_define.inc}
{$T-,W-,X+,P+}
interface
uses
Windows, Messages, Classes, Graphics, Forms, se_controls, KsSkinVersion,
KsSkinObjects, KsSkinSource, KsSkinEngine;
type
{ TSeSkinProgressBar class }
TSeSkinProgressBar = class(TSeCustomProgressBar)
private
FSkinEngine: TSeSkinEngine;
FSkinObject: string;
FSkinProgress: TSeSkinObject;
function GetVersion: TSeSkinVersion;
procedure SetVersion(const Value: TSeSkinVersion);
procedure SetSkinEngine(const Value: TSeSkinEngine);
procedure SetSkinObject(const Value: string);
protected
procedure WMInvalidateSkinObject(var Msg: TMessage); message WM_INVALIDATESKINOBJECT;
procedure WMBeforeChange(var Msg: TMessage); message WM_BEFORECHANGE;
procedure WMSkinChange(var Msg: TMessage); message WM_SKINCHANGE;
function UseSkin: boolean;
{ overrides }
function GetBarRect: TRect; override;
procedure PaintBar; override;
procedure PaintFrame; override;
{ VCL protected }
procedure Notification(AComponent: TComponent; Operation: TOperation); override;
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
procedure Loaded; override;
published
property Max;
property Min;
property Position;
property Orientation;
property Smooth;
property SkinEngine: TSeSkinEngine read FSkinEngine write SetSkinEngine;
property SkinObject: string read FSkinObject write SetSkinObject;
property Version: TSeSkinVersion read GetVersion write SetVersion
stored false;
end;
implementation {===============================================================}
{ TSeSkinProgressBar }
constructor TSeSkinProgressBar.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
FSkinObject := 'ProgressBar';
Transparent := true;
BorderWidth := 0;
end;
destructor TSeSkinProgressBar.Destroy;
begin
if FSkinProgress <> nil then FSkinProgress.Free;
inherited Destroy;
end;
procedure TSeSkinProgressBar.Loaded;
begin
inherited;
Invalidate;
end;
function TSeSkinProgressBar.UseSkin: boolean;
begin
if (csDestroying in ComponentState) or (csLoading in ComponentState) then
Result := false
else
if (FSkinEngine <> nil) and (FSkinEngine.SkinSource <> nil) and
(not FSkinEngine.SkinSource.IsChanging) and
(FSkinEngine.SkinSource.Count > 0) and
(FSkinEngine.SkinSource.GetObjectByName(FSkinObject) <> nil) and
(FSkinProgress <> nil)
then
Result := true
else
Result := false;
end;
function TSeSkinProgressBar.GetBarRect: TRect;
begin
if UseSkin and (FSkinProgress.FindObjectByName('Frame') <> nil) then
begin
Result := Rect(0, 0, FWidth, FHeight);
with FSkinProgress.FindObjectByName('Frame') do
Result := Rect(MarginLeft, MarginTop, FWidth - MarginRight, FHeight - MarginBottom)
end
else
Result := inherited GetBarRect;
end;
{ Drawing }
procedure TSeSkinProgressBar.PaintBar;
var
FillR, R: TRect;
W, Pos: integer;
SkinObject: TSeSkinObject;
begin
if UseSkin then
begin
R := GetBarRect;
if Orientation = kboHorizontal then
W := RectWidth(R)
else
W := RectHeight(R);
{ Calc Pos }
Pos := Round(W * GetPercent(Position));
{ Set FillR }
FillR := R;
if Orientation = kboHorizontal then
FillR.Right := FillR.Left + Pos
else
FillR.Top := FillR.Bottom - Pos;
if Orientation = kboHorizontal then
SkinObject := FSkinProgress.FindObjectByName('BarHorz')
else
SkinObject := FSkinProgress.FindObjectByName('BarVert');
if SkinObject = nil then
SkinObject := FSkinProgress.FindObjectByName('Bar');
{ Draw Bar }
if SkinObject <> nil then
begin
SkinObject.BoundsRect := FillR;
SkinObject.Draw(Canvas);
end;
end
else
inherited;
end;
procedure TSeSkinProgressBar.PaintFrame;
var
R: TRect;
SkinObject: TSeSkinObject;
begin
if UseSkin then
begin
if not Transparent then FillRect(Canvas, Rect(0, 0, Width, Height), Color);
R := Rect(0, 0, FWidth, FHeight);
{ Draw Frame }
SkinObject := FSkinProgress.FindObjectByName('Frame');
if SkinObject <> nil then
begin
SkinObject.BoundsRect := R;
SkinObject.Draw(Canvas);
end;
end
else
inherited;
end;
procedure TSeSkinProgressBar.WMInvalidateSkinObject(var Msg: TMessage);
begin
Invalidate;
end;
procedure TSeSkinProgressBar.WMBeforeChange(var Msg: TMessage);
begin
if Pointer(Msg.LParam) = nil then Exit;
if TSeSkinEngine(Msg.LParam) <> FSkinEngine then Exit;
if FSkinProgress <> nil then FSkinProgress.Free;
FSkinProgress := nil;
end;
procedure TSeSkinProgressBar.WMSkinChange(var Msg: TMessage);
begin
if Pointer(Msg.LParam) = nil then Exit;
if TSeSkinEngine(Msg.LParam) <> FSkinEngine then Exit;
SkinEngine := FSkinEngine;
end;
{ VCL }
procedure TSeSkinProgressBar.Notification(AComponent: TComponent;
Operation: TOperation);
begin
inherited;
if (Operation = opRemove) and (AComponent = FSkinEngine) then
SkinEngine := nil;
end;
{ Properties }
procedure TSeSkinProgressBar.SetSkinEngine(const Value: TSeSkinEngine);
begin
FSkinEngine := Value;
if (FSkinEngine <> nil) and (FSkinEngine.SkinSource <> nil) and
(not FSkinEngine.SkinSource.IsChanging) and
(FSkinEngine.SkinSource.Count > 0) then
begin
if FSkinProgress <> nil then FSkinProgress.Free;
FSkinProgress := nil;
if FSkinEngine.SkinSource.GetObjectByName(FSkinObject) <> nil then
FSkinProgress := FSkinEngine.SkinSource.GetObjectByName(FSkinObject).CreateCopy(nil);
if FSkinProgress <> nil then FSkinProgress.ParentControl := Self;
end
else
begin
if FSkinProgress <> nil then FSkinProgress.Free;
FSkinProgress := nil;
end;
Invalidate;
end;
function TSeSkinProgressBar.GetVersion: TSeSkinVersion;
begin
Result := sSeSkinVersion;
end;
procedure TSeSkinProgressBar.SetVersion(const Value: TSeSkinVersion);
begin
end;
procedure TSeSkinProgressBar.SetSkinObject(const Value: string);
begin
FSkinObject := Value;
end;
end.
⌨️ 快捷键说明
复制代码Ctrl + C
搜索代码Ctrl + F
全屏模式F11
增大字号Ctrl + =
减小字号Ctrl + -
显示快捷键?