frm_drwchild.pas

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

procedure TfrmDrw.PasteFromClipboard;
var
  hbuf : THandle;
  bufptr : Pointer;
  mstream : TMemoryStream;
  i:integer;
begin
  for i:=0 to tsSelection.Count -1 do
  TDrawObject(tsSelection.Items[i]).Selected(drwPaint.Canvas,false);
  tsSelection.Clear;
  curDrawRef:=nil;
  hbuf := Clipboard.GetAsHandle(CF_MYFORMAT);
  if hbuf <> 0 then
  begin
    bufptr := GlobalLock(hbuf);
    if bufptr <> nil then
    begin
     try
        mstream := TMemoryStream.Create;
        try
          mstream.WriteBuffer(bufptr^, GlobalSize(hbuf));
          mstream.Position := 0;
          {-- 处理流的代码 --}
          i:=mstream.Size;
          while i-mstream.Position >0 do
          ReadObjectStream(mStream);
          for i:=0 to tsSelection.Count -1 do
          begin
            TDrawObject(tsSelection.Items[i]).ZoomScale :=curZoomScale;
            TDrawObject(tsSelection.Items[i]).addXY(2,2,-1);
            TDrawObject(tsSelection.Items[i]).Draw(drwPaint.Canvas);
            TDrawObject(tsSelection.Items[i]).Selected(drwPaint.Canvas,true);
          end;
          if tsSelection.Count >0 then curDrawRef:=tsSelection.Items[0];
        finally
        mstream.Free;
        end;
      finally
        GlobalUnlock(hbuf);
      end;
    end;
  end;
end;

procedure TfrmDrw.CopyToClipboard;
var
  hbuf : THandle;
  bufptr : Pointer;
  mstream : TMemoryStream;
begin
  mstream := TMemoryStream.Create;
  try
    {-- 处理流的代码 --}
    writeObjectStream(mStream);//将选中的图形数据写到内存流中
    hbuf := GlobalAlloc(GMEM_MOVEABLE, mstream.size);
    try
      bufptr := GlobalLock(hbuf);
      try
        Move(mstream.Memory^, bufptr^, mstream.size);
        Clipboard.SetAsHandle(CF_MYFORMAT, hbuf);
      finally
      GlobalUnlock(hbuf);
      end;
    except
      GlobalFree(hbuf);
    raise;
    end;
  finally
    mstream.Free;
  end;
end;

procedure TfrmDrw.writeObjectStream(f: TStream);
var
  i:integer;
begin
  if curDrawRef=nil then exit;
  if tsSelection.Count =0 then exit;
  for i:=0 to tsSelection.Count -1 do
  TDrawObject(tsSelection.Items[i]).Save(f);  
end;

procedure TfrmDrw.CutToClipboard;
begin
  CopyToClipboard;
  Del_SelectObjects;
end;

procedure TfrmDrw.setBkColor(value: TColor);
begin
  if value=curBackColor then exit;
  curBackColor:=value;
  draw_Rambitmap;
end;

function TfrmDrw.getBkColor: TColor;
begin
  result:=curBackColor;
end;

procedure TfrmDrw.CancelSelect(var msg: TMessage);
var
  i:integer;
begin
  if tsSelection.Count =0 then exit;
  for i:=0 to tsSelection.Count -1 do
  TDrawObject(tsSelection.Items[i]).Selected(drwPaint.Canvas,false);
  tsSelection.Clear;
  curDrawRef:=nil;
end;

procedure TfrmDrw.setAlign(flag: TAlign);
var
  i,incX,incY:integer;
  lPoint,tmpPoint:TPoint;
begin
  case flag of
    taLeft:begin
       lPoint:=TDrawObject(tsSelection.Items[0]).getMinPoint;
       incY:=0;
       for i:=1 to tsSelection.Count -1 do
       begin
         tmpPoint:=TDrawObject(tsSelection.Items[i]).GetMinPoint;
         incX:=lPoint.X -tmpPoint.X;
         TDrawObject(tsSelection.Items[i]).addXY(incx,incy,-1);
       end;
    end;
    taRight:begin
       incY:=0;
       lPoint:=TDrawObject(tsSelection.Items[0]).getMaxPoint;
       for i:=1 to tsSelection.Count -1 do
       begin
         tmpPoint:=TDrawObject(tsSelection.Items[i]).getMaxPoint;
         incX:=lPoint.x-tmpPoint.X;
         TDrawObject(tsSelection.Items[i]).addXY(incx,incy,-1);
       end;
    end;
    taTop:begin
       incX:=0;
       lPoint:=TDrawObject(tsSelection.Items[0]).getMinPoint;
       for i:=1 to tsSelection.Count -1 do
       begin
         tmpPoint:=TDrawObject(tsSelection.Items[i]).GetMinPoint;
         incY:=lPoint.Y -tmpPoint.Y;
         TDrawObject(tsSelection.Items[i]).addXY(incx,incy,-1);
       end;
    end;
    taBottom:begin
       incX:=0;
       lPoint:=TDrawObject(tsSelection.Items[0]).getMaxPoint;
       for i:=1 to tsSelection.Count -1 do
       begin
         tmpPoint:=TDrawObject(tsSelection.Items[i]).getMaxPoint;
         incY:=lPoint.Y-tmpPoint.Y;
         TDrawObject(tsSelection.Items[i]).addXY(incx,incy,-1);
       end;
    end;
  end;
  draw_Rambitmap;
