⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 iswitchpanel.pas

📁 iocopm3.04源码,一套很好的工控开发工具
💻 PAS
📖 第 1 页 / 共 2 页
字号:
{*******************************************************}
{                                                       }
{       TiSwitchPanel Component                         }
{                                                       }
{       Copyright (c) 1997,2003 Iocomp Software         }
{                                                       }
{*******************************************************}
{$I iInclude.inc}

{$ifdef iVCL}unit  iSwitchPanel;{$endif}
{$ifdef iCLX}unit QiSwitchPanel;{$endif}

interface

uses
  {$I iIncludeUses.inc}
  {$IFDEF iVCL} iTypes,  iGPFunctions,  iMath,  iClasses,  iCustomComponent;{$ENDIF}
  {$IFDEF iCLX}QiTypes, QiGPFunctions, QiMath, QiClasses, QiCustomComponent;{$ENDIF}

type
  TiSwitchPanelMouseControlStyle = (ispmcsRotate, ispmcsIncrement);
  TiSwitchPanelBorderStyle       = (ispbsLine, ispbsRaised, ispbsLowered, ispbsTop, ispbsNone);

  TiSwitchPanel = class(TiCustomComponent)
  private
    FPanelFontInactive    : TFont;
    FPanelFontActive      : TFont;
    FPositionCaption1     : String;
    FPositionCaption2     : String;
    FPositionCaption3     : String;
    FPosition             : Integer;
    FPositionCount        : Integer;
    FKnobRadiusAutoSize   : Boolean;
    FKnobRadius           : Integer;
    FKnobHandleWidth      : Integer;
    FKnobHandleColor      : TColor;
    FKnobInnerColor       : TColor;
    FKnobOuterColor       : TColor;

    FKnobCenterPoint      : TPoint;
    FKnobOuterRect        : TRect;
    FKnobInnerRect        : TRect;

    FCaptionRect1         : TRect;
    FCaptionRect2         : TRect;
    FCaptionRect3         : TRect;

    FMouseDownCaption1    : Boolean;
    FMouseDownCaption2    : Boolean;
    FMouseDownCaption3    : Boolean;

    FMouseDownKnob        : Boolean;
    FMouseDownDegrees     : Double;

    FMouseDown            : Boolean;
    FKeyDown              : Boolean;
    FMouseControlStyle    : TiSwitchPanelMouseControlStyle;
    FPanelMarginTop       : Double;
    FPanelMarginRow       : Double;
    FPanelMarginBottom    : Double;
    FPanelBackGroundColor : TColor;
    FKnobSideMargin       : Integer;
    FBorderStyle          : TiSwitchPanelBorderStyle;
    FBackGroundColorTop   : TColor;
    FOnPositionChange     : TNotifyEvent;
    FOnPositionChangeUser : TNotifyEvent;
    FUserGenerated        : Boolean;
  protected
    procedure SetPositionCaption1    (const Value: String);
    procedure SetPositionCaption2    (const Value: String);
    procedure SetPositionCaption3    (const Value: String);
    procedure SetPanelFontInactive   (const Value: TFont);
    procedure SetPanelFontActive     (const Value: TFont);
    procedure SetPosition            (const Value: Integer);
    procedure SetPositionCount       (const Value: Integer);
    procedure SetKnobRadiusAutoSize  (const Value: Boolean);
    procedure SetKnobHandleColor     (const Value: TColor);
    procedure SetKnobInnerColor      (const Value: TColor);
    procedure SetKnobOuterColor      (const Value: TColor);
    procedure SetKnobRadius          (const Value: Integer);
    procedure SetKnobHandleWidth     (const Value: Integer);
    procedure SetMouseControlStyle   (const Value: TiSwitchPanelMouseControlStyle);
    procedure SetPanelBackGroundColor(const Value: TColor);
    procedure SetPanelMarginBottom   (const Value: Double);
    procedure SetPanelMarginRow      (const Value: Double);
    procedure SetPanelMarginTop      (const Value: Double);
    procedure SetKnobSideMargin      (const Value: Integer);
    procedure SetBorderStyle         (const Value: TiSwitchPanelBorderStyle); reintroduce;
    procedure SetBackGroundColorTop  (const Value: TColor);

    procedure DoPositionChange;

    procedure iPaintTo  (Canvas: TCanvas);   override;
    procedure DrawBorder(Canvas: TCanvas);   override;

    procedure iMouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;
    procedure iMouseUp  (Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;
    procedure iMouseMove(                      Shift: TShiftState; X, Y: Integer); override;
    procedure iDoKillFocus;                                                        override;
 public
    constructor Create(AOwner: TComponent);override;
    destructor  Destroy;                   override;
  published
    property PositionCaption1     : String                         read FPositionCaption1     write SetPositionCaption1;
    property PositionCaption2     : String                         read FPositionCaption2     write SetPositionCaption2;
    property PositionCaption3     : String                         read FPositionCaption3     write SetPositionCaption3;
    property PanelFontInactive    : TFont                          read FPanelFontInactive    write SetPanelFontInactive;
    property PanelFontActive      : TFont                          read FPanelFontActive      write SetPanelFontActive;

    property PanelBackGroundColor : TColor                         read FPanelBackGroundColor write SetPanelBackGroundColor;
    property PanelMarginTop       : Double                         read FPanelMarginTop       write SetPanelMarginTop;
    property PanelMarginRow       : Double                         read FPanelMarginRow       write SetPanelMarginRow;
    property PanelMarginBottom    : Double                         read FPanelMarginBottom    write SetPanelMarginBottom;

    property PositionCount        : Integer                        read FPositionCount        write SetPositionCount;
    property Position             : Integer                        read FPosition             write SetPosition;

    property KnobOuterColor       : TColor                         read FKnobOuterColor       write SetKnobOuterColor;
    property KnobInnerColor       : TColor                         read FKnobInnerColor       write SetKnobInnerColor;
    property KnobHandleColor      : TColor                         read FKnobHandleColor      write SetKnobHandleColor;
    property KnobHandleWidth      : Integer                        read FKnobHandleWidth      write SetKnobHandleWidth;
    property KnobRadius           : Integer                        read FKnobRadius           write SetKnobRadius;
    property KnobSideMargin       : Integer                        read FKnobSideMargin       write SetKnobSideMargin;

    property KnobRadiusAutoSize   : Boolean                        read FKnobRadiusAutoSize   write SetKnobRadiusAutoSize;
    property MouseControlStyle    : TiSwitchPanelMouseControlStyle read FMouseControlStyle    write SetMouseControlStyle;
    property BorderStyle          : TiSwitchPanelBorderStyle       read FBorderStyle          write SetBorderStyle;

    property BackGroundColorTop   : TColor                         read FBackGroundColorTop   write SetBackGroundColorTop;

    property OnPositionChange     : TNotifyEvent                   read FOnPositionChange     write FOnPositionChange;
    property OnPositionChangeUser : TNotifyEvent                   read FOnPositionChangeUser write FOnPositionChangeUser;

    property BackGroundColor;
    property Width            default 140;
    property Height           default 190;
  end;

implementation
//****************************************************************************************************************************************************
constructor TiSwitchPanel.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  Width            := 100;
  Height           := 150;

  FPanelFontActive            := TFont.Create;
  FPanelFontActive.Size       := 8;
  FPanelFontActive.Style      := [fsBold];
  FPanelFontActive.Color      := clAqua;
  FPanelFontActive.OnChange   := InvalidateChangeEvent;

  FPanelFontInactive          := TFont.Create;
  FPanelFontInactive.Size     := 8;
  FPanelFontInactive.Style    := [fsBold];
  FPanelFontInactive.Color    := clWhite;
  FPanelFontInactive.OnChange := InvalidateChangeEvent;

  FPanelMarginTop     := 0.25;
  FPanelMarginRow     := 0.25;
  FPanelMarginBottom  := 0.25;

  FPositionCount      := 3;

  FPositionCaption1   := 'On';
  FPositionCaption2   := 'Off';
  FPositionCaption3   := 'Manual';

  FKnobOuterColor     := clWhite;
  FKnobInnerColor     := clGray;
  FKnobHandleColor    := clGray;
  KnobHandleWidth     := 10;

  FBackGroundColorTop := clAqua;

  FKnobRadiusAutoSize := True;
end;
//****************************************************************************************************************************************************
destructor TiSwitchPanel.Destroy;
begin
  FPanelFontInactive.Free;
  FPanelFontActive.Free;
  inherited;
end;
//*************************************************************************************************************************************
procedure TiSwitchPanel.DoPositionChange;
begin
  if not Loading then
    begin
      if                          Assigned(OnChangeProtected)     then OnChangeProtected    (Self, 'Position');
      if                          Assigned(FOnPositionChange)     then FOnPositionChange    (Self);
      if (FUserGenerated) then if Assigned(FOnPositionChangeUser) then FOnPositionChangeUser(Self);
    end;
end;
//****************************************************************************************************************************************************
procedure TiSwitchPanel.SetPositionCaption1    (const Value: String );begin SetStringProperty (Value, FPositionCaption1,    irtInvalidate);end;
procedure TiSwitchPanel.SetPositionCaption2    (const Value: String );begin SetStringProperty (Value, FPositionCaption2,    irtInvalidate);end;
procedure TiSwitchPanel.SetPositionCaption3    (const Value: String );begin SetStringProperty (Value, FPositionCaption3,    irtInvalidate);end;
procedure TiSwitchPanel.SetKnobRadiusAutoSize  (const Value: Boolean);begin SetBooleanProperty(Value, FKnobRadiusAutoSize,  irtInvalidate);end;
procedure TiSwitchPanel.SetKnobHandleColor     (const Value: TColor );begin SetColorProperty  (Value, FKnobHandleColor,     irtInvalidate);end;
procedure TiSwitchPanel.SetKnobInnerColor      (const Value: TColor );begin SetColorProperty  (Value, FKnobInnerColor,      irtInvalidate);end;
procedure TiSwitchPanel.SetKnobOuterColor      (const Value: TColor );begin SetColorProperty  (Value, FKnobOuterColor,      irtInvalidate);end;
procedure TiSwitchPanel.SetKnobRadius          (const Value: Integer);begin SetIntegerProperty(Value, FKnobRadius,          irtInvalidate);end;
procedure TiSwitchPanel.SetKnobHandleWidth     (const Value: Integer);begin SetIntegerProperty(Value, FKnobHandleWidth,     irtInvalidate);end;
procedure TiSwitchPanel.SetPanelBackGroundColor(const Value: TColor );begin SetColorProperty  (Value, FPanelBackGroundColor,irtInvalidate);end;
procedure TiSwitchPanel.SetPanelMarginBottom   (const Value: Double );begin SetDoubleProperty (Value, FPanelMarginBottom,   irtInvalidate);end;
procedure TiSwitchPanel.SetPanelMarginRow      (const Value: Double );begin SetDoubleProperty (Value, FPanelMarginRow,      irtInvalidate);end;
procedure TiSwitchPanel.SetPanelMarginTop      (const Value: Double );begin SetDoubleProperty (Value, FPanelMarginTop,      irtInvalidate);end;
procedure TiSwitchPanel.SetKnobSideMargin      (const Value: Integer);begin SetIntegerProperty(Value, FKnobSideMargin,      irtInvalidate);end;
procedure TiSwitchPanel.SetBackGroundColorTop  (const Value: TColor );begin SetColorProperty  (Value, FBackGroundColorTop,  irtInvalidate);end;
//****************************************************************************************************************************************************
procedure TiSwitchPanel.SetPanelFontInactive(const Value: TFont);begin FPanelFontInactive.Assign(Value);end;
procedure TiSwitchPanel.SetPanelFontActive  (const Value: TFont);begin FPanelFontActive.Assign(Value);  end;
//****************************************************************************************************************************************************
procedure TiSwitchPanel.SetPositionCount(const Value: Integer);
var
  TempValue : Integer;
begin
  TempValue := Value;
  if TempValue < 2 then TempValue := 2;
  if TempValue > 3 then TempValue := 3;
  if FPositionCount <> TempValue then
    begin
      FPositionCount := TempValue;
      if (FPositionCount-1) > FPosition then FPosition := FPositionCount-1;
      InvalidateChange;
    end;
end;
//****************************************************************************************************************************************************
procedure TiSwitchPanel.SetPosition(const Value: Integer);
var
  CanEdit   : Boolean;
  TempValue : Integer;
begin
  TempValue := Value;
  if TempValue < 0 then TempValue := 0;
  if TempValue > (FPositionCount - 1) then TempValue := FPositionCount - 1;
  if FPosition <> TempValue then
    begin
      CanEdit := True;
      if Assigned(OnRequestEditProtected) then OnRequestEditProtected(Self, 'Position', CanEdit);
      if CanEdit then
        begin
          FPosition := TempValue;
          InvalidateChange;
          DoPositionChange;
          {$ifdef iVCL}OPCOutputData('Position', FPosition);{$endif}
        end;
    end;
end;
//****************************************************************************************************************************************************
procedure TiSwitchPanel.SetMouseControlStyle(const Value: TiSwitchPanelMouseControlStyle);
begin
  FMouseControlStyle := Value;
end;
//****************************************************************************************************************************************************
procedure TiSwitchPanel.SetBorderStyle(const Value: TiSwitchPanelBorderStyle);
begin
  if FBorderStyle <> Value then
    begin
      FBorderStyle := Value;
      InvalidateChange;
    end;
end;
//****************************************************************************************************************************************************
procedure TiSwitchPanel.DrawBorder(Canvas: TCanvas);
var
  DrawRect : TRect;
begin                                
  with Canvas do
    begin
      DrawRect := Rect(0, 0 ,Width, Height);
      case FBorderStyle of
        ispbsLowered : iDrawEdge(Canvas, DrawRect, idesSunken);
        ispbsRaised  : iDrawEdge(Canvas, DrawRect, idesRaised);
      end;
    end;
end;
//****************************************************************************************************************************************************

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -