buttoncomps.pas

一组个delphi按钮控件的代码

begin
  if Enabled then begin
     if MOver.Width > 0 then begin
        ActualBmp.Assign(MOver);
        Width := MOver.Width;
        Height := MOver.Height;
        Paint;
     end;
  end;
end;

procedure TImageButton.MouseLeave(var Message: TMessage);
begin
  if Enabled then begin
     if Bmp.Width > 0 then begin
        ActualBmp.Assign(Bmp);
        Width := Bmp.Width;
        Height := Bmp.Height;
        Paint;
     end;
  end;
end;

constructor TSelButton.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  Width := 105;
  Height := 20;
  Col := clBtnFace;
  OverFColor := clBlack;
  OverColor := $00A4B984;
  DownColor := $00A4B984;
  Canvas.Brush.Color := clBlack;
  Border := clGray;
  Font.Name := 'Arial';
  Font.Color := clGray;
  Font.Size := 8;
  Enab := true;
  ShowHint := true;
  Alment := taLeftJustify;
  BWidth := 1;
end;

procedure TSelButton.SetParent(Value: TWinControl);
begin
  inherited;
  if Value <> nil then Cap := Name;
end;

procedure TSelButton.Paint;
var TextWidth, TextHeight : Longint;
    i: Longint;
begin
  inherited Paint;
  Canvas.Font := Font;
  Canvas.Brush.Color := Col;
  Canvas.FillRect(Rect(1,1,Width-1,Height-1));
  TextWidth := Canvas.TextWidth(Cap);
  TextHeight := Canvas.TextHeight(Cap);
  Canvas.Font.Color := $00D6E0E0;

  Canvas.Font.Color := Font.Color;
  if Alment = taCenter then Canvas.TextOut(Width div 2 - TextWidth div 2,Height div 2-TextHeight div 2,Cap);
  if Alment = taLeftJustify then Canvas.TextOut(5,Height div 2-TextHeight div 2,Cap);
  if Alment = taRightJustify then Canvas.TextOut(Width - TextWidth - 6,Height div 2-TextHeight div 2,Cap);

  Canvas.Brush.Color := Border;
  for i := 0 to BWidth-1 do Canvas.FrameRect(Rect(i,i,Width-i,Height-i));
end;

procedure TSelButton.Click;
begin
  inherited Click;
  Paint;
  if Enab then if Assigned(BtnClick) then BtnClick(Self);
end;

procedure TSelButton.SetCol(Value: TColor);
begin
  Col := Value;
  Paint;
end;

procedure TSelButton.SetBorder(Value: TColor);
begin
  Border := Value;
  Paint;
end;

procedure TSelButton.SetCap(Value: string);
begin
  Cap := value;
  Paint;
end;

procedure TSelButton.SetAlment(Value: TAlignment);
begin
  Alment := Value;
  Paint;
end;

procedure TSelButton.SetBWidth(Value: Longint);
begin
  BWidth := value;
  Paint;
end;

procedure TSelButton.MouseDown(Button: TMouseButton; Shift: TShiftState;
  X, Y: Integer);
var TextWidth, TextHeight : Longint;
    i: Longint;
begin
  inherited MouseDown(Button, Shift, X, Y);
  TextWidth := Canvas.TextWidth(Cap);
  TextHeight := Canvas.TextHeight(Cap);
  if (Button = mbLeft) and Enab then begin
      if Assigned (MDown) then MDown(Self, Button, Shift, X, Y);
      Canvas.Brush.Color := DownColor;
      Canvas.FillRect(Rect(1,1,Width-1,Height-1));

      if Alment = taCenter then Canvas.TextOut(Width div 2 - TextWidth div 2+1,Height div 2-TextHeight div 2+1,Cap);
      if Alment = taLeftJustify then Canvas.TextOut(5+1,Height div 2-TextHeight div 2+1,Cap);
      if Alment = taRightJustify then Canvas.TextOut(Width - TextWidth - 6-1,Height div 2-TextHeight div 2+1,Cap);

      Canvas.Brush.Color := Border;
      for i := 0 to BWidth-1 do Canvas.FrameRect(Rect(i,i,Width-i,Height-i));
  end;
end;

procedure TSelButton.MouseUp(Button: TMouseButton; Shift: TShiftState;
  X, Y: Integer);
var TextWidth, TextHeight : Longint;
    i: Longint;
    MouseOverButton: Boolean;
    P: TPoint;
