frm_main.pas

delphi语言开发的矢量图形处理对象

procedure TfrmMain.drwPopmenuPopup(Sender: TObject);
begin
  if (tsSelection.Count >1) then
  begin
    mnuLineSet.Enabled :=false;
    mnuFill_Color.Enabled :=false;
//    totalAttr.Enabled :=false;
    exit;
  end;
  mnuLineSet.Enabled :=true;
  mnuFill_Color.Enabled :=true;
//  totalAttr.Enabled :=true;
  case TDrawObject(curDrawRef).Style of
    drwText:begin
      mnuLineSet.Enabled :=false;
      mnuFill_Color.Enabled :=false;
    end;
    drwImage:begin
      mnuLineSet.Enabled :=false;
      mnuFill_Color.Enabled :=false;
//      totalAttr.Enabled :=false;
    end;
    drwLine,drwPline:begin
      mnuFill_Color.Enabled :=false;
//      totalAttr.Enabled :=false;
    end;
  else
//    totalAttr.Enabled :=false;
  end;
end;

procedure TfrmMain.mnuLineSetClick(Sender: TObject);
var
  f:TDrawObject;
begin
  frmSetLine:=TFrmSetLine.create(Application);
  try
    f:=TDrawObject(curDrawRef);
    frmSetLine.cmoLineColor.Selected :=f.PenColor;
    case f.PenWidth of
      1:frmSetLine.cmoLineWidth.ItemIndex :=0;
      2:frmSetLine.cmoLineWidth.ItemIndex :=1;
      4:frmSetLine.cmoLineWidth.ItemIndex :=2;
      6:frmSetLine.cmoLineWidth.ItemIndex :=3;
      8:frmSetLine.cmoLineWidth.ItemIndex :=4;
    else
      frmSetLine.cmoLineWidth.ItemIndex :=5;
    end;
    frmSetLine.lblWidth.Caption :=intTostr(f.PenWidth)+'P';
    frmSetLine.cmoLineType.ItemIndex :=integer(f.PenStyle);
    if f.Style =drwLine then
    begin
       frmSetLine.cmoLineArrow.ItemIndex :=integer(TDrawLine(f).ArrowStyle );
       frmSetLine.cmoLineArrow.Enabled :=true;
    end
    else
    begin
       frmSetLine.cmoLineArrow.Enabled :=false;
    end;
    if frmSetLine.ShowModal=mrOk then
    begin
      f.PenColor :=frmSetLine.cmoLineColor.Selected;
      f.PenWidth :=strToint(copy(frmSetLine.lblWidth.Caption,
                   1,length(frmSetLine.lblWidth.Caption)-1));
      curPenWidth:=strToint(copy(frmSetLine.lblWidth.Caption,
                   1,length(frmSetLine.lblWidth.Caption)-1));
      f.PenStyle :=TPenStyle(frmSetLine.cmoLineType.ItemIndex);
      if f.Style =drwLine then
      TDrawLine(f).ArrowStyle :=TArrowStyle(frmSetLine.cmoLineArrow.ItemIndex);
      draw_Rambitmap;
    end;
  finally
    frmSetLine.Free;
  end;
end;

procedure TfrmMain.mnuFill_ColorClick(Sender: TObject);
var
  f:TDrawObject;
