janshapeeditor.pas

更好用的 shape 控件 delphi 3.0, 4.0, 5.0, 6.0, 7.0 適用

       Tshape(selpoints[i]).left:=5;
  drawpoints;
end;

procedure TShapeEditorForm.btnrightClick(Sender: TObject);
var i:integer;
begin
  if selpoints.count<>0 then
    for i:=0 to selpoints.count-1 do
      Tshape(selpoints[i]).left:=polyimage.Width+4;
  drawpoints;
end;

procedure TShapeEditorForm.SpeedButton7Click(Sender: TObject);
var i:integer;
begin
  if selpoints.count<>0 then
    for i:=0 to selpoints.count-1 do
     Tshape(selpoints[i]).top:=polyimage.height+4;
  drawpoints;
end;

procedure TShapeEditorForm.SpeedButton5Click(Sender: TObject);
begin
  if selObj<>nil then
  begin
    selObj.top:=polyimage.height div 2 +5;
    selObj.left:=polyimage.width div 2 +5;
    drawpoints;
  end;
end;

procedure TShapeEditorForm.SpeedButton4Click(Sender: TObject);
begin
  if selObj<>nil then
  begin
    selObj.left:=5;
    selObj.top:=5;
    drawpoints;
  end;

end;

procedure TShapeEditorForm.SpeedButton2Click(Sender: TObject);
begin
  if selObj<>nil then
  begin
    selObj.left:=polyimage.Width+4;
    selObj.top:=5;
    drawpoints;
  end;

end;

procedure TShapeEditorForm.SpeedButton9Click(Sender: TObject);
begin
  if selObj<>nil then
  begin
    selObj.left:=polyimage.Width+4;
    selObj.top:=polyimage.height+4;
    drawpoints;
  end;

end;

procedure TShapeEditorForm.SpeedButton8Click(Sender: TObject);
begin
  if selObj<>nil then
  begin
    selObj.left:=5;
    selObj.top:=polyimage.height+4;
    drawpoints;
  end;
end;

procedure TShapeEditorForm.btnalignverClick(Sender: TObject);
var i:integer;
begin
  if selpoints.count>1 then
    for i:=1 to selpoints.count-1 do
     Tshape(selpoints[i]).top:=Tshape(selpoints[0]).top;
  drawpoints;
end;

procedure TShapeEditorForm.btnalignhorClick(Sender: TObject);
var i:integer;
begin
  if selpoints.count>1 then
    for i:=1 to selpoints.count-1 do
     Tshape(selpoints[i]).left:=Tshape(selpoints[0]).left;
  drawpoints;
end;

procedure TShapeEditorForm.UserListDrawItem(Control: TWinControl; Index: Integer;
  Rect: TRect; State: TOwnerDrawState);
begin
  userlist.canvas.TextRect (rect,rect.left,rect.top,userlist.items.names[index]);
end;

procedure TShapeEditorForm.SpeedButton3Click(Sender: TObject);
var s,un:string;
    p:integer;
begin
  un:=username.text;
  if un ='' then exit;
  if userlist.Items.IndexOfName (un)<>-1 then
  begin
    showmessage(un+' allready exists');
    exit;
  end;
  s:=janshape1.UserVectorString;
  p:=pos('=',s);
  s:=copy(s,p+1,length(s));
  userlist.items.Append (un+'='+s);
end;

procedure TShapeEditorForm.strtoPoints(Avector:string);
var
  alist:tstringlist;
  p,lc,i,j,pts,w,h:integer;
  xf,yf:extended;
  poly:array of TPoint;
  xscale,yscale:extended;
  sh:Tshape;
begin
  p:=pos('=',AVector);
  if p=0 then exit;
  Avector:=copy(Avector,p+1,length(AVector));
  if Avector='' then exit;
  alist:=tstringlist.create;
  alist.CommaText :=Avector;
  lc:=alist.count;
  if (lc=0) or ((lc mod 2)<>0) then exit;
  pts:=lc  div 2;
  setlength(poly,pts);
  j:=0;
  w:=polyimage.width;
  h:=polyimage.height;
  xscale:=1/w;
  yscale:=1/h;
  try
    for i:=0 to pts-1 do
    begin
      xf:=strtofloat(alist[j]);
      poly[i].x:=round(xf/xscale);
      inc(j);
      yf:=strtofloat(alist[j]);
      poly[i].y:=round(yf/yscale);
      inc(j);
    end;
   except
     alist.free;
     exit;
   end;
  selpoints.clear;
  if pointlist.Count >0 then
    for i:=0 to pointlist.count-1 do
       TShape(pointlist[i]).free;
  pointlist.clear;
  for i:=0 to pts-1 do
  begin
    sh:=Tshape.Create (self);
    sh.parent:=box;
    sh.Width :=10;
    sh.height:=10;
    sh.left:=poly[i].x+5;
    sh.top:=poly[i].y+5;
    sh.OnMouseDown :=shape1mousedown;
    sh.OnMouseMove:=shape1mousemove;
    sh.OnMouseUp:=shape1mouseup;
    pointlist.Add (sh);
  end;
  drawpoints;
  alist.free;
end;

procedure TShapeEditorForm.UserListDblClick(Sender: TObject);
var index,p:integer;
    s:string;