end;

procedure TfrmDrw.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
begin
  if isModify then
  begin
    if messageDlg('是否保存文件？',mtInformation,[mbYes,mbNo],0)=mrYes then
    Save;
  end;
  postMessage(frmMain.Handle,WM_DELACTION,0,0);
end;

procedure TfrmDrw.redrawText;
var
  i,j:integer;
begin
  j:=0;
  for i:=0 to tsSelection.Count -1 do
  begin
    if TDrawObject(tsSelection.Items[i]).Style in [drwText,drwYc,drwCurve] then
    begin
       TDrawText(tsSelection.Items[i]).Font.Name :=frmMain.fontcom.Items.Strings[frmMain.fontcom.ItemIndex];
       TDrawText(tsSelection.Items[i]).Font.Size :=trunc(frmMain.fontspin.Value);
       TDrawText(tsSelection.Items[i]).isBold :=frmMain.btnBold.Down;
       TDrawText(tsSelection.Items[i]).isItaic :=frmMain.btnItalic.Down;
       TDrawText(tsSelection.Items[i]).isUnderLine :=frmMain.btnLine.Down;
       j:=j+1;
    end;
  end;
  {没有选择任何图形改变系统的默认格式}
  if tsSelection.Count=0 then
  begin
    curTextName:=frmMain.fontcom.Items.Strings[frmMain.fontcom.ItemIndex];
    curTextSize:=trunc(frmMain.fontSpin.Value);
    bFontBold:=frmMain.btnBold.Down;
    bFontItalic:=frmMain.btnItalic.Down;
    bFontUnderLine:=frmMain.btnLine.Down;
  end;
  if j>0 then
  draw_Rambitmap;
end;

procedure TfrmDrw.setTextStatus;
var
  i,j:integer;
  tmp:Pointer;
begin
  frmMain.fontspin.Tag :=1;
  j:=0;
  if tsSelection.Count >0 then
  begin
    for i:=0 to tsSelection.Count-1 do
    begin
      if TDrawObject(tsSelection.Items[i]).Style =drwText then
      begin
        j:=j+1;
        tmp:=tsSelection.Items[i];
      end;
    end;
  end;
  if (j>0) and (j<2) then
  begin
      {选择一个文本图形时,则设置为当前选中文本的格式}
      frmMain.fontcom.ItemIndex :=frmmain.FontCom.Items.IndexOf(TDrawText(tmp).Font.Name);
      frmMain.fontspin.Value :=TDrawText(tmp).Font.Size;
      frmMain.btnBold.Down:=TDrawText(tmp).isBold;
      frmMain.btnItalic.Down :=TDrawText(tmp).isItaic;
      frmMain.btnLine.Down :=TDrawText(tmp).isUnderLine;
  end;
  if (tsSelection.Count =0) or (j=0) then
  begin
    frmMain.fontcom.ItemIndex :=frmmain.FontCom.Items.IndexOf(curTextName);
    frmMain.fontspin.Value :=curTextSize;
    frmMain.btnBold.Down :=bFontBold;
    frmMain.btnItalic.Down :=bFontItalic;
    frmMain.btnLine.Down :=bFontUnderLine;
  end;
end;


function TfrmDrw.getFontStyle: TFontStyles;
begin
  result:=[];
  if bFontBold then
  result:=[fsBold];
  if bFontItalic then
  result:=result+[fsItalic];
  if bFontUnderLine then
  result:=result+[fsUnderLine];
end;

