图章

最新推荐文章于 2024-09-18 22:43:41 发布

yjswjm119

最新推荐文章于 2024-09-18 22:43:41 发布

阅读量885

点赞数

分类专栏： Delphi_Picture 文章标签： integer button string forms interface windows

本文链接：https://blog.csdn.net/yjswjm119/article/details/556812

版权

Delphi_Picture 专栏收录该内容

4 篇文章 0 订阅

订阅专栏

unit Unit1;

interface

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, ExtCtrls;

type
TForm1 = class(TForm)
    PaintBox1: TPaintBox;
    Button1: TButton;
    Button2: TButton;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
private
    { Private declarations }
public
    { Public declarations }
end;

var
Form1: TForm1;

implementation

{$R *.dfm}
procedure AngleTextOut(Canvas: TCanvas; const X, Y, Angle: Integer;
const Text: string);
var
NewFnt: TFont;
Lfnt: tagLOGFONTA;
begin
NewFnt := TFont.Create;
NewFnt.Assign(Canvas.Font);
GetObject(NewFnt.Handle, SizeOf(Lfnt), @Lfnt);
with Lfnt do
begin
    lfEscapement := 10 * Angle;
    lfOrientation := 0;
end;
if GetBkMode(Canvas.Handle) = OPAQUE then
    SetBkMode(Canvas.Handle, TRANSPARENT);
NewFnt.Handle := CreateFontIndirect(Lfnt);
Canvas.Font.Assign(NewFnt);
NewFnt.Free;
Canvas.TextOut(X, Y, Text);
end;

//Canvas：画布；X, Y：扇形圆心；Angle：扇形的角度；Radius：扇形半径；Text：文字
procedure SectorTextOut(Canvas: TCanvas; const X, Y, Angle, Radius: Integer;
const Text: string);
var
N, I: Integer;
Alfa, CosAlfa, SinAlfa, XPos, YPos: Double;
begin
N := Length(WideString(Text));
for I := 1 to N do
begin
    Alfa := 0.5 * Angle * (2 * I - N -1) / N;
    CosAlfa := Cos(Alfa * Pi / 180);
    SinAlfa := Sin(Alfa * Pi / 180);
    XPos := (0.5 * Canvas.Font.Height - Radius) * SinAlfa - 0.5 * Canvas.Font.Size * CosAlfa;
    YPos := (0.5 * Canvas.Font.Height - Radius) * CosAlfa + 0.5 * Canvas.Font.Size * SinAlfa;
    AngleTextOut(Canvas, Round(X + XPos), Round(Y + YPos), Round(Alfa), WideString(Text)[N - I + 1]);
end;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
SectorTextOut(PaintBox1.Canvas, 100, 100, 270, 50, '某某公司');
end;

procedure TForm1.Button2Click(Sender: TObject);
var
bmp: TBitmap;
r: TRect;
begin
bmp := TBitmap.Create;
bmp.Width := PaintBox1.Width;
bmp.Height := PaintBox1.Height;
r := Rect(Paintbox1.Left, Paintbox1.Top, Paintbox1.Width, Paintbox1.Height);
bmp.Canvas.CopyRect(r, PaintBox1.Canvas, r);
bmp.SaveToFile('c:/a.bmp');
bmp.Free;
end;

end.