adbgrged.pas

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

unit adbgrged;
(*
 COPYRIGHT (c) RSD software 1997 - 98
 All Rights Reserved.
*)

interface

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

type
  TAutoGridGroupsEditor = class(TForm)
    GB: TGroupBox;
    GroupList: TListBox;
    NewButton: TButton;
    DeleteButton: TButton;
    BOk: TButton;
    BCancel: TButton;
    BHelp: TButton;
    PM: TPopupMenu;
    UpButton: TButton;
    DownButton: TButton;
    New1: TMenuItem;
    Delete1: TMenuItem;
    Up1: TMenuItem;
    Down1: TMenuItem;
    FontDialog: TFontDialog;
    GroupBox: TGroupBox;
    GroupCaption: TEdit;
    GroupAlignment: TComboBox;
    GroupColor: TComboBox;
    RestoreDefaults: TButton;
    GroupFont: TButton;
    LCaption: TLabel;
    LAlignment: TLabel;
    LColor: TLabel;
    LWidth: TLabel;
    GroupWidth: TEdit;
    procedure FormCreate(Sender: TObject);
    procedure GroupListClick(Sender: TObject);
    procedure GroupAlignmentClick(Sender: TObject);
    procedure GroupColorClick(Sender: TObject);
    procedure GroupColorExit(Sender: TObject);
    procedure GroupFontClick(Sender: TObject);
    procedure NewButtonClick(Sender: TObject);
    procedure DeleteButtonClick(Sender: TObject);
    procedure UpButtonClick(Sender: TObject);
    procedure DownButtonClick(Sender: TObject);
    procedure New1Click(Sender: TObject);
    procedure Delete1Click(Sender: TObject);
    procedure Up1Click(Sender: TObject);
    procedure Down1Click(Sender: TObject);
    procedure GroupCaptionExit(Sender: TObject);
    procedure GroupListDragDrop(Sender, Source: TObject; X, Y: Integer);
    procedure GroupListDragOver(Sender, Source: TObject; X, Y: Integer;
      State: TDragState; var Accept: Boolean);
    procedure RestoreDefaultsClick(Sender: TObject);
    procedure GroupWidthKeyPress(Sender: TObject; var Key: Char);
  private
    GridLayout : TAutoGridLayout;
    ActiveGroup : TAutoGridGroup;
  end;

function  ShowAutoGridGroupsEditor(AGridLayout : TAutoGridLayout) : Boolean;

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

function  ShowAutoGridGroupsEditor(AGridLayout : TAutoGridLayout) : Boolean;
Var
  AForm: TAutoGridGroupsEditor;
  i : Integer;
begin
  AForm := TAutoGridGroupsEditor.Create(Nil);
  with AForm do begin
    Caption := LoadStr(ACDB_GRIDGROUPESDITORCAPTION) + AGridLayout.Owner.Name;
    GridLayout := TAutoGridLayout.Create(AForm);
    GridLayout.Assign(AGridLayout);
    ActiveGroup := Nil;
    for i := 0 to GridLayout.Groups.Count - 1 do
      GroupList.Items.AddObject(GridLayout.Groups[i].Caption, GridLayout.Groups[i]);
    GroupListClick(Nil);  
    ShowModal;
  end;
  if(AForm.ModalResult = mrOk) then begin
    Result := True;
    AForm.GroupList.ItemIndex := -1;
    AForm.GroupListClick(Nil);
    AGridLayout.Groups.Assign(AForm.GridLayout.Groups);
  end else Result := False;

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


procedure TAutoGridGroupsEditor.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
      GroupColor.Items.Add(Values[i]);
  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);
  GroupFont.Caption := LoadStr(ACDB_FONTEX);
  RestoreDefaults.Caption := LoadStr(ACDB_RESTORESEFAULTS);
  GB.Caption := LoadStr(AEL_GROUPS);
  LAlignment.Caption := LoadStr(ACDB_ALIGNMENT);
  LCaption.Caption := LoadStr(ACDB_CAPTION);
  LColor.Caption := LoadStr(ACDB_COLOR);
  LWidth.Caption := LoadStr(ACDB_WIDTH);  
  GroupBox.Caption := LoadStr(ACDB_GROUPPROPERTIES)
end;

