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

📄 frm_main.pas

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

interface

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

type
  TfrmMain = class(TForm)
    ActionManager1: TActionManager;
    FileNew: TAction;
    FileOpen: TAction;
    FileClose: TAction;
    actMainBar: TActionMainMenuBar;
    MainImageList: TImageList;
    StatusBar1: TStatusBar;
    FileSave: TAction;
    FileExit: TAction;
    imageTool: TImageList;
    LeftAlign: TAction;
    RightAlign: TAction;
    TopAlign: TAction;
    BottomAlign: TAction;
    ZoomOut: TAction;
    ZoomIn: TAction;
    ZoomFit: TAction;
    SendFront: TAction;
    SendBack: TAction;
    WindowArrange: TAction;
    windowCengDie: TAction;
    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;
    actSize: TAction;
    winShow: TAction;
    BrowseURL1: TBrowseURL;
    SendMail1: TSendMail;
    Panel2: TPanel;
    Panel3: TPanel;
    Panel4: TPanel;
    pnlFore: TPanel;
    pnlBk: TPanel;
    Label1: TLabel;
    Label2: TLabel;
    Timer1: TTimer;
    dlgSave: TSaveDialog;
    fileBmp: TAction;
    fileJpeg: TAction;
    Panel6: TPanel;
    Image1: TImage;
    openLib: TAction;
    rightDockPanel: TPanel;
    Splitter1: TSplitter;
    Panel7: TPanel;
    ActionToolBar1: TActionToolBar;
    Panel5: TPanel;
    btnBold: TSpeedButton;
    btnItalic: TSpeedButton;
    btnLine: TSpeedButton;
    fontcom: TComboBox;
    Splitter2: TSplitter;
    edit_TurnX: TAction;
    edit_TurnY: TAction;
    actPrint: TAction;
    CoolBar1: TCoolBar;
    ToolBar1: TToolBar;
    ToolButton1: TToolButton;
    ToolButton2: TToolButton;
    ToolButton15: TToolButton;
    ToolButton14: TToolButton;
    ToolButton3: TToolButton;
    ToolButton4: TToolButton;
    ToolButton5: TToolButton;
    ToolButton16: TToolButton;
    ToolButton6: TToolButton;
    ToolButton7: TToolButton;
    ToolButton17: TToolButton;
    ToolButton8: TToolButton;
    ToolButton13: TToolButton;
    ToolBar2: TToolBar;
    ToolButton20: TToolButton;
    ToolButton21: TToolButton;
    ToolButton22: TToolButton;
    ToolButton23: TToolButton;
    fontSpin: TRzSpinEdit;
    ColorGrid1: TColorGrid;
    procedure FileNewExecute(Sender: TObject);
    procedure FileOpenExecute(Sender: TObject);
    procedure FileSaveExecute(Sender: TObject);
    procedure FileCloseExecute(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 actSizeExecute(Sender: TObject);
    procedure LeftAlignExecute(Sender: TObject);
    procedure WindowArrangeExecute(Sender: TObject);
    procedure windowCengDieExecute(Sender: TObject);
    procedure winShowExecute(Sender: TObject);
    procedure aboutExecute(Sender: TObject);
    procedure ColorGrid1Change(Sender: TObject);
    procedure fontcomClick(Sender: TObject);
    procedure fontspinChange(Sender: TObject);
    procedure btnBoldClick(Sender: TObject);
    procedure btnItalicClick(Sender: TObject);
    procedure btnLineClick(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);
    procedure StatusBar1DrawPanel(StatusBar: TStatusBar;
      Panel: TStatusPanel; const Rect: TRect);
    procedure ZoomOutExecute(Sender: TObject);
    procedure ZoomInExecute(Sender: TObject);
    procedure fileBmpExecute(Sender: TObject);
    procedure fileJpegExecute(Sender: TObject);
    procedure rightDockPanelDockOver(Sender: TObject;
      Source: TDragDockObject; X, Y: Integer; State: TDragState;
      var Accept: Boolean);
    procedure rightDockPanelGetSiteInfo(Sender: TObject;
      DockClient: TControl; var InfluenceRect: TRect; MousePos: TPoint;
      var CanDock: Boolean);
    procedure rightDockPanelUnDock(Sender: TObject; Client: TControl;
      NewTarget: TWinControl; var Allow: Boolean);
    procedure rightDockPanelDockDrop(Sender: TObject;
      Source: TDragDockObject; X, Y: Integer);
    procedure openLibExecute(Sender: TObject);
    procedure Splitter2Paint(Sender: TObject);
    procedure FormShow(Sender: TObject);
    procedure edit_TurnXExecute(Sender: TObject);
    procedure edit_TurnYExecute(Sender: TObject);
    procedure actPrintExecute(Sender: TObject);
  private
    { Private declarations }
    viewhandle:HWND;
    openFileNum:integer;
    FOldClientProc,
    FNewClientProc: TFarProc;
    FDrawDC: hDC;
    oldButton:TToolButton;
    procedure ClientWndProc(var Message: TMessage);
    procedure DrawStretched;
    procedure DrawCentered;
    procedure DrawTiled;
    procedure Change(var msg:TWMdrawclipboard);message wm_drawclipboard;
    procedure DelAction(var msg:TMessage);message WM_DELACTION;
    procedure setToolVisible(isVisible:boolean);
    procedure createActionClient(sCaption:string);
    function getNewAction(sCaption:string):TAction;
    procedure loadLib;//调用图库
    procedure searchLibFiles(paraList:TStrings);//查找图库文件
  protected
    procedure CreateWnd; override;
  public
    { Public declarations }
    curDrwChild:Pointer;
  end;

var
  frmMain: TfrmMain;

implementation
uses
  frm_DrwChild,drwObj,frm_setPic,About,libManage;
{$R *.dfm}

procedure TfrmMain.FileNewExecute(Sender: TObject);
var
  sFileName:string;
  i,j:integer;
begin
  sFileName:='noname'+inttostr(MDIChildCount+1);
  j:=2;
  for i:=0 to MDIChildCount-1 do
  begin
    if sFileName=Tfrmdrw(MDIChildren[i]).Caption then
    begin
      sFileName:='noname'+inttostr(MDIChildCount+j);
      j:=j+1;
      continue;
    end;
  end;
  curDrwChild:=TfrmDrw.Create(sFileName,true);
  createActionClient(sFileName);
end;

procedure TfrmMain.FileOpenExecute(Sender: TObject);
var
  sFileName,tmpFile:string;
  i:integer;
begin
  dlgOpen.Filter :='工程文件(*.Drw)|*.drw';
  if dlgOpen.Execute then
  begin
     sFileName:=dlgOpen.FileName;
     tmpFile:=ExtractFileName(sFileName);
     for i:=0 to Self.MDIChildCount -1 do
     begin
       if tmpFile=TfrmDrw(MDIChildren[i]).Caption then
       begin
         messageDlg('该文件:'+tmpFile+'已经打开!',mtError,[mbOk],0);
         exit;
       end;
     end;
     curDrwChild:=TfrmDrw.Create(sFileName,false);
     {增加窗口菜单项文件列表}
     createActionClient(ExtractFileName(sFileName));
  end;
end;

procedure TfrmMain.FileSaveExecute(Sender: TObject);
var
  winActionItem:TActionClientItem;
  newAction:TAction;
  i:integer;
begin
  winActionItem:=actionManager1.FindItemByCaption('窗口【&W】');
  for i:=3 to winActionItem.Items.Count -1 do
  begin
    newAction:=TAction(winActionitem.Items[i].Action);
    if newAction.Caption =TfrmDrw(Self.ActiveMDIChild).Caption then
    break;
  end;
  TfrmDrw(Self.ActiveMDIChild).Save;
  if newAction<>nil then
  newAction.Caption :=TfrmDrw(Self.ActiveMDIChild).Caption;
end;

procedure TfrmMain.FileCloseExecute(Sender: TObject);
{var
  winActionItem:TActionClientItem;
  newAction:TAction;
  i:integer;
begin
  winActionItem:=actionManager1.FindItemByCaption('窗口【&W】');
  for i:=3 to winActionItem.Items.Count -1 do
  begin
    newAction:=TAction(winActionitem.Items[i].Action);
    if newAction.Checked then
    break;
  end;
  if TfrmDrw(ActiveMDIChild).isModify then
  begin
    if messageDlg('是否保存文件?',mtInformation,[mbYes,mbNo],0)=mrYes then
    TfrmDrw(ActiveMDIChild).Save;
  end;}
begin
  TfrmDrw(ActiveMDIChild).Close;
end;

procedure TfrmMain.ActionManager1Update(Action: TBasicAction;
  var Handled: Boolean);
var
  bExistChild:boolean;
begin
  bExistChild:=MDIChildCount >0;
  FileSave.Enabled :=bExistChild;
  FileClose.Enabled :=bExistChild;
  actPrint.Enabled :=bExistChild;
  zoom_20.Enabled :=bExistChild;
  zoom_50.Enabled :=bExistChild;
  zoom_70.Enabled :=bExistChild;
  zoom_100.Enabled :=bExistChild;
  zoom_120.Enabled :=bExistChild;
  zoom_150.Enabled :=bExistChild;
  zoom_200.Enabled :=bExistChild;
  actGrid.Enabled :=bExistChild;
  actSize.Enabled :=bExistChild;
  ZoomIn.Enabled :=bExistChild;
  ZoomOut.Enabled :=bExistChild;
  fileBmp.Enabled :=ActiveMDIChild<>nil;
  fileJpeg.Enabled :=ActiveMDIChild<>nil;
  if MDIChildCount>0 then
  begin
    edit_Together.Enabled:=TfrmDrw(ActiveMDIChild).tsSelection.Count>1;
    if TfrmDrw(ActiveMDIChild).curDrawRef <>nil then
      edit_FenJie.Enabled :=(TDrawObject(TfrmDrw(ActiveMDIChild).curDrawRef).Style=drwGroup)
    else
      edit_FenJie.Enabled :=false;
    sendBack.Enabled :=(TfrmDrw(ActiveMDIChild).curDrawRef <> nil) and (drwTool=drwSelect);
    sendFront.Enabled :=(TfrmDrw(ActiveMDIChild).curDrawRef <> nil) and (drwTool=drwSelect);
    edit_copy.Enabled :=(TfrmDrw(ActiveMDIChild).curDrawRef <> nil) and (drwTool=drwSelect);
    edit_Cut.Enabled :=(TfrmDrw(ActiveMDIChild).curDrawRef <> nil) and (drwTool=drwSelect);
    edit_del.Enabled :=(TfrmDrw(ActiveMDIChild).curDrawRef <> nil) and (drwTool=drwSelect);
    leftAlign.Enabled :=(TfrmDrw(ActiveMDIChild).tsSelection.Count>1) and (drwTool=drwSelect);
    rightAlign.Enabled :=(TfrmDrw(ActiveMDIChild).tsSelection.Count>1) and (drwTool=drwSelect);
    topAlign.Enabled :=(TfrmDrw(ActiveMDIChild).tsSelection.Count>1) and (drwTool=drwSelect);
    bottomAlign.Enabled :=(TfrmDrw(ActiveMDIChild).tsSelection.Count>1) and (drwTool=drwSelect);
  end
  else
  begin
    edit_Together.Enabled :=false;
    edit_FenJie.Enabled :=false;
    sendBack.Enabled :=false;
    sendFront.Enabled :=false;
    edit_copy.Enabled :=false;
    edit_Cut.Enabled :=false;
    edit_Del.Enabled :=false;
    leftAlign.Enabled :=false;
    rightAlign.Enabled :=false;
    topAlign.Enabled :=false;
    bottomAlign.Enabled :=false;
  end;
end;
procedure TfrmMain.Edit_TogetherExecute(Sender: TObject);
begin
  TfrmDrw(ActiveMDIChild).CreateGroup;
end;

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

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

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

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

procedure TfrmMain.FormCreate(Sender: TObject);
begin
  CF_MYFORMAT:=RegisterClipboardFormat(CLIPBOARDFORMAT);
  viewhandle:=SetClipboardviewer(Handle);
  openFileNum:=0;
  curForeColor:=clBlack;
  curFillColor:=clSilver;
  curTextName:='宋体';
  curTextSize:=10;
  curPenWidth:=1;
  fontcom.Clear;
  fontcom.Items := Screen.Fonts;
  fontCom.ItemIndex :=fontCom.Items.IndexOf('宋体');
  bFontBold:=false;
  bFontItalic:=false;
  bFontUnderLine:=false;
  oldButton:=ToolButton1;
  loadLib;//调用图库
end;

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

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

procedure TfrmMain.Edit_PasteExecute(Sender: TObject);
begin
  if SELF.MDIChildCount =0 THEN EXIT;
  TfrmDrw(ActiveMDIChild).PasteFromClipboard;
end;

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

procedure TfrmMain.FormDestroy(Sender: TObject);
begin
  clipboard.Clear;
  ChangeClipboardChain(Handle,viewhandle);
end;

procedure TfrmMain.Edit_DelExecute(Sender: TObject);
begin
  TfrmDrw(ActiveMDIChild).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
  CoolBar1.Visible :=isVisible;
  splitter1.Left :=CoolBar1.Width;
  splitter1.Visible :=isVisible;
end;

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

procedure TfrmMain.ToolButton1Click(Sender: TObject);
begin
  isFill:=false;
  if oldButton=TToolButton(Sender) then
  begin
   oldButton.Down:=true;
   exit;
  end;
  oldButton.Down :=false;
  case TToolButton(Sender).Tag of
    0:drwTool:=drwSelect;
    1:drwTool:=drwLine;
    2:drwTool:=drwCircle;
    3:drwTool:=drwEllispe;
    4,15:drwTool:=drwRect;
    5:drwTool:=drwPLine;
    6:drwTool:=drwPolygon;
    7:drwTool:=drwText;
    12:drwTool:=drwImage;
    13:drwTool:=drwArc;
    14:drwTool:=drwFreeLine;
    16:drwTool:=drwGrid;
    17:drwTool:=drwRectGraph;
    18:drwTool:=drwLineGraph;
    19:drwTool:=drwYc;
    20:drwTool:=drwCurve;
  end;
  oldButton:=TToolButton(Sender);
  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;
  if ActiveMDIChild<>nil then
  sendMessage(TfrmDrw(ActiveMDIChild).Handle,WM_UNSELECT,0,0);
end;

procedure TfrmMain.actSizeExecute(Sender: TObject);
begin
  frmsetPic:=TFrmsetPic.Create(Application);
  try
    frmSetpic.pnlBk.Color :=TfrmDrw(activeMDIChild).getBkColor;

⌨️ 快捷键说明

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