bottleclient/StrListEditor.pas

   1 unit StrListEditor;
   2
   3 interface
   4
   5 uses
   6   Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
   7   Dialogs, StdCtrls, ExtCtrls, Menus;
   8
   9 type
  10   TfrmStrListEditor = class(TForm)
  11     pnlHeader: TPanel;
  12     pnlFooter: TPanel;
  13     memStrings: TMemo;
  14     btnCancel: TButton;
  15     btnOk: TButton;
  16     lblCaption: TLabel;
  17     mnConst: TPopupMenu;
  18     btnConst: TButton;
  19     procedure memStringsChange(Sender: TObject);
  20     procedure btnOkClick(Sender: TObject);
  21     procedure btnCancelClick(Sender: TObject);
  22     procedure btnConstMouseDown(Sender: TObject; Button: TMouseButton;
  23       Shift: TShiftState; X, Y: Integer);
  24     procedure FormCreate(Sender: TObject);
  25     procedure FormDestroy(Sender: TObject);
  26   private
  27     FCanAllowEmpty: boolean;
  28     FConsts: TStrings;
  29     procedure SetCanAllowEmpty(const Value: boolean);
  30     procedure SetConsts(const Value: TStrings);
  31     { Private \90é\8c¾ }
  32   public
  33     { Public \90é\8c¾ }
  34     procedure InsertConstItem(Sender: TObject);
  35     property CanAllowEmpty: boolean read FCanAllowEmpty write SetCanAllowEmpty;
  36     property Consts: TStrings read FConsts write SetConsts;
  37   end;
  38
  39 var
  40   frmStrListEditor: TfrmStrListEditor;
  41
  42 function StrListEdit(const List: TStrings; CaptionStr: String;
  43   AllowEmpty: boolean = false): boolean; overload;
  44 function StrListEdit(const List: TStrings; CaptionStr: String;
  45   AllowEmpty: boolean; ConstList: TStrings): boolean; overload;
  46
  47 implementation
  48
  49 {$R *.dfm}
  50
  51 function StrListEdit(const List: TStrings; CaptionStr: String;
  52   AllowEmpty: boolean = false): boolean;
  53 begin
  54   Result := StrListEdit(List, CaptionStr, AllowEmpty, nil);
  55 end;
  56
  57 function StrListEdit(const List: TStrings; CaptionStr: String;
  58   AllowEmpty: boolean; ConstList: TStrings): boolean;
  59 var MyfrmStrListEditor: TfrmStrListEditor;
  60 begin
  61   Application.CreateForm(TfrmStrListEditor, MyfrmStrListEditor);
  62   with MyfrmStrListEditor do begin
  63     try
  64       CanAllowEmpty := AllowEmpty;
  65       lblCaption.Caption := CaptionStr;
  66       memStrings.Lines := List; // Using Assign method (of course)
  67       Consts := ConstList;
  68       Result := ShowModal = mrOk;
  69       if Result then List.Assign(memStrings.Lines);
  70     finally
  71       Release;
  72     end;
  73   end;
  74 end;
  75
  76 procedure TfrmStrListEditor.memStringsChange(Sender: TObject);
  77 begin
  78   btnOk.Enabled := (memStrings.Lines.Count > 0) or CanAllowEmpty;
  79 end;
  80
  81 procedure TfrmStrListEditor.btnOkClick(Sender: TObject);
  82 begin
  83   if (memStrings.Lines.Count = 0) and not CanAllowEmpty then Exit;
  84   ModalResult := mrOk;
  85 end;
  86
  87 procedure TfrmStrListEditor.SetCanAllowEmpty(const Value: boolean);
  88 begin
  89   FCanAllowEmpty := Value;
  90 end;
  91
  92 procedure TfrmStrListEditor.btnCancelClick(Sender: TObject);
  93 begin
  94   ModalResult := mrCancel;
  95 end;
  96
  97 procedure TfrmStrListEditor.btnConstMouseDown(Sender: TObject;
  98   Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
  99 var Pos: TPoint;
 100 begin
 101   if Button <> mbLeft then Exit;
 102   if FConsts.Count = 0 then Exit;
 103   Pos := btnConst.ClientToScreen(Point(0, btnConst.Height));
 104   mnConst.Popup(Pos.X, Pos.Y);
 105 end;
 106
 107 procedure TfrmStrListEditor.InsertConstItem(Sender: TObject);
 108 begin
 109   memStrings.Lines.Add(Consts[(Sender as TMenuItem).Tag]);
 110 end;
 111
 112 procedure TfrmStrListEditor.SetConsts(const Value: TStrings);
 113 var i: integer;
 114     AMenu: TMenuItem;
 115 begin
 116   if Value <> nil then begin
 117     FConsts.Assign(Value);
 118     mnConst.Items.Clear;
 119     for i := 0 to Consts.Count-1 do begin
 120       AMenu := TMenuItem.Create(self);
 121       with AMenu do begin
 122         Caption := Consts[i];
 123         Tag := i;
 124         OnClick := InsertConstItem;
 125         if (i mod 20 = 0) and (i > 0) then AMenu.Break := mbBarBreak;
 126       end;
 127       mnConst.Items.Add(AMenu);
 128     end;
 129     btnConst.Visible := true;
 130     btnConst.Enabled := FConsts.Count > 0;
 131   end else begin
 132     FConsts.Clear;
 133     btnConst.Visible := false;
 134   end;
 135 end;
 136
 137 procedure TfrmStrListEditor.FormCreate(Sender: TObject);
 138 begin
 139   FConsts := TStringList.Create;
 140 end;
 141
 142 procedure TfrmStrListEditor.FormDestroy(Sender: TObject);
 143 begin
 144   FConsts.Free;
 145 end;
 146
 147 end.