abcbitbt.pas

著名的虚拟仪表控件,包含全部源码, 可以在,delphi2007 下安装运行

  begin
    FOffsetX := Value;
    StatusChanged;
  end;
end;

procedure TAbColBitBtn.SetOffsetY(Value: Integer);
begin
  if FOffsetY <> Value then
  begin
    FOffsetY := Value;
    StatusChanged;
  end;
end;

procedure TAbColBitBtn.SetColorOn(Value: TColor);
begin
  if FColorOn <> Value then
  begin
    FColorOn := Value;
    StatusChanged;
  end;
end;

procedure TAbColBitBtn.SetColorOff(Value: TColor);
begin
  if FColorOff <> Value then
  begin
    FColorOff := Value;
    StatusChanged;
  end;
end;

procedure TAbColBitBtn.SetColorDisabled(Value: TColor);
begin
  if FColorDisabled <> Value then
  begin
    FColorDisabled := Value;
    StatusChanged;
  end;
end;

procedure TAbColBitBtn.Draw(stGlyph, stText, stTextCol, stBtn: Boolean);
var
  r                 : TRect;
  GlyphNr           : Integer;
  Bmp, bmp2         : TBitmap;
  r1                : TRect;
  FCol              : TColor;
  BmpPos, TxtPos    : TPoint;
  txtToPos          : toPos;
  w, h, space       : Integer;
  txt               : string;
  offsX, offsY      : Integer;
  cp                : TPoint;           // centerpoint glyph/text
  gtHeight, gtWidth : Integer; // glyph+text height/width (incl. spacing)
begin
  txtToPos := toTopLeft;
  bmp2 := TBitmap.Create;
  bmp2.Width := FGlyph.Width div FNumGlyph;
  bmp2.Height := FGlyph.Height;

  Bmp := TBitmap.Create;
  Bmp.Width := Width;
  Bmp.Height := Height;

  r := ClientRect;

  Bmp.Assign(BmpBackground);

  offsX := FOffsetX;
  offsY := FOffsetY;

  if MouseIsDown or (Checked and (coBevel in CheckedOptions)) then
  begin
    offsX := offsX + FOffsetDown;
    offsY := offsY + FOffsetDown;
  end;


  if not FEnabled then
    FCol := FColorDisabled
  else
    if stBtn  then
      FCol := FColorOn
    else
      FCol := FColorOff;

  if (FBeveled and (not FFlat or (csDesigning in Componentstate)))
    or (not FBeveled and FFlat and (csDesigning in Componentstate))
    or (MouseInControl and FFlat) then
  begin
    if (coBevel in CheckedOptions) then
    begin
      FButtonBevel.PaintBevel(Bmp.Canvas, r, not (Checked or MouseIsDown), not
        (FTransparent or FGradBtnFace.Visible), FCol);
    end
    else
    begin
      FButtonBevel.PaintBevel(Bmp.Canvas, r, not MouseIsDown, not (FTransparent
        or FGradBtnFace.Visible), FCol);
    end;
  end
  else
    if (not FTransparent) and (not FGradBtnFace.Visible) then
    begin
      Bmp.Canvas.Brush.Color := FCol;
      Bmp.Canvas.Pen.Color := FCol;
      Bmp.Canvas.Brush.Style := bsSolid;
      Bmp.Canvas.Rectangle(r.Left, r.Top, r.Right, r.Bottom);
    end;

  Bmp.Canvas.Font := Font;

  w := AbMaxInt(Bmp.Canvas.TextWidth(TextOn), Bmp.Canvas.TextWidth(TextOff));
  h := Round(Bmp.Canvas.Textheight(TextOn) * 0.85);

  if (bmp2.Width > 0) and (w > 0) then
    space := FSpacing
  else
    space := 0;

  gtHeight := 0;
  gtWidth := 0;
  case fPosGlyph of
    pLeft, pRight:
      begin
        gtHeight := AbMaxInt(bmp2.Height, h);
        gtWidth := bmp2.Width + space + w;
      end;
    pTop, pBottom:
      begin
        gtHeight := bmp2.Height + space + h;
        gtWidth := AbMaxInt(bmp2.Width, w);
      end;
  end;


  case fPosHorizontal of
    phLeft: cp.x := r.Left + gtWidth div 2;
    phRight: cp.x := r.Right - gtWidth div 2;
    phCenter: cp.x := r.Left + (r.Right - r.Left) div 2;
  end;

  case fPosVertical of
    pvTop: cp.y := r.Top + gtHeight div 2;
    pvBottom: cp.y := r.Bottom - gtHeight div 2;
    pvCenter: cp.y := r.Top + (r.Bottom - r.Top) div 2;
  end;

  case fPosGlyph of
    pLeft:
      begin
        BmpPos.x := cp.x - gtWidth div 2;
        BmpPos.y := cp.y - bmp2.Height div 2;
        TxtPos.x := BmpPos.x + space + bmp2.Width;
        TxtPos.y := cp.y;
        txtToPos := toMidLeft;
      end;
    pRight:
      begin
        BmpPos.x := cp.x + gtWidth div 2 - bmp2.Width;
        BmpPos.y := cp.y - bmp2.Height div 2;
        TxtPos.x := BmpPos.x - space;
        TxtPos.y := cp.y;
        txtToPos := toMidRight;
      end;
    pTop:
      begin
        BmpPos.x := cp.x - bmp2.Width div 2;
        BmpPos.y := cp.y - gtHeight div 2;
        TxtPos.x := cp.x;
        TxtPos.y := BmpPos.y + space + bmp2.Height;
        txtToPos := toTopCenter;
      end;
    pBottom:
      begin
        BmpPos.x := cp.x - bmp2.Width div 2;
        BmpPos.y := cp.y + gtHeight div 2 - bmp2.Height;
        TxtPos.x := cp.x;
        TxtPos.y := BmpPos.y - space;
        txtToPos := toBotCenter;
      end;
  end;

  BmpPos.x := BmpPos.x + offsX;
  BmpPos.y := BmpPos.y + offsY;
  TxtPos.x := TxtPos.x + offsX;
  TxtPos.y := TxtPos.y + offsY;

  Bmp.Canvas.Brush.Style := bsClear;

  if stTextCol then
    FCol := FTextColOn
  else
    FCol := FTextColOff;
  if not Enabled then FCol := FTextColDisabled;

  if stText then
    txt := FTextOn
  else
    if FTextOff <> '' then
      txt := FTextOff
    else
      txt := FTextOn;

  AbTextOut3D(Bmp.Canvas, TxtPos.x, TxtPos.y, FCol, FButtonBevel.ShadowColTo,
    FButtonBevel.HighlightColTo, txt, txtToPos, FText3D);


  if bmp2.Width > 0 then
  begin

    if NumGlyph > 1 then
    begin
      if FEnabled then
      begin
        if stGlyph and (FNumGlyph >= 3) then
          GlyphNr := 2
        else
          GlyphNr := 0;
      end
      else
        GlyphNr := 1;
    end
    else
      GlyphNr := 0;

    r1 := Rect(GlyphNr * bmp2.Width,
      0,
      GlyphNr * bmp2.Width + bmp2.Width,
      bmp2.Height);

    bmp2.Canvas.CopyRect(bmp2.Canvas.Cliprect, FGlyph.Canvas, r1);

    bmp2.Transparent := true;
    bmp2.TransparentColor := FGlyph.TransparentColor;

    Bmp.Canvas.Draw(BmpPos.x, BmpPos.y, bmp2);
  end;

  Canvas.Draw(0, 0, Bmp);
  Bmp.Free;
  bmp2.Free;

