source: branches/zoom/Packages/CevoComponents/ButtonG.pas

unit ButtonG;

interface

uses
  Classes, SysUtils, LCLIntf, LCLType, ButtonBase, GraphicSet;

type

  { TButtonG }

  TButtonG = class(TButtonBase)
  private
    FBackgroundDownName: string;
    FBackgroundDownIndex: Integer;
    FBackgroundUpName: string;
    FBackgroundUpIndex: Integer;
    FGlyphIndex: Integer;
    FGlyphName: string;
    FGraphicSet: TGraphicSet;
    function GetGraphicSetItem(Index: Integer; Name: string): TGraphicSetItem;
    procedure SetBackgroundDownIndex(AValue: Integer);
    procedure SetBackgroundDownName(AValue: string);
    procedure SetBackgroundUpIndex(AValue: Integer);
    procedure SetBackgroundUpName(AValue: string);
    procedure SetGlyphIndex(AValue: Integer);
    procedure SetGlyphName(AValue: string);
    procedure SetGraphicSet(AValue: TGraphicSet);
  protected
    procedure Paint; override;
    procedure SetVisible(Value: Boolean); override;
  public
    constructor Create(AOwner: TComponent); override;
  published
    property GraphicSet: TGraphicSet read FGraphicSet write SetGraphicSet;
    property BackgroundUpIndex: Integer read FBackgroundUpIndex write SetBackgroundUpIndex default -1;
    property BackgroundUpName: string read FBackgroundUpName write SetBackgroundUpName;
    property BackgroundDownIndex: Integer read FBackgroundDownIndex write SetBackgroundDownIndex default -1;
    property BackgroundDownName: string read FBackgroundDownName write SetBackgroundDownName;
    property GlyphIndex: Integer read FGlyphIndex write SetGlyphIndex default -1;
    property GlyphName: string read FGlyphName write SetGlyphName;
    property Visible;
    property OnClick;
  end;

procedure Register;


implementation

uses
  ScreenTools;

procedure Register;
begin
  RegisterComponents('C-evo', [TButtonG]);
end;

{ TButtonG }

procedure TButtonG.SetGraphicSet(AValue: TGraphicSet);
begin
  if FGraphicSet = AValue then Exit;
  FGraphicSet := AValue;
end;

procedure TButtonG.Paint;
var
  Back: TGraphicSetItem;
  Glyph: TGraphicSetItem;
  Drawn: Boolean;
begin
  Drawn := False;
  with Canvas do begin
    if Assigned(FGraphicSet) then begin
      if FDown then Back := GetGraphicSetItem(FBackgroundDownIndex, FBackgroundDownName)
        else Back := GetGraphicSetItem(FBackgroundUpIndex, FBackgroundUpName);
      if Assigned(Back) then begin
        BitBltCanvas(Canvas, 0, 0, Back.Width, Back.Height, FGraphic.Canvas, Back.Left,
          Back.Top);
        Drawn := True;
      end;
      Glyph := GetGraphicSetItem(FGlyphIndex, FGlyphName);
      if Assigned(Glyph) then begin
        BitBltCanvas(Canvas, 0, 0, Glyph.Width, Glyph.Height, FGraphic.Canvas, Glyph.Left,
          Glyph.Top, SRCAND);
        BitBltCanvas(Canvas, 0, 0, Glyph.Width, Glyph.Height, FGraphic.Canvas, Glyph.Left,
          Glyph.Top, SRCPAINT);
        Drawn := True;
      end;
    end;
    if not Drawn then begin
      Brush.Color := $0000FF;
      FrameRect(Rect(0, 0, Width - 1, Height - 1));
    end;
  end;
end;

procedure TButtonG.SetVisible(Value: Boolean);
begin
  inherited SetVisible(Value);
end;

constructor TButtonG.Create(AOwner: TComponent);
begin
  inherited;
  FBackgroundUpIndex := -1;
  FBackgroundDownIndex := -1;
  FGlyphIndex := -1;
end;

function TButtonG.GetGraphicSetItem(Index: Integer; Name: string): TGraphicSetItem;
begin
  Result := nil;
  if Assigned(FGraphicSet) then begin
    if (Index <> -1) and (Index < FGraphicSet.Items.Count) then
      Result := FGraphicSet.Items[Index]
    else if (Name <> '') then
      Result := FGraphicSet.Items.SearchByName(Name);
  end;
end;

procedure TButtonG.SetBackgroundDownIndex(AValue: Integer);
begin
  if FBackgroundDownIndex = AValue then Exit;
  FBackgroundDownIndex := AValue;
  FBackgroundDownName := '';
end;

procedure TButtonG.SetBackgroundDownName(AValue: string);
begin
  if FBackgroundDownName = AValue then Exit;
  FBackgroundDownName := AValue;
  FBackgroundDownIndex := -1;
end;

procedure TButtonG.SetBackgroundUpIndex(AValue: Integer);
begin
  if FBackgroundUpIndex = AValue then Exit;
  FBackgroundUpIndex := AValue;
  FBackgroundUpName := '';
end;

procedure TButtonG.SetBackgroundUpName(AValue: string);
begin
  if FBackgroundUpName = AValue then Exit;
  FBackgroundUpName := AValue;
  FBackgroundUpIndex := -1;
end;

procedure TButtonG.SetGlyphIndex(AValue: Integer);
begin
  if FGlyphIndex = AValue then Exit;
  FGlyphIndex := AValue;
  FGlyphName := '';
end;

procedure TButtonG.SetGlyphName(AValue: string);
begin
  if FGlyphName = AValue then Exit;
  FGlyphName := AValue;
  FGlyphIndex := -1;
end;

end.