图章

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.

阅读更多
想对作者说点什么?

博主推荐

换一批

没有更多推荐了,返回首页