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 + -
显示快捷键?