buttoncomps.pas

一组个delphi按钮控件的代码

  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 Bmp.Empty = false then begin
         if SCap = true then begin
            Canvas.BrushCopy(Rect(Width div 2 - (Bmp.Width+TextWidth) div 2-1+1,Height div 2 - Bmp.Height div 2+1,
                   bmp.width+Width div 2 - (Bmp.Width+TextWidth) div 2+1,bmp.height+Height div 2 - Bmp.Height div 2+1),
                   bmp,Rect(0,0,bmp.width,bmp.height),bmp.Canvas.pixels[0,0]);
            Canvas.TextOut(Width div 2 + (Bmp.Width-TextWidth) div 2+5-1+1,Height div 2-TextHeight div 2+1,Cap);
         end else Canvas.BrushCopy(Rect(Width div 2-Bmp.Width div 2+1,Height div 2-Bmp.Height div 2+1,
                         bmp.width+Width div 2-Bmp.Width div 2+1,bmp.height+Height div 2-Bmp.Height div 2+1),
                         bmp,Rect(0,0,bmp.width,bmp.height),bmp.Canvas.pixels[0,0]);
      end else if SCap = true then Canvas.TextOut(Width div 2 - TextWidth div 2+1,Height div 2-TextHeight div 2+1,Cap);

      Canvas.Brush.Color := Border;
      Canvas.FrameRect(Rect(0,0,Width,Height));
      Canvas.Pen.Color := $00EDF4F8;
      Canvas.Polyline([Point(Width-1,0),Point(Width-1,Height)]);
      Canvas.Polyline([Point(Width,Height-1),Point(-1,Height-1)]);
      Canvas.Pen.Color := $004F4F4F;
      Canvas.Polyline([Point(0,Height-2),Point(0,0)]);
      Canvas.Polyline([Point(0,0),Point(Width-1,0)]);
  end;
end;

procedure TEncartaButton.MouseUp(Button: TMouseButton; Shift: TShiftState;
  X, Y: Integer);
var TextWidth, TextHeight : 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 Bmp.Empty = false then begin
            if SCap = true then begin
               Canvas.BrushCopy(Rect(Width div 2 - (Bmp.Width+TextWidth) div 2-1,Height div 2 - Bmp.Height div 2,
                      bmp.width+Width div 2 - (Bmp.Width+TextWidth) div 2,bmp.height+Height div 2 - Bmp.Height div 2),
                      bmp,Rect(0,0,bmp.width,bmp.height),bmp.Canvas.pixels[0,0]);
               Canvas.TextOut(Width div 2 + (Bmp.Width-TextWidth) div 2+5-1,Height div 2-TextHeight div 2,Cap);
            end else Canvas.BrushCopy(Rect(Width div 2-Bmp.Width div 2,Height div 2-Bmp.Height div 2,
                            bmp.width+Width div 2-Bmp.Width div 2,bmp.height+Height div 2-Bmp.Height div 2),
                            bmp,Rect(0,0,bmp.width,bmp.height),bmp.Canvas.pixels[0,0]);
         end else if SCap = true then Canvas.TextOut(Width div 2 - TextWidth div 2,Height div 2-TextHeight div 2,Cap);

         Canvas.Brush.Color := Border;
         Canvas.FrameRect(Rect(0,0,Width,Height));
         Canvas.Pen.Color := $00EDF4F8;
         Canvas.Polyline([Point(0,Height-2),Point(0,0)]);
         Canvas.Polyline([Point(0,0),Point(Width-1,0)]);
         Canvas.Pen.Color := $004F4F4F;
         Canvas.Polyline([Point(Width-1,0),Point(Width-1,Height)]);
         Canvas.Polyline([Point(Width,Height-1),Point(-1,Height-1)]);
      end;
  end;
end;

