iswitchled.pas

iocopm3.04源码,一套很好的工控开发工具

{*******************************************************}
{                                                       }
{       TiSwitchLed Component                           }
{                                                       }
{       Copyright (c) 1997,2003 Iocomp Software         }
{                                                       }
{*******************************************************}
{$I iInclude.inc}

{$ifdef iVCL}unit  iSwitchLed;{$endif}
{$ifdef iCLX}unit QiSwitchLed;{$endif}

interface

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

type
  TiSwitchLedCaptionAlignment = (islcaIndicator, islcaOppisiteSide);

  TiSwitchLed = class(TiCustomComponent)
  private
    FMouseDown            : Boolean;
    FKeyDown              : Boolean;
    FActive               : Boolean;
    FActiveColor          : TColor;
    FAutoLedSize          : Boolean;
    FCaption              : String;
    FCaptionFont          : TFont;
    FCaptionMargin        : Integer;
    FIndicatorHeight      : Integer;
    FIndicatorAlignment   : TiSideAlignment;
    FIndicatorMargin      : Integer;
    FIndicatorWidth       : Integer;
    FShowFocusRect        : Boolean;
    FOnChange             : TNotifyEvent;
    FCaptionAlignment     : TiSwitchLedCaptionAlignment;
    FUserGenerated        : Boolean;
    FWordWrap             : Boolean;
    FOnChangeUser         : TNotifyEvent;
    FBorderSize           : Integer;
    FGlyph                : TBitmap;
    FBorderShadowColor    : TColor;
    FBorderHighlightColor : TColor;

    procedure SetActive              (const Value: Boolean);
    procedure SetActiveColor         (const Value: TColor);
    procedure SetAutoLedSize         (const Value: Boolean);
    procedure SetCaption             (const Value: String);
    procedure SetCaptionFont         (const Value: TFont);
    procedure SetCaptionMargin       (const Value: Integer);
    procedure SetIndicatorAlignment  (const Value: TiSideAlignment);
    procedure SetIndicatorHeight     (const Value: Integer);
    procedure SetIndicatorMargin     (const Value: Integer);
    procedure SetIndicatorWidth      (const Value: Integer);
    procedure SetShowFocusRect       (const Value: Boolean);
    procedure SetCaptionAlignment    (const Value: TiSwitchLedCaptionAlignment);
    procedure SetWordWrap            (const Value: Boolean);
    procedure SetBorderSize          (const Value: Integer);
    procedure SetGlyph               (const Value: TBitmap);
    procedure SetBorderHighlightColor(const Value: TColor);
    procedure SetBorderShadowColor   (const Value: TColor);
  protected
    procedure iMouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;
    procedure iMouseUp  (Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;

    procedure iKeyUp  (var CharCode: Word; Shift: TShiftState);                    override;
    procedure iKeyDown(var CharCode: Word; Shift: TShiftState);                    override;

    procedure iDoKillFocus;                                                        override;

    procedure iPaintTo           (Canvas: TCanvas);                                override;
    procedure DrawBorder         (Canvas: TCanvas);                                reintroduce;
    procedure DrawEdgeTopLeft    (Canvas: TCanvas; Offset: Integer; AColor: TColor);
    procedure DrawEdgeBottomRight(Canvas: TCanvas; Offset: Integer; AColor: TColor);
    //Kylix TODO
    {$ifndef iCLX}
    procedure CMEnabledChanged(var Message: TMessage);      message CM_ENABLEDCHANGED;
    procedure CMDialogChar    (var Message: TCMDialogChar); message CM_DIALOGCHAR;
    procedure WMSysChar       (var Message: TWMSysChar);    message WM_SYSCHAR;
    {$endif}
    procedure DefineProperties(Filer: TFiler); override;
    procedure WriteCaption    (Writer: TWriter);
    procedure ReadCaption     (Reader: TReader);
    procedure DoChange;
  public
    constructor Create(AOwner: TComponent); override;
    destructor  Destroy;                    override;
    procedure   SetActiveNoEvent(const Value: Boolean);
  published
    property Active               : Boolean                     read FActive               write SetActive             default False;
    property ActiveColor          : TColor                      read FActiveColor          write SetActiveColor        default clLime;
    property AutoLedSize          : Boolean                     read FAutoLedSize          write SetAutoLedSize        default True;
    property Caption              : String                      read FCaption              write SetCaption;
    property CaptionFont          : TFont                       read FCaptionFont          write SetCaptionFont;
    property CaptionMargin        : Integer                     read FCaptionMargin        write SetCaptionMargin;
    property CaptionAlignment     : TiSwitchLedCaptionAlignment read FCaptionAlignment     write SetCaptionAlignment   default islcaIndicator;
    property IndicatorAlignment   : TiSideAlignment             read FIndicatorAlignment   write SetIndicatorAlignment default isaBottom;
    property IndicatorHeight      : Integer                     read FIndicatorHeight      write SetIndicatorHeight    default 4;
    property IndicatorMargin      : Integer                     read FIndicatorMargin      write SetIndicatorMargin    default 5;
    property IndicatorWidth       : Integer                     read FIndicatorWidth       write SetIndicatorWidth     default 10;
    property ShowFocusRect        : Boolean                     read FShowFocusRect        write SetShowFocusRect      default True;
    property WordWrap             : Boolean                     read FWordWrap             write SetWordWrap           default False;
    property BorderSize           : Integer                     read FBorderSize           write SetBorderSize;
    property BorderHighlightColor : TColor                      read FBorderHighlightColor write SetBorderHighlightColor;
    property BorderShadowColor    : TColor                      read FBorderShadowColor    write SetBorderShadowColor;
    property OnChange             : TNotifyEvent                read FOnChange             write FOnChange;
    property OnChangeUser         : TNotifyEvent                read FOnChangeUser         write FOnChangeUser;

    property Glyph                : TBitmap                     read FGlyph                write SetGlyph;
    property Enabled;
    property TabOrder;
    property TabStop          default True;
    property Width            default 40;
    property Height           default 28;
    property BackGroundColor  default clBtnFace;
  end;

implementation
//*************************************************************************************************************************************
constructor TiSwitchLed.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);

  Width           := 40;
  Height          := 28;
  TabStop         := True;
  BackGroundColor := clBtnFace;

  FBorderHighlightColor := clBtnHighlight;
  FBorderShadowColor    := clBtnShadow;

  FActiveColor     := clLime;
  FAutoLedSize     := True;
  FCaptionMargin   := 2;
  FIndicatorHeight := 4;
  FIndicatorMargin := 5;
  FIndicatorWidth  := 10;
  FShowFocusRect   := True;
  FBorderSize      := 2;

  FCaptionFont := TFont.Create; FCaptionFont.OnChange := BackGroundChangeEvent;

  FGlyph                 := TBitmap.Create;
  FGlyph.Transparent     := True;
  FGlyph.TransparentMode := tmAuto;
  FGlyph.OnChange        := InvalidateChangeEvent;

  FCaption := 'On';               
