?? 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 + -