home *** CD-ROM | disk | FTP | other *** search
/ Chip 2001 December / Chip_2001-12_cd1.bin / zkuste / delphi / kolekce / d3456 / ALEXSOFT.ZIP / RUSSIAN / FMFIELDS.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  2001-09-29  |  9.0 KB  |  286 lines
  1. (*////////////////////////////////////////////////////////////////////////////
  2. //   Part of AlexSoft VCL/DLL Library.                                      //
  3. //   All rights reserved. (c) Copyright 1998.                               //
  4. //   Created by: Alex Rabichooc                                             //
  5. //**************************************************************************//
  6. //  Users of this unit must accept this disclaimer of warranty:             //
  7. //    "This unit is supplied as is. The author disclaims all warranties,    //
  8. //    expressed or implied, including, without limitation, the warranties   //
  9. //    of merchantability and of fitness for any purpose.                    //
  10. //    The author assumes no liability for damages, direct or                //
  11. //    consequential, which may result from the use of this unit."           //
  12. //                                                                          //
  13. //  This Unit is donated to the public as public domain.                    //
  14. //                                                                          //
  15. //  This Unit can be freely used and distributed in commercial and          //
  16. //  private environments provided this notice is not modified in any way.   //
  17. //                                                                          //
  18. //  If you do find this Unit handy and you feel guilty for using such a     //
  19. //  great product without paying someone - sorry :-)                        //
  20. //                                                                          //
  21. //  Please forward any comments or suggestions to Alex Rabichooc at:        //
  22. //                                                                          //
  23. //  a_rabichooc@yahoo.com or alex@carmez.mldnet.com                         //
  24. /////////////////////////////////////////////////////////////////////////////*)
  25.  
  26. unit fmFields;
  27.  
  28. interface
  29.  
  30. uses
  31.   Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  32.   ExtCtrls, Buttons, StdCtrls, Db;
  33.  
  34. type
  35.   TfmGetFields = class(TForm)
  36.     Panel1: TPanel;
  37.     Panel3: TPanel;
  38.     Panel2: TPanel;
  39.     Panel4: TPanel;
  40.     lbAvFields: TListBox;
  41.     lbSelFields: TListBox;
  42.     SpeedButton1: TSpeedButton;
  43.     SpeedButton2: TSpeedButton;
  44.     SpeedButton3: TSpeedButton;
  45.     SpeedButton4: TSpeedButton;
  46.     Panel5: TPanel;
  47.     Panel6: TPanel;
  48.     Button1: TButton;
  49.     Button2: TButton;
  50.     procedure SpeedButton3Click(Sender: TObject);
  51.     procedure SpeedButton1Click(Sender: TObject);
  52.     procedure SpeedButton2Click(Sender: TObject);
  53.     procedure SpeedButton4Click(Sender: TObject);
  54.     procedure lbFieldsDragOver(Sender, Source: TObject; X, Y: Integer;
  55.       State: TDragState; var Accept: Boolean);
  56.     procedure lbFieldsDragDrop(Sender, Source: TObject; X, Y: Integer);
  57.     procedure lbAvFieldsDblClick(Sender: TObject);
  58.     procedure lbSelFieldsDblClick(Sender: TObject);
  59.   private
  60.     FDataSet: TDataSet;
  61.     procedure CreateFieldList(AList: TList);
  62.     procedure Exchange(Source, Dest: TListBox; AllItems: Boolean);
  63.     procedure MoveItems(ASource, ADest: TListBox; AIndex: Integer);
  64.     procedure ShowMoving(AListBox: TListBox; AIndex: Integer);
  65.   public
  66.     constructor CreateWithDataSet(AOwner: TComponent; ADataSet: TDataSet;
  67.                                     AList: TList); dynamic;
  68.   end;
  69.  
  70. var
  71.   fmGetFields: TfmGetFields;
  72.  
  73. implementation
  74.  
  75. {$R *.DFM}
  76.  
  77. constructor TfmGetFields.CreateWithDataSet(AOwner: TComponent;
  78.                                               ADataSet: TDataSet; AList: TList);
  79. begin
  80.    Create(AOwner);
  81.    FDataSet := ADataSet;
  82.    CreateFieldList(AList);
  83. end;
  84.  
  85. procedure TfmGetFields.ShowMoving(AListBox: TListBox; AIndex: Integer);
  86. var i: Integer;
  87.     ARect: TRect;
  88. begin
  89.    if AIndex > AListBox.Items.Count-1 then
  90.       AIndex := AListBox.Items.Count-1;
  91.    for i := 0 to AListBox.Items.Count-1 do
  92.    begin
  93.       ARect := AListBox.ItemRect(i);
  94.       AListBox.Canvas.FrameRect(ARect);
  95.    end;
  96.    ARect := AListBox.ItemRect(AIndex);
  97.    AListBox.Canvas.DrawFocusRect(ARect);
  98. end;
  99.  
  100. procedure TfmGetFields.MoveItems(ASource, ADest: TListBox; AIndex: Integer);
  101.   procedure MoveSame(AListBox: TListBox);
  102.   var
  103.     i, Delta: integer;
  104.   begin
  105.      Delta := 0;
  106.      if AIndex > AListBox.Items.Count-1 then
  107.         AIndex := AListBox.Items.Count-1;
  108.      for i := 0 to AListBox.Items.Count-1 do
  109.        if AListBox.Selected[i] then
  110.        begin
  111.           Delta := i - AIndex;
  112.           break;
  113.        end;
  114.      i := 0;
  115.      AListBox.Items.BeginUpdate;
  116.      try
  117.         while i < AListBox.Items.Count do
  118.         if AListBox.Selected[i] then
  119.         begin
  120.            AListBox.Selected[i] := False;
  121.            AListBox.Items.Move(i, i-Delta);
  122.         end
  123.          else
  124.            Inc(i);
  125.      finally
  126.         AListBox.Items.EndUpdate;
  127.      end;
  128.      AListBox.Selected[AIndex] := True;
  129.   end;
  130.  
  131.   procedure MoveDifferent(Source, Dest: TListBox);
  132.   var
  133.     i: integer;
  134.   begin
  135.      if AIndex > Dest.Items.Count then
  136.         AIndex := Dest.Items.Count;
  137.      Source.Items.BeginUpdate;
  138.      Dest.Items.BeginUpdate;
  139.      try
  140.         i := Source.Items.Count-1;
  141.         while i >= 0 do
  142.         begin
  143.            if Source.Selected[i] then
  144.            begin
  145.              Dest.Items.InsertObject(AIndex, Source.Items[i],
  146.                                                          Source.Items.Objects[i]);
  147.              Dest.Selected[AIndex] := True;
  148.              Source.Items.Delete(i);
  149.            end;
  150.            dec(i);
  151.         end;
  152.      finally
  153.         Source.Items.EndUpdate;
  154.         Dest.Items.EndUpdate;
  155.      end;
  156.      Dest.SetFocus;
  157.   end;
  158.  
  159. begin
  160.    if ASource = ADest then MoveSame(ASource)
  161.                     else MoveDifferent(ASource, ADest);
  162. end;
  163.  
  164. procedure TfmGetFields.Exchange(Source, Dest: TListBox; AllItems: Boolean);
  165. var
  166.   i: integer;
  167. begin
  168.    i := 0;
  169.    Source.Items.BeginUpdate;
  170.    try
  171.       Dest.Items.BeginUpdate;
  172.       try
  173.          while i < Source.Items.Count do
  174.           if AllItems or Source.Selected[i] then
  175.           begin
  176.              Dest.Items.AddObject(Source.Items[i], Source.Items.Objects[i]);
  177.              Source.Items.Delete(i);
  178.           end
  179.            else
  180.              inc(i);
  181.       finally
  182.          Dest.Items.EndUpdate;
  183.       end;
  184.    finally
  185.      Source.Items.EndUpdate;
  186.    end;
  187. end;
  188.  
  189. procedure TfmGetFields.CreateFieldList(AList: TList);
  190. var
  191.   i: integer;
  192.   AField: TField;
  193. begin
  194.   if FDataSet <> nil then
  195.     with FDataSet do
  196.     begin
  197.       if (AList <> nil) and (AList.Count > 0) then
  198.       begin
  199.          for i := 0 to AList.Count-1 do
  200.          begin
  201.             AField := AList[i];
  202.             lbSelFields.Items.AddObject(AField.FieldName, AField);
  203.          end;
  204.       end
  205.         else
  206.          for i := 0 to FieldCount - 1 do
  207.            if not Fields[i].IsBlob and
  208.               not (Fields[i] is TBinaryField)
  209.             {$IFNDEF VER110}
  210.                 and (Fields[i].DataType <> ftDataSet)
  211.             {$ENDIF} then
  212.                 if Fields[i].Visible then
  213.                     lbSelFields.Items.AddObject(Fields[i].FieldName, Fields[i]);
  214.       for i := 0 to FieldCount - 1 do
  215.          if not Fields[i].IsBlob and
  216.             not (Fields[i] is TBinaryField) and
  217.             {$IFNDEF VER110}
  218.                 (Fields[i].DataType <> ftDataSet) and
  219.             {$ENDIF}
  220.             (lbSelFields.Items.IndexOfObject(Fields[i]) = -1) then
  221.            lbAvFields.Items.AddObject(Fields[i].FieldName, Fields[i]);
  222.     end;
  223. end;
  224.  
  225. procedure TfmGetFields.SpeedButton3Click(Sender: TObject);
  226. begin
  227.    Exchange(lbSelFields, lbAvFields, False);
  228. end;
  229.  
  230. procedure TfmGetFields.SpeedButton1Click(Sender: TObject);
  231. begin
  232.    Exchange(lbAvFields, lbSelFields, False);
  233. end;
  234.  
  235. procedure TfmGetFields.SpeedButton2Click(Sender: TObject);
  236. begin
  237.    Exchange(lbAvFields, lbSelFields, True);
  238. end;
  239.  
  240. procedure TfmGetFields.SpeedButton4Click(Sender: TObject);
  241. begin
  242.    Exchange(lbSelFields, lbAvFields, True);
  243. end;
  244.  
  245. procedure TfmGetFields.lbFieldsDragOver(Sender, Source: TObject; X,
  246.   Y: Integer; State: TDragState; var Accept: Boolean);
  247. var AIndex: Integer;
  248.     Pos: TPoint;
  249. begin
  250.    Pos.x := X;
  251.    Pos.y := Y;
  252.    Accept := (Source is TListBox) and ((Source as TListBox).SelCount > 0);
  253.    if Accept then
  254.    begin
  255.       if (Source as TListBox).SelCount = 1 then
  256.          (Sender as TListBox).DragCursor := crDrag
  257.         else
  258.          (Sender as TListBox).DragCursor := crMultiDrag;
  259.       AIndex := (Sender as TListBox).ItemAtPos(Pos, False);
  260.       ShowMoving(Sender as TListBox, AIndex);
  261.    end;
  262. end;
  263.  
  264. procedure TfmGetFields.lbFieldsDragDrop(Sender, Source: TObject; X,
  265.   Y: Integer);
  266. var Pos: TPoint;
  267. begin
  268.    Pos.x := X;
  269.    Pos.y := Y;
  270.    if Source is TListBox then
  271.      MoveItems(Source as TListBox, Sender as TListBox,
  272.                                    (Sender as TListBox).ItemAtPos(Pos, False));
  273. end;
  274.  
  275. procedure TfmGetFields.lbAvFieldsDblClick(Sender: TObject);
  276. begin
  277.    SpeedButton1.Click;
  278. end;
  279.  
  280. procedure TfmGetFields.lbSelFieldsDblClick(Sender: TObject);
  281. begin
  282.    SpeedButton3.Click;
  283. end;
  284.  
  285. end.
  286.