end;
//*************************************************************************************************************************************
destructor TiSwitchLed.Destroy;
begin
  OnMouseUp := nil;
  FCaptionFont.Free;
  FGlyph.Free;
  inherited;
end;
//*************************************************************************************************************************************
procedure TiSwitchLed.DoChange;
begin
  if not Loading then
    begin
      if                        Assigned(OnChangeProtected) then OnChangeProtected(Self, 'Active');
      if                        Assigned(FOnChange)         then FOnChange        (Self);
      if FUserGenerated then if Assigned(FOnChangeUser)     then FOnChangeUser    (Self);
    end;
end;
//*************************************************************************************************************************************
procedure TiSwitchLed.SetActiveColor         (const Value:TColor); begin SetColorProperty  (Value,FActiveColor,         irtInvalidate);end;
procedure TiSwitchLed.SetCaptionMargin       (const Value:Integer);begin SetIntegerProperty(Value,FCaptionMargin,       irtInvalidate);end;
procedure TiSwitchLed.SetIndicatorHeight     (const Value:Integer);begin SetIntegerProperty(Value,FIndicatorHeight,     irtInvalidate);end;
procedure TiSwitchLed.SetIndicatorMargin     (const Value:Integer);begin SetIntegerProperty(Value,FIndicatorMargin,     irtInvalidate);end;
procedure TiSwitchLed.SetIndicatorWidth      (const Value:Integer);begin SetIntegerProperty(Value,FIndicatorWidth,      irtInvalidate);end;
procedure TiSwitchLed.SetShowFocusRect       (const Value:Boolean);begin SetBooleanProperty(Value,FShowFocusRect,       irtInvalidate);end;
procedure TiSwitchLed.SetAutoLedSize         (const Value:Boolean);begin SetBooleanProperty(Value,FAutoLedSize,         irtInvalidate);end;
procedure TiSwitchLed.SetWordWrap            (const Value:Boolean);begin SetBooleanProperty(Value,FWordWrap,            irtInvalidate);end;
procedure TiSwitchLed.SetBorderHighlightColor(const Value:TColor );begin SetColorProperty  (Value,FBorderHighlightColor,irtInvalidate);end;
procedure TiSwitchLed.SetBorderShadowColor   (const Value:TColor );begin SetColorProperty  (Value,FBorderShadowColor,   irtInvalidate);end;
//*************************************************************************************************************************************
procedure TiSwitchLed.SetBorderSize(const Value: Integer);
var
  TempValue : Integer;
