📄 iledmatrix.pas
字号:
{*******************************************************}
{ }
{ TiLedMatrix Component }
{ }
{ Copyright (c) 1997,2003 Iocomp Software }
{ }
{*******************************************************}
{$I iInclude.inc}
{$ifdef iVCL}unit iLedMatrix;{$endif}
{$ifdef iCLX}unit QiLedMatrix;{$endif}
interface
uses
{$I iIncludeUses.inc}
{$IFDEF iVCL} iTypes, iGPFunctions, iCustomComponent, iOPCItem;{$ENDIF}
{$IFDEF iCLX}QiTypes, QiGPFunctions, QiCustomComponent; {$ENDIF}
type
TClickIndicatorEvent = procedure(Row, Col: Integer) of object;
TLedCacheObject = class(TObject)
public
ActiveBitmap : TBitmap;
InActiveBitmap : TBitmap;
Color : TColor;
destructor Destroy; override;
end;
TLedCache = class(TObject)
private
FCacheList : TList;
public
constructor Create;
destructor Destroy; override;
function Find(AColor: TColor) : TLedCacheObject;
procedure Add(LedCacheObject: TLedCacheObject);
procedure Clear;
end;
TIndicatorData = record
Color : TColor;
Caption : String[50];
Active : Boolean;
Dirty : Boolean;
ARect : TRect;
MouseDown : Boolean;
end;
PIndicatorList = ^TIndicatorList;
TIndicatorList = array[0..100000] of TIndicatorData;
TiLedMatrixIndiatorStyle = (ilmisRound, ilmisRectangle);
TiLedMatrix = class(TiCustomComponent)
private
FLedCache : TLedCache;
FFillBackGround : Boolean;
FIndicatorList : PIndicatorList;
FIndicatorActiveColor : TColor;
FColCount : Integer;
FRowCount : Integer;
FIndicatorStyle : TiLedMatrixIndiatorStyle;
FIndicatorHeight : Integer;
FIndicatorWidth : Integer;
FIndicatorBevelStyle : TiBevelStyle;
FSpacingHorizontal : Integer;
FOuterMargin : Integer;
FSpacingVertical : Integer;
FAutoSize : Boolean;
FOnAutoSize : TNotifyEvent;
FIndicatorCaptionInactiveFont : TFont;
FIndicatorCaptionActiveFont : TFont;
FIndicatorShowReflection : Boolean;
FDoingAutoSize : Boolean;
FOnMouseUpIndicator : TClickIndicatorEvent;
FOnMouseMoveIndicator : TClickIndicatorEvent;
FOnMouseDownIndicator : TClickIndicatorEvent;
FOnClickIndicator : TClickIndicatorEvent;
FOnDblClickIndicator : TClickIndicatorEvent;
FClickRow : Integer;
FClickCol : Integer;
procedure SetIndicatorActiveColor(const Value: TColor);
procedure SetColCount (const Value: Integer);
procedure SetRowCount (const Value: Integer);
procedure SetIndicatorStyle (const Value: TiLedMatrixIndiatorStyle);
procedure SetIndicatorBevelStyle (const Value: TiBevelStyle);
procedure SetIndicatorHeight (const Value: Integer);
procedure SetIndicatorWidth (const Value: Integer);
procedure SetOuterMargin (const Value: Integer);
procedure SetSpacingHorizontal (const Value: Integer);
procedure SetSpacingVertical (const Value: Integer);
procedure iSetAutoSize (const Value: Boolean);
procedure SetIndicatorActive (Row, Col: Integer; const Value: Boolean);
procedure SetIndicatorColor (Row, Col: Integer; const Value: TColor);
function GetIndicatorActive (Row, Col: Integer): Boolean;
function GetIndicatorColor (Row, Col: Integer): TColor;
function GetIndicatorCaption (Row, Col: Integer): String;
procedure SetIndicatorCaption (Row, Col: Integer; const Value: String);
procedure SetIndicatorCaptionActiveFont (const Value: TFont);
procedure SetIndicatorCaptionInactiveFont(const Value: TFont);
procedure SetIndicatorShowReflection (const Value: Boolean);
protected
function GetAutoSize : TPoint;
function GetLedAtXY(X, Y: Integer): Integer;
procedure SetTransparent (const Value: Boolean); override;
procedure SetBackGroundColor(const Value: TColor); override;
procedure SetBorderStyle (const Value: TiBevelStyle); override;
procedure SetCachedDrawing (const Value: Boolean); override;
procedure DoAutoSize;
procedure SetCapacity;
procedure iPaintTo (Canvas: TCanvas); override;
procedure iPaintCached (Canvas: TCanvas);
procedure iPaintNonCached(Canvas: TCanvas);
procedure DrawRound (Canvas: TCanvas; DrawRect: TRect; Active: Boolean; AColor: TColor);
procedure DrawRectangle(Canvas: TCanvas; DrawRect: TRect; Active: Boolean; AColor: TColor);
procedure RedoAll;
procedure ClearMouseDown;
procedure iDoKillFocus;
override;
procedure iMouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;
procedure iMouseMove( Shift: TShiftState; X, Y: Integer); override;
procedure iMouseUp (Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;
procedure DblClick; override;
{$ifdef iVCL}
procedure UpdateOPCSpecialList; override;
function OPCNewDataSpecial(iOPCItem: TiOPCItem): Boolean; override;
{$endif}
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
procedure SetBounds(ALeft, ATop, AWidth, AHeight: Integer); override;
property IndicatorActive [Row, Col: Integer] : Boolean read GetIndicatorActive write SetIndicatorActive;
property IndicatorColor [Row, Col: Integer] : TColor read GetIndicatorColor write SetIndicatorColor;
property IndicatorCaption[Row, Col: Integer] : String read GetIndicatorCaption write SetIndicatorCaption;
property OnAutoSize : TNotifyEvent read FOnAutoSize write FOnAutoSize;
published
property AutoSize : Boolean read FAutoSize write iSetAutoSize default True;
property IndicatorActiveColor : TColor read FIndicatorActiveColor write SetIndicatorActiveColor default clLime;
property ColCount : Integer read FColCount write SetColCount default 5;
property RowCount : Integer read FRowCount write SetRowCount default 5;
property IndicatorStyle : TiLedMatrixIndiatorStyle read FIndicatorStyle write SetIndicatorStyle default ilmisRectangle;
property IndicatorWidth : Integer read FIndicatorWidth write SetIndicatorWidth default 10;
property IndicatorHeight : Integer read FIndicatorHeight write SetIndicatorHeight default 10;
property IndicatorBevelStyle : TiBevelStyle read FIndicatorBevelStyle write SetIndicatorBevelStyle default ibsNone;
property IndicatorCaptionActiveFont : TFont read FIndicatorCaptionActiveFont write SetIndicatorCaptionActiveFont;
property IndicatorCaptionInactiveFont : TFont read FIndicatorCaptionInactiveFont write SetIndicatorCaptionInactiveFont;
property OuterMargin : Integer read FOuterMargin write SetOuterMargin default 5;
property SpacingHorizontal : Integer read FSpacingHorizontal write SetSpacingHorizontal default 2;
property SpacingVertical : Integer read FSpacingVertical write SetSpacingVertical default 2;
property IndicatorShowReflection : Boolean read FIndicatorShowReflection write SetIndicatorShowReflection default True;
property OnMouseDownIndicator : TClickIndicatorEvent read FOnMouseDownIndicator write FOnMouseDownIndicator;
property OnMouseMoveIndicator : TClickIndicatorEvent read FOnMouseMoveIndicator write FOnMouseMoveIndicator;
property OnMouseUpIndicator : TClickIndicatorEvent read FOnMouseUpIndicator write FOnMouseUpIndicator;
property OnClickIndicator : TClickIndicatorEvent read FOnClickIndicator write FOnClickIndicator;
property OnDblClickIndicator : TClickIndicatorEvent read FOnDblClickIndicator write FOnDblClickIndicator;
property BackGroundColor;
property BorderStyle;
property Transparent;
property CachedDrawing;
property Width default 150;
property Height default 150;
end;
implementation
//****************************************************************************************************************************************************
constructor TiLedMatrix.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
Width := 150;
Height := 150;
FIndicatorActiveColor := clLime;
FIndicatorShowReflection := True;
FColCount := 5;
FRowCount := 5;
FAutoSize := True;
FOuterMargin := 5;
FIndicatorWidth := 10;
FIndicatorHeight := 10;
FIndicatorStyle := ilmisRectangle;
FSpacingHorizontal := 2;
FSpacingVertical := 2;
SetCapacity;
FIndicatorCaptionActiveFont := TFont.Create;
FIndicatorCaptionActiveFont.OnChange := BackGroundChangeEvent;
FIndicatorCaptionInactiveFont := TFont.Create;
FIndicatorCaptionInactiveFont.OnChange := BackGroundChangeEvent;
FIndicatorCaptionInactiveFont.Color := clWhite;
FLedCache := TLedCache.Create;
end;
//****************************************************************************************************************************************************
destructor TiLedMatrix.Destroy;
begin
FIndicatorCaptionActiveFont.Free;
FIndicatorCaptionInactiveFont.Free;
FLedCache.Free;
FreeMem(FIndicatorList);
inherited;
end;
//****************************************************************************************************************************************************
procedure TiLedMatrix.SetBounds(ALeft, ATop, AWidth, AHeight: Integer);
begin
inherited;
if FAutoSize and not FDoingAutoSize then
begin
IndicatorWidth := Trunc((AWidth - 2*FOuterMargin)/FColCount) - FSpacingHorizontal;
IndicatorHeight := Trunc((AHeight - 2*FOuterMargin)/FRowCount) - FSpacingVertical;
end;
RedoAll;
end;
//****************************************************************************************************************************************************
procedure TiLedMatrix.SetIndicatorCaptionActiveFont (const Value: TFont);begin FIndicatorCaptionActiveFont.Assign(Value); end;
procedure TiLedMatrix.SetIndicatorCaptionInactiveFont(const Value: TFont);begin FIndicatorCaptionInactiveFont.Assign(Value);end;
//****************************************************************************************************************************************************
procedure TiLedMatrix.SetBackGroundColor(const Value: TColor);
begin
inherited;
RedoAll;
end;
//****************************************************************************************************************************************************
procedure TiLedMatrix.SetBorderStyle(const Value: TiBevelStyle);
begin
inherited;
RedoAll;
end;
//****************************************************************************************************************************************************
procedure TiLedMatrix.RedoAll;
var
Row, Col : Integer;
begin
if Assigned(FIndicatorList) then
begin
for Row := 0 to FRowCount -1 do
for Col := 0 to FColCount - 1 do
FIndicatorList^[Col + Row*ColCount].Dirty := True;
end;
if Assigned(FLedCache) then FLedCache.Clear;
FFillBackGround := True;
end;
//****************************************************************************************************************************************************
procedure TiLedMatrix.SetCapacity;
var
Col, Row : Integer;
begin
if ((FRowCount * FColCount) > MaxListSize) then Exception.Create('Exceed Maximum Matrix Size');
ReallocMem(FIndicatorList, FRowCount * FColCount * SizeOf(TIndicatorData));
for Col := 0 to FColCount -1 do
for Row := 0 to FRowCount - 1 do
begin
FIndicatorList^[Col + Row*ColCount].Active := False;
FIndicatorList^[Col + Row*ColCount].Color := FIndicatorActiveColor;
FIndicatorList^[Col + Row*ColCount].Dirty := True;
FIndicatorList^[Col + Row*ColCount].Caption := '';
end;
end;
//****************************************************************************************************************************************************
procedure TiLedMatrix.iDoKillFocus;
begin
inherited;
ClearMouseDown;
end;
//****************************************************************************************************************************************************
procedure TiLedMatrix.ClearMouseDown;
var
x : Integer;
begin
for x := 0 to (ColCount*RowCount)-1 do
FIndicatorList^[x].MouseDown := False;
end;
//****************************************************************************************************************************************************
procedure TiLedMatrix.iMouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
var
Index : Integer;
Row : Integer;
Col : Integer;
begin
inherited;
Index := GetLedAtXY(X, Y);
if Index <> -1 then
begin
FIndicatorList^[Index].MouseDown := True;
Row := Index div ColCount;
Col := Index mod ColCount;
if Assigned(FOnMouseDownIndicator) then FOnMouseDownIndicator(Row, Col);
end;
end;
//****************************************************************************************************************************************************
procedure TiLedMatrix.iMouseMove(Shift: TShiftState; X, Y: Integer);
var
Index : Integer;
Row : Integer;
Col : Integer;
begin
inherited;
Index := GetLedAtXY(X, Y);
if Index <> -1 then
begin
Row := Index div ColCount;
Col := Index mod ColCount;
if Assigned(FOnMouseMoveIndicator) then FOnMouseMoveIndicator(Row, Col);
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -