Chip 2003 January/Chip_2003-01_cd1.bin/zkuste/delphi/kompon/D34567/SETDBGR/SMDBGSET.ZIP/SMDBGSet.pas

Pascal/Delphi Source File | 2002-10-09 | 17.3 KB | 589 lines

{ Copyright (C) 1998-2002, written by Shkolnik Mike, Scalabium
  E-Mail:  [e-mail]
           [e-mail]
  WEB: http://www.scalabium.com
       http://www.geocities.com/mshkolnik
  tel: [phone]

  In this unit I described the visual dialog for TDBGrid's Columns property tuning.
}

unit SMDBGSet;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms,
  Dialogs, stdctrls, extctrls, checklst, DBGrids, Menus;

type
  TSMSetDBGridDialog = class(TComponent)
  private
    { Private declarations }
    FCaption: TCaption;
    FDBGrid: TCustomDBGrid;
    FAllowedFields: TStrings;

    FOnBeforeExecute: TNotifyEvent;
    FOnAfterExecute: TNotifyEvent;
    FOnShow: TNotifyEvent;

    procedure SetAllowedFields(Value: TStrings);
  protected
    { Protected declarations }
  public
    { Public declarations }
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    function Execute: Boolean;
  published
    { Published declarations }
    property Caption: TCaption read FCaption write FCaption;
    property DBGrid: TCustomDBGrid read FDBGrid write FDBGrid;
    property AllowedFields: TStrings read FAllowedFields write SetAllowedFields;

    property OnBeforeExecute: TNotifyEvent read FOnBeforeExecute write FOnBeforeExecute;
    property OnAfterExecute: TNotifyEvent read FOnAfterExecute write FOnAfterExecute;
    property OnShow: TNotifyEvent read FOnShow write FOnShow;
  end;

  TSMGridSetupItem = class
    FieldIndex: Integer;
    FieldName: string;

    TitleAlignment: TAlignment;
    TitleCaption: string;
    TitleColor: TColor;
    TitleFont: TFont;

    DataAlignment: TAlignment;
    DataColor: TColor;
    DataFont: TFont;
    Width: Integer;
  end;

  TfrmGridSetup = class(TForm)
    btnOk: TButton;
    btnCancel: TButton;
    bvlButton: TBevel;
    clbFields: TCheckListBox;
    gbTitle: TGroupBox;
    lblTitleCaption: TLabel;
    lblTitleAlignment: TLabel;
    lblTitleColor: TLabel;
    lblTitleFont: TLabel;
    edTitleCaption: TEdit;
    edTitleFont: TEdit;
    cbTitleAlignment: TComboBox;
    gbData: TGroupBox;
    lblDataAlignment: TLabel;
    lblDataColor: TLabel;
    lblDataFont: TLabel;
    edDataFont: TEdit;
    cbDataAlignment: TComboBox;
    lblWidth: TLabel;
    lblWidthFix: TLabel;
    edWidth: TEdit;
    FontDlg: TFontDialog;
    SMColorsCBTitle: TComboBox;
    SMColorsCBData: TComboBox;
    btnTitleFont: TButton;
    btnDataFont: TButton;
    pmColumns: TPopupMenu;
    miSelectAll: TMenuItem;
    miUnselectAll: TMenuItem;
    miInvertSelection: TMenuItem;
    procedure PropertyExit(Sender: TObject);
    procedure clbFieldsClick(Sender: TObject);
    procedure clbFieldsDragDrop(Sender, Source: TObject; X, Y: Integer);
    procedure clbFieldsDragOver(Sender, Source: TObject; X, Y: Integer;
      State: TDragState; var Accept: Boolean);
    procedure edTitleFontButtonClick(Sender: TObject);
    procedure SMColorsCBTitleDrawItem(Control: TWinControl; Index: Integer;
      Rect: TRect; State: TOwnerDrawState);
    procedure miSelectAllClick(Sender: TObject);
    procedure SMColorsCBTitleClick(Sender: TObject);
    procedure SMColorsCBTitleChange(Sender: TObject);
  private
    { Private declarations }
    function GetItemCaption(item: TSMGridSetupItem): string;
    function GetCaptionFont(Font: TFont): string;
  public
    { Public declarations }
  end;

procedure Register;

implementation
{$R *.DFM}
uses SMCnst;

procedure Register;
begin
  RegisterComponents('SMComponents', [TSMSetDBGridDialog]);
end;

const
  clCream = TColor($A6CAF0);
  clMoneyGreen = TColor($C0DCC0);
  clSkyBlue = TColor($FFFBF0);

  ColorsInList = 46;
  ColorValues: array [0..ColorsInList - 1] of TColor = (
    clBlack, clMaroon, clGreen, clOlive, clNavy, clPurple, clTeal, clGray,
    clSilver, clRed, clLime, clYellow, clBlue, clFuchsia, clAqua, clWhite,
    clScrollBar, clBackground, clActiveCaption, clInactiveCaption,
    clMenu, clWindow, clWindowFrame, clMenuText, clWindowText, clCaptionText,
    clActiveBorder, clInactiveBorder, clAppWorkSpace, clHighlight,
    clHighlightText, clBtnFace, clBtnShadow, clGrayText, clBtnText,
    clInactiveCaptionText, clBtnHighlight, cl3DDkShadow, cl3DLight,
    clInfoText, clInfoBk, clCream, clMoneyGreen, clSkyBlue, 0, 0);


{ TSMSetDBGridDialog }
constructor TSMSetDBGridDialog.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);

  FCaption := 'Grid setup';
  FDBGrid := nil;
  FAllowedFields := TStringList.Create;
end;

destructor TSMSetDBGridDialog.Destroy;
begin
  FAllowedFields.Free;

  inherited Destroy;
end;

procedure TSMSetDBGridDialog.SetAllowedFields(Value: TStrings);
begin
  FAllowedFields.Assign(Value);
end;

function TSMSetDBGridDialog.Execute: Boolean;
var
  i, j: Integer;
  item: TSMGridSetupItem;
  TM: TTextMetric;
  IsSMDBGrid: Boolean;
