#1 2013-06-22 10:57:02

esmondb
Member
From: London
Registered: 2010-07-20
Posts: 299

Column Picker Form

I've created a form for selecting fields from a TSQLRecord. As it's fairly generic it could be useful to others so I've posted it below.

BTW I found a small typo in TSynButton.CreateKind where the 'right' parameter should be 'top'.

unit ColumnPicker;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes,
  Vcl.Graphics, Vcl.Controls, Vcl.Forms, Vcl.Dialogs, mORMot, SynCommons, SynTaskDialog,
  Vcl.ExtCtrls, Vcl.StdCtrls, Vcl.CheckLst;

type
  TColumnPickerForm = class(TForm)
    procedure ToggleAllCheckBoxClick(Sender: TObject);
    procedure FieldsCheckListBoxClickCheck(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
  protected
    OKBtn, CancelBtn: TSynButton;
    BottomPanel: TPanel;
    ToggleAllCheckBox: TCheckBox;
    FieldsCheckListBox: TCheckListbox;
  private
    fTableName: RawUTF8;
    fFieldNames: TRawUTF8DynArray;
    function getToggleAllCheckboxState: TCheckBoxState;
    function getSelStatement: RawUTF8;
  public
    constructor Create(AOwner: TComponent; ARecord: TSQLRecord); reintroduce;
    property SelectStatement: RawUTF8 read getSelStatement;
  end;

implementation

{$R *.dfm}

constructor TColumnPickerForm.Create(AOwner: TComponent; ARecord: TSQLRecord);
var
  i : integer;
begin
  inherited Create(aOwner);
  width := 300;
  height := 400;
  fTableName := ARecord.RecordProps.SQLTableName;
  Caption := fTableName;
  ToggleAllCheckBox := TCheckBox.Create(self);
  ToggleAllCheckBox.Parent := self;
  ToggleAllCheckBox.Align := alTop;
  ToggleAllCheckBox.AlignWithMargins := true;
  ToggleAllCheckBox.Margins.Left := 1;
  ToggleAllCheckBox.OnClick := ToggleAllCheckBoxClick;
  BottomPanel := TPanel.Create(self);
  BottomPanel.Parent := self;
  BottomPanel.Caption := '';
  BottomPanel.Align := alBottom;
  BottomPanel.BevelOuter := bvNone;
  FieldsCheckListBox := TCheckListbox.Create(self);
  FieldsCheckListBox.BorderStyle := bsNone;
  FieldsCheckListBox.Parent := self;
  FieldsCheckListBox.Align := alClient;
  FieldsCheckListBox.OnClickCheck := FieldsCheckListBoxClickCheck;
  SetLength(fFieldNames, ARecord.RecordProps.Fields.Count);
  for i := 0 to ARecord.RecordProps.Fields.Count -1 do begin
    FieldsCheckListBox.Items.Append(UTF8toString(UnCamelCase(ARecord.RecordProps.Fields.Items[i].Name)));
    fFieldNames[i] := ARecord.RecordProps.Fields.Items[i].Name
  end;
  OKBtn := TSynButton.CreateKind(BottomPanel, cbOK, 180, 4, 89, 33);
  CancelBtn := TSynButton.CreateKind(BottomPanel, cbCancel, 80, 4, 89, 33);
  OnDestroy := FormDestroy;
end;

procedure TColumnPickerForm.FormDestroy(Sender: TObject);
begin
  SetLength(fFieldNames, 0);
end;

procedure TColumnPickerForm.ToggleAllCheckBoxClick(Sender: TObject);
begin
  if ToggleAllCheckBox.State <> cbGrayed then
    if ToggleAllCheckBox.Checked then
      FieldsCheckListBox.CheckAll(cbChecked, false, false)
    else
      FieldsCheckListBox.CheckAll(cbUnChecked, false, false);
end;

function TColumnPickerForm.getToggleAllCheckboxState: TCheckBoxState;
var
  i, cnt : integer;
  firstCheck: boolean;
begin
  result := cbUnchecked;
  if FieldsCheckListBox.Items.Count = 0 then exit;
  firstCheck := FieldsCheckListBox.Checked[0];
  if firstCheck then result := cbChecked;
  for i := 1 to FieldsCheckListBox.Items.Count-1 do
    if FieldsCheckListBox.Checked[i] <> firstCheck then begin
      result := cbGrayed;
      break;
    end;
end;

procedure TColumnPickerForm.FieldsCheckListBoxClickCheck(Sender: TObject);
begin
  ToggleAllCheckbox.State := getToggleAllCheckboxState;
end;

function TColumnPickerForm.getSelStatement: RawUTF8;
var
  i : integer;
begin
  result := 'SELECT ' + fTableName + '.ID';
  if ToggleAllCheckBox.Checked then
    result := 'SELECT *'
  else if ToggleAllCheckBox.State = cbGrayed then begin
    for i := 0 to FieldsCheckListBox.Items.Count-1 do
      if FieldsCheckListBox.Checked[i] then
        result := result + #32 + fTableName + '.' + fFieldNames[i];
  end;
end;

end.

Offline

Board footer

Powered by FluxBB