bboard.pas

電子看板的物件程式

unit BBoard;

(*--------------------------------------------------------------------*)
(*																																		*)
(* TBillBoard Beta Release 1.0																				*)
(*																																		*)
(* author	:	Eduardo Manso Neto ( [e-mail] )				*)
(*																																		*)
(* 					Copyright 1997 MANSOFT Inform醫ica Ltda										*)
(*																																		*)
(*--------------------------------------------------------------------*)

interface

uses

  Windows, SysUtils, Messages, Classes, Graphics, Controls,
  Forms, Dialogs, ExtCtrls, DsgnIntf,
  BBConst, BBCommon;

(*											*)
(* Forward declaration	*)
(*											*)

procedure Register;

(*																		*)
(* TBBMask property editor definition	*)
(*																		*)

type

	TBBMaskPropertyEditor = class( TClassProperty )

    public
    	procedure Edit; override;
      function 	GetAttributes: TPropertyAttributes; override;
      function 	GetValue: string; override;

	end;

(*																				*)
(* TBillBoard Component Editor definition	*)
(*																				*)

type

  TBillBoardComponentEditor = class( TComponentEditor )

    protected
      procedure ShowAbout;
      procedure ShowEditor;

    public
      procedure Edit; override;
      procedure ExecuteVerb( Index: Integer ); override;
      function GetVerb( Index: Integer ): string; override;
      function GetVerbCount: Integer; override;

  end;

(*																*)
(* 	TBillBoard control definition	*)
(*																*)

type

	TDotStyle = ( dsDot, dsBulb );

  TBillBoard = class( TGraphicControl )
    private
      FAnimation : boolean;
      FAnimationRate : integer;
      FBackColor : TColor;
      FBackGndBmp: TBitmap;
	    FBBMask : TBBMask;
      FCellSize : integer;
      FChanged: Boolean;
      FCharHeight : integer;
      FCharWidth : integer;
	    FCustomMask : Boolean;
      FDotOffColor : TColor;
      FDotOnColor : TColor;
      FDotSize : integer;
    	FDotStyle	: TDotStyle;
      FOldHeight: integer;
      FOldWidth: integer;
      FOnBmp: TBitmap;
      FPenOffColor : TColor;
      FPenOnColor : TColor;
      FStartCell: integer;
      FStartPoint: TPoint;
      FText : string;
      FTimer : TTimer;
      procedure DrawBackGround( Bitmap: TBitmap );
      procedure DrawDigit( Digit: Char; FromCell: TPoint; Bitmap: TBitmap );
      procedure DrawDynamicText( Text: string; Bitmap: TBitmap );
      procedure DrawStaticText( Text: string; Cell: TPoint; Bitmap: TBitmap );
      procedure SetAnimationOnOff( Value: boolean );
      procedure SetAnimationRate( Value: integer );
      procedure SetBackColor( Value: TColor );
      procedure SetCharset( Value: TBBMask );
      procedure SetDotOffColor( Value: TColor );
      procedure SetDotSize( Value: integer );
      procedure SetDotStyle( dotStyle: TDotStyle );
      procedure SetDotOnColor( Value: TColor );
      procedure SetPenOffColor( Value: TColor );
      procedure SetPenOnColor( Value: TColor );
      procedure SetSizes;
      procedure SetText( Value: string );
    protected
			FOnClick: TNotifyEvent;
			FOnDblClick: TNotifyEvent;
			FOnNeedText: TNotifyEvent;
      FOnMouseDown: TMouseEvent;
      FOnMouseUp: TMouseEvent;
      FOnMouseMove: TMouseMoveEvent;
			procedure OnTimer( Sender: TObject );
      procedure DefineProperties( Filer: TFiler ); override;
      procedure ReadCustomMask( reader: TReader );
      procedure WriteCustomMask( writer: TWriter );
      procedure ReadCustom( stream: TStream );
      procedure WriteCustom( stream: TStream );
      procedure Paint; override;
			procedure Click; override;
			procedure DblClick; override;
			procedure MouseDown( Button: TMouseButton; Shift: TShiftState; X,Y: integer ); override;
			procedure MouseUp( Button: TMouseButton; Shift: TShiftState; X,Y: integer ); override;
 			procedure MouseMove( Shift: TShiftState; X,Y: integer ); override;
    public
      constructor Create( AOwner: TComponent ); override;
      destructor Destroy; override;
      property CustomCharset: Boolean read FCustomMask write FCustomMask default false;
      property CellSize : integer read FCellSize;
      property CharWidth : integer read FCharWidth;
    published
      property Align;
      property Tag;
      property Animation : boolean read FAnimation write SetAnimationOnOff default false;
      property AnimationRate : integer read FAnimationRate write SetAnimationRate default 500;
      property BackColor : TColor read FBackColor write SetBackColor default clBlack;
			property Charset : TBBMask read FBBMask write SetCharset;
      property DotOffColor : TColor read FDotOffColor write SetDotOffColor default clBlack;
      property DotOnColor : TColor read FDotOnColor write SetDotOnColor default clLime;
      property DotSize : integer read FDotSize write SetDotSize default 4;
      property DotStyle : TDotStyle read FDotStyle write SetDotStyle default dsDot;
      property OnClick : TNotifyEvent read FOnClick write FOnClick;
      property OnDblClick : TNotifyEvent read FOnDblClick write FOnDblClick;
      property OnNeedText : TNotifyEvent read FOnNeedText write FOnNeedText;
      property OnMouseDown : TMouseEvent read FOnMouseDown write FOnMouseDown;
      property OnMouseMove : TMouseMoveEvent read FOnMouseMove write FOnMouseMove;
      property OnMouseUp : TMouseEvent read FOnMouseUp write FOnMouseUp;
      property PenOffColor : TColor read FPenOffColor write SetPenOffColor default clTeal;
      property PenOnColor : TColor read FPenOnColor write SetPenOnColor default clRed;
      property Text : string read FText write SetText;

  end;

