⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 wwsavflt.pas

📁 InfoPower_Studio 2007 v5.0.1.3 banben
💻 PAS
字号:
unit wwsavflt;
{
//---------------------------------------------------------------------------
// Component to save and restore filters to  text file. - This is
// an example component provided by Woll2Woll.  You are free to use this
// component in your own applications.
//
// Components : TwwSaveFilter
//
// Copyright (c) 1997 by Woll2Woll Software
//
//
}

interface

uses
  SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
  Forms, Dialogs, StdCtrls, Buttons, db, ExtCtrls,
  dbtables, dbctrls, wwstr, wwfltdlg;

type

TwwSaveFilter = class(TComponent)
private
   FDelimiter: string;
   FFilePath: string;
protected
   FOverwriteMessage: boolean;
   FCalledBySave: boolean;
   FFilterDialog: TwwFilterDialog;

   procedure SetFilterDialog(val: TwwFilterDialog);
   Procedure Notification(AComponent: TComponent; Operation: TOperation); override;

public
   constructor create(Owner: TComponent); override;
   destructor destroy; override;
   procedure SaveFilter(FilterName: string); virtual;
   function DeleteFilter(FilterName: string): boolean; virtual;
   function LoadFilter(FilterName: string): boolean; virtual;
   function GetFilterNames(FilterNames: TStrings): boolean; virtual;
   function FilterExists(FilterName: string): boolean; virtual;

published
   property Delimiter: string read FDelimiter write FDelimiter;
   property FilePath: string read FFilePath write FFilePath;
   property OverwriteMessage: boolean read FOverwriteMessage write FOverwriteMessage;
   property wwFilterDialog: TwwFilterDialog read FFilterDialog write SetFilterDialog;
end;

procedure Register;

implementation

constructor TwwSaveFilter.create(Owner: TComponent);
begin
   inherited Create(Owner);
   Delimiter := '///';
   FCalledBySave := False;
   OverwriteMessage := True;
end;

destructor TwwSaveFilter.destroy;
begin
   if (FFilterDialog<>Nil) then FFilterDialog.RemoveDependent(self);
   inherited Destroy;
end;

{ Save filter information to the file}
procedure TwwSaveFilter.SaveFilter(FilterName: string);
var DoOverwrite: boolean;
    TempStringList: TStrings;
    curFieldInfo: TwwFieldInfo;
    NewCaseSensitive: string;
    NewNonMatching: string;
    i: integer;
