ledbtn.pas

Ket noi web voi xml

unit LedBtn;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, Buttons,
  MMSystem;

type

  TLEDType = (RoundLED, TriLEDDown, TriLEDUp, RedLed);

  TLedButton = class(TButton)
  private
    { Private declarations }
    FSoundFile: PString;
    F3DCaption : Boolean;
    FCanvas    : TCanvas;
    FStyle     : TButtonStyle;
    FGlyph     : TBitmap;
    FLedType   : TLEDType;
    IsFocused  : Boolean;
    ExtraSpace : word;
    HasMouse,
    IsMouseDown,
    IsClicked  : boolean;

    procedure SetStyle(Value: TButtonStyle);
    procedure DrawItem(const DrawItemStruct: TDrawItemStruct);
    procedure SetLEDType(value: TLEDType);
    procedure CNMeasureItem(var Message: TWMMeasureItem); message CN_MEASUREITEM;
    procedure CNDrawItem(var Message: TWMDrawItem); message CN_DRAWITEM;
    procedure CMFontChanged(var Message: TMessage); message CM_FONTCHANGED;
    procedure CMEnabledChanged(var Message: TMessage); message CM_ENABLEDCHANGED;
    procedure WMLButtonDblClk(var Message: TWMLButtonDblClk);
      message WM_LBUTTONDBLCLK;
    procedure CMMouseEnter(var Message: TMessage); message CM_MOUSEENTER;
    procedure CMMouseLeave(var Message: TMessage); message CM_MOUSELEAVE;
    function  GetSoundFile: String;
    procedure SetSoundFile(const V: String);

  protected
    { Protected declarations }
    procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;
    procedure MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;
    procedure SetButtonStyle(ADefault: Boolean); override;
    procedure CreateParams(var Params: TCreateParams); override;
    procedure WMMouseMove(var Message: TWMMouseMove); message WM_MOUSEMOVE;
    procedure WMLButtonDblClick(var Message: TWMLButtonDown); message WM_LBUTTONDOWN;
    procedure WMMButtonDblClick(var Message: TWMMButtonDown); message WM_MBUTTONDOWN;
    procedure WMRButtonDblClick(var Message: TWMRButtonDown); message WM_RBUTTONDOWN;
    procedure SetCaption3D(AValue : boolean);
    procedure PlaySoundFile(const FileName: String; uFlags: word);
  public
    { Public declarations }
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure Click; override;
  published
    { Published declarations }
    property SoundFile: String  read GetSoundFile write SetSoundFile;
    property LEDType   : TLEDType read FLEDType write SetLEDType default RoundLED;
    property Style     : TButtonStyle read FStyle write SetStyle default bsAutoDetect;
    property Caption3D : Boolean read F3DCaption write SetCaption3D default False;
  end;



implementation

{$R *.RES}

constructor TLedButton.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  LEDType := RoundLED;
  FCanvas := TCanvas.Create;
  FGlyph  := TBitmap.Create;
  FGlyph.Handle := LoadBitmap(HInstance, 'OFF3');
  Width := 85;
end;

destructor TLedButton.Destroy;
begin
  inherited Destroy;
  FGlyph.Free;
  FCanvas.Free;
end;

procedure TLedButton.SetLEDType(value: TLEDType);
begin
  if value <> FLEDType then
  begin
    FLEDType := value;
    case FLEDType of
         RoundLED:   FGlyph.Handle := LoadBitmap(HInstance, 'OFF3');
         TriLEDDown: FGlyph.Handle := LoadBitmap(HInstance, 'OFF1');
         TriLEDUp:   FGlyph.Handle := LoadBitmap(HInstance, 'OFF2');
         RedLed  :   FGlyph.Handle := LoadBitmap(HInstance, 'OFF4');
    end;
    Repaint;
  end;
end;


procedure TLedButton.CNMeasureItem(var Message: TWMMeasureItem);
begin
  with Message.MeasureItemStruct^ do
  begin
    itemWidth := Width;
    itemHeight := Height;
  end;
end;

procedure TLedButton.CNDrawItem(var Message: TWMDrawItem);
begin
  DrawItem(Message.DrawItemStruct^);
end;

procedure TLedButton.DrawItem(const DrawItemStruct: TDrawItemStruct);
var
  IsDown, IsDefault
            : Boolean;
  R         : TRect;
  Flags     : Longint;
  GlyphTop,
  GlyphLeft : integer;
  GlyphRect, BitmapRect : TRect;
  TextRect,TmpRect      : TRect;

