freepicu.pas

矢量图形绘制

unit FreePicU;

interface

uses
    Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
    Dialogs, ImgList, ComCtrls, ToolWin, ExtCtrls, Buttons, Contnrs,
    PicBase, LinePic, RectPic, RounPic, CircPic, ArccPic, PolyPic, CurvePic, TextPic, //图象类
    PicConst, PicFuns, BmpFuns, Menus, jpeg; //常量

type
    TFreePicF = class(TForm)
        OpenDialog1: TOpenDialog;
        SaveDialog1: TSaveDialog;
        Panel1: TPanel;
        ScrollBox1: TScrollBox;
        Image1: TImage;
        SpeedButton1: TSpeedButton;
        SpeedButton2: TSpeedButton;
        SpeedButton3: TSpeedButton;
        SpeedButton8: TSpeedButton;
        SpeedButton9: TSpeedButton;
        SpeedButton10: TSpeedButton;
        SpeedButton11: TSpeedButton;
        SpeedButton12: TSpeedButton;
        SpeedButton13: TSpeedButton;
        SpeedButton14: TSpeedButton;
        SpeedButton15: TSpeedButton;
        SpeedButton0: TSpeedButton;
        PicMenu: TPopupMenu;
        N1: TMenuItem;
        N2: TMenuItem;
        N3: TMenuItem;
        N4: TMenuItem;
        N5: TMenuItem;
        N6: TMenuItem;
        N7: TMenuItem;
        N8: TMenuItem;
        N9: TMenuItem;
        N10: TMenuItem;
        N11: TMenuItem;
        N12: TMenuItem;
        N13: TMenuItem;
        N14: TMenuItem;
        N15: TMenuItem;
        N16: TMenuItem;
        SpeedButton7: TSpeedButton;
        SpeedButton6: TSpeedButton;
        SpeedButton5: TSpeedButton;
        SpeedButton4: TSpeedButton;
        SpeedButton17: TSpeedButton;
        SpeedButton18: TSpeedButton;
        SpeedButton16: TSpeedButton;
        G1: TMenuItem;
        N17: TMenuItem;
        N18: TMenuItem;
        N19: TMenuItem;
        N3D1: TMenuItem;
        X1: TMenuItem;
        S1: TMenuItem;
        N20: TMenuItem;
        I1: TMenuItem;
        A1: TMenuItem;
        O1: TMenuItem;
        C1: TMenuItem;
        N21: TMenuItem;
        N22: TMenuItem;
        N23: TMenuItem;
        N24: TMenuItem;
        N25: TMenuItem;
        N26: TMenuItem;
        procedure FormShow(Sender: TObject);
        procedure SpeedButton0Click(Sender: TObject);
        procedure FormCreate(Sender: TObject);
        procedure FormClose(Sender: TObject; var Action: TCloseAction);
        procedure SpeedButton8Click(Sender: TObject);
        procedure Image1MouseDown(Sender: TObject; Button: TMouseButton;
            Shift: TShiftState; X, Y: Integer);
        procedure Image1MouseUp(Sender: TObject; Button: TMouseButton;
            Shift: TShiftState; X, Y: Integer);
        procedure Image1MouseMove(Sender: TObject; Shift: TShiftState; X,
            Y: Integer);
        procedure N1Click(Sender: TObject);
        procedure N3Click(Sender: TObject);
        procedure N10Click(Sender: TObject);
        procedure N11Click(Sender: TObject);
        procedure N3D1Click(Sender: TObject);
        procedure SpeedButton4Click(Sender: TObject);
        procedure SpeedButton1Click(Sender: TObject);
        procedure N16Click(Sender: TObject);
        procedure SpeedButton3Click(Sender: TObject);
        procedure SpeedButton2Click(Sender: TObject);
        procedure FormKeyDown(Sender: TObject; var Key: Word;
            Shift: TShiftState);
        procedure Image1DblClick(Sender: TObject);
        procedure N20Click(Sender: TObject);
        procedure N26Click(Sender: TObject);
    private
        //=====================================================
        mouseOldX, mouseOldY: Integer; //前一次鼠标的位置
        mouseDownOldX, mouseDownOldY: Integer; //鼠标Down的位置
        mousePos: MOUSE_POS;
        //======================================================
        CopyPic: TPicBase;
        {CopyLine:TLinePic;
        CopyRect:TRectPic;
        CopyRoun:TRounPic;
        CopyCirc:TCircPic;
        CopyArcc:TArccPic;
        CopyPoly:TPolyPic;
        CopyCurve:TCurvePic;
        CopyText:TTextPic;}
        //======================================================
        OffSrc: TBitMap;
        PicList: TComponentList;
        SelPic: TPicBase;
        LinePic: TLinePic;
        RectPic: TRectPic;
        RounPic: TRounPic;
        CircPic: TCircPic;
        ArccPic: TArccPic;
        PolyPic: TPolyPic;
        CurvePic: TCurvePic;
        TextPic: TTextPic;
        procedure InitPicVar;
        procedure FreePicVar;
        procedure PicDrawEndEvent(Pic: TComponent);
        procedure GetImageCanvasBmp(DisChoose: Boolean; DrawToImage: Boolean);
        function GetMousePos(mp: TPoint; var index: Integer): MOUSE_POS;
        procedure ClearPicListData;
        { Private declarations }
    public
        { Public declarations }
    end;

