adbpnped.pas

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

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

interface

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

type
  TAutoPanelPagesEditor = class(TForm)
    GB: TGroupBox;
    PageList: 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;
    RestoreDefaults: TButton;
    LCaption: TLabel;
    LAlignment: TLabel;
    LColor: TLabel;
    PageBox1: TGroupBox;
    PageCaption: TEdit;
    PageAlignment: TComboBox;
    PageColor: TComboBox;
    LControlLayout: TLabel;
    LLabelLayout: TLabel;
    PageControlLayout: TComboBox;
    PageLabelLayout: TComboBox;
    procedure FormCreate(Sender: TObject);
    procedure PageListClick(Sender: TObject);
    procedure PageAlignmentClick(Sender: TObject);
    procedure PageColorClick(Sender: TObject);
    procedure PageColorExit(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 PageCaptionExit(Sender: TObject);
    procedure PageListDragDrop(Sender, Source: TObject; X, Y: Integer);
    procedure PageListDragOver(Sender, Source: TObject; X, Y: Integer;
      State: TDragState; var Accept: Boolean);
    procedure RestoreDefaultsClick(Sender: TObject);
    procedure PageControlLayoutClick(Sender: TObject);
    procedure PageLabelLayoutClick(Sender: TObject);
  private
    PanelLayout : TAutoPanelLayout;
    ActivePage : TAutoPanelPage;
  end;

function  ShowAutoPanelPagesEditor(APanelLayout : TAutoPanelLayout) : Boolean;

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

function  ShowAutoPanelPagesEditor(APanelLayout : TAutoPanelLayout) : Boolean;
Var
  AForm: TAutoPanelPagesEditor;
  i : Integer;
begin
  AForm := TAutoPanelPagesEditor.Create(Nil);
  with AForm do begin
    Caption := LoadStr(ACDB_PANELPAGESDITORCAPTION) + APanelLayout.Owner.Name;  
    PanelLayout := TAutoPanelLayout.Create(AForm);
    PanelLayout.Assign(APanelLayout);
    ActivePage := Nil;
    for i := 0 to PanelLayout.Pages.Count - 1 do
      PageList.Items.AddObject(PanelLayout.Pages[i].Caption, PanelLayout.Pages[i]);
    PageListClick(Nil);  
    ShowModal;
  end;
  if(AForm.ModalResult = mrOk) then begin
    Result := True;
    AForm.PageList.ItemIndex := -1;
    AForm.PageListClick(Nil);
    APanelLayout.Pages.Assign(AForm.PanelLayout.Pages);
  end else Result := False;

  AForm.PanelLayout.Free;
  AForm.Free;
end;


procedure TAutoPanelPagesEditor.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
      PageColor.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);
  UpButton.Caption := LoadStr(ACB_MOVEUP);
  DownButton.Caption := LoadStr(ACB_MOVEDOWN);  
  RestoreDefaults.Caption := LoadStr(ACDB_RESTORESEFAULTS);
  GB.Caption := LoadStr(ACDB_PAGES);
  LAlignment.Caption := LoadStr(ACDB_ALIGNMENT);
  LCaption.Caption := LoadStr(ACDB_CAPTION);
  LColor.Caption := LoadStr(ACDB_COLOR);
  LControlLayout.Caption := LoadStr(ACDB_PANELCONTROLLAYOUT);
  LLabelLayout.Caption := LoadStr(ACDB_PANELLABELLAYOUT);  
  PageBox1.Caption := LoadStr(ACDB_PAGEPROPERTIES);
end;

