home *** CD-ROM | disk | FTP | other *** search
/ Chip 2001 October / Chip_2001-10_cd1.bin / zkuste / delphi / kolekce / d6 / FRCLX.ZIP / SOURCE / DBX / FR_DBXMd.pas < prev    next >
Pascal/Delphi Source File  |  2001-07-08  |  4KB  |  167 lines
  1.  
  2. {******************************************}
  3. {                                          }
  4. {   FastReport CLX v2.4 - DBX components   }
  5. {        Master/detail definition          }
  6. {                                          }
  7. { Copyright (c) 1998-2001 by Tzyganenko A. }
  8. {                                          }
  9. {******************************************}
  10.  
  11. unit FR_DBXMd;
  12.  
  13. interface
  14.  
  15. {$I FR.inc}
  16.  
  17. uses
  18.   Types, SysUtils, Classes, QGraphics, QControls, QForms, QDialogs,
  19.   DB, DBXpress, SqlExpr, QExtCtrls, QStdCtrls, FR_Const;
  20.  
  21. type
  22.   TfrDBXFieldsLinkForm = class(TForm)
  23.     DetailL: TListBox;
  24.     MasterL: TListBox;
  25.     Label1: TLabel;
  26.     Label2: TLabel;
  27.     AddB: TButton;
  28.     JoinL: TListBox;
  29.     Label3: TLabel;
  30.     ClearB: TButton;
  31.     Bevel1: TBevel;
  32.     OkB: TButton;
  33.     CancelB: TButton;
  34.     procedure FormShow(Sender: TObject);
  35.     procedure FormHide(Sender: TObject);
  36.     procedure ClearBClick(Sender: TObject);
  37.     procedure DetailLDrawItem(Control: TWinControl; Index: Integer;
  38.       Rect: TRect; State: TOwnerDrawState);
  39.     procedure DetailLClick(Sender: TObject);
  40.     procedure MasterLClick(Sender: TObject);
  41.     procedure AddBClick(Sender: TObject);
  42.     procedure FormCreate(Sender: TObject);
  43.   private
  44.     { Private declarations }
  45.     FMasterFields, FCurFields: String;
  46.     lm, ld: TStringList;
  47.     procedure FillLists;
  48.     procedure Localize;
  49.   public
  50.     { Public declarations }
  51.     MasterDS: TDataset;
  52.     DetailDS: TSQLTable;
  53.   end;
  54.  
  55. implementation
  56.  
  57. uses FR_Utils;
  58.  
  59. {$R *.xfm}
  60.  
  61.  
  62. procedure TfrDBXFieldsLinkForm.FillLists;
  63. var
  64.   i: Integer;
  65.   s: String;
  66. begin
  67.   MasterL.Items.Assign(lm);
  68.   DetailL.Items.Assign(ld);
  69.   JoinL.Items.Clear;
  70.   i := 1;
  71.   while i <= Length(FCurFields) do
  72.   begin
  73.     s := ExtractFieldName(FCurFields, i);
  74.     JoinL.Items.Add(DetailL.Items[0] + ' -> ' + s);
  75.     DetailL.Items.Delete(0);
  76.     MasterL.Items.Delete(MasterL.Items.IndexOf(s));
  77.   end;
  78.   AddB.Enabled := False;
  79. end;
  80.  
  81. procedure TfrDBXFieldsLinkForm.FormShow(Sender: TObject);
  82. var
  83.   i: Integer;
  84. begin
  85.   Caption := DetailDS.Name + ' -> ' + MasterDS.Name;
  86.   lm := TStringList.Create;
  87.   ld := TStringList.Create;
  88.   FMasterFields := DetailDS.MasterFields;
  89.   FCurFields := FMasterFields;
  90.   MasterDS.GetFieldNames(lm);
  91.   DetailDS.Open;
  92.   for i := 0 to DetailDS.IndexFieldCount - 1 do
  93.     ld.Add(DetailDS.IndexFields[i].FieldName);
  94.   DetailDS.Close;
  95.   FillLists;
  96. end;
  97.  
  98. procedure TfrDBXFieldsLinkForm.FormHide(Sender: TObject);
  99. begin
  100.   if ModalResult = mrOk then
  101.     DetailDS.MasterFields := FCurFields else
  102.     DetailDS.MasterFields := FMasterFields;
  103.   ld.Free;
  104.   lm.Free;
  105. end;
  106.  
  107. procedure TfrDBXFieldsLinkForm.ClearBClick(Sender: TObject);
  108. begin
  109.   FCurFields := '';
  110.   FillLists;
  111. end;
  112.  
  113. procedure TfrDBXFieldsLinkForm.DetailLDrawItem(Control: TWinControl;
  114.   Index: Integer; Rect: TRect; State: TOwnerDrawState);
  115. begin
  116.   with DetailL.Canvas do
  117.   begin
  118.     if Index > 0 then
  119.       Font.Color := clBtnShadow;
  120.     FillRect(Rect);
  121.     TextOut(Rect.Left + 2, Rect.Top, DetailL.Items[Index]);
  122.   end;
  123. end;
  124.  
  125. procedure TfrDBXFieldsLinkForm.DetailLClick(Sender: TObject);
  126. begin
  127.   if DetailL.ItemIndex > 0 then
  128.     DetailL.ItemIndex := 0;
  129.   if MasterL.ItemIndex <> -1 then
  130.     AddB.Enabled := True;
  131. end;
  132.  
  133. procedure TfrDBXFieldsLinkForm.MasterLClick(Sender: TObject);
  134. begin
  135.   if DetailL.ItemIndex <> -1 then
  136.     AddB.Enabled := True;
  137. end;
  138.  
  139. procedure TfrDBXFieldsLinkForm.AddBClick(Sender: TObject);
  140. var s: String;
  141. begin
  142.   s := MasterL.Items[MasterL.ItemIndex];
  143.   if FCurFields = '' then
  144.     FCurFields := s else
  145.     FCurFields := FCurFields + ';' + s;
  146.   FillLists;
  147. end;
  148.  
  149. procedure TfrDBXFieldsLinkForm.Localize;
  150. begin
  151.   Label1.Caption := S56130;
  152.   Label2.Caption := S56131;
  153.   Label3.Caption := S56132;
  154.   AddB.Caption := S56133;
  155.   ClearB.Caption := S56134;
  156.   OkB.Caption := (SOk);
  157.   CancelB.Caption := (SCancel);
  158. end;
  159.  
  160. procedure TfrDBXFieldsLinkForm.FormCreate(Sender: TObject);
  161. begin
  162.   Localize;
  163. end;
  164.  
  165. end.
  166.  
  167.