t_course.pas

Delphi图像盖章程序源码,供大家参考。

end;

function GSpisPoint_str(str:string;data:real;li:integer):string;
var tmp:string;
begin
    case li of
    1:tmp:=GPoint_str(Gshow_title(Gshow_title(Str,':',4),'@',3),data,li);
    2:tmp:=GPoint_str(Gshow_title(Gshow_title(Str,':',4),'@',3),data,li);
    3:tmp:=GPoint_str(Gshow_title(Gshow_title(Str,':',4),'@',3),data,li);
    4:tmp:=GPoint_str(Gshow_title(Gshow_title(Str,':',4),'@',3),data,li);
    5:tmp:=GPoint_str(Gshow_title(Gshow_title(Str,':',4),'@',3),data,li);
    end;//case
result:=Gshow_title(Str,':',3)+':'+tmp+'@'+Gshow_title(Str,'@',4);
end;

function GPoint_str(PointString:string;data:real;li:integer):string;
var tmp:string;
    i,adds:integer;
    tmppoint:Tpoint;
begin
tmp:='';adds:=0;
for i:=0 to length(PointString) do
    if PointString[i] = ';'
       then adds:=adds+1;

case li of
1:begin//->x
for i:=0 to adds-1 do begin
tmp:=tmp+inttostr(round(strtoint(Gshow_title(PointString,',',3))+data))+',';
  PointString:=Gshow_title(PointString,',',4);
tmp:=tmp+inttostr(strtoint(Gshow_title(PointString,';',3)))+';';
  PointString:=Gshow_title(PointString,';',4);
                      end;
  end;
2:begin//->y
for i:=0 to adds-1 do begin
tmp:=tmp+inttostr(strtoint(Gshow_title(PointString,',',3)))+',';
  PointString:=Gshow_title(PointString,',',4);
tmp:=tmp+inttostr(round(strtoint(Gshow_title(PointString,';',3))+data))+';';
  PointString:=Gshow_title(PointString,';',4);
                      end;
  end;
3:begin//->xy */
for i:=0 to adds-1 do begin
tmp:=tmp+inttostr(round(strtoint(Gshow_title(PointString,',',3))*data))+',';
  PointString:=Gshow_title(PointString,',',4);
tmp:=tmp+inttostr(round(strtoint(Gshow_title(PointString,';',3))*data))+';';
  PointString:=Gshow_title(PointString,';',4);
                      end;
  end;
4:begin//->xy +-
for i:=0 to adds-1 do begin
tmp:=tmp+inttostr(round(strtoint(Gshow_title(PointString,',',3))+data))+',';
  PointString:=Gshow_title(PointString,',',4);
tmp:=tmp+inttostr(round(strtoint(Gshow_title(PointString,';',3))+data))+';';
  PointString:=Gshow_title(PointString,';',4);
                      end;
  end;
5:begin
for i:=0 to adds-1 do begin
tmppoint:=Geddying(
    point(strtoint(Gshow_title(PointString,',',3)),
          strtoint(Gshow_title(Gshow_title(PointString,';',3),',',4)))
          ,data,1);
tmp:=tmp+inttostr(tmppoint.x)+','+inttostr(tmppoint.Y)+';';
PointString:=Gshow_title(PointString,';',4);
                      end;
  end;
end;//case
result:=tmp;
end;

function GPointZoomOut2(str:AnsiString;_li:real;li:integer):string;
var tmp,strs:AnsiString;
    i,l:integer;
    tmppoint:Tpoint;
begin
tmp:='';
strs:=str;
str:=T_Course.Gshow_title(T_Course.Gshow_title(str,':',4),'@',3);
for i:=1 to strtoint(Gshow_title(str,';',6)) do begin
  tmppoint.X:=strtoint(Gshow_title(Gshow_title(str,';',3),',',3));
  tmppoint.Y:=strtoint(Gshow_title(Gshow_title(str,';',3),',',4));
  tmp:=tmp+inttostr(round(tmppoint.X*_li))+','+inttostr(round(tmppoint.Y*_li))+';';
  str:=Gshow_title(str,';',4);
                                                end;
tmp:=Gshow_title(strs,':',3)+':'+tmp+'@'+Gshow_title(strs,'@',4);
case li of
1:begin
  if round(strtoint(Gshow_title(Gshow_title(strs,'<',4),'>',3))*_li)<0
     then l:=1
     else l:=round(strtoint(Gshow_title(Gshow_title(strs,'<',4),'>',3))*_li);
str:=inttostr(l);
tmp:=Gshow_title(tmp,'<',3)+'<'+str+'>'+Gshow_title(tmp,'>',4);
  end;
end;//case
result:=tmp;
end;

function GPointZoomOut(str,data:AnsiString;im:Timage;li:integer):string;
var tmp,strs:AnsiString;
    i:integer;
    tmppoint,P1,P2:Tpoint;
    l:real;
begin
p1.x:=strtoint(T_Course.Gshow_title(data,',',3));
  data:=T_Course.Gshow_title(data,',',4);
p1.y:=strtoint(T_Course.Gshow_title(data,';',3));
  data:=T_Course.Gshow_title(data,';',4);
p2.x:=strtoint(T_Course.Gshow_title(data,',',3));
  data:=T_Course.Gshow_title(data,',',4);
p2.y:=strtoint(T_Course.Gshow_title(data,';',3));


l:=Gvex_li(p1,p2);
M_li:=l;
    case li of
    1:T_Course.Gcreatbmp(im,4,0,p2.X-p1.X,p2.Y-p2.Y);
    end;//case

tmp:='';
strs:=str;
str:=T_Course.Gshow_title(T_Course.Gshow_title(str,':',4),'@',3);
for i:=1 to strtoint(Gshow_title(str,';',6)) do begin
  tmppoint.X:=strtoint(T_Course.Gshow_title(T_Course.Gshow_title(str,';',3),',',3));
  tmppoint.Y:=strtoint(T_Course.Gshow_title(T_Course.Gshow_title(str,';',3),',',4));
  tmp:=tmp+inttostr(round(tmppoint.X*l))+','+inttostr(round(tmppoint.Y*l))+';';
  str:=Gshow_title(str,';',4);
                                                end;
tmp:=T_Course.Gshow_title(strs,':',3)+':'+tmp+'@'+T_Course.Gshow_title(strs,'@',4);
result:=tmp;
end;


function GVex_InOut(num:tpoint;li:real):tpoint;
begin
num.x:=round(num.x*li);
num.y:=round(num.y*li);
Gvex_InOut.x:=num.x;
Gvex_InOut.y:=num.y;
end;

function GShow_title(str:Ansistring;feng:char;lei:integer):string;
var i,k:integer;
begin
str:=trim(str);
//feng:=trim(feng);
case lei of
1:begin//拆除单项,在后
k:=0;
for i:=1 to length(str) do begin
   if str[i] = feng
      then k:=i+1;
                           end;//for
result:=copy(str,k,length(str));
  end;//1
2:begin//拆除单项,在前
k:=0;
for i:=1 to length(str) do begin
   if str[i] = feng
      then k:=i-1;
                           end;//for
result:=copy(str,1,k);
  end;//2
3:begin//拆除单项,在前
k:=0;
for i:=1 to length(str) do begin
   if str[i] = feng
      then begin
            k:=i-1;
            break;
           end;
                           end;//for
result:=copy(str,1,k);
  end;//3
4:begin//拆除单项,在后
k:=0;
for i:=1 to length(str) do begin
   if str[i] = feng
      then begin
            k:=i+1;
            break;
           end;
                           end;//for
result:=copy(str,k,length(str));
  end;//4
5:begin//存在
k:=0;
for i:=1 to length(str) do begin
   if str[i] = feng
      then begin
            k:=1;
            break;
           end;
                            end;
if k = 1
  then result:=uppercase('true')
  else result:=uppercase('false');
  end;//5
6:begin
k:=0;
for i:=1 to length(str) do
   if str[i] = feng
      then k:=k+1;
result:=inttostr(k);
  end;//6
end;
end;


function GDrawShape(Image:Timage; DrawingTool:TDrawingTool;TopLeft, BottomRight: TPoint; AMode: TPenMode;drawbool:boolean):string;
var strpointarr:array [1..256] of tpoint;
    tmp:ansistring;
    i,adds:integer;
begin
adds:=0;
result:='';
  with Image.Canvas do
  begin
    Pen.Mode := AMode;
    case DrawingTool of
      dtLine:
        begin
          MoveTo(TopLeft.X, TopLeft.Y);
          LineTo(BottomRight.X, BottomRight.Y);
        end;
      dtlineDD1:
        begin
          MoveTo(TopLeft.X+3, TopLeft.Y);
          LineTo(BottomRight.X+3, BottomRight.Y);
          MoveTo(TopLeft.X-3, TopLeft.Y);
          LineTo(BottomRight.X-3, BottomRight.Y);
        end;
      dtlineDD2:
        begin
          MoveTo(TopLeft.X, TopLeft.Y+3);
          LineTo(BottomRight.X, BottomRight.Y+3);
          MoveTo(TopLeft.X, TopLeft.Y-3);
          LineTo(BottomRight.X, BottomRight.Y-3);
        end;
      dtlineDD3://
        begin
          MoveTo(TopLeft.X, TopLeft.Y);
          LineTo(BottomRight.X, BottomRight.Y);
