home *** CD-ROM | disk | FTP | other *** search
/ Chip 2001 October / Chip_2001-10_cd1.bin / zkuste / delphi / kolekce / d6 / FRCLX.ZIP / SOURCE / FR_IFlds.pas < prev    next >
Pascal/Delphi Source File  |  2001-07-03  |  9KB  |  329 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_IFlds;
  12.  
  13. interface
  14.  
  15. {$I FR.inc}
  16.  
  17. uses
  18.   SysUtils, Types, Classes, QGraphics, QControls, QForms, QDialogs,
  19.   QStdCtrls, FR_DBRel, QExtCtrls;
  20.  
  21. type
  22.   TfrInsertFieldsForm = class(TForm)
  23.     FieldsL: TListBox;
  24.     DatasetCB: TComboBox;
  25.     Label1: TLabel;
  26.     GroupBox1: TGroupBox;
  27.     HorzRB: TRadioButton;
  28.     VertRB: TRadioButton;
  29.     Button1: TButton;
  30.     Button2: TButton;
  31.     GroupBox2: TGroupBox;
  32.     HeaderCB: TCheckBox;
  33.     BandCB: TCheckBox;
  34.     Image1: TImage;
  35.     Image2: TImage;
  36.     procedure DatasetCBChange(Sender: TObject);
  37.     procedure FormShow(Sender: TObject);
  38.     procedure FormCreate(Sender: TObject);
  39.     procedure FormClose(Sender: TObject; var Action: TCloseAction);
  40.     procedure DatasetCBDrawItem(Sender: TObject; Index: Integer;
  41.       ARect: TRect; State: TOwnerDrawState; var Handled: Boolean);
  42.     procedure FieldsLDrawItem(Sender: TObject; Index: Integer; ARect: TRect;
  43.       State: TOwnerDrawState; var Handled: Boolean);
  44.   private
  45.     { Private declarations }
  46.     procedure Localize;
  47.   public
  48.     { Public declarations }
  49.     DataSet: TfrTDataSet;
  50.   end;
  51.  
  52.  
  53. implementation
  54.  
  55. uses FR_Class, FR_Desgn, FR_Const, FR_Utils, FR_DBSet, FR_Ctrls;
  56.  
  57. {$R *.xfm}
  58.  
  59. procedure TfrInsertFieldsForm.FormShow(Sender: TObject);
  60. begin
  61.   DataSet := nil;
  62.   CurReport.Dictionary.GetDatasetList(DatasetCB.Items);
  63.   if DatasetCB.Items.Count > 0 then
  64.     DatasetCB.ItemIndex := 0;
  65.   DatasetCBChange(nil);
  66. end;
  67.  
  68. procedure TfrInsertFieldsForm.DatasetCBChange(Sender: TObject);
  69. var
  70.   DSName: String;
  71. begin
  72.   DSName := DatasetCB.Items[DatasetCB.ItemIndex];
  73.   DataSet := frGetDataSet(CurReport.Dictionary.RealDataSetName[DSName]);
  74.   CurReport.Dictionary.GetFieldList(DSName, FieldsL.Items);
  75. end;
  76.  
  77. procedure TfrInsertFieldsForm.Localize;
  78. begin
  79.   Caption := (S53630);
  80.   Label1.Caption := (S53631);
  81.   GroupBox1.Caption := (S53632);
  82.   HorzRB.Caption := (S53633);
  83.   VertRB.Caption := (S53634);
  84.   HeaderCB.Caption := (S53635);
  85.   BandCB.Caption := (S53636);
  86.   Button1.Caption := (SOk);
  87.   Button2.Caption := (SCancel);
  88. end;
  89.  
  90. procedure TfrInsertFieldsForm.FormCreate(Sender: TObject);
  91. begin
  92.   Localize;
  93. end;
  94.  
  95. procedure TfrInsertFieldsForm.DatasetCBDrawItem(Sender: TObject;
  96.   Index: Integer; ARect: TRect; State: TOwnerDrawState; var Handled: Boolean);
  97. var
  98.   r: TRect;
  99. begin
  100.   r := ARect;
  101.   r.Right := r.Left + 18;
  102.   r.Bottom := r.Top + 16;
  103.   OffsetRect(r, 2, 0);
  104.   with DatasetCB.Canvas do
  105.   begin
  106.     FillRect(ARect);
  107.     frDrawTransparent(DatasetCB.Canvas, r.Left, r.Top, Image1.Picture.Bitmap);
  108.     TextOut(ARect.Left + 20, ARect.Top + 1, DatasetCB.Items[Index]);
  109.   end;
  110. end;
  111.  
  112. procedure TfrInsertFieldsForm.FieldsLDrawItem(Sender: TObject;
  113.   Index: Integer; ARect: TRect; State: TOwnerDrawState; var Handled: Boolean);
  114. var
  115.   r: TRect;
  116. begin
  117.   r := ARect;
  118.   r.Right := r.Left + 18;
  119.   r.Bottom := r.Top + 16;
  120.   OffsetRect(r, 2, 0);
  121.   with FieldsL.Canvas do
  122.   begin
  123.     FillRect(ARect);
  124.     frDrawTransparent(FieldsL.Canvas, r.Left, r.Top, Image2.Picture.Bitmap);
  125.     TextOut(ARect.Left + 20, ARect.Top + 1, FieldsL.Items[Index]);
  126.   end;
  127. end;
  128.  
  129. {$HINTS OFF}
  130. procedure TfrInsertFieldsForm.FormClose(Sender: TObject;
  131.   var Action: TCloseAction);
  132. var
  133.   i, x, y, dx, dy, pdx, adx: Integer;
  134.   HeaderL, DataL: TList;
  135.   t, t1: TfrView;
  136.   b: TfrBandView;
  137.   f: TfrTField;
  138.   fSize: Integer;
  139.   fName: String;
  140.   DSName, FieldName: String;
  141.   dsgn: TfrDesignerForm;
  142.   bmp: TBitmap;
  143.  
  144.   function FindDataset(DataSet: TfrTDataSet): String;
  145.   var
  146.     i: Integer;
  147.     function EnumComponents(f: TComponent): String;
  148.     var
  149.       i: Integer;
  150.       c: TComponent;
  151.       d: TfrDBDataSet;
  152.     begin
  153.       Result := '';
  154.       for i := 0 to f.ComponentCount - 1 do
  155.       begin
  156.         c := f.Components[i];
  157.         if c is TfrDBDataSet then
  158.         begin
  159.           d := c as TfrDBDataSet;
  160.           if d.GetDataSet = DataSet then
  161.           begin
  162.             if d.Owner = CurReport.Owner then
  163.               Result := d.Name else
  164.               Result := d.Owner.Name + '.' + d.Name;
  165.             break;
  166.           end;
  167.         end;
  168.       end;
  169.     end;
  170.   begin
  171.     Result := '';
  172.     for i := 0 to Screen.FormCount - 1 do
  173.     begin
  174.       Result := EnumComponents(Screen.Forms[i]);
  175.       if Result <> '' then Exit;
  176.     end;
  177.     for i := 0 to Screen.DataModuleCount - 1 do
  178.     begin
  179.       Result := EnumComponents(Screen.DataModules[i]);
  180.       if Result <> '' then Exit;
  181.     end;
  182.   end;
  183.  
  184. begin
  185.   dsgn := TfrDesignerForm(frDesigner);
  186.   HeaderL := TList.Create;
  187.   DataL := TList.Create;
  188.   bmp := TBitmap.Create;
  189.   bmp.Width := 16; bmp.Height := 16;
  190.   if (ModalResult = mrOk) and (DataSet <> nil) and
  191.     (FieldsL.Items.Count > 0) and (FieldsL.SelCount > 0) then
  192.   begin
  193.     dsgn.BeforeChange;
  194.     DSName := DatasetCB.Items[DatasetCB.ItemIndex];
  195.     x := dsgn.Page.LeftMargin; y := dsgn.Page.TopMargin;
  196.     for i := 0 to FieldsL.Items.Count - 1 do
  197.       if FieldsL.Selected[i] then
  198.       begin
  199.         FieldName := FieldsL.Items[i];
  200.         f := TfrTField(DataSet.FindField(CurReport.Dictionary.RealFieldName[FieldsL.Items[i]]));
  201.         fSize := 0;
  202.         if f <> nil then
  203.         begin
  204.           fSize := f.DisplayWidth;
  205.           fName := f.DisplayName;
  206.         end
  207.         else
  208.           fName := FieldName;
  209.         if (fSize = 0) or (fSize > 255) then
  210.           fSize := 6;
  211.  
  212.         t := frCreateObject(gtMemo, '');
  213.         t.CreateUniqueName;
  214.         t.x := x;
  215.         t.y := y;
  216.         t.dy := 16;
  217.         if HeaderCB.Checked then
  218.           TfrMemoView(t).Font.Style := [fsBold];
  219.         bmp.Canvas.Font.Assign(TfrMemoView(t).Font);
  220.         t.Selected := True;
  221.         if HeaderCB.Checked then
  222.         begin
  223.           t.Memo.Add(fName);
  224.           t.dx := bmp.Canvas.TextWidth(fName + '   ') div dsgn.GridSizeX * dsgn.GridSizeX;
  225.         end
  226.         else
  227.         begin
  228.           t.Memo.Add('[' + DSName + '."' + FieldName + '"]');
  229.           t.dx := (fSize * bmp.Canvas.TextWidth('=')) div dsgn.GridSizeX * dsgn.GridSizeX;
  230.         end;
  231.         dx := t.dx;
  232.         dsgn.Page.Objects.Add(t);
  233.         if HeaderCB.Checked then
  234.           HeaderL.Add(t) else
  235.           DataL.Add(t);
  236.         if HeaderCB.Checked then
  237.         begin
  238.           t := frCreateObject(gtMemo, '');
  239.           t.CreateUniqueName;
  240.           t.x := x;
  241.           t.y := y;
  242.           t.dy := 16;
  243.           if HorzRB.Checked then
  244.             Inc(t.y, 72) else
  245.             Inc(t.x, dx + dsgn.GridSizeX * 2);
  246.           t.Selected := True;
  247.           t.Memo.Add('[' + DSName + '."' + FieldName + '"]');
  248.           t.dx := (fSize * bmp.Canvas.TextWidth('=')) div dsgn.GridSizeX * dsgn.GridSizeX;
  249.           dsgn.Page.Objects.Add(t);
  250.           DataL.Add(t);
  251.         end;
  252.         if HorzRB.Checked then
  253.           Inc(x, t.dx + dsgn.GridSizeX) else
  254.           Inc(y, t.dy + dsgn.GridSizeY);
  255.       end;
  256.  
  257.     if HorzRB.Checked then
  258.     begin
  259.       t := DataL[DataL.Count - 1];
  260.       adx := t.x + t.dx;
  261.       pdx := dsgn.Page.RightMargin - dsgn.Page.LeftMargin;
  262.       x := dsgn.Page.LeftMargin;
  263.       if adx > pdx then
  264.       begin
  265.         for i := 0 to DataL.Count - 1 do
  266.         begin
  267.           t := DataL[i];
  268.           t.x := Round((t.x - x) / (adx / pdx)) + x;
  269.           t.dx := Round(t.dx / (adx / pdx));
  270.         end;
  271.         if HeaderCB.Checked then
  272.           for i := 0 to DataL.Count - 1 do
  273.           begin
  274.             t := HeaderL[i];
  275.             t1 := DataL[i];
  276.             t.x := Round((t.x - x) / (adx / pdx)) + x;
  277.             if t.dx > t1.dx then
  278.               t.dx := t1.dx;
  279.           end;
  280.       end;
  281.     end;
  282.  
  283.     if BandCB.Checked then
  284.     begin
  285.       if HeaderCB.Checked then
  286.         t := HeaderL[DataL.Count - 1] else
  287.         t := DataL[DataL.Count - 1];
  288.       dy := t.y + t.dy - dsgn.Page.TopMargin;
  289.       b := frCreateObject(gtBand, '') as TfrBandView;
  290.       b.CreateUniqueName;
  291.       b.y := dsgn.Page.TopMargin;
  292.       b.dy := dy;
  293.       b.Selected := True;
  294.       if not HeaderCB.Checked or not HorzRB.Checked then
  295.       begin
  296.         dsgn.Page.Objects.Add(b);
  297.         b.BandType := btMasterData;
  298.         b.DataSet := FindDataset(DataSet);
  299.       end
  300.       else
  301.       begin
  302.         if frCheckBand(btPageHeader) then
  303.           b.Free
  304.         else
  305.         begin
  306.           b.BandType := btPageHeader;
  307.           dsgn.Page.Objects.Add(b);
  308.         end;
  309.         b := frCreateObject(gtBand, '') as TfrBandView;
  310.         b.BandType := btMasterData;
  311.         b.DataSet := FindDataset(DataSet);
  312.         b.CreateUniqueName;
  313.         b.y := dsgn.Page.TopMargin + 72;
  314.         b.dy := dy;
  315.         b.Selected := True;
  316.         dsgn.Page.Objects.Add(b);
  317.       end;
  318.     end;
  319.   end;
  320.   HeaderL.Free;
  321.   DataL.Free;
  322. end;
  323. {$HINTS ON}
  324.  
  325.  
  326.  
  327. end.
  328.  
  329.