begin

  if (FilterName='') then exit;

  if not FileExists(FilePath) then
  begin
     TempStringList:= TStringList.create;
     TempStringList.SaveToFile(FilePath);
     TempStringList.Free;
  end;

  if (FilterExists(FilterName)) then
  begin
     if (OverwriteMessage) then
     begin
        DoOverwrite :=
            (MessageDlg('"' + FilterName + '"' + ' already exists.  Overwrite?',
            mtWarning, [mbYes, mbNo], 0)= mrYes);
     end
     else DoOverwrite := true;

     if (DoOverwrite) then DeleteFilter(FilterName)
     else exit;
  end;

  TempStringList := TStringList.create;
  TempStringList.LoadFromFile(FilePath);

  TempStringList.Add(FilterName);
  for i:= 0 to FFilterDialog.FieldInfo.Count-1 do begin
     curFieldInfo := TwwFieldInfo(FFilterDialog.FieldInfo.Items[i]);

     if (curFieldInfo.CaseSensitive) then NewCaseSensitive := 'True'
     else NewCaseSensitive := 'False';

     if (curFieldInfo.NonMatching) then NewNonMatching := 'True'
     else NewNonMatching := 'False';

     TempStringList.Add(curFieldInfo.FieldName + #9 +
                     curFieldInfo.DisplayLabel + #9 +
                     IntToStr(integer(curFieldInfo.MatchType)) + #9 +
                     curFieldInfo.FilterValue + #9 +
                     curFieldInfo.MinValue + #9 +
                     curFieldInfo.MaxValue + #9 +
                     NewCaseSensitive + #9 + NewNonMatching);
  end;

  TempStringList.Add(Delimiter);
  TempStringList.SaveToFile(FilePath);
  TempStringList.Free;
end;

// Check if filter exists in file
function TwwSaveFilter.FilterExists(FilterName: string): boolean;
var TempStringList: TStrings;
    lineNum: integer;
begin
  TempStringList := TStringList.create;
  TempStringList.LoadFromFile(FilePath);
  result:= False;
  lineNum:= 0;
  while(lineNum<TempStringList.Count) do begin
     if (TempStringList.Strings[lineNum] = FilterName) then begin
        result := true;
        break;
     end
     else inc(lineNum);
  end;
  TempStringList.Free;

end;

{ Delete filter from file}
function TwwSaveFilter.DeleteFilter(FilterName: string): boolean;
var TempStringList: TStrings;
    lineNum: integer;
begin
  TempStringList := TStringList.create;
  TempStringList.LoadFromFile(FilePath);
  result:= False;
  lineNum:= 0;
  while(lineNum<TempStringList.Count) do begin
     if (TempStringList.Strings[lineNum] = FilterName) then
     begin
        while (lineNum+1<TempStringList.Count) do
        begin
           TempStringList.Delete(lineNum);
           if (TempStringList.Strings[lineNum]= Delimiter)  then
           begin
              TempStringList.Delete(lineNum);
              result := true;
              break;
           end
        end;
        if (result) then break;
     end
     else inc(lineNum);
  end;
  TempStringList.SaveToFile(FilePath);
  TempStringList.Free;
end;

{
// Pass the name of the filter you want to load, the same name passed
// from the SaveFilterToFile procedure.
}
function TwwSaveFilter.LoadFilter(FilterName: string): boolean;
var myFieldInfoStrings, TempStringList: TStrings;
    lineNum: integer;
    curFieldInfo: TwwFieldInfo;
begin
  TempStringList := TStringList.create;
  TempStringList.LoadFromFile(FilePath);
  lineNum:=0;
  result:= false;

  while(lineNum<TempStringList.Count) do begin
     if (TempStringList.Strings[lineNum] = FilterName) then begin
        FFilterDialog.ClearFilter;
        myFieldInfoStrings := TStringList.create;
        while (lineNum+1<TempStringList.Count) do begin
           inc(lineNum);
           if (TempStringList.Strings[lineNum]= Delimiter) then break;

           curFieldInfo := TwwFieldInfo.create;
           strBreakApart(TempStringList.Strings[lineNum], #9, myFieldInfoStrings);
           curFieldInfo.FieldName := myFieldInfoStrings.Strings[0];
           curFieldInfo.DisplayLabel := myFieldInfoStrings.Strings[1];
           curFieldInfo.MatchType := TwwFilterMatchType(StrToInt(myFieldInfoStrings.Strings[2]));
           curFieldInfo.FilterValue := myFieldInfoStrings.Strings[3];
           curFieldInfo.MinValue := myFieldInfoStrings.Strings[4];
           curFieldInfo.MaxValue := myFieldInfoStrings.Strings[5];

           if (myFieldInfoStrings.Strings[6] = 'True') then
              curFieldInfo.CaseSensitive := True
           else curFieldInfo.CaseSensitive := False;

           if (myFieldInfoStrings.Count-1 > 6) and
              (myFieldInfoStrings.Strings[7] = 'True') then
              curFieldInfo.NonMatching := True
           else curFieldInfo.NonMatching := False;

           FFilterDialog.FieldInfo.Add(curFieldInfo);
        end;
        myFieldInfoStrings.Free;
        FFilterDialog.ApplyFilter;
        result := true;
        break;
     end
     else inc(lineNum);
  end;

  TempStringList.Free;
end;

{
// Get list of filter names
}
function TwwSaveFilter.GetFilterNames(FilterNames: TStrings): boolean;
var TempStringList: TStrings;
   lineNum: integer;
begin
  FilterNames.Clear;
  if (not FileExists(FilePath)) then begin
     result:= false;
     exit;
  end;

  TempStringList := TStringList.create;
  TempStringList.LoadFromFile(FilePath);

  LineNum:=0;
  while(lineNum<TempStringList.Count) do begin
     if (length(TempStringList.Strings[lineNum])=0) then begin{ Skip null lines}
        inc(lineNum);
        continue;
     end;
     if (lineNum<TempStringList.Count) then
        FilterNames.Add(TempStringList.Strings[lineNum]);

     { Skip text until encounter delimeter, then add line following delimeter to list }
     while ((TempStringList.Strings[lineNum] <> Delimiter) and
            (lineNum<TempStringList.Count-1)) do inc(lineNum);
     inc(lineNum);
  end;

  TempStringList.Free;

  result:= FilterNames.count>0;
end;

{// Inform filterdialog to notify us when it is destroyed}
procedure TwwSaveFilter.SetFilterDialog(val: TwwFilterDialog);
begin
   if (FFilterDialog<>Nil) then FFilterDialog.RemoveDependent(self);
   FFilterDialog:=val;
   if (val<>Nil) then
      FFilterDialog.AddDependent(self);
end;

procedure TwwSaveFilter.Notification(AComponent: TComponent; Operation: TOperation);
begin
  inherited Notification(AComponent, Operation);
  if ((Operation = opRemove) and (AComponent = FFilterDialog)) then
    FFilterDialog:= Nil;
end;


procedure Register;
begin
   RegisterComponents('Samples', [TwwSaveFilter]);
end;
end.

⌨️ 快捷键说明

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