freepicu.pas

矢量图源代码 包括直线文本矩形等等

                   mLinePic:=TLinePic.Create;
                   mLinePic.AssignPic(CopyPic);
                   mLinePic.DrawPic(Image1.Canvas);
                   mLinePic.MovePic(Image1.Canvas,Point(PICDIFF,PICDIFF));
                   mLinePic.PicIndex:=PicList.Count;
                   mLinePic.Choosed:=True;
                   PicList.Add(mLinePic);
                 end;
             PIC_RECT:
                 begin
                   mRectPic:=TRectPic.Create;
                   mRectPic.AssignPic(CopyPic);
                   mRectPic.DrawPic(Image1.Canvas);
                   mRectPic.MovePic(Image1.Canvas,Point(PICDIFF,PICDIFF));
                   mRectPic.PicIndex:=PicList.Count;
                   mRectPic.Choosed:=True;
                   PicList.Add(mRectPic);
                 end;
             PIC_ROUN:
                 begin
                   mRounPic:=TRounPic.Create;
                   mRounPic.AssignPic(CopyPic);
                   mRounPic.DrawPic(Image1.Canvas);
                   mRounPic.MovePic(Image1.Canvas,Point(PICDIFF,PICDIFF));
                   mRounPic.PicIndex:=PicList.Count;
                   mRounPic.Choosed:=True;
                   PicList.Add(mRounPic);
                 end;
             PIC_CIRC:
                 begin
                   mCircPic:=TCircPic.Create;
                   mCircPic.AssignPic(CopyPic);
                   mCircPic.DrawPic(Image1.Canvas);
                   mCircPic.MovePic(Image1.Canvas,Point(PICDIFF,PICDIFF));
                   mCircPic.PicIndex:=PicList.Count;
                   mCircPic.Choosed:=True;
                   PicList.Add(mCircPic);
                 end;
             PIC_ARCC:
                 begin
                   mArccPic:=TArccPic.Create;
                   mArccPic.AssignPic(CopyPic);
                   mArccPic.DrawPic(Image1.Canvas);
                   mArccPic.MovePic(Image1.Canvas,Point(PICDIFF,PICDIFF));
                   mArccPic.PicIndex:=PicList.Count;
                   mArccPic.Choosed:=True;
                   PicList.Add(mArccPic);
                 end;
             PIC_POLY:
                 begin
                   mPolyPic:=TPolyPic.Create;
                   mPolyPic.AssignPic(CopyPic);
                   mPolyPic.DrawPic(Image1.Canvas);
                   mPolyPic.MovePic(Image1.Canvas,Point(PICDIFF,PICDIFF));
                   mPolyPic.PicIndex:=PicList.Count;
                   mPolyPic.Choosed:=True;
                   PicList.Add(mPolyPic);
                 end;
             PIC_CURVE:
                 begin
                   mCurvePic:=TCurvePic.Create;
                   mCurvePic.AssignPic(CopyPic);
                   mCurvePic.DrawPic(Image1.Canvas);
                   mCurvePic.MovePic(Image1.Canvas,Point(PICDIFF,PICDIFF));
                   mCurvePic.PicIndex:=PicList.Count;
                   mCurvePic.Choosed:=True;
                   PicList.Add(mCurvePic);
                 end;
             PIC_TEXT:
                 begin
                   mTextPic:=TTextPic.Create(Nil);
                   mTextPic.AssignPic(CopyPic);
                   mTextPic.DrawPic(Image1.Canvas);
                   mTextPic.MovePic(Image1.Canvas,Point(PICDIFF,PICDIFF));
                   mTextPic.PicIndex:=PicList.Count;
                   mTextPic.Choosed:=True;
                   PicList.Add(mTextPic);
                 end;
           end;
           SelPic:=TPicBase(PicList.Items[PicList.Count-1]);
           CopyPic:=SelPic;
           GetImageCanvasBmp(False,True);
         end;
       end;
    4: begin
         if SelPic<>Nil then begin
           if SelPic.PicIndex<0 then Exit;
           if MessageDlg('您确实要删除该图元么？',mtConfirmation,[mbYes,mbNo],0)=mrYes then begin
             mIndex:=SelPic.PicIndex;
             Case TPicBase(PicList.Items[mIndex]).PicId of
               PIC_LINE:  TLinePic(PicList.Items[mIndex]).Free;
               PIC_RECT:  TRectPic(PicList.Items[mIndex]).Free;
               PIC_ROUN:  TRounPic(PicList.Items[mIndex]).Free;
               PIC_CIRC:  TCircPic(PicList.Items[mIndex]).Free;
               PIC_ARCC:  TArccPic(PicList.Items[mIndex]).Free;
               PIC_POLY:  TPolyPic(PicList.Items[mIndex]).Free;
               PIC_CURVE: TCurvePic(PicList.Items[mIndex]).Free;
               PIC_TEXT:  TTextPic(PicList.Items[mIndex]).Free;
             end;
             ChangPicListItemIndex;
             SelPic:=nil;
           end;
         end;
       end;
  end;