implementation

uses

	BBAbout, BBEditor;

(*																				*)
(* TBBMask property editor implementation	*)
(*																				*)

procedure TBBMaskPropertyEditor.Edit;
var
	bb: TBillBoard;
  ed: TBillBoardEditor;
begin

	if( PropCount > 0 ) then
  	begin
    	ed := TBillBoardEditor.Create( Application );
      try
      	bb := TBillBoard( GetComponent( 0 ) );
        ed.Execute( bb );
        bb.Refresh;
      finally
      	ed.Free;
      end;
    end;

end;

function TBBMaskPropertyEditor.GetAttributes: TPropertyAttributes;
begin

	Result := [ paMultiSelect, paDialog ];

end;

function TBBMaskPropertyEditor.GetValue: string;
var
	bb: TBillBoard;
begin

	if( PropCount > 0 ) then
  	begin
      try
        bb := TBillBoard( GetComponent( 0 ) );
        if( not( bb.CustomCharset ) ) then
        	Result := 'Default'
        else
        	Result := 'Custom';
      except
      	Result := '?';
      end;
    end;

end;

(*																						*)
(* TBillBoard Component Editor implementation	*)
(*																						*)

function TBillBoardComponentEditor.GetVerbCount: Integer;
begin

  Result := 2;

end;

function TBillBoardComponentEditor.GetVerb( Index: Integer ): string;
begin

	case Index of
  	0: Result := 'About...';
    1: Result := 'Edit charset...';
  end;

end;

procedure TBillBoardComponentEditor.Edit;
begin

  ShowEditor;

end;

procedure TBillBoardComponentEditor.ExecuteVerb( Index: Integer );
begin

	case Index of
  	0: ShowAbout;
    1: ShowEditor;
  end;

end;

procedure TBillBoardComponentEditor.ShowAbout;
var
	bba: TBillBoardAboutBox;
begin

	bba := TBillBoardAboutBox.Create( Application );
	try
    bba.ShowModal;
  finally
    bba.Free;
  end;

end;

procedure TBillBoardComponentEditor.ShowEditor;
var
	bb: TBillBoard;
  ed: TBillBoardEditor;
begin

	ed := TBillBoardEditor.Create( Application );
  try
    bb := TBillBoard( Component );
    ed.Execute( bb );
    bb.Refresh;
  finally
    ed.Free;
  end;

end;

(*																		*)
(* 	TBillBoard control implementation	*)
(*																		*)

constructor TBillBoard.Create( AOwner: TComponent );
begin

  inherited Create( AOwner );

  ControlStyle := ControlStyle + [ csOpaque ];
	FBBMask := TBBMask.Create( Self );
	FCustomMask := false;
  FDotStyle := dsDot;
  FBackColor := clBlack;
  FDotOnColor := clLime;
  FDotOffColor := clBlack;
  FPenOnColor := clRed;
  FPenOffColor := clTeal;
  FText := 'Mansoft Inform醫ica';
  FDotSize := 4;
  SetSizes;
  Width := FCharWidth * Length( FText );
  Height := FCharHeight;
  FAnimationRate := 500;
  FChanged := true;

end;

destructor TBillBoard.Destroy;
begin

	if( Assigned( FOnBmp ) ) then
  	FOnBmp.Free;

	if( Assigned( FBackGndBmp ) ) then
  	FBackGndBmp.Free;

  inherited Destroy;

end;

procedure TBillBoard.DefineProperties( Filer: TFiler );
begin

	inherited DefineProperties( Filer );

  Filer.DefineProperty( 'CustomMask', ReadCustomMask, WriteCustomMask, true );
  Filer.DefineBinaryProperty( 'Custom', ReadCustom, WriteCustom, CustomCharset );

end;

procedure TBillBoard.ReadCustomMask( reader: TReader );
begin

	FCustomMask := reader.ReadBoolean;

end;

procedure TBillBoard.WriteCustomMask( writer: TWriter );
begin

	writer.WriteBoolean( FCustomMask );

end;

procedure TBillBoard.ReadCustom( stream: TStream );
begin

	FBBMask.Load( stream );

end;

procedure TBillBoard.WriteCustom( stream: TStream );
begin

	FBBMask.Save( stream );

end;

procedure TBillBoard.SetSizes;
begin

  FCellSize := FDotSize + ( GapWidth * 2 );
  FCharWidth := ( MaskCharWidth + GapWidth ) * FCellSize;
  FCharHeight := MaskCharHeight * FCellSize;

end;

procedure TBillBoard.SetCharset( Value: TBBMask );
begin

	FBBMask.Copy( Value );

end;

procedure TBillBoard.SetBackColor( Value: TColor );
begin

  if( Value <> FBackColor ) then
    begin
      FBackColor := Value;
      FChanged := true;
      Refresh;
    end;

end;

procedure TBillBoard.SetDotOnColor( Value: TColor );