var
    FreePicF: TFreePicF;
    LedW, LedH: Integer;

var
    InfBuf: array[0..4] of Char;
    PicBuf: array[0..1023] of Char; //2k数据空间
    BufLen: Integer;

implementation

uses SetLineW;

{$R *.dfm}

procedure TFreePicF.InitPicVar;
begin
    SelPic := TPicBase.Create;
    LinePic := TLinePic.Create;
    LinePic.DrawEndEvent := PicDrawEndEvent;
    RectPic := TRectPic.Create;
    RectPic.DrawEndEvent := PicDrawEndEvent;
    RounPic := TRounPic.Create;
    RounPic.DrawEndEvent := PicDrawEndEvent;
    CircPic := TCircPic.Create;
    CircPic.DrawEndEvent := PicDrawEndEvent;
    ArccPic := TArccPic.Create;
    ArccPic.DrawEndEvent := PicDrawEndEvent;
    PolyPic := TPolyPic.Create;
    PolyPic.DrawEndEvent := PicDrawEndEvent;
    CurvePic := TCurvePic.Create;
    CurvePic.DrawEndEvent := PicDrawEndEvent;
    TextPic := TTextPic.Create(ScrollBox1);
    TextPic.DrawEndEvent := PicDrawEndEvent;
    CopyPic := TPicBase.Create;
end;

procedure TFreePicF.FreePicVar;
begin
    CopyPic := nil;
    CopyPic.Free;
    SelPic := nil;
    SelPic.Free;
    LinePic.Free;
    RectPic.Free;
    RounPic.Free;
    CircPic.Free;
    ArccPic.Free;
    PolyPic.Free;
    CurvePic.Free;
    TextPic.Free;
end;

procedure TFreePicF.PicDrawEndEvent(Pic: TComponent);
var
    PicLine: TLinePic;
    PicRect: TRectPic;
    PicRoun: TRounPic;
    PicCirc: TCircPic;
    PicArcc: TArccPic;
    PicPoly: TPolyPic;
    PicCurve: TCurvePic;
    PicText: TTextPic;
