sbuttoncontrol.pas

AlphaControls是一个Delphi标准控件的集合

    OldBmp.Assign(sStyle.FCacheBmp);
    PaintNewBmp;
    FadeTimer.Enabled := False;
    FadeTimer.Interval := sStyle.ActualFadingOut;
    FadeTimer.Direction := fdDown;
  end;
end;

procedure TsButtonControl.StopFading;
begin
  if sStyle.ActualFadingEnabled then begin
    FadeTimer.Direction := fdNone;
    FadeLevel := sStyle.ActualFadingIter - 1;
  end;
end;

procedure TsButtonControl.PaintBtnBorder;
var
  Mode : integer;
begin
  if Down then begin
    Mode := 2;
  end
  else if sStyle.ControlIsActive then begin
    Mode := 1;
  end
  else begin
    Mode := 0;
  end;
  PaintRasterBorder(sStyle.FCacheBmp, GetBorder(sStyle), Mode, sStyle.FRegion, sStyle.BtnEffects.MaskedBorders.TransparentColor, true);
end;

function TsButtonControl.ImgRect: TRect;
var
  x, y : integer;
  dh, dw : integer;
begin
  x := 0;
  y := 0;
  Result := Rect(0, 0, 0, 0);
  dw := (Width - GlyphWidth - Spacing * integer(ShowCaption and (GlyphWidth > 0) and (Caption <> '')) - TextRectSize.cx) div 2 - FMargin;
  dh := (Height - GlyphHeight - Spacing * integer(ShowCaption and (GlyphWidth > 0) and (Caption <> '')) - TextRectSize.cy) div 2 - FMargin;
  case Layout of
    blGlyphLeft : begin
      case Alignment of
        taLeftJustify : begin
          x := Margin;
          y := (Height - GlyphHeight) div 2;
        end;
        taCenter : begin
          x := Margin + dw;
          y := (Height - GlyphHeight) div 2;
        end;
        taRightJustify : begin
          x := Margin + 2 * dw;
          y := (Height - GlyphHeight) div 2;
        end;
      end;
    end;
    blGlyphRight : begin
      case Alignment of
        taLeftJustify : begin
          x := Width - Margin - 2 * dw - Spacing * integer(ShowCaption and (GlyphWidth > 0) and (Caption <> '')) - GlyphWidth;
          y := (Height - GlyphHeight) div 2;
        end;
        taCenter : begin
          x := (Width - GlyphWidth + Spacing * integer(ShowCaption and (GlyphWidth > 0) and (Caption <> '')) + TextRectSize.cx) div 2;
          y := (Height - GlyphHeight) div 2;
        end;
        taRightJustify : begin
          x := Width - GlyphWidth - Margin;
          y := (Height - GlyphHeight) div 2;
        end;
      end;
    end;
    blGlyphTop : begin
      x := (Width - GlyphWidth) div 2;
      y := FMargin + dh;
    end;
    blGlyphBottom : begin
      x := (Width - GlyphWidth) div 2;
      y := Height - FMargin - dh - GlyphHeight;
    end;
  end;
  inc(x, integer(Down));
  inc(y, integer(Down));
  Result := Rect(x, y, x + GlyphWidth, y + GlyphHeight);
end;

function TsButtonControl.GlyphHeight: integer;
begin
  if (GeTCustomImageList <> nil) and (ImageIndex > -1) then begin
    Result := GeTCustomImageList.Height;
  end
  else begin
    Result := 0;
  end
end;

function TsButtonControl.GlyphWidth: integer;
begin
  if (GeTCustomImageList <> nil) and (ImageIndex > -1) then begin
    Result := GeTCustomImageList.Width;
  end
  else begin
    Result := 0;
  end
end;

function TsButtonControl.TextRectSize: TSize;
var
  R : TRect;
begin
  if ShowCaption then begin
    R := Rect(0, 0, MaxTextLen, 0);
    DrawText(sStyle.FCacheBMP.Canvas.Handle, PChar(Caption), Length(Caption), R, DT_EXPANDTABS or DT_WORDBREAK or DT_CALCRECT);
    Result.cy := HeightOf(R);
    Result.cx := WidthOf(R);
  end
  else begin
    Result.cy := 0;
    Result.cx := 0;
  end;
end;

