⭐ 欢迎来到虫虫下载站！ | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站
📤 上传资源

📄 frm_main.pas

📁 delphi语言开发的矢量图形处理对象
💻 PAS
📖 第 1 页 / 共 4 页
字号:
🔍
1234 
unit Frm_Main;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ActnList, ImgList, XPStyleActnCtrls, ActnMan, ToolWin, ActnCtrls,
  ActnMenus, ExtCtrls, ComCtrls,ActnColorMaps, StdCtrls,Clipbrd,
  ExtActns, ColorGrd, Spin, Buttons,jpeg, Menus,drwObj,drwBaseType,
  ExtDlgs;

type
  TfrmMain = class(TForm)
    ActionManager1: TActionManager;
    FileNew: TAction;
    FileOpen: TAction;
    FileClose: TAction;
    actMainBar: TActionMainMenuBar;
    MainImageList: TImageList;
    Panel1: TPanel;
    StatusBar1: TStatusBar;
    FileSave: TAction;
    FileExit: TAction;
    ToolBar1: TToolBar;
    ToolButton1: TToolButton;
    ToolButton2: TToolButton;
    ToolButton3: TToolButton;
    ToolButton4: TToolButton;
    ToolButton5: TToolButton;
    imageTool: TImageList;
    LeftAlign: TAction;
    RightAlign: TAction;
    TopAlign: TAction;
    BottomAlign: TAction;
    ZoomOut: TAction;
    ZoomIn: TAction;
    ZoomFit: TAction;
    SendFront: TAction;
    SendBack: TAction;
    ToolButton6: TToolButton;
    ToolButton7: TToolButton;
    ToolButton9: TToolButton;
    ToolButton10: TToolButton;
    ToolButton11: TToolButton;
    ToolButton12: TToolButton;
    about: TAction;
    actHelp: TAction;
    actGrid: TAction;
    actTool: TAction;
    Edit_Copy: TAction;
    Edit_Cut: TAction;
    Edit_Paste: TAction;
    Edit_Together: TAction;
    Edit_FenJie: TAction;
    Edit_Del: TAction;
    Zoom_20: TAction;
    Zoom_50: TAction;
    Zoom_70: TAction;
    Zoom_100: TAction;
    Zoom_120: TAction;
    Zoom_150: TAction;
    Zoom_200: TAction;
    dlgOpen: TOpenDialog;
    ToolButton13: TToolButton;
    BrowseURL1: TBrowseURL;
    SendMail1: TSendMail;
    Panel2: TPanel;
    Panel3: TPanel;
    Panel4: TPanel;
    ColorGrid1: TColorGrid;
    pnlFore: TPanel;
    pnlBk: TPanel;
    Label1: TLabel;
    Label2: TLabel;
    Timer1: TTimer;
    dlgSave: TSaveDialog;
    Panel6: TPanel;
    rightDockPanel: TPanel;
    Splitter1: TSplitter;
    Panel7: TPanel;
    ActionToolBar1: TActionToolBar;
    ToolButton14: TToolButton;
    ToolButton15: TToolButton;
    ToolButton16: TToolButton;
    ToolButton17: TToolButton;
    ListViewObj: TListView;
    Splitter2: TSplitter;
    ScrollBox1: TScrollBox;
    drwPaint: TPaintBox;
    drwPopmenu: TPopupMenu;
    editCopy: TMenuItem;
    EditCut: TMenuItem;
    EditPaste: TMenuItem;
    N5: TMenuItem;
    N4: TMenuItem;
    N1: TMenuItem;
    MenuItem1: TMenuItem;
    MenuItem2: TMenuItem;
    N2: TMenuItem;
    mnuLineSet: TMenuItem;
    mnuFill_Color: TMenuItem;
    drwImageList: TImageList;
    dlgOpenBit: TOpenPictureDialog;
    imageLstObj: TImageList;
    fileNewObj: TAction;
    objPopup: TPopupMenu;
    mnuDelObj: TMenuItem;
    mnuRename: TMenuItem;
    CheckBox1: TCheckBox;
    procedure Panel1Resize(Sender: TObject);
    procedure ActionManager1Update(Action: TBasicAction;
      var Handled: Boolean);
    procedure Edit_TogetherExecute(Sender: TObject);
    procedure Edit_FenJieExecute(Sender: TObject);
    procedure Zoom_20Execute(Sender: TObject);
    procedure SendFrontExecute(Sender: TObject);
    procedure SendBackExecute(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure Edit_CopyExecute(Sender: TObject);
    procedure Edit_CutExecute(Sender: TObject);
    procedure Edit_PasteExecute(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure Edit_DelExecute(Sender: TObject);
    procedure FileExitExecute(Sender: TObject);
    procedure actToolExecute(Sender: TObject);
    procedure actGridExecute(Sender: TObject);
    procedure ToolButton1Click(Sender: TObject);
    procedure LeftAlignExecute(Sender: TObject);
    procedure aboutExecute(Sender: TObject);
    procedure ColorGrid1Change(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);
    procedure StatusBar1DrawPanel(StatusBar: TStatusBar;
      Panel: TStatusPanel; const Rect: TRect);
    procedure ZoomOutExecute(Sender: TObject);
    procedure ZoomInExecute(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 FormKeyDown(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure drwPopmenuPopup(Sender: TObject);
    procedure mnuLineSetClick(Sender: TObject);
    procedure mnuFill_ColorClick(Sender: TObject);
    procedure drwPaintPaint(Sender: TObject);
    procedure FormActivate(Sender: TObject);
    procedure FileOpenExecute(Sender: TObject);
    procedure ListViewObjClick(Sender: TObject);
    procedure FileSaveExecute(Sender: TObject);
    procedure FileNewExecute(Sender: TObject);
    procedure fileNewObjExecute(Sender: TObject);
    procedure FileCloseExecute(Sender: TObject);
    procedure ListViewObjEdited(Sender: TObject; Item: TListItem;
      var S: String);
    procedure objPopupPopup(Sender: TObject);
    procedure mnuDelObjClick(Sender: TObject);
    procedure mnuRenameClick(Sender: TObject);
    procedure CheckBox1Click(Sender: TObject);
  private
    { Private declarations }
    viewhandle:HWND;
    { its from frmDrw Public declarations }
    bGridVisible:boolean;
    isModify:boolean;//说明文件是否进行了修改
    curDrawRef:Pointer;//存储当前图形指针
    tsdrwObjects:TList;
    tsSelection:TList;//记录多项选择图形地址
    curZoomScale:single;
    isMove:boolean;
    bDrawing:boolean;//记录是否正处于画图状态
    iMoveMode:integer;//记录图形移动那个节点
    curBackColor:TColor;//当前画布背景颜色
    curobjName:string;//记录当前组件的名称
    {一下变量用于鼠标划分范围选择时}
    Drawing: Boolean;
    Origin, MovePt: TPoint;

    procedure Change(var msg:TWMdrawclipboard);message wm_drawclipboard;
    procedure setToolVisible(isVisible:boolean);
    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 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 MoveObject(Sender: TObject; var Key: Word;Shift: TShiftState);
    procedure centerDrwPaint;
    procedure delAllObjLst;
  public
    { Public declarations }
    function  CreateGroup:TDrawGroup;{组合图形}
    procedure ClipToGroup;
    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;
  end;

var
  frmMain: TfrmMain;

implementation
uses
   About,frm_SetFill,frm_setLine,frm_TextAttr,txtDlg,libManage;
{$R *.dfm}

procedure TfrmMain.Panel1Resize(Sender: TObject);
begin
  if panel1.Width <=30 then
  panel1.Width :=30;
end;

procedure TfrmMain.ActionManager1Update(Action: TBasicAction;
  var Handled: Boolean);
begin

    edit_Together.Enabled:=tsSelection.Count>1;
    if curDrawRef <>nil then
      edit_FenJie.Enabled :=TDrawObject(curDrawRef).Style=drwGroup
    else
      edit_FenJie.Enabled :=false;
    sendBack.Enabled :=(curDrawRef <> nil) and (drwTool=drwSelect);
    sendFront.Enabled :=(curDrawRef <> nil) and (drwTool=drwSelect);
    edit_copy.Enabled :=(curDrawRef <> nil) and (drwTool=drwSelect);
    edit_Cut.Enabled :=(curDrawRef <> nil) and (drwTool=drwSelect);
    edit_del.Enabled :=(curDrawRef <> nil) and (drwTool=drwSelect);
    leftAlign.Enabled :=(tsSelection.Count>1) and (drwTool=drwSelect);
    rightAlign.Enabled :=(tsSelection.Count>1) and (drwTool=drwSelect);
    topAlign.Enabled :=(tsSelection.Count>1) and (drwTool=drwSelect);
    bottomAlign.Enabled :=(tsSelection.Count>1) and (drwTool=drwSelect);
    fileNewObj.Enabled :=mLibManager<>nil;
    fileSave.Enabled :=mLibManager<>nil;
    fileClose.Enabled :=mLibManager<>nil;
end;
procedure TfrmMain.Edit_TogetherExecute(Sender: TObject);
begin
  ClipToGroup;
end;

procedure TfrmMain.Edit_FenJieExecute(Sender: TObject);
begin
  BreakGroup;
end;

procedure TfrmMain.Zoom_20Execute(Sender: TObject);
var
  value:single;
  tmp:integer;
begin
  tmp:=TAction(Sender).Tag;
  value:=tmp / 100;
  ZoomInOut(value);
end;

procedure TfrmMain.SendFrontExecute(Sender: TObject);
begin
  SendObject_Back;
end;

procedure TfrmMain.SendBackExecute(Sender: TObject);
begin
  SendObject_Front;
end;

procedure TfrmMain.FormCreate(Sender: TObject);
begin
  CF_MYFORMAT:=RegisterClipboardFormat(CLIPBOARDFORMAT);
  viewhandle:=SetClipboardviewer(Handle);
  curForeColor:=clBlack;
  curFillColor:=clSilver;
  curTextName:='宋体';
  curTextSize:=10;
  curPenWidth:=1;
  curObjName:='';
  curDrawRef:=nil;
  {from frmDrw Init Variart}
  bDrawing:=false;
  curDrawRef:=nil;
  isModify:=false;
  isMove:=false;
  bGridVisible:=true;
  drawing:=false;
  curBackColor:=clInfoBk;
  drwCanvasWidth:=460;
  drwCanvasHeight:=360;
  drwPaint.Width :=drwCanvasWidth;
  drwPaint.Height :=drwCanvasHeight;
  tsDrwObjects:=TList.Create;
  tsSelection:=TList.Create;
  curZoomScale:=1.0;

end;

procedure TfrmMain.Edit_CopyExecute(Sender: TObject);
begin
  CopyToClipboard;
end;

procedure TfrmMain.Edit_CutExecute(Sender: TObject);
begin
  CutToClipboard;
end;

procedure TfrmMain.Edit_PasteExecute(Sender: TObject);
begin
  PasteFromClipboard;
end;

procedure TfrmMain.Change(var msg: TWMdrawclipboard);
begin
  edit_Paste.Enabled :=clipboard.HasFormat(CF_MYFORMAT);
end;

procedure TfrmMain.FormDestroy(Sender: TObject);
var
  i:integer;
begin
  for i:=0 to tsDrwObjects.Count -1 do
  TDrawObject(tsDrwObjects.Items[i]).Free;
  tsDrwObjects.Clear;
  tsDrwObjects.Free;
  tsSelection.Free;
  clipboard.Clear;
  ChangeClipboardChain(Handle,viewhandle);
end;

procedure TfrmMain.Edit_DelExecute(Sender: TObject);
begin
  Del_SelectObjects;
end;

procedure TfrmMain.FileExitExecute(Sender: TObject);
begin
  close;
end;

procedure TfrmMain.actToolExecute(Sender: TObject);
begin
  actTool.Checked :=not actTool.Checked;
  setToolVisible(actTool.Checked);
end;

procedure TfrmMain.setToolVisible(isVisible: boolean);
begin
  Panel1.Visible :=isVisible;
  splitter1.Left :=Panel1.Width;
  splitter1.Visible :=isVisible;
end;

procedure TfrmMain.actGridExecute(Sender: TObject);
begin
  actGrid.Checked :=not actGrid.Checked;
  bGridVisible :=actGrid.Checked;
  draw_RamBitmap;
end;

procedure TfrmMain.ToolButton1Click(Sender: TObject);
begin
  isFill:=false;
  case TToolButton(Sender).Tag of
    0:drwTool:=drwSelect;
    1:drwTool:=drwLine;
    2,8:drwTool:=drwCircle;
    3,9:drwTool:=drwEllispe;
    4,10,15:drwTool:=drwRect;
    5:drwTool:=drwPLine;
    6,11:drwTool:=drwPolygon;
    7:drwTool:=drwText;
    12:drwTool:=drwImage;
    13:drwTool:=drwArc;
    14:drwTool:=drwFreeLine;
    16:drwTool:=drwSanJiao;
  end;
  if drwTool=drwSelect then
     drwPaint.Cursor :=crDefault
  else
     drwPaint.Cursor :=crCross;
  if TToolButton(Sender).Tag in [8,9,10,11] then
     isFill:=true
  else
     isFill:=false;
  if TToolButton(sender).Tag =15 then
     isRound:=true
  else
     isRound:=false;
  sendMessage(Handle,WM_UNSELECT,0,0);
end;

procedure TfrmMain.LeftAlignExecute(Sender: TObject);
begin
  setAlign(TAlign(TAction(sender).Tag));
end;

procedure TfrmMain.aboutExecute(Sender: TObject);
begin
  AboutBox:=TAboutBox.Create(Application);
  try
    AboutBox.ShowModal
  finally
    AboutBox.Free;
  end;
end;

procedure TfrmMain.ColorGrid1Change(Sender: TObject);
begin
  pnlBK.Color :=ColorGrid1.BackgroundColor;
  pnlFore.Color :=colorGrid1.ForegroundColor;
  curForeColor:=colorGrid1.ForegroundColor;
  curFillColor:=ColorGrid1.BackgroundColor;
end;

procedure TfrmMain.Timer1Timer(Sender: TObject);
begin
  statusBar1.Panels[1].Text :='  当前日期：'+dateTostr(Now);
  statusBar1.Panels[2].Text :='  当前时间：'+TimeToStr(now);
end;

procedure TfrmMain.StatusBar1DrawPanel(StatusBar: TStatusBar;
  Panel: TStatusPanel; const Rect: TRect);
begin
  statusBar1.Canvas.Brush.Color :=clMoneyGreen;
  statusBar1.Canvas.Brush.Style :=bsSolid;
  case Panel.Index of
    0:begin
      statusBar1.Canvas.Font.Color :=clBlue;
      statusBar1.Canvas.Font.Style :=[fsBold];
    end;
    1:statusBar1.Canvas.Font.Color :=clPurple;
    2:statusBar1.Canvas.Font.Color :=clPurple;
  end;
  statusBar1.Canvas.TextRect(rect,rect.Left,rect.Top+2 ,panel.Text);

end;

procedure TfrmMain.ZoomOutExecute(Sender: TObject);
var
  tmpValue:single;
begin
  tmpValue:=curZoomScale;
  tmpValue:=tmpValue+0.2;
  if tmpValue>2.6 then exit;
  ZoomInOut(tmpValue);
end;

procedure TfrmMain.ZoomInExecute(Sender: TObject);
var
  tmpValue:single;
begin
  tmpValue:=curZoomScale;
  tmpValue:=tmpValue-0.2;
  if tmpValue<0.2 then exit;
  ZoomInOut(tmpValue);
1234

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -