bottleclient/SearchLog.pas

   1 unit SearchLog;
   2
   3 // \81u\83\8d\83O\82Ì\8c\9f\8dõ\81v\83t\83H\81[\83\80\82Æ\81A\82»\82Ì\8c\9f\8dõ\8fð\8c\8f
   4
   5 interface
   6
   7 uses
   8   Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
   9   Dialogs, StdCtrls, ExtCtrls, Spin, BRegExp;
  10
  11 type
  12   // \8c\9f\8dõ\8fð\8c\8f\82ð\95\\82·\83N\83\89\83X\81B
  13   // \8cã\82Å\89½\82ç\82©\82Ì\95û\96@\82Å\89i\91±\89»\82·\82é\82©\82à\82µ\82ê\82È\82¢\82Ì\82Å\95Ê\83N\83\89\83X\82É\82·\82é
  14   TSearchLogRange = (srSelectedLogList, srAboveSelectedLog, srAllLogLists);
  15
  16   TSearchCond = class(TComponent)
  17   private
  18     FScriptRegExp: boolean;
  19     FMinLength: integer;
  20     FMaxLength: integer;
  21     FGhost: String;
  22     FChannel: String;
  23     FScriptPattern: String;
  24     FMinVote: integer;
  25     FMinAgree: integer;
  26     FSearchLogRange: TSearchLogRange;
  27     procedure SetChannel(const Value: String);
  28     procedure SetGhost(const Value: String);
  29     procedure SetMaxLength(const Value: integer);
  30     procedure SetMinLength(const Value: integer);
  31     procedure SetScriptPattern(const Value: String);
  32     procedure SetScriptRegExp(const Value: boolean);
  33     procedure SetMinAgree(const Value: integer);
  34     procedure SetMinVote(const Value: integer);
  35     procedure SetSearchLogRange(const Value: TSearchLogRange);
  36   public
  37     procedure Assign(Source: TPersistent); override;
  38     function IsInvalidCondition: boolean;
  39   published
  40     property ScriptPattern: String read FScriptPattern write SetScriptPattern;
  41     property ScriptRegExp: boolean read FScriptRegExp write SetScriptRegExp;
  42     property Channel: String read FChannel write SetChannel;
  43     property Ghost: String read FGhost write SetGhost;
  44     property MinLength: integer read FMinLength write SetMinLength; //\96¢\8eÀ\91\95
  45     property MaxLength: integer read FMaxLength write SetMaxLength; //\96¢\8eÀ\91\95
  46     property MinVote: integer read FMinVote write SetMinVote;
  47     property MinAgree: integer read FMinAgree write SetMinAgree;
  48     property SearchLogRange: TSearchLogRange read FSearchLogRange write SetSearchLogRange;
  49   end;
  50
  51   // \83\8d\83O\82Ì\8c\9f\8dõ\83t\83H\81[\83\80
  52   TfrmSearchLog = class(TForm)
  53     btnOk: TButton;
  54     btnCancel: TButton;
  55     gbxCondition: TGroupBox;
  56     lblScriptPattern: TLabel;
  57     lblChannel: TLabel;
  58     lblGhost: TLabel;
  59     edtScriptPattern: TEdit;
  60     cbxScriptRegExp: TCheckBox;
  61     cbxGhost: TComboBox;
  62     cbxChannel: TComboBox;
  63     rgpSearchLogRange: TRadioGroup;
  64     lblMinVote: TLabel;
  65     lblMinAgree: TLabel;
  66     spnMinVote: TSpinEdit;
  67     spnMinAgree: TSpinEdit;
  68     lblMinVote2: TLabel;
  69     lblMinAgree2: TLabel;
  70     procedure btnOkClick(Sender: TObject);
  71     procedure btnCancelClick(Sender: TObject);
  72   private
  73     FCondition: TSearchCond;
  74     procedure SetCondition(const Value: TSearchCond);
  75     procedure SetChannelList(const Value: TStrings);
  76     procedure SetGhostList(const Value: TStrings);
  77     function GetChannelList: TStrings;
  78     function GetGhostList: TStrings;
  79   public
  80     constructor Create(AOwner: TComponent); override;
  81     destructor Destroy; override;
  82     function Execute: boolean;
  83     property Condition: TSearchCond read FCondition write SetCondition;
  84     property GhostList: TStrings read GetGhostList write SetGhostList;
  85     property ChannelList: TStrings read GetChannelList write SetChannelList;
  86   end;
  87
  88 var
  89   frmSearchLog: TfrmSearchLog;
  90
  91 implementation
  92
  93 {$R *.dfm}
  94
  95 { TSearchCond }
  96
  97 procedure TSearchCond.Assign(Source: TPersistent);
  98 var
  99   Src: TSearchCond;
 100 begin
 101   if not (Source is TSearchCond) then
 102     inherited
 103   else
 104   begin
 105     Src := Source as TSearchCond;
 106     FScriptPattern := Src.ScriptPattern;
 107     FScriptRegExp  := Src.ScriptRegExp;
 108     FChannel       := Src.Channel;
 109     FGhost         := Src.Ghost;
 110     FMinLength     := Src.MinLength;
 111     FMaxLength     := Src.MaxLength;
 112     FMinVote       := Src.MinVote;
 113     FMinAgree      := Src.MinAgree;
 114     SearchLogRange := Src.SearchLogRange;
 115   end;
 116 end;
 117
 118 function TSearchCond.IsInvalidCondition: boolean;
 119 begin
 120   // \8bó\82Á\82Û\82Ì\8fð\8c\8f\82Å\82Í\82È\82¢\82±\82Æ\82ð\83`\83F\83b\83N
 121   Result := true;
 122   if ScriptPattern <> '' then
 123     Result := false;
 124   if (Channel <> '') or (Ghost <> '') then
 125     Result := false;
 126   if (MinVote > 0) or (MinAgree > 0) then
 127     Result := false;
 128   { if (MinLength > 0) or (MaxLength > 0) then
 129     Result := false; }
 130 end;
 131
 132 procedure TSearchCond.SetChannel(const Value: String);
 133 begin
 134   FChannel := Value;
 135 end;
 136
 137 procedure TSearchCond.SetGhost(const Value: String);
 138 begin
 139   FGhost := Value;
 140 end;
 141
 142 procedure TSearchCond.SetMaxLength(const Value: integer);
 143 begin
 144   FMaxLength := Value;
 145 end;
 146
 147 procedure TSearchCond.SetMinAgree(const Value: integer);
 148 begin
 149   FMinAgree := Value;
 150 end;
 151
 152 procedure TSearchCond.SetMinLength(const Value: integer);
 153 begin
 154   FMinLength := Value;
 155 end;
 156
 157 procedure TSearchCond.SetMinVote(const Value: integer);
 158 begin
 159   FMinVote := Value;
 160 end;
 161
 162 procedure TSearchCond.SetScriptPattern(const Value: String);
 163 begin
 164   FScriptPattern := Value;
 165 end;
 166
 167 procedure TSearchCond.SetScriptRegExp(const Value: boolean);
 168 begin
 169   FScriptRegExp := Value;
 170 end;
 171
 172 { TTfrmSearchLog }
 173
 174 function TfrmSearchLog.Execute: boolean;
 175 var
 176   Backup: TSearchCond;
 177 begin
 178   // \83L\83\83\83\93\83Z\83\8b\8e\9e\82É\90Ý\92è\82ª\95Ï\82í\82ç\82È\82¢\82æ\82¤\82É\83o\83b\83N\83A\83b\83v
 179   Backup := TSearchCond.Create(nil);
 180   try
 181     Backup.Assign(Condition);
 182     with Condition do
 183     begin
 184       edtScriptPattern.Text   := ScriptPattern;
 185       cbxScriptRegExp.Checked := ScriptRegExp;
 186       cbxChannel.Text   := Channel;
 187       cbxGhost.Text     := Ghost;
 188       spnMinVote.Value  := MinVote;
 189       spnMinAgree.Value := MinAgree;
 190       rgpSearchLogRange.ItemIndex := Ord(SearchLogRange);
 191     end;
 192     Result := ShowModal = mrOk;
 193     // \83L\83\83\83\93\83Z\83\8b\8e\9e\82É\82Í\90Ý\92è\82ð\8c³\82É\96ß\82·
 194     if not Result then
 195       Condition.Assign(Backup);
 196   finally
 197     Backup.Free;
 198   end;
 199 end;
 200
 201 procedure TfrmSearchLog.SetCondition(const Value: TSearchCond);
 202 begin
 203   FCondition.Assign(Value);
 204 end;
 205
 206 procedure TfrmSearchLog.btnOkClick(Sender: TObject);
 207 var tmpScriptPattern,tmpStringReplace : String;
 208 begin
 209   tmpScriptPattern := edtScriptPattern.Text;
 210
 211   if cbxScriptRegExp.Checked then
 212   begin
 213     if tmpScriptPattern <> '' then
 214     begin
 215       try
 216         //Perl\82Ì\90³\8bK\95\\8c»\8d\\95¶\82É\83}\83b\83`\82·\82é\90³\8bK\95\\8c»\82Å\83`\83F\83b\83N
 217         if not brx.Match('m/^m?(.).+\1\w*$/k',tmpScriptPattern) then
 218         begin
 219           tmpStringReplace := tmpScriptPattern;
 220           tmpStringReplace := StringReplace(tmpStringReplace, '/', '\/', [rfReplaceAll]);
 221           tmpScriptPattern := 'm/' + tmpStringReplace + '/k'; //k\83I\83v\83V\83\87\83\93\82Í\8a¿\8e\9a\91Î\89\9e
 222         end;
 223       except
 224         tmpScriptPattern := '';
 225       end;
 226     end;
 227   end;
 228
 229   // \8c\8b\89ÊOK\82Å\83E\83B\83\93\83h\83E\82ð\95Â\82¶\82é
 230   with Condition do
 231   begin
 232     ScriptPattern := tmpScriptPattern;
 233     ScriptRegExp  := cbxScriptRegExp.Checked;
 234     Channel  := cbxChannel.Text;
 235     Ghost    := cbxGhost.Text;
 236     MinVote  := spnMinVote.Value;
 237     MinAgree := spnMinAgree.Value;
 238     SearchLogRange := TSearchLogRange(rgpSearchLogRange.ItemIndex);
 239   end;
 240   if Condition.IsInvalidCondition then
 241     ShowMessage('\8fð\8c\8f\82ð\8ew\92è\82µ\82Ä\82\82¾\82³\82¢')
 242   else
 243     ModalResult := mrOk;
 244 end;
 245
 246 procedure TfrmSearchLog.btnCancelClick(Sender: TObject);
 247 begin
 248   // \8c\8b\89Ê\83L\83\83\83\93\83Z\83\8b\82Å\83E\83B\83\93\83h\83E\82ð\95Â\82¶\82é
 249   ModalResult := mrCancel;
 250 end;
 251
 252 procedure TfrmSearchLog.SetChannelList(const Value: TStrings);
 253 begin
 254   cbxChannel.Items.Assign(Value);
 255 end;
 256
 257 procedure TfrmSearchLog.SetGhostList(const Value: TStrings);
 258 begin
 259   cbxGhost.Items.Assign(Value);
 260 end;
 261
 262 constructor TfrmSearchLog.Create(AOwner: TComponent);
 263 begin
 264   inherited;
 265   FCondition := TSearchCond.Create(nil);
 266 end;
 267
 268 destructor TfrmSearchLog.Destroy;
 269 begin
 270   FCondition.Free;
 271   inherited;
 272 end;
 273
 274 function TfrmSearchLog.GetChannelList: TStrings;
 275 begin
 276   Result := cbxChannel.Items;
 277 end;
 278
 279 function TfrmSearchLog.GetGhostList: TStrings;
 280 begin
 281   Result := cbxGhost.Items;
 282 end;
 283
 284 procedure TSearchCond.SetSearchLogRange(const Value: TSearchLogRange);
 285 begin
 286   FSearchLogRange := Value;
 287 end;
 288
 289 end.