rotatelabel1.~pas

田民格设计Delphi旋转控件

 P[5].X:=Round((P[1].X+Lm*P[2].X)/(1+Lm));P[5].Y:=Round((P[1].Y+Lm*P[2].Y)/(1+Lm));
 Lm:=5/3;
 P[6].X:=Round((P[1].X+Lm*P[2].X)/(1+Lm));P[6].Y:=Round((P[1].Y+Lm*P[2].Y)/(1+Lm));
 Lm:=3/5;
 P[2].X:=Round((P[0].X+Lm*P[1].X)/(1+Lm));P[2].Y:=Round((P[0].Y+Lm*P[1].Y)/(1+Lm));
 Lm:=5/3;
 P[3].X:=Round((P[0].X+Lm*P[1].X)/(1+Lm));P[3].Y:=Round((P[0].Y+Lm*P[1].Y)/(1+Lm));
 P[0]:=P[12];Lm:=3/5;
 P[1].X:=Round((P[0].X+Lm*P[5].X)/(1+Lm));P[1].Y:=Round((P[0].Y+Lm*P[5].Y)/(1+Lm));
 Lm:=5/3;
 P[4].X:=Round((P[0].X+Lm*P[5].X)/(1+Lm));P[4].Y:=Round((P[0].Y+Lm*P[5].Y)/(1+Lm));
 Lm:=3/5;
 P[7].X:=Round((P[6].X+Lm*P[11].X)/(1+Lm));P[7].Y:=Round((P[6].Y+Lm*P[11].Y)/(1+Lm));
 Lm:=5/3;
 P[10].X:=Round((P[6].X+Lm*P[11].X)/(1+Lm));P[10].Y:=Round((P[6].Y+Lm*P[11].Y)/(1+Lm));
 Canvas.Brush.Color:=fBrushColor;Canvas.Brush.Style:=fBrushStyle;Canvas.Polygon(P);
End;

procedure   TRotateLabel.Arrow(aRect:TRect);//画箭头
var x,y,Cx,Cy,aAngle:integer;Lm:double;P:array[0..7] of TPoint;
Begin
 aAngle:=fEscapement;x:=0;y:=0;
 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;//倾斜矩形框区域起始坐标点       倾斜矩形水平和垂直方向投影尺寸Cx、Cy
  Cx:=Abs(round(fcx*cos(aAngle*Pi/180)))+Abs(round(fcy*sin(aAngle*Pi/180)));
  Cy:=Abs(round(fcx*sin(aAngle*Pi/180)))+Abs(round(fcy*cos(aAngle*Pi/180)));
  if akLeft IN Anchors2 then aRect.Right:=aRect.Left+Cx;//根据投影尺寸进行靠边
  if akRight IN Anchors2 then aRect.Left:=aRect.Right-Cx;
  if akTop IN Anchors2 then aRect.Bottom:=aRect.Top+Cy;
  if akBottom IN Anchors2 then aRect.Top:=aRect.Bottom-Cy;
 P[0].Y:=aRect.Top+y;P[0].X:=aRect.Left+x;//倾斜矩形框靠边后的起始坐标点
 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));//旋转矩形4点坐标
 P[7].X:=(P[0].X+P[3].X) div 2;P[7].Y:=(P[0].Y+P[3].Y) div 2;//03边中点为箭尖位置
 Lm:=1.5;P[6].X:=Round((P[2].X+Lm*P[3].X)/(1+Lm));P[6].Y:=Round((P[2].Y+Lm*P[3].Y)/(1+Lm));
 Lm:=3;P[4].X:=Round((P[1].X+Lm*P[2].X)/(1+Lm));P[4].Y:=Round((P[1].Y+Lm*P[2].Y)/(1+Lm));
 Lm:=0.5;P[3].X:=Round((P[1].X+Lm*P[4].X)/(1+Lm));P[3].Y:=Round((P[1].Y+Lm*P[4].Y)/(1+Lm));
 Lm:=1.5;P[1].X:=Round((P[1].X+Lm*P[0].X)/(1+Lm));P[1].Y:=Round((P[1].Y+Lm*P[0].Y)/(1+Lm));
 Lm:=3;P[5].X:=Round((P[1].X+Lm*P[6].X)/(1+Lm));P[5].Y:=Round((P[1].Y+Lm*P[6].Y)/(1+Lm));
 Lm:=0.5;P[2].X:=Round((P[1].X+Lm*P[5].X)/(1+Lm));P[2].Y:=Round((P[1].Y+Lm*P[5].Y)/(1+Lm));
 P[0]:=P[7];Canvas.Brush.Color:=fBrushColor;//一定要先Color再Style
 Canvas.Brush.Style:=fBrushStyle;Canvas.Polygon(P);
