_gclass.pas

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

  FUpdateCount := 0;
  AbInfo := LoadAbakusInfo;

end;


procedure TAbCustomControl.MouseDown(Button: TMouseButton; Shift: TShiftState;
  x, y: Integer);
begin
  inherited MouseDown(Button, Shift, x, y);
end;

procedure TAbCustomControl.BeginUpdate;
begin
  Inc(FUpdateCount);
end;

procedure TAbCustomControl.EndUpdate;
begin
  Dec(FUpdateCount);
  if FUpdateCount < 0 then FUpdateCount := 0;
  if (UpdateCount = 0) then Invalidate;
end;

procedure TAbCustomControl.ParamChange(Sender: TObject);
begin
  //
end;

procedure TAbCustomControl.Change;
begin
  if (UpdateCount = 0) then ParamChange(self);
end;

//==============================================================================
//==============================================================================

constructor TAbGraphicControl.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  Parent := AOwner as TWinControl;
  FUpdateCount := 0;
  AbInfo := LoadAbakusInfo;
end;


procedure TAbGraphicControl.MouseDown(Button: TMouseButton; Shift: TShiftState;
  x, y: Integer);
begin
  inherited MouseDown(Button, Shift, x, y);
end;

procedure TAbGraphicControl.BeginUpdate;
begin
  Inc(FUpdateCount);
end;

procedure TAbGraphicControl.EndUpdate;
begin
  Dec(FUpdateCount);
  if FUpdateCount < 0 then FUpdateCount := 0;
  if (UpdateCount = 0) then Change;
end;

procedure TAbGraphicControl.ParamChange(Sender: TObject);
begin
  //
end;

procedure TAbGraphicControl.Invalidate;
begin
   CompInvalidate := true;
   inherited Invalidate;
end;

procedure TAbGraphicControl.Change;
begin
  if (UpdateCount = 0) then ParamChange(self);
end;

procedure TAbOffset.SetTop(Value: Integer);
begin
  if FTop <> Value then
  begin
    FTop := Value;
    Change;
  end;
end;

procedure TAbOffset.SetLeft(Value: Integer);
begin
  if FLeft <> Value then
  begin
    FLeft := Value;
    Change;
  end;
end;

procedure TAbOffset.SetRight(Value: Integer);
begin
  if FRight <> Value then
  begin
    FRight := Value;
    Change;
  end;
end;

procedure TAbOffset.SetBottom(Value: Integer);
begin
  if FBottom <> Value then
  begin
    FBottom := Value;
    Change;
  end;
end;

procedure TAbOffset.Write(oTop, oLeft, oRight, oBottom: Integer);
begin
  FTop := oTop;
  FLeft := oLeft;
  FRight := oRight;
  FBottom := oBottom;
end;

function TAbOffset.SetOffset(r: TRect): TRect;
var
  re                : TRect;
begin
  re := r;
  AbMultiBorder(re, FLeft, FTop, FRight, FBottom);
  result := re;
end;

constructor TAbOffset.Create;
begin
  inherited;
  FTop := 0;
  FLeft := 0;
  FRight := 0;
  FBottom := 0;
end;

procedure TAbOffset.AssignTo(Dest: TPersistent);
begin
  if Dest is TAbOffset then
    with TAbOffset(Dest) do
    begin
      FTop := self.FTop;
      FLeft := self.FLeft;
      FRight := self.FRight;
      FBottom := self.FBottom;
      Change;
    end
  else
    inherited AssignTo(Dest);
end;


{ TAbBtnBevel }
{=================================================================}


procedure TAbBtnBevel.PaintBevel(can: TCanvas; // the canvas
  var r: TRect;                         // Btn Rectangle
  up,                                   // up or down
  filled: Boolean;                      // filled inside
  Col: TColor);                         // fill color
var
  n                 : Integer;
begin

  if filled then
  begin
    can.Pen.Width := 1;
    can.Pen.Color := Col;
    can.Brush.Color := Col;
    can.Brush.Style := bsSolid;
    can.Rectangle(r.Left, r.Top, r.Right, r.Bottom);

  end;

  if up then
  begin
    for n := 1 to FWidth do
    begin
      Frame3D(can, r,
        AbCalcColor(FHighlightColFrom, FHighlightColTo, FWidth, n),
        AbCalcColor(FShadowColFrom, FShadowColTo, FWidth, n),
        1);

    end;
  end
  else
  begin
    for n := 1 to FWidth do
    begin
      Frame3D(can, r,
        AbCalcColor(FShadowColTo, FShadowColFrom, FWidth, n),
        AbCalcColor(FHighlightColTo, FHighlightColFrom, FWidth, n),
        1);
    end;
  end;
end;


procedure TAbBtnBevel.SetShadowColFrom(Value: TColor);
begin
  if FShadowColFrom <> Value then
  begin
    FShadowColFrom := Value;
    Change;
  end;
