iledarrow.pas

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

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

{$ifdef iVCL}unit  iLedArrow;{$endif}
{$ifdef iCLX}unit QiLedArrow;{$endif}

interface

uses
  {$I iIncludeUses.inc}
  {$IFDEF iVCL} iTypes,  iGPFunctions,  iClasses,  iLed;{$ENDIF}
  {$IFDEF iCLX}QiTypes, QiGPFunctions, QiClasses, QiLed;{$ENDIF}

type
  TiLedArrowStyle = (ilasRight, ilasLeft, ilasUp, ilasDown, ilasLeftRight, ilasUpDown);

  TiPointRecord = record
    Point   : TPoint;
    Shadow  : Boolean;
  end;
   
  TiLedArrow = class(TiLed)
  private
    FStyle           : TiLedArrowStyle;
    FAutoSize        : Boolean;
    FDoingAutoSize   : Boolean;
    FArrowBodyLength : Integer;
    FArrowHeadSize   : Integer;
    FOnAutoSize      : TNotifyEvent;
    procedure SetStyle          (const Value: TiLedArrowStyle);
    procedure iSetAutoSize      (const Value: Boolean);
    procedure SetArrowBodyLength(const Value: Integer);
    procedure SetArrowHeadSize  (const Value: Integer);
  protected
    procedure iPaintTo(Canvas: TCanvas);                          override;
    procedure DoAutoSize;

    property OnAutoSize       : TNotifyEvent    read FOnAutoSize      write FOnAutoSize;
  public
    constructor Create(AOwner: TComponent);                       override;
    procedure   SetBounds(ALeft, ATop, AWidth, AHeight: Integer); override;
  published
    property AutoSize         : Boolean         read FAutoSize        write iSetAutoSize        default True;
    property Style            : TiLedArrowStyle read FStyle           write SetStyle            default ilasRight;
    property ArrowBodyLength  : Integer         read FArrowBodyLength write SetArrowBodyLength  default 20;
    property ArrowHeadSize    : Integer         read FArrowHeadSize   write SetArrowHeadSize    default 20;
    property Active;
    property ActiveColor;
    property BevelStyle;
    property OnChange;              
    property BackGroundColor;
    property Transparent;
    property Width            default 40;
    property Height           default 20;
  end;

implementation
//****************************************************************************************************************************************************
constructor TiLedArrow.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  Width            := 40;
  Height           := 20;

  FArrowHeadSize   := 20;
  FArrowBodyLength := 20;
  iSetAutoSize(True);
end;
//****************************************************************************************************************************************************
procedure TiLedArrow.SetBounds(ALeft, ATop, AWidth, AHeight: Integer);
begin
  case FStyle of
    ilasRight, ilasLeft : if AWidth  <   AHeight then AWidth  :=   AHeight;
    ilasLeftRight       : if AWidth  < 2*AHeight then AWidth  := 2*AHeight;
    ilasUp, ilasDown    : if AHeight <   AWidth  then AHeight :=   AWidth;
    ilasUpDown          : if AHeight < 2*AWidth  then AHeight := 2*AWidth;
  end;

  inherited;
  if FAutoSize and (not FDoingAutoSize) then
    begin
      case FStyle of
        ilasRight, ilasLeft : begin
                                FArrowHeadSize   := AHeight;
                                FArrowBodyLength := AWidth - FArrowHeadSize;
                              end;
        ilasLeftRight       : begin
                                FArrowHeadSize   := AHeight;
                                FArrowBodyLength := (AWidth - 2*FArrowHeadSize) div 2;
                              end;
        ilasUp, ilasDown    : begin
                                FArrowHeadSize   := AWidth;
                                FArrowBodyLength := AHeight - FArrowHeadSize;
                              end;
        ilasUpDown          : begin
                                FArrowHeadSize   := AWidth;
                                FArrowBodyLength := (AHeight - 2*FArrowHeadSize) div 2;
                              end;
      end;
    end;
end;
//****************************************************************************************************************************************************
procedure TiLedArrow.DoAutoSize;
begin
  if FAutoSize then
    begin
      FDoingAutoSize := True;
      case FStyle of
        ilasRight, ilasLeft : begin
                                Height := FArrowHeadSize;
                                Width  := FArrowBodyLength + FArrowHeadSize;
                              end;
        ilasLeftRight       : begin
                                Height := FArrowHeadSize;
                                Width  := 2*FArrowBodyLength + 2*FArrowHeadSize;
                              end;
        ilasUp, ilasDown    : begin
                                Height := FArrowBodyLength + FArrowHeadSize;
                                Width  := FArrowHeadSize;
                              end;
        ilasUpDown          : begin
                                Width  := FArrowHeadSize;
                                Height := 2*FArrowBodyLength + 2*FArrowHeadSize;
                              end;
      end;
      FDoingAutoSize := False;
      if Assigned(FOnAutoSize) then FOnAutoSize(Self);
  end;
end;
//****************************************************************************************************************************************************
procedure TiLedArrow.iSetAutoSize(const Value: Boolean);
begin
  if FAutoSize <> Value then
    begin
      FAutoSize := Value;
      DoAutoSize;
    end;
end;
//****************************************************************************************************************************************************
procedure TiLedArrow.SetArrowBodyLength(const Value: Integer);
begin
  if FArrowBodyLength <> Value then
    begin
      FArrowBodyLength := Value;
      BackGroundChange;
      DoAutoSize;
    end;
end;
//****************************************************************************************************************************************************
procedure TiLedArrow.SetArrowHeadSize(const Value: Integer);
begin
  if FArrowHeadSize <> Value then
    begin
      FArrowHeadSize := Value;
      BackGroundChange;
      DoAutoSize;
    end;
end;
//****************************************************************************************************************************************************
procedure TiLedArrow.SetStyle(const Value: TiLedArrowStyle);
begin
  if FStyle <> Value then
    begin
      FStyle := Value;
      BackGroundChange;
      DoAutoSize;
    end;
end;