home *** CD-ROM | disk | FTP | other *** search
/ Chip 2001 October / Chip_2001-10_cd1.bin / zkuste / delphi / kolekce / d6 / FRCLX.ZIP / SOURCE / FR_Flds.pas < prev    next >
Pascal/Delphi Source File  |  2001-07-03  |  4KB  |  171 lines
  1.  
  2. {******************************************}
  3. {                                          }
  4. {           FastReport CLX v2.4            }
  5. {               Fields list                }
  6. {                                          }
  7. { Copyright (c) 1998-2001 by Tzyganenko A. }
  8. {                                          }
  9. {******************************************}
  10.  
  11. unit FR_Flds;
  12.  
  13. interface
  14.  
  15. {$I FR.inc}
  16.  
  17. uses
  18.   SysUtils, Types, Classes, QGraphics, QControls, QForms, QDialogs,
  19.   QStdCtrls, QExtCtrls;
  20.  
  21. type
  22.   TfrFieldsForm = class(TForm)
  23.     FieldsLB: TListBox;
  24.     DatasetsLB: TListBox;
  25.     Button1: TButton;
  26.     Button2: TButton;
  27.     Image1: TImage;
  28.     Image2: TImage;
  29.     Image3: TImage;
  30.     Image4: TImage;
  31.     procedure FormCreate(Sender: TObject);
  32.     procedure FieldsLBDblClick(Sender: TObject);
  33.     procedure DatasetsLBClick(Sender: TObject);
  34.     procedure FormShow(Sender: TObject);
  35.     procedure FormHide(Sender: TObject);
  36.     procedure DatasetsLBDrawItem(Sender: TObject; Index: Integer;
  37.       ARect: TRect; State: TOwnerDrawState; var Handled: Boolean);
  38.   private
  39.     { Private declarations }
  40.     procedure FillDatasetsLB;
  41.     procedure GetFieldName;
  42.     procedure Localize;
  43.   public
  44.     { Public declarations }
  45.     DBField: String;
  46.   end;
  47.  
  48.  
  49.  
  50. implementation
  51.  
  52. {$R *.xfm}
  53.  
  54. uses FR_Class, FR_Const, FR_Utils, FR_DBRel, FR_Ctrls;
  55.  
  56. var
  57.   LastDB: String;
  58.  
  59.  
  60. procedure TfrFieldsForm.FillDatasetsLB;
  61. var
  62.   i: Integer;
  63.   sl: TStringList;
  64. begin
  65.   sl := TStringList.Create;
  66.   DatasetsLB.Items.BeginUpdate;
  67.   CurReport.Dictionary.GetDatasetList(DatasetsLB.Items);
  68.   if CurReport.MixVariablesAndDBFields then
  69.   begin
  70.     CurReport.Dictionary.GetCategoryList(sl);
  71.     for i := 0 to sl.Count - 1 do
  72.       DatasetsLB.Items.AddObject(sl[i], TObject(1));
  73.   end;
  74.   DatasetsLB.Items.EndUpdate;
  75.   sl.Free;
  76. end;
  77.  
  78. procedure TfrFieldsForm.DatasetsLBClick(Sender: TObject);
  79. var
  80.   i: Integer;
  81.   sl: TStringList;
  82. begin
  83.   if Integer(DatasetsLB.Items.Objects[DatasetsLB.ItemIndex]) = 1 then
  84.   begin
  85.     sl := TStringList.Create;
  86.     CurReport.Dictionary.GetVariablesList(DatasetsLB.Items[DatasetsLB.ItemIndex], sl);
  87.     FieldsLB.Items.Clear;
  88.     for i := 0 to sl.Count - 1 do
  89.       FieldsLB.Items.AddObject(sl[i], TObject(1));
  90.     sl.Free;
  91.   end
  92.   else
  93.     CurReport.Dictionary.GetFieldList(DatasetsLB.Items[DatasetsLB.ItemIndex],
  94.       FieldsLB.Items)
  95. end;
  96.  
  97. procedure TfrFieldsForm.GetFieldName;
  98. begin
  99.   if DatasetsLB.Items.Count > 0 then
  100.     LastDB := DatasetsLB.Items[DatasetsLB.ItemIndex];
  101.   if FieldsLB.ItemIndex <> -1 then
  102.     if Integer(FieldsLB.Items.Objects[FieldsLB.ItemIndex]) = 1 then
  103.       DBField := FieldsLB.Items[FieldsLB.ItemIndex] else
  104.       DBField := LastDB + '."' + FieldsLB.Items[FieldsLB.ItemIndex] + '"';
  105. end;
  106.  
  107. procedure TfrFieldsForm.Localize;
  108. begin
  109.   Caption := S53450;
  110.   Button1.Caption := (SOk);
  111.   Button2.Caption := (SCancel);
  112. end;
  113.  
  114. procedure TfrFieldsForm.FormCreate(Sender: TObject);
  115. begin
  116.   Localize;
  117. end;
  118.  
  119. procedure TfrFieldsForm.FormShow(Sender: TObject);
  120. begin
  121.   FillDatasetsLB;
  122.   with DatasetsLB do
  123.     if Items.Count > 0 then
  124.     begin
  125.       if Items.IndexOf(LastDB) <> -1 then
  126.         ItemIndex := Items.IndexOf(LastDB) else
  127.         ItemIndex := 0;
  128.       DatasetsLBClick(nil);
  129.     end;
  130. end;
  131.  
  132. procedure TfrFieldsForm.FormHide(Sender: TObject);
  133. begin
  134.   GetFieldName;
  135.   if frDesigner.Visible then
  136.     frDesigner.SetFocus;
  137. end;
  138.  
  139. procedure TfrFieldsForm.FieldsLBDblClick(Sender: TObject);
  140. begin
  141.   ModalResult := mrOk;
  142. end;
  143.  
  144. procedure TfrFieldsForm.DatasetsLBDrawItem(Sender: TObject; Index: Integer;
  145.   ARect: TRect; State: TOwnerDrawState; var Handled: Boolean);
  146. var
  147.   Image: TImage;
  148.   r: TRect;
  149. begin
  150.   r := ARect;
  151.   r.Right := r.Left + 18;
  152.   r.Bottom := r.Top + 16;
  153.   OffsetRect(r, 2, 0);
  154.   with TListBox(Sender) do
  155.   begin
  156.     Canvas.FillRect(ARect);
  157.     if Sender = DatasetsLB then
  158.       if Integer(Items.Objects[Index]) = 1 then
  159.         Image := Image3 else
  160.         Image := Image1
  161.     else if Integer(Items.Objects[Index]) = 1 then
  162.       Image := Image4 else
  163.       Image := Image2;
  164.     frDrawTransparent(Canvas, r.Left, r.Top, Image.Picture.Bitmap);
  165.     Canvas.TextOut(ARect.Left + 20, ARect.Top + 1, Items[Index]);
  166.   end;
  167. end;
  168.  
  169.  
  170. end.
  171.