end;

procedure TAbBtnBevel.SetShadowColTo(Value: TColor);
begin
  if FShadowColTo <> Value then
  begin
    FShadowColTo := Value;
    Change;
  end;
end;

procedure TAbBtnBevel.SetHighlightColFrom(Value: TColor);
begin
  if FHighlightColFrom <> Value then
  begin
    FHighlightColFrom := Value;
    Change;
  end;
end;

procedure TAbBtnBevel.SetHighlightColTo(Value: TColor);
begin
  if FHighlightColTo <> Value then
  begin
    FHighlightColTo := Value;
    Change;
  end;
end;

procedure TAbBtnBevel.SetWidth(Value: Integer);
begin
  if (FWidth <> Value) and (Value >= 0) then
  begin
    FWidth := Value;
    Change;
  end;
end;


constructor TAbBtnBevel.Create;
begin
  inherited Create;
  FShadowColFrom := clBlack;
  FShadowColTo := clBtnShadow;
  FHighlightColFrom := RGB(210, 210, 210);
  FHighlightColTo := clBtnHighlight;
  FWidth := 2;
end;

procedure TAbBtnBevel.AssignTo(Dest: TPersistent);
begin
  if Dest is TAbBtnBevel then
    with TAbBtnBevel(Dest) do
    begin
      FShadowColFrom := self.FShadowColFrom;
      FShadowColTo := self.FShadowColTo;
      FHighlightColFrom := self.FHighlightColFrom;
      FHighlightColTo := self.FHighlightColTo;
      FWidth := self.FWidth;
      Change;
    end
  else
    inherited AssignTo(Dest);
end;



{ TArrowSettings }
{=================================================================}

constructor TArrowSettings.Create;
begin
  FShape := 0;
  FColorPen := clBlack;
  FColorBrush := clLime;
  FColorCP1Pen := clBlack;
  FColorCP1Brush := clBlack;
  FColorCP2Pen := clBlack;
  FColorCP2Brush := clBtnFace;

end;

procedure TArrowSettings.AssignTo(Dest: TPersistent);
begin
  if Dest is TArrowSettings then
    with TArrowSettings(Dest) do
    begin
      FShape := self.FShape;
      FColorPen := self.FColorPen;
      FColorBrush := self.FColorBrush;
      FColorCP1Pen := self.FColorCP1Pen;
      FColorCP1Brush := self.FColorCP1Brush;
      FColorCP2Pen := self.FColorCP2Pen;
      FColorCP2Brush := self.FColorCP2Brush;
      Change;
    end
  else
    inherited AssignTo(Dest);
end;

procedure TArrowSettings.SetShape(Value: Integer);
begin
  if FShape <> Value then
  begin
    FShape := Value;
    Change;
  end;
end;

procedure TArrowSettings.SetColorPen(Value: TColor);
begin
  if FColorPen <> Value then
  begin
    FColorPen := Value;
    Change;
  end;
end;

procedure TArrowSettings.SetColorBrush(Value: TColor);
begin
  if FColorBrush <> Value then
  begin
    FColorBrush := Value;
    Change;
  end;
end;

procedure TArrowSettings.SetColorCP1Pen(Value: TColor);
begin
  if FColorCP1Pen <> Value then
  begin
    FColorCP1Pen := Value;
    Change;
  end;
end;

procedure TArrowSettings.SetColorCP1Brush(Value: TColor);
begin
  if FColorCP1Brush <> Value then
  begin
    FColorCP1Brush := Value;
    Change;
  end;
end;

procedure TArrowSettings.SetColorCP2Pen(Value: TColor);
begin
  if FColorCP2Pen <> Value then
  begin
    FColorCP2Pen := Value;
    Change;
  end;
end;

procedure TArrowSettings.SetColorCP2Brush(Value: TColor);
begin
  if FColorCP2Brush <> Value then
  begin
    FColorCP2Brush := Value;
    Change;
  end;
end;


{ TLED }
{=================================================================}

constructor TLED.Create;
begin
  FShape := sRound;
  FWidth := 13;
  FHeight := 13;
  FColorOff := clBtnFace;
  FColorOn := clLime;
end;

procedure TLED.Draw(can: TCanvas; Checked: Boolean);
begin
  if Checked then
    AbDrawLED(can, Rect, Shape, clBtnShadow, ColorOn)
  else
    AbDrawLED(can, Rect, Shape, clBtnShadow, ColorOff);
end;


procedure TLED.SetShape(Value: TLEDShape);
begin
  if FShape <> Value then
  begin
    FShape := Value;
    Change;
  end;
end;

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

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

procedure TLED.SetWidth(Value: Integer);
begin
  if FWidth <> Value then
  begin
    if (Value > 3) and (Value < 41) then
    begin
      FWidth := Value;
      Change;
    end;
  end;