procedure TEncartaButton.MouseEnter(var Message: TMessage);
var TextWidth, TextHeight : Integer;
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 Bmp.Empty = false then begin
        if SCap = true then begin
           Canvas.BrushCopy(Rect(Width div 2 - (Bmp.Width+TextWidth) div 2-1,Height div 2 - Bmp.Height div 2,
                  bmp.width+Width div 2 - (Bmp.Width+TextWidth) div 2,bmp.height+Height div 2 - Bmp.Height div 2),
                  bmp,Rect(0,0,bmp.width,bmp.height),bmp.Canvas.pixels[0,0]);
           Canvas.TextOut(Width div 2 + (Bmp.Width-TextWidth) div 2+5-1,Height div 2-TextHeight div 2,Cap);
        end else Canvas.BrushCopy(Rect(Width div 2-Bmp.Width div 2,Height div 2-Bmp.Height div 2,
                        bmp.width+Width div 2-Bmp.Width div 2,bmp.height+Height div 2-Bmp.Height div 2),
                        bmp,Rect(0,0,bmp.width,bmp.height),bmp.Canvas.pixels[0,0]);
     end else if SCap = true then Canvas.TextOut(Width div 2 - TextWidth div 2,Height div 2-TextHeight div 2,Cap);

     Canvas.Brush.Color := Border;
     Canvas.FrameRect(Rect(0,0,Width,Height));
     Canvas.Pen.Color := $00EDF4F8;
     Canvas.Polyline([Point(0,Height-2),Point(0,0)]);
     Canvas.Polyline([Point(0,0),Point(Width-1,0)]);
     Canvas.Pen.Color := $004F4F4F;
     Canvas.Polyline([Point(Width-1,0),Point(Width-1,Height)]);
     Canvas.Polyline([Point(Width,Height-1),Point(-1,Height-1)]);
  end;
end;

procedure TEncartaButton.MouseLeave(var Message: TMessage);
var TextWidth, TextHeight : 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 Bmp.Empty = false then begin
     if SCap = true then begin
        Canvas.BrushCopy(Rect(Width div 2 - (Bmp.Width+TextWidth) div 2-1,Height div 2 - Bmp.Height div 2,
               bmp.width+Width div 2 - (Bmp.Width+TextWidth) div 2,bmp.height+Height div 2 - Bmp.Height div 2),
               bmp,Rect(0,0,bmp.width,bmp.height),bmp.Canvas.pixels[0,0]);
        Canvas.Font.Color := Font.Color;
        Canvas.TextOut(Width div 2 + (Bmp.Width-TextWidth) div 2+5-1,Height div 2-TextHeight div 2,Cap);
     end else Canvas.BrushCopy(Rect(Width div 2-Bmp.Width div 2,Height div 2-Bmp.Height div 2,
                     bmp.width+Width div 2-Bmp.Width div 2,bmp.height+Height div 2-Bmp.Height div 2),
                     bmp,Rect(0,0,bmp.width,bmp.height),bmp.Canvas.pixels[0,0]);
  end else if SCap = true then Canvas.TextOut(Width div 2 - TextWidth div 2,Height div 2-TextHeight div 2,Cap);

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

constructor TAOLButton.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  Width := 89;
  Height := 23;
  Col := $00A56934;
  Canvas.Brush.Color := clBlack;
  Font.Name := 'Arial';
  Font.Color := clWhite;
  Font.Size := 8;
  Font.Style :=[fsBold];
  Enab := true;
  ShowHint := true;
  RaiseCol := $00D7A28A;
end;

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

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

  Canvas.Brush.Color := RaiseCol;
  Canvas.FillRect(Rect(1,1,3,Height-1));
  Canvas.FillRect(Rect(1,1,Width-1,3));
  Canvas.Brush.Color := clBlack;
  Canvas.FillRect(Rect(Width-1,1,Width-3,Height-1));
  Canvas.FillRect(Rect(Width-1,Height-1,1,Height-3));

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

  Canvas.Brush.Color := Col;
  Canvas.Font.Color := Font.Color;
  Canvas.TextOut(Width div 2 - TextWidth div 2,Height div 2-TextHeight div 2,Cap);

  Canvas.Brush.Color := clBlack;
  Canvas.FrameRect(Rect(0,0,Width,Height));
end;

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

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

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

procedure TAOLButton.SetRaiseCol(Value: TColor);
begin
  RaiseCol := value;
  Paint;
end;

procedure TAOLButton.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 := Color;
      Canvas.FillRect(Rect(1,1,Width-1,Height-1));

      Canvas.Brush.Color := clBlack;
      Canvas.FillRect(Rect(1,1,Width-1,2));

      Canvas.Brush.Color := Col;
      Canvas.TextOut(Width div 2 - TextWidth div 2+2,Height div 2-TextHeight div 2+2,Cap);

      Canvas.Brush.Color := clBlack;
      Canvas.FrameRect(Rect(0,0,Width,Height));
  end;
