adbgrfed.pas

来自「delphi编程控件」· PAS 代码 · 共 408 行

PAS
408
字号
unit adbgrfed;
(*
 COPYRIGHT (c) RSD software 1997 - 98
 All Rights Reserved.
*)

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  Menus, StdCtrls, ComCtrls, adbgrid;

type
  TAutoGridFieldsEditor = class(TForm)
    BHelp: TButton;
    BCancel: TButton;
    BOk: TButton;
    GB: TGroupBox;
    ColumnList: TListBox;
    NewButton: TButton;
    DeleteButton: TButton;
    AddAllFields: TButton;
    DeleteAll: TButton;
    PageControl1: TPageControl;
    ts1: TTabSheet;
    LFieldName: TLabel;
    ColFieldName: TComboBox;
    ColAlignment: TComboBox;
    ColColor: TComboBox;
    ColReadOnly: TComboBox;
    ColFont: TButton;
    RestoreDefaults: TButton;
    TitleAlignment: TComboBox;
    TitleCaption: TEdit;
    TitleColor: TComboBox;
    TitleFont: TButton;
    FontDialog: TFontDialog;
    PM: TPopupMenu;
    Newcolumn1: TMenuItem;
    Deletecolumn1: TMenuItem;
    Addallfields1: TMenuItem;
    Deleteallcolumns1: TMenuItem;
    ts2: TTabSheet;
    LAlignment: TLabel;
    LColor: TLabel;
    LReadOnly: TLabel;
    LTAlignment: TLabel;
    LCaption: TLabel;
    LTColor: TLabel;
    procedure FormCreate(Sender: TObject);
    procedure ColumnListClick(Sender: TObject);
    procedure AddAllFieldsClick(Sender: TObject);
    procedure ColAlignmentClick(Sender: TObject);
    procedure RestoreDefaultsClick(Sender: TObject);
    procedure TitleAlignmentClick(Sender: TObject);
    procedure ColColorClick(Sender: TObject);
    procedure TitleColorClick(Sender: TObject);
    procedure ColReadOnlyClick(Sender: TObject);
    procedure ColFontClick(Sender: TObject);
    procedure ColColorExit(Sender: TObject);
    procedure TitleColorExit(Sender: TObject);
    procedure TitleFontClick(Sender: TObject);
    procedure TitleCaptionExit(Sender: TObject);
    procedure DeleteAllClick(Sender: TObject);
    procedure DeleteButtonClick(Sender: TObject);
    procedure NewButtonClick(Sender: TObject);
    procedure Newcolumn1Click(Sender: TObject);
    procedure Deletecolumn1Click(Sender: TObject);
    procedure Addallfields1Click(Sender: TObject);
    procedure Deleteallcolumns1Click(Sender: TObject);
    procedure ColumnListDragOver(Sender, Source: TObject; X, Y: Integer;
      State: TDragState; var Accept: Boolean);
    procedure ColumnListDragDrop(Sender, Source: TObject; X, Y: Integer);
  private
    GridLayout : TAutoGridLayout;
    ActiveField : TAutoGridField;

    procedure UpdateColumns;
  public

  end;

function  ShowAutoGridFieldsEditor(AGridLayout : TAutoGridLayout) : Boolean;

implementation
uses autostrs, audbstrs;
{$R *.DFM}

function  ShowAutoGridFieldsEditor(AGridLayout : TAutoGridLayout) : Boolean;
Var
  AForm : TAutoGridFieldsEditor;
  i : Integer;
begin
  AForm := TAutoGridFieldsEditor.Create(Nil);
  with AForm do begin
    Caption := LoadStr(ACDB_GRIDFIELDEDITORCAPTION) + AGridLayout.Owner.Name;
    GridLayout := TAutoGridLayout.Create(AForm);
    GridLayout.Assign(AGridLayout);
    ActiveField := Nil;
    if(GridLayout.DataSet <> Nil) then
      for i := 0 to GridLayout.DataSet.FieldCount - 1 do
        ColFieldName.Items.Add(GridLayout.DataSet.Fields[i].FieldName);
    UpdateColumns;        
    ShowModal;
  end;
  if(AForm.ModalResult = mrOk) then begin
    Result := True;
    AForm.ColumnList.ItemIndex := -1;
    AForm.ColumnListClick(Nil);
    AGridLayout.Assign(AForm.GridLayout);
  end else Result := False;

  AForm.GridLayout.Free;
  AForm.Free;
