home *** CD-ROM | disk | FTP | other *** search
/ Chip 1999 January / Chip_1999-01_cd.bin / zkuste / delphi / QDB / QDBV.ZIP / RestForm.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1998-07-02  |  6.9 KB  |  247 lines
  1. unit RestForm;
  2.  
  3. interface
  4.  
  5. uses
  6.   {$IFDEF WIN32}Windows, {$ELSE}WinTypes, WinProcs, {$ENDIF}
  7.   Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  8.   Menus, QDB, StdCtrls, Grids, ExtCtrls, QDBView {, ComCtrls};
  9.  
  10. type
  11.   TRestructureForm = class(TForm)
  12.     RestructureButton : TButton;
  13.     CancelButton : TButton;
  14.     Fields : TStringGrid;
  15.     HelpButton : TButton;
  16.     procedure FieldsDragOver(Sender, Source : TObject; X, Y : integer;
  17.       State : TDragState; var Accept : boolean);
  18.     procedure FieldsDragDrop(Sender, Source : TObject; X, Y : integer);
  19.     procedure CancelButtonClick(Sender : TObject);
  20.     procedure FieldsMouseDown(Sender : TObject; Button : TMouseButton;
  21.       Shift : TShiftState; X, Y : integer);
  22.     procedure RestructureButtonClick(Sender : TObject);
  23.     procedure FormActivate(Sender : TObject);
  24.     procedure HelpButtonClick(Sender : TObject);
  25.     procedure FormCreate(Sender : TObject);
  26.   private
  27.     { Private declarations }
  28.   public
  29.     { Public declarations }
  30.     FileName : string;
  31.     Panel : TCustomPanel;
  32.   end;
  33.  
  34. var
  35.   RestructureForm : TRestructureForm;
  36.   Q : TQDBView;
  37.  
  38. implementation
  39.  
  40. {$R *.DFM}
  41.  
  42. uses
  43.   RestHelp;
  44.  
  45. const
  46.   SBadTemp = 'could not create a temp file';  
  47.  
  48. { Only accept dragged items from the grid's column 1 }
  49.  
  50. procedure TRestructureForm.FieldsDragOver(Sender, Source : TObject; X, Y : integer;
  51.   State : TDragState; var Accept : boolean);
  52. var
  53.   c, R : longint;
  54. begin
  55.   Accept := false;
  56.   Fields.MouseToCell(X, Y, c, R);
  57.   if (Source = Fields) and (c = 1) then
  58.     Accept := true;
  59. end;
  60.  
  61. procedure TRestructureForm.FieldsDragDrop(Sender, Source : TObject; X, Y : integer);
  62. var
  63.   c, R : longint;
  64. begin
  65.   Fields.MouseToCell(X, Y, c, R);
  66.   if Fields.Cells[1, R] = '' then
  67.   begin
  68.     if Source is TStringGrid then
  69.     begin
  70.       Fields.Cells[1, R] := TStringGrid(Source).Cells[1, TStringGrid(Source).Row];
  71.       Fields.Cells[1, TStringGrid(Source).Row] := '';
  72.     end;
  73.   end;
  74. end;
  75.  
  76. procedure TRestructureForm.FieldsMouseDown(Sender : TObject; Button : TMouseButton;
  77.   Shift : TShiftState; X, Y : integer);
  78. begin
  79.   Fields.BeginDrag(true);
  80. end;
  81.  
  82. procedure TRestructureForm.CancelButtonClick(Sender : TObject);
  83. begin
  84.   Close;
  85. end;
  86.  
  87. type
  88.   TQDBItemHack = class(TQDBItem);
  89.  
  90. procedure TRestructureForm.RestructureButtonClick(Sender : TObject);
  91. const
  92.   zero : longint = 0;
  93. var
  94.   n : integer;
  95.   i : integer;
  96.   m : TMemoryStream;
  97.   FName2 : string;
  98.   FIndex2 : integer;
  99.   newkey : TKey;
  100.   TmpFileName : string;
  101.   OldQDB : TQDBItem;
  102.   NewQDB : TQDBItem;
  103. begin
  104.   if (mrNo = MessageDlg('Restructuring the file will change any data stored in it. ' +
  105.     'Are you sure you want to do this?',mtWarning,[mbYes,mbNo],0)) then
  106.     Exit;
  107.   try
  108.     { first open up the file via a QDBItem }
  109.     OldQDB := TQDBItem.Create(Self);
  110.     OldQDB.FileName := FileName;
  111.     { load up its field definitions }
  112.     OldQDB.FetchStructure;
  113.     { now get a temp file name ... }
  114.     TmpFileName := TempFileName('QZZ');
  115.     if TmpFileName = '' then
  116.     begin
  117.       raise Exception.Create(SBadTemp);
  118.     end;
  119.     { there mustn't actually be any file yet }
  120.     if FileExists(TmpFileName) then DeleteFile(TmpFileName);
  121.     { ... and open it up via a new QDBItem }
  122.     NewQDB := TQDBItem.Create(Self);
  123.     NewQDB.FileName := TmpFileName;
  124.     { now set up its field definitons from the QDBPanel ... the panel is still attached }
  125.     for n := 1 to Q.FieldCount do
  126.       NewQDB.AddField(Q.FieldNames[n - 1], Q.FieldTypes[n - 1]);
  127.     { next we set up the field equivalences using the grids objects }
  128.     { property to store the index of the matching fields            }
  129.     for i := 1 to NewQDB.FieldCount do
  130.     begin
  131.       FName2 := Fields.Cells[1, i];
  132.       if FName2 = '' then
  133.         FIndex2 := -1
  134.       else
  135.         FIndex2 := OldQDB.FieldIndex(FName2);
  136.       Fields.Objects[1, i] := pointer(Findex2);
  137.     end;
  138.       { now we can iterate through the file modifying each item }
  139.       for n := 1 to OldQDB.Count do
  140.       begin
  141.         { get the old item }
  142.         OldQDB.ItemIndex := n - 1;
  143.         OldQDB.Fetch;
  144.         { copy the only the appropriate data into the new item (using m as a carrier) }
  145.         for i := 1 to NewQDB.FieldCount do
  146.         begin
  147.           if longint(Fields.Objects[1, i]) <> -1 then
  148.             m:=OldQDB.GetField(longint(Fields.Objects[1, i]))
  149.           else
  150.             m.Clear;  
  151.           TQDBItemHack(NewQDB).SetField(i - 1, m);
  152.           m.Position:=0;
  153.         end;
  154.         { the new item is ready and can be stored in the new file }
  155.         newkey := OldQDB.Key;
  156.         NewQDB.StoreAs(newkey);
  157.       end;
  158.     { save and close the old file }
  159.     OldQDB.FileName := '';
  160.     OldQDB.Free;
  161.     OldQDB := nil;
  162.     { save and close the new file }
  163.     NewQDB.FileName := '';
  164.     NewQDB.Free;
  165.     NewQDB := nil;
  166.     { get rid of the old file }
  167.     DeleteFile(FileName);
  168.     { rename the new (temp) file to the old name }
  169.     RenameOrMoveFile(TmpFileName, FileName);
  170.     { open up the brand new file in a QDBPanel }
  171.     Q.FileName := FileName;
  172.     { setting the Panel property brands the file with }
  173.     { the proper field definitions                    }
  174.     Q.Panel := Panel;
  175.     { all done so save and close the file }
  176.     Q.FileName := '';
  177.   finally
  178.     ModalResult := mrOK;
  179.   end;
  180. end;
  181.  
  182. type
  183.   TQDBViewHack = class(TQDBView);
  184.  
  185. procedure TRestructureForm.FormActivate(Sender : TObject);
  186. var
  187.   n : integer;
  188.   T : TStringList;
  189. begin
  190.   { first set up the grid }
  191.   Fields.DefaultColWidth := Fields.ClientWidth div 2;
  192.   Fields.Cells[0, 0] := 'New Fields in Panel';
  193.   Fields.Cells[1, 0] := 'Old Fields in File';
  194.   { open a QDBView and use it to get the field names from the file }
  195.   T := TStringList.Create;
  196.   try
  197.     { this makes the file really open even though we are in design mode }
  198.     TQDBViewHack(Q).Restructuring := true;
  199.     Q.FileName := FileName;
  200.     Q.ListFileFieldNames(T);
  201.     Fields.RowCount := T.Count + 1;
  202.     for n := 1 to T.Count do
  203.     begin
  204.       with Fields do
  205.       begin
  206.         Cells[1, n] := T[n - 1];
  207.       end;
  208.     end;
  209.     { close the file down }
  210.     Q.FileName := '';
  211.   finally
  212.     T.Free;
  213.   end;
  214.   { now attach our panel and get its field names }
  215.   Q.Panel := Panel;
  216.   Fields.RowCount := Fields.RowCount + Q.FieldCount;
  217.   for n := 1 to Q.FieldCount do
  218.   begin
  219.     with Fields do
  220.     begin
  221.       Cells[0, n] := Q.FieldNames[n - 1];
  222.     end;
  223.   end;
  224. end;
  225.  
  226. procedure TRestructureForm.HelpButtonClick(Sender : TObject);
  227. var
  228.   RestHelpForm : TRestructureHelpForm;
  229. begin
  230.   { just show a little help on restructuring }
  231.   RestHelpForm := TRestructurehelpForm.Create(Application);
  232.   try
  233.     RestHelpForm.Memo1.WordWrap := true;
  234.     RestHelpForm.ShowModal;
  235.   finally
  236.     RestHelpForm.Free;
  237.   end;
  238. end;
  239.  
  240. procedure TRestructureForm.FormCreate(Sender : TObject);
  241. begin
  242.   Q := TQDBView.Create(Self);
  243. end;
  244.  
  245. end.
  246.  
  247.