begin
    case TPicBase(Pic).PicId of
        PIC_LINE:
            begin
                PicLine := TLinePic.Create;
                PicLine.AssignPic(TLinePic(Pic));
                PicLine.PicIndex := PicList.Count;
                PicList.Add(PicLine);
            end;
        PIC_RECT:
            begin
                PicRect := TRectPic.Create;
                PicRect.AssignPic(TRectPic(Pic));
                PicRect.PicIndex := PicList.Count;
                PicList.Add(PicRect);
            end;
        PIC_ROUN:
            begin
                PicRoun := TRounPic.Create;
                PicRoun.AssignPic(TRounPic(Pic));
                PicRoun.PicIndex := PicList.Count;
                PicList.Add(PicRoun);
            end;
        PIC_CIRC:
            begin
                PicCirc := TCircPic.Create;
                PicCirc.AssignPic(TCircPic(Pic));
                PicCirc.PicIndex := PicList.Count;
                PicList.Add(PicCirc);
            end;
        PIC_ARCC:
            begin
                PicArcc := TArccPic.Create;
                PicArcc.AssignPic(TArccPic(Pic));
                PicArcc.PicIndex := PicList.Count;
                PicList.Add(PicArcc);
            end;
        PIC_POLY:
            begin
                PicPoly := TPolyPic.Create;
                PicPoly.AssignPic(TPolyPic(Pic));
                PicPoly.PicIndex := PicList.Count;
                PicList.Add(PicPoly);
                TPolyPic(Pic).PolyPointNum := 0;
            end;
        PIC_CURVE:
            begin
                PicCurve := TCurvePic.Create;
                PicCurve.AssignPic(TCurvePic(Pic));
                PicCurve.PicIndex := PicList.Count;
                PicList.Add(PicCurve);
                TCurvePic(Pic).CurvePointNum := 0;
            end;
        PIC_TEXT:
            begin
                PicText := TTextPic.Create(nil);
                PicText.AssignPic(TTextPic(Pic));
                PicText.PicIndex := PicList.Count;
                PicList.Add(PicText);
            end;
    end;
    GetImageCanvasBmp(False, True);
end;

procedure TFreePicF.FormShow(Sender: TObject);
begin
    OffSrc.PixelFormat := pf4Bit;
    OffSrc.Canvas.Brush.Color := RGB(100,0,100);
    OffSrc.Canvas.Brush.Style := bsSolid;
    OffSrc.Width := LedW;
    OffSrc.Height := LedH;
    OffSrc.Canvas.FillRect(Rect(0, 0, OffSrc.Width, OffSrc.Height));
    Image1.Picture.Assign(OffSrc);
end;

procedure TFreePicF.SpeedButton0Click(Sender: TObject);
begin
    GetImageCanvasBmp(True, False);
    ShowAllSizeOfImage(OffSrc);
end;

procedure TFreePicF.FormCreate(Sender: TObject);
var
    ScreenWdith,ScreenHeight:Integer;
    Led:ShortString;
begin
    //=========================================
    ScreenWdith:=800;
    ScreenHeight:=600;
    Led:='*.fdf';
    //----------------------------------------
    self.Caption:= self.Caption + '    当前编辑：' + Led + '    标准幕尺寸：' + IntToStr(ScreenWdith) + 'x' + IntToStr(ScreenHeight);
    self.Width:=ScreenWdith;
    self.Height:=ScreenHeight;
    LedW :=ScreenWdith;
    LedH :=ScreenHeight;
    self.Image1.Width := LedW;
    self.Image1.Height := LedH;
    //==========================================
    DoubleBuffered := True;
    InitPicVar; //初始化图象变量类
    OffSrc := TBitMap.Create;
    PicList := TComponentList.Create;
end;

procedure TFreePicF.FormClose(Sender: TObject; var Action: TCloseAction);
var
    I1: Integer;
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;
    FreePicVar; //释放图象变量类
    OffSrc.Free;
    PicList.Free;
end;

procedure TFreePicF.SpeedButton8Click(Sender: TObject);
var
    atext: TTextInfo;
begin
    if TSpeedButton(Sender).Down then begin
        case TSpeedButton(Sender).Tag of
            1..4:
                begin
                    Image1.Cursor := TSpeedButton(Sender).Tag;
                end;
            5: begin
                    Image1.Cursor := 5;
                    ArccPic.PicArccType := ARCC_ARC;
                end;
            6: begin
                    Image1.Cursor := 5;
                    ArccPic.PicArccType := ARCC_SECTOR;
                end;
            7: begin
                    Image1.Cursor := 5;
                    ArccPic.PicArccType := ARCC_CHORD;
                end;
            8: begin
                    Image1.Cursor := 6;
                    PolyPic.PolyType := PolyOpen;
                end;
            9: begin
                    Image1.Cursor := 6;
                    PolyPic.PolyType := PolyClose;
                end;
            10: begin
                    Image1.Cursor := 7;
                end;