rmd_md.pas

进销存·完整的·有数据库的·非常完整·只得参考

{*****************************************}
{                                         }
{ Report Machine v2.0 - Data storage      }
{        Master/detail definition         }
{                                         }
{*****************************************}

unit RMD_md;

interface

{$I RM.inc}

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  DB, RMD_DBWrap, ExtCtrls, StdCtrls, RM_Const;

type
  TRMDFieldsLinkForm = class(TForm)
    lstDetail: TListBox;
    lstMaster: TListBox;
    Label1: TLabel;
    Label2: TLabel;
    btnAdd: TButton;
    JoinL: TListBox;
    Label3: TLabel;
    btnClear: TButton;
    Bevel1: TBevel;
    btnOK: TButton;
    btnCancel: TButton;
    procedure FormShow(Sender: TObject);
    procedure btnClearClick(Sender: TObject);
    procedure lstDetailDrawItem(Control: TWinControl; Index: Integer;
      Rect: TRect; State: TOwnerDrawState);
    procedure lstDetailClick(Sender: TObject);
    procedure lstMasterClick(Sender: TObject);
    procedure btnAddClick(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure FormCreate(Sender: TObject);
  private
    { Private declarations }
    FMasterFields, FCurFields: String;
    lm, ld: TStringList;
    procedure FillLists;
    procedure Localize;
  public
    { Public declarations }
    MasterDS: TDataset;
    DetailDS: TRMDTable;
    function Execute(var MasterFields: string): Boolean;
  end;

implementation

uses RM_Utils;

{$R *.DFM}

type
	THackRMDTable = class(TRMDTable)
  end;

procedure TRMDFieldsLinkForm.Localize;
begin
	Font.Name := RMLoadStr(SRMDefaultFontName);
  Font.Size := StrToInt(RMLoadStr(SRMDefaultFontSize));
  Font.Charset := StrToInt(RMLoadStr(SCharset));

  RMSetStrProp(Label1, 'Caption', rmRes + 3130);
  RMSetStrProp(Label2, 'Caption', rmRes + 3131);
  RMSetStrProp(Label3, 'Caption', rmRes + 3132);
  RMSetStrProp(btnAdd, 'Caption', rmRes + 3133);
  RMSetStrProp(btnClear, 'Caption', rmRes + 3134);

  btnOK.Caption := RMLoadStr(SOk);
  btnCancel.Caption := RMLoadStr(SCancel);
end;

function TRMDFieldsLinkForm.Execute(var MasterFields: string): Boolean;
begin
	FMasterFields := MasterFields;
	Result := (ShowModal = mrOK);
  if Result then
  begin
		MasterFields := FCurFields;
  end;
end;

procedure TRMDFieldsLinkForm.FillLists;
var
  i: Integer;
  s: String;
begin
  lstMaster.Items.Assign(lm);
  lstDetail.Items.Assign(ld);
  JoinL.Items.Clear;
  i := 1;
  while i <= Length(FCurFields) do
  begin
    s := ExtractFieldName(FCurFields, i);
    JoinL.Items.Add(lstDetail.Items[0] + ' -> ' + s);
    lstDetail.Items.Delete(0);
    lstMaster.Items.Delete(lstMaster.Items.IndexOf(s));
  end;
  btnAdd.Enabled := False;
end;

procedure TRMDFieldsLinkForm.FormShow(Sender: TObject);
begin
  Caption := DetailDS.DataSet.Name + ' -> ' + MasterDS.Name;

  lm := TStringList.Create;
  ld := TStringList.Create;
  FCurFields := FMasterFields;
  MasterDS.GetFieldNames(lm);
  DetailDS.DataSet.Open;
  THackRMDTable(DetailDS).GetIndexNames(ld);
  DetailDS.DataSet.Close;
  FillLists;
end;

procedure TRMDFieldsLinkForm.btnClearClick(Sender: TObject);
begin
  FCurFields := '';
  FillLists;
end;

procedure TRMDFieldsLinkForm.lstDetailDrawItem(Control: TWinControl;
  Index: Integer; Rect: TRect; State: TOwnerDrawState);
begin
  with lstDetail.Canvas do
  begin
    if Index > 0 then
      Font.Color := clBtnShadow;
    FillRect(Rect);
    TextOut(Rect.Left + 2, Rect.Top, lstDetail.Items[Index]);
  end;
end;

procedure TRMDFieldsLinkForm.lstDetailClick(Sender: TObject);
begin
  if lstDetail.ItemIndex > 0 then
    lstDetail.ItemIndex := 0;
  if lstMaster.ItemIndex <> -1 then
    btnAdd.Enabled := True;
end;

procedure TRMDFieldsLinkForm.lstMasterClick(Sender: TObject);
begin
  if lstDetail.ItemIndex <> -1 then
    btnAdd.Enabled := True;
end;

procedure TRMDFieldsLinkForm.btnAddClick(Sender: TObject);
var s: String;
begin
  s := lstMaster.Items[lstMaster.ItemIndex];
  if FCurFields = '' then
    FCurFields := s
  else
    FCurFields := FCurFields + ';' + s;
  FillLists;
end;

procedure TRMDFieldsLinkForm.FormDestroy(Sender: TObject);
begin
  ld.Free;
  lm.Free;
end;

procedure TRMDFieldsLinkForm.FormCreate(Sender: TObject);
begin
	Localize;
end;

end.