begin
  f:=TDrawObject(curDrawRef);
  frm_FillSet:=TFrm_FillSet.Create(Application);
  case f.Style of
    drwRect:
    begin
     frm_fillSet.cmoFillColor.Selected :=TDrawRect(curDrawRef).BrushColor;
     frm_fillset.cmoFillMode.ItemIndex :=getIndex(TDrawRect(curDrawRef).BrushStyle);
    end;
    drwEllispe:
    begin
     frm_fillSet.cmoFillColor.Selected :=TDrawEllipse(curDrawRef).BrushColor;
     frm_fillset.cmoFillMode.ItemIndex :=getIndex(TDrawEllipse(curDrawRef).BrushStyle);
    end;
    drwCircle:
    begin
     frm_fillSet.cmoFillColor.Selected :=TDrawCircle(curDrawRef).BrushColor;
     frm_fillset.cmoFillMode.ItemIndex :=getIndex(TDrawCircle(curDrawRef).BrushStyle);
    end;
    drwPolygon:
    begin
     frm_fillSet.cmoFillColor.Selected :=TDrawPolygon(curDrawRef).BrushColor;
     frm_fillset.cmoFillMode.ItemIndex :=getIndex(TDrawPolygon(curDrawRef).BrushStyle);
    end;
    drwFreeLine:
    begin
     frm_fillSet.cmoFillColor.Selected :=TDrawFreeLine(curDrawRef).BrushColor;
     frm_fillset.cmoFillMode.ItemIndex :=getIndex(TDrawFreeLine(curDrawRef).BrushStyle);
    end;
  end;
  frm_FillSet.cboMode.ItemIndex :=ord(f.GradientStyle);
  frm_fillSet.cboStart.Selected :=f.BeginColor;
  frm_fillSet.cboEnd.Selected :=f.EndColor;
  if f.Style in [drwCircle,drwEllispe,drwRect,drwPolygon,drwFreeLine] then
  begin
     frm_fillSet.RadioButton1.Checked:=f.Gradient;
     frm_fillSet.RadioButton2.Checked :=not f.Gradient;
     frm_fillSet.GroupBox3.Enabled :=true;
  end
  else begin
     frm_fillSet.RadioButton1.Checked :=false;
     frm_fillSet.RadioButton2.Enabled :=true;
     frm_fillSet.GroupBox3.Enabled :=false;
  end;
  try
    if frm_fillSet.ShowModal=mrOk then
    begin
      case f.Style of
        drwRect:
        begin
          TdrawRect(curDrawRef).BrushColor :=frm_FillSet.cmoFillColor.Selected;
          TdrawRect(curDrawRef).BrushStyle :=TBrushStyle(frm_fillSet.cmoFillMode.ItemIndex);
        end;
        drwCircle:
        begin
          TdrawCircle(curDrawRef).BrushColor :=frm_FillSet.cmoFillColor.Selected;
          TdrawCircle(curDrawRef).BrushStyle :=TBrushStyle(frm_fillSet.cmoFillMode.ItemIndex);
        end;
        drwEllispe:
        begin
          TdrawEllipse(curDrawRef).BrushColor :=frm_FillSet.cmoFillColor.Selected;
          TdrawEllipse(curDrawRef).BrushStyle :=TBrushStyle(frm_fillSet.cmoFillMode.ItemIndex);
        end;
        drwPolygon:
        begin
          TdrawPolygon(curDrawRef).BrushColor :=frm_FillSet.cmoFillColor.Selected;
          TdrawPolygon(curDrawRef).BrushStyle :=TBrushStyle(frm_fillSet.cmoFillMode.ItemIndex);
        end;
        drwFreeLine:
        begin
          TdrawFreeLine(curDrawRef).BrushColor :=frm_FillSet.cmoFillColor.Selected;
          TdrawFreeLine(curDrawRef).BrushStyle :=TBrushStyle(frm_fillSet.cmoFillMode.ItemIndex);
        end;
      end;
      if f.Style in [drwFreeLine,drwCircle,drwRect,drwEllispe,drwPolygon] then
      begin
         f.Gradient :=frm_fillset.RadioButton1.Checked;
         f.BeginColor :=frm_fillset.cboStart.Selected;
         f.EndColor :=frm_fillset.cboEnd.Selected;
         f.GradientStyle :=TGradientStyle(frm_fillset.cboMode.ItemIndex);
      end;
      draw_RamBitmap;
    end;
  finally
    frm_fillSet.Free;
  end;
end;

procedure TfrmMain.drwPaintPaint(Sender: TObject);
begin
  drwPaint.Canvas.Brush.Color:=curBackColor;
  drwPaint.Canvas.Brush.Style :=bsSolid;
  drwPaint.Canvas.FillRect(drwPaint.ClientRect);
  drwPaint.Canvas.Brush.Color :=clBlack;
  drwPaint.Canvas.Brush.Style :=bsClear;
  draw_Rambitmap;
end;

procedure TfrmMain.centerDrwPaint;
begin
 drwPaint.Left := (ScrollBox1.Width  - drwPaint.Width) div 2;
 drwPaint.Top  := (ScrollBox1.Height - drwPaint.Height) div 2
end;

procedure TfrmMain.FormActivate(Sender: TObject);
begin
  centerDrwPaint;
end;

procedure TfrmMain.FileOpenExecute(Sender: TObject);
begin
  dlgOpen.Filter :='图库(*.Lib)|*.lib';
  dlgOpen.Title :='选择一个图库文件';
  if dlgOpen.Execute then
  begin
    delAllObjLst;
    draw_RamBitmap;
    curObjName:='';
    loadLib(dlgOpen.FileName,imageLstObj,ListViewObj);
  end;
