eermodel.pas

DBDesigner 4 is a database design system that integrates database design, modelling, creation and ma

    PaintingToSpecialCanvas: Boolean;

    //Actions
    CurrentAction: Integer;
    ActionLog: TObjectList;

    //The PopupMenus
    PopupMenuEERTable,
    PopupMenuEERRelation,
    PopupMenuEERNote,
    PopupMenuEERImage,
    PopupMenuEERRegion: TPopupMenu;

    //Store the last selected Editor Pages
    LastTableEditorPage,
    LastRelEditorPage: integer;

    //Region Colors
    RegionColors: TStringList;

    //Plugin Data
    PluginData: TObjectList;

    //Stored SQLCmds
    StoredSQLCmds: TObjectList;

    //PositionMarkers
    PosMarkers: TObjectList;

    UsePositionGrid: Boolean;
    PositionGrid: TPoint;

    TableNameInRefs: Boolean;
    DefaultTableType: integer;
    ActivateRefDefForNewRelations: Boolean;

    FKPrefix, FKPostfix: string;

    CreateFKRefDefIndex: Boolean;

    //This flag tells the Objects that they don't have
    //to update other objects because all objects are being cleared
    ModelIsBeingCleared: Boolean;

    DBQuoteCharacter: string;

    ReadOnly: Boolean;

    LinkedModels: TObjectList;
    CreateSQLforLinkedObjects: Boolean;
  end;

  // -----------------------------------------------
  // Declaration of the EERModel - Objects (EER_Table, EER_Rel, EER_Note, ...)

  TEERObj = class(TPaintBox)
    constructor Create(AOwner: TComponent); override;

    procedure Assign(Source: TPersistent); override;
    function ObjIsEqualTo(Source: TObject): Boolean;

    //Displays the Object's Editor
    procedure ShowEditor(Sender: TObject); virtual; abstract;

    //Returns the Obj as XML Model code (for copy/paste and actions)
    function GetObjAsXMLModel: string;

    //Get the Region the Obj is in
    function GetRegion: Pointer;

    //Paint the Object
    procedure PaintObj(theCanvas: TCanvas; theZoomfac: double = -1;
      x: integer = 0; y: integer = 0; w: integer = 0; h: integer = 0);
    procedure PaintMouseOver; virtual;
    procedure PaintMouseOverClear; virtual;

    //Event, is defined as abstract, so it has to be overwriten
    procedure DoPaint(Sender: TObject); virtual; abstract;

    //Refresh Obj (with new Zoom factor) but does no paint
    procedure RefreshObj(Sender: TObject = nil); virtual; abstract;

    //Get and set Selection State
    function Selected: Boolean;
    procedure SetSelected(select: Boolean); virtual;

    //Selects the Obj
    procedure SelectObj(Sender: TObject);
    //Deletes the Object
    procedure DeleteObj; virtual; abstract;
  protected
    //Call Editor
    procedure DoDblClick(Sender: TObject);

    //Define Mouse Actions procedures as abstract, so they have to be overwritten
    procedure DoMouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer); virtual;
    procedure DoMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer); virtual;
    procedure DoMouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); virtual;

    procedure DoMouseEnter(Sender: TObject);
    procedure DoMouseLeave(Sender: TObject);

    //Drag'n'Drop
    procedure DoOnStartDrag(Sender: TObject;
      var DragObject: TDragObject);
    procedure DoOnEndDrag(Sender, Target: TObject; X,
      Y: Integer);

    //Paints the Obj, is defined as abstract, so it has to be overwriten
    procedure PaintObj2Canvas(theCanvas: TCanvas; xo, yo: integer); virtual; abstract;

    //Calculates ScreenCoordinates to EER-Coordinates
    function EvalZoomFac(thevalue: integer): integer;
    //Calculates EER-Coordinates to ScreenCoordinates
    function ReEvalZoomFac(thevalue: integer): integer;

    //Get Obj as XML
    function GetXML: string; virtual; abstract;
  private
    { Private declarations }
    IsSelected: Boolean;

  public
    { Public declarations }
    ParentEERModel: TEERModel;

    Obj_id,
    Obj_X, Obj_Y, Obj_W, Obj_H: integer;

    ObjName: string;

    Comments: String;

    //Vars for MouseAction
    mouse_posx, mouse_posy, mouse_absx, mouse_absy: integer;
    MouseIsDown,
    EditorIsCalled: Boolean;

    ObjChanged: Boolean;

    IsLinkedObject: Boolean;
    IDLinkedModel,
    Obj_id_Linked: integer;

    OrderPos: integer;
  end;


  // -----------------------------------------------
  // Declaration of the EER Table Object

  TEERTable = class(TEERObj)
    constructor Create(AOwner: TComponent; TheName: string; FontName: string; theTableType: integer; theTablePrefix: integer; thePopupMenu: TPopupMenu); reintroduce; overload;
    destructor Destroy; override;

    procedure Assign(Source: TPersistent); override;
    function ObjIsEqualTo(Source: TObject): Boolean; overload;

    //Displays the Obj's Editor
    procedure ShowEditor(Sender: TObject); override;

    //Event
    procedure DoPaint(Sender: TObject); override;

    //Draw mouse over Object
    procedure PaintMouseOver; override;
    procedure PaintMouseOverClear; override;

    //Paint the Object
    procedure PaintObj2Canvas(theCanvas: TCanvas; xo, yo: integer); override;

    //Refresh the table
    procedure RefreshObj(Sender: TObject = nil); override;
    //Delete the Obj
    procedure DeleteObj; override;

    //Refresh all Relations of this table
    procedure RefreshRelations(preventRecursion: Boolean = False);

    //Get the offset value of the specified Relation
    //(when there are more than one relation on one side of the table)
    function GetRelationOffset(theRel: Pointer): integer;

    //Checks the primary index and returns the obj_id or -1
    function CheckPrimaryIndex: integer;
    procedure PrimaryColumnsFirst;

    //Returns the table's prefix
    function GetTablePrefix: String;

    //Get SQL Codes
    function GetSQLTableName(DoNotAddPrefix: Boolean = False): string;
    function GetSQLCreateCode(DefinePK: Boolean = True;
      CreateIndices: Boolean = True; DefineFK: Boolean = False;
      TblOptions: Boolean = True; StdInserts: Boolean = False;
      OutputComments: Boolean = False): string;
    function GetSQLColumnCreateDefCode(i: integer): string;
    function GetSQLDropCode: string;
    function GetSQLInsertCode: string;

    //Get an set the XML code of the Table
    function GetXML: string; override;
{$IFDEF USE_IXMLDBMODELType}
    procedure SetXML(theXMLTable: IXMLTABLEType);
{$ENDIF}
    procedure SetXML2(theXMLParser: TXmlParser);

    //Copy to clipboard functions
    procedure CopyTableName(Sender: TObject);
    procedure CopyTableFields(Sender: TObject);
    procedure CopyTableSQLInsert(Sender: TObject);
    procedure CopyTableSQLCreate(Sender: TObject);
    procedure CopyTableSQLDrop(Sender: TObject);

    //Column functions
    function GetColumnCount: integer;
    function GetColumnByIndex(index: integer): Pointer;
    function GetColumnByID(idColumn: integer): Pointer;
    function GetColumnByName(cname: string): Pointer;
    procedure DeleteColumn(index: integer);

    //nm-Table functions
    function GetnmTableStatus: Boolean;
    procedure SetnmTableStatus(isnmTable: Boolean);

  protected
    procedure DoMouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer); override;
    procedure DoMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer); override;
    procedure DoMouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;
    procedure DoClick(Sender: TObject);

    procedure DoDragOver(Sender, Source: TObject; X, Y: Integer;
      State: TDragState; var Accept: Boolean);
    procedure DoDragDrop(Sender, Source: TObject; X, Y: Integer);

    procedure PaintCachedImg(theCanvas: TCanvas; xo: integer = 0; yo: integer = 0);
  private
    { Private declarations }

    nmTable: Boolean;

  public
    { Public declarations }
    TableType,
    TablePrefix: integer;
    Temporary: Boolean;

    PrevTableName: string;

    TableOptions: TStringList;

    StandardInserts: TStringList;
    UseStandardInserts: Boolean;


    Columns: TObjectList;
    Indices: TObjectList;

    //List of ALL Relations Starting and Ending at this table
    RelStart, RelEnd: TList;

    // Lists of Relations on each side
    Rel: Array[1..4] of TList;

    RefreshStrechedImg: Boolean;
    StrechedImg: TBitmap;
    CachedTblXML: string;

    Collapsed: Boolean;

    tmp: string;
  end;

  // -----------------------------------------------
  // Declaration of the EER Rel Object

  TEERRel = class(TEERObj)
    constructor Create(AOwner: TComponent; TheName: string); reintroduce; overload;
    destructor Destroy; override;

    procedure Assign(Source: TPersistent); override;

    procedure ShowEditor(Sender: TObject); override;

    procedure DoPaint(Sender: TObject); override;

    //Paint the Object
    procedure PaintObj2Canvas(theCanvas: TCanvas; xo, yo: integer); override;

    procedure PaintObj2(theCanvas: TCanvas; theZoomfac: double = -1;
      x: integer = 0; y: integer = 0; w: integer = 0; h: integer = 0; SubObj: integer = 1);

    // Caution: if Sender<>nil the RefreshObj WILL NOT call itself over the
    // RefreshRelations function preventing infinite recursive loop
    procedure RefreshObj(Sender: TObject = nil); override;

    //Delete the Obj
    procedure DeleteObj; override;

    function GetRelDirection: integer;

    function GetIntervalTxt(StartInterval: Boolean): string;

    function GetXML: string; override;
{$IFDEF USE_IXMLDBMODELType}
    procedure SetXML(theXMLRelation: IXMLRELATIONType);
{$ENDIF}
    procedure SetXML2(theXMLParser: TXmlParser);

  protected
    procedure DoMouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer); override;
    procedure DoMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer); override;
    procedure DoMouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;

    procedure PaintObj2Canvas_RelStart(theCanvas: TCanvas; xo, yo: integer);
    procedure PaintObj2Canvas_RelMiddle(theCanvas: TCanvas; xo, yo: integer);
    procedure PaintObj2Canvas_RelEnd(theCanvas: TCanvas; xo, yo: integer);
    procedure PaintObj2Canvas_RelCaption(theCanvas: TCanvas; xo, yo: integer);
    procedure PaintObj2Canvas_RelStartInterval(theCanvas: TCanvas; xo, yo: integer);
    procedure PaintObj2Canvas_RelEndInterval(theCanvas: TCanvas; xo, yo: integer);

    procedure DoPaint_RelMiddle(Sender: TObject);
    procedure DoPaint_RelEnd(Sender: TObject);
    procedure DoPaint_Caption(Sender: TObject);
    procedure DoPaint_StartInterval(Sender: TObject);
    procedure DoPaint_EndInterval(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
    RelKind: integer;

    SrcTbl, DestTbl: TEERTable;
    FKFields, //Stores the names of Source and Dest. Fields
    FKFieldsComments: TStringList; //Stores Comments

    CreateRefDef: Boolean;
    RefDef: TStringList;
    FKRefDefIndex_Obj_id: integer;

    Invisible: Boolean;
    Splitted: Boolean;

    RelMiddle, RelEnd,
    RelCaption: TPaintBox;
    RelStartInterval,
    RelEndInterval: TPaintBox;

    OptionalStart, OptionalEnd: Boolean;

    relDirection, relMidDirection: integer;

    MidOffset, tempMidOffset: integer;
    CaptionOffset, tempOffset: TPoint;
    StartIntervalOffset,
    EndIntervalOffset: TPoint;

    tempW, tempH: integer;
  end;

  // -----------------------------------------------
  // Declaration of the EER Note Object

  TEERNote = class(TEERObj)
    constructor Create(AOwner: TComponent; TheName: string); reintroduce; overload;
    destructor Destroy; override;

    procedure Assign(Source: TPersistent); override;

    procedure ShowEditor(Sender: TObject); override;

    procedure DoPaint(Sender: TObject); override;

    //Paint the Object
    procedure PaintObj2Canvas(theCanvas: TCanvas; xo, yo: integer); override;

    procedure RefreshObj(Sender: TObject = nil); override;

    //Delete the Obj
    procedure DeleteObj; override;

    function GetXML: string; override;
{$IFDEF USE_IXMLDBMODELType}
    procedure SetXML(theXMLNote: IXMLNOTEType);
{$ENDIF}
    procedure SetXML2(theXMLParser: TXmlParser);

    function GetNoteText: string;
    procedure SetNoteText(txt: string);
  private
    { Private declarations }
    NoteText: TStringList;
  public
    { Public declarations }
  end;


  // -----------------------------------------------
  // Declaration of the EER Image Object

  TEERImage = class(TEERObj)
    constructor Create(AOwner: TComponent; TheName: string); reintroduce; overload;
    destructor Destroy; override;

    procedure ShowEditor(Sender: TObject); override;

    procedure DoPaint(Sender: TObject); override;

    //Paint the Object
    procedure PaintObj2Canvas(theCanvas: TCanvas; xo, yo: integer); override;

    procedure RefreshObj(Sender: TObject = nil); override;