End;

procedure   TRotateLabel.North(aRect:TRect);//画指北针
var x,y,Cx,Cy,aAngle:integer;Lm:double;P:array[0..4] of TPoint;Bs:TBrushStyle;
Begin
 aAngle:=fEscapement;x:=0;y:=0;
 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;//倾斜矩形框区域起始坐标点       倾斜矩形水平和垂直方向投影尺寸Cx、Cy
  Cx:=Abs(round(fcx*cos(aAngle*Pi/180)))+Abs(round(fcy*sin(aAngle*Pi/180)));
  Cy:=Abs(round(fcx*sin(aAngle*Pi/180)))+Abs(round(fcy*cos(aAngle*Pi/180)));
  if akLeft IN Anchors2 then aRect.Right:=aRect.Left+Cx;//根据投影尺寸进行靠边
  if akRight IN Anchors2 then aRect.Left:=aRect.Right-Cx;
  if akTop IN Anchors2 then aRect.Bottom:=aRect.Top+Cy;
  if akBottom IN Anchors2 then aRect.Top:=aRect.Bottom-Cy;
 P[0].Y:=aRect.Top+y;P[0].X:=aRect.Left+x;//倾斜矩形框靠边后的起始坐标点
 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));//旋转矩形4点坐标
 P[0].X:=(P[0].X+P[3].X) div 2;P[0].Y:=(P[0].Y+P[3].Y) div 2;//03边中点为箭尖位置
 P[4]:=P[0];P[3]:=P[2];Lm:=3;//指北针各点坐标
 P[2].X:=(P[1].X+P[2].X) div 2;P[2].Y:=(P[1].Y+P[2].Y) div 2;
 P[2].X:=Round((P[0].X+Lm*P[2].X)/(1+Lm));
 P[2].Y:=Round((P[0].Y+Lm*P[2].Y)/(1+Lm));
 Bs:=Canvas.Brush.Style;Canvas.Brush.Style:=bsClear;//先画不填充的指北针
 Canvas.Polygon(P);P[3]:=P[2];Canvas.Brush.Color:=fBrushColor;//再画半边填充
 Canvas.Brush.Style:=fBrushStyle;
 Canvas.Polygon(P);Canvas.Brush.Style:=Bs;
End;

procedure TRotateLabel.Wjx(Rect:TRect);
var P0,P1:TPoint;x0,y0,x1,y1,i:integer;r,r0,a:double;P:array[0..10] of TPoint;
Begin
P0:=Rect.TopLeft;p1:=Rect.BottomRight;//坐标的左上角和右下角
x0:=round((p0.X+p1.X)/2);y0:=round((p0.Y+p1.Y)/2);//几何中心
if abs((p0.X-p1.X)/2)<abs((p0.Y-p1.Y)/2) then
r:=abs((p0.X-p1.X)/2) else r:=abs((p0.Y-p1.Y)/2);//五角星角半径
r0:=sin(pi/10)*r/sin(7*pi/10);a:=fEscapement*pi/180;//五角星内径和旋转角度
for i:=0 to 4 do
 begin
 x1:=round(x0+r*cos(2*pi*i/5+pi/2+a));
 y1:=round(y0-r*sin(2*pi*i/5+pi/2+a));
 p[2*i]:=point(x1,y1);
 x1:=round(x0+r0*cos(2*pi*i/5+pi/2+pi/5+a));
 y1:=round(y0-r0*sin(2*pi*i/5+pi/2+pi/5+a));
 p[2*i+1]:=point(x1,y1);
 end;
p[10]:=p[0];
canvas.Polygon(p);
End;