begin
  FCanvas.Handle := DrawItemStruct.hDC;
  R := ClientRect;

  with DrawItemStruct do
  begin
    IsDown := itemState and ODS_SELECTED <> 0;
    IsDefault := itemState and ODS_FOCUS <> 0;
  end;

  Flags := DFCS_BUTTONPUSH or DFCS_ADJUSTRECT;
  if IsDown then Flags := Flags or DFCS_PUSHED;
  if DrawItemStruct.itemState and ODS_DISABLED <> 0 then
    Flags := Flags or DFCS_INACTIVE;

  { DrawFrameControl doesn't allow for drawing a button as the
      default button, so it must be done here. }
  if IsFocused or IsDefault then
  begin
    FCanvas.Pen.Color := clWindowFrame;
    FCanvas.Pen.Width := 1;
    FCanvas.Brush.Style := bsClear;
    FCanvas.Rectangle(R.Left, R.Top, R.Right, R.Bottom);

    { DrawFrameControl must draw within this border }
    InflateRect(R, -1, -1);
  end;

  { DrawFrameControl does not draw a pressed button correctly }
  if IsDown then
  begin
    FCanvas.Pen.Color := clBtnShadow;
    FCanvas.Pen.Width := 1;
    FCanvas.Brush.Color := clBtnFace;
    FCanvas.Rectangle(R.Left, R.Top, R.Right, R.Bottom);
    InflateRect(R, -1, -1);
  end
  else
    begin
      FCanvas.Pen.Color := clBtnShadow;
      FCanvas.Pen.Width := 1;
      FCanvas.Brush.Color := clBtnFace;
      FCanvas.Rectangle(R.Left, R.Top, R.Right, R.Bottom);
      DrawFrameControl(DrawItemStruct.hDC, R, DFC_BUTTON, Flags);
    end;

  if IsFocused then
  begin
    R := ClientRect;
    InflateRect(R, -1, -1);
  end;

  FCanvas.Font := Self.Font;
  if IsDown then
    OffsetRect(R, 1, 1);

  GlyphTop   := ((Height - FGlyph.Height) div 2) + ExtraSpace;
  GlyphLeft  := 7 + ExtraSpace;
  GlyphRect  := Rect(GlyphLeft, GlyphTop, FGlyph.Width+GlyphLeft, FGlyph.Height+GlyphTop);
  BitmapRect := Rect(0, 0, FGlyph.Width, FGlyph.Height);

    if HasMouse then
    begin
       if IsMouseDown then
       begin
          case FLEDType of
               RoundLED:   FGlyph.Handle := LoadBitmap(HInstance, 'DOWN3');
               TriLEDDown: FGlyph.Handle := LoadBitmap(HInstance, 'DOWN1');
               TriLEDUp:   FGlyph.Handle := LoadBitmap(HInstance, 'DOWN2');
               RedLed  :   FGlyph.Handle := LoadBitmap(HInstance, 'DOWN4');
          end;
       end
       else
       begin
          case FLEDType of
               RoundLED:   FGlyph.Handle := LoadBitmap(HInstance, 'ON3');
               TriLEDDown: FGlyph.Handle := LoadBitmap(HInstance, 'ON1');
               TriLEDUp:   FGlyph.Handle := LoadBitmap(HInstance, 'ON2');
               RedLed  :   FGlyph.Handle := LoadBitmap(HInstance, 'ON4');
          end;
       end;
    end
    else
    begin
       case FLEDType of
            RoundLED:   FGlyph.Handle := LoadBitmap(HInstance, 'OFF3');
            TriLEDDown: FGlyph.Handle := LoadBitmap(HInstance, 'OFF1');
            TriLEDUp:   FGlyph.Handle := LoadBitmap(HInstance, 'OFF2');
            RedLed  :   FGlyph.Handle := LoadBitmap(HInstance, 'OFF4');
       end;
    end;

    FCanvas.BrushCopy(GlyphRect, FGlyph, BitmapRect, clYellow);

    if (not F3DCaption) then
      begin
       if not Enabled then Font.Color := clGray;
       FCanvas.TextOut(GlyphLeft+ FGlyph.Width,
       ((Height - FCanvas.TextHeight(Pchar(Caption))) div 2)+ExtraSpace,Pchar(Caption));
     end
       else
        begin
          FCanvas.Brush.Style := bsClear;
          TextRect   := ClientRect;
          OffsetRect(TextRect,GlyphLeft+ FGlyph.Width,
          ((Height - FCanvas.TextHeight(Pchar(Caption))) div 2)+ExtraSpace);

          FCanvas.Font.Color := clBtnShadow;
          TmpRect := TextRect;
          OffsetRect( TmpRect, 1, 1 );
          DrawText(FCanvas.Handle, PChar(Caption), Length(Caption), TmpRect, DT_WORDBREAK or DT_NOPREFIX);

          FCanvas.Font.Color := clBtnHighlight;
          TmpRect := TextRect;
          OffsetRect( TmpRect, -1, -1 );
          DrawText(FCanvas.Handle, PChar(Caption), Length(Caption), TmpRect, DT_WORDBREAK or DT_NOPREFIX);

          if not Enabled then Font.Color := clGray;
          FCanvas.Font.Color := Font.Color;
          DrawText(FCanvas.Handle, PChar(Caption), Length(Caption), TextRect, DT_WORDBREAK or DT_NOPREFIX);
        end;


  if IsFocused and IsDefault then
  begin
    R := ClientRect;
    InflateRect(R, -4, -4);
    FCanvas.Pen.Color := clWindowFrame;
    FCanvas.Brush.Color := clBtnFace;
    DrawFocusRect(FCanvas.Handle, R);
  end;

  FCanvas.Handle := 0;