procedure TAutoGridGroupsEditor.GroupListClick(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(GroupList.ItemIndex = -1) And (GroupList.Items.Count > 0) then
    GroupList.ItemIndex := 0;
  SetEnabled(GroupBox, GroupList.ItemIndex > -1);

  if (ActiveGroup <> Nil) And (Sender <> RestoreDefaults) then begin
    ActiveGroup.Alignment := TAlignment(GroupAlignment.ItemIndex);
    ActiveGroup.Color := StringToColor(GroupColor.Text);
    ActiveGroup.Caption := GroupCaption.Text;
    if(GroupWidth.Text <> '') then
      ActiveGroup.Width := StrToInt(GroupWidth.Text);
  end;

  if(GroupList.ItemIndex > -1) and (GroupList.ItemIndex  < GroupList.Items.Count) then begin
    ActiveGroup := TAutoGridGroup(GroupList.Items.Objects[GroupList.ItemIndex]);
    GroupAlignment.ItemIndex := Integer(ActiveGroup.Alignment);
    GroupAlignmentClick(Sender);
    GroupColor.Text := ColorToString(ActiveGroup.Color);
    GroupColorClick(Sender);
    GroupCaption.Text := ActiveGroup.Caption;
    GroupWidth.Text := IntToStr(ActiveGroup.Width);
    if(ActiveGroup.IsFontStored) then
      GroupFont.Font.Style := [fsBold]
    else GroupFont.Font.Style := [];
  end else begin
    ActiveGroup := Nil;
    GroupCaption.Text := '';
    GroupWidth.Text := '';
  end;
  GroupBox.Enabled := ActiveGroup <> Nil;
end;

procedure TAutoGridGroupsEditor.GroupAlignmentClick(Sender: TObject);
begin
  if(ActiveGroup.DefaultAlignment = TAlignment(GroupAlignment.ItemIndex)) then
    GroupAlignment.Font.Style := []
  else GroupAlignment.Font.Style := [fsBold];
end;

procedure TAutoGridGroupsEditor.GroupColorClick(Sender: TObject);
begin
  if(ColorToString(ActiveGroup.DefaultColor) = GroupColor.Text) then
    GroupColor.Font.Style := []
  else GroupColor.Font.Style := [fsBold];
end;

procedure TAutoGridGroupsEditor.GroupColorExit(Sender: TObject);
Var
  dummy : LongInt;
begin
  if Not IdentToColor(GroupColor.Text, dummy) then
    GroupColor.Text := ColorToString(ActiveGroup.Color);
end;

procedure TAutoGridGroupsEditor.GroupFontClick(Sender: TObject);
begin
  FontDialog.Font.Assign(ActiveGroup.Font);
  if(FontDialog.Execute) then begin
    ActiveGroup.AssignedValues := ActiveGroup.AssignedValues + [ggvFont];
    ActiveGroup.Font := FontDialog.Font;
  end;
  if Not (ggvFont in ActiveGroup.AssignedValues) then
    GroupFont.Font.Style := []
  else GroupFont.Font.Style := [fsBold];
end;

procedure TAutoGridGroupsEditor.NewButtonClick(Sender: TObject);
Var
  AGroup : TAutoGridGroup;
begin
  AGroup := GridLayout.Groups.Add;
  GroupList.Items.AddObject(AGroup.Caption, AGroup);
  GroupList.ItemIndex := GroupList.Items.Count - 1;
  GroupListClick(Sender);  
end;

procedure TAutoGridGroupsEditor.DeleteButtonClick(Sender: TObject);
Var
  OldItemIndex : Integer;
begin
  if(ActiveGroup <> Nil) then begin
    ActiveGroup.Free;
    ActiveGroup := Nil;
    OldItemIndex := GroupList.ItemIndex;
    GroupList.Items.Delete(OldItemIndex);
    if(OldItemIndex >= GroupList.Items.Count) then
      Dec(OldItemIndex);
    GroupList.ItemIndex := OldItemIndex;
    GroupListClick(Sender);
  end;
end;

procedure TAutoGridGroupsEditor.UpButtonClick(Sender: TObject);
begin
  if(ActiveGroup <> Nil) And (ActiveGroup.Index > 0) then begin
    ActiveGroup.Index := ActiveGroup.Index - 1;
    GroupList.Items.Move(ActiveGroup.Index + 1, ActiveGroup.Index);
    GroupList.ItemIndex := ActiveGroup.Index;
    GroupListClick(Sender);
  end;
end;

procedure TAutoGridGroupsEditor.DownButtonClick(Sender: TObject);
begin
  if(ActiveGroup <> Nil) And (ActiveGroup.Index < GroupList.Items.Count - 1) then begin
    ActiveGroup.Index := ActiveGroup.Index + 1;
    GroupList.Items.Move(ActiveGroup.Index - 1, ActiveGroup.Index);
    GroupList.ItemIndex := ActiveGroup.Index;
    GroupListClick(Sender);
  end;
end;

procedure TAutoGridGroupsEditor.New1Click(Sender: TObject);
begin
  NewButtonClick(Sender);
end;

procedure TAutoGridGroupsEditor.Delete1Click(Sender: TObject);
begin
  DeleteButtonClick(Sender);
end;

procedure TAutoGridGroupsEditor.Up1Click(Sender: TObject);
begin
  UpButtonClick(Sender);
end;

procedure TAutoGridGroupsEditor.Down1Click(Sender: TObject);
begin
  DownButtonClick(Sender);
end;

procedure TAutoGridGroupsEditor.GroupCaptionExit(Sender: TObject);
Var
  OldIndex : Integer;
begin
  OldIndex := GroupList.ItemIndex;
  GroupList.Items[OldIndex] := GroupCaption.Text;
  GroupList.ItemIndex := OldIndex;
end;

procedure TAutoGridGroupsEditor.GroupListDragDrop(Sender, Source: TObject;
  X, Y: Integer);
Var
  AIndex1, AIndex2 : Integer;
begin
  AIndex1 := GroupList.ItemAtPos(Point(X, Y), True);
  if(AIndex1 > -1) then begin
    AIndex2 := GroupList.ItemIndex;
    GroupList.Items.Move(AIndex2, AIndex1);
    Gridlayout.Groups[AIndex2].Index := AIndex1;
    GroupList.ItemIndex := AIndex1;
    GroupListClick(Sender);
  end;
end;

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

procedure TAutoGridGroupsEditor.RestoreDefaultsClick(Sender: TObject);
begin
  ActiveGroup.RestoreDefaults;
  GroupListClick(Sender);
end;

procedure TAutoGridGroupsEditor.GroupWidthKeyPress(Sender: TObject;
  var Key: Char);
begin
  if(Key < '0') and (Key > '9') then begin
    Key := #0;
    MessageBeep(MB_OK);
  end;
end;

end.