srctab.pas

RxRich很有用的文字图像显示控件,这是它的Demo

{*******************************************************}
{                                                       }
{     Delphi VCL Extensions (RX) demo program           }
{                                                       }
{     Copyright (c) 1996 AO ROSNO                       }
{     Copyright (c) 1997 Master-Bank                    }
{                                                       }
{*******************************************************}

unit SrcTab;

interface

uses
  SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
  Forms, Dialogs, ExtCtrls, Grids, StdCtrls, Mask, ToolEdit, Placemnt, DB,
  DBLists, DBTables, RXDBCtrl, MemTable, DBGrids, CurrEdit;

type
  TSrcTableDlg = class(TForm)
    Expanded: TBevel;
    FormStorage: TFormStorage;
    TableFields: TTableItems;
    MappingsTab: TMemoryTable;
    MappingsTabSRC_NAME: TStringField;
    MappingsTabDST_NAME: TStringField;
    dsMappings: TDataSource;
    TopPanel: TPanel;
    Label1: TLabel;
    Label4: TLabel;
    RecordCountBox: TGroupBox;
    Label2: TLabel;
    FirstRecsBtn: TRadioButton;
    AllRecsBtn: TRadioButton;
    ModeCombo: TComboBox;
    SrcNameEdit: TFilenameEdit;
    OkBtn: TButton;
    CancelBtn: TButton;
    MapBtn: TButton;
    BottomPanel: TPanel;
    Label3: TLabel;
    MapGrid: TRxDBGrid;
    RecordCntEdit: TCurrencyEdit;
    procedure FormCreate(Sender: TObject);
    procedure MapBtnClick(Sender: TObject);
    procedure SrcNameEditChange(Sender: TObject);
    procedure OkBtnClick(Sender: TObject);
    procedure AllRecsBtnClick(Sender: TObject);
    procedure MappingsTabDST_NAMEGetText(Sender: TField; var Text: string;
      DisplayText: Boolean);
    procedure MappingsTabDST_NAMESetText(Sender: TField;
      const Text: string);
  private
    { Private declarations }
    FExpanded: Boolean;
    FMappingsHeight: Integer;
    FDstTable: TTable;
    FSrcName: string;
    procedure UpdateFormView;
    procedure UpdateMapGrid;
    procedure MapTabBeforeDeleteInsert(DataSet: TDataSet);
  protected
    procedure CreateParams(var Params: TCreateParams); override;
  public
    { Public declarations }
  end;

function GetImportParams(const DstTable: TTable; var TabName: string;
  var RecordCount: Longint; Mappings: TStrings; var Mode: TBatchMode): Boolean;

implementation

uses VCLUtils;

{$R *.DFM}

function GetImportParams(const DstTable: TTable; var TabName: string;
  var RecordCount: Longint; Mappings: TStrings; var Mode: TBatchMode): Boolean;
begin
  with TSrcTableDlg.Create(Application) do begin
    try
      Caption := Format(Caption, [DstTable.TableName]);
      FDstTable := DstTable;
      Result := ShowModal = mrOk;
      if Result then begin
        TabName := SrcNameEdit.Text;
        RecordCount := 0;
        if FirstRecsBtn.Checked then
          RecordCount := RecordCntEdit.AsInteger;
        if Mappings <> nil then begin
          Mappings.Clear;
          with MappingsTab do begin
            if Active then begin
              First;
              while not EOF do begin
                if (Trim(FieldByName('SRC_NAME').AsString) <> '') and
                  (Trim(FieldByName('DST_NAME').AsString) <> '') then
                  Mappings.Add(Format('%s=%s', [FieldByName('DST_NAME').Value,
                    FieldByName('SRC_NAME').Value]));
                Next;
              end;
            end;
          end;
        end;
        Mode := TBatchMode(ModeCombo.ItemIndex);
      end;
    finally
      Free;
    end;
  end;
end;

const
  SMappings = '&Mappings';

procedure TSrcTableDlg.CreateParams(var Params: TCreateParams);
begin
  inherited CreateParams(Params);
  if Application.MainForm <> nil then
    Params.WndParent := Application.MainForm.Handle;
end;

procedure TSrcTableDlg.MapTabBeforeDeleteInsert(DataSet: TDataSet);
begin
  SysUtils.Abort;
end;

procedure TSrcTableDlg.FormCreate(Sender: TObject);
begin
  ModeCombo.ItemIndex := 0;
  FMappingsHeight := ClientHeight;
  UpdateFormView;
