bboard.pas

電子看板的物件程式

begin

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

end;

procedure TBillBoard.SetDotOffColor( Value: TColor );
begin

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

end;

procedure TBillBoard.SetPenOnColor( Value: TColor );
begin

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

end;

procedure TBillBoard.SetPenOffColor( Value: TColor );
begin

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

end;

procedure TBillBoard.SetDotSize( Value: integer );
begin

  if( ( Value <> FDotSize ) and
  		( Value > 1 ) and
      ( Value <= 150 ) ) then
    begin
      FDotSize := Value;
      SetSizes;
      FChanged := true;
      Refresh;
    end;

end;

procedure TBillBoard.SetDotStyle( dotStyle: TDotStyle );
begin

	if( FDotStyle <> dotStyle ) then
  	begin
    	FDotStyle := dotStyle;
      FChanged := true;
      Refresh;
    end;

end;

procedure TBillBoard.SetAnimationOnOff( Value: boolean );
begin

	if( FAnimation <> Value ) then
  	FAnimation := Value;

  if( FAnimation ) then
  	begin
      FStartCell := ( Width div FCellSize ) + 1;
      FStartPoint := Point( FStartCell, 0 );
    	FTimer := TTimer.Create( Application );
      FTimer.OnTimer := OnTimer;
      FTimer.Interval := FAnimationRate;
      FTimer.Enabled := true;
    end
  else
  	begin
    	if( Assigned( FTimer ) ) then
      	begin
          FTimer.Enabled := false;
          FTimer.Free;
          FTimer := nil;
      		FStartPoint := Point( 0, 0 );
          Refresh;
        end;
    end;

end;

procedure TBillBoard.SetAnimationRate( Value: integer );
begin

	if( FAnimationRate <> Value ) then
  	begin
    	if( FAnimation ) then
      	FTimer.Enabled := false;
  		FAnimationRate := Value;
    	if( FAnimation ) then
      	begin
        	FTimer.Interval := Value;
      		FTimer.Enabled := true;
        end;
    end;

end;

procedure TBillBoard.SetText( Value: string );
begin

	if( FText <> Value ) then
    begin
      FText := Value;
      if( FAnimation ) then
        begin
          FAnimation := false;
          FAnimation := true;
        end
      else
      	Refresh;
    end;

end;

procedure TBillBoard.Click;
begin

	inherited Click;

	if( Assigned( FOnClick ) ) then
  	FOnClick( Self );

end;

procedure TBillBoard.DblClick;
begin

	inherited DblClick;

	if( Assigned( FOnDblClick ) ) then
  	FOnDblClick( Self );

end;

procedure TBillBoard.MouseDown( Button: TMouseButton;
																	Shift: TShiftState; X,Y: integer );
begin

	inherited MouseDown( Button, Shift, X, Y );

	if( Assigned( FOnMouseDown ) ) then
  	FOnMouseDown( Self, Button, Shift, X, Y );

end;

procedure TBillBoard.MouseUp( Button: TMouseButton;
      													Shift: TShiftState; X,Y: integer );
begin

	inherited MouseUp( Button, Shift, X, Y );

	if( Assigned( FOnMouseUp ) ) then
  	FOnMouseUp( Self, Button, Shift, X, Y );

end;

procedure TBillBoard.MouseMove( Shift: TShiftState; X,Y: integer );
begin

	inherited MouseMove( Shift, X, Y );

	if( Assigned( FOnMouseMove ) ) then
  	FOnMouseMove( Self, Shift, X, Y );

end;

procedure TBillBoard.OnTimer( Sender: TObject );
begin

	if( Length( FText ) > 0 ) then
  	Refresh;

end;

procedure TBillBoard.Paint;
var
  R: TRect;
  Bitmap: TBitmap;
begin

  inherited Paint;

  if( ( FChanged ) or
  		( Width <> FOldWidth ) or
      ( Height <> FOldHeight ) ) then
  	begin
      R := ClientRect;
    	FBackGndBmp.Free;
      FBackGndBmp := TBitmap.Create;
      FBackGndBmp.Height := Height;
      FBackGndBmp.Width := Width;
      FBackGndBmp.Canvas.Brush.Color := FBackColor;
      FBackGndBmp.Canvas.FillRect( R );
      FOldHeight := Height;
      FOldWidth := Width;
      FChanged := true;
      DrawBackGround( FBackGndBmp );
    end;

  Bitmap := TBitmap.Create;
  Bitmap.Assign( FBackGndBmp );

  if( not( FAnimation ) ) then
  	DrawStaticText( FText, FStartPoint, Bitmap )
  else
  	DrawDynamicText( FText, Bitmap );

  Canvas.CopyMode := cmSrcCopy;
  Canvas.Draw( 0, 0, Bitmap );

  Bitmap.Free;

end;

procedure TBillBoard.DrawBackGround( Bitmap: TBitmap );
var
	col,row: integer;
  x,y,x1,y1: integer;