begin
  if Assigned(FOnBeforeExecute) then
    FOnBeforeExecute(Self);

  Result := False;

  with TDBGrid(DBGrid), TfrmGridSetup.Create(Application) do
    try
      if not (Assigned(DataSource) and
         Assigned(DataSource.DataSet)) then exit;

      Caption := FCaption;
      btnOk.Caption := SBtnOk;
      btnCancel.Caption := SBtnCancel;

      gbTitle.Caption := SgbTitle;
      lblTitleCaption.Caption := STitleCaption;
      lblTitleAlignment.Caption := STitleAlignment;
      cbTitleAlignment.Items.Add(SAlignLeft);
      cbTitleAlignment.Items.Add(SAlignRight);
      cbTitleAlignment.Items.Add(SAlignCenter);
      lblTitleColor.Caption := STitleColor;
      lblTitleFont.Caption := STitleFont;

      gbData.Caption := SgbData;
      lblDataAlignment.Caption := STitleAlignment;
      cbDataAlignment.Items.Add(SAlignLeft);
      cbDataAlignment.Items.Add(SAlignRight);
      cbDataAlignment.Items.Add(SAlignCenter);
      lblDataColor.Caption := STitleColor;
      lblDataFont.Caption := STitleFont;

      lblWidth.Caption := SWidth;
      lblWidthFix.Caption := SWidthFix;


      {fill the field list}
      with Columns do
        for i := 0 to Count-1 do
        begin
          if (AllowedFields.Count = 0) or
             (AllowedFields.IndexOf(Items[i].FieldName) > -1) then
          begin
            item := TSMGridSetupItem.Create;
            item.TitleFont := TFont.Create;
            item.DataFont := TFont.Create;

            item.FieldIndex := i;
            item.FieldName := Items[i].FieldName;

            item.TitleAlignment := Items[i].Title.Alignment;
            item.TitleCaption := Items[i].Title.Caption;
            item.TitleColor := Items[i].Title.Color;
            item.TitleFont.Assign(Items[i].Title.Font);

            item.DataAlignment := Items[i].Alignment;
            item.DataColor := Items[i].Color;
            item.DataFont.Assign(Items[i].Font);

            if (Items[i].Width > 0) then
            begin
              GetTextMetrics(Canvas.Handle, TM);
              item.Width := (Items[i].Width - TM.tmOverhang - 4) div (Canvas.TextWidth('0') - TM.tmOverhang);
            end;


            j := clbFields.Items.AddObject(GetItemCaption(item), item);
            {$IFDEF VER120} //D4
            clbFields.Checked[j] := Items[i].Visible;
            {$ELSE}
            {$IFDEF VER125} //CB4
            clbFields.Checked[j] := Items[i].Visible;
            {$ELSE}
            {$IFDEF VER130} //D5
            clbFields.Checked[j] := Items[i].Visible;
            {$ELSE}
            clbFields.Checked[j] := True;
            {$ENDIF}
            {$ENDIF}
            {$ENDIF}
          end;
        end;

      IsSMDBGrid := (Columns.Count > 0);
      for i := 0 to DataSource.DataSet.FieldCount - 1 do
        if (AllowedFields.Count = 0) or
           (AllowedFields.IndexOf(DataSource.DataSet.Fields[i].FieldName) > -1) then
        begin
          for j := 0 to clbFields.Items.Count-1 do
          begin
            IsSMDBGrid := (TSMGridSetupItem(clbFields.Items.Objects[j]).FieldName = DataSource.DataSet.Fields[i].FieldName);
            if IsSMDBGrid then
              break;
          end;
          if not IsSMDBGrid then
          begin
            item := TSMGridSetupItem.Create;
            item.TitleFont := TFont.Create;
            item.DataFont := TFont.Create;

            item.FieldIndex := clbFields.Items.Count;
            item.FieldName := DataSource.DataSet.Fields[i].FieldName;

            item.TitleAlignment := DataSource.DataSet.Fields[i].Alignment;
            item.TitleCaption := DataSource.DataSet.Fields[i].DisplayName;
            item.TitleColor := FixedColor;
            item.TitleFont.Assign(Font);

            item.DataAlignment := DataSource.DataSet.Fields[i].Alignment;
            item.DataColor := Color;
            item.DataFont.Assign(Font);

            item.Width := DataSource.DataSet.Fields[i].DisplayWidth;

            j := clbFields.Items.AddObject(GetItemCaption(item), item);
            clbFields.Checked[j] := False;
          end;
      end;

      clbFields.ItemIndex := 0;
      clbFieldsClick(clbFields);

      if Assigned(FOnShow) then
        FOnShow(Self);

      Result := (ShowModal = mrOk);
      if Result then
      begin
        if (Columns.Count > 0) then
        begin
          Columns.Clear;
          for i := 0 to clbFields.Items.Count-1 do
            if clbFields.Checked[i] then
            begin
              item := TSMGridSetupItem(clbFields.Items.Objects[i]);
              with Columns.Add do
              begin
                FieldName := item.FieldName;
                Title.Alignment := item.TitleAlignment;
                Title.Caption := item.TitleCaption;
                Title.Color := item.TitleColor;
                Title.Font.Assign(item.TitleFont);

                Alignment := item.DataAlignment;
                Color := item.DataColor;
                Font.Assign(item.DataFont);

                if (item.Width > 0) then
                begin
                  GetTextMetrics(Canvas.Handle, TM);
                  Width := item.Width*(Canvas.TextWidth('0') - TM.tmOverhang)
                             + TM.tmOverhang + 4;
                end;
              end;
            end;
        end
        else
        begin
          for i := 0 to clbFields.Items.Count-1 do
          begin
            item := TSMGridSetupItem(clbFields.Items.Objects[i]);
            with DataSource.DataSet.Fields[i] do
            begin
              FieldName := item.FieldName;

              Alignment := item.DataAlignment;
              DisplayLabel := item.TitleCaption;
              Color := item.DataColor;
              Font.Assign(item.DataFont);

              if (item.Width > 0) then
              begin
                GetTextMetrics(Canvas.Handle, TM);
                DisplayWidth := item.Width*(Canvas.TextWidth('0') - TM.tmOverhang)
                                 + TM.tmOverhang + 4;
              end;
              Visible := clbFields.Checked[i];
            end;
          end;
        end;
      end
    finally
      for i := clbFields.Items.Count-1 downto 0 do
        with TSMGridSetupItem(clbFields.Items.Objects[i]) do
        begin
          TitleFont.Free;
          DataFont.Free;
          Free;
        end;
      Free
    end;

  if Assigned(FOnAfterExecute) then
    FOnAfterExecute(Self);