end;

procedure TfrmMain.ListViewObjClick(Sender: TObject);
var
  f:TDrawGroup;
  objName:string;
  minPoint,maxPoint:TPoint;
  i:integer;
begin
  if (listViewObj.Items.Count =0) or (listViewObj.Selected =nil) then exit;
  objName:=listViewObj.Selected.Caption;
  if objName=curObjName then
     exit
  else
     curObjName:=objName;
  delAllObjLst;{清除当前组件指针链表}
  mLibManager.getShapeByName(curObjName,f);
  minPoint:=f.getMinPoint;
  maxPoint:=f.getMaxPoint;
  maxPoint.X :=(drwCanvasWidth -(maxPoint.X-minPoint.X)) div 2;
  maxPoint.Y :=(drwCanvasHeight -(maxPoint.Y -minPoint.Y)) div 2;
  f.addXY(maxPoint.X -minPoint.X,maxPoint.Y-minPoint.Y ,-1);
  f.setAllDeadXY;
  for i:=0 to f.CountObjGroups -1 do
  begin
        // new Add 2004.3.12
    TDrawObject(f.ObjGroups[i]).IsVisible := TDrawObject(f.ObjGroups[i]).Visible;
    
    if TDrawObject(f.ObjGroups[i]).Style =drwGroup then
    begin
      TDrawGroup(f.objGroups[i]).setAllVersus;
      // new Add 2004.3.12
      if not TDrawObject(f.ObjGroups[i]).IsVisible then
      TDrawGroup(f.objGroups[i]).setObjVisible(true);
    end;
    tsDrwObjects.Add(f.ObjGroups[i]);
    TDrawObject(f.ObjGroups[i]).ZoomScale :=curZoomScale;
    TDrawObject(f.ObjGroups[i]).Visible :=true;
  end;
  f.Free;
  draw_RamBitmap;
end;

procedure TfrmMain.FileSaveExecute(Sender: TObject);
var
  f,newGroup:TDrawGroup;
  index:Integer;
  ABitmap:TBitmap;
  AListItem: TListItem;
  stream:TMemoryStream;
  drwMode:TDrwStyle;
  fileName:string;
begin
  if tsDrwObjects.Count =0 then exit;
  f:=createGroup;
  if curObjName='' then
  begin
     curObjName:=InputBOx('输入框','输入组件的名称：','');
     if curObjName='' then
     begin
       f.Free;
       exit;
     end;
  end;
  f.Name :=curObjName;
  try
    stream:=TMemoryStream.Create;
    f.Save(stream);
    stream.Position :=0;
    newGroup:=TDrawGroup.create;
    stream.Read(drwMode,SizeOf(TDrwStyle));
    newGroup.Load(stream);
    newGroup.Style :=drwMode;
  finally
    stream.Free;
  end;
  
  f.setAllDeadXY;//还原各图元的绝对坐标
  for index:=0 to tsDrwObjects.Count -1 do
  begin
    if TDrawObject(tsDrwObjects.Items[index]).Style =drwGroup then
    begin
      TDrawGroup(tsDrwObjects.Items[index]).setAllVersus;
      TDrawGroup(tsDrwObjects.Items[index]).setObjVisible(true);
    end;
    TDrawObject(tsDrwObjects.Items[index]).Visible :=true;
  end;

  f.Free;
  ABitmap:=TBitmap.Create;
  try
    ABitmap.Width :=32;ABitmap.Height :=32;
    index:=mLibManager.saveShapeByName(curObjName,newGroup);
    {重新设置组件的图标显示}
    mLibManager.getIconByName(curObjName,ABitmap);
    if index<imageLstObj.Count -1 then
    begin
      imageLstObj.Delete(index);
      imageLstObj.InsertMasked(index,ABitmap,clGray);
    end
    else
    imageLstObj.AddMasked(ABitmap,clGray);
  finally
    ABitmap.Free;
  end;
  {如果是新增的组件，则添加视图列表}
  if index>listViewObj.Items.Count -1 then
  begin
    AListItem:=ListViewObj.Items.Add;
    AListItem.Caption:=curObjName;
    AListItem.ImageIndex:=imageLstObj.Count -1;
  end;

  {开始保存图库文件}
  dlgSave.Filter :='图库(*.Lib)|*.lib';
  dlgSave.Title :='输入保存图库的文件名称';
  if mLibManager.LibFileName='' then
  begin
     if dlgSave.Execute then
     begin
       fileName:=dlgSave.FileName;
       if pos('.lib',lowerCase(fileName))=0 then
       fileName:=fileName+'.lib';
       mLibManager.LibFileName :=fileName;
       mLibManager.save;
     end;
  end
  else
  mLibManager.save;
