frm_drwchild.pas

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

unit frm_DrwChild;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ExtCtrls,drwObj,drwBaseType, Menus, ImgList,ComCtrls, ExtDlgs,
  StdCtrls,Clipbrd,CanvasPanel,Print_Preview,printers;

type
  TfrmDrw = class(TForm)
    ScrollBox1: TScrollBox;
//    drwPaint: TPaintBox;
    saveDlg: TSaveDialog;
    drwPopmenu: TPopupMenu;
    editCopy: TMenuItem;
    EditPaste: TMenuItem;
    EditCut: TMenuItem;
    N1: TMenuItem;
    sendFront: TMenuItem;
    sendBack: TMenuItem;
    TotalAttr: TMenuItem;
    N2: TMenuItem;
    N3: TMenuItem;
    mnuFill_Color: TMenuItem;
    mnuLineSet: TMenuItem;
    dlgOpenBit: TOpenPictureDialog;
    drwImageList: TImageList;
    topPnl: TPanel;
    pnlLeft: TPanel;
    Panel1: TPanel;
    pnlTop: TPanel;
    rulerHoz: TPaintBox;
    rulerVer: TPaintBox;
    lblX: TLabel;
    lblY: TLabel;
    N4: TMenuItem;
    N5: TMenuItem;
    N6: TMenuItem;
    mnuSetData: TMenuItem;
    procedure drwPaintPaint(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure drwPaintMouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure drwPaintMouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer);
    procedure drwPaintMouseUp(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure mnuLineSetClick(Sender: TObject);
    procedure mnuFill_ColorClick(Sender: TObject);
    procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
    procedure TotalAttrClick(Sender: TObject);
    procedure drwPopmenuPopup(Sender: TObject);
    procedure FormKeyDown(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure drwPaintDragOver(Sender, Source: TObject; X, Y: Integer;
      State: TDragState; var Accept: Boolean);
    procedure drwPaintDragDrop(Sender, Source: TObject; X, Y: Integer);
    procedure mnuSetDataClick(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
  private
    { Private declarations }
    Print_previewer : TPrintout;

    isMove:boolean;
    bDrawing:boolean;//记录是否正处于画图状态
    sFilePath:string;//记录文件的路径
    iMoveMode:integer;//记录图形移动那个节点
    curBackColor:TColor;//当前画布背景颜色
    {******用于设置图形的背景图的变量***********************}
    bLoadMap:Boolean;//是否载入背景图
    backBitmap:TBitmap;//背景图形缓冲区
    iArrangeMode:integer;//背景图排列方式 0、平铺 1、居中 2、伸缩
    {******以下变量用于鼠标划分范围选择时************}
    Drawing: Boolean;
    Origin, MovePt: TPoint;
    procedure DrawShape(TopLeft, BottomRight: TPoint; AMode: TPenMode);
    procedure SelectObj(TopLeft, BottomRight: TPoint);
    procedure addObjects(drwRef:TDrwTool;tmpMode:TDrwStyle;f:TStream);
    procedure drawBack(tmpCanvas:TCanvas);//设置画布的背景
    procedure drawObjects(drwCanvas:TCanvas);
    procedure drawSelect(shift:TShiftState;x,y:Integer);
    procedure MouseLeftDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);//鼠标左键处理过程
    procedure MouseRightDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);//鼠标右键处理过程
    procedure Drag_SelectObjects(x,y:integer);//图形的整体拖动
    procedure SetCursors(x,y:integer);//设置光标
    procedure PopupMnu(x,y:integer);//人工弹出菜单
    function  getIndex(value:TBrushStyle):integer;//获取画笔填充样式的类型序号
    procedure readObjectStream(f:TStream);//从数据流中读出图元对象
    procedure writeObjectStream(f:TStream);//将图元对象写到数据流中
    procedure CancelSelect(var msg:TMessage);message WM_UNSELECT;//取消选中的图形
    function getFontStyle:TFontStyles;
    procedure setTextStatus;//设置鼠标选中图元时文本修饰的值
    procedure draw_TopRuler(drwCanvas:TCanvas);
    procedure draw_LeftRuler(drwCanvas:TCanvas);
    procedure MoveObject(Sender: TObject; var Key: Word;Shift: TShiftState);
    //背景图像处理函数
    procedure DrawTitled(drwCanvas:TCanvas;CR:TRect;RamBitmap:TBitmap);
    procedure DrawStretched(drwCanvas:TCanvas;CR:TRect;RamBitmap:TBitmap);
    procedure DrawCentered(drwCanvas:TCanvas;CR:TRect;RamBitmap:TBitmap);
  public

    drwPaint:TPanelWithCanvas;

    bGridVisible:boolean;
    isModify:boolean;//说明文件是否进行了修改
    curDrawRef:Pointer;//存储当前图形指针
    tsdrwObjects:TList;
    tsSelection:TList;//记录多项选择图形地址
    curZoomScale:single;
    constructor Create(s:string;flag:Boolean);reintroduce;overLoad;
    Destructor Destroy;override;
    procedure Save;
    procedure Load(sFileName:string);
    procedure CreateGroup;{组合图形}
    procedure BreakGroup;{分解组合}
    procedure ZoomInOut(value:single);{图形的放大设置}
    procedure SendObject_Front;
    procedure SendObject_Back;
    procedure draw_RamBitmap;//在内存中重新画图
    procedure Del_SelectObjects;//删除选中的图形
    procedure PasteFromClipboard;//粘贴数据流来自剪贴板
    procedure CopyToClipboard;//拷贝到剪贴板
    procedure CutToClipboard;//剪切到剪贴板
    procedure setBkColor(value:TColor);
    function  getBkColor:TColor;
    procedure setAlign(flag:TAlign);
    procedure redrawText;
    procedure GetBmp(bmp:TBitmap);
    procedure SaveToJpeg(sfileName:string);
    //设置背景图形
    procedure setBackBitmap(sFile:string;iMode:integer);
    procedure reLoadBackSet;
    procedure Turn_X;{水平翻转}
    procedure Turn_Y;{垂直翻转}
    procedure PrintObj;
  end;

var
  frmDrw: TfrmDrw;

implementation
uses
   TxtDlg,frm_SetLine,frm_SetFill,frm_Main,frm_TextAttr,jpeg,libManage
   ,frm_setRectGraph,frm_LineGraph,frm_setPic,frmYcConfig,frmCurveConfig
   ,frmYxConfig,frmGridConfig;
{$R *.dfm}

{ TfrmDrw }

procedure TfrmDrw.addObjects(drwRef: TDrwTool;tmpMode:TDrwStyle;f:TStream);
var
  drw_ref:TDrawObject;
begin
  drw_Ref:=drwRef.create;
  drw_ref.Load(f);
  tsDrwObjects.Add(drw_ref);
  drw_Ref.Style :=tmpMode;
  if tmpMode=drwGroup then
  drw_Ref.setOrg;//重新设置组内各图元的初始保存点
//  tsSelection.Add(drw_Ref);
end;

constructor TfrmDrw.Create(s: string; flag: Boolean);
begin
   inherited Create(Application);
   //***************** define customPanel *********************
   drwPaint:=TPanelWithCanvas.Create(self);
   with drwPaint do
   begin
     Parent :=scrollBox1;
     BevelInner :=bvNone;
     BevelOuter :=bvNone;
     OnMouseDown :=drwPaintMouseDown;
     OnMouseMove :=drwPaintMouseMove;
     OnMouseUp :=drwPaintMouseUp;
     OnPaint :=drwPaintPaint;
     PopupMenu :=drwPopmenu;
     OnDragDrop :=drwPaintDragDrop;
     OnDragOver :=drwPaintDragOver;
   end;
   drwCanvasWidth:=800;
   drwCanvasHeight:=600;
   drwPaint.Width :=drwCanvasWidth;
   drwPaint.Height :=drwCanvasHeight;

   curBackColor:=clInfoBk;
   tsDrwObjects:=TList.Create;
   tsSelection:=TList.Create;
   backBitmap:=TBitmap.Create;
   curZoomScale:=1.0;
   bLoadMap:=false;
   if flag then
      Caption:=s
   else
   begin
      Caption:=extractFileName(s);
      sFilePath:=extractfilePath(s);
   end;
   if flag then
   exit;
   Load(s);
   tsSelection.Clear;
end;

destructor TfrmDrw.Destroy;
var
  i:integer;
begin
  for i:=0 to tsDrwObjects.Count -1 do
  TDrawObject(tsDrwObjects.Items[i]).Free;
  tsDrwObjects.Clear;
  tsDrwObjects.Free;
  tsSelection.Free;
  inherited;
end;

procedure TfrmDrw.drawBack(tmpCanvas:TCanvas);
var
  i:integer;
  irow,icol:integer;
  oldBrushColor,oldPenColor:TColor;
  oldBrushStyle:TBrushStyle;
  oldPenStyle:TPenStyle;
  t:TRect;
begin
  oldBrushColor:=tmpCanvas.Brush.Color;
  oldBrushStyle:=tmpCanvas.Brush.Style;
  oldPenColor:=tmpCanvas.Pen.Color;
  oldPenStyle:=tmpCanvas.Pen.Style;

  iCol:=drwCanvasWidth div 20;
  iRow:=drwCanvasHeight div 20;
  t:=rect(0,0,round(drwCanvasWidth*curZoomScale),round(drwCanvasHeight*curZoomScale));
  //填充背景图
  if bLoadMap then
  begin
    case iArrangeMode of
      0:begin
          tmpCanvas.Brush.Bitmap :=backBitmap;
          tmpCanvas.FillRect(t);
          tmpCanvas.Brush.Bitmap :=nil;
        end;
      1:drawCentered(tmpCanvas,t,backBitmap);
      2:drawStretched(tmpCanvas,t,backBitmap);
    end;
  end
  else begin//填充背景色
    tmpCanvas.Brush.Color :=curBackColor;
    tmpCanvas.Brush.Style :=bsSolid;
    tmpCanvas.FillRect(t);
  end;
  tmpCanvas.Brush.Style :=bsClear;
  tmpCanvas.Pen.Style :=psDot;
  tmpCanvas.Pen.Color :=clMedGray;
  if bGridVisible and (not bLoadMap) then
  begin
    for i:=1 to irow-1 do
    begin
      tmpCanvas.MoveTo(0,round(i*20*curZoomScale));
      tmpCanvas.LineTo(round(drwCanvasWidth*curZoomScale),round(i*20*curZoomScale));
    end;
    for i:=1 to iCol-1 do
     begin
      tmpCanvas.MoveTo(round(i*20*curZoomScale),0);
      tmpCanvas.LineTo(round(i*20*curZoomScale),round(drwCanvasHeight*curZoomScale));
    end;
  end;
  tmpCanvas.Pen.Style :=oldPenStyle;
  tmpCanvas.Pen.Color :=oldPenColor;
  tmpCanvas.Brush.Style :=oldBrushStyle;
  tmpCanvas.Brush.Color :=oldBrushColor;
end;

procedure TfrmDrw.Load(sFileName:string);
var
  f:TFileStream;
  DestFile:string;
  SoftName:TDrwName;
  fileTotalsize:int64;
begin
  DestFile:=sFileName;
  f:=TFileStream.Create(DestFile,fmOpenRead);
  try
  fileTotalSize:=f.Size;
  f.Read(SoftName,sizeOf(softname));
  if SoftName<>CurrentVer then
  begin
    messageDlg('文件打开失败!版本不符.',mtInformation,[mbOk],0);
    f.Free;
    exit;
  end;
  f.Read(DrwCanvasWidth,sizeOf(Longint));
  f.Read(DrwCanvasHeight,sizeOf(Longint));
  DrwPaint.Width:=DrwCanvasWidth;
  DrwPaint.Height:=DrwCanvasHeight;
  f.Read(curBackColor,sizeOf(TColor));
  {**********读背景图形**************}
  f.Read(bLoadMap,sizeOf(bLoadMap));
  f.Read(iArrangeMode,sizeOf(iArrangeMode));
  if bLoadMap then
  backBitmap.LoadFromStream(f);
 {**********读图形对象****************}
  While (fileTotalSize-f.Position<>0) do
  begin
    application.ProcessMessages;
    readObjectStream(f);
  end;
  finally
    f.Free;
  end;
end;

procedure TfrmDrw.Save;
var
  f:TFileStream;
  i:Integer;
  s:string;
  ver:TDrwName;
begin
   s:=Caption;
   if pos('noname',LowerCase(s))<>0 then
     begin
     s:='';
     if saveDlg.Execute then
      s:=saveDlg.FileName
     else
      exit;
     if pos('.drw',LowerCase(s))=0 then
     s:=s+'.drw';
     end
   else
     s:=sFilePath+s;
   Caption:=extractFileName(s);
   f:=TFileStream.Create(s,fmCreate);
   try
     ver:=CurrentVer;
     f.Write(ver,sizeOf(Ver));
     f.Write(DrwCanvasWidth,SizeOf(Longint));
     f.Write(drwCanvasHeight,sizeOf(Longint));
     f.Write(curBackColor,sizeOf(TColor));
     {**********增加背景图形**************}
     f.Write(bLoadMap,sizeOf(bLoadMap));
     f.Write(iArrangeMode,sizeOf(iArrangeMode));
     if bLoadMap then
     backBitmap.SaveToStream(f);
     {**********写图形对象****************}
     for i:=0 to tsDrwObjects.Count -1 do
     TDrawObject(tsDrwObjects.Items[i]).Save(f);
   finally
     f.Free;
   end;
   isModify:=false;
end;

procedure TfrmDrw.drwPaintPaint(Sender: TObject);
begin
  draw_LeftRuler(rulerVer.Canvas);
  draw_TopRuler(rulerHoz.Canvas);
  drawBack(drwPaint.Canvas);
  drawObjects(drwPaint.Canvas);  
end;

procedure TfrmDrw.FormCreate(Sender: TObject);
begin
  bDrawing:=false;
  curDrawRef:=nil;
  isModify:=false;
  isMove:=false;
  bGridVisible:=true;
  drawing:=false;
//**********new add 2004.4.9************
  printer.Orientation := poLandscape;
  Print_previewer := TPrintout.Create;
end;

procedure TfrmDrw.drwPaintMouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  PostMessage(Handle,WM_ACTIVATE,Longint(True),0);
  //鼠标左键的处理过程
  if Button=mbLeft then
  MouseLeftDown(Sender,Button,shift, round(X/curZoomScale), round(Y/curZoomScale));

  //鼠标右键按下时的处理过程
  if Button=mbRight then
  MouseRightDown(Sender,Button,Shift, round(X/curZoomScale), round(Y/curZoomScale));
end;

procedure TfrmDrw.drwPaintMouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
begin
  lblX.Caption :=format('%-2.1f',[x/(curZoomScale*35)]);
  lblY.Caption :=format('%-2.1f',[y/(curZoomScale*35)]);
  if (curDrawRef<>nil) and bDrawing then
  begin
    if (TDrawObject(curDrawRef).Style =drwFreeLine) and (drwTool=drwFreeLine) then
    begin
       TDrawFreeLine(curDrawRef).AddPoint(round(x/curZoomScale),round(y/curZoomScale));
       TDrawFreeLine(curDrawRef).Draw(drwPaint.Canvas);
    end
    else
    begin
      TDrawObject(curDrawRef).MoveAt(drwPaint.Canvas,iMoveMode,round(x/curZoomScale),round(y/curZoomScale))
    end;