|
|
在X3平台下,怎么实现record的定义?如果不能实现,怎么用其它的方法能够绕过去？
附代码如下:
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, TeeProcs, TeEngine, Chart, ExtCtrls, StdCtrls, Series, DB, ADODB,
DbChart, Buttons, ImgList;
type
TForm1 = class(TForm)
Panel1: TPanel;
btn1: TButton;
ADOConnection1: TADOConnection;
ADOQuery1: TADOQuery;
ADOQuery2: TADOQuery;
Chart3: TChart;
LineSeries1: TLineSeries;
Button1: TButton;
btn2: TButton;
Edit1: TEdit;
Label1: TLabel;
ColorBox1: TColorBox;
Image1: TImage;
BitBtn1: TBitBtn;
ImageList1: TImageList;
BitBtn2: TBitBtn;
procedure btn2Click(Sender: TObject);
procedure Chart3MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure Chart3MouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
procedure Chart3MouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure BitBtn1Click(Sender: TObject);
procedure FormCreate(Sender: TObject);
private
{ Private declarations }
procedure preMove(myPoint:TPoint);
procedure preDel(myPoint:TPoint);
function prepare(myPoint,firstPoint,secondPoint:TPoint):boolean;
procedure realMoveLine(myPoint:TPoint);
procedure drawLine(topLeft: TPoint; bottomRight: TPoint);//me
// procedure preFill(myPoint:TPoint);
public
{ Public declarations }
end;
type myDraw=(null,myLine,myRect,myEllips,myCircle);
type pLine=^recordLine;
recordLine=record
originP,finalP:TPoint;
lineColor:TColor;
next:pLine;
end;
var
Form1: TForm1;
drawing,filling,moving,deling: Boolean;
movingLine,movingRect,movingEllips,movingCircle:Boolean;
myDrawStart:myDraw;
origin,movePt:TPoint;
itsLine,firstLine,lastLine,dLine:pLine;
implementation
{$R *.dfm}
procedure TForm1.btn2Click(Sender: TObject);
begin
Image1.Canvas.LineTo(100,1000);
myDrawStart:=myLine;
filling:=false;
moving:=false;
deling:=false;
edit1.Text :='绘制直线：拾取起始点（按下鼠标左键）';
end;
procedure TForm1.drawLine(topLeft: TPoint; bottomRight: TPoint);
begin
with Chart3.canvas do
begin
MoveTo(topLeft.x,topLeft.y);
Draw(topLeft.X,topLeft.Y,BitBtn2.Glyph);
lineto(bottomRight.x,bottomRight.y);
end;
end;
procedure TForm1.preMove(myPoint:TPoint);
begin
itsLine:=firstLine^.next ;
while itsLine<>nil do
begin
if prepare(myPoint,itsLine^.originP,itsLine^.finalP) then
begin
edit1.Text :='拾取移动终止点：按住左键并且移动鼠标至终止点再松开';
realMoveLine(myPoint);
movingLine:=True;
exit;//<<<<<<<<<<<<<<< Bug !!! <<<<<<<<<<
end;
itsLine:=itsLine^.next ;
end;
if itsLine=nil then
itsLine:=lastLine; //<<<<<< Bug! <<
end;
procedure TForm1.preDel(myPoint:TPoint);
begin
dLine:=firstLine;
itsLine:=firstLine^.next ;
while itsLine<>nil do
begin
if prepare(myPoint,itsLine^.originP,itsLine^.finalP) then
begin
edit1.Text :='继续刚才的操作类型，或者重新选择操作类型';
Chart3.Canvas.Pen.Color := clRed;
drawLine(itsLine^.originP,itsLine^.finalP);
dLine^.next :=itsLine^.next ;
if itsLine=lastLine then
lastLine:=dLine;
dispose(itsLine);
itsLine:=lastLine;
exit;//
end;
dLine:=dLine^.next ;
itsLine:=itsLine^.next ;
end;
if itsLine=nil then
itsLine:=lastLine; //
end;
procedure TForm1.Chart3MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
if button=mbLeft then
begin
drawing:=true;
Chart3.Canvas.Pen.Color :=colorbox1.Selected;
origin:=Point(x,y);
movePt:=origin;
if moving=true then
begin
drawing:=false;
premove(origin);
end;
if deling=true then
begin
drawing:=false;
preDel(origin);
end;
if drawing=true then
begin
edit1.Text :='拾取终点：按住左键并且移动鼠标至终点再松开';
end;
end;
end;
function TForm1.prepare(myPoint,firstPoint,secondPoint:TPoint):boolean;
var
lengthA,lengthB,lengthC:real;
lengthX,lengthY:real; //integer;
begin
lengthX:=abs(myPoint.X-firstPoint.X );
lengthY:=abs(myPoint.Y-firstPoint.Y );
lengthX:=sqr(lengthX);
lengthY:=sqr(lengthY);
lengthA:=sqrt(lengthX+lengthY);
lengthX:=abs(myPoint.X-secondPoint.X );
lengthY:=abs(myPoint.Y-secondPoint.Y );
lengthX:=sqr(lengthX);
lengthY:=sqr(lengthY);
lengthB:=sqrt(lengthX+lengthY);
lengthX:=abs(secondPoint.X-firstPoint.X );
lengthY:=abs(secondPoint.Y-firstPoint.Y );
lengthX:=sqr(lengthX);
lengthY:=sqr(lengthY);
lengthC:=sqrt(lengthX+lengthY);
if lengthA+lengthB<lengthC+1 then
result:=true
else
result:=false;
end;
procedure TForm1.realMoveLine(myPoint:TPoint);
var
deltaX,deltaY:integer;
firstPoint,secondPoint:TPoint;
begin
Chart3.Canvas.Pen.Color :=itsLine^.lineColor ;
drawLine(itsLine^.originP,itsLine^.finalP);
deltaX:=-origin.X+myPoint.X;
deltaY:=-origin.Y+myPoint.Y;
firstPoint:=Point(itsLine^.originP.X+deltaX,itsLine^.originP.Y+deltaY);
secondPoint:=Point(itsLine^.finalP.X+deltaX,itsLine^.finalP.Y+deltaY);
drawLine(firstPoint,secondPoint);
origin:=myPoint;
itsLine^.originP:=firstPoint;
itsLine^.finalP:=secondPoint;
end;
procedure TForm1.Chart3MouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
begin
label1.Caption:='坐标 ( '+intToStr(x)+' , '+intToStr(Chart3.Height-y)+' )';
if drawing then
begin
Chart3.Canvas.Pen.Mode :=pmNotXor; //--------?????
Chart3.Canvas.Brush.Style :=bsClear;//<<< !!!
case myDrawStart of
myLine:
begin
drawLine(origin,movePt);
movePt:=Point(x,y);
drawLine(origin,movePt);
end;
end;
end;
if movingLine then
begin
movePt:=Point(x,y);
realMoveLine(movePt);
end;
end;
procedure TForm1.Chart3MouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
if button=mbLeft then
begin
if drawing then
begin
drawing:=false;
edit1.Text :='继续刚才的操作类型，或者重新选择操作类型';
case myDrawStart of
myLine:
begin
new(itsLine^.next);
itsLine:=itsLine^.next;
itsLine^.originP:=origin;
itsLine^.finalP:=movePt;
itsLine^.lineColor:=Chart3.Canvas.Pen.Color;
lastLine:=itsLine;
end;
end;
if movingLine then
begin
movingLine:=false; //<<<<<<<< Right
itsLine:=lastLine;
edit1.Text :='继续刚才的操作类型，或者重新选择操作类型';
end;
end;
end;
if movingLine then
begin
movingLine:=false; //<<<<<<<< Right
itsLine:=lastLine;
edit1.Text :='继续刚才的操作类型，或者重新选择操作类型';
end;
end;
procedure TForm1.BitBtn1Click(Sender: TObject);
begin
deling:=true;
filling:=false;
moving:=false;
edit1.Text :='删除图形（请选择图形的轮廓线）';
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
drawing:=false;
filling:=false;
moving:=false;
deling:=false;
movingLine:=false;
movingRect:=false;
movingEllips:=false;
movingCircle:=false;
edit1.Text :='请选择操作类型：选择下拉菜单或者操作按钮';
new(itsLine);
itsLine^.next:=nil;
firstLine:=itsLine ; //<<<<<<<<<<<<<
lastLine:=itsLine;
end;
end. |
|
发表于 2007-5-24 11:08:58
楼主