dsfancybutton.pas

componete para dar presentacion a tus aplicaciones es indispensable para una buena presentacion

  Canvas.Pen.Style:=psDot;
  Canvas.Pen.Color:=clGray;
  case FEffect.Shape of
    btnRectangle:
      begin
        Dia:=2*FEffect.CornerRadius;
        Canvas.RoundRect(0, 0, Width, Height, Dia, Dia);
      end;
    btnCapsule:
      begin
        if Width<Height then Dia:=Width else Dia:=Height;
        Canvas.RoundRect(0, 0, Width, Height, Dia, Dia);
      end;
    btnOval: Canvas.Ellipse(0, 0, Width, Height);
  end; //case
  Canvas.Pen.Style:=psSolid;
end;

function TDsFancyButton.ColorLevel(BaseColor: TColor; Value: Integer): TColor;
var R, G, B: Byte;
begin
  BaseColor:=ColorToRGB(BaseColor);

  R:=GetRValue(BaseColor);
  G:=GetGValue(BaseColor);
  B:=GetBValue(BaseColor);

  if Value>0 then
  begin
    R:=Min(255, R+Value);
    G:=Min(255, G+Value);
    B:=Min(255, B+Value);
  end
  else
  begin
    R:=Max(0, R+Value);
    G:=Max(0, G+Value);
    B:=Max(0, B+Value);
  end;
  Result:=RGB(R, G, B);
end;

procedure TDsFancyButton.Additional3DEffect;
var cx, cy: Integer;
begin
  cx:=FEffect.FCornerRadius;
  cy:=FEffect.FCornerRadius;

  with Canvas do
  begin
    if FIsDown then Pen.Color:=ColorLevel(Color, -10)
    else Pen.Color:=ColorLevel(Color, -15);
    Brush.Style:=bsClear;
    if FEffect.FBtnShape=btnOval then
      begin cx:=Width div 2; cy:=Height div 2; end
    else if FEffect.FBtnShape=btnCapsule then
      if Width>Height then begin cy:=Height div 2; cx:=cy; end
      else begin cx:=Width div 2; cy:=cx; end;

    Arc(1+1, 1+1, 2*cx+2, 2*cy+2, cx+1, 0, 0, cy+1);
    MoveTo(2, cy+1); LineTo(2, Height-cy-1);
    MoveTo(cx+1, 2); LineTo(Width-cx-1, 2);
  end;
end;

procedure TDsFancyButton.DrawButtonFace;
var
  FC, Warna: TColor;
  R, G, B: Byte;
  AwalR, AwalG, AwalB,
  AkhirR, AkhirG, AkhirB,
  n, t, Dia: Integer;
  FRgn: HRgn;
  TempValue: real;
  ofs: Integer;
begin
  if FIsDown then
    Warna:=ColorToRGB(Color)
  else if FInRegion then
    Warna:=ColorLevel(Color, 10)
  else
    Warna:=ColorToRGB(Color);

  FC:=ColorLevel(Warna, -80);
  AwalR:=GetRValue(FC); AkhirR:=GetRValue(Warna);
  AwalG:=GetGValue(FC); AkhirG:=GetGValue(Warna);
  AwalB:=GetBValue(FC); AkhirB:=GetBValue(Warna);

  t:=FEffect.FFrameWidth;
  ofs:=0;
  if FIsDown then ofs:=2;
  for n:=0 to t-1 do
  begin
    if FIsDown then if n>(t div 3) then Break;
    TempValue:=Sqrt(t*t-Sqr(t-n))/t;
    R:=AwalR+Round(TempValue*(AkhirR-AwalR));
    G:=AwalG+Round(TempValue*(AkhirG-AwalG));
    B:=AwalB+Round(TempValue*(AkhirB-AwalB));
    Canvas.Brush.Color:=RGB(R, G, B);

    if FEffect.Shape=btnOval then
      FRgn:=CreateEllipticRgn(n+1+ofs, n+1+ofs, Width-n+ofs-1, Height-n+ofs-1)
    else
    begin
      if FEffect.Shape=btnCapsule then
        if Width<Height then Dia:=Width else Dia:=Height
      else Dia:=2*FEffect.CornerRadius;

      if (Dia-2*n)>0 then
        FRgn:=CreateRoundRectRgn(n+1+ofs, n+1+ofs, Width-n+ofs-1, Height-n+ofs-1, Dia-2*n, Dia-2*n)
      else FRgn:=CreateRectRgn(n+1+ofs, n+1+ofs, Width-n+ofs-1, Height-n+ofs-1);
    end;

    try
      FillRgn(Canvas.Handle, FRgn, Canvas.Brush.Handle);
    finally
      DeleteObject(FRgn);
    end;
  end;
  Additional3DEffect;
