previous_dsfancybutton.pas

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

        MRgn:=CreateRoundRectRgn(0, 0, Width, Height, Dia, Dia);
      end;
    btnCapsule:
      begin
        if Width<Height then Dia:=Width else Dia:=Height;
        MRgn:=CreateRoundRectRgn(0, 0, Width, Height, Dia, Dia);
      end;
    btnOval: MRgn:=CreateEllipticRgn(0, 0, Width, Height);
  end; //case

  try
    if PtInRegion(MRgn, X, Y) then Result:=True;
  finally
    DeleteObject(MRgn);
  end;
end;

procedure TDsFancyButton.DrawButtonArea;
var Dia: Integer;
begin
  if not (csDesigning in ComponentState) then Exit;
  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
end;

function TDsFancyButton.ColorBlend(BaseColor, MixColor: TColor; Level: Byte): TColor;
var AwalR, AwalG, AwalB,
    AkhirR, AkhirG, AkhirB: TColor;
    R, G, B: Byte;
begin
    BaseColor:=ColorToRGB(BaseColor);
    MixColor:=ColorToRGB(MixColor);

    AwalR:=GetRValue(MixColor); AkhirR:=GetRValue(BaseColor);
    AwalG:=GetGValue(MixColor); AkhirG:=GetGValue(BaseColor);
    AwalB:=GetBValue(MixColor); AkhirB:=GetBValue(BaseColor);

    R:=Round((AwalR*Level+AkhirR*(100-Level))*0.01);
    G:=Round((AwalG*Level+AkhirG*(100-Level))*0.01);
    B:=Round((AwalB*Level+AkhirB*(100-Level))*0.01);
    Result:=RGB(R, G, B);
  end;

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

  with Canvas do
  begin
    Pen.Color:=ColorBlend(FEffect.FrameColor, clWhite, 65);
    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.DrawShape;
var
  FC, Warna: TColor;
  R, G, B: Byte;
  AwalR, AwalG, AwalB,
  AkhirR, AkhirG, AkhirB,
  n, t, Dia: Integer;
  FRgn: HRgn;
  TempValue: real;
begin
  if FInRegion then
    Warna:=ColorBlend(FEffect.FaceColor, clWhite, 12)
  else
    Warna:=ColorToRGB(FEffect.FaceColor);
  FC:=ColorToRGB(FEffect.FrameColor);

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

  t:=FEffect.FFrameWidth;
  for n:=0 to t-1 do
  begin
    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, n+1, Width-n, Height-n)
    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, n+1, Width-n, Height-n, Dia-2*n, Dia-2*n)
      else FRgn:=CreateRectRgn(n+1, n+1, Width-n, Height-n);
    end;

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

procedure TDsFancyButton.DrawShapePressed;
var Dia: Integer;
  FRgn: HRgn;
begin
  if FEffect.Shape=btnOval then
    FRgn:=CreateEllipticRgn(1, 1, Width-2, Height-2)
  else
  begin
    if FEffect.Shape=btnCapsule then
      if Width<Height then Dia:=Width else Dia:=Height
    else Dia:=2*FEffect.CornerRadius-4;

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

  try
    Canvas.Brush.Color:=ColorBlend(FEffect.FaceColor, FEffect.FrameColor, 70);
    FillRgn(Canvas.Handle, FRgn, Canvas.Brush.Handle);
    OffsetRgn(FRgn, 1, 1);
    {--frame color: 40% face color: 60%--}
    Canvas.Brush.Color:=ColorBlend(FEffect.FaceColor, FEffect.FrameColor, 40);
    FillRgn(Canvas.Handle, FRgn, Canvas.Brush.Handle);
    OffsetRgn(FRgn, 2, 2);
    Canvas.Brush.Color:=clBtnHighlight;
    FillRgn(Canvas.Handle, FRgn, Canvas.Brush.Handle);
    OffsetRgn(FRgn, -1, -1);
    {--frame color: 15% face color: 85%--}
    Canvas.Brush.Color:=ColorBlend(FEffect.FaceColor, FEffect.FrameColor, 15);
    FillRgn(Canvas.Handle, FRgn, Canvas.Brush.Handle);
  finally
    DeleteObject(FRgn);
  end;
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:=clBtnHighLight;
      OffsetRect(TR, 1, 1);
      DrawText(Handle, PChar(Caption), Length(Caption), TR, Flags);
    end
    else if (FEffect.TextStyle=txLowered) and FIsDown then
    begin
      Font.Color:=clBtnHighLight;
      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:=clBtnHighLight;
      OffsetRect(TR, -1, -1);
      DrawText(Handle, PChar(Caption), Length(Caption), TR, Flags);
    end
    else if (FEffect.TextStyle=txRaised) and FIsDown then
    begin
      Font.Color:=clBtnHighLight;
      DrawText(Handle, PChar(Caption), Length(Caption), TR, Flags);
    end
    else if (FEffect.TextStyle=txShadowed) and FIsDown then
    begin
      Font.Color:=clBtnShadow;
      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:=clBtnShadow;
      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 else FGlyphT:=0;
                FTextL:=FGlyphL+FBmpWidth+dist;
                FTextT:=(Height-ht) div 2;
              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 else FGlyphT:=0;
                FTextL:=FGlyphL-wt-dist;
                FTextT:=(Height-ht) div 2;
              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
                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;
begin
  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;

  R.Left:=FGlyphL;  R.Right:=FGlyphL+FBmpWidth;
  R.Top:=FGlyphT;   R.Bottom:=FGlyphT+FGlyphs.Glyph.Height;
  if FIsDown then OffsetRect(R, 1, 1);

  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.WMSize(var Message: TWMSize);
begin
  inherited;
  if Width>145 then Width:=145;
  if Height>145 then Height:=145;
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('My Compo', [TDsFancyButton]);
end;

end.