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