unthqjdraw.pas

这是个可以划出不同几何图形的程序

end;

procedure THQJDraw.MakeSizeRect;
var
rc:TRect;
begin
//if ShapeList[CurrentIndex].ClassType=TBaseLine then exit;
  rc:=TBaseShape(ShapeList[CurrentIndex]).BoundRect;
  LTPnt:=rc.TopLeft;
  RTPnt:=Point(rc.Right,rc.top);
  RBPnt:=rc.BottomRight ;
  LBPnt:=Point(rc.Left,rc.Bottom);
end;



procedure THQJDraw.Drag_0(const x, y: integer);
begin
 LTPnt:=Point(x,y);
 LBPnt.X:=x;
 RTPnt.Y:=y;
end;

procedure THQJDraw.Drag_1(const x, y: integer);
begin
 LTPnt.y:=y;
 RTPnt.Y:=y;
end;

procedure THQJDraw.Drag_2(const x, y: integer);
begin
  LTPnt.y:=y;
  RBPnt.X:=x;
  RTPnt:=Point(x,y);
end;

procedure THQJDraw.Drag_3(const x, y: integer);
begin
  RTPnt.x:=x;
  RBPnt.X:=x;
end;

procedure THQJDraw.Drag_4(const x, y: integer);
begin
  RBPnt:=Point(x,y);
  RTPnt.x:=x;
  LBPnt.y:=y;
end;

procedure THQJDraw.Drag_5(const x, y: integer);
begin
  LBPnt.y:=y;
  RBPnt.y:=y;
end;

procedure THQJDraw.Drag_6(const x, y: integer);
begin
  LTPnt.x:=x;
  LBPnt:=Point(x,y);
  RBPnt.y:=y;
end;

procedure THQJDraw.Drag_7(const x, y: integer);
begin
 LTPnt.x:=x;
 LBPnt.x:=x;
end;
procedure THQJDraw.SelectedNone;
var
i:integer;
begin
 for i:=0 to ShapeList.Count-1 do
  TBaseShape(ShapeList[i]).Selected:=false;
  CurrentIndex:=-1;
end;

procedure THQJDraw.DrawBGDBmp;
var
i,j:integer;
begin
   FMemBMp.Width:=Width;
   FMemBmp.Height:=Height;
  if not FGlyph.Empty then
  begin
  if (Width>FGlyph.Width)and(Height>FGlyph.Height)then
    begin
    for i:=0 to(Width div FGlyph.Width +1) do
      for j:=0 to(Height div FGlyph.Height+1) do
          FMemBmp.Canvas.Draw(i*FGlyph.Width,j*FGlyph.Height,FGlyph);
    end;
  end;
end;

procedure THQJDraw.WMERASEBKGND(var msg: TMessage);
begin
  msg.Result:=0;
end;

procedure THQJDraw.WMSIZE(var msg: TMessage);
begin
  PaintAll;
end;

procedure THQJDraw.SetDrawItem(val: TShapeElement);
begin
 if not FLocked then
 begin
   FDrawItem:=val;
 end;
end;

procedure THQJDraw.SetState;
begin
 FState:=dsNone;
 if FDrawItem=seNone then FState:=dsSelect;
 case CursorKind of
 sTypeDrag                      : FState:=dsBeginDrag;
 sTypeFree,sType0,sType1,
 sType2,sType3,sType4,sType5,
 sType6,sType7                  :FState:=dsOnSize;
 end;
end;

procedure THQJDraw.DrawItem(Shift: TShiftState; X, Y: Integer);
begin
 FLocked:=false;
 if FState=dsNone then
  begin
  ChangeCursor(Point(X,y));
  exit;
  end;
 if (FState=dsOnSize) and (CurrentIndex>=0) then
  begin
  ReSizeShape(TBaseShape(ShapeList[CurrentIndex]),CursorKind,x,y);
  TBaseShape(ShapeList[CurrentIndex]).SetRect(LTPnt,RBPnt);
  if  ShapeList[CurrentIndex].ClassType=TBaseLine then
  TBaseLine(ShapeList[CurrentIndex]).MoveCurrentPnt(X,Y);
  paintAll;
  Canvas.Draw(0,0,FMemBmp);
  exit;
  end;
  if FState=dsSelect then
  begin
    DrawHotRect;
    EndPnt:=Point(x,y);
    DrawHotRect;
    exit;
  end;
  if FState=dsBeginDrag then
  begin
  DrawBoundRect(EndPnt.x,EndPnt.y);
  EndPnt:=Point(x,y);
  DrawBoundRect(x,y);
  exit;
  end;

end;

procedure THQJDraw.FinishDraw(Button: TMouseButton; Shift: TShiftState; X,
  Y: Integer);
