ledcntrl.pas

一个音乐 CD 播放程序

unit Ledcntrl;

interface

uses
  SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
  Forms, Dialogs;

type
  TLEDDisp = class(TGraphicControl)
  private
	 FDisplay: string ;
	 FEnabled: Boolean;
    FDisplayType: Integer;
	 { Private declarations }
  protected
	 { Protected declarations }
	 procedure Paint; override;
	 procedure SetDisplay(s: string);
	 procedure SetEnabled(e: Boolean);
    procedure SetDisplayType(t: integer);
  public
	 { Public declarations }
	 constructor Create(Anowner: TComponent); override;
	 destructor Destroy; override;
  published
	 { Published declarations }
	 property Display: string read FDisplay write SetDisplay;
	 property Enabled: Boolean read FEnabled write SetEnabled;
    property DisplayType: integer read FDisplayType write SetDisplayType;
  end;

var
	LEDs,LCDs: TBitmap;
const	cnt: integer=0;

procedure Register;
procedure GetLed(dig: char; state: boolean; var r: Trect);

implementation
{$R LEDCNTRL.RES}

constructor TLEDDisp.Create(Anowner: TComponent);
begin
	inherited Create(Anowner);
	if cnt=0 then
	begin
		leds:=TBitmap.Create;
      lcds:=TBitmap.Create;
		LEDs.Handle:=LoadBitmap(HInstance,'LEDS');
		LCDs.Handle:=LoadBitmap(HInstance,'LCDS');
	end;
	inc(cnt);
end;

destructor TLEDDisp.Destroy;
begin
	dec (cnt);
   if cnt=0 then
   begin
      LEDs.Free;
      LCDs.Free;
   end;
	inherited Destroy;
end;

procedure TLEDDisp.SetEnabled(e: Boolean);
begin
	if e<>FEnabled then
	begin
		FEnabled:=e;
		Paint;
	end;
end;

procedure TLEDDisp.SetDisplay(s: string);
begin
	if s<>FDisplay then
	begin
		FDisplay:=s;
		Paint;
	end;
end;

procedure TLEDDisp.SetDisplayType(t: integer);
begin
   if t<>FDisplayType then
   begin
      FDisplayType:=t;
      Paint;
   end;
end;

procedure TLEDDisp.Paint;
var
	lp: integer;
   s,d: Trect;
begin
   d.left:=0;
   d.top:=0;
   d.bottom:=32;
   for lp:=1 to length(Display) do
	begin
      Getled(Display[lp],FEnabled,s);
      d.right:=(s.right-s.left)+d.left;
      if FDisplayType=0 then
   		canvas.copyrect(d,LEDs.Canvas,s)
      else
   		canvas.copyrect(d,LCDs.Canvas,s);
      d.left:=d.right;
	end;
end;

procedure GetLed(dig: char; state: boolean; var r: Trect);
begin
   r.top:=0;
   r.bottom:=32;
	case state of
		True:
			case dig of
         	'0'..'9': begin
               r.left:=(integer(dig)-48)*16;
               r.right:=r.left+16;
            end;
				'.': begin
               r.left:=177;
               r.right:=181;
				end;
			else
				r.left:=160;
            r.right:=176;
			end;
		False:
			if dig ='.' then
         begin
            r.left:=183;
            r.right:=187;
         end
			else
         begin
				r.left:=160;
            r.right:=176;
			end;
	end;
end;

procedure Register;
begin
  RegisterComponents('Samples', [TLEDDisp]);
end;

end.