procedure TsButtonControl.SetMargin(const Value: integer);
begin
  if Margin <> Value then begin
    if not RestrictDrawing then sStyle.BGChanged := True;
    FMargin := Value;
    Invalidate;
  end
end;

function TsButtonControl.MaxTextLen: integer;
begin
  if ShowCaption then begin
    case Layout of
      blGlyphLeft, blGlyphRight : begin
        Result := min(
             sStyle.FCacheBMP.Canvas.TextWidth(Caption) + Spacing * integer((GlyphWidth > 0) and (Caption <> '')),
             Width - GlyphWidth - 2 * FMargin - Spacing * integer((GlyphWidth > 0) and (Caption <> ''))
        );
      end
      else begin
        Result := min(sStyle.FCacheBMP.Canvas.TextWidth(Caption), Width - 2 * FMargin);
      end;
    end;
  end
  else begin
    Result := 0;
  end;
end;

procedure TsButtonControl.DoDrawText(var Rect: TRect; Flags: Integer);
var
  Text: string;
begin
  Text := Caption;
  Flags := DrawTextBiDiModeFlags(Flags);

  sStyle.FCacheBMP.Canvas.Font.Assign(Font);
(*  if not Enabled then begin
    OffsetRect(Rect, 1, 1);
    sStyle.FCacheBMP.Canvas.Font.Color := clBtnHighlight;
    DrawText(sStyle.FCacheBMP.Canvas.Handle, PChar(Text), Length(Text), Rect, Flags);
    OffsetRect(Rect, -1, -1);
    sStyle.FCacheBMP.Canvas.Font.Color := clBtnShadow;
    DrawText(sStyle.FCacheBMP.Canvas.Handle, PChar(Text), Length(Text), Rect, Flags);
  end
  else begin
    sStyle.FCacheBMP.Canvas.Font.Assign(Font);
    if sStyle.ControlIsActive then begin
//      sStyle.FCacheBMP.Canvas.Font.Color := sStyle.ActualHotfontcolor;
//      sStyle.FCacheBMP.Canvas.Font.Style := sStyle.HotStyle.HotPainting.FontStyle;
    end;
//    DrawText(sStyle.FCacheBMP.Canvas.Handle, PChar(Text), Length(Text), Rect, Flags);
    WriteTextEx(sStyle.FCacheBMP.Canvas, PChar(Text), True{Enabled}, Rect, Flags, sStyle.SkinIndex, sStyle.ControlIsActive);
  end;  *)
    WriteTextEx(sStyle.FCacheBMP.Canvas, PChar(Text), True{Enabled}, Rect, Flags, sStyle.SkinIndex, sStyle.ControlIsActive);
end;

procedure TsButtonControl.DrawCaption;
var
  R, CalcRect : TRect;
  DrawStyle: Longint;
begin
  sStyle.FCacheBMP.Canvas.Brush.Style := bsClear;
  R := CaptionRect;
  { Calculate vertical layout }
  CalcRect := R;

  if HeightOf(CalcRect) > sStyle.FCacheBMP.Canvas.TextHeight('T') + 6 then begin
    FTextLayout := DT_CENTER;
  end;

  DrawStyle := DT_EXPANDTABS or DT_WORDBREAK or FTextLayout;

  DoDrawText(R, DrawStyle);

  if Self is TsButton then begin
    if Focused and TsButton(Self).ActualShowFocus then begin
      InflateRect(R, TsButton(Self).FocusMargin, TsButton(Self).FocusMargin);
      FocusRect(sStyle.FCacheBMP.Canvas, R);
    end;
  end;
end;

function TsButtonControl.CaptionRect: TRect;
var
  l, t, r, b : integer;
  dh, dw : integer;
  Size : TSize;