procedure TRotateLabel.CalcTextPos(var aRect:TRect;aAngle:Integer;aTxt:String);
var DC:HDC;hSavFont:HFont;Size:TSize;x,y,cx,cy:Integer;
cStr:array[0..255] of Char;r,Lm:double;
begin
  StrPCopy(cStr,aTxt);DC:=GetDC(0);x:=0;y:=0;//fcx:=100;fcy:=30;
  hSavFont:=SelectObject(DC,Font.Handle);//取字体设备描述和句柄
  {$IFDEF WIN32}
  GetTextExtentPoint32(DC,cStr,Length(aTxt),Size);
  {$ELSE}
  GetTextExtentPoint(DC,cStr,Length(aTxt),Size);
  {$ENDIF}
  SelectObject(DC,hSavFont);ReleaseDC(0,DC);//bs:=2;
  cx:=Size.cx;cy:=size.cy;//返回写aTxt所需打印矩形区域
  if aTxt='' then Begin Cx:=fcx;Cy:=fCy;End else
   Begin if cx>fCx then fCx:=cx;if cy>fCy then fCy:=Cy;End;
  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[0..4]
  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)));
  if Autosize then begin Width:=max(x,fCx);Height:=max(y,fCy);end else
  Begin//对整个输出框进行水平居中、靠右对齐和垂直居中、靠底对齐
  if Alignment=taCenter then begin P[0].X:=P[0].X+((Width-x) div 2);end else
  if Alignment=taRightJustify then begin P[0].X:=P[0].X+Width-x-1;end;
  if fAlignmentH=ahCenter then P[0].Y:=P[0].Y+(Height-y)div 2 Else
  if fAlignmentH=ahBottom then P[0].Y:=P[0].Y+Height-y-1;
  End;
  P[4]:=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));
  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));//使文字显示在边框中心位置
end;

procedure TRotateLabel.DrawAngleText(aCanvas:TCanvas;aRect:tRect;aAngle:Integer;aTxt:String);
{ Draw text with FontIndirect (angle -> escapement)                        }
var LFont:TLogFont;hOldFont,hNewFont:HFont;
begin
  CalcTextPos(aRect,aAngle,aTxt);
  GetObject(aCanvas.Font.Handle,SizeOf(LFont),Addr(LFont));
  LFont.lfEscapement := aAngle*10;
  hNewFont := CreateFontIndirect(LFont);
  hOldFont := SelectObject(aCanvas.Handle,hNewFont);
  aCanvas.TextOut(aRect.Left,aRect.Top,aTxt);
  hNewFont := SelectObject(aCanvas.Handle,hOldFont);
  DeleteObject(hNewFont); //
end;

procedure TRotateLabel.DoDrawText(var Rect:TRect;Flags:Word);
var Text:String;TmpRect:TRect;UpperColor:TColor;LowerColor:TColor;
    {$IFDEF WINDOWS}cStr:array[0..255] of Char;{$ENDIF}
begin
 Text:=Caption;
 {$IFDEF WINDOWS}StrPCopy(cStr,Text);{$ENDIF}
 if (Flags and DT_CALCRECT<>0)and((Text='')or ShowAccelChar and
  (Text[1]='&')and(Text[2]=#0))then Text:=Text+' ';
 if not ShowAccelChar then Flags:=Flags or DT_NOPREFIX;
 Canvas.Font:=Font;UpperColor:=clBtnHighlight;LowerColor:=clBtnShadow;
 if FTextStyle=tsRecessed then
  begin UpperColor:=clBtnShadow;LowerColor:=clBtnHighlight;end;
 if FTextStyle in [tsRecessed,tsRaised] then begin
  TmpRect:=Rect;OffsetRect(TmpRect,1,1);Canvas.Font.Color:=LowerColor;
  if fEscapement <> 0 then DrawAngleText(Canvas,TmpRect,fEscapement,Text)
  {$IFDEF WIN32}
   else DrawText(Canvas.Handle,pChar(Text),Length(Text),TmpRect,Flags);
  {$ELSE}
   else DrawText(Canvas.Handle,cStr,Length(Text),TmpRect,Flags);
  {$ENDIF}
  TmpRect:=Rect;OffsetRect(TmpRect,-1,-1);Canvas.Font.Color:=UpperColor;
  if fEscapement <> 0 then DrawAngleText(Canvas,TmpRect,fEscapement,Text)
  {$IFDEF WIN32}
  else DrawText(Canvas.Handle,pChar(Text),Length(Text),TmpRect,Flags);
  {$ELSE}
  else DrawText(Canvas.Handle,cStr,Length(Text),TmpRect,Flags);
  {$ENDIF}
 end;
 Canvas.Font.Color := Font.Color;
 if not Enabled then Canvas.Font.Color := clGrayText;
 if fEscapement <> 0 then DrawAngleText(Canvas,Rect,fEscapement,Text)
 {$IFDEF WIN32}
 else DrawText(Canvas.Handle,pChar(Text),Length(Text),Rect,Flags);
 {$ELSE}
 else DrawText(Canvas.Handle,cStr,Length(Text),Rect,Flags);
 {$ENDIF}
end;

end.