end;

procedure TSrcTableDlg.UpdateFormView;
begin
  DisableAlign;
  try
    if FExpanded then begin
      ClientHeight := FMappingsHeight;
      MapBtn.Caption := '<< ' + SMappings;
    end
    else begin
      ClientHeight := BottomPanel.Top;
      MapBtn.Caption := SMappings + ' >>';;
    end;
    BottomPanel.Visible := FExpanded;
    MapGrid.Enabled := FExpanded;
  finally
    EnableAlign;
  end;
end;

procedure TSrcTableDlg.MapBtnClick(Sender: TObject);
begin
  if not FExpanded then UpdateMapGrid;
  FExpanded := not FExpanded;
  UpdateFormView;
end;

procedure TSrcTableDlg.SrcNameEditChange(Sender: TObject);
begin
  OkBtn.Enabled := SrcNameEdit.Text <> EmptyStr;
  MapBtn.Enabled := FExpanded or (SrcNameEdit.Text <> EmptyStr);
end;

procedure TSrcTableDlg.OkBtnClick(Sender: TObject);
begin
  if not FileExists(SrcNameEdit.FileName) then begin
    raise Exception.Create(Format('File %s does not exist',
      [SrcNameEdit.FileName]));
  end;
  ModalResult := mrOk;
end;

procedure TSrcTableDlg.AllRecsBtnClick(Sender: TObject);
begin
  RecordCntEdit.Enabled := FirstRecsBtn.Checked;
  if RecordCntEdit.Enabled then begin
    RecordCntEdit.Color := clWindow;
    RecordCntEdit.ParentFont := True;
    if SrcNameEdit.Text <> '' then ActiveControl := RecordCntEdit
    else ActiveControl := SrcNameEdit;
  end
  else begin
    RecordCntEdit.ParentColor := True;
    RecordCntEdit.Font.Color := RecordCntEdit.Color;
  end;
end;

procedure TSrcTableDlg.UpdateMapGrid;
begin
  if (FSrcName = SrcNameEdit.FileName) and MappingsTab.Active then
    Exit;
  FSrcName := SrcNameEdit.FileName;
  MappingsTab.DisableControls;
  StartWait;
  try
    MappingsTab.Close;
    TableFields.Close;
    TableFields.SessionName := FDstTable.SessionName;
    TableFields.DatabaseName := FDstTable.DatabaseName;
    TableFields.TableName := FDstTable.TableName;
    TableFields.Open;
    try
      MapGrid.Columns[1].PickList.Clear;
      while not TableFields.EOF do begin
        MapGrid.Columns[1].PickList.Add(
          TableFields.FieldByName('NAME').AsString);
        TableFields.Next;
      end;
    finally
      TableFields.Close;
    end;
    TableFields.DatabaseName := '';
    TableFields.TableName := SrcNameEdit.FileName;
    TableFields.Open;
    try
      with MappingsTab do begin
        BeforeDelete := nil;
        BeforeInsert := nil;
        Open;
      end;
      while not TableFields.Eof do begin
        MappingsTab.Append;
        MappingsTab.FieldByName('SRC_NAME').AsString :=
          TableFields.FieldByName('NAME').AsString;
        if MapGrid.Columns[1].PickList.IndexOf(
          MappingsTab.FieldByName('SRC_NAME').AsString) >= 0 then
          MappingsTab.FieldByName('DST_NAME').AsString :=
            MappingsTab.FieldByName('SRC_NAME').AsString
        else
          MappingsTab.FieldByName('DST_NAME').AsString := ' ';
        try
          MappingsTab.Post;
        except
          MappingsTab.Cancel;
          raise;
        end;
        TableFields.Next;
      end;
      with MappingsTab do begin
        BeforeDelete := MapTabBeforeDeleteInsert;
        BeforeInsert := MapTabBeforeDeleteInsert;
      end;
    finally
      TableFields.Close;
    end;
    MappingsTab.First;
  finally
    StopWait;
    MappingsTab.EnableControls;
  end;
end;

procedure TSrcTableDlg.MappingsTabDST_NAMEGetText(Sender: TField;
  var Text: string; DisplayText: Boolean);
begin
  Text := Trim(Sender.AsString);
end;

procedure TSrcTableDlg.MappingsTabDST_NAMESetText(Sender: TField;
  const Text: string);
begin
  if Text = '' then Sender.AsString := ' '
  else Sender.AsString := Text;
end;

end.