ksskintrackbars.pas
来自「小区水费管理系统源代码水费收费管理系统 水费收费管理系统」· PAS 代码 · 共 611 行 · 第 1/2 页
PAS
611 行
{==============================================================================
SkinEngine's Trackbar
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: KsSkinTrackBars.pas,v 1.1.1.1 2002/08/05 12:12:14 Evgeny Exp $
===============================================================================}
unit KsSkinTrackBars;
{$I se_define.inc}
{$T-,W-,X+,P+}
interface
uses
Classes, Controls, Windows, Graphics, Messages, se_controls, KsSkinVersion,
KsSkinObjects, KsSkinSource, KsSkinEngine;
type
{ TSeSkinTrackBar }
TSeSkinTrackBar = class(TSeCustomTrackBar)
private
FSkinEngine: TSeSkinEngine;
FSkinObject: string;
FSkinTrackBar: TSeSkinObject;
function GetThumbHeight: integer;
function GetVersion: TSeSkinVersion;
procedure SetVersion(const Value: TSeSkinVersion);
procedure SetSkinEngine(const Value: TSeSkinEngine);
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;
{ TrackBar }
function GetThumbWidth: integer; override;
function GetSideMargin: integer; override;
function GetTopBottomMargin: integer; override;
procedure DrawTrack(BegCoord, EndCoord, PosCooord: integer); override;
procedure DrawThumb(APosCoord: integer); override;
procedure DrawTick(Value, Coord: integer; TopLeft: boolean); override;
{ VCL protected }
procedure Notification(AComponent: TComponent; Operation: TOperation); override;
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
procedure Loaded; override;
published
property Enabled;
property IntervalHighlightType;
property LineSize;
property Max;
property Min;
property Orientation;
property PageSize;
property Position;
property Frequency;
property ShowTicks;
property SkinEngine: TSeSkinEngine read FSkinEngine write SetSkinEngine;
property SkinObject: string read FSkinObject write FSkinObject;
property ThumbHalfWidth;
property ThumbVisible;
property TickMarks;
property Version: TSeSkinVersion read GetVersion write SetVersion
stored false;
property OnChange;
end;
implementation {===============================================================}
uses Extctrls, Dialogs;
{ TSeSkinTrackBar }
constructor TSeSkinTrackBar.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
FSkinObject := 'TrackBar';
Transparent := true;
end;
destructor TSeSkinTrackBar.Destroy;
begin
if FSkinTrackBar <> nil then FSkinTrackBar.Free;
inherited Destroy;
end;
procedure TSeSkinTrackBar.Loaded;
begin
inherited;
{ SkinEngine := FSkinEngine; }
end;
{ Theme }
function TSeSkinTrackBar.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
(FSkinTrackBar <> nil)
then
Result := true
else
Result := false;
end;
{ Track Bar }
function TSeSkinTrackBar.GetThumbWidth: integer;
var
SkinObject: TseSkinObject;
begin
Result := inherited GetThumbWidth;
if UseSkin then
begin
if (Orientation = toHorizontal) then
SkinObject := FSkinTrackBar.FindObjectByName('ThumbHorz');
if (Orientation = toVertical) then
SkinObject := FSkinTrackBar.FindObjectByName('ThumbVert');
if SkinObject = nil then
SkinObject := FSkinTrackBar.FindObjectByName('Thumb');
if SkinObject <> nil then
if (Orientation = toHorizontal) then
Result := SkinObject.Width
else
Result := SkinObject.Height;
end;
end;
function TSeSkinTrackBar.GetThumbHeight: integer;
var
SkinObject: TseSkinObject;
begin
Result := Round(GetThumbWidth * CStdThumbRatio);
if UseSkin then
begin
if (Orientation = toHorizontal) then
SkinObject := FSkinTrackBar.FindObjectByName('ThumbHorz');
if (Orientation = toVertical) then
SkinObject := FSkinTrackBar.FindObjectByName('ThumbVert');
if SkinObject = nil then
SkinObject := FSkinTrackBar.FindObjectByName('Thumb');
if SkinObject <> nil then
if (Orientation = toHorizontal) then
Result := SkinObject.Height
else
Result := SkinObject.Width;
end
end;
function TSeSkinTrackBar.GetSideMargin: integer;
var
SkinObject: TseSkinObject;
begin
Result := inherited GetSideMargin;
if UseSkin then
begin
if (Orientation = toHorizontal) then
SkinObject := FSkinTrackBar.FindObjectByName('FrameHorz');
if (Orientation = toVertical) then
SkinObject := FSkinTrackBar.FindObjectByName('FrameVert');
if SkinObject = nil then
SkinObject := FSkinTrackBar.FindObjectByName('Frame');
if SkinObject <> nil then
if (Orientation = toHorizontal) then
Result := SkinObject.MarginLeft
else
Result := SkinObject.MarginTop;
end
end;
function TSeSkinTrackBar.GetTopBottomMargin: integer;
var
SkinObject: TseSkinObject;
begin
Result := inherited GetTopBottomMargin;
if UseSkin then
begin
if (Orientation = toHorizontal) then
SkinObject := FSkinTrackBar.FindObjectByName('FrameHorz');
if (Orientation = toVertical) then
SkinObject := FSkinTrackBar.FindObjectByName('FrameVert');
if SkinObject = nil then
SkinObject := FSkinTrackBar.FindObjectByName('Frame');
if SkinObject <> nil then
if (Orientation = toHorizontal) then
Result := SkinObject.MarginTop
else
Result := SkinObject.MarginLeft;
end
end;
procedure TSeSkinTrackBar.DrawTrack(BegCoord, EndCoord, PosCooord: integer);
var
R, LTrackRect, LowIntervalRect, TmpRect: TRect;
LSideMarign, LTopBottmMarign, LThumbWidth, LThumbHeight: integer;
Frame, SkinObject: TSeSkinObject;
begin
if not UseSkin then
inherited
else
begin
LThumbWidth := GetThumbWidth;
LTopBottmMarign := GetTopBottomMargin;
LSideMarign := GetSideMargin;
LThumbHeight := GetThumbHeight;
with LTrackRect do
begin
if Orientation = toHorizontal then
begin
Top := LTopBottmMarign;
if TickMarks = tmTopLeft then
Top := Top + LThumbWidth div 2
else
Top := Top + LThumbWidth div 4;
if ShowTicks and ((TickMarks = tmTopLeft) or (TickMarks = tmBoth)) then
Top := Top + 4 + 1;
if TickMarks = tmBoth then
begin
Bottom := Top + LThumbHeight - (LThumbWidth div 4) * 2;
InflateRect(LTrackRect, 0, -1);
end
else
Bottom := Top + LThumbHeight - LThumbWidth div 2 - LThumbWidth div 4;
Left := BegCoord;
Right := EndCoord;
LowIntervalRect.Top := Top;
LowIntervalRect.Bottom := Bottom;
if IntervalHighlightType = htLowInterval then
begin
LowIntervalRect.Left := Left;
LowIntervalRect.Right := PosCooord;
end
else
begin
LowIntervalRect.Left := PosCooord;
LowIntervalRect.Right := Right;
end;
end
else
begin
Left := LTopBottmMarign;
if TickMarks = tmTopLeft then
Left := Left + LThumbWidth div 2
else
Left := Left + LThumbWidth div 4;
if ShowTicks and ((TickMarks = tmTopLeft) or (TickMarks = tmBoth)) then
Left := Left + 4 + 1;
if TickMarks = tmBoth then
begin
Right := Left + LThumbHeight - (LThumbWidth div 4) * 2;
InflateRect(LTrackRect, -1, 0);
end
else
Right := Left + LThumbHeight - LThumbWidth div 2 - LThumbWidth div 4;
Top := BegCoord;
Bottom := EndCoord;
LowIntervalRect.Left := Left;
LowIntervalRect.Right := Right;
if IntervalHighlightType = htLowInterval then
begin
LowIntervalRect.Top := Top;
⌨️ 快捷键说明
复制代码Ctrl + C
搜索代码Ctrl + F
全屏模式F11
增大字号Ctrl + =
减小字号Ctrl + -
显示快捷键?