freepicu.pas

矢量图形绘制

                end;
            end;
        3: begin
                if CopyPic <> nil then begin
                    ChangPicListSelect;
                    case TPicBase(CopyPic).PicId of
                        PIC_LINE:
                            begin
                                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.