end;


procedure TAutoGridFieldsEditor.UpdateColumns;
Var
  i : Integer;
begin
  ColumnList.Clear;
  for i := 0 to GridLayout.Fields.Count - 1 do
    if(GridLayout.Fields[i].Customized) then
      ColumnList.Items.AddObject(GridLayout.Fields[i].Caption, GridLayout.Fields[i]);
  ActiveField := Nil;    
  ColumnListClick(Nil);
end;

procedure TAutoGridFieldsEditor.FormCreate(Sender: TObject);
type
  TGetStrFunc = function(const Value: string): Integer of object;
Var
  Values: TStringList;
  AddValue: TGetStrFunc;
  i : Integer;
begin
  Values := TStringList.Create;
  try
    AddValue := Values.Add;
    GetColorValues(TGetStrProc(AddValue));
    for i := 0 to Values.Count - 1 do
      ColColor.Items.Add(Values[i]);
    TitleColor.Items.Assign(ColColor.Items);
  finally
    Values.Free;
  end;
  BOK.Caption := LoadStr(ACB_OK);
  BCancel.Caption := LoadStr(ACB_CANCEL);
  BHelp.Caption := LoadStr(ACB_HELP);
  NewButton.Caption := LoadStr(ACB_ADD);
  DeleteButton.Caption := LoadStr(ACB_DELETE);
  AddAllFields.Caption := LoadStr(ACDB_ADDALLFIELDS);
  DeleteAll.Caption := LoadStr(ACDB_DELETEALLFIELDS);
  ColFont.Caption := LoadStr(ACDB_FONTEX);
  TitleFont.Caption := LoadStr(ACDB_FONTEX);
  RestoreDefaults.Caption := LoadStr(ACDB_RESTORESEFAULTS);
  GB.Caption := LoadStr(ACDB_FIELDS);
  LAlignment.Caption := LoadStr(ACDB_ALIGNMENT);
  LTAlignment.Caption := LoadStr(ACDB_ALIGNMENT);
  LCaption.Caption := LoadStr(ACDB_CAPTION);
  LColor.Caption := LoadStr(ACDB_COLOR);
  LTColor.Caption := LoadStr(ACDB_COLOR);  
  LFieldName.Caption := LoadStr(ACDB_FIELDNAME);
  LReadOnly.Caption := LoadStr(ACDB_READONLY);
  ts1.Caption := LoadStr(ACDB_FIELDPROPERTIES);
  ts2.Caption := LoadStr(ACDB_TITLEPROPERTIES);  
end;

procedure TAutoGridFieldsEditor.ColumnListClick(Sender: TObject);

  procedure SetEnabled(AControl : TWinControl; AEnabled : Boolean);
  Var
    i : Integer;
  begin
    for i := 0 to AControl.ControlCount - 1 do begin
      AControl.Controls[i].Enabled := AEnabled;
      if Not AEnabled then begin
        if (AControl.Controls[i] is TComboBox) then begin
          TComboBox(AControl.Controls[i]).ItemIndex := -1;
          TComboBox(AControl.Controls[i]).Font.Style := [];
        end;
        if (AControl.Controls[i] is TButton) then
          TButton(AControl.Controls[i]).Font.Style := [];
      end;
    end;
  end;