begin
  l := 0; t := 0; r := 0; b := 0;
  Size := TextRectSize;
  case Layout of
    blGlyphLeft : begin
      dw := (Width - GlyphWidth - Spacing * integer((GlyphWidth > 0) and (Caption <> '')) - Size.cx) div 2 - FMargin;
      t := (Height - Size.cy) div 2;
      b := Height - t;
      case Alignment of
        taLeftJustify : begin
          l := Margin + GlyphWidth + Spacing * integer(GlyphWidth > 0);
          r := Width - FMargin - dw * 2;
        end;
        taCenter : begin
          l := FMargin + dw + GlyphWidth + Spacing * integer(GlyphWidth > 0);
          r := Width - FMargin - dw;
        end;
        taRightJustify : begin
          l := FMargin + 2 * dw + GlyphWidth + Spacing * integer(GlyphWidth > 0);
          r := Width - FMargin;
        end;
      end;
      FTextLayout := DT_LEFT;
    end;
    blGlyphRight : begin
      dw := (Width - GlyphWidth - Spacing * integer((GlyphWidth > 0) and (Caption <> '')) - Size.cx) div 2 - FMargin;
      t := (Height - Size.cy) div 2;
      b := Height - t;
      case Alignment of
        taLeftJustify : begin
          l := FMargin;
          r := FMargin + Size.cx;
        end;
        taCenter : begin
          l := FMargin + dw;
          r := FMargin + dw + Size.cx;
        end;
        taRightJustify : begin
          l := FMargin + 2 * dw;
          r := FMargin + 2 * dw + Size.cx;
        end;
      end;
      FTextLayout := DT_RIGHT;
    end;
    blGlyphTop : begin
      dh := (Height - GlyphHeight - Spacing * integer((GlyphHeight > 0) and (Caption <> '')) - Size.cy) div 2 - FMargin;
      l := (Width - Size.cx) div 2;
      t := (FMargin + dh + GlyphHeight + Spacing * integer((GlyphHeight > 0) and (Caption <> '')));
      r := Width - (Width - Size.cx) div 2;
      b := Height - dh - FMargin;
      FTextLayout := DT_CENTER;
    end;
    blGlyphBottom : begin
      dh := (Height - GlyphHeight - Spacing * integer((GlyphHeight > 0) and (Caption <> '')) - Size.cy) div 2 - FMargin;
      l := (Width - Size.cx) div 2;
      t := FMargin + dh;
      r := Width - (Width - Size.cx) div 2;
      b := Height - dh - FMargin - GlyphHeight - Spacing * integer((GlyphHeight > 0) and (Caption <> ''));
      FTextLayout := DT_CENTER;
    end;
  end;
  Result := Rect(l - 1, t, r + 2, b);
  if Down then OffsetRect(Result, 1, 1);
end;

procedure TsButtonControl.AfterConstruction;
begin
  inherited;
  sStyle.Loaded;
end;

procedure TsButtonControl.Loaded;
begin
  inherited;
  sStyle.Loaded;

end;

procedure TsButtonControl.PaintSkinBorder(index : integer);
var
  Mode : integer;
begin
  if Down then begin
    Mode := 2;
  end
  else if sStyle.ControlIsActive then begin
    Mode := 1;
  end
  else begin
    Mode := 0;
  end;
  PaintRasterBorder(sStyle.FCacheBmp, ma[index].Bmp, Mode, sStyle.FRegion, ma[index].TransparentColor, True);
end;

procedure TsButtonControl.SetNumGlyphs(const Value: integer);
begin
  if FNumGlyphs <> Value then begin
    if Value < 1 then begin
      FNumGlyphs := 1;
    end
    else begin
      FNumGlyphs := Value;
    end;
    sStyle.Invalidate;
  end;
end;

procedure TsButtonControl.SetImages(const Value: TCustomImageList);
begin
  if Images <> nil then Images.UnRegisterChanges(FImageChangeLink);
  FImages := Value;
  if Images <> nil then begin
    Images.RegisterChanges(FImageChangeLink);
    Images.FreeNotification(Self);
    Perform(TCM_SETIMAGELIST, 0, Images.Handle);
  end
  else Perform(TCM_SETIMAGELIST, 0, 0);
  sStyle.Invalidate;
end;

procedure TsButtonControl.ImageListChange(Sender: TObject);
begin
  if HandleAllocated then Perform(TCM_SETIMAGELIST, 0, TCustomImageList(Sender).Handle);
end;

function TsButtonControl.GetCustomImageList: TCustomImageList;
begin
  if Enabled then begin
    if Assigned(ImagesGrayed) and not sStyle.ControlIsActive then begin
      Result := ImagesGrayed;
    end
    else begin
      Result := Images;
    end;
  end
  else begin
    Result := TCustomImageList(iffo(Assigned(ImagesDisabled), ImagesDisabled, Images));
  end;
end;