begin
  inherited MouseUp(Button, Shift, X, Y);
  TextWidth := Canvas.TextWidth(Cap);
  TextHeight := Canvas.TextHeight(Cap);
  if (Button = mbLeft) and Enab then begin
      if Assigned (MUp) then MUp(Self, Button, Shift, X, Y);
      GetCursorPos(P);
      MouseOverButton := (FindDragTarget(P, True) = Self);
      if MouseOverButton then begin
         Canvas.Brush.Color := OverColor;
         Canvas.FillRect(Rect(1,1,Width-1,Height-1));
         Canvas.Font.Color := OverFColor;

         if Alment = taCenter then Canvas.TextOut(Width div 2 - TextWidth div 2,Height div 2-TextHeight div 2,Cap);
         if Alment = taLeftJustify then Canvas.TextOut(5,Height div 2-TextHeight div 2,Cap);
         if Alment = taRightJustify then Canvas.TextOut(Width - TextWidth - 6,Height div 2-TextHeight div 2,Cap);

         Canvas.Brush.Color := Border;
         for i := 0 to BWidth-1 do Canvas.FrameRect(Rect(i,i,Width-i,Height-i));
      end;
  end;
end;

procedure TSelButton.MouseEnter(var Message: TMessage);
var TextWidth, TextHeight : Integer;
    i: Longint;
begin
  TextWidth := Canvas.TextWidth(Cap);
  TextHeight := Canvas.TextHeight(Cap);
  if Enab then begin
     Canvas.Brush.Color := OverColor;
     Canvas.FillRect(Rect(1,1,Width-1,Height-1));
     Canvas.Font.Color := OverFColor;

     if Alment = taCenter then Canvas.TextOut(Width div 2 - TextWidth div 2,Height div 2-TextHeight div 2,Cap);
     if Alment = taLeftJustify then Canvas.TextOut(5,Height div 2-TextHeight div 2,Cap);
     if Alment = taRightJustify then Canvas.TextOut(Width - TextWidth - 6,Height div 2-TextHeight div 2,Cap);

     Canvas.Brush.Color := Border;
     for i := 0 to BWidth-1 do Canvas.FrameRect(Rect(i,i,Width-i,Height-i));
  end;
end;

procedure TSelButton.MouseLeave(var Message: TMessage);
var TextWidth, TextHeight : Integer;
    i: integer;
begin
  TextWidth := Canvas.TextWidth(Cap);
  TextHeight := Canvas.TextHeight(Cap);
  Canvas.Brush.Color := Col;
  Canvas.FillRect(Rect(1,1,Width-1,Height-1));
  Canvas.Font.Color := $00D6E0E0;
  Canvas.Brush.Color := Col;
  Canvas.Font.Color := Font.Color;

  if Alment = taCenter then Canvas.TextOut(Width div 2 - TextWidth div 2,Height div 2-TextHeight div 2,Cap);
  if Alment = taLeftJustify then Canvas.TextOut(5,Height div 2-TextHeight div 2,Cap);
  if Alment = taRightJustify then Canvas.TextOut(Width - TextWidth - 6,Height div 2-TextHeight div 2,Cap);

  Canvas.Brush.Color := Border;
  for i := 0 to BWidth-1 do Canvas.FrameRect(Rect(i,i,Width-i,Height-i));
end;

constructor TSquareButton.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  Width := 113;
  Height := 17;
  Col := clBtnFace;
  OverFColor := clWhite;
  Canvas.Brush.Color := clBlack;
  Border := clBlack;
  Font.Name := 'Arial';
  Font.Color := clBlack;
  Font.Size := 8;
  Enab := true;
  ShowHint := true;
  Alment := taLeftJustify;
  OverBorderCol := clBlack;
  BWidth := 2;
  DownBorderCol := clWhite;
end;

procedure TSquareButton.SetParent(Value: TWinControl);
begin
  inherited;
  if Value <> nil then Cap := Name;
end;

procedure TSquareButton.Paint;
var TextWidth, TextHeight : Longint;
begin
  inherited Paint;
  Canvas.Font := Font;
  Canvas.Brush.Color := Col;
  Canvas.FillRect(Rect(0,0,Width,Height));

  TextWidth := Canvas.TextWidth(Cap);
  TextHeight := Canvas.TextHeight(Cap);
  Canvas.Font.Color := $00D6E0E0;

  Canvas.Font.Color := Font.Color;
  if Alment = taCenter then Canvas.TextOut(Width div 2 - TextWidth div 2,Height div 2-TextHeight div 2-1,Cap);
  if Alment = taLeftJustify then Canvas.TextOut(6,Height div 2-TextHeight div 2-1,Cap);
  if Alment = taRightJustify then Canvas.TextOut(Width - TextWidth - 7,Height div 2-TextHeight div 2-1,Cap);

  Canvas.Brush.Color := Border;
  Canvas.FillRect(Rect(0,Height,Width,Height-BWidth));
  Canvas.FillRect(Rect(0,0,BWidth,Height));