end;

procedure TLedButton.CMFontChanged(var Message: TMessage);
begin
  inherited;
  Invalidate;
end;

procedure TLedButton.CMEnabledChanged(var Message: TMessage);
begin
  inherited;
  Invalidate;
end;

procedure TLedButton.WMLButtonDblClk(var Message: TWMLButtonDblClk);
begin
  Perform(WM_LBUTTONDOWN, Message.Keys, Longint(Message.Pos));
end;


procedure TLedButton.SetButtonStyle(ADefault: Boolean);
begin
  if ADefault <> IsFocused then
  begin
    IsFocused := ADefault;
    Refresh;
  end;
end;

procedure TLedButton.SetStyle(Value: TButtonStyle);
begin
  if Value <> FStyle then
  begin
    FStyle := Value;
    Invalidate;
  end;
end;


procedure TLedButton.CreateParams(var Params: TCreateParams);
begin
  inherited CreateParams(Params);
  with Params do Style := Style or BS_OWNERDRAW;
end;

procedure TLedButton.Click;
Var Param : Word;
begin
  if Enabled then
  begin
    isClicked := true;
    if SoundFile <> '' then
      begin
        Param := snd_Async+snd_NoDefault;
        PlaySoundFile(SoundFile,Param);
      end
       else
        case ModalResult of
         mrOK,
         mrYes,
         mrAll,
         mrYesToAll   : MessageBeep(MB_OK);
         mrCancel,
         mrAbort      : MessageBeep(MB_ICONEXCLAMATION);
         mrIgnore,
         mrRetry      : MessageBeep(MB_ICONQUESTION);
         mrNo,
         mrNoToAll    : MessageBeep(MB_ICONHAND);
        end;
    inherited Click;
  end;
end;

procedure TLedButton.MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
  if Enabled then
  begin
    HasMouse := true;
    IsMouseDown := true;
    Repaint;
    inherited MouseDown(Button, Shift, X, Y);
  end;
end;

procedure TLedButton.MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
  if Enabled then
  begin
    IsMouseDown := false;
    Repaint;
    inherited MouseUp(Button, Shift, X, Y);
  end;
end;

procedure TLedButton.CMMouseEnter(var Message: TMessage);
begin
  if Enabled then
  begin
    HasMouse := true;
    Repaint;
  end;
end;

procedure TLedButton.CMMouseLeave(var Message: TMessage);
begin
  if Enabled then
  begin
    isClicked := true;
    HasMouse := false;
    Repaint;
  end;
end;

procedure TLedButton.WMMouseMove(var Message: TWMMouseMove);
var
  CurrentPoint: TPoint;
begin
  if Enabled then
  begin
    CurrentPoint.X := Message.XPos;
    CurrentPoint.Y := Message.YPos;
    if not HasMouse and PtInRect(GetClientRect, CurrentPoint) then
    begin
      HasMouse := true;
      Repaint;
    end;
  end;
  inherited;
end;

procedure TLedButton.WMLButtonDblClick(var Message: TWMLButtonDown);
begin
  IsMouseDown := false;
  if Enabled then Inherited;
end;

procedure TLedButton.WMMButtonDblClick(var Message: TWMMButtonDown);
begin
  IsMouseDown := false;
  if Enabled then Inherited;
end;

procedure TLedButton.WMRButtonDblClick(var Message: TWMRButtonDown);
begin
  IsMouseDown := false;
  if Enabled then Inherited;
end;


procedure TLedButton.SetCaption3D(AValue : boolean);
begin
  if AValue <> F3Dcaption then
    begin
      F3DCaption := AValue;
      Repaint;
    end;
end;


procedure TLedButton.PlaySoundFile(const FileName: String; uFlags: word);

var
  SName: array[0..128] of char;

begin
  if (length(FileName) > 0)
    then begin
           StrPCopy(SName,FileName);
           sndPlaySound(SName,uFlags);
         end
    else sndPlaySound(NIL,0);
end;


function TLedButton.GetSoundFile: String;

begin
  if (FSoundFile <> NIL)
    then Result := FSoundFile^
    else Result := '';
end;

procedure TLedButton.SetSoundFile(const V: String);

var
  Param: word;

begin
  AssignStr(FSoundFile,V);
  PlaySoundFile('',0);
  if (length(SoundFile) > 0) and (csDesigning in ComponentState)
    then
      begin
         Param := snd_Async+snd_NoDefault;
         PlaySoundFile(Soundfile,Param);
      end;
end;



end.