end;

procedure TfrmMain.FileNewExecute(Sender: TObject);
begin
  if mLibManager<>nil then
  begin
    mLibManager.clear;
    curObjName:='';
    listViewObj.Items.Clear;
    imageLstObj.Clear;
    mLibManager.LibFileName :='';
    delAllObjLst;
    draw_RamBitmap;
  end
  else
  begin
    mLibManager:=TLibManage.Create;
    mLibManager.LibFileName :='';
    delAllObjLst;
    draw_RamBitmap;
  end;
end;

procedure TfrmMain.delAllObjLst;
var
  i:integer;
begin
  for i:=0 to tsDrwObjects.Count -1 do
  begin
   if TDrawObject(tsDrwObjects.Items[i]).Style =drwGroup then
   TDrawGroup(tsDrwObjects.Items[i]).deleteObjects;
   TDrawObject(tsDrwObjects.Items[i]).Free;
  end;
  tsDrwObjects.Clear;
  tsSelection.Clear;
  curDrawRef:=nil;
end;

procedure TfrmMain.fileNewObjExecute(Sender: TObject);
begin
  {清除图元列表}
  delAllObjLst;
  draw_RamBitmap;
  curObjName:='';
end;

procedure TfrmMain.FileCloseExecute(Sender: TObject);
begin
  mLibManager.Free;
  mLibManager:=nil;
  curObjName:='';
  listViewObj.Items.Clear;
  imageLstObj.Clear;
  delAllObjLst;
end;

procedure TfrmMain.ListViewObjEdited(Sender: TObject; Item: TListItem;
  var S: String);
var
  iIndex:integer;
begin
  if ListViewObj.Items.Count =0 then exit;
  if s=Item.Caption then
  exit;
  iIndex:=Item.Index;
  mLibManager.setObjName(iIndex,s);
  curObjName:=s;
  if mLibManager.LibFileName <>'' then
  mLibManager.save;
end;

procedure TfrmMain.objPopupPopup(Sender: TObject);
begin
  if listViewObj.Selected =nil then
  begin
     mnuDelObj.Enabled :=false;
     mnuRename.Enabled :=false;
  end
  else
  begin
     mnuDelObj.Enabled :=true;
     mnuRename.Enabled :=true;
  end;
end;

procedure TfrmMain.mnuDelObjClick(Sender: TObject);
var
  index:integer;
  fileName:string;
begin
  mLibManager.delete(listViewObj.Selected.Caption);
  index:=listViewObj.ItemIndex;
  listViewObj.Items.Delete(index);
  if listViewObj.Items.Count >0 then
     mLibManager.save
  else
  begin
     fileName:=mLibManager.LibFileName;
     if fileExists(fileName) then
     DeleteFile(fileName);
  end;
  listViewObj.Arrange(arDefault);
  delAllObjLst;
  curObjName:='';
  draw_RamBitmap;
  curDrawRef:=nil;
end;

procedure TfrmMain.mnuRenameClick(Sender: TObject);
begin
  listViewObj.Selected.EditCaption;
end;

procedure TfrmMain.ClipToGroup;
var
  i:integer;
  f:TDrawGroup;
begin
  f:=TDrawGroup.create;
  for i:=tsDrwobjects.Count -1 Downto 0 do
  begin
    if TDrawObject(tsDrwobjects.Items[i]).mSelected then
    begin
      //drwlineGraph\drwRectGraph不能组合
      f.addObject(tsDrwObjects.Items[i]);
      TDrawObject(tsDrwObjects.Items[i]).Selected(drwPaint.Canvas,false);
      tsDrwObjects.Delete(i);
    end;
  end;
  f.getRect;//设置组的矩形坐标范围
  f.ZoomScale :=curZoomScale;
  f.Selected(drwPaint.Canvas,true);
  f.Style :=drwGroup;
  tsDrwObjects.Add(f);
  curDrawRef:=f;
  tsSelection.Clear;
  tsSelection.Add(f);end;
procedure TfrmMain.CheckBox1Click(Sender: TObject);
begin
  if curDrawRef<>nil then
  TDrawObject(curDrawRef).isVisible :=checkBox1.Checked;
end;

end.