end;

{ TfrmGridSetup }
procedure TfrmGridSetup.clbFieldsClick(Sender: TObject);

  function GetColorID(cl: TColor): Integer;
  var
    i: Integer;
  begin
    Result := -1;

    for i := 0 to ColorsInList do
      if ColorValues[i] = cl then
      begin
        Result := i;
        break;
      end;
    if Result < 0 then
      Result := 0;
  end;

begin
  if clbFields.ItemIndex > -1 then
    with TSMGridSetupItem(clbFields.Items.Objects[clbFields.ItemIndex]) do
    begin
      edTitleCaption.Text := TitleCaption;

      cbTitleAlignment.ItemIndex := Ord(TitleAlignment);
      SMColorsCBTitle.ItemIndex := GetColorID(TitleColor);
      edTitleFont.Font.Assign(TitleFont);
      edTitleFont.Text := GetCaptionFont(edTitleFont.Font);

      cbDataAlignment.ItemIndex := Ord(DataAlignment);
      SMColorsCBData.ItemIndex := GetColorID(DataColor);
      edDataFont.Font.Assign(DataFont);
      edDataFont.Text := GetCaptionFont(edDataFont.Font);

      edWidth.Text := IntToStr(Width);

      ColorValues[ColorsInList-2] := TitleColor;
      ColorValues[ColorsInList-1] := DataColor;

      SMColorsCBTitleChange(SMColorsCBTitle)
    end;
end;

procedure TfrmGridSetup.clbFieldsDragDrop(Sender, Source: TObject; X,
  Y: Integer);
var intItemIndex, intNewItemIndex: Integer;
    boolChecked: Boolean;
    coordXY: TPoint;
begin
  with Source as TCheckListBox do
  begin
    intItemIndex := clbFields.ItemIndex;
    coordXY.x := X;
    coordXY.y := Y;
    intNewItemIndex := clbFields.ItemAtPos(coordXY, True);
    if (intNewItemIndex <> -1) then
    begin
      boolChecked := clbFields.Checked[intItemIndex];
      clbFields.Items.Move(intItemIndex, intNewItemIndex);
      clbFields.Checked[intNewItemIndex] := boolChecked;
      clbFields.ItemIndex := intNewItemIndex;
    end;
  end;
end;

procedure TfrmGridSetup.clbFieldsDragOver(Sender, Source: TObject; X,
  Y: Integer; State: TDragState; var Accept: Boolean);
begin
  if (Source = clbFields) then
    Accept := True
  else
    Accept := False;
end;

procedure TfrmGridSetup.PropertyExit(Sender: TObject);
var
  item: TSMGridSetupItem;
begin
  if clbFields.ItemIndex > -1 then
  begin
    item := TSMGridSetupItem(clbFields.Items.Objects[clbFields.ItemIndex]);

    case (Sender as TControl).Tag of
      1: begin
           item.TitleCaption := edTitleCaption.Text;
           clbFields.Items[clbFields.ItemIndex] := GetItemCaption(item);
         end;
      2: item.TitleAlignment := TAlignment(cbTitleAlignment.ItemIndex);
      3: item.TitleColor := ColorValues[SMColorsCBTitle.ItemIndex];
      4: item.TitleFont.Assign(edTitleFont.Font);

      5: item.DataAlignment := TAlignment(cbDataAlignment.ItemIndex);
      6: if (SMColorsCBData.ItemIndex = SMColorsCBData.Items.Count-1) then
           item.DataColor := ColorValues[SMColorsCBData.ItemIndex+1]
         else
           item.DataColor := ColorValues[SMColorsCBData.ItemIndex];
      7: item.DataFont.Assign(edDataFont.Font);

      8, 9: item.Width := StrToIntDef(edWidth.Text, 0);
      10: item.Width := 10;
    end;
  end;