procedure TfrmDrw.TotalAttrClick(Sender: TObject);
begin
   if curDrawRef<>nil then
   begin
     frmTextAtrr:=TfrmTextAtrr.Create(Application);
     try
       frmTextAtrr.Edit1.Text :=TDrawText(curDrawRef).Info;
       frmTextAtrr.CheckBox1.Checked :=TDrawText(curDrawRef).isBold;
       frmTextAtrr.CheckBox2.Checked :=TDrawText(curDrawRef).isItaic;
       frmTextAtrr.CheckBox3.Checked :=TDrawText(curDrawRef).isUnderLine;
       frmTextAtrr.ColorBox1.Selected :=TDrawText(curDrawRef).Font.Color;
       frmTextAtrr.SpinEdit1.Value :=TDrawText(curDrawRef).Font.Size;
       if frmTextAtrr.ShowModal =mrOK THEN
       Begin
         TDrawText(curDrawRef).Info :=frmTextAtrr.Edit1.Text;
         TDrawText(curDrawRef).isBold :=frmTextAtrr.CheckBox1.Checked;
         TDrawText(curDrawRef).isItaic :=frmTextAtrr.CheckBox2.Checked;
         TDrawText(curDrawRef).isUnderLine :=frmTextAtrr.CheckBox3.Checked;
         TDrawText(curDrawRef).Font.Color :=frmTextAtrr.ColorBox1.Selected;
         TDrawText(curDrawRef).Font.Size :=frmTextAtrr.SpinEdit1.Value;
         draw_RamBitmap;
       end;
     finally
       frmTextAtrr.Free;
     end;
   end;
end;

procedure TfrmDrw.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;
      mnuSetData.Enabled :=false;
    end;
    drwImage:begin
      mnuLineSet.Enabled :=false;
      mnuFill_Color.Enabled :=false;
      totalAttr.Enabled :=false;
      mnuSetData.Enabled :=false;
    end;
    drwLine,drwPline:begin
      mnuFill_Color.Enabled :=false;
      totalAttr.Enabled :=false;
      mnuSetData.Enabled :=false;
    end;
    drwRectGraph,drwLineGraph:begin
      mnuFill_color.Enabled :=false;
      totalAttr.Enabled :=false;
      mnuSetData.Enabled :=true;
    end;
    drwYc,drwCurve:begin
      mnuLineSet.Enabled :=false;
      mnuFill_color.Enabled :=false;
      totalAttr.Enabled :=false;
      mnuSetData.Enabled :=true;
    end;
  else
    totalAttr.Enabled :=false;
    mnuSetData.Enabled :=false;
    mnuSetData.Enabled :=true;
  end;
end;

procedure TfrmDrw.draw_TopRuler(drwCanvas: TCanvas);
var
  i,posX,incSize,divSize:integer;
  tmpVal:real;
  rlRect:tRect;
begin
  {获取标尺的逻辑尺寸}
  rlRect:=rulerHoz.ClientRect;
  rlRect.Right :=drwPaint.Width;

  incSize:=trunc(35*curZoomScale);
 if (incSize mod 5)=0 then
     divSize:=incSize div 5
  else
  begin
     incSize:=incSize-(incSize mod 5);
     divSize:=incSize div 5;
  end;
  with drwCanvas do
  begin
    rulerHoz.Repaint;
    Brush.Color :=clWhite;
    Brush.Style :=bsSolid;
    Pen.Color :=clGrayText;
    {填充标尺背景}
    FillRect(rlRect);

    MoveTo(1,rlRect.Bottom-2);
    LineTo(rlRect.Right-2,rlRect.Bottom-2);
   if scrollBox1.HorzScrollBar.Position=0 then
      tmpval:=0
   else
      tmpVal:=incSize-((scrollBox1.HorzScrollBar.Position/incSize)-(scrollBox1.HorzScrollBar.Position Div incSize))*incSize;
   posX:=round(tmpVal);
   if scrollBox1.HorzScrollBar.Position=0 then
      i:=0
   else
      i:=trunc(scrollBox1.HorzScrollBar.Position/incSize)+1;

   while posX<round(rlRect.Right) do
   begin
      MoveTo(posX,6);
      LineTo(posX,rlRect.Bottom-2);
      TextOut(posX-TextWidth(intTostr(i))-2,6,intTostr(i));
      posX:=posX+incSize;
      inc(i);
   end;
   if scrollBox1.HorzScrollBar.Position=0 then
      tmpVal:=0
   else
      tmpVal:=divSize-((scrollBox1.HorzScrollBar.Position/divSize)-(scrollBox1.HorzScrollBar.Position Div divSize))*divSize;
   posX:=round(tmpVal);
   while posX<round(rlRect.Right) do
   begin
      MoveTo(posX,rlRect.Bottom-5);
      LineTo(posX,rlRect.Bottom-2);
      posX:=posX+divSize;
   end;
  end;
end;

procedure TfrmDrw.draw_LeftRuler(drwCanvas: TCanvas);
var
  i,posY,incSize,divSize:integer;
  tmpVal:real;
  rlRect:TRect;
begin
  incSize:=round(35*curZoomScale);
  if (incSize mod 5)=0 then
     divSize:=incSize div 5
  else
  begin
     incSize:=-(incSize mod 5)+incSize;
     divSize:=incSize div 5;
  end;
  {获取标尺的逻辑尺寸}
  rlRect:=rulerVer.ClientRect;
  rlRect.Bottom :=drwPaint.Height;

  with drwCanvas do
  begin
    rulerVer.Repaint;