if not drawing//结束画图
   then begin
for i:=0 to length(GM_stringpoint) do
    if GM_StringPoint[i] = ';'
       then adds:=adds+1;
tmp:=GM_Stringpoint;
for i:=1 to adds do begin
strpointarr[i].x:=strtoint(Gshow_title(tmp,',',3));
tmp:=Gshow_title(tmp,',',4);
strpointarr[i].y:=strtoint(Gshow_title(tmp,';',3));
tmp:=Gshow_title(tmp,';',4);
                      end;
strpointarr[adds+1]:=strpointarr[1];
polygon(slice(strpointarr,adds));
          end;
        end;
      dtfillpoly:begin
if not drawing
   then floodfill(BottomRight.x,BottomRight.y,pen.color,fsborder);
                 end;
      dtfillpoly2:begin//封闭多边行

          MoveTo(TopLeft.X, TopLeft.Y);
          LineTo(BottomRight.X, BottomRight.Y);

if not drawing//结束画图
   then begin
for i:=0 to length(GM_stringpoint) do
    if GM_stringpoint[i] = ';'
       then adds:=adds+1;
tmp:=GM_stringpoint;
for i:=1 to adds do begin
strpointarr[i].x:=strtoint(Gshow_title(tmp,',',3));
tmp:=Gshow_title(tmp,',',4);
strpointarr[i].y:=strtoint(Gshow_title(tmp,';',3));
tmp:=Gshow_title(tmp,';',4);
                      end;
polygon(slice(strpointarr,adds));
          end;

                  end;
      dtarc:begin
             MoveTo(TopLeft.X, TopLeft.Y);
             arc(TopLeft.X, TopLeft.Y,
                 BottomRight.X, BottomRight.Y,
                 TopLeft.X, TopLeft.Y,
                 BottomRight.X, BottomRight.Y
                );
            end;
      dtRectangle:
          Rectangle(TopLeft.X, TopLeft.Y,
                    BottomRight.X,BottomRight.Y);
      dtEllipse:begin
          Ellipse(Topleft.X, TopLeft.Y,
                  BottomRight.X,BottomRight.Y);
                 end;
     dtRoundRect:
           roundRect(TopLeft.X, TopLeft.Y,
                    BottomRight.X,BottomRight.Y,
                    (TopLeft.X - BottomRight.X) div 5,
                    (TopLeft.Y - BottomRight.Y) div 5);
      dtround:begin//同心圆
{          Ellipse(Topleft.X, TopLeft.Y,
                  BottomRight.X,BottomRight.Y);}

i:=round(sqrt(sqr(Topleft.X-BottomRight.X)+sqr(TopLeft.Y-BottomRight.Y)));
//mainFDraw.caption:=inttostr(i)+':'+inttostr(Topleft.X)+','+inttostr(Topleft.y)+';'+inttostr(BottomRight.X)+','+inttostr(BottomRight.Y);
Ellipse(Topleft.X-i, TopLeft.Y-i,BottomRight.X+i,BottomRight.Y+i);
              end;
       dthz:
        begin
        end;
    end;
  end;
end;

procedure GGetPointArr(Arrpoint:string;list:Tlistbox);
var i:integer;
begin
for i:=0 to strtoint(Gshow_title(arrpoint,';',6))-1 do begin
  if list.items.Count <= 1
      then list.items.add(Gshow_title(arrpoint,';',3)+';')
      else if uppercase(Gshow_title(arrpoint,';',3)) <> uppercase(list.items[list.items.Count-1])
              then list.items.add(Gshow_title(arrpoint,';',3)+';');
   arrpoint:=Gshow_title(arrpoint,';',4)                                                       end;
end;

function GDrawShape_(Image:Timage;DrawingTool:TDrawingTool;PointArr:ansistring;AMode:TPenMode):string;
var StrPointArr:array  of tpoint;
    tmp:string;
    i,adds:integer;
begin
//填充数组
adds:=strtoint(GShow_title(PointArr,';',6));

if adds <> 1
   then begin