end;

procedure TAbColBitBtn.StatusChanged;
var
  Bin1, Bin2, Bin3, Bin4: Boolean;
begin
  if Painting then exit;
  Painting := true;
  if (foGlyph in FlashOptions) and Checked and Flashing then
    Bin1 := FlashStatus
  else
    Bin1 := ((coGlyph in CheckedOptions) and Checked);


  if (foText in FlashOptions) and Checked and Flashing  then
    Bin2 := FlashStatus
  else
    Bin2 := ((coText in CheckedOptions) and Checked);


  if (foTextCol in FlashOptions) and Checked and Flashing then
    Bin3 := FlashStatus
  else
    Bin3 := ((coTextCol in CheckedOptions) and Checked);

  if (foBtnCol in FlashOptions) and Checked and Flashing then
    Bin4 := FlashStatus
  else
    Bin4 := ((coBtnCol in CheckedOptions) and Checked);


  if Visible or (csDesigning in Componentstate)
    then Draw(Bin1, Bin2, Bin3, Bin4);
  Painting := false;
end;


procedure TAbColBitBtn.Paint;
var
  rBtnFace          : TRect;
begin
  if Painting then exit;
  Painting := true;
  rBtnFace := Rect(0, 0, Width, Height);
  AbBorder(rBtnFace, FButtonBevel.Width);

  if Visible or (csDesigning in Componentstate) then
  begin

    BmpBackground.Width := Width;       // save Background
    BmpBackground.Height := Height;
    BmpBackground.Canvas.CopyRect(ClientRect, Canvas, ClientRect);

    if (not Transparent) and (FGradBtnFace.Visible) then
      AbGradFill(BmpBackground.Canvas,
        rBtnFace,
        FGradBtnFace.ColorFrom, FGradBtnFace.ColorTo,
        FGradBtnFace.Style
        );


    Painting := false;
    StatusChanged;

  end;
  Painting := false;
end;

destructor TAbColBitBtn.Destroy;
begin
  FGlyph.Free;
  BmpBackground.Free;
  FButtonBevel.Free;
  FGradBtnFace.Free;
  inherited Destroy;
end;

constructor TAbColBitBtn.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  if (AOwner is TWinControl) then Parent := AOwner as TWinControl;
  FEnabled := true;

  fPosHorizontal := phCenter;
  fPosVertical := pvCenter;

  SetBounds(Left, Top, 65, 33);

  FFlashOptions := [foGlyph, foText, foTextCol, foBtnCol];
  FCheckedOptions := [coGlyph, coText, coTextCol, coBtnCol, coBevel];

  Font.Style := [fsBold];

  FGlyph := TBitmap.Create;
  FNumGlyph := 1;
  FOffsetDown := 1;

  BmpBackground := TBitmap.Create;

  FBeveled := true;

  FGradBtnFace := TAbGradSettings.Create;
  FGradBtnFace.ColorFrom := $00F0F0F0;
  FGradBtnFace.ColorTo := $00696969;
  FGradBtnFace.Style := gsHorizontal1;
  FGradBtnFace.Visible := true;

  FButtonBevel := TAbBtnBevel.Create;
  FButtonBevel.Width := 4;

  Mode := mButton;
  FColorDisabled := $00A0A0A0;
  FColorOff := clBtnFace;
  FColorOn := clBtnFace;
  FSpacing := 4;

  FTextOn := '';
  FTextOff := '';

  FText3D := true;
  FTextColOn := clLime;
  FTextColOff := clBlack;
  FTextColDisabled := clBtnShadow;

  if (csDesigning in Componentstate) then Loaded;
end;

procedure TAbColBitBtn.Loaded;
begin
  inherited Loaded;
  FGradBtnFace.OnChange := ParamChange;


  FButtonBevel.OnChange := ParamChange;

end;

procedure TAbColBitBtn.ParamChange(Sender: TObject);
begin
  Invalidate;
end;

end.