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 + -
显示快捷键?