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

📄 d_lmddbdiagram0.pas

📁 delphi 运行期间窗体设计
💻 PAS
字号:
unit d_LMDDBDiagram0;

interface

uses
  Windows, Messages, SysUtils, {$IFNDEF VER130} Variants, {$ENDIF}Classes, Graphics, Controls, Forms,
  Dialogs, ExtCtrls, LmdDsgDiagram, StdCtrls, LmdDsgDiagramDb;
                           
type
  TForm1 = class(TForm)
    LMDDiagram1: TLMDDBDiagram;
    Memo1: TMemo;
    Label3: TLabel;
    CheckBox8: TCheckBox;
    CheckBox9: TCheckBox;
    Button5: TButton;
    Panel1: TPanel;
    Button1: TButton;
    Button2: TButton;
    Label1: TLabel;
    procedure LMDDiagram1Change(Sender: TObject);
    procedure LMDDiagram1ChangeSelection(Sender: TObject);
    procedure LMDDiagram1Click(Sender: TObject);
    procedure LMDDiagram1DblClick(Sender: TObject);
    procedure LMDDiagram1DeleteItem(Sender: TObject;
      AItem: TLMDDiagramItem);
    procedure LMDDiagram1DeleteLink(Sender: TObject;
      ALink: TLMDDiagramLink);
    procedure LMDDiagram1Enter(Sender: TObject);
    procedure LMDDiagram1Exit(Sender: TObject);
    procedure LMDDiagram1InsertItem(Sender: TObject;
      AItem: TLMDDiagramItem);
    procedure LMDDiagram1InsertLink(Sender: TObject;
      ALink: TLMDDiagramLink);
    procedure LMDDiagram1KeyDown(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure LMDDiagram1KeyPress(Sender: TObject; var Key: Char);
    procedure LMDDiagram1KeyUp(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure LMDDiagram1MouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure LMDDiagram1MouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer);
    procedure LMDDiagram1MouseUp(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure Button5Click(Sender: TObject);
    procedure Panel1DragOver(Sender, Source: TObject; X, Y: Integer;
      State: TDragState; var Accept: Boolean);
    procedure FormDestroy(Sender: TObject);
    procedure Panel1DragDrop(Sender, Source: TObject; X, Y: Integer);
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure LMDDiagram1DragOver(Sender, Source: TObject; X, Y: Integer;
      State: TDragState; var Accept: Boolean);
    procedure LMDDiagram1DragDrop(Sender, Source: TObject; X, Y: Integer);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

uses d_LMDDBDiagram1, d_LMDDBDiagram2;

{$R *.dfm}

procedure TForm1.LMDDiagram1Change(Sender: TObject);
begin
  Memo1.Lines.Add('OnChange');
end;

procedure TForm1.LMDDiagram1ChangeSelection(Sender: TObject);
begin
  Memo1.Lines.Add('OnChangeSelection');
end;

procedure TForm1.LMDDiagram1Click(Sender: TObject);
begin
  Memo1.Lines.Add('OnClick');
end;

procedure TForm1.LMDDiagram1DblClick(Sender: TObject);
begin
  Memo1.Lines.Add('OnDblClick');

  if LMDDiagram1.SelectedItem <> nil then
    with TdlgItemProps.Create(Application) do
    begin
      Lines.Assign(LMDDiagram1.SelectedItem.Lines);
      if Execute then
        LMDDiagram1.SelectedItem.Lines.Assign(Lines);
      Free;
    end
  else if LMDDiagram1.SelectedLink <> nil then
    with TdlgLinkProps.Create(Application) do
    begin
      BeginType := LMDDiagram1.SelectedLink.BeginPointType;
      EndType := LMDDiagram1.SelectedLink.EndPointType;
      BeginLines.Assign(LMDDiagram1.SelectedLink.BeginItem.Lines);
      EndLines.Assign(LMDDiagram1.SelectedLink.EndItem.Lines);
      BeginLineIndex := LMDDiagram1.SelectedLink.BeginLineIndex;
      EndLineIndex := LMDDiagram1.SelectedLink.EndLineIndex;
      if Execute then
      begin
        LMDDiagram1.SelectedLink.BeginPointType := BeginType;
        LMDDiagram1.SelectedLink.EndPointType := EndType;
        LMDDiagram1.SelectedLink.BeginLineIndex := BeginLineIndex;
        LMDDiagram1.SelectedLink.EndLineIndex := EndLineIndex;
      end;
      Free;
    end;
end;

procedure TForm1.LMDDiagram1DeleteItem(Sender: TObject;
  AItem: TLMDDiagramItem);
begin
  Memo1.Lines.Add(Format('OnDeleteItem: %s', [AItem.DisplayName]));
end;

procedure TForm1.LMDDiagram1DeleteLink(Sender: TObject;
  ALink: TLMDDiagramLink);
begin
  Memo1.Lines.Add(Format('OnDeleteLink: %s', [ALink.DisplayName]));
end;

procedure TForm1.LMDDiagram1Enter(Sender: TObject);
begin
  Memo1.Lines.Add('OnEnter');
end;

procedure TForm1.LMDDiagram1Exit(Sender: TObject);
begin
  Memo1.Lines.Add('OnExit');
end;

procedure TForm1.LMDDiagram1InsertItem(Sender: TObject;
  AItem: TLMDDiagramItem);
begin
  Memo1.Lines.Add(Format('OnInsertItem: %s', [AItem.DisplayName]));
end;

procedure TForm1.LMDDiagram1InsertLink(Sender: TObject;
  ALink: TLMDDiagramLink);
begin
  Memo1.Lines.Add(Format('OnInsertLink: %s', [ALink.DisplayName]));
end;

procedure TForm1.LMDDiagram1KeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin
  if CheckBox9.Checked then
    Memo1.Lines.Add(Format('OnKeyDown: (Key: $%x)', [Key]));
end;

procedure TForm1.LMDDiagram1KeyUp(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin
  if CheckBox9.Checked then
    Memo1.Lines.Add(Format('OnKeyUp: (Key: %x)', [Key]));
end;

procedure TForm1.LMDDiagram1MouseDown(Sender: TObject;
  Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
var
  LItem: TLMDDiagramItem;
  LLink: TLMDDiagramLink;
  LS, LS1: string;
begin
  if CheckBox8.Checked then
  begin
    LItem := LMDDiagram1.ItemAtPos(X, Y);
    LLink := LMDDiagram1.LinkAtPos(X, Y);
    if LItem <> nil then
      LS := Format('ItemAtPos: %s', [LItem.DisplayName])
    else
      LS := 'ItemAtPos: nil';
    if LLink <> nil then
      LS1 := Format('LinkAtPos: %s', [LLink.DisplayName])
    else
      LS1 := 'LinkAtPos: nil';
    Memo1.Lines.Add(Format('OnMouseDown: (X: %d, Y: %d, %s, %s)',
      [X, Y, LS, LS1]));
  end;
end;

procedure TForm1.LMDDiagram1MouseMove(Sender: TObject; Shift: TShiftState;
  X, Y: Integer);
var
  LItem: TLMDDiagramItem;
  LLink: TLMDDiagramLink;
  LS, LS1: string;
begin
  if CheckBox8.Checked then
  begin
    LItem := LMDDiagram1.ItemAtPos(X, Y);
    LLink := LMDDiagram1.LinkAtPos(X, Y);
    if LItem <> nil then
      LS := Format('ItemAtPos: %s', [LItem.DisplayName])
    else
      LS := 'ItemAtPos: nil';
    if LLink <> nil then
      LS1 := Format('LinkAtPos: %s', [LLink.DisplayName])
    else
      LS1 := 'LinkAtPos: nil';
    Memo1.Lines.Add(Format('OnMouseMove: (X: %d, Y: %d, %s, %s)',
      [X, Y, LS, LS1]));
  end;
end;

procedure TForm1.LMDDiagram1MouseUp(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
var
  LItem: TLMDDiagramItem;
  LLink: TLMDDiagramLink;
  LS, LS1: string;
begin
  if CheckBox8.Checked then
  begin
    LItem := LMDDiagram1.ItemAtPos(X, Y);
    LLink := LMDDiagram1.LinkAtPos(X, Y);
    if LItem <> nil then
      LS := Format('ItemAtPos: %s', [LItem.DisplayName])
    else
      LS := 'ItemAtPos: nil';
    if LLink <> nil then
      LS1 := Format('LinkAtPos: %s', [LLink.DisplayName])
    else
      LS1 := 'LinkAtPos: nil';
    Memo1.Lines.Add(Format('OnMouseUp: (X: %d, Y: %d, %s, %s)',
      [X, Y, LS, LS1]));
  end;
end;

procedure TForm1.Button5Click(Sender: TObject);
begin
  Memo1.Lines.Clear;
end;

procedure TForm1.Panel1DragOver(Sender, Source: TObject; X, Y: Integer;
  State: TDragState; var Accept: Boolean);
var
  LSource, LItem: string;
begin
  if Source <> nil then
    LSource := (Source as TComponent).Name
  else
    LSource := 'nil';
  if (Source is TLMDDBDiagram) and (TLMDDBDiagram(Source).SelectedItem <> nil) then
    LItem := TLMDDBDiagram(Source).SelectedItem.DisplayName
  else
    LItem := 'nil';

  Memo1.Lines.Add(Format('Panel1.OnDragOver: %s (Item: %s) -> %s (X: %d, Y: %d)',
    [LSource, LItem, Panel1.Name, X, Y]));
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
  LMDDiagram1.Free;
end;

procedure TForm1.Panel1DragDrop(Sender, Source: TObject; X, Y: Integer);
var
  LSource, LItem: string;
begin
  if Source <> nil then
    LSource := (Source as TComponent).Name
  else
    LSource := 'nil';
  if (Source is TLMDDBDiagram) and (TLMDDBDiagram(Source).SelectedItem <> nil) then
    LItem := TLMDDBDiagram(Source).SelectedItem.DisplayName
  else
    LItem := 'nil';

  Memo1.Lines.Add(Format('Panel1.OnDragDrop: %s (Item: %s) -> %s (X: %d, Y: %d)',
    [LSource, LItem, Panel1.Name, X, Y]));
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  LMDDiagram1.Items.Add;
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
  if LMDDiagram1.SelectedItem <> nil then
     LMDDiagram1.SelectedItem.Free;
  if LMDDiagram1.SelectedLink <> nil then
     LMDDiagram1.SelectedLink.Free;
end;

procedure TForm1.LMDDiagram1DragOver(Sender, Source: TObject; X,
  Y: Integer; State: TDragState; var Accept: Boolean);
begin
  if (Source = LMDDiagram1) and
    (LMDDiagram1.SelectedItem <> nil) and
    (LMDDiagram1.SelectedItemLine <> -1) and
    (LMDDiagram1.ItemAtPos(X, Y) <> nil) and
    (LMDDiagram1.ItemAtPos(X, Y).LineAtPos(Point(X, Y), True) <> -1) and
    (LMDDiagram1.SelectedItem <> LMDDiagram1.ItemAtPos(X, Y)) then
    Accept := True
  else
    Accept := False;
end;

procedure TForm1.LMDDiagram1DragDrop(Sender, Source: TObject; X,
  Y: Integer);
begin
  if (Source = LMDDiagram1) and
  (LMDDiagram1.SelectedItem <> nil) and
  (LMDDiagram1.SelectedItemLine <> -1) and
  (LMDDiagram1.ItemAtPos(X, Y) <> nil) and
  (LMDDiagram1.ItemAtPos(X, Y).LineAtPos(Point(X, Y), True) <> -1) and
  (LMDDiagram1.SelectedItem <> LMDDiagram1.ItemAtPos(X, Y)) then
  with TLMDDBDiagramLink(LMDDiagram1.Links.Add) do
  begin
    BeginItemName := LMDDiagram1.SelectedItem.Name;
    EndItemName := LMDDiagram1.ItemAtPos(X, Y).Name;
    BeginLineIndex := LMDDiagram1.SelectedItemLine;
    EndLineIndex := LMDDiagram1.ItemAtPos(X, Y).LineAtPos(Point(X, Y), True);
    BeginPointType := lptOne;
    EndPointType := lptInfinity; 
  end;
end;

procedure TForm1.LMDDiagram1KeyPress(Sender: TObject; var Key: Char);
begin
  if CheckBox9.Checked then
    Memo1.Lines.Add(Format('OnKeyPress: (Key: "%s")', [Key]));
end;

end.

⌨️ 快捷键说明

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