procedure TAutoPanelPagesEditor.PageListClick(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(PageList.ItemIndex = -1) And (PageList.Items.Count > 0) then
    PageList.ItemIndex := 0;
  SetEnabled(PageBox1, PageList.ItemIndex > -1);

  if (ActivePage <> Nil) And (Sender <> RestoreDefaults) then begin
    ActivePage.Alignment := TAlignment(PageAlignment.ItemIndex);
    ActivePage.ControlLayout := TAutoControlLayout(PageControlLayout.ItemIndex);
    ActivePage.LabelLayout := TAutoLabelLayout(PageLabelLayout.ItemIndex);
    ActivePage.Color := StringToColor(PageColor.Text);
    ActivePage.Caption := PageCaption.Text;
  end;

  if(PageList.ItemIndex > -1) and (PageList.ItemIndex < PageList.Items.Count)then begin
    ActivePage := TAutoPanelPage(PageList.Items.Objects[PageList.ItemIndex]);
    PageAlignment.ItemIndex := Integer(ActivePage.Alignment);
    PageAlignmentClick(Sender);
    PageControlLayout.ItemIndex := Integer(ActivePage.ControlLayout);
    PageControlLayoutClick(Sender);
    PageLabelLayout.ItemIndex := Integer(ActivePage.LabelLayout);
    PageLabelLayoutClick(Sender);
    PageColor.Text := ColorToString(ActivePage.Color);
    PageColorClick(Sender);
    PageCaption.Text := ActivePage.Caption;
  end else begin
    ActivePage := Nil;
    PageCaption.Text := '';
  end;
  PageBox1.Enabled := ActivePage <> nil;
end;

procedure TAutoPanelPagesEditor.PageAlignmentClick(Sender: TObject);
begin
  if(ActivePage.DefaultAlignment = TAlignment(PageAlignment.ItemIndex)) then
    PageAlignment.Font.Style := []
  else PageAlignment.Font.Style := [fsBold];
end;

procedure TAutoPanelPagesEditor.PageColorClick(Sender: TObject);
begin
  if(ColorToString(ActivePage.DefaultColor) = PageColor.Text) then
    PageColor.Font.Style := []
  else PageColor.Font.Style := [fsBold];
end;

procedure TAutoPanelPagesEditor.PageColorExit(Sender: TObject);
Var
  dummy : LongInt;
begin
  if Not IdentToColor(PageColor.Text, dummy) then
    PageColor.Text := ColorToString(ActivePage.Color);
end;

procedure TAutoPanelPagesEditor.NewButtonClick(Sender: TObject);
Var
  APage : TAutoPanelPage;
begin
  APage := PanelLayout.Pages.Add;
  PageList.Items.AddObject(APage.Caption, APage);
  PageList.ItemIndex := PageList.Items.Count - 1;
  PageListClick(Sender);  
end;

procedure TAutoPanelPagesEditor.DeleteButtonClick(Sender: TObject);
Var
  OldItemIndex : Integer;
begin
  if(ActivePage <> Nil) then begin
    ActivePage.Free;
    ActivePage := Nil;
    OldItemIndex := PageList.ItemIndex;
    PageList.Items.Delete(OldItemIndex);
    if(OldItemIndex >= PageList.Items.Count) then
      Dec(OldItemIndex);
    PageList.ItemIndex := OldItemIndex;
    PageListClick(Sender);
  end;
end;

procedure TAutoPanelPagesEditor.UpButtonClick(Sender: TObject);
begin
  if(ActivePage <> Nil) And (ActivePage.Index > 0) then begin
    ActivePage.Index := ActivePage.Index - 1;
    PageList.Items.Move(ActivePage.Index + 1, ActivePage.Index);
    PageList.ItemIndex := ActivePage.Index;
    PageListClick(Sender);
  end;
end;

procedure TAutoPanelPagesEditor.DownButtonClick(Sender: TObject);
begin
  if(ActivePage <> Nil) And (ActivePage.Index < PageList.Items.Count - 1) then begin
    ActivePage.Index := ActivePage.Index + 1;
    PageList.Items.Move(ActivePage.Index - 1, ActivePage.Index);
    PageList.ItemIndex := ActivePage.Index;
    PageListClick(Sender);
  end;
end;

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

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

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

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

procedure TAutoPanelPagesEditor.PageCaptionExit(Sender: TObject);
Var
  OldIndex : Integer;
begin
  OldIndex := PageList.ItemIndex;
  PageList.Items[OldIndex] := PageCaption.Text;
  PageList.ItemIndex := OldIndex;
end;

procedure TAutoPanelPagesEditor.PageListDragDrop(Sender, Source: TObject;
  X, Y: Integer);
Var
  AIndex1, AIndex2 : Integer;
begin
  AIndex1 := PageList.ItemAtPos(Point(X, Y), True);
  if(AIndex1 > -1) then begin
    AIndex2 := PageList.ItemIndex;
    PageList.Items.Move(AIndex2, AIndex1);
    Panellayout.Pages[AIndex2].Index := AIndex1;
    PageList.ItemIndex := AIndex1;
    PageListClick(Sender);
  end;
end;

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

procedure TAutoPanelPagesEditor.RestoreDefaultsClick(Sender: TObject);
begin
  ActivePage.RestoreDefaults;
  PageListClick(Sender);
end;

procedure TAutoPanelPagesEditor.PageControlLayoutClick(Sender: TObject);
begin
  if(ActivePage.DefaultControlLayout = TAutoControlLayout(PageControlLayout.ItemIndex)) then
    PageControlLayout.Font.Style := []
  else PageControlLayout.Font.Style := [fsBold];
end;

procedure TAutoPanelPagesEditor.PageLabelLayoutClick(Sender: TObject);
begin
  if(ActivePage.DefaultLabelLayout = TAutoLabelLayout(PageLabelLayout.ItemIndex)) then
    PageLabelLayout.Font.Style := []
  else PageLabelLayout.Font.Style := [fsBold];
end;

end.

⌨️ 快捷键说明

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