robitbtn.~pas

田民格设计Delphi旋转控件

unit RoBitBtn;

interface

uses
  Windows,SysUtils,Classes, Controls, StdCtrls,Graphics, Buttons,math;

type
  TRoBitBtn = class(TBitBtn)
  private
    fEscapement,fcEscapement:Integer;B:TBitmap;
    fText:string;{Ok,}Doing:boolean;
    fBckColor,fBorderColor:TColor;
    fCx,fCy:integer;
procedure DrawAngleText(aCanvas:TCanvas;aRect:tRect;aAngle:Integer;cAngle:Integer;aTxt:String);
procedure CalcTextPos(aCanvas:TCanvas;var aRect:TRect;aAngle:Integer;aTxt:String);
procedure SetEscapement(aVal:Integer);
procedure SetcEscapement(aVal:Integer);
procedure SetText(aVal:string);
procedure SetBckColor(aVal:TColor);
procedure SetBrDColor(aVal:TColor);
procedure DrawRectText;
procedure SetfCx(aVal:Integer);
procedure SetfCy(aVal:Integer);
    { Private declarations }
  protected
    { Protected declarations }
  public
    DiZhi,LouZhang:string;
    ZhiBei,Ceng,Hu:integer;
    P:array[0..4] of TPoint;
    PB:array[0..4] of TPoint;TooSmall:Boolean;
    constructor Create(AOwner:TComponent);OverLoad;override;
    constructor Create(aOwner:TComponent;Txt:string;L:integer=0;T:integer=0;W:integer=120;H:integer=25;Angle:integer=405;FontSize:integer=12);OverLoad;
    destructor Destroy; override;
    procedure CreateWnd;override;
    procedure Invalidate;override;
  published
    property Escapement:Integer read fEscapement write SetEscapement;
    property cEscapement:Integer read fcEscapement write SetcEscapement;
    property Text:string read fText write SetText;
    property BackColor:TColor read fBckColor write SetBckColor;
    property BorderColor:TColor read fBorderColor write SetBrdColor;
    property Cx:integer read fCx write SetfCx;
    property Cy:integer read fCy write SetfCy;
  end;

procedure Register;

implementation

procedure Register;
begin
  RegisterComponents('Standard', [TRoBitBtn]);
end;

constructor TRoBitBtn.Create(aOwner:TComponent);
begin
  inherited Create(aOwner);doing:=true;
  Escapement:=45;Height:=150;Width:=150;fCx:=120;fCy:=25;Caption:='';
  fText:='这是旋转按钮';fBckColor:=clBtnFace;//设置默认背景色
  fBorderColor:=clRed;Font.Name:='宋体';Font.Size:=12;
end;
constructor TRoBitBtn.Create(aOwner:TComponent;Txt:string;L:integer=0;T:integer=0;W:integer=120;H:integer=25;Angle:integer=405;FontSize:integer=12);
begin
  doing:=true;inherited Create(aOwner);Top:=T;Left:=L;fEscapement:=Angle;
  fCy:=H;fCx:=W;if Angle=405 then Begin
  Height:=round(sqrt(H*H+W*W)+30);Width:=Height;end else
  Begin
  Width:=Abs(round(fcx*cos(Angle*Pi/180)))+Abs(round(fcy*sin(Angle*Pi/180)))+17;
  Height:=Abs(round(fcx*sin(Angle*Pi/180)))+Abs(round(fcy*cos(Angle*Pi/180)))+17;
  End;
  fText:=Txt;Caption:='';
  fBckColor:=clBtnFace;fBorderColor:=clRed;//设置默认背景色和边框色
  Font.Name:='宋体';Font.Size:=FontSize;
end;
destructor TRoBitBtn.Destroy;
begin
  B.Free;
  inherited Destroy;
end;

procedure TRoBitBtn.CreateWnd;
begin
 inherited CreateWnd;DrawRectText;doing:=false;
end;

procedure TRoBitBtn.Invalidate;
Begin
inherited Invalidate;
if not doing then
Begin doing:=true;DrawRectText;doing:=false;end;
End;