end;

procedure TDsFancyButton.WriteCaption;
var Flags: Word;
    BtnL, BtnT, BtnR, BtnB: Integer;
    R, TR: TRect;
    FTextColor: TColor;
begin
  R:=ClientRect; TR:=ClientRect;
  Canvas.Brush.Style:=bsClear;
  Flags:=DT_CENTER or DT_SINGLELINE;
  Canvas.Font:=Font;

  if FInRegion and not FIsDown then FTextColor:=FEffect.HoverColor
  else FTextColor:=Self.Font.Color;

  with canvas do
  begin
    BtnT:=FTextT;
    BtnB:=BtnT+TextHeight(Caption);
    BtnL:=FTextL;
    BtnR:=BtnL+TextWidth(Caption);
    TR:=Rect(BtnL, BtnT, BtnR, BtnB);
    R:=TR;

    if (FEffect.TextStyle=txLowered) and not FIsDown then
    begin
      Font.Color:=ColorLevel(Color, 25);
      OffsetRect(TR, 1, 1);
      DrawText(Handle, PChar(Caption), Length(Caption), TR, Flags);
    end
    else if (FEffect.TextStyle=txLowered) and FIsDown then
    begin
      Font.Color:=ColorLevel(Color, 25);
      OffsetRect(TR, 2, 2);
      DrawText(Handle, PChar(Caption), Length(Caption), TR, Flags);
    end
    else if (FEffect.TextStyle=txRaised) and not FIsDown then
    begin
      Font.Color:=ColorLevel(Color, 25);
      OffsetRect(TR, -1, -1);
      DrawText(Handle, PChar(Caption), Length(Caption), TR, Flags);
    end
    else if (FEffect.TextStyle=txRaised) and FIsDown then
    begin
      Font.Color:=ColorLevel(Color, 25);
      DrawText(Handle, PChar(Caption), Length(Caption), TR, Flags);
    end
    else if (FEffect.TextStyle=txShadowed) and FIsDown then
    begin
      Font.Color:=ColorLevel(Color, -50);
      OffsetRect(TR, 3, 3);
      DrawText(Handle, PChar(Caption), Length(Caption), TR, Flags);
    end
    else if (FEffect.TextStyle=txShadowed) and not FIsDown then
    begin
      Font.Color:=ColorLevel(Color, -50);
      OffsetRect(TR, 2, 2);
      DrawText(Handle, PChar(Caption), Length(Caption), TR, Flags);
    end;

    if Enabled then Font.Color:=FTextColor
    else if (FEffect.TextStyle=txShadowed) and not Enabled then
      Font.Color:=clBtnFace
    else Font.Color:=clBtnShadow;
    if FIsDown then OffsetRect(R, 1, 1);
    DrawText(Handle, PChar(Caption), Length(Caption), R, Flags);
  end;
end;

procedure TDsFancyButton.LayoutSetting;
var n: Integer;
    wg, hg, wt, ht: Integer;
    dist: Integer;