begin

  Bitmap.Canvas.Pen.Color := FPenOffColor;
  Bitmap.Canvas.Brush.Color := FDotOffColor;

  for row := 0 to ( Height div FDotSize ) + GapWidth do
    begin
      for col := 0 to ( Width div FDotSize ) + GapWidth do
        begin
          x := ( col * FCellSize ) + GapWidth;
          y := ( row * FCellSize ) + GapWidth;
          x1 := x + FCellSize - ( GapWidth * 2 );
          y1 := y + FCellSize - ( GapWidth * 2 );
          if( FDotStyle = dsBulb ) then
            Bitmap.Canvas.Ellipse( x, y, x1, y1 )
          else
            Bitmap.Canvas.Rectangle( x, y, x1, y1 );
        end;
    end;

end;

procedure TBillBoard.DrawDynamicText( Text: string; Bitmap: TBitmap );
var
	i: integer;
  p: TPoint;
begin

  if( FStartPoint.x < -( Length( Text ) * ( MaskCharWidth + GapWidth ) ) ) then
    begin
      if( Assigned( FOnNeedText ) ) then
        FOnNeedText( Self );
      FStartPoint.x := FStartCell;
    end;

  p := FStartPoint;
	if( Length( Text ) <> 0 ) then
  	begin
      for i := 1 to Length( Text ) do
      	begin
          DrawDigit( Text[ i ], p, Bitmap );
          inc( p.x, MaskCharWidth + GapWidth );
        end;
		end;
  dec( FStartPoint.x, GapWidth );

end;

procedure TBillBoard.DrawStaticText( Text: string; Cell: TPoint; Bitmap: TBitmap );
var
	i,j,k,m,n,r,x: integer;
begin

	if( Length( Text ) <> 0 ) then
  	begin
    	x := Cell.x;
    	n := 1;
      m := Width div FCharWidth;
      if( m = 0 ) then
      	m := 1;
			k := Length( Text ) div m;
      r := Length( Text ) mod m;
    	for i := 1 to k do
      	begin
          for j := 1 to m do
            begin
              DrawDigit( Text[ n ], Cell, Bitmap );
              inc( Cell.x, MaskCharWidth + GapWidth );
              inc( n );
            end;
        	inc( Cell.y, MaskCharHeight );
          Cell.x := x;
        end;
      if( r > 0 ) then
        begin
          for j := 1 to r do
            begin
              DrawDigit( Text[ n ], Cell, Bitmap );
              inc( Cell.x, MaskCharWidth + GapWidth );
              inc( n );
            end;
        end;
		end;

end;

procedure TBillBoard.DrawDigit( Digit: Char; FromCell: TPoint; Bitmap: TBitmap );
var
	row,line,maskbit: integer;
  x,y: integer;
  dgt: integer;
  r: TRect;
begin

  Bitmap.Canvas.Pen.Color := FPenOnColor;
  Bitmap.Canvas.Brush.Color := FDotOnColor;

  if( FChanged ) then
  	begin
      r := Rect( 0, 0, FCellSize, FCellSize );
    	FOnBmp.Free;
      FOnBmp := TBitmap.Create;
      FOnBmp.Height := FCellSize;
      FOnBmp.Width := FCellSize;
      FOnBmp.Canvas.Brush.Color := FBackColor;
      FOnBmp.Canvas.FillRect( r );
  		FOnBmp.Canvas.Pen.Color := FPenOnColor;
      FOnBmp.Canvas.Brush.Color := FDotOnColor;
      if( FDotStyle = dsBulb ) then
        FOnBmp.Canvas.Ellipse( GapWidth, GapWidth, FCellSize - GapWidth, FCellSize - GapWidth )
      else
        FOnBmp.Canvas.Rectangle( GapWidth, GapWidth, FCellSize - GapWidth, FCellSize - GapWidth );
      FChanged := false;
    end;

	dgt := Ord( Digit );

  for maskbit := MaskCharWidth - 1 downto 0 do
  	begin
  		row := FromCell.y;
      for line := 0 to MaskCharHeight - 1 do
        begin
          x := FromCell.x * FCellSize;
          y := row * FCellSize;
          if( ( FBBMask.Item[ dgt, line ] and ( $01 shl maskbit ) ) <> 0 ) then
          	Bitmap.Canvas.Draw( x, y, FOnBmp );
      		inc( row );
        end;
      inc( FromCell.x );
    end;

end;

(*									*)
(* Register all...	*)
(*									*)

procedure Register;
begin

  RegisterComponentEditor( TBillBoard, TBillBoardComponentEditor );

	RegisterPropertyEditor(	TypeInfo( TBBMask ), TBillBoard,
                          'Charset', TBBMaskPropertyEditor );

  RegisterComponents(	'Mansoft', [ TBillBoard ] );

end;

end.