end;

procedure TFreePicF.N16Click(Sender: TObject);
begin
  Case TMenuItem(Sender).Tag of
    1: SpeedButton4Click(SpeedButton4);
    2: SpeedButton4Click(SpeedButton5);
    3: SpeedButton4Click(SpeedButton6);
    4: SpeedButton4Click(SpeedButton7);
  end;
end;

procedure TFreePicF.FormKeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin
  Case Key of
    46: SpeedButton4Click(SpeedButton7);
    38: if SelPic<>Nil then SelPic.MovePic(Image1.Canvas,Point(0,-1));
    40: if SelPic<>Nil then SelPic.MovePic(Image1.Canvas,Point(0,1));
    37: if SelPic<>Nil then SelPic.MovePic(Image1.Canvas,Point(-1,0));
    39: if SelPic<>Nil then SelPic.MovePic(Image1.Canvas,Point(1,0));
    67: if (ssCtrl in Shift) then SpeedButton4Click(SpeedButton4);
    86: if (ssCtrl in Shift) then SpeedButton4Click(SpeedButton6);
  end;
  if ((Key>=37)and(Key<=40)) then GetImageCanvasBmp(False,True);
end;

procedure TFreePicF.Image1DblClick(Sender: TObject);
begin
  if (SelPic is TTextPic) then begin
    if Image1.Cursor<>CURSOR_ARROW then begin
      TTextPic(SelPic).ParentDbClick(Image1.Canvas); //问题
      Image1.Tag:=1;  //使用Image1的TAG作为修改文字的标识
    end;
  end;
end;

procedure TFreePicf.ClearPicListData;
var
  i1:Integer;
  SpeedButton:TComponent;
begin
  For i1:=PicList.Count-1 downto 0 do begin
    Case TPicBase(PicList.Items[i1]).PicId of
      PIC_LINE:  TLinePic(PicList.Items[i1]).Free;
      PIC_RECT:  TRectPic(PicList.Items[i1]).Free;
      PIC_ROUN:  TRounPic(PicList.Items[i1]).Free;
      PIC_CIRC:  TCircPic(PicList.Items[i1]).Free;
      PIC_ARCC:  TArccPic(PicList.Items[i1]).Free;
      PIC_POLY:  TPolyPic(PicList.Items[i1]).Free;
      PIC_CURVE: TCurvePic(PicList.Items[i1]).Free;
      PIC_TEXT:  TTextPic(PicList.Items[i1]).Free;
    end;
  end;
  For i1:=8 to 18 do begin
    SpeedButton:=FindComponent('SpeedButton'+IntToStr(i1));
    TSpeedButton(SpeedButton).Down:=False;
  end; 
end;

procedure TFreePicF.SpeedButton1Click(Sender: TObject);
begin
  if PicList.Count>0 then begin
    if MessageDlg('当前图象内容已改变，是否保存？',mtConfirmation,[mbYes,mbNo],0)=mrYes then begin
      SpeedButton3Click(Nil);
    end;
  end;
  ClearPicListData;
  SelPic:=nil;  //没有选择
  Image1.Cursor:=CURSOR_ARROW;
  GetImageCanvasBmp(False,True);
end;


procedure TFreePicF.SpeedButton3Click(Sender: TObject);
var
  I1:Integer;
  tf:File;
  fn:String;
  mPicType:TPicType;
  procedure SetInfBufData(pictype:TPicType;PicLen:Integer);
  var
    P:Pointer;
  begin
    P:=Pointer(@InfBuf[0]);
    PByte(P)^:=Ord(PicType);
    Inc(PByte(P));
    PInteger(P)^:=PicLen;
    Inc(PInteger(P));
  end;
  procedure SetPicCountInfData(V:integer);
  var
    P:Pointer;
  begin
    P:=Pointer(@InfBuf[0]);
    PInteger(P)^:=V;
  end;