begin
  if(ColumnList.ItemIndex = -1) And (ColumnList.Items.Count > 0) then
    ColumnList.ItemIndex := 0;
  SetEnabled(ts1, ColumnList.ItemIndex > -1);
  SetEnabled(ts2, ColumnList.ItemIndex > -1);

  if (ActiveField <> Nil) And (Sender <> RestoreDefaults) then begin
    ActiveField.Alignment := TAlignment(ColAlignment.ItemIndex);
    ActiveField.TitleAlignment := TAlignment(TitleAlignment.ItemIndex);
    ActiveField.Color := StringToColor(ColColor.Text);
    ActiveField.TitleColor := StringToColor(TitleColor.Text);
    ActiveField.FieldName := ColFieldName.Text;
    ActiveField.ReadOnly := Boolean(ColReadOnly.ItemIndex);
    ActiveField.Caption := TitleCaption.Text;
  end;

  if(ColumnList.ItemIndex > -1) and (ColumnList.ItemIndex < ColumnList.Items.Count) then begin
    ActiveField := TAutoGridField(ColumnList.Items.Objects[ColumnList.ItemIndex]);
    ColAlignment.ItemIndex := Integer(ActiveField.Alignment);
    ColAlignmentClick(Sender);
    TitleAlignment.ItemIndex := Integer(ActiveField.TitleAlignment);
    TitleAlignmentClick(Sender);
    ColColor.Text := ColorToString(ActiveField.Color);
    ColColorClick(Sender);
    TitleColor.Text := ColorToString(ActiveField.TitleColor);
    TitleColorClick(Sender);
    ColFieldName.Text := ActiveField.FieldName;
    ColReadOnly.ItemIndex := Integer(ActiveField.ReadOnly);
    ColReadOnlyClick(Sender);
    TitleCaption.Text := ActiveField.Caption;    
    if(ActiveField.IsFontStored) then
      ColFont.Font.Style := [fsBold]
    else ColFont.Font.Style := [];
    if(ActiveField.IsTitleFontStored) then
      TitleFont.Font.Style := [fsBold]
    else TitleFont.Font.Style := [];
  end else begin
    ActiveField := Nil;
    TitleCaption.Text := '';
  end;
  PageControl1.Enabled := ActiveField <> nil;
end;

procedure TAutoGridFieldsEditor.AddAllFieldsClick(Sender: TObject);
Var
  i : Integer;
  AField : TAutoGridField;
begin
  if(GridLayout.DataSet <> Nil) then begin
    GridLayout.Fields.Clear;
    for i := 0 to GridLayout.DataSet.FieldCount - 1 do begin
      AField := GridLayout.Fields.Add;
      AField.Field := GridLayout.DataSet.Fields[i];
    end;
    UpdateColumns;
  end;
end;

procedure TAutoGridFieldsEditor.ColAlignmentClick(Sender: TObject);
begin
  if(ActiveField.DefaultAlignment = TAlignment(ColAlignment.ItemIndex)) then
    ColAlignment.Font.Style := []
  else ColAlignment.Font.Style := [fsBold];
end;

procedure TAutoGridFieldsEditor.RestoreDefaultsClick(Sender: TObject);
begin
  ActiveField.RestoreDefaults;
  ColumnListClick(Sender);
end;

procedure TAutoGridFieldsEditor.TitleAlignmentClick(Sender: TObject);
begin
  if(ActiveField.DefaultTitleAlignment = TAlignment(TitleAlignment.ItemIndex)) then
    TitleAlignment.Font.Style := []
  else TitleAlignment.Font.Style := [fsBold];
end;

procedure TAutoGridFieldsEditor.ColColorClick(Sender: TObject);
begin
  if(ColorToString(ActiveField.DefaultColor) = ColColor.Text) then
    ColColor.Font.Style := []
  else ColColor.Font.Style := [fsBold];
end;

procedure TAutoGridFieldsEditor.TitleColorClick(Sender: TObject);
begin
  if(ColorToString(ActiveField.DefaultTitleColor) = TitleColor.Text) then
    TitleColor.Font.Style := []
  else TitleColor.Font.Style := [fsBold];
end;

procedure TAutoGridFieldsEditor.ColReadOnlyClick(Sender: TObject);
begin
  if(ActiveField.DefaultReadonly = Boolean(ColReadOnly.ItemIndex)) then
    ColReadOnly.Font.Style := []
  else ColReadOnly.Font.Style := [fsBold];
end;

procedure TAutoGridFieldsEditor.ColFontClick(Sender: TObject);
begin
  FontDialog.Font.Assign(ActiveField.Font);
  if(FontDialog.Execute) then
    ActiveField.Font := FontDialog.Font;
  if Not (gfvFont in ActiveField.AssignedValues) then
    ColFont.Font.Style := []
  else ColFont.Font.Style := [fsBold];