PointArr:=copy(PointArr,0,length(PointArr)-1);
PointArr:=Gshow_title(PointArr,';',2)+';';
adds:=adds-1;
        end;

setlength(StrPointArr,adds);

tmp:=PointArr;
for i:=0 to adds-1 do begin
StrPointArr[i].x:=strtoint(Gshow_title(tmp,',',3));
tmp:=Gshow_title(tmp,',',4);
StrPointArr[i].y:=strtoint(Gshow_title(tmp,';',3));
tmp:=Gshow_title(tmp,';',4);
                      end;
//按坐标画图
  with Image.Canvas do  begin
    Pen.Mode := AMode;
    case DrawingTool of
        dtLine,dtlineDD3:begin//直线
//   polyline(slice(StrPointArr,adds));
   polyline(StrPointArr);
                         end;
   dtRectangle:begin//直角方形
for i:=0 to adds-2 do
   Rectangle(StrPointArr[i].x,StrPointArr[i].y,
             StrPointArr[i+1].x,StrPointArr[i+1].y);
               end;
     dtEllipse:begin//圆
for i:=0 to adds-2 do
   Ellipse(StrPointArr[i].x,StrPointArr[i].y,
           StrPointArr[i+1].x,StrPointArr[i+1].y);
               end;
   dtRoundRect:begin //弧边圆
for i:=0 to adds-2 do
   roundRect(StrPointArr[i].x,StrPointArr[i].y,
             StrPointArr[i+1].x,StrPointArr[i+1].y,
            (StrPointArr[i].x-StrPointArr[i+1].x) div 5,
            (StrPointArr[i].y-StrPointArr[i+1].y) div 5);
               end;
     dtlineDD1:begin//竖双线
for i:=0 to adds-2 do begin
          MoveTo(StrPointArr[i].X+3, StrPointArr[i].Y);
          LineTo(StrPointArr[i+1].X+3, StrPointArr[i+1].Y);
          MoveTo(StrPointArr[i].X-3, StrPointArr[i].Y);
          LineTo(StrPointArr[i+1].X-3, StrPointArr[i+1].Y);
                    end;
               end;
     dtlinedd2:begin//横双线
for i:=0 to adds-2 do begin
          MoveTo(StrPointArr[i].X, StrPointArr[i].Y+3);
          LineTo(StrPointArr[i+1].X, StrPointArr[i+1].Y+3);
          MoveTo(StrPointArr[i].X, StrPointArr[i].Y-3);
          LineTo(StrPointArr[i+1].X, StrPointArr[i+1].Y-3);
                      end;
               end;
         dtarc:begin//弧
for i:=0 to adds-2 do begin
             //MoveTo(StrPointArr[i].x, StrPointArr[i].Y);
             arc(StrPointArr[i+1].X, StrPointArr[i+1].Y,
                 StrPointArr[i].X, StrPointArr[i].Y,
                 StrPointArr[i+1].X, StrPointArr[i+1].Y,
                 StrPointArr[i].X, StrPointArr[i].Y
                );
                      end;
               end;
       dtround:begin//同心圆
for i:=0 to adds-2 do
   Ellipse(StrPointArr[i].x,StrPointArr[i].y,
           StrPointArr[i+1].x,StrPointArr[i+1].y);
               end;
    dtfillpoly:begin//填充颜色
for i:=0 to adds-2 do
   floodfill(StrPointArr[i].X, StrPointArr[i].Y,Image.Canvas.Pen.Color,fsborder);
               end;
   dtfillpoly2:begin//封闭多边形
  polygon(StrPointArr);
               end;
   dthz:begin
        end;

    end;//case
                        end;//with
end;


function GCreatbmp(IM:Timage;lei,Mwidth,Tmp_width,Tmp_height:integer):string;
{
1:400X400
2:im.width,im.height
3:A4 21*32--29.7*32cm
}
var
  Bitmap: TBitmap;
begin
M_li:=1;

if im <> nil then
case lei of
1:begin
im.Align:=alNone;
im.Width:=400;
im.Height:=400;
im.Left:=Mwidth;
im.Top:=Mwidth;
//    ActiveControl := Edit1.text;
      Bitmap := TBitmap.Create;
      Bitmap.Width := 400;
      Bitmap.Height := 400;
//      SaveStyles;
      Im.Picture.Graphic := Bitmap;
//      RestoreStyles;
//      CurrentFile := EmptyStr;
Bitmap.free;
   end;
2:begin
//    ActiveControl := Edit1;