home *** CD-ROM | disk | FTP | other *** search
/ CD Actual Thematic 25: Programming / pc_actual_25.iso / Delphi / Duck Report / _SETUP.1 / DQLinkCtrl.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1999-10-23  |  22.6 KB  |  836 lines
  1. Unit DQLinkCtrl;
  2.  
  3. {.$DEFINE MAKE_DQUERY}
  4. Interface
  5.  
  6. Uses
  7.     Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms,
  8.   Dialogs, StdCtrls, DQQField;
  9. //  StdUtil, DRBase
  10. Const
  11.     LINE_BOX    = 5;
  12. Type
  13.     PointPtr            = ^TPoint;
  14.     TQueryLinkType    = (tltEqual, tltNotEqual, tltGreater, tltLess,
  15.                           tltGreaterEqual, tltLessEqual, tltLeftOuter,
  16.                     tltRightOuter);
  17.     RQueryLinkPtr    = ^RQueryLink;
  18.     RQueryLink        = Packed  Record
  19.       QueryLinkType:    TQueryLinkType;
  20.         MAlias:        String[255];
  21.         MField:        String[255];
  22.         DAlias:        String[255];
  23.      DField:        String[255];
  24.  
  25.         { Not Uses }
  26.      MCtrl:        TControl;
  27.      DCtrl:        TControl;
  28.      LineList:    TList;
  29.      bSelect:        Boolean;
  30.     End;
  31.     TSelectLinkEvent = Procedure (Sender: TObject; bSelect: Boolean) Of Object;
  32.     { ---------- TDQLinkCtrl ---------- }
  33.     TDQLinkCtrl = Class (TScrollBox)
  34.     Private
  35.   Protected
  36.       FCanvas:                    TCanvas;
  37.      FTableLink:                TList;
  38.  
  39.      FOnNewLink:                TNotifyEvent;
  40.      FOnSelectLinkEvent:    TSelectLinkEvent;
  41.  
  42.      FFieldHeight:    Integer;
  43.      FFieldWidth:    Integer;
  44.      iSpaceX:            Integer;
  45.      iSpaceY:            Integer;
  46.      FLineSelectColor:    TColor;
  47.      FLineColor:            TColor;
  48.      Function        AddField (StDataBase, StTable, StAlias: String;
  49.                      Fields: TStrings): Boolean;
  50.      Procedure    FieldReSize (Sender: TObject);
  51.      Procedure    FieldAddLink (Sender: TObject);
  52.      Procedure    CreateLine;
  53.      Procedure    PaintLineLink (LinkPtr: RQueryLinkPtr);
  54.         Function        FindLinkSelect: Integer;
  55.         Procedure    DBlClickLink (iNo: Integer);
  56.      Procedure    MouseDown (Button: TMouseButton; Shift: TShiftState;
  57.                         X, Y: Integer); Override;
  58.      Function        FindQueryField (StAlias: String): TQueryField;
  59.  
  60.      Procedure    WMPaint (var Message: TWMPaint); message WM_PAINT;
  61.         Procedure    PaintWindow(DC: HDC); override;
  62.      Procedure    Paint; virtual;
  63.      Procedure    DestroyPoint (LineList: TList);
  64.      Procedure    ClearTableLink;
  65.     Public
  66.         Constructor    Create (AOwner: TComponent); Override;
  67.         Destructor    Destroy; Override;
  68.  
  69.      Function        AddTable (StDataBase, StTable, StAlias: String;
  70.                      Fields: TStrings): Boolean;
  71.      Function        AddTableExt (StDataBase, StTable, StAlias: String): Boolean;
  72.      Procedure    ReInitTableLink;
  73.  
  74.      Procedure    DeleteLineActive;
  75.      Procedure    Arrange;
  76.      Procedure    OptionLineActive;
  77.      Procedure    ClearAllCtrl;
  78.      Procedure    DeleteControl (StAlias: String);
  79.      Procedure    GetFieldWithAlias (StAlias: String; Items: TStrings);
  80.      Function        GetLink (iCount: Integer; Var QueryLink: RQueryLink): Boolean;
  81.      Procedure    AddLink (QueryLink: RQueryLink);
  82.  
  83.      Property        Canvas:        TCanvas Read FCanvas;
  84.      Property        TableLink:    TList Read FTableLink;
  85.  
  86.     Published
  87.      Property        OnNewLink:            TNotifyEvent Read FOnNewLink Write FOnNewLink;
  88.      Property        OnSelectLinkEvent:    TSelectLinkEvent Read FOnSelectLinkEvent Write FOnSelectLinkEvent;
  89.      Property        FieldHeight:    Integer Read FFieldHeight Write FFieldHeight;
  90.      Property        FieldWidth:        Integer Read FFieldWidth Write FFieldWidth;
  91.  
  92.      Property        LineSelectColor:    TColor Read FLineSelectColor Write FLineSelectColor
  93.                                              Default clWhite;
  94.      Property        LineColor:            TColor Read FLineColor Write FLineColor
  95.                                              Default clBlack;
  96.     End;
  97.  
  98. {$IFDEF MAKE_DQUERY}
  99. Procedure    Register;
  100. {$ENDIF}
  101. Function    Max (lV1, lV2: LongInt): Integer;
  102. Function    Min (lV1, lV2: LongInt): Integer;
  103. Function    PointInRect (x, y: Integer; Rc: TRect): Boolean;
  104.  
  105. Implementation
  106. Uses DQLinkOp;
  107. {$IFDEF MAKE_DQUERY}
  108. Procedure Register;
  109. Begin
  110.     RegisterComponents ('DuckTech', [TDQLinkCtrl]);
  111. End;
  112. {$ENDIF}
  113. Function    Max (lV1, lV2: LongInt): Integer;
  114. Begin
  115.     if lV1 > lV2 Then
  116.       Result    := lV1
  117.   Else
  118.       Result    := lV2;
  119. End;
  120. Function    Min (lV1, lV2: LongInt): Integer;
  121. Begin
  122.     if lV1 < lV2 Then
  123.       Result    := lV1
  124.   Else
  125.       Result    := lV2;
  126. End;
  127. Function    PointInRect (x, y: Integer; Rc: TRect): Boolean;
  128. Begin
  129.     Result    := PtInRect (Rc, Point (x, y));
  130. End;
  131. { ---------- TDQLinkCtrl ---------- }
  132. Constructor TDQLinkCtrl.Create (AOwner: TComponent);
  133. Begin
  134.     inherited Create (AOwner);
  135.   FCanvas := TControlCanvas.Create;
  136.     TControlCanvas(FCanvas).Control := Self;
  137.  
  138.   FFieldHeight    := D_HEIGHT;
  139.   FFieldWidth        := D_WIDTH;
  140.   iSpaceY            := 10;
  141.   iSpaceX            := 20;
  142.   FTableLink        := TList.Create;
  143.  
  144.   FLineSelectColor    := clWhite;
  145.     FLineColor            := clBlack;
  146. End;
  147. Destructor TDQLinkCtrl.Destroy;
  148. Begin
  149.     ClearTableLink;
  150.     FTableLink.Free;
  151.   FCanvas.Free;
  152.     inherited Destroy;
  153. End;
  154. Procedure TDQLinkCtrl.ClearTableLink;
  155. Var
  156.     i:                Integer;
  157.     LinkPtr:        RQueryLinkPtr;
  158. Begin
  159.   For i := 0 To FTableLink.Count - 1 Do
  160.   Begin
  161.       LinkPtr    := RQueryLinkPtr (FTableLink.Items[i]);
  162.      FreeMem (LinkPtr);
  163.   End;
  164.   FTableLink.Clear;
  165. End;
  166. Procedure TDQLinkCtrl.DestroyPoint (LineList: TList);
  167. Var
  168.     j:                Integer;
  169.   PPtr:            PointPtr;
  170. Begin
  171.     if LineList = nil Then Exit;
  172.   Try
  173.         For j := 0 To LineList.Count - 1 Do
  174.         Begin
  175.             PPtr    := PointPtr (LineList.Items[j]);
  176.          if PPtr <> nil Then
  177.                 FreeMem (PPtr, Sizeof (TPoint));
  178.         End;
  179.   Finally
  180.       LineList.Clear;
  181.   End;
  182. End;
  183. Function TDQLinkCtrl.AddTable (StDataBase, StTable, StAlias: String;
  184.                      Fields: TStrings): Boolean;
  185. Begin
  186.     Result    := AddField (StDataBase, StTable, StAlias, Fields);
  187.   if Result Then
  188.       FieldReSize (nil);
  189. End;
  190. Function TDQLinkCtrl.AddTableExt (StDataBase, StTable, StAlias: String): Boolean;
  191. Begin
  192.     Result    := AddField (StDataBase, StTable, StAlias, nil);
  193.   if Result Then
  194.       FieldReSize (nil);
  195. End;
  196. Function TDQLinkCtrl.AddField (StDataBase, StTable, StAlias: String;
  197.                      Fields: TStrings): Boolean;
  198. Var
  199.     i:                Integer;
  200.   bLoop:        Boolean;
  201.   Rc:            TRect;
  202.   RcParent:    TRect;
  203.   RcC:            TRect;
  204.   QField:        TQueryField;
  205. Begin
  206.     RcParent    := ClientRect;
  207.   SetRect (Rc, 0, iSpaceY, 0, 0);
  208.     bLoop        := TRUE;
  209.     While bLoop Do
  210.     Begin
  211.       bLoop        := FALSE;
  212.       if (Rc.Right + FFieldWidth + iSpaceX) > RcParent.Right Then
  213.      Begin
  214.          Rc.Left    := iSpaceX;
  215.          Rc.Top    := Rc.Bottom + iSpaceY;
  216.      End
  217.      Else
  218.      Begin
  219.          if Rc.Left = 0 Then
  220.             Rc.Left    := iSpaceX
  221.         Else
  222.              Rc.Left    := Rc.Right + iSpaceX;
  223.      End;
  224.         Rc.Right        := Rc.Left + FFieldWidth;
  225.         Rc.Bottom    := Rc.Top + FFieldHeight;
  226.      For i := 0 To ControlCount - 1 Do
  227.         Begin
  228.           if Controls[i] is TQueryField Then
  229.          Begin
  230.              QField        := TQueryField (Controls[i]);
  231.            RcC.Left        := QField.Left;
  232.            RcC.Top        := QField.Top;
  233.            RcC.Right    := RcC.Left + QField.Width;
  234.            RcC.Bottom    := RcC.Top + QField.Height;
  235.            if (Rc.Left >= RcC.Left) and (Rc.Left <= RcC.Right) or
  236.                (Rc.Right >= RcC.Left) and (Rc.Right <= RcC.Right) Then
  237.            Begin
  238.                if (Rc.Top >= RcC.Top) and (Rc.Top <= RcC.Bottom) or
  239.                   (Rc.Bottom >= RcC.Top) and (Rc.Bottom <= RcC.Bottom) Then
  240.               Begin
  241.                   bLoop    := TRUE;
  242.                   break;
  243.               End;
  244.            End;
  245.             End;
  246.       End;
  247.     End;
  248.     QField            := TQueryField.Create (Self);
  249.   QField.Font.Assign (Self.Font);
  250.     QField.Parent        := Self;
  251.     QField.Caption        := StAlias;
  252.   QField.OnAddLink    := FieldAddLink;
  253.   QField.OnResize    := FieldReSize;
  254.     QField.Top            := Rc.Top;
  255.   QField.Height        := FFieldHeight;
  256.   QField.Width        := FFieldWidth;
  257.   QField.Left            := Rc.Left;
  258.   QField.StartMove    := TRUE;
  259.   Result                := TRUE;
  260.   Try
  261.          if Fields = nil Then
  262.           QField.SetDataBase (StDataBase, StTable)
  263.      else
  264.          QField.SetDataBaseField (StDataBase, StTable, Fields);
  265.   Except
  266.       QField.Free;
  267.      Result    := FALSE;
  268.      Exit;
  269.   End;
  270.     FieldReSize (nil);
  271.     QField.Visible    := TRUE;
  272. End;
  273. Procedure TDQLinkCtrl.FieldReSize (Sender: TObject);
  274. Var
  275.     RcParent:    TRect;
  276.   iMaxHeight:    Integer;
  277.   iMaxWidth:    Integer;
  278.   i, w, h:            Integer;
  279.   QField:        TQueryField;
  280. Begin
  281.     iMaxHeight    := 0;
  282.   iMaxWidth    := 0;
  283.     For i := 0 To ControlCount - 1 Do
  284.   Begin
  285.       if Controls[i] is TQueryField Then
  286.      Begin
  287.          QField    := TQueryField (Controls[i]);
  288.         if QField.StartMove = FALSE Then
  289.         Begin
  290.             Continue;
  291.         End;
  292.         h            := QField.Top + QField.Height;
  293.         if h > iMaxHeight Then
  294.                 iMaxHeight    := h;
  295.         w            := QField.Left + QField.Width;
  296.         if w > iMaxWidth Then
  297.             iMaxWidth    := w;
  298.      End;
  299.   End;
  300.     VertScrollBar.Range        := iMaxHeight;
  301.     HorzScrollBar.Range        := iMaxWidth;
  302.   CreateLine;
  303.     Invalidate;
  304. End;
  305. Function TDQLinkCtrl.FindQueryField (StAlias: String): TQueryField;
  306. Var
  307.   QField:    TQueryField;
  308.   i:            Integer;
  309. Begin
  310.     Result    := nil;
  311.     For i := 0 To ControlCount - 1 Do
  312.   Begin
  313.       if not (Controls[i] is TQueryField) Then Continue;
  314.      QField    := TQueryField (Controls[i]);
  315.      if QField.Caption = StAlias Then
  316.      Begin
  317.          Result    := QField;
  318.         Break;
  319.      End;
  320.   End;
  321. End;
  322. Procedure TDQLinkCtrl.FieldAddLink (Sender: TObject);
  323. Var
  324.     LinkPtr:        RQueryLinkPtr;
  325.   QueryField:    TQueryField;
  326. Begin
  327.     if (Sender is TQueryField) = FALSE Then Exit;
  328.   QueryField    := TQueryField (Sender);
  329.     GetMem (Pointer (LinkPtr), Sizeof (RQueryLink));
  330.   FillChar (LinkPtr^, Sizeof (RQueryLink), $0);
  331.     With QueryField Do
  332.   Begin
  333.         LinkPtr^.MAlias    := QueryField.MAlias;
  334.       LinkPtr^.MField    := QueryField.MField;
  335.         LinkPtr^.MCtrl        := MCtrl;
  336.  
  337.      LinkPtr^.DAlias    := QueryField.DAlias;
  338.       LinkPtr^.DField    := QueryField.DField;
  339.       LinkPtr^.DCtrl        := DCtrl;
  340.   End;
  341.     FTableLink.Add (LinkPtr);
  342.   CreateLine;
  343.     Invalidate;
  344. End;
  345. Procedure TDQLinkCtrl.CreateLine;
  346. Var
  347.     i:                    Integer;
  348.     LinkPtr:            RQueryLinkPtr;
  349.     MiTop, DiTop:    Integer;
  350.     MQF, DQF:        TQueryField;
  351.   MRc, DRc:        TRect;
  352.   PPtr:                PointPtr;
  353.   iMax, iMin:        Integer;
  354.   x, y:                Integer;
  355. Begin
  356.     For i := 0 To FTableLink.Count - 1 Do
  357.   Begin
  358.         LinkPtr    := RQueryLinkPtr (FTableLink.Items[i]);
  359.      if (LinkPtr^.MCtrl <> nil) and (LinkPtr^.DCtrl <> nil) Then
  360.         Begin
  361.          if LinkPtr^.LineList <> nil Then
  362.         Begin
  363.             DestroyPoint (LinkPtr^.LineList);
  364.            LinkPtr^.LineList.Free;
  365.         End;
  366.         LinkPtr^.LineList    := TList.Create;
  367.          MQF        := TQueryField (LinkPtr^.MCtrl);
  368.         DQF        := TQueryField (LinkPtr^.DCtrl);
  369.  
  370.         MRc        := MQF.BoundsRect;
  371.         Inc (MRc.Right, LINE_BOX);
  372.         DRc        := DQF.BoundsRect;
  373.         Dec (DRc.Left, LINE_BOX);
  374.             MiTop        := MQF.GetPosition (LinkPtr^.MField);
  375.         if MiTop > MRc.Bottom Then
  376.                 MiTop    := MRc.Bottom - 2;
  377.             DiTop        := DQF.GetPosition (LinkPtr^.DField);
  378.         if DiTop > DRc.Bottom Then
  379.                 DiTop    := DRc.Bottom - 2;
  380.  
  381.         iMax        := Max (MRc.Right, DRc.Left);
  382.         iMin        := Min (MRc.Right, DRc.Left);
  383.         x            := iMin + ((iMax - iMin) div 2);
  384.         GetMem (Pointer (PPtr), Sizeof (TPoint));
  385.         FillChar (PPtr^, Sizeof (TPoint), $0);
  386.         PPtr^.x    := MRc.Right;
  387.         PPtr^.y    := MiTop;
  388.         LinkPtr^.LineList.Add (PPtr);
  389.  
  390.         GetMem (Pointer (PPtr), Sizeof (TPoint));
  391.         FillChar (PPtr^, Sizeof (TPoint), $0);
  392.         PPtr^.x    := x;
  393.         PPtr^.y    := MiTop;
  394.             LinkPtr^.LineList.Add (PPtr);
  395.  
  396.         GetMem (Pointer (PPtr), Sizeof (TPoint));
  397.         FillChar (PPtr^, Sizeof (TPoint), $0);
  398.         PPtr^.x    := x;
  399.         PPtr^.y    := DiTop;
  400.         LinkPtr^.LineList.Add (PPtr);
  401.  
  402.         GetMem (Pointer (PPtr), Sizeof (TPoint));
  403.         FillChar (PPtr^, Sizeof (TPoint), $0);
  404.         PPtr^.x    := DRc.Left;
  405.         PPtr^.y    := DiTop;
  406.         LinkPtr^.LineList.Add (PPtr);
  407.      End;
  408.     End;
  409. End;
  410. Procedure TDQLinkCtrl.WMPaint(var Message: TWMPaint);
  411. Begin
  412.     PaintHandler(Message);
  413. End;
  414. Procedure TDQLinkCtrl.PaintWindow(DC: HDC);
  415. Begin
  416.     {$IFDEF WIN32}
  417.     FCanvas.Lock;
  418.   {$ENDIF}
  419.     try
  420.         FCanvas.Handle := DC;
  421.         try
  422.             Paint;
  423.         finally
  424.             FCanvas.Handle := 0;
  425.         End;
  426.     finally
  427.   {$IFDEF WIN32}
  428.     FCanvas.Unlock;
  429.   {$ENDIF}
  430.     End;
  431. End;
  432. Procedure TDQLinkCtrl.Paint;
  433. Var
  434.     i:                Integer;
  435.   LinkPtr:        RQueryLinkPtr;
  436. Begin
  437.   For i := 0 To FTableLink.Count - 1 Do
  438.   Begin
  439.         LinkPtr    := RQueryLinkPtr (FTableLink.Items[i]);
  440.      PaintLineLink (LinkPtr);
  441.     End;
  442. End;
  443. Procedure TDQLinkCtrl.PaintLineLink (LinkPtr: RQueryLinkPtr);
  444. Var
  445.     j:                Integer;
  446.   PPtr1:        PointPtr;
  447.   PPtr2:        PointPtr;
  448.   Rc:            TRect;
  449.   x, y:            Integer;
  450. Begin
  451.     if LinkPtr^.LineList = nil Then Exit;
  452.   y    := VertScrollBar.Position;
  453.     x    := HorzScrollBar.Position;
  454.   if LinkPtr^.bSelect Then
  455.   Begin
  456.         Canvas.Brush.Color    := FLineSelectColor;
  457.         Canvas.Pen.Color        := FLineSelectColor;
  458.   End
  459.   Else
  460.   Begin
  461.         Canvas.Brush.Color    := FLineColor;
  462.         Canvas.Pen.Color        := FLineColor;
  463.   End;
  464.     For j := 1 To LinkPtr^.LineList.Count - 1 Do
  465.     Begin
  466.         PPtr1    := PointPtr (LinkPtr^.LineList.Items[j - 1]);
  467.         PPtr2    := PointPtr (LinkPtr^.LineList.Items[j]);
  468.         With Canvas Do
  469.         Begin
  470.             if j = 1 Then
  471.             Begin
  472.                 SetRect (Rc, PPtr1^.x - LINE_BOX,
  473.                PPtr1^.y - (LINE_BOX div 2),
  474.               PPtr1^.x, PPtr1^.y + (LINE_BOX div 2) + 1);
  475.            Inc (Rc.Left);
  476.            Dec (Rc.right);
  477.            Rc        := Rect (Rc.Left - x, Rc.Top - y,
  478.                        Rc.Right - x, Rc.Bottom - y); 
  479.            FillRect (Rc);
  480.         End;
  481.         if j = (LinkPtr^.LineList.Count - 1) Then
  482.         Begin
  483.             SetRect (Rc, PPtr2^.x,
  484.                PPtr2^.y - (LINE_BOX div 2),
  485.               PPtr2^.x + LINE_BOX,
  486.               PPtr2^.y + (LINE_BOX div 2) + 1);
  487.            Inc (Rc.Left); Dec (Rc.Top); Inc (Rc.Bottom);
  488.             MoveTo (Rc.Left - x, Rc.Top - y);
  489.            LineTo (Rc.Left - x, Rc.Bottom - y);
  490.            MoveTo (Rc.Left - x + 1, Rc.Top - y + 1);
  491.            LineTo (Rc.Left - x + 1, Rc.Bottom - y - 1);
  492.  
  493.            MoveTo (Rc.Left - x + 2, Rc.Top - y + 2);
  494.            LineTo (Rc.Left - x + 2, Rc.Bottom - y - 2);
  495.  
  496.            MoveTo (Rc.Left - x + 3, Rc.Top - y + 3);
  497.            LineTo (Rc.Left - x + 3, Rc.Top - y + 4);
  498.         End;
  499.         MoveTo (PPtr1^.x  - x, PPtr1^.y - y);
  500.         LineTo (PPtr2^.x  - x, PPtr2^.y - y);
  501.      End;
  502.     End;
  503. End;
  504. Procedure TDQLinkCtrl.MouseDown (Button: TMouseButton; Shift: TShiftState;
  505.                         X, Y: Integer);
  506. Var
  507.     j, i:            Integer;
  508.   LinkPtr:        RQueryLinkPtr;
  509.   SelectLinkPtr:    RQueryLinkPtr;
  510.   PPtr1:        PointPtr;
  511.   PPtr2:        PointPtr;
  512.   Rc:            TRect;
  513.   iTemp:        Integer;
  514.   bFound:        Boolean;
  515.   iFind:        Integer;
  516. Begin
  517.   iTemp                    := (LINE_BOX div 2);
  518.   bFound                := FALSE;
  519.   SelectLinkPtr        := nil;
  520.   For i := 0 To FTableLink.Count - 1 Do
  521.   Begin
  522.         LinkPtr    := RQueryLinkPtr (FTableLink.Items[i]);
  523.      if LinkPtr^.LineList = nil Then Continue;
  524.      For j := 1 To LinkPtr^.LineList.Count - 1 Do
  525.         Begin
  526.             PPtr1    := PointPtr (LinkPtr^.LineList.Items[j - 1]);
  527.             PPtr2    := PointPtr (LinkPtr^.LineList.Items[j]);
  528.         if j = 1 Then
  529.         Begin
  530.             SetRect (Rc, PPtr1^.x - LINE_BOX,
  531.                PPtr1^.y - iTemp,
  532.               PPtr2^.x, PPtr1^.y + iTemp + 1);
  533.            Inc (Rc.Left);
  534.         End
  535.         Else
  536.             if j = LinkPtr^.LineList.Count - 1 Then
  537.            Begin
  538.                SetRect (Rc, PPtr1^.x,
  539.                    PPtr1^.y - iTemp,
  540.                   PPtr2^.x + LINE_BOX, PPtr1^.y + iTemp + 1);
  541.            End
  542.            Else
  543.            Begin
  544.                SetRect (Rc, PPtr1^.x - iTemp,
  545.                    PPtr1^.y, PPtr1^.x + iTemp + 1, PPtr2^.y);
  546.            End;
  547.         if PointInRect (x, y, Rc) Then
  548.         Begin
  549.             iFind                := FindLinkSelect;
  550.            if iFind >= 0 Then
  551.                 SelectLinkPtr        := RQueryLinkPtr (FTableLink.Items[iFind])
  552.            Else
  553.                SelectLinkPtr        := nil;
  554.            if (SelectLinkPtr <> nil) and
  555.                (SelectLinkPtr <> LinkPtr) Then
  556.            Begin
  557.                SelectLinkPtr^.bSelect    := FALSE;
  558.               PaintLineLink (SelectLinkPtr);
  559.            End;
  560.            if (ssDouble in Shift) and (LinkPtr^.bSelect = TRUE) Then
  561.                 Begin
  562.               DBlClickLink (iFind);
  563.                     Exit;
  564.               End;
  565.             LinkPtr^.bSelect    := not LinkPtr^.bSelect;
  566.             PaintLineLink (LinkPtr);
  567.            bFound    := TRUE;
  568.         End;
  569.      End;
  570.     End;
  571.   if not bFound Then
  572.   Begin
  573.      if SelectLinkPtr <> nil Then
  574.      Begin
  575.          SelectLinkPtr^.bSelect    := FALSE;
  576.         PaintLineLink (SelectLinkPtr);
  577.      End;
  578.   End
  579.   Else
  580.       if Assigned (FOnNewLink) Then
  581.           FOnNewLink (Self);
  582.   if Assigned (FOnSelectLinkEvent) Then
  583.         FOnSelectLinkEvent (Self,  bFound);
  584. End;
  585. Function TDQLinkCtrl.FindLinkSelect: Integer;
  586. Var
  587.     i:                Integer;
  588.     LinkPtr:        RQueryLinkPtr;
  589. Begin
  590.   Result    := -1;
  591.   For i := 0 To FTableLink.Count - 1 Do
  592.   Begin
  593.         LinkPtr    := RQueryLinkPtr (FTableLink.Items[i]);
  594.      if LinkPtr^.bSelect Then
  595.      Begin
  596.          Result    := i;
  597.         Break;
  598.      End;
  599.     End;
  600. End;
  601. Procedure TDQLinkCtrl.DeleteLineActive;
  602. Var
  603.     LinkPtr:        RQueryLinkPtr;
  604.   iFind:        Integer;
  605.   QueryField:    TQueryField;
  606. Begin
  607.   iFind    := FindLinkSelect;
  608.     if iFind >= 0 Then
  609.         LinkPtr    := RQueryLinkPtr (FTableLink.Items[iFind])
  610.   Else
  611.       LinkPtr    := nil;
  612.     if LinkPtr = nil Then Exit;
  613.  
  614.   if LinkPtr^.MCtrl <> nil Then
  615.     Begin
  616.       QueryField    := TQueryField (LinkPtr^.MCtrl);
  617.      QueryField.ListBox.SetSelectIndex (QueryField.ListBox.Items.IndexOf (LinkPtr^.MField), FALSE);
  618.   End;
  619.     if LinkPtr^.DCtrl <> nil Then
  620.   Begin
  621.       QueryField    := TQueryField (LinkPtr^.DCtrl);
  622.      QueryField.ListBox.SetSelectIndex (QueryField.ListBox.Items.IndexOf (LinkPtr^.DField), FALSE);
  623.     End;
  624.  
  625.   iFind        := FTableLink.IndexOf (LinkPtr);
  626.   if iFind < 0 Then Exit;
  627.   FreeMem (LinkPtr, Sizeof (RQueryLink));
  628.   FTableLink.Delete (iFind);
  629.     Invalidate;
  630.   if Assigned (FOnSelectLinkEvent) Then
  631.         FOnSelectLinkEvent (Self,  FALSE);
  632. End;
  633. Procedure TDQLinkCtrl.DBlClickLink (iNo: Integer);
  634. Begin
  635.     if Assigned (FOnSelectLinkEvent) Then
  636.         FOnSelectLinkEvent (Self,  TRUE);
  637.     FormDQLinkOption    := TFormDQLinkOption.Create (Self);
  638.   FormDQLinkOption.TableLink            := FTableLink;
  639.     FormDQLinkOption.LBLink.ItemIndex    := iNo;
  640.   FormDQLinkOption.LBLinkClick (nil);
  641.   FormDQLinkOption.ShowModal;
  642.   FormDQLinkOption.Free;
  643. End;
  644. Procedure TDQLinkCtrl.OptionLineActive;
  645. Var
  646.     iFind:        Integer;
  647. Begin
  648.     iFind    := FindLinkSelect;
  649.     DBlClickLink (iFind);
  650. End;
  651. Procedure TDQLinkCtrl.ClearAllCtrl;
  652. Var
  653.     i:            Integer;
  654.   LinkPtr:    RQueryLinkPtr;
  655. Begin
  656.     For i := ControlCount - 1 DownTo 0 Do
  657.     Begin
  658.         if Controls[i] is TQueryField Then
  659.          Controls[i].Free;
  660.     End;
  661.     For i := 0 To FTableLink.Count - 1 Do
  662.   Begin
  663.       LinkPtr    := RQueryLinkPtr (FTableLink.Items[i]);
  664.      LinkPtr^.MCtrl        := nil;
  665.       LinkPtr^.DCtrl        := nil;
  666.      if LinkPtr^.LineList <> nil Then
  667.             DestroyPoint (LinkPtr^.LineList);
  668.      LinkPtr^.LineList    := nil;
  669.   End;
  670. End;
  671. Procedure TDQLinkCtrl.GetFieldWithAlias (StAlias: String; Items: TStrings);
  672. Var
  673.     QueryField:    TQueryField;
  674. Begin
  675.     QueryField    := FindQueryField (StAlias);
  676.   Items.Clear;
  677.     if QueryField = nil then Exit;
  678.     QueryField.GetField (Items);
  679. End;
  680. Procedure TDQLinkCtrl.DeleteControl (StAlias: String);
  681. Var
  682.     i:                Integer;
  683.     LinkPtr:        RQueryLinkPtr;
  684.   QueryField:    TQueryField;
  685. Begin
  686.     For i := ControlCount - 1 DownTo 0 Do
  687.     Begin
  688.         if Controls[i] is TQueryField Then
  689.         Begin
  690.          QueryField    := TQueryField (Controls[i]);
  691.             if QueryField.Caption = StAlias Then
  692.         Begin
  693.             QueryField.Free;
  694.            Break;
  695.         End;
  696.         End;
  697.     End;
  698.   i    := 0;
  699.   While i < FTableLink.Count Do
  700.   Begin
  701.       LinkPtr    := RQueryLinkPtr (FTableLink.Items[i]);
  702.      if (LinkPtr^.MAlias = StAlias) or
  703.           (LinkPtr^.DAlias = StAlias) Then
  704.      Begin
  705.          if LinkPtr^.MCtrl <> nil Then
  706.             Begin
  707.               QueryField    := TQueryField (LinkPtr^.MCtrl);
  708.              QueryField.ListBox.SetSelectIndex (QueryField.ListBox.Items.IndexOf (LinkPtr^.MField), FALSE);
  709.           End;
  710.             if LinkPtr^.DCtrl <> nil Then
  711.           Begin
  712.               QueryField    := TQueryField (LinkPtr^.DCtrl);
  713.              QueryField.ListBox.SetSelectIndex (QueryField.ListBox.Items.IndexOf (LinkPtr^.DField), FALSE);
  714.             End;
  715.         
  716.          DestroyPoint (LinkPtr^.LineList);
  717.         LinkPtr^.LineList    := nil;
  718.         FreeMem (LinkPtr);
  719.         FTableLink.Delete (i);
  720.      End
  721.      Else
  722.          Inc (i);
  723.   End;
  724. End;
  725. Procedure TDQLinkCtrl.Arrange;
  726. Var
  727.     RcParent:    TRect;
  728.   QField:        TQueryField;
  729.   x, y:            Integer;
  730.   i:                Integer;
  731. Begin
  732.   x            := 0;
  733.   y            := iSpaceY;
  734.   RcParent    := ClientRect;
  735.   VertScrollBar.Range        := 0;
  736.   VertScrollBar.Position    := 0;
  737.     HorzScrollBar.Range        := 0;
  738.   HorzScrollBar.Position    := 0;
  739.   RcParent    := ClientRect;
  740.  
  741.     For i := 0 To ControlCount - 1 Do
  742.     Begin
  743.         if Controls[i] is TQueryField Then
  744.         Begin
  745.          QField                := TQueryField (Controls[i]);
  746.         QField.StartMove    := FALSE;
  747.         QField.Visible        := FALSE;
  748.           QField.Height        := FFieldHeight;
  749.           QField.Width        := FFieldWidth;
  750.         if (x + iSpaceX + FFieldWidth) > RcParent.Right Then
  751.         Begin
  752.             x    := 0;
  753.             y    := y + iSpaceY + FFieldHeight;
  754.         End;
  755.  
  756.         QField.Top            := y;
  757.           QField.Left            := x + iSpaceX;
  758.         QField.Visible        := TRUE;
  759.         QField.StartMove    := TRUE;
  760.         QField.SetListBoxSize;
  761.  
  762.         x    := QField.Left + FFieldWidth;
  763.         End;
  764.     End;
  765.   VertScrollBar.Range        := y + iSpaceY + FFieldHeight;
  766.     CreateLine;
  767.     Invalidate;
  768. End;
  769. Function TDQLinkCtrl.GetLink (iCount: Integer; Var QueryLink: RQueryLink): Boolean;
  770. Var
  771.     LinkPtr:    RQueryLinkPtr;
  772. Begin
  773.     Result    := FALSE;
  774.   if iCount >= FTableLink.Count Then Exit;
  775.   LinkPtr    := RQueryLinkPtr (FTableLink.Items[iCount]);
  776.     QueryLink.MAlias        := LinkPtr^.MAlias;
  777.     QueryLink.MField        := LinkPtr^.MField;
  778.     QueryLink.QueryLinkType    := LinkPtr^.QueryLinkType;
  779.     QueryLink.DAlias        := LinkPtr^.DAlias;
  780.     QueryLink.DField        := LinkPtr^.DField;
  781.  
  782.   Result    := TRUE;
  783. End;
  784. Procedure TDQLinkCtrl.AddLink (QueryLink: RQueryLink);
  785. Var
  786.     LinkPtr:        RQueryLinkPtr;
  787.   QField:        TQueryField;
  788.   i:                Integer;
  789. Begin
  790.     GetMem (Pointer (LinkPtr), Sizeof (RQueryLink));
  791.   FillChar (LinkPtr^, Sizeof (RQueryLink), $0);
  792.     LinkPtr^.MAlias    := QueryLink.MAlias;
  793.     LinkPtr^.MField    := QueryLink.MField;
  794.     LinkPtr^.DAlias    := QueryLink.DAlias;
  795.     LinkPtr^.DField    := QueryLink.DField;
  796.   LinkPtr^.QueryLinkType    := QueryLink.QueryLinkType;
  797.  
  798.   For i := 0 To ControlCount - 1 Do
  799.   Begin
  800.       if Controls[i] is TQueryField Then
  801.      Begin
  802.          QField    := TQueryField (Controls[i]);
  803.         if LinkPtr^.MAlias = QField.Caption Then
  804.                 LinkPtr^.MCtrl    := Controls[i];
  805.             if LinkPtr^.DAlias = QField.Caption Then
  806.                 LinkPtr^.DCtrl    := Controls[i];
  807.      End;
  808.   End;
  809.     FTableLink.Add (LinkPtr);
  810. End;
  811. Procedure TDQLinkCtrl.ReInitTableLink;
  812. Var
  813.     i:                Integer;
  814.   LinkPtr:        RQueryLinkPtr;
  815.   QueryField:    TQueryField;
  816. Begin
  817.     CreateLine;
  818.   For i := 0 To FTableLink.Count - 1 Do
  819.   Begin
  820.         LinkPtr    := RQueryLinkPtr (FTableLink.Items[i]);
  821.      if LinkPtr^.MCtrl <> nil Then
  822.         Begin
  823.          QueryField    := TQueryField (LinkPtr^.MCtrl);
  824.             QueryField.ListBox.SetSelectIndex (QueryField.ListBox.Items.IndexOf (LinkPtr^.MField), TRUE);
  825.      End;
  826.         if LinkPtr^.DCtrl <> nil Then
  827.         Begin
  828.         QueryField    := TQueryField (LinkPtr^.DCtrl);
  829.             QueryField.ListBox.SetSelectIndex (QueryField.ListBox.Items.IndexOf (LinkPtr^.DField), TRUE);
  830.      End;
  831.     End;
  832.   Invalidate;
  833. End;
  834. End.
  835.  
  836.