bottleclient/BottleChainListFrame.pas

   1 unit BottleChainListFrame;
   2
   3 interface
   4
   5 uses
   6   Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
   7   Dialogs, BottleChainEvent, BottleChainRule, StdCtrls, CheckLst,
   8   BottleChainRuleEditor;
   9
  10 type
  11   TfrmBottleChainList = class(TFrame)
  12     lstRules: TCheckListBox;
  13     btnDelete: TButton;
  14     btnAdd: TButton;
  15     btnDown: TButton;
  16     btnUp: TButton;
  17     btnEdit: TButton;
  18     btnDuplicate: TButton;
  19     procedure lstRulesMeasureItem(Control: TWinControl; Index: Integer;
  20       var Height: Integer);
  21     procedure lstRulesDrawItem(Control: TWinControl; Index: Integer;
  22       Rect: TRect; State: TOwnerDrawState);
  23     procedure lstRulesClickCheck(Sender: TObject);
  24     procedure EditRule(Sender: TObject);
  25     procedure btnAddClick(Sender: TObject);
  26     procedure btnDeleteClick(Sender: TObject);
  27     procedure btnUpClick(Sender: TObject);
  28     procedure btnDownClick(Sender: TObject);
  29     procedure btnDuplicateClick(Sender: TObject);
  30   private
  31     function ExecuteEditRule(Rule: TBottleChainRule): boolean;
  32     procedure UpdateCheckBox;
  33     procedure UpdateHeight;
  34   public
  35     procedure UpdateDisplay;
  36   end;
  37
  38 implementation
  39
  40 {$R *.dfm}
  41
  42 procedure TfrmBottleChainList.lstRulesMeasureItem(Control: TWinControl; Index: Integer;
  43   var Height: Integer);
  44 var Str: String;
  45     ARect: TRect;
  46 begin
  47   ARect := lstRules.ItemRect(Index);
  48   ARect.Left := ARect.Left + 2;
  49   ARect.Right := ARect.Right - 2;
  50
  51   Str := BottleChainRuleList[Index].StringExpression;
  52   //
  53   lstRules.Canvas.Font.Style := lstRules.Canvas.Font.Style + [fsBold];
  54   DrawText(lstRules.Canvas.Handle, PChar(Str), -1,
  55     ARect, DT_NOPREFIX or DT_EDITCONTROL or DT_CALCRECT or DT_WORDBREAK);
  56   Height := ARect.Bottom - ARect.Top;
  57   //
  58
  59   ARect.Left := ARect.Left + 5;
  60   lstRules.Canvas.Font.Style := lstRules.Canvas.Font.Style - [fsBold];
  61   Str := BottleChainRuleList[Index].Title;
  62   DrawText(lstRules.Canvas.Handle, PChar(Str), -1,
  63     ARect, DT_NOPREFIX or DT_EDITCONTROL or DT_CALCRECT or DT_WORDBREAK);
  64   Height := Height + ARect.Bottom - ARect.Top;
  65   Height := Height + 4;
  66 end;
  67
  68 procedure TfrmBottleChainList.lstRulesDrawItem(Control: TWinControl; Index: Integer;
  69   Rect: TRect; State: TOwnerDrawState);
  70 var Str: String;
  71     y: integer;
  72 begin
  73   lstRules.Canvas.FillRect(Rect);
  74
  75   // \83e\83L\83X\83g\95`\89æ\97Ì\88æ\82Ì\83}\81[\83W\83\93\82ð\8eæ\82é
  76   Rect.Left := Rect.Left + 2;
  77   Rect.Top := Rect.Top + 2;
  78   Rect.Right := Rect.Right - 2;
  79   Rect.Bottom := Rect.Bottom - 2;
  80
  81   lstRules.Canvas.Font.Style := lstRules.Canvas.Font.Style + [fsBold];
  82   Str := BottleChainRuleList[Index].Title;
  83   y := DrawText(lstRules.Canvas.Handle, PChar(Str), -1, Rect, DT_NOPREFIX or DT_WORDBREAK);
  84   lstRules.Canvas.Font.Style := lstRules.Canvas.Font.Style - [fsBold];
  85   Str := BottleChainRuleList[Index].StringExpression;
  86   Rect.Top := Rect.Top + y;
  87   Rect.Left := Rect.Left + 5;
  88   DrawText(lstRules.Canvas.Handle, PChar(Str), -1, Rect, DT_NOPREFIX or DT_WORDBREAK);
  89 end;
  90
  91 procedure TfrmBottleChainList.UpdateDisplay;
  92 var i: integer;
  93     sel: TBottleChainRule;
  94 begin
  95   i := lstRules.ItemIndex;
  96   if i >= 0 then begin
  97     if i <= BottleChainRuleList.Count-1 then
  98       sel := BottleChainRuleList[i]
  99     else if BottleChainRuleList.Count > 0 then
 100       sel := BottleChainRuleList[BottleChainRuleList.Count-1]
 101     else
 102       sel := nil;
 103   end else sel := nil;
 104
 105   lstRules.Items.BeginUpdate;
 106   lstRules.Items.Clear;
 107   for i := 0 to BottleChainRuleList.Count-1 do begin
 108     lstRules.Items.Add(BottleChainRuleList.Rules[i].StringExpression);
 109     lstRules.Checked[i] := BottleChainRuleList[i].Enabled;
 110   end;
 111   lstRules.Items.EndUpdate;
 112   lstRules.ItemIndex := BottleChainRuleList.List.IndexOf(sel);
 113 end;
 114
 115 procedure TfrmBottleChainList.lstRulesClickCheck(Sender: TObject);
 116 var i: integer;
 117 begin
 118   for i := 0 to BottleChainRuleList.Count-1 do begin
 119     BottleChainRuleList[i].Enabled := lstRules.Checked[i];
 120   end;
 121 end;
 122
 123 procedure TfrmBottleChainList.EditRule(Sender: TObject);
 124 var
 125   Edit: TBottleChainRule;
 126 begin
 127   if lstRules.ItemIndex <> -1 then
 128   begin
 129     Edit := TBottleChainRule.Create(nil);
 130     try
 131       Edit.Assign(BottleChainRuleList[lstRules.ItemIndex]);
 132       if ExecuteEditRule(Edit) then
 133         BottleChainRuleList[lstRules.ItemIndex].Assign(Edit);
 134     finally
 135       Edit.Free;
 136     end;
 137     UpdateHeight;
 138   end;
 139 end;
 140
 141 procedure TfrmBottleChainList.btnAddClick(Sender: TObject);
 142 var
 143   New: TBottleChainRule;
 144 begin
 145   New := TBottleChainRule.Create(BottleChainRuleList);
 146   try
 147     New.Enabled := true;
 148     if ExecuteEditRule(New) then
 149     begin
 150       New.RuleList := BottleChainRuleList; // \8e©\95ª\82ð\83\8a\83X\83g\82É\92Ç\89Á\82·\82é
 151       UpdateDisplay;
 152     end
 153     else
 154       New.Free;
 155   except
 156     New.Free;
 157   end;
 158 end;
 159
 160 procedure TfrmBottleChainList.btnDeleteClick(Sender: TObject);
 161 var
 162   Del: TBottleChainRule;
 163   Index: integer;
 164 begin
 165   Index := lstRules.ItemIndex;
 166   if Index < 0 then
 167     Exit;
 168   Del := BottleChainRuleList[Index];
 169   Del.Free;
 170   lstRules.Items.Delete(Index);
 171 end;
 172
 173 procedure TfrmBottleChainList.btnUpClick(Sender: TObject);
 174 var i: integer;
 175 begin
 176   i := lstRules.ItemIndex;
 177   if i > 0 then begin
 178     BottleChainRuleList.List.Move(i, i - 1);
 179     lstRules.Items.Move(i, i-1);
 180     lstRules.ItemIndex := i - 1;
 181     UpdateHeight;
 182   end;
 183 end;
 184
 185 procedure TfrmBottleChainList.btnDownClick(Sender: TObject);
 186 var i: integer;
 187 begin
 188   i := lstRules.ItemIndex;
 189   if (i >= 0) and (i < lstRules.Items.Count-1) then begin
 190     BottleChainRuleList.List.Move(i, i + 1);
 191     lstRules.Items.Move(i, i+1);
 192     lstRules.ItemIndex := i + 1;
 193     UpdateHeight;
 194   end;
 195 end;
 196
 197 function TfrmBottleChainList.ExecuteEditRule(Rule: TBottleChainRule): boolean;
 198 var MyfrmBottleChainRuleEditor: TfrmBottleChainRuleEditor;
 199 begin
 200   Application.CreateForm(TfrmBottleChainRuleEditor, MyfrmBottleChainRuleEditor);
 201   with MyfrmBottleChainRuleEditor do begin
 202     try
 203       Result := Execute(Rule);
 204     finally
 205       Release;
 206     end;
 207   end;
 208 end;
 209
 210 procedure TfrmBottleChainList.btnDuplicateClick(Sender: TObject);
 211 var
 212   New: TBottleChainRule;
 213 begin
 214   if lstRules.ItemIndex <> -1 then
 215   begin
 216     New := TBottleChainRule.Create(BottleChainRuleList);
 217     New.Assign(BottleChainRuleList.Rules[lstRules.ItemIndex]);
 218     New.RuleList := BottleChainRuleList; // \82±\82ê\82Å\83\8b\81[\83\8b\83\8a\83X\83g\82É\82Í\92Ç\89Á\82³\82ê\82é
 219     lstRules.Items.Insert(lstRules.ItemIndex + 1, New.StringExpression);
 220     UpdateCheckBox;
 221     UpdateHeight;
 222   end;
 223 end;
 224
 225 procedure TfrmBottleChainList.UpdateCheckBox;
 226 var
 227   i: integer;
 228 begin
 229   for i := 0 to BottleChainRuleList.Count-1 do
 230     lstRules.Checked[i] := BottleChainRuleList[i].Enabled;
 231 end;
 232
 233 procedure TfrmBottleChainList.UpdateHeight;
 234 begin
 235   with lstRules do
 236   begin
 237     Style := lbOwnerDrawFixed;
 238     Style := lbOwnerDrawVariable;
 239   end;
 240 end;
 241
 242 end.