begin
  index:=userlist.itemindex;
  if index=-1 then exit;
  s:=userlist.items[index];
  p:=pos('=',s);
  if p=0 then exit;
  username.Text :=copy(s,1,p-1);
  strtopoints(s);
end;

procedure TShapeEditorForm.SpeedButton6Click(Sender: TObject);
var s,un:string;
    p,index:integer;
begin
  un:=username.text;
  if un ='' then exit;
  index:= userlist.Items.IndexOfName (un);
  if index=-1 then
  begin
    showmessage(un+' does not exist');
    exit;
  end;
  s:=janshape1.UserVectorString;
  p:=pos('=',s);
  s:=copy(s,p+1,length(s));
  userlist.items[index]:= un+'='+s;
end;

procedure TShapeEditorForm.SpeedButton10Click(Sender: TObject);
var index:integer;
begin
  index:=userlist.ItemIndex ;
  if index=-1 then exit;
  userlist.items.Delete (index);
end;

procedure TShapeEditorForm.btnloadClick(Sender: TObject);
begin
  if opendialog1.execute then
    userlist.Items.LoadFromFile (opendialog1.filename);
end;

procedure TShapeEditorForm.btnsaveClick(Sender: TObject);
begin
   if savedialog1.execute then
      userlist.items.SaveToFile (savedialog1.filename);
end;

procedure TShapeEditorForm.btnnewClick(Sender: TObject);
var i:integer;
begin
  selpoints.clear;
  if pointlist.Count >0 then
    for i:=0 to pointlist.count-1 do
       TShape(pointlist[i]).free;
  pointlist.clear;
  drawpoints;
end;


procedure TShapeEditorForm.btnallClick(Sender: TObject);
var i:integer;
    obj:TShape;
begin
  if pointlist.count=0 then exit;
  selpoints.clear;
  for i:=0 to pointlist.Count -1 do
  begin
    obj:=Tshape(pointlist[i]);
    selpoints.Add (obj);
    obj.brush.color:=clred;
  end;
end;

procedure TShapeEditorForm.polyimageMouseDown(Sender: TObject;
  Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
  polyimage.tag:=1;
  deselectall;
  FrameX0:=x;
  FrameY0:=y;
  FrameXold:=x;
  FrameYold:=y;
  polyimage.canvas.DrawFocusRect(rect(FrameX0,FrameY0,FrameXold,FrameYold));

end;

procedure TShapeEditorForm.polyimageMouseMove(Sender: TObject;
  Shift: TShiftState; X, Y: Integer);
begin
  if polyimage.tag=1 then
  begin
  polyimage.canvas.DrawFocusRect (rect(FrameX0,FrameY0,FrameXold,FrameYold));
  FrameXold:=x;
  FrameYOld:=y;
  polyimage.canvas.DrawFocusRect (rect(FrameX0,FrameY0,FrameXold,FrameYold));  
  end;
end;

procedure TShapeEditorForm.SpeedButton11Click(Sender: TObject);
begin
  modalresult:=mrOK;
end;

procedure TShapeEditorForm.SpeedButton12Click(Sender: TObject);
begin
  modalresult:=mrCancel;
end;

procedure TShapeEditorForm.btnsymverClick(Sender: TObject);
var i,w2:integer;
    xoff,x0,xc:integer;
    obj:TShape;
begin
  if selpoints.count>1 then
  begin
    w2:=polyimage.width div 2;
    x0:=polyimage.left;
    xc:=x0+w2;
    xoff:=abs(Tshape(selpoints[0]).left+5-x0-w2);
    for i:=1 to selpoints.count-1 do
    begin
     obj:=Tshape(selpoints[i]);
     if (obj.Left +5)>xc then
       obj.left:=xc+xoff-5
     else
       obj.left:=xc-xoff-5;
    end;
  end;
  drawpoints;
end;

procedure TShapeEditorForm.SpeedButton13Click(Sender: TObject);
var i,h2:integer;
    yoff,y0,yc:integer;
    obj:TShape;
begin
  if selpoints.count>1 then
  begin
    h2:=polyimage.height div 2;
    y0:=polyimage.top;
    yc:=y0+h2;
    yoff:=abs(Tshape(selpoints[0]).top+5-y0-h2);
    for i:=1 to selpoints.count-1 do
    begin
     obj:=Tshape(selpoints[i]);
     if (obj.top +5)>yc then
       obj.top:=yc+yoff-5
     else
       obj.top:=yc-yoff-5;
    end;
  end;
  drawpoints;
end;

procedure TShapeEditorForm.btnctrverClick(Sender: TObject);
var i,w2:integer;
begin
  if selpoints.count>0 then
  begin
    w2:=polyimage.left + (polyimage.width div 2)-5;
    for i:=0 to selpoints.count-1 do
     Tshape(selpoints[i]).left:=w2;
  end;
  drawpoints;
end;

procedure TShapeEditorForm.btnctrhorClick(Sender: TObject);
var i,h2:integer;
begin
  if selpoints.count>0 then
  begin
    h2:=polyimage.top + (polyimage.height div 2)-5;
    for i:=0 to selpoints.count-1 do
     Tshape(selpoints[i]).top:=h2;
  end;
  drawpoints;
end;

procedure TShapeEditorForm.ckPolyLineClick(Sender: TObject);
begin
  janshape1.PolyLineMode :=ckpolyline.Checked;
end;

end.