begin
  TempValue := Value;
  if TempValue <  2 then TempValue := 2;
  if FBorderSize <> TempValue then
    begin
      FBorderSize := TempValue;
      InvalidateChange;
    end;
end;
//*************************************************************************************************************************************
procedure TiSwitchLed.SetCaptionFont(const Value:TFont);begin FCaptionFont.Assign(Value);end;
//*************************************************************************************************************************************
procedure TiSwitchLed.SetActiveNoEvent(const Value: Boolean);
var
  TempOnChange : TNotifyEvent;
begin
  TempOnChange := FOnChange;
  FOnChange    := nil;
  try
    SetActive(Value);
  finally
    FOnChange := TempOnChange;
  end;
end;
//*************************************************************************************************************************************
procedure TiSwitchLed.SetActive(const Value: Boolean);
var
  CanEdit     : Boolean;
  TempBoolean : Boolean;
begin
  if ord(Value) = 0 then TempBoolean := False else TempBoolean := True;
  if FActive <> TempBoolean then
    begin
      CanEdit := True;
      if Assigned(OnRequestEditProtected) then OnRequestEditProtected(Self, 'Active', CanEdit);
      if CanEdit then
        begin
          FActive := TempBoolean;
          InvalidateChange;
          DoChange;
          {$ifdef iVCL}OPCOutputData('Active', FActive);{$endif}
        end;
    end;       
end;
//*************************************************************************************************************************************
procedure TiSwitchLed.SetCaption(const Value: String);
begin
  if FCaption <> Value then
    begin
      FCaption := Value;
      //Kylix TODO
      //Is this necessary?
      {$ifndef iCLX}
      Perform(WM_SETTEXT, 0, Longint(PChar(Value)));
      {$endif}
      InvalidateChange;
    end;
end;
//*************************************************************************************************************************************
procedure TiSwitchLed.SetIndicatorAlignment(const Value: TiSideAlignment);
begin
  if FIndicatorAlignment <> Value then
    begin
      FIndicatorAlignment := Value;
      InvalidateChange;
    end;
end;
//*************************************************************************************************************************************
procedure TiSwitchLed.SetCaptionAlignment(const Value: TiSwitchLedCaptionAlignment);
begin
  if FCaptionAlignment <> Value then
    begin
      FCaptionAlignment := Value;
      InvalidateChange;
    end;
end;
//*************************************************************************************************************************************
procedure TiSwitchLed.iMouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
  if Button = mbLeft then
    begin
      SetFocus;
      FMouseDown := True;
      InvalidateChange;
    end;
end;
//*************************************************************************************************************************************
procedure TiSwitchLed.iMouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
  if FMouseDown then
    begin
      InvalidateChange;
      FMouseDown     := False;
      FUserGenerated := True;
      try
        if PtInRect(Rect(0, 0 ,Width, Height), Point(X,Y)) then Active := not FActive;
      finally
        FUserGenerated := False;
      end;
    end;
end;
//*************************************************************************************************************************************
procedure TiSwitchLed.iKeyDown(var CharCode: Word; Shift: TShiftState);
begin
  if CharCode = 32 then
    begin
      FMouseDown := False;
      FKeyDown   := True;
      InvalidateChange;
    end;
end;
//*************************************************************************************************************************************
procedure TiSwitchLed.iKeyUp(var CharCode: Word; Shift: TShiftState);
begin
  if CharCode = 32 then
    if FKeyDown then
      begin
        InvalidateChange;
        FMouseDown     := False;
        FKeyDown       := False;
        FUserGenerated := True;
        try
          Active := not Active;
        finally
          FUserGenerated := False;
        end;
      end;
end;
//*************************************************************************************************************************************
procedure TiSwitchLed.iPaintTo(Canvas: TCanvas);
var
  DrawRect         : TRect;
  DrawWidth        : Integer;
  DrawHeight       : Integer;
  LedRect          : TRect;
  TempWidth        : Integer;
  TempHeight       : Integer;
  CenterPoint      : TPoint;
  ATextRect        : TRect;
  ATextFlags       : TiTextFlags;
begin
  CenterPoint := GetCenterPoint(Canvas);
  LedRect     := Rect(0,0,0,0);
  with Canvas, DrawRect do