procedure TRoBitBtn.DrawRectText;
var aRect:TRect;Rgn:HRGN;
Begin
if B=nil then B:=TBitmap.Create;
B.Width:=Width;B.Height:=Height;
B.Canvas.Brush.Color:=fBckColor;//设置背景色
B.Canvas.Pen.Mode:=pmcopy;
B.Canvas.Rectangle(0,0,B.Width-1,B.Height-1);//画背景
B.Canvas.Pen.Mode:=pmcopy;B.Canvas.Pen.Color:=BorderColor;
B.Canvas.Font:=Font;
aRect.Left:=5;aRect.Top:=5;
aRect.Right:=B.Width;aRect.Bottom:=B.Height;
DrawAngleText(B.Canvas,aRect,fEscapement,fcEscapement,Text);
Glyph.Assign(B);
Rgn:=CreatePolygonRgn(PB,4,WINDING);
SetWindowRgn(TRoBitBtn(self).Handle,Rgn,True);//只显示矩形区域
caption:='';
End;

procedure TRoBitBtn.SetEscapement(aVal:Integer);
begin
  if fEscapement=aVal then exit;
  while aVal<0 do aVal:=aVal+360;while aVal>=360 do aVal:=aVal-360;
  fEscapement:=aVal;if (aVal>90)and(aVal<270) then aVal:=0;
  fcEscapement:=aVal;Invalidate;
end;
procedure TRoBitBtn.SetcEscapement(aVal:Integer);
begin
  if fcEscapement=aVal then exit;
  while aVal<0 do aVal:=aVal+360;while aVal>=360 do aVal:=aVal-360;
  fcEscapement:=aVal;Invalidate;
end;

procedure TRoBitBtn.SetBckColor(aVal:TColor);
begin
  if fBckColor=aVal then exit;fBckColor:=aVal;Invalidate;
end;
procedure TRoBitBtn.SetBrdColor(aVal:TColor);
begin
  if fBorderColor=aVal then exit;fBorderColor:=aVal;Invalidate;
end;

procedure TRoBitBtn.SetfCx(aVal:integer);
begin
  if fCx=aVal then exit;fCx:=aVal;Invalidate;
end;
procedure TRoBitBtn.SetfCy(aVal:integer);
begin
  if fCy=aVal then exit;fCy:=aVal;Invalidate;
end;

procedure TRoBitBtn.SetText(aVal:string);
begin
  if fText=aVal then exit;fText:=aVal;Invalidate;
end;

procedure TRoBitBtn.DrawAngleText(aCanvas:TCanvas;aRect:TRect;aAngle:Integer;cAngle:Integer;aTxt:String);
var LFont:TLogFont;hOldFont,hNewFont:HFont;
begin
  CalcTextPos(aCanvas,aRect,aAngle,aTxt);
  GetObject(aCanvas.Font.Handle,SizeOf(LFont),Addr(LFont));