end;

procedure TAOLButton.MouseUp(Button: TMouseButton; Shift: TShiftState;
  X, Y: Integer);
begin
  inherited MouseUp(Button, Shift, X, Y);
  if (Button = mbLeft) and Enab then begin
      if Assigned (MUp) then MUp(Self, Button, Shift, X, Y);
      if (X>0) and (Y>0) and (X<=Width) and (Y<=Height) then Paint;
  end;
end;

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

constructor TImageButton.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  MOver := TBitmap.Create;
  MDown := TBitmap.Create;
  MUp := TBitmap.Create;
  Bmp := TBitmap.Create;
  BmpDAble := TBitmap.Create;
  ActualBmp := TBitmap.Create;
  Width := 50;
  Height := 50;
  Canvas.Brush.Color := clBtnFace;
  ShowHint := true;
end;

procedure TImageButton.Paint;
begin
  inherited Paint;
  if ActualBmp.Width = 0 then ActualBmp.Assign(Bmp);
  Canvas.FillRect(Rect(0,0,Width,Height));
  if Enabled or (BmpDAble.Width = 0) then Canvas.Draw(0,0,ActualBmp)
  else begin
    Width := BmpDAble.Width;
    Height := BmpDAble.Height;
    Canvas.Draw(0,0,BmpDAble);
  end;
end;

procedure TImageButton.Click;
begin
  inherited Click;
  Paint;
  if Enabled then if Assigned(BtnClick) then BtnClick(Self);
end;

procedure TImageButton.SetMOver(Value: TBitmap);
begin
  MOver.Assign(Value);
  Paint;
end;

procedure TImageButton.SetMDown(Value: TBitmap);
begin
  MDown.Assign(Value);
  Paint;
end;

procedure TImageButton.SetMUp(Value: TBitmap);
begin
  MUp.Assign(Value);
  Paint;
end;

procedure TImageButton.SetBmp(Value: TBitmap);
begin
  Bmp.Assign(Value);
  ActualBmp.Assign(Value);
  Width := Bmp.Width;
  Height := Bmp.Height;
  Paint;
end;

procedure TImageButton.SetBmpDAble(Value: TBitmap);
begin
  BmpDAble.Assign(Value);
  paint;
end;

procedure TImageButton.MouseDown(Button: TMouseButton; Shift: TShiftState;
  X, Y: Integer);
begin
  inherited MouseDown(Button, Shift, X, Y);
  if (Button = mbLeft) and Enabled then begin
     if Assigned (OnMDown) then OnMDown(Self, Button, Shift, X, Y);
     if MDown.Width > 0 then begin
        ActualBmp.Assign(MDown);
        Width := MDown.Width;
        Height := MDown.Height;
        Paint;
     end;
  end;
end;

procedure TImageButton.MouseUp(Button: TMouseButton; Shift: TShiftState;
  X, Y: Integer);
var MouseOverButton: Boolean;
    P: TPoint;
begin
  inherited MouseUp(Button, Shift, X, Y);
  if (Button = mbLeft) and Enabled then begin
     if Assigned (OnMUp) then OnMUp(Self, Button, Shift, X, Y);
     if MUp.Width > 0 then begin
        GetCursorPos(P);
        MouseOverButton := (FindDragTarget(P, True) = Self);
        if MouseOverButton then begin
           Width := MUp.Width;
           Height := MUp.Height;
           Canvas.FillRect(Rect(0,0,Width,Height));
           Canvas.Draw(0,0,MUp);
        end else begin
           Width := bmp.Width;
           Height := Bmp.Height;
           Canvas.FillRect(Rect(0,0,Width,Height));
           Canvas.Draw(0,0,Bmp);
        end;
     end else begin
        if MouseOverButton = false then begin
           Width := MOver.Width;
           Height := MOver.Height;
           Canvas.FillRect(Rect(0,0,Width,Height));
           Canvas.Draw(0,0,MOver);
        end else begin
           Width := bmp.Width;
           Height := Bmp.Height;
           Canvas.FillRect(Rect(0,0,Width,Height));
           Canvas.Draw(0,0,Bmp);
        end;
     end;
  end;
end;

procedure TImageButton.MouseEnter(var Message: TMessage);