begin
  dist:=FGlyphs.Distance;
  wg:=FGlyphs.Glyph.Width div FGlyphs.Number;
  hg:=FGlyphs.Glyph.Height;
  wt:=Canvas.TextWidth(Caption);
  ht:=Canvas.TextHeight(Caption);
  case FGlyphs.Layout of
    lyLeft  : begin
                if Width>(wg+dist+wt) then FGlyphL:=(Width-wg-dist-wt) div 2
                else FGlyphL:=0;
                if Height>hg then FGlyphT:=(Height-hg) div 2-1 else FGlyphT:=0;
                FTextL:=FGlyphL+FBmpWidth+dist;
                FTextT:=(Height-ht) div 2-1;
              end;
    lyRight : begin
                if Width>(wg+dist+wt) then n:=(Width-wg-dist-wt) div 2
                else n:=0;
                FGlyphL:=Width-n-wg;
                if Height>hg then FGlyphT:=(Height-hg) div 2-1 else FGlyphT:=0;
                FTextL:=FGlyphL-wt-dist;
                FTextT:=(Height-ht) div 2-1;
              end;
    lyTop   : begin
                if Width>wg then FGlyphL:=(Width-wg) div 2 else FGlyphL:=0;
                if Height>(hg+dist+ht) then FGlyphT:=(Height-hg-dist-ht) div 2-1
                else FGlyphT:=0;
                FTextL:=(Width-wt) div 2;
                FTextT:=FGlyphT+FGlyphs.Glyph.Height+dist;
              end;
    lyBottom: begin
                if Width>wg then FGlyphL:=(Width-wg) div 2 else FGlyphL:=0;
                if Height>(hg+dist+ht) then n:=(Height-hg-dist-ht) div 2
                else n:=0;
                FGlyphT:=Height-n-hg;
                FTextL:=(Width-wt) div 2;
                FTextT:=FGlyphT-dist-ht;
              end;
    lyCenter: begin
                if Width>wg then FGlyphL:=(Width-wg) div 2 else FGlyphL:=0;
                if Height>hg then FGlyphT:=(Height-hg) div 2 else FGlyphT:=0;
                FTextL:=(Width-wt) div 2;
                FTextT:=(Height-ht) div 2;
              end;
  end;
end;

procedure TDsFancyButton.DrawGlyph;
var c: Byte;
    R: TRect;
    clr, c1: TColor;
    FBmp, BmpTemp: TBitmap;
    x, y: Integer;
begin
  R.Left:=FGlyphL;  R.Right:=FGlyphL+FBmpWidth;
  R.Top:=FGlyphT;   R.Bottom:=FGlyphT+FGlyphs.Glyph.Height;
  if FIsDown then OffsetRect(R, 1, 1);
  if FGlyphToDraw>FGlyphs.Number then FGlyphToDraw:=1;

  { 1=enabled  2=disabled  3=pressed  4=pointed }
  c:=0;
  case FGlyphToDraw of
    1: c:=0;
    2: c:=1;
    3: c:=2;
    4: c:=3;
  end;

  BmpTemp:=TBitmap.Create;
  BmpTemp.Width:=FGlyphs.FBmpGlyph.Width div FGlyphs.FGlyphsNum;
  BmpTemp.Height:=FGlyphs.FBmpGlyph.Height;
  BmpTemp.Canvas.Draw(-c*BmpTemp.Width, 0, FGlyphs.FBmpGlyph);

  {--glyph style--}
  clr:=BmpTemp.Canvas.Pixels[0, BmpTemp.Height-1];
  FBmp:=TBitmap.Create;
  try
    FBmp.Assign(BmpTemp);
    FBmp.Width:=BmpTemp.Width;
    FBmp.Height:=BmpTemp.Height;

    FBmp.Transparent:=True;
    FBmp.TransparentMode:=tmAuto;

    case FGlyphs.GlyphStyle of
      gsRaised : c1:=ColorLevel(Color, 20);
      gsLowered: c1:=ColorLevel(Color, -30);
    end;
    if FIsDown then
      c1:=ColorLevel(Color, -50);

    if FIsDown or (FGlyphs.GlyphStyle<>gsNormal) then
    begin
      for x:=0 to FBmp.Width-1 do
      for y:=0 to FBmp.Height-1 do
        if FGlyphs.FBmpGlyph.Canvas.Pixels[x,y]<>clr then
          FBmp.Canvas.Pixels[x,y]:=c1;
      Canvas.Draw(R.Left-1, R.Top-1, FBmp);
    end;

    case FGlyphs.GlyphStyle of
      gsRaised : c1:=ColorLevel(Color, -50);
      gsLowered: c1:=ColorLevel(Color, 25);
    end;

    if FIsDown then
      c1:=ColorLevel(Color, 20);

    if FIsDown or (FGlyphs.GlyphStyle<>gsNormal) then
    begin
      for x:=0 to FBmp.Width-1 do
      for y:=0 to FBmp.Height-1 do
        if FGlyphs.FBmpGlyph.Canvas.Pixels[x,y]<>clr then
          FBmp.Canvas.Pixels[x,y]:=c1;
      Canvas.Draw(R.Left+1, R.Top+1, FBmp);
    end;
  finally
    FBmp.Free;
  end;
  BmpTemp.Free;

  FTransparentColor:=FGlyphs.Glyph.Canvas.Pixels[0, FGlyphs.Glyph.Height-1];
  Canvas.BrushCopy(R, FGlyphs.Glyph,
                   Bounds(c*FBmpWidth, 0, FBmpWidth, FGlyphs.Glyph.Height),
                   FTransparentColor);