procedure TsButtonControl.SetDisabledGlyphKind(const Value: TsDisabledGlyphKind);
begin
  if FDisabledGlyphKind <> Value then begin
    FDisabledGlyphKind := Value;
    sStyle.Invalidate;
  end;
end;

procedure TsButtonControl.SetAlignment(const Value: TAlignment);
begin
  if FAlignment <> Value then begin
    FAlignment := Value;
    sStyle.Invalidate;
  end;
end;

procedure TsButtonControl.SetDisabledKind(const Value: TsDisabledKind);
begin
  if FDisabledKind <> Value then begin
    FDisabledKind := Value;
    FsStyle.Invalidate;
  end;
end;

{ TFadeTimer }

constructor TFadeTimer.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FOwner := TsButtonControl(AOwner);
  Direction := fdNone;
  OnTimer := TimerAction;
end;

procedure TFadeTimer.FadeDown;
var
  b : TBitmap;
  c : TsColor;
begin
  if (FOwner = nil) or (csDestroying in FOwner.ComponentState) then Exit;
  b := TBitmap.Create;
  b.Width := FOwner.sStyle.FCacheBmp.Width;
  b.Height := FOwner.sStyle.FCacheBmp.Height;
  b.PixelFormat := pf24Bit;

  c.A := 0;
  c.R := 255 - FOwner.FadeLevel * 255 div FOwner.sStyle.ActualFadingIter;
  c.G := c.R;
  c.B := c.R;
  try
    BitBlt(b.Canvas.Handle, 0, 0, b.Width, b.Height, FOwner.sStyle.FCacheBmp.Canvas.Handle, 0, 0, SRCCOPY);
    SumBitmaps(b, FOwner.OldBmp, c);
    BitBlt(FOwner.Canvas.Handle, 0, 0, b.Width, b.Height, b.Canvas.Handle, 0, 0, SRCCOPY);
  finally
    FreeAndNil(b);
    dec(FOwner.FadeLevel);
  end;
end;

procedure TFadeTimer.FadeUp;
var
  b : TBitmap;
  c : TsColor;
begin
  if (FOwner = nil) or (csDestroying in FOwner.ComponentState) then Exit;
  b := TBitmap.Create;
  b.Width := FOwner.sStyle.FCacheBmp.Width;
  b.Height := FOwner.sStyle.FCacheBmp.Height;
  b.PixelFormat := pf24Bit;

  c.A := 0;
  c.R := 255 - FOwner.FadeLevel * 255 div FOwner.sStyle.ActualFadingIter;
  c.G := c.R;
  c.B := c.R;
  try
    BitBlt(b.Canvas.Handle, 0, 0, b.Width, b.Height, FOwner.OldBmp.Canvas.Handle, 0, 0, SRCCOPY);
    SumBitmaps(b, FOwner.sStyle.FCacheBmp, c);
    BitBlt(FOwner.Canvas.Handle, 0, 0, b.Width, b.Height, b.Canvas.Handle, 0, 0, SRCCOPY);
  finally
    FreeAndNil(b);
    inc(FOwner.FadeLevel);
  end;
end;

procedure TFadeTimer.SetDirection(const Value: TFadeDirection);
begin
  FDirection := Value;
  Enabled := Value <> fdNone;
end;

procedure TFadeTimer.Timer;
begin
  inherited;
  ToEnd;
  case FDirection of
    fdUp : FadeUp;
    fdDown : FadeDown;
    fdNone : Enabled := False;
  end;
end;

procedure TFadeTimer.TimerAction(Sender: TObject);
begin
end;

procedure TFadeTimer.ToEnd;
begin
  if (FOwner = nil) or (csDestroying in FOwner.ComponentState) or Application.Terminated then begin
    FDirection := fdNone;
  end else
  if (FOwner.FadeLevel > FOwner.sStyle.ActualFadingIter) then begin
    dec(FOwner.FadeLevel);
    FDirection := fdNone;
    if not RestrictDrawing then FOwner.sStyle.BGChanged := True;
    FOwner.Repaint;
  end else
  if (FOwner.FadeLevel < 0) then begin
    inc(FOwner.FadeLevel);
    FDirection := fdNone;
    if not RestrictDrawing then FOwner.sStyle.BGChanged := True;
    FOwner.Repaint;
  end;
end;

end.