CD Actual Thematic 25: Programming/pc_actual_25.iso/Delphi/eXpertDevelopmentKit/SOURCE/XDKFIXED.PAS

Pascal/Delphi Source File | 1998-01-26 | 5.0 KB | 183 lines

{*******************************************************}
{                                                       }
{       eXpert Development Kit                          }
{                                                       }
{       Copyright (c) 1996,97 Sergey Orlik              }
{       - product manager of Borland Russia             }
{                                                       }
{*******************************************************}
unit XDKfixEd;
interface
uses
  DsgnIntf, Classes;

procedure Register;

implementation

uses
  SysUtils, Graphics, Menus, Forms, Controls, Dialogs, Buttons, StdCtrls,
  ComCtrls;

{ TfixActivePageProperty }
type
  TfixActivePageProperty = class(TComponentProperty)
  public
    function GetAttributes: TPropertyAttributes; override;
    procedure GetValues(Proc: TGetStrProc); override;
  end;

function TfixActivePageProperty.GetAttributes: TPropertyAttributes;
begin
  Result := [paValueList];
end;

procedure TfixActivePageProperty.GetValues(Proc: TGetStrProc);
var
  I: Integer;
  Component: TComponent;
begin
  for I := 0 to {Designer.Form}TControl(GetComponent(0)).Owner.ComponentCount - 1 do //***
  begin
    Component := {Designer.Form}TControl(GetComponent(0)).Owner.Components[I]; //***
    if (Component.Name <> '') and (Component is TTabSheet) and
      (TTabSheet(Component).PageControl = GetComponent(0)) then
      Proc(Component.Name);
  end;
end;

{ TfixPageControlEditor }
type
  TfixPageControlEditor = class(TDefaultEditor)
    procedure ExecuteVerb(Index: Integer); override;
    function GetVerb(Index: Integer): string; override;
    function GetVerbCount: Integer; override;
  end;

resourcestring
  SNewPage = 'Ne&w Page';
  SNextPage = 'Ne&xt Page';
  SPrevPage = '&Previous Page';

const
  PageControlVerbs: array[0..2] of string = (SNewPage, SNextPage, SPrevPage);

procedure TfixPageControlEditor.ExecuteVerb(Index: Integer);
var
  PageControl: TPageControl;
  Page: TTabSheet;
  Designer: TFormDesigner;
begin
  if Component is TTabSheet then
    PageControl := TTabSheet(Component).PageControl else
    PageControl := TPageControl(Component);
  if PageControl <> nil then
  begin
    Designer := Self.Designer;
    if Index = 0 then
    begin
      Page := TTabSheet.Create(Component.Owner); //***
      try
        Page.Name := Designer.UniqueName(TTabSheet.ClassName);
        Page.Parent := PageControl;
        Page.PageControl := PageControl;
      except
        Page.Free;
        raise;
      end;
      PageControl.ActivePage := Page;
      Designer.SelectComponent(Page);
      Designer.Modified;
    end else
    begin
      Page := PageControl.FindNextPage(PageControl.ActivePage,
        Index = 1, False);
      if (Page <> nil) and (Page <> PageControl.ActivePage) then
      begin
        PageControl.ActivePage := Page;
        if Component is TTabSheet then Designer.SelectComponent(Page);
        Designer.Modified;
      end;
    end;
  end;
end;

function TfixPageControlEditor.GetVerb(Index: Integer): string;
begin
  Result := PageControlVerbs[Index];
end;

function TfixPageControlEditor.GetVerbCount: Integer;
begin
  Result := High(PageControlVerbs) + 1;
end;

{ TfixToolBarEditor }
type
  TfixToolBarEditor = class(TDefaultEditor)
    procedure ExecuteVerb(Index: Integer); override;
    function GetVerb(Index: Integer): string; override;
    function GetVerbCount: Integer; override;
  end;

resourcestring
  SNewBtn = 'New &Button';
  SNewSpr = 'New Se¶tor';
const
  ToolBarVerbs: array[0..1] of string = (SNewBtn, SNewSpr);

procedure TfixToolBarEditor.ExecuteVerb(Index: Integer);
var
  ToolBar: TToolBar;
  Btn: TToolButton;
  Designer: TFormDesigner;
begin
  if Component is TToolButton then
    ToolBar := TToolBar(TToolButton(Component).Parent) else
    ToolBar := TToolBar(Component);
  if ToolBar <> nil then
  begin
    Designer := Self.Designer;
    begin
      Btn := TToolButton.Create(Component.Owner); //***
      try
        Btn.Name := Designer.UniqueName(TToolButton.ClassName);
        Btn.Parent := ToolBar;
        if Index = 0 then
          Btn.Style:=tbsButton
        else begin
          Btn.Style:=tbsSeparator;
          Btn.Width:=8;
        end;
      except
        Btn.Free;
        raise;
      end;
      Designer.SelectComponent(Btn);
      Designer.Modified;
    end;
  end;
end;

function TfixToolBarEditor.GetVerb(Index: Integer): string;
begin
  Result := ToolBarVerbs[Index];
end;

function TfixToolBarEditor.GetVerbCount: Integer;
begin
  Result := High(ToolBarVerbs) + 1;
end;

procedure Register;
begin
  RegisterComponentEditor(TPageControl, TfixPageControlEditor);
  RegisterComponentEditor(TTabSheet, TfixPageControlEditor);
  RegisterPropertyEditor(TypeInfo(TTabSheet), TPageControl, 'ActivePage', TfixActivePageProperty);

  RegisterComponentEditor(TToolBar, TfixToolBarEditor);
  RegisterComponentEditor(TToolButton, TfixToolBarEditor);
end;

end.