controls/listedit/mckListEdit.pas

   1 unit mckListEdit;
   2
   3 interface
   4
   5 uses
   6   Windows, Classes, Messages, Forms, SysUtils,
   7   mckCtrls, Graphics;
   8
   9 type
  10
  11   TListEditColumns = class;
  12
  13   TKOLListEdit = class(TKOLListView)
  14   private
  15     fColumns: TListEditColumns;
  16     fColCount: integer;
  17     fListData: boolean;
  18   protected
  19     function  AdditionalUnits: string; override;
  20     procedure SetupFirst( SL: TStringList; const AName, AParent, Prefix: String ); override;
  21     procedure SetupLast( SL: TStringList; const AName, AParent, Prefix: String ); override;
  22     procedure AssignEvents( SL: TStringList; const AName: String ); override;
  23     function GetCaption: string;
  24     function GetStyle: TKOLListViewStyle;
  25     function GetOptions: TKOLListViewOptions;
  26     procedure SetOptions(v: TKOLListViewOptions);
  27     function GetColumns: TListEditColumns; virtual;
  28     procedure SetColumns(v: TListEditColumns);
  29     function  GetColCount: integer;
  30     procedure SetColCount(v: integer);
  31   public
  32     constructor Create(Owner: TComponent); override;
  33     property IsListData: boolean read fListData write fListData;
  34     procedure UpdateColumns; virtual;
  35   published
  36     property Caption: string Read GetCaption;
  37     property Style: TKOLListViewStyle Read GetStyle;
  38     property Options: TKOLListViewOptions read GetOptions write SetOptions;
  39     property Columns: TListEditColumns read fColumns write SetColumns;
  40     property ColCount: integer read GetColCount write SetColCount;
  41   end;
  42
  43   TListEditColumnsItem = class(TCollectionItem)
  44   private
  45     fCaption: string;
  46     fAlign: TAlignment;
  47     fWidth: integer;
  48     fFieldName: string;
  49   protected
  50     procedure SetAlignment(a: TAlignment);
  51     procedure SetCaption(c: string);
  52     procedure SetWidth(w: integer);
  53   published
  54     property Alignment: TAlignment read fAlign write fAlign;
  55     property Caption: string read fCaption write fCaption;
  56     property Width: integer read fWidth write fWidth;
  57     property FieldName: string read fFieldName write fFieldName;
  58   end;
  59
  60   TListEditColumns = class(TCollection)
  61   private
  62     FOwner: TKOLListEdit;
  63     function GetItem(Index: Integer): TListEditColumnsItem;
  64     procedure SetItem(Index: Integer; Value: TListEditColumnsItem);
  65   protected
  66     function GetOwner: TPersistent; override;
  67   public
  68     FieldNames: TStringList;
  69     constructor Create(AOwner: TKOLListEdit);
  70     destructor Destroy; override;
  71     function Owner: TKOLListEdit;
  72     property Items[Index: Integer]: TListEditColumnsItem read GetItem write SetItem; default;
  73   end;
  74
  75   procedure Register;
  76
  77 implementation
  78
  79 {$R *.dcr}
  80
  81 constructor TKOLListEdit.Create;
  82 begin
  83    inherited;
  84    inherited Style   := lvsDetail;
  85    inherited Options := [lvoRowSelect];
  86    Font.FontCharset  := 204;
  87    fColumns := TListEditColumns.Create(self);
  88 end;
  89
  90 procedure TKOLListEdit.UpdateColumns;
  91 begin
  92    Change;
  93 end;
  94
  95 function  TKOLListEdit.AdditionalUnits;
  96 begin
  97    Result := ', ListEdit';
  98 end;
  99
 100 procedure TKOLListEdit.SetupFirst;
 101 var i: integer;
 102     s: string;
 103 begin
 104   inherited;
 105   for i := 0 to fColumns.Count - 1 do begin
 106      case fColumns.Items[i].Alignment of
 107     taLeftJustify:   s := 'taLeft';
 108     taCenter:        s := 'taCenter';
 109     taRightJustify:  s := 'taRight';
 110      end;
 111      SL.Add( Prefix + AName + '.LVColAdd(''' + fColumns.Items[i].Caption + ''',' + s + ' , ' + intTostr(fColumns.Items[i].Width) + ');' );
 112   end;
 113 end;
 114
 115 procedure TKOLListEdit.SetupLast;
 116 begin
 117    inherited AssignEvents(SL, AName);
 118 end;
 119
 120 procedure TKOLListEdit.AssignEvents;
 121 begin
 122    inherited;
 123 end;
 124
 125 function TKOLListEdit.GetCaption;
 126 begin
 127    Result := inherited Caption;
 128 end;
 129
 130 function TKOLListEdit.GetStyle;
 131 begin
 132    Result := lvsDetail;
 133 end;
 134
 135 function TKOLListEdit.GetOptions;
 136 begin
 137    Result := inherited Options;
 138 end;
 139
 140 procedure TKOLListEdit.SetOptions;
 141 begin
 142    inherited Options := v + [lvoRowSelect];
 143 end;
 144
 145 function  TKOLListEdit.GetColumns;
 146 begin
 147    Result := fColumns;
 148 end;
 149
 150 procedure TKOLListEdit.SetColumns;
 151 begin
 152    fColumns.Assign(v);
 153    Change;
 154 end;
 155
 156 function  TKOLListEdit.GetColCount;
 157 begin
 158    Result := fColumns.Count;
 159 end;
 160
 161 procedure TKOLListEdit.SetColCount;
 162 begin
 163    fColCount := v;
 164    if fColCount < 0 then fColCount := 0;
 165    while fColCount > fColumns.Count do fColumns.Add;
 166    while fColCount < fColumns.Count do fColumns[fColumns.Count - 1].Free;
 167    Change;
 168 end;
 169
 170 procedure TListEditColumnsItem.SetAlignment;
 171 begin
 172    fAlign := A;
 173    TListEditColumns(GetOwner).FOwner.Change;
 174 end;
 175
 176 procedure TListEditColumnsItem.SetCaption;
 177 begin
 178    fCaption := C;
 179 end;
 180
 181 procedure TListEditColumnsItem.SetWidth;
 182 begin
 183    fWidth := W;
 184 end;
 185
 186 constructor TListEditColumns.Create;
 187 begin
 188    inherited create(TListEditColumnsItem);
 189    fOwner := AOwner;
 190    FieldNames := TStringList.Create;
 191 end;
 192
 193 destructor TListEditColumns.Destroy;
 194 begin
 195    FieldNames.Free;
 196    inherited;
 197 end;
 198
 199 function  TListEditColumns.GetItem;
 200 begin
 201   result := TListEditColumnsItem(inherited GetItem(Index));
 202 end;
 203
 204 procedure TListEditColumns.SetItem;
 205 begin
 206   inherited SetItem(Index, Value);
 207   FOwner.Change;
 208 end;
 209
 210 function  TListEditColumns.GetOwner;
 211 begin
 212   result := FOwner;
 213 end;
 214
 215 function  TListEditColumns.Owner;
 216 begin
 217   result := FOwner;
 218 end;
 219
 220 procedure Register;
 221 begin
 222   RegisterComponents('KOLUtil', [TKOLListEdit]);
 223 end;
 224
 225 end.
 226