end;

procedure TfrmGridSetup.edTitleFontButtonClick(Sender: TObject);
var cntr: TEdit;
begin
  if TButton(Sender) = btnTitleFont then
    cntr := edTitleFont
  else
    cntr := edDataFont;

  with FontDlg do
  begin
    Font.Assign(cntr.Font);
    if Execute then
    begin
      cntr.Font.Assign(Font);
      cntr.Text := GetCaptionFont(Font);

      PropertyExit(Sender);
    end;
  end;
end;

function TfrmGridSetup.GetItemCaption(item: TSMGridSetupItem): string;
begin
  Result := item.FieldName + '  :  ' + item.TitleCaption;
end;

function TfrmGridSetup.GetCaptionFont(Font: TFont): string;
begin
  Result := Font.Name + ', ' + IntToStr(Font.Size);
end;


procedure TfrmGridSetup.SMColorsCBTitleDrawItem(Control: TWinControl;
  Index: Integer; Rect: TRect; State: TOwnerDrawState);
var
  ARect: TRect;
  Safer: TColor;
  i: Integer;
begin
  ARect := Rect;
  InflateRect(ARect, -2, -2);

  with (Control as TComboBox) do
  begin
    Canvas.FillRect(Rect);
    Safer := Canvas.Brush.Color;
    Canvas.Pen.Color := clWindowText;
    Canvas.Rectangle(ARect.Left, ARect.Top, ARect.Right, ARect.Bottom);
    i := Index;
    if (Control = SMColorsCBData) and
       (i = SMColorsCBData.Items.Count-1) then
      Inc(i);
    Canvas.Brush.Color := ColorValues[i];
    try
      InflateRect(ARect, -1, -1);
      Canvas.FillRect(ARect);

{      if (Index = Items.Count-1) then
      begin
        Canvas.Pen.Color := clWhite;
        Canvas.TextOut(ARect.Left, ARect.Top, 'Custom...')
      end;
}    finally
      Canvas.Brush.Color := Safer;
    end;
  end;
end;

procedure TfrmGridSetup.miSelectAllClick(Sender: TObject);
var
  i, intTag: Integer;
begin
  intTag := TComponent(Sender).Tag;
  for i := 0 to clbFields.Items.Count-1 do
    case intTag of
      1: //unselect all
         clbFields.Checked[i] := False;
      2: //invert selection
         clbFields.Checked[i] := not clbFields.Checked[i];
    else //select all
      clbFields.Checked[i] := True;
    end;
  clbFields.Invalidate
end;

procedure TfrmGridSetup.SMColorsCBTitleClick(Sender: TObject);
var
  i: Integer;
begin
  with TCombobox(Sender) do
    if (ItemIndex = ColorsInList-2) then
    begin
      with TColorDialog.Create(Self) do
        try
          i := ColorsInList-1;
          if (Sender = SMColorsCBTitle) then
            Dec(i);

          Color := ColorValues[i];
          if Execute then
            ColorValues[i] := Color
        finally
          Free
        end
    end;
end;

procedure TfrmGridSetup.SMColorsCBTitleChange(Sender: TObject);
begin
  edTitleFont.Color := ColorValues[SMColorsCBTitle.ItemIndex];
  if (SMColorsCBData.ItemIndex = SMColorsCBData.Items.Count-1) then
    edDataFont.Color := ColorValues[SMColorsCBData.ItemIndex+1]
  else
    edDataFont.Color := ColorValues[SMColorsCBData.ItemIndex];
end;

end.