filtered.pas

来自「delphi编程控件」· PAS 代码 · 共 211 行

PAS
211
字号
unit filtered;
(*
 COPYRIGHT (c) RSD software 1997 - 98
 All Rights Reserved.
*)

interface

{$I aclver.inc}
uses Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, Buttons, ExtCtrls, DB, MacroEd;

type
  TAutoDataSetFilterEdit = class(TForm)
    Panel: TPanel;
    BOk: TButton;
    Edit: TEdit;
    BCancel: TButton;
    CheckBox: TCheckBox;
    BMEditor: TButton;
    BHelp: TButton;
    procedure CheckBoxClick(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure MemoKeyDown(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure BMEditorClick(Sender: TObject);
  private
    AutoDataSet : TDataSet;
  end;

function EditAutoDataSetFilter(AAutoDataSet : TDataSet; Var StFilter : String) : Boolean;

implementation
uses autostrs, audbstrs, afilter, TypInfo;
{$R *.DFM}

Var
  AFiltered : Boolean;
  SaveStrings : TStrings;
  Macros : TMacros;

procedure AssignMacros(AutoDataSet : TDataSet);
Var
  PropInfo : PPropInfo;
  AMacros : TMacros;
begin
  PropInfo := GetPropInfo(AutoDataSet.ClassInfo, 'Macros');
  if(PropInfo <> Nil) then begin
    AMacros := TMacros(GetOrdProp(AutoDataSet, PropInfo));
    if(AMacros <> Nil) then
      AMacros.Assign(Macros);
  end;
end;

procedure GetMacros(AutoDataSet : TDataSet);
Var
  PropInfo : PPropInfo;
  AMacros : TMacros;
begin
  PropInfo := GetPropInfo(AutoDataSet.ClassInfo, 'Macros');
  if(PropInfo <> Nil) then begin
    AMacros := TMacros(GetOrdProp(AutoDataSet, PropInfo));
    if(AMacros <> Nil) then
      Macros.Assign(AMacros);
  end;
end;

procedure RefreshMacros(IsDialogShow : Boolean; Lines : TStrings; AutoDataSet : TDataSet);
var
  i, Count, Max : integer;
  List : TMacros;
  MacroOption : TMacroOption;
  PCh, PCh1 : PChar;
begin
  if AFiltered then begin
    MacroOption := moFilter;
    PCh := StrAlloc(Length(Lines[0]) + 1);
    PCh := StrPCopy(PCh, Lines[0]);
  end else begin
    MacroOption := moSQL;
    Count := 1;
    Max := 1;
    for i := 0 to Lines.Count - 1 do begin
      if(Length(Lines[i]) + 2 > Max) then
        Max := Length(Lines[i]) + 2;
      Inc(Count, Length(Lines[i]) + 2);
    end;
    PCh := StrAlloc(Count);
    PCh1 := StrAlloc(Max);
    PCh := StrPCopy(PCh, '');
    for i := 0 to Lines.Count - 1 do begin
      PCh1 := StrPCopy(PCh1, Lines[i] + ' ');
      PCh := StrCat(PCh, PCh1);
    end;
    StrDispose(PCh1);
  end;

  List := TMacros.Create;
  try
    CreateMacros(List, PCh, [MacroOption]);

    for i := 0 to Macros.Count - 1 do
      if Not (MacroOption in Macros[i].MacroOptions) then
        List.CreateMacro(Macros[i].Name );

    List.AssignValues(Macros);
    if(IsDialogShow) then
      EditDataSetMacros(AutoDataSet.Name, List);

    Macros.Free;
    Macros := List;
  except
    List.Free;
  end;
  StrDispose(PCh);
end;

function ReplaceMacrosInString(const S: string; AutoDataSet : TDataSet): string;
var
  I, P: Integer;
  Macro: TMacro;
  Temp: string;
begin
  Result := S;

  for I := 0 to Macros.Count - 1 do begin
    Macro := Macros[I];
    repeat
      P := Pos('&' + Macro.Name, Result);
      if P > 0 then begin
        Temp := Macro.Text;
        Result := Copy(Result, 1, P - 1) + Temp + Copy(Result,
        P + Length(Macro.Name) + 1, MaxInt);
      end;
    until P = 0;
  end;

end;

function EditAutoDataSetFilter(AAutoDataSet : TDataSet; Var StFilter : String) : Boolean;
Var
  AForm : TAutoDataSetFilterEdit;
begin
  Result := False;
  AForm := TAutoDataSetFilterEdit.Create(Nil);
  with AForm do begin
    AutoDataSet := AAutoDataSet;
    Caption := AAutoDataSet.Name + '.Filter';
    AFiltered := True;
    Edit.Text := StFilter;
    GetMacros(AutoDataSet);
    ShowModal;
  end;
  if(AForm.ModalResult = mrOk) then begin
    StFilter := AForm.Edit.Text;
    SaveStrings[0] := AForm.Edit.Text;
    RefreshMacros(False, SaveStrings, AForm.AutoDataSet);
    AssignMacros(AForm.AutoDataSet);
    Result := True;
  end;
  AForm.Free;
end;

procedure TAutoDataSetFilterEdit.CheckBoxClick(Sender: TObject);
begin
  BMEditor.Enabled := CheckBox.Checked = False;
  if(CheckBox.Checked) then begin
    SaveStrings[0] := Edit.Text;
    Edit.Text := ReplaceMacrosInString(Edit.Text, AutoDataSet);
    RefreshMacros(False, SaveStrings, AutoDataSet);
    Edit.ReadOnly := True;
  end else begin
    Edit.Text := SaveStrings[0];
    Edit.ReadOnly := False;
  end;
end;

procedure TAutoDataSetFilterEdit.FormCreate(Sender: TObject);
begin
  SaveStrings := TStringList.Create;
  SaveStrings.Add('');
  Macros := TMacros.Create;
  BOK.Caption := LoadStr(ACB_OK);
  BCancel.Caption := LoadStr(ACB_CANCEL);
  BHelp.Caption := LoadStr(ACB_HELP);
  BMEditor.Caption := LoadStr(ACDB_MACROSEDITOR);
  CheckBox.Caption := LoadStr(ACDB_VIEWWITHOUTMACROS);
end;

procedure TAutoDataSetFilterEdit.FormDestroy(Sender: TObject);
begin
  SaveStrings.Free;
  Macros.Free;
end;

procedure TAutoDataSetFilterEdit.MemoKeyDown(Sender: TObject;
  var Key: Word; Shift: TShiftState);
begin
  if(Key = VK_ESCAPE) then
    ModalResult := mrCancel;
end;

procedure TAutoDataSetFilterEdit.BMEditorClick(Sender: TObject);
begin
  SaveStrings[0] := Edit.Text;
  RefreshMacros(True, SaveStrings, AutoDataSet);
end;

end.

⌨️ 快捷键说明

复制代码Ctrl + C
搜索代码Ctrl + F
全屏模式F11
增大字号Ctrl + =
减小字号Ctrl + -
显示快捷键?