begin
  SaveDialog1.InitialDir:=ExtractFilePath(Paramstr(0))+'Bmps\';
  if SaveDialog1.Execute then begin
    try
      //保存图象
      GetImageCanvasBmp(True,False);
      OffSrc.SaveToFile(SaveDialog1.FileName);
      //保存图元列表
      fn:=ChangeFileExt(SaveDialog1.FileName,'.fdf');
      AssignFile(tf,fn);
      ReWrite(tf,1);
      //写文件头信息
      PicBuf:='This File Structure Is Designed By WangChangYu! 2004-06-22';
      PicBuf[59]:=#18;
      BlockWrite(tf,PicBuf,60);  //写入文件说明
      SetPicCountInfData(PicList.Count);
      BlockWrite(tf,InfBuf,4); //写入总图元数
      For i1:=0 to PicList.Count-1 do begin
        mPicType:=TPicBase(PicList.Items[i1]).PicId;
        Case mPicType of
          PIC_LINE: TLinePic(PicList.Items[i1]).SaveClassDataToChar(BufLen,PicBuf); //直线
          PIC_RECT: TRectPic(PicList.Items[i1]).SaveClassDataToChar(BufLen,PicBuf); //矩形
          PIC_ROUN: TRounPic(PicList.Items[i1]).SaveClassDataToChar(BufLen,PicBuf); //圆角矩形
          PIC_CIRC: TCircPic(PicList.Items[i1]).SaveClassDataToChar(BufLen,PicBuf); //圆形
          PIC_ARCC: TArccPic(PicList.Items[i1]).SaveClassDataToChar(BufLen,PicBuf); //弧类
          PIC_POLY: TPolyPic(PicList.Items[i1]).SaveClassDataToChar(BufLen,PicBuf); //多边形
          PIC_CURVE:TCurvePic(PicList.Items[i1]).SaveClassDataToChar(BufLen,PicBuf);  //曲线
          PIC_TEXT: TTextPic(PicList.Items[i1]).SaveClassDataToChar(BufLen,PicBuf); //文本
        end;
        SetInfBufData(mPicType,BufLen-1);
        BlockWrite(tf,InfBuf,SizeOf(InfBuf));  //写入图元信息
        BlockWrite(tf,PicBuf,BufLen-1);        //写入图元数据
      end;
    finally
      CloseFile(tf);
    end;
  end;
end;



procedure TFreePicF.SpeedButton2Click(Sender: TObject);
var
  I1:integer;
  sf:File;
  mPicType:TPicType;
  PicCount:Integer;
  mLinePic:TLinePic;
  mRectPic:TRectPic;
  mRounPic:TRounPic;
  mCircPic:TCircPic;
  mArccPic:TArccPic;
  mPolyPic:TPolyPic;
  mCurvePic:TCurvePic;
  mTextPic:TTextPic;
  procedure GetPicDataInfoAndLen;
  var
    p:Pointer;
  begin
    p:=Pointer(@InfBuf[0]);
    mPicType:=TPicType(PByte(P)^);
    inc(PByte(P));
    BufLen:=PInteger(P)^;
  end;
  procedure GetPicCountInfoData;
  var
    p:Pointer;
  begin
    p:=Pointer(@InfBuf[0]);
    PicCount:=PInteger(P)^;
  end;
begin
  OpenDialog1.InitialDir:=ExtractFilePath(Paramstr(0))+'Bmps\';
  if OpenDialog1.Execute then begin
    try
      SpeedButton1Click(Nil); //清楚原来的内容
      AssignFile(sf,OpenDialog1.FileName);
      Reset(sf,1);
      Seek(sf,59);
      BlockRead(sf,InfBuf,1);
      if InfBuf[0]=#18 then begin
        BlockRead(sf,InfBuf,4);
        GetPicCountInfoData;
        For i1:=1 to PicCount do begin
          BlockRead(sf,InfBuf,5);
          GetPicDataInfoAndLen;
          BlockRead(sf,PicBuf,BufLen);
          Case mPictype of
            PIC_LINE:
              begin   //直线
                mLinePic:=TLinePic.Create;
                mLinePic.GetClassDataFromChar(BufLen,PicBuf);
                PicList.Add(mLinePic);
              end;
            PIC_RECT:  //矩形
              begin
                mRectPic:=TRectPic.Create;
                mRectPic.GetClassDataFromChar(BufLen,PicBuf);
                PicList.Add(mRectPic);
              end;
            PIC_ROUN:   //圆角矩形
              begin
                mRounPic:=TRounPic.Create;
                mRounPic.GetClassDataFromChar(BufLen,PicBuf);
                PicList.Add(mRounPic);
              end;
            PIC_CIRC:  //圆形
              begin
                mCircPic:=TCircPic.Create;
                mCircPic.GetClassDataFromChar(BufLen,PicBuf);
                PicList.Add(mCircPic);
              end;
            PIC_ARCC:  //弧类
              begin
                mArccPic:=TArccPic.Create;
                mArccPic.GetClassDataFromChar(BufLen,PicBuf);
                PicList.Add(mArccPic);
              end;
            PIC_POLY:  //多边形
              begin
                mPolyPic:=TPolyPic.Create;
                mPolyPic.GetClassDataFromChar(BufLen,PicBuf);
                PicList.Add(mPolyPic);
              end;
            PIC_CURVE: //曲线
              begin
                mCurvePic:=TCurvePic.Create;
                mCurvePic.GetClassDataFromChar(BufLen,PicBuf);
                PicList.Add(mCurvePic);
              end;
            PIC_TEXT: //文本
              begin
                mTextPic:=TTextPic.Create(ScrollBox1);
                mTextPic.GetClassDataFromChar(BufLen,PicBuf);
                PicList.Add(mTextPic);
              end;
          end;
        end;
      end else Application.MessageBox('错误的文件类型，无法读区文件数据！','错误',0);
    finally
      CloseFile(sf);
    end;
    SelPic:=Nil;
    GetImageCanvasBmp(False,True);
  end;
end;


end.