end;

procedure TSquareButton.Click;
begin
  inherited Click;
  Paint;
  if Enab then if Assigned(BtnClick) then BtnClick(Self);
end;

procedure TSquareButton.SetCol(Value: TColor);
begin
  Col := Value;
  Paint;
end;

procedure TSquareButton.SetBorder(Value: TColor);
begin
  Border := Value;
  Paint;
end;

procedure TSquareButton.SetCap(Value: string);
begin
  Cap := value;
  Paint;
end;

procedure TSquareButton.SetAlment(Value: TAlignment);
begin
  Alment := Value;
  Paint;
end;

procedure TSquareButton.SetBWidth(Value: Longint);
begin
  BWidth := Value;
  Paint;
end;

procedure TSquareButton.MouseDown(Button: TMouseButton; Shift: TShiftState;
  X, Y: Integer);
var TextWidth, TextHeight : Longint;
begin
  inherited MouseDown(Button, Shift, X, Y);
  TextWidth := Canvas.TextWidth(Cap);
  TextHeight := Canvas.TextHeight(Cap);
  if (Button = mbLeft) and Enab then begin
      if Assigned (MDown) then MDown(Self, Button, Shift, X, Y);
      Canvas.Brush.Color := Col;
      Canvas.FillRect(Rect(0,0,Width,Height));

      if Alment = taCenter then Canvas.TextOut(Width div 2 - TextWidth div 2,Height div 2-TextHeight div 2-1,Cap);
      if Alment = taLeftJustify then Canvas.TextOut(6,Height div 2-TextHeight div 2-1,Cap);
      if Alment = taRightJustify then Canvas.TextOut(Width - TextWidth - 7,Height div 2-TextHeight div 2-1,Cap);

      Canvas.Brush.Color := DownBorderCol;
      Canvas.FillRect(Rect(0,Height,Width,Height-BWidth));
      Canvas.FillRect(Rect(0,0,BWidth,Height));
  end;
end;

procedure TSquareButton.MouseUp(Button: TMouseButton; Shift: TShiftState;
  X, Y: Integer);
var TextWidth, TextHeight : Longint;
    P: TPoint;
    MouseOverButton: Boolean;
begin
  inherited MouseUp(Button, Shift, X, Y);
  TextWidth := Canvas.TextWidth(Cap);
  TextHeight := Canvas.TextHeight(Cap);
  if (Button = mbLeft) and Enab then begin
      if Assigned (MUp) then MUp(Self, Button, Shift, X, Y);
      GetCursorPos(P);
      MouseOverButton := (FindDragTarget(P, True) = Self);
      if MouseOverButton then begin
         Canvas.Brush.Color := Col;
         Canvas.FillRect(Rect(0,0,Width,Height));
         Canvas.Font.Color := OverFColor;

         if Alment = taCenter then Canvas.TextOut(Width div 2 - TextWidth div 2,Height div 2-TextHeight div 2-1,Cap);
         if Alment = taLeftJustify then Canvas.TextOut(6,Height div 2-TextHeight div 2-1,Cap);
         if Alment = taRightJustify then Canvas.TextOut(Width - TextWidth - 7,Height div 2-TextHeight div 2-1,Cap);

         Canvas.Brush.Color := OverBorderCol;
         Canvas.FillRect(Rect(0,Height,Width,Height-BWidth));
         Canvas.FillRect(Rect(0,0,BWidth,Height));
      end;
  end;
end;

procedure TSquareButton.MouseEnter(var Message: TMessage);
var TextWidth, TextHeight : Longint;
begin
  if Enab then begin
     TextWidth := Canvas.TextWidth(Cap);
     TextHeight := Canvas.TextHeight(Cap);
     Canvas.Brush.Color := Col;
     Canvas.FillRect(Rect(0,0,Width,Height));
     Canvas.Font.Color := OverFColor;

     if Alment = taCenter then Canvas.TextOut(Width div 2 - TextWidth div 2,Height div 2-TextHeight div 2-1,Cap);
     if Alment = taLeftJustify then Canvas.TextOut(6,Height div 2-TextHeight div 2-1,Cap);
     if Alment = taRightJustify then Canvas.TextOut(Width - TextWidth - 7,Height div 2-TextHeight div 2-1,Cap);

     Canvas.Brush.Color := OverBorderCol;
     Canvas.FillRect(Rect(0,Height,Width,Height-BWidth));
     Canvas.FillRect(Rect(0,0,BWidth,Height));
  end;
end;

procedure TSquareButton.MouseLeave(var Message: TMessage);
begin
  Paint;
end;

end.