end;

procedure TDsFancyButton.UpdateChanges(Sender: TObject);
begin
  if csLoading in ComponentState then Exit;
  Invalidate;
end;

procedure TDsFancyButton.MouseDown(Button: TMouseButton;
          Shift: TShiftState; X, Y: Integer);
begin
  inherited MouseDown(Button, Shift, X, Y);
  if Button=mbRight then Exit;
  if not FInRegion then Exit;
  FIsDown:=True;
  FGlyphToDraw:=3;
  Invalidate;
end;

procedure TDsFancyButton.MouseUp(Button: TMouseButton;
          Shift: TShiftState; X, Y: Integer);
begin
  inherited MouseUp(Button, Shift, X, Y);
  if Button=mbRight then Exit;
  if not FInRegion then Exit;
  inherited Click;
  FIsDown:=False;
  Invalidate;
end;

procedure TDsFancyButton.MouseMove(Shift: TShiftState; X, Y: Integer);
begin
  inherited MouseMove(Shift, X, Y);
  if FIsDown then Exit;
  if IsInRegion(X, Y) then
  begin
    FInRegion:=True;
    if (FGlyphToDraw<>4) then
      begin FGlyphToDraw:=4; Invalidate; end;
  end
  else
  begin
    FInRegion:=False;
    if FGlyphToDraw<>1 then
      begin FGlyphToDraw:=1; Invalidate; end;
  end;
end;

procedure TDsFancyButton.CMEnabledChanged(var Message: TMessage);
begin
  inherited;
  if not Enabled then FGlyphToDraw:=2
  else FGlyphToDraw:=1; 
  invalidate;
end;

procedure TDsFancyButton.CMTextChanged(var Message: TMessage);
begin
  inherited;
  Invalidate;
end;

procedure TDsFancyButton.CMDialogChar(var Message: TCMDialogChar);
begin
  with Message do
    if IsAccel(CharCode, Caption) and Enabled then
      begin inherited Click; Result:=1; end
    else inherited;
end;

procedure TDsFancyButton.CMMouseLeave(var AMsg: TMessage);
begin
  inherited;
  if Enabled then FGlyphToDraw:=1
  else FGlyphToDraw:=2;
  FInRegion:=False;
  FIsDown:=False;
  Invalidate;
end;

procedure TDsFancyButton.Click;
begin
  Invalidate;
end;

procedure Register;
begin
  RegisterComponents('Fancy Compo', [TDsFancyButton]);
end;


end.