home *** CD-ROM | disk | FTP | other *** search
/ Chip 2001 October / Chip_2001-10_cd1.bin / zkuste / delphi / kolekce / d6 / FRCLX.ZIP / SOURCE / FR_Flds1.pas < prev    next >
Pascal/Delphi Source File  |  2001-07-06  |  7KB  |  259 lines
  1.  
  2. {******************************************}
  3. {                                          }
  4. {           FastReport CLX v2.4            }
  5. {           Insert Fields dialog           }
  6. {                                          }
  7. { Copyright (c) 1998-2001 by Tzyganenko A. }
  8. {                                          }
  9. {******************************************}
  10.  
  11. unit FR_Flds1;
  12.  
  13. interface
  14.  
  15. {$I FR.inc}
  16.  
  17. uses
  18.   SysUtils, Types, Classes, QGraphics, QControls, QForms, QDialogs,
  19.   QStdCtrls, QExtCtrls, FR_Ctrls;
  20.  
  21. type
  22.   TfrInsFieldsForm = class(TForm)
  23.     FieldsLB: TListBox;
  24.     DatasetsLB: TListBox;
  25.     Panel1: TPanel;
  26.     Image1: TImage;
  27.     Image2: TImage;
  28.     Image3: TImage;
  29.     Image4: TImage;
  30.     Splitter: TPanel;
  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 FormClose(Sender: TObject; var Action: TCloseAction);
  37.     procedure FieldsLBStartDrag(Sender: TObject;
  38.       var DragObject: TDragObject);
  39.     procedure SplitterMouseDown(Sender: TObject; Button: TMouseButton;
  40.       Shift: TShiftState; X, Y: Integer);
  41.     procedure SplitterMouseMove(Sender: TObject; Shift: TShiftState; X,
  42.       Y: Integer);
  43.     procedure SplitterMouseUp(Sender: TObject; Button: TMouseButton;
  44.       Shift: TShiftState; X, Y: Integer);
  45.     procedure DatasetsLBDrawItem(Sender: TObject; Index: Integer;
  46.       ARect: TRect; State: TOwnerDrawState; var Handled: Boolean);
  47.   private
  48.     { Private declarations }
  49.     FHeightChanged: TNotifyEvent;
  50.     FDown: Boolean;
  51.     FLastY: Integer;
  52.     procedure FillDatasetsLB;
  53.     procedure GetFieldName;
  54.     procedure Localize;
  55.   public
  56.     { Public declarations }
  57.     DBField: String;
  58.     DefHeight: Integer;
  59.     constructor Create(AOwner: TComponent); override;
  60.     procedure Grow;
  61.     procedure RefreshData;
  62.     property OnHeightChanged: TNotifyEvent read FHeightChanged write FHeightChanged;
  63.   end;
  64.  
  65.  
  66. var
  67.   frFieldsDialog: TfrInsFieldsForm;
  68.  
  69.  
  70. implementation
  71.  
  72. {$R *.xfm}
  73.  
  74. uses FR_Class, FR_Const, FR_Utils, FR_DBRel, FR_Dock;
  75.  
  76. var
  77.   LastDB: String;
  78.  
  79.  
  80. constructor TfrInsFieldsForm.Create(AOwner: TComponent);
  81. begin
  82.   inherited Create(AOwner);
  83.   Parent := AOwner as TWinControl;
  84. end;
  85.  
  86. procedure TfrInsFieldsForm.FillDatasetsLB;
  87. var
  88.   i: Integer;
  89.   sl: TStringList;
  90. begin
  91.   sl := TStringList.Create;
  92.   DatasetsLB.Items.BeginUpdate;
  93.   CurReport.Dictionary.GetDatasetList(DatasetsLB.Items);
  94.   if CurReport.MixVariablesAndDBFields then
  95.   begin
  96.     CurReport.Dictionary.GetCategoryList(sl);
  97.     for i := 0 to sl.Count - 1 do
  98.       DatasetsLB.Items.AddObject(sl[i], TObject(1));
  99.   end;
  100.   DatasetsLB.Items.EndUpdate;
  101.   sl.Free;
  102. end;
  103.  
  104. procedure TfrInsFieldsForm.DatasetsLBClick(Sender: TObject);
  105. var
  106.   i: Integer;
  107.   sl: TStringList;
  108. begin
  109.   if Integer(DatasetsLB.Items.Objects[DatasetsLB.ItemIndex]) = 1 then
  110.   begin
  111.     sl := TStringList.Create;
  112.     CurReport.Dictionary.GetVariablesList(DatasetsLB.Items[DatasetsLB.ItemIndex], sl);
  113.     FieldsLB.Items.Clear;
  114.     for i := 0 to sl.Count - 1 do
  115.       FieldsLB.Items.AddObject(sl[i], TObject(1));
  116.     sl.Free;
  117.   end
  118.   else
  119.     CurReport.Dictionary.GetFieldList(DatasetsLB.Items[DatasetsLB.ItemIndex],
  120.       FieldsLB.Items)
  121. end;
  122.  
  123. procedure TfrInsFieldsForm.GetFieldName;
  124. begin
  125.   if DatasetsLB.Items.Count > 0 then
  126.     LastDB := DatasetsLB.Items[DatasetsLB.ItemIndex];
  127.  
  128.   if (FieldsLB.ItemIndex <> -1) and (FieldsLB.Items.Count <> 0) then
  129.     if Integer(FieldsLB.Items.Objects[FieldsLB.ItemIndex]) = 1 then
  130.       DBField := FieldsLB.Items[FieldsLB.ItemIndex] else
  131.       DBField := LastDB + '."' + FieldsLB.Items[FieldsLB.ItemIndex] + '"';
  132. end;
  133.  
  134. procedure TfrInsFieldsForm.RefreshData;
  135. begin
  136.   if DatasetsLB.Items.Count > 0 then
  137.     LastDB := DatasetsLB.Items[DatasetsLB.ItemIndex];
  138.   FormShow(nil);
  139. end;
  140.  
  141. procedure TfrInsFieldsForm.Localize;
  142. begin
  143.   Caption := S53450;
  144. end;
  145.  
  146. procedure TfrInsFieldsForm.FormCreate(Sender: TObject);
  147. begin
  148.   Parent := Owner as TWinControl;
  149.   Localize;
  150.   RestoreFormPosition(frIni, Self);
  151.   DatasetsLB.Height := frIni.ReadInteger(rsForm + ClassName, 'SplitterPos', 120);
  152.   DefHeight := Height;
  153.   if DefHeight < 30 then
  154.     DefHeight := 300;
  155.   if ClientHeight < 20 then
  156.     DatasetsLB.Hide;
  157. end;
  158.  
  159. procedure TfrInsFieldsForm.FormShow(Sender: TObject);
  160. begin
  161.   FillDatasetsLB;
  162.   with DatasetsLB do
  163.     if Items.Count > 0 then
  164.     begin
  165.       if Items.IndexOf(LastDB) <> -1 then
  166.         ItemIndex := Items.IndexOf(LastDB) else
  167.         ItemIndex := 0;
  168.       DatasetsLBClick(nil);
  169.     end
  170.     else
  171.       FieldsLB.Items.Clear;
  172. end;
  173.  
  174. procedure TfrInsFieldsForm.FormHide(Sender: TObject);
  175. begin
  176.   frFieldsDialog := nil;
  177.   SaveFormPosition(frIni, Self);
  178.   frIni.WriteInteger(rsForm + ClassName, 'SplitterPos', DatasetsLB.Height);
  179.   GetFieldName;
  180.   if frDesigner.Visible then
  181.     frDesigner.SetFocus;
  182. end;
  183.  
  184. procedure TfrInsFieldsForm.FieldsLBDblClick(Sender: TObject);
  185. begin
  186.   ModalResult := mrOk;
  187. end;
  188.  
  189. procedure TfrInsFieldsForm.DatasetsLBDrawItem(Sender: TObject;
  190.   Index: Integer; ARect: TRect; State: TOwnerDrawState;
  191.   var Handled: Boolean);
  192. var
  193.   Image: TImage;
  194.   r: TRect;
  195. begin
  196.   r := ARect;
  197.   r.Right := r.Left + 18;
  198.   r.Bottom := r.Top + 16;
  199.   OffsetRect(r, 2, 0);
  200.   with TListBox(Sender) do
  201.   begin
  202.     Canvas.FillRect(ARect);
  203.     if Sender = DatasetsLB then
  204.       if Integer(Items.Objects[Index]) = 1 then
  205.         Image := Image3 else
  206.         Image := Image1
  207.     else if Integer(Items.Objects[Index]) = 1 then
  208.       Image := Image4 else
  209.       Image := Image2;
  210.     frDrawTransparent(Canvas, r.Left, r.Top, Image.Picture.Bitmap);
  211.     Canvas.TextOut(ARect.Left + 20, ARect.Top + 1, Items[Index]);
  212.   end;
  213. end;
  214.  
  215. procedure TfrInsFieldsForm.FormClose(Sender: TObject; var Action: TCloseAction);
  216. begin
  217.   FormHide(nil);
  218.   Action := caFree;
  219. end;
  220.  
  221. procedure TfrInsFieldsForm.FieldsLBStartDrag(Sender: TObject;
  222.   var DragObject: TDragObject);
  223. begin
  224.   GetFieldName;
  225. end;
  226.  
  227. procedure TfrInsFieldsForm.Grow;
  228. begin
  229.   Height := DefHeight;
  230.   DatasetsLB.Show;
  231.   if Assigned(FHeightChanged) then
  232.     FHeightChanged(Self);
  233. end;
  234.  
  235. procedure TfrInsFieldsForm.SplitterMouseDown(Sender: TObject;
  236.   Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
  237. begin
  238.   FDown := True;
  239.   FLastY := Y;
  240. end;
  241.  
  242. procedure TfrInsFieldsForm.SplitterMouseMove(Sender: TObject;
  243.   Shift: TShiftState; X, Y: Integer);
  244. begin
  245.   if FDown then
  246.   begin
  247.     DatasetsLB.Height := DatasetsLB.Height + (Y - FLastY);
  248.     Splitter.Top := Splitter.Top + Y - FLastY;
  249.   end;
  250. end;
  251.  
  252. procedure TfrInsFieldsForm.SplitterMouseUp(Sender: TObject;
  253.   Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
  254. begin
  255.   FDown := False;
  256. end;
  257.  
  258. end.
  259.