end;

procedure TAutoGridFieldsEditor.ColColorExit(Sender: TObject);
Var
  dummy : LongInt;
begin
  if Not IdentToColor(ColColor.Text, dummy) then
    ColColor.Text := ColorToString(ActiveField.Color);
end;

procedure TAutoGridFieldsEditor.TitleColorExit(Sender: TObject);
Var
  dummy : LongInt;
begin
  if Not IdentToColor(TitleColor.Text, dummy) then
    TitleColor.Text := ColorToString(ActiveField.TitleColor);
end;

procedure TAutoGridFieldsEditor.TitleFontClick(Sender: TObject);
begin
  FontDialog.Font.Assign(ActiveField.TitleFont);
  if(FontDialog.Execute) then
    ActiveField.TitleFont := FontDialog.Font;
  if Not (gfvTitleFont in ActiveField.AssignedValues) then
    TitleFont.Font.Style := []
  else TitleFont.Font.Style := [fsBold];
end;

procedure TAutoGridFieldsEditor.TitleCaptionExit(Sender: TObject);
Var
  OldIndex : Integer;
begin
  OldIndex := ColumnList.ItemIndex;
  ColumnList.Items[OldIndex] := TitleCaption.Text;
  ColumnList.ItemIndex := OldIndex;
end;

procedure TAutoGridFieldsEditor.DeleteAllClick(Sender: TObject);
begin
  ActiveField := Nil;
  GridLayout.Fields.Clear;
  UpdateColumns;
end;

procedure TAutoGridFieldsEditor.DeleteButtonClick(Sender: TObject);
Var
  OldItemIndex : Integer;
begin
  if(ActiveField <> Nil) then begin
    ActiveField.Free;
    ActiveField := Nil;
    OldItemIndex := ColumnList.ItemIndex;
    ColumnList.Items.Delete(OldItemIndex);
    if(OldItemIndex >= ColumnList.Items.Count) then
      Dec(OldItemIndex);
    ColumnList.ItemIndex := OldItemIndex;
    ColumnListClick(Sender);
  end;
end;

procedure TAutoGridFieldsEditor.NewButtonClick(Sender: TObject);
Var
  AField : TAutoGridField;
begin
  AField := GridLayout.Fields.Add;
  ColumnList.Items.AddObject(AField.Caption, AField);
  ColumnList.ItemIndex := ColumnList.Items.Count - 1;
  ColumnListClick(Sender);
end;

procedure TAutoGridFieldsEditor.Newcolumn1Click(Sender: TObject);
begin
  NewButtonClick(Sender);
end;

procedure TAutoGridFieldsEditor.Deletecolumn1Click(Sender: TObject);
begin
  DeleteButtonClick(Sender);
end;

procedure TAutoGridFieldsEditor.Addallfields1Click(Sender: TObject);
begin
  AddAllFieldsClick(Sender);
end;

procedure TAutoGridFieldsEditor.Deleteallcolumns1Click(Sender: TObject);
begin
  DeleteAllClick(Sender);
end;

procedure TAutoGridFieldsEditor.ColumnListDragOver(Sender, Source: TObject;
  X, Y: Integer; State: TDragState; var Accept: Boolean);
begin
  Accept := True; 
end;

procedure TAutoGridFieldsEditor.ColumnListDragDrop(Sender, Source: TObject;
  X, Y: Integer);
Var
  AIndex1, AIndex2 : Integer;
begin
  AIndex1 := ColumnList.ItemAtPos(Point(X, Y), True);
  if(AIndex1 > -1) then begin
    AIndex2 := ColumnList.ItemIndex;
    ColumnList.Items.Move(AIndex2, AIndex1);
    Gridlayout.Fields[AIndex2].Index := AIndex1;
    ColumnList.ItemIndex := AIndex1;
    ColumnListClick(Sender);
  end;
end;

end.

⌨️ 快捷键说明

复制代码Ctrl + C
搜索代码Ctrl + F
全屏模式F11
增大字号Ctrl + =
减小字号Ctrl + -
显示快捷键?