📄 t_course.pas
字号:
////////////////////////////////////////////////////
// //
// SPR中央宣传部2003年核准下发 中京[2003-6712] //
// SPR Army TMP10Game of China //
// //
// 2003年 //
// 1.0 //
////////////////////////////////////////////////////
//临10局核准下发，13局提供
unit T_Course;
{
All string point in the working.
}
interface
uses
Windows, Messages,StdCtrls,Dialogs,
SysUtils, Controls, Graphics,ExtCtrls,Types,Forms
;
type
TCeaterLine = record
Point_1:Tpoint;
Point_2:TPoint;
PenMode:TPenMode;
li:integer;
LineWidth:integer;
Pencolor:TColor;
PenWidth:integer;
end;
type
TDrawingTool = (dtLine,//直线
dtRectangle,//直角方形
dtEllipse,//圆
dtRoundRect,//弧边圆
dtlineDD1,//竖双线
dtlinedd2,//横双线
dtlineDD3,//封闭多边形
dtarc,//弧
dtround,//同心圆
dtfillpoly,//填充颜色
dtfillpoly2,//填充封闭多边形
dthz//矢量汉字--未定义
);
//画图 (控件名称，画图类型，头坐标，尾坐标，画图模式，鼠标判断)
function GDrawShape(Image:Timage;DrawingTool:TDrawingTool;TopLeft, BottomRight: TPoint; AMode: TPenMode;drawbool:boolean):string;
//画图 (控件名称，画图类型，坐标序列（非标准命令符），画图模式)
function GDrawShape_(Image:Timage; DrawingTool:TDrawingTool;PointArr:string;AMode:TPenMode):string;
//截取字符串 (字符串，截取分隔符，截取类型)
function GShow_title(str:Ansistring;feng:char;lei:integer):string;
//矢量缩小/放大 (操作坐标，操作参数 当li>0时放大，否则缩小)
function Gvex_InOut(num:tpoint;li:real):tpoint;
//求缩放比 (第一参数，第二参数 以小的数值为返回值)
function GVex_li(Wh1,Wh2:Tpoint):real;
//新建图片 (控件名称，创建类型,预设宽度)
function GCreatbmp(IM:Timage;lei,Mwidth,Tmp_width,Tmp_height:integer):string;
//标准格 (控件名称，格宽，笔宽，笔颜色，类型)
procedure GStandard(IM:Timage;width,penwidth:integer;color:Tcolor;li:integer);
//返回按比例缩小坐标字符串(坐标串，可绘面积，Timage控件，绘图类型)
function GPointZoomOut(str,data:string;im:Timage;li:integer):string;
//返回按比例缩小坐标字符串(坐标串，缩放比，类型----为1时对笔宽进行缩放)
function GPointZoomOut2(str:AnsiString;_li:real;li:integer):string;
//剪切可视区域
function GPointMoveto(str,data:string;im:Timage;li:integer):string;
//按spis格式重绘Timage控键各信息(传递标准命令符)
function SPIStoCourse(Arrpoint:string;im:Timage):string;
//传递坐标组到listbox控件（传递标准坐标字符串）
procedure GgetPointArr(Arrpoint:string;list:Tlistbox);
//以下为相互转换
function StrtoDraw(str:string):TDrawingTool;//命令字符
function Drawtostr(DT:TDrawingTool):string;
function StrToPenStyles(str:string):TpenStyle;//笔类型
function PenStylestostr(TS:TpenStyle):string;
function StrtoBrushStyles(Str:string):TBrushStyle;//画布类型
function BrushStylestostr(BS:TBrushStyle):string;
function FontStyletostr(FS:TFontStyle):string;
function strtoFontStyle(str:string):TFontStyle;
//按角度改变坐标
function Geddying(Gxy:Tpoint;U:real;li:integer):Tpoint;
//按X,Y分别改变坐标
function GLineMove(Gxy:tpoint;li:integer;data:real):Tpoint;
//查找坐标
function GListPoint(st:Tpoint;listPoint:string;warp:integer):integer;//在坐标序列里查找
function GListPointII(st:Tpoint;listPoint:Tlistbox;warp:integer):integer;//在列表控件中查找
function GRectBoundPoint(Top,bottom:Tpoint;aim:TPoint):boolean;//再给定区查找
//给出命令行改变坐标
function GPoint_str(PointString:string;data:real;li:integer):string;
//给出坐标字符串改变坐标
function GSpisPoint_str(str:string;data:real;li:integer):string;
//标准格
Procedure GstandardLine(im:Timage;m1,m2,M3,M4,PenWidth,LineWidth:integer;color:Tcolor;li:integer);
//中心线(1-9)
Procedure GCenterLine(im:Timage;m1,m2,M3,M4,PenWidth,LineWidth:integer;color:Tcolor;PenMode:TPenMode;li:integer);
//可视区中心线
procedure GShow_CeaterLine(im:Timage;m1,m2,M3,M4,PenWidth,LineWidth:integer;color:Tcolor;PenMode:TPenMode;Ceater_li:integer);
//找出最边上的四点
Function GPointEstimate_str(ListPoint:string):string;//传递标准坐标,返回顶、底坐标
Function GPointEstimate_Point(listPoint:string;li:integer):TPoint;
function GPointEstimate_1(im:Timage;list:Tlistbox;li:integer):String;//传递标准坐标
function GPointEstimate_2(im:Timage;list:Tlistbox;li:integer):String;//传递绘制长方形顶,底坐标
//定位控健左上角坐标
procedure GPoint_show(ScrollBox:TScrollBox;bx,by,li:integer);
//合并控件中的坐标，注意不要太大
function GListToStrSPIS(listbox:Tlistbox;top,butt:integer):ansistring;
//提取SPIS扩展命令集
function GExtSPISReam(listorder:string):string;
var
GM_StringPoint:AnsiString;//鼠标轨迹记录
M_li:double;//整图缩放比例
DrawingTool:TDrawingTool;//画图类型
Drawing:boolean;//鼠标状态--连续作图
G_OldCeaterLine:TCeaterLine;//以画中心线 注意：li是判断使用的基本条件
G_PointSum:integer;//记录坐标点数目
implementation
//扩展定义符号序列 只在连接时使用
//扩展部分有结束符号，且不能与内容相同
{
左大扩号扩展开始
^ 标点序列EG:^1,3,9,11,13,15, 拐点//全部为基数 ^结束
: 组号//层 :结束
_ 汉字说明内容 _结束
右大扩号扩展结束
}
function GExtSPISReam(listorder:string):string;
begin
if uppercase(GShow_title(listorder,'{',5)) = uppercase('true')
then begin
if uppercase(GShow_title(listorder,'}',5)) = uppercase('true')
then result:=GShow_title(GShow_title(listorder,'{',4),'}',3)
else result:=GShow_title(listorder,'{',4)
end
else result:='';
end;
Procedure GCenterLine(im:Timage;m1,m2,M3,M4,PenWidth,LineWidth:integer;color:Tcolor;PenMode:TPenMode;li:integer);
var Oldwidth:integer;
OldColor:Tcolor;
OldMode:TPenMode;
begin
oldwidth:=im.Canvas.Pen.Width;
oldcolor:=im.Canvas.Pen.Color;
OldMode:=im.Canvas.Pen.Mode;
im.Canvas.Pen.Width:=PenWidth;
im.Canvas.Pen.Color :=color;
im.Canvas.Pen.Mode:=PenMode;
case li of
1:begin
im.Canvas.MoveTo((abs(m1-m3) div 2)+m3,m4); // .(m3,m4) | }
im.Canvas.lineto((abs(m1-m3) div 2)+m3,m2); // { | }
// {--------|--------}
im.Canvas.MoveTo(m3,(abs(m2-m4) div 2) +m4); // { | }
im.Canvas.lineto(m1,(abs(m2-m4) div 2) +m4); // { | .(m1,m2)
end;
2:begin
im.Canvas.MoveTo(m1,abs(m2-m3)); // { | }
im.Canvas.lineto(m1,abs(m2+m3)); // { m3 }
// {--m4----.---------}// (m1,m2)
im.Canvas.MoveTo(abs(m1-m4),m2); // { | }
im.Canvas.lineto(abs(m1+m4),m2); // { | }
end;
3:begin // _
im.Canvas.MoveTo(m1+(m4 div 2),m2); // .(m1,m2) | } |
im.Canvas.lineto(m1+(m4 div 2),m2+m3); // { | } |
// {--------|---------} m3
im.Canvas.MoveTo(m1,m2+(m3 div 2)); // { | } |
im.Canvas.lineto(m1+m4,m2+(m3 div 2)); // { | } |
end; // //-------m4---------// -
4:begin
im.Canvas.MoveTo(m1,0); // { | }
im.Canvas.lineto(m1,im.Height); // { | }
// {--------.---------}// (m1,m2)
im.Canvas.MoveTo(0,m2); // { | }
im.Canvas.lineto(im.Width,m2); // { | }
end;
5:begin//斜十字
im.Canvas.MoveTo(0,0);
im.Canvas.lineto(im.Width,im.Height);
im.Canvas.MoveTo(im.Width,0);
im.Canvas.lineto(0,im.Height);
end;
6:begin//区域内斜十字
im.Canvas.MoveTo(m1,m2);
im.Canvas.lineto(m3,m4);
im.Canvas.MoveTo(m3,m2);
im.Canvas.lineto(m1,m4);
end;
7:begin//米字格
im.Canvas.MoveTo(0,0);
im.Canvas.lineto(im.Width,im.Height);
im.Canvas.MoveTo(im.Width,0);
im.Canvas.lineto(0,im.Height);
im.Canvas.MoveTo(0,im.Height div 2);
im.Canvas.lineto(im.Width,im.Height div 2);
im.Canvas.MoveTo(im.Width div 2,0);
im.Canvas.lineto(im.Width div 2,im.Height);
end;
8:begin//区域内米字格
im.Canvas.MoveTo(m1,m2);
im.Canvas.lineto(m3,m4);
im.Canvas.MoveTo(m3,m2);
im.Canvas.lineto(m1,m4);
im.Canvas.MoveTo(m1+((m3-m1) div 2),m2);
im.Canvas.lineto(m1+((m3-m1) div 2),m4);
im.Canvas.MoveTo(m1,(m2+(m4-m2) div 2));
im.Canvas.lineto(m3,(m2+(m4-m2) div 2));
end;
9:begin//区域内米字格--带边框
im.Canvas.Rectangle(m1,m2,m3,m4);
im.Canvas.MoveTo(m1,m2);
im.Canvas.lineto(m3,m4);
im.Canvas.MoveTo(m3,m2);
im.Canvas.lineto(m1,m4);
im.Canvas.MoveTo(m1+((m3-m1) div 2),m2);
im.Canvas.lineto(m1+((m3-m1) div 2),m4);
im.Canvas.MoveTo(m1,(m2+(m4-m2) div 2));
im.Canvas.lineto(m3,(m2+(m4-m2) div 2));
end;
end;//case
im.Canvas.Pen.Width:=oldwidth;
im.Canvas.Pen.Color:=oldcolor;
im.Canvas.Pen.Mode:=OldMode;
end;
Procedure GstandardLine(im:Timage;m1,m2,M3,M4,PenWidth,LineWidth:integer;color:Tcolor;li:integer);
var h:integer;
begin
im.Canvas.Pen.Width:=PenWidth;
im.Canvas.Pen.Color :=Color;
case li of
1:begin
h:=0;
while h < m2 do
begin
im.Canvas.moveto(m3,h);
Im.Canvas.lineto(m1,h);
h:=h+LineWidth;
end;
h:=0;
while h < m1 do
begin
Im.Canvas.moveto(h,m4);
Im.Canvas.lineto(h,m2);
h:=h+LineWidth;
end;
end;
2:begin
h:=0;
while h < m2 do
begin
im.Canvas.moveto(m3,h);
Im.Canvas.lineto(m1,h);
h:=h+LineWidth;
end;
end;
3:begin
h:=0;
while h < m1 do
begin
Im.Canvas.moveto(h,m4);
Im.Canvas.lineto(h,m2);
h:=h+LineWidth;
end;
end;
end;//case
end;
function GLineMove(Gxy:tpoint;li:integer;data:real):Tpoint;
begin
case li of
1:Gxy.x:=Round(Gxy.x+data);
2:Gxy.y:=Round(Gxy.y+data);
3:Gxy.y:=Round(Gxy.x*data);
4:Gxy.y:=Round(Gxy.y*data);
end;
result:=Gxy;
end;
function Geddying(Gxy:Tpoint;U:real;li:integer):Tpoint;
begin
case li of
1:begin
Gxy.x:=round((Gxy.x)*cos(u)-(Gxy.y)*sin(u));
Gxy.y:=round((Gxy.x)*sin(u)+(Gxy.y)*cos(u));
// Gxy.y:=round((u+gxy.Y*cos(u))/(Gxy.X*sin(u)));
end;
2:begin
end;
end;
result:=Gxy;
end;
function PenStylestostr(TS:TpenStyle):string;
begin
case TS of
psSolid:result:='psSolid';
psDash:result:='psDash';
psDot:result:='psDot';
psDashDot:result:='psDashDot';
psDashDotDot:result:='psDashDotDot';
psClear:result:='psClear';
end;//case
end;
function StrToPenStyles(str:string):TpenStyle;
begin
result := psSolid;
if uppercase(str) = uppercase('psSolid')
then result := psSolid;
if uppercase(str) = uppercase('psDash')
then result := psDash;
if uppercase(str) = uppercase('psDot')
then result := psDot;
if uppercase(str) = uppercase('psDashDot')
then result := psDashDot;
if uppercase(str) = uppercase('psDashDotDot')
then result := psDashDotDot;
if uppercase(str) = uppercase('psClear')
then result := psClear;
end;
function Drawtostr(DT:TDrawingTool):string;
begin
case DrawingTool of
dtLine:result :='dtLine';
dtRectangle:result :='dtRectangle';
dtEllipse:result :='dtEllipse';
dtRoundRect:result :='dtRoundRect';
dtlineDD1:result :='dtlineDD1';
dtlinedd2:result :='dtlineDD2';
dtlineDD3:result :='dtlineDD3';
dtarc:result :='dtarc';
dtround:result :='dtround';
dtfillpoly:result :='dtfillpoly';
dtfillpoly2:result :='dtfillpoly2';
dthz:result :='dthz';
end;
end;
function StrtoDraw(str:string):TDrawingTool;
begin
//if uppercase(str) = uppercase('dtanear')
// then result := dtanear;
result := dtfillpoly2;
if uppercase(str) = uppercase('dtfillpoly2')
then result := dtfillpoly2;
if uppercase(str) = uppercase('dtfillpoly')
then result := dtfillpoly;
if uppercase(str) = uppercase('dtLine')
then result := dtLine;
if uppercase(str) = uppercase('dtRectangle')
then result :=dtRectangle;
if uppercase(str) = uppercase('dtEllipse')
then result :=dtEllipse;
if uppercase(str) = uppercase('dtRoundRect')
then result :=dtRoundRect;
if uppercase(str) = uppercase('dtlineDD1')
then result :=dtlineDD1;
if uppercase(str) = uppercase('dtlinedd2')
then result :=dtlinedd2;
if uppercase(str) = uppercase('dtlineDD3')
then DrawingTool :=dtlineDD3;
if uppercase(str) = uppercase('dtarc')
then result :=dtarc;
if uppercase(str) = uppercase('dtround')
then result :=dtround;
if uppercase(str) = uppercase('dthz')
then result :=dthz;
end;
function FontStyletostr(FS:TFontStyle):string;
begin
case fs of
fsBold:result := 'fsBold';
fsItalic:result := 'fsItalic';
fsUnderline:result := 'fsUnderline';
fsStrikeOut:result := 'fsStrikeOut';
end;
end;
function strtoFontStyle(str:string):TFontStyle;
begin
result := fsBold;
if uppercase(str) = uppercase('fsBold')
then result := fsBold;
if uppercase(str) = uppercase('fsItalic')
then result := fsItalic;
if uppercase(str) = uppercase('fsUnderline')
then result := fsUnderline;
if uppercase(str) = uppercase('fsStrikeOut')
then result := fsStrikeOut;
end;
function BrushStylestostr(BS:TBrushStyle):string;
begin
case bs of
bsSolid: result := 'bsSolid';
bsClear:result :='bsClear';
bsHorizontal:result :='bsHorizontal';
bsVertical:result :='bsVertical';
bsFDiagonal:result :='bsFDiagonal';
bsBDiagonal:result :='bsBDiagonal';
bsCross:result :='bsCross';
bsDiagCross: result :='bsDiagCross';
end;
end;
function StrtoBrushStyles(Str:string):TBrushStyle;
begin
result := bsSolid;
if uppercase(str) = uppercase('bsSolid')
then result := bsSolid;
if uppercase(str) = uppercase('bsClear')
then result :=bsClear;
if uppercase(str) = uppercase('bsHorizontal')
then result :=bsHorizontal;
if uppercase(str) = uppercase('bsVertical')
then result :=bsVertical;
if uppercase(str) = uppercase('bsFDiagonal')
then result :=bsFDiagonal;
if uppercase(str) = uppercase('bsBDiagonal')
then result :=bsBDiagonal;
if uppercase(str) = uppercase('bsCross')
then result :=bsCross;
if uppercase(str) = uppercase('bsDiagCross')
then result :=bsDiagCross;
end;
function GVex_li(Wh1,Wh2:Tpoint):real;
begin
if (wh1.x / wh2.x) < (wh1.y / wh2.y)
then result:=wh1.x / wh2.x
else result:=wh1.y / wh2.y;
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -