印章图型显示问题,急! ( 积分: 200 )

谁能提供印章代码(圆形、椭圆形、正方形、三角形),高分送出!

1、过去用大萝卜刻过几个，给你一个函数：
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;
2、用的时候，先把 PaintBox 设为中文字符集，并选择中文字体（如黑体），然后：
SectorTextOut(PaintBox.Canvas, 100, 100, 270, 50, '某某公司');
3、保存为 bmp
var
bmp: TBitmap;
r: TRect;
begin
bmp := TBitmap.Create;
bmp.Width := PaintBox.Width;
bmp.Height := PaintBox.Height;
r := Rect(Paintbox.Left, Paintbox.Top, Paintbox.Width, Paintbox.Height);
bmp.Canvas.CopyRect(r, PaintBox.Canvas, r);
bmp.SaveToFile('d:/a.bmp');
bmp.Free;
end;
4、至于椭圆、三角形的懒得写了...

vvyang大哥：
测试时文字不是按弧度排列，而歪歪扭扭的。
你再辛苦写完好吗？我再给你加分。
最好有完整的源代码发给我好吗？
QQ：403019047
邮箱：wulongdong@21cn.com

demo 给你啦

unit chork;

interface

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

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

var
Form1: TForm1;

implementation

{$R *.dfm}

uses myfunctions;

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);
var
x, y, r, fh: integer;
begin
canvas.Brush.Color:=clwhite;
canvas.FillRect(clientRect);
canvas.Font.Name:='宋体';
canvas.Font.Color:=clRed;
canvas.Font.Size:=10;
x:=200;
y:=200;
R:=30;
fh:=3*canvas.TextHeight('我') div 4;
canvas.Pen.Width:=2;
canvas.Pen.Color:=clRed;
canvas.Ellipse(x-r-fh, y-r-fh, x+r+fh, y+r+fh);
canvas.Ellipse(x-r+fh, y-r+fh, x+r-fh, y+r-fh);

SectorTextOut(canvas, x, y, 270, r, '爱高塑胶厂品质管理部');
// myfunctions.Draw5pStar(canvas, r-5*fh div 3 , -18, x, y);

end;

procedure TForm1.Button2Click(Sender: TObject);
var
pt: array[1..5] of Tpoint;
R: integer;
A: integer;
org: integer;
x, y, i: integer;
begin
A:=-18;
org:=200;
R:=200;
for i:=1 to 5 do
begin
x:=round(R*cos(pi*A/180));
y:=round(R*sin(pi*A/180));
pt.X:=org+x;
pt.Y:=org+y;
inc(A, 360 div 5);
canvas.TextOut(pt.X, pt.Y, inttostr(i));
end;
canvas.Pen.Color:=clRed;
canvas.Brush.Color:=clRed;
canvas.Polygon([pt[1], pt[3], pt[5], pt[2], pt[4], pt[1]]);
//canvas.TextOut(org, org, 'org');
canvas.FloodFill(org, org, clRed, fsBorder);
end;

procedure TForm1.Button3Click(Sender: TObject);
begin
//myfunctions.Draw5pStar(canvas, 100, -18, 200, 200);
end;

procedure TForm1.Button4Click(Sender: TObject);
begin
canvas.Font.Size:=20;
canvas.TextOut(10, 60, 'ddsdd s 湿度的刚刚来可控件进经');
myfunctions.DrawChorkSoft(canvas, 270, 12, 100, 10, 10,'爱高塑胶厂品质管理部');
end;

end.

to xuxiaohan:
myfunctions.DrawChorkSoft(canvas, 270, 12, 100, 10, 10,'爱高塑胶厂品质管理部')中,myfunctions.DrawChorkSoft的函数无办法找到呢

这个是半透明水印相关，你可以去掉这一句。

to xuxiaohan:
还有椭圆、三角形、正方形。。。我今后有事还要请教你!
能提供联系方式吗?

接受了

QQ： 284039616

QQ： 284039616