LFont.lfHeight:=aCanvas.Font.Height;//字高 //LFont.lfWidth:=self.Font.Size;//字宽
  LFont.lfEscapement:=aAngle*10;//倾斜度
  LFont.lfOrientation:=cAngle*10;//方向与倾斜度取值相同
{LFont.lfWeight:=400;//字体笔画粗细程度
LFont.lfItalic:=0;//没有斜体效果
LFont.lfUnderline:=0;//没有下划线
LFont.lfStrikeOut:=0;//没有删除线
LFont.lfCharSet:=0;//默认字符集
LFont.lfQuality:=0;//系统默认值
LFont.lfPitchAndFamily:=0;//系统默认值}
 StrPCopy(LFont.lfFaceName,aCanvas.Font.Name);//字体名称
 LFont.lfOutPrecision:=0;//系统默认值
 LFont.lfClipPrecision:=0;//系统默认值

  hNewFont:=CreateFontIndirect(LFont);
  hOldFont:=SelectObject(aCanvas.Handle,hNewFont);
  aCanvas.Brush.Style:=bsClear;
  aCanvas.TextOut(aRect.Left,aRect.Top,aTxt);
  aCanvas.Polygon(P);
  hNewFont:=SelectObject(aCanvas.Handle,hOldFont);
  DeleteObject(hNewFont);
end;

procedure TRoBitBtn.CalcTextPos(aCanvas:TCanvas;var aRect:TRect;aAngle:Integer;aTxt:String);
var DC:HDC;hSavFont:HFont;Size:TSize;x,y,cx,cy,bs:Integer;
r,a03,Lm:double;cStr:array[0..255] of Char;//,x0,y0
begin
  StrPCopy(cStr,aTxt);DC:=GetDC(0);x:=0;y:=0;
  hSavFont:=SelectObject(DC,aCanvas.Font.Handle);//取画布字体设备描述和句柄
  {$IFDEF WIN32}
  GetTextExtentPoint32(DC,cStr,Length(aTxt),Size);//返回写aTxt所需打印矩形区域
  {$ELSE}
  GetTextExtentPoint(DC,cStr,Length(aTxt),Size);
  {$ENDIF}
  SelectObject(DC,hSavFont);ReleaseDC(0,DC);
  cx:=Size.cx+aCanvas.Font.Size div 2;cy:=size.cy;//补偿计算误差
  if fCx<cx then fCx:=cx;if fCy<cy then fCy:=Cy;//要求区域太小AutoSize
  if  aAngle<=90  then begin { 1.Quadrant }//矩形框区域相对于(0,0)的起始坐标点
     x:=0;y:=Trunc(fCx*sin(aAngle*Pi/180));
  end else if aAngle<=180 then begin    { 2.Quadrant }
     x:=Trunc(fCx*-cos(aAngle*Pi/180));
     y:=Trunc(fCx*sin(aAngle*Pi/180)+fCy*cos((180-aAngle)*Pi/180));
  end else if aAngle<=270 then begin    { 3.Quadrant }
     x:=Trunc(fCx*-cos(aAngle*Pi/180)+fCy*sin((aAngle-180)*Pi/180));
     y:=Trunc(fCy*sin((270-aAngle)*Pi/180));
  end else if aAngle<=360 then begin { 4.Quadrant }
     x:=Trunc(fCy*sin((360-aAngle)*Pi/180));y:=0;
  end;//矩形框区域在画布的起始坐标点
  P[0].Y:=aRect.Top+y;P[0].X:=aRect.Left+x;//aRect.TopLeft:=P[0];
  P[4]:=P[0];//打印区域在画布的所有坐标点P[0..4]
  P[1].X:=P[0].X+round(fcy*sin(aAngle*Pi/180));//4点坐标逆时针顺序
  P[1].Y:=P[0].Y+round(fcy*cos(aAngle*Pi/180));
  P[2].X:=P[0].X+round(fcy*sin(aAngle*Pi/180)+fcx*cos(aAngle*Pi/180));
  P[2].Y:=P[0].Y+round(fcy*cos(aAngle*Pi/180)-fcx*sin(aAngle*Pi/180));
  P[3].X:=P[0].X+round(fcx*cos(aAngle*Pi/180));
  P[3].Y:=P[0].Y-round(fcx*sin(aAngle*Pi/180));
  bs:=3;r:=bs*sqrt(2);fcy:=fcy+2*bs;fcx:=fcx+2*bs;//03边的角度为矩形角度
  a03:=aAngle*Pi/180+135*PI/180;//01与03边角平分线的反向沿长线方向故+135度
  PB[0].X:=max(round(P[0].X+r*cos(a03)),2);//外扩bs个单位作为显示矩形以保证显示外框
  PB[0].Y:=max(round(P[0].Y-r*sin(a03)),2);//打印区域外围坐标点PB[0..4]
  PB[1].X:=max(PB[0].X+round(fcy*sin(aAngle*Pi/180)),2);
  PB[1].Y:=max(PB[0].Y+round(fcy*cos(aAngle*Pi/180)),2);
  PB[2].X:=max(PB[0].X+round(fcy*sin(aAngle*Pi/180)+fcx*cos(aAngle*Pi/180)),2);
  PB[2].Y:=max(PB[0].Y+round(fcy*cos(aAngle*Pi/180)-fcx*sin(aAngle*Pi/180)),2);
  PB[3].X:=max(PB[0].X+round(fcx*cos(aAngle*Pi/180)),2);
  PB[3].Y:=max(PB[0].Y-round(fcx*sin(aAngle*Pi/180)),2);
  PB[4]:=PB[0];fcy:=fcy-2*bs;fcx:=fcx-2*bs;
  Lm:=ArcTan2(fCy-Cy,fCx-Cx);r:=sqrt(sqr(fCy-Cy)+sqr(fCx-Cx))/2;
  aRect.Top:=round(P[0].Y-r*sin(aAngle*Pi/180-Lm));
  aRect.Left:=round(P[0].X+r*cos(aAngle*Pi/180-Lm));
  x:=Abs(round(fcx*cos(aAngle*Pi/180)))+Abs(round(fcy*sin(aAngle*Pi/180)));
  y:=Abs(round(fcx*sin(aAngle*Pi/180)))+Abs(round(fcy*cos(aAngle*Pi/180)));
  TooSmall:=(Width<x+17)or(Height<y+17);//若Width<x+20或Heigth<y+20将不能完全显示
end;//若直接修改宽度和高度会引起位图右移

end.