begin
 FLocked:=false;
    if FState=dsSelect then
  begin
    EndPnt:=Point(x,y);
    DrawHotRect;
    FState:=dsNone;
    exit;
  end;
  if FState=dsBeginDrag then
  begin
    FState:=dsNone;
    EndPnt:=Point(x,y);
    TBaseShape(ShapeList[CurrentIndex]).Move(EndPnt.X-StartPnt.x,EndPnt.Y-StartPnt.y);
    PaintAll;
    Canvas.Draw(0,0,FMemBmp);
    FState:=dsNone;
    exit;
  end;
  if FState=dsOnSize then
  begin
    FState:=dsNone;
    if CurrentIndex<=-1 then exit;
    if ShapeList[CurrentIndex].ClassType=TRectangle then
          TRectangle(ShapeList[CurrentIndex]).SetRect(LTPnt,RBPnt);
    if ShapeList[CurrentIndex].ClassType=TBaseLine then
          TBaseLine(ShapeList[CurrentIndex]).MoveCurrentPnt(X,Y);
    PaintAll;
    Canvas.Draw(0,0,FMemBmp);
    exit;
  end;
 // Canvas.Draw(0,0,FMemBmp);
end;

procedure THQJDraw.PrepairDraw(Button: TMouseButton; Shift: TShiftState; X,
  Y: Integer);
begin
  if Button<>mbLeft then exit;
  SelectedNone;
  HitTestAll(Point(X,Y));
  PaintAll;
  Canvas.Draw(0,0,FMemBmp);
  SetState;

  StartPnt:=Point(x,y);
  EndPnt:=StartPnt;
  ZeroPnt:=StartPnt;
  case FState of
   dsNone          :exit;
   dsOnSize        :begin
                     MakeSizeRect;
                    end;
   dsSelect        :exit;
   dsBeginDrag     :begin
                     DrawBoundRect( x,y);
                     exit;
                    end;
  end;

end;

function THQJDraw.AddOne(shape: TShapeElement;
  SPrpty: TShapeProperty): Boolean;
var
index:integer;
begin
 result:=false;
 if shape=seNone then exit;
  index:=CurrentIndex;
  if (index>=0) and (index<=ShapeList.Count-1)then
  begin
  TBaseShape(ShapeList[CurrentIndex]).Selected:=false;
  PaintAll;
  Canvas.Draw(0,0,FMemBmp);
  end;
  SelectedNone;
  case shape of
   seSLine:       AddSLine(SPrpty);
   seCylinder:    AddCylinder(SPrpty);
   seArrow:       AddArrow(SPrpty);
   seRectangle:   AddRectangle(SPrpty);
   seDiamond:     AddDiamond(SPrpty);
   seEchelon:     AddEchelon(SPrpty);
   seEllipse:     AddEllipse(SPrpty);
   seTriangle:    AddTriangle(SPrpty);
  end;
  result:=true;
  RePaintOne(CurrentIndex);
end;

procedure THQJDraw.AddArrow(prpty: TShapeProperty);
var
item:TArrow;
begin
   item:=TArrow.Create(prpty);
   ShapeList.Add(item);
   CurrentIndex:=ShapeList.Count-1;
end;

procedure THQJDraw.AddCylinder(prpty: TShapeProperty);
var
item:TCylinder;
begin
   item:=TCylinder.Create(prpty);
   ShapeList.Add(item);
   CurrentIndex:=ShapeList.Count-1;
end;

procedure THQJDraw.AddEchelon(prpty: TShapeProperty);
var
item:TEchelon;
begin
   item:=TEchelon.Create(prpty);
   ShapeList.Add(item);
   CurrentIndex:=ShapeList.Count-1;
end;
procedure THQJDraw.AddEllipse(prpty: TShapeProperty);
var
item:TEllipse;
begin
   item:=TEllipse.Create(prpty);
   ShapeList.Add(item);
   CurrentIndex:=ShapeList.Count-1;
end;



procedure THQJDraw.AddRectangle(prpty: TShapeProperty);
var
item:TRectangle;
begin
   item:=TRectangle.Create(prpty);
   ShapeList.Add(item);
   CurrentIndex:=ShapeList.Count-1;
end;

procedure THQJDraw.AddDiamond(prpty: TShapeProperty);
var
item:TDiamond;
begin
   item:=TDiamond.Create(prpty);
   ShapeList.Add(item);
   CurrentIndex:=ShapeList.Count-1;
end;

procedure THQJDraw.AddSLine(prpty: TShapeProperty);
var
item:TBaseLine;
begin
   item:=TBaseLine.Create(prpty);
   ShapeList.Add(item);
   CurrentIndex:=ShapeList.Count-1;
end;

procedure THQJDraw.AddTriangle(prpty: TShapeProperty);
var
item:TTriangle;
begin
   item:=TTriangle.Create(prpty);
   ShapeList.Add(item);
   CurrentIndex:=ShapeList.Count-1;
end;


procedure THQJDraw.DrawHotLine;
var
pm:TPenMode;
pc:TColor;
ps:TPenStyle;
begin
 if (StartPnt.x=EndPnt.X)and(StartPnt.y=EndPnt.y) then exit;
    with Canvas do
    begin
      pm:=Pen.Mode;
      pc:=Pen.Color;
      ps:=Pen.Style;
        Pen.Mode:=pmNotXor;
        Pen.Style:=psDashDotDot;
        Pen.Color:=clRed;
        MoveTo(StartPnt.x,StartPnt.y);
        LIneTo(EndPnt.X,EndPnt.y);
      Pen.Mode:=pm;
      Pen.Color:=pc;
      Pen.Style:=ps;
    end;
end;

end.