PC Format Collection 48/SENT14D.ISO/tech/delphi/disk15/experts.pak/DLG.PAS

Pascal/Delphi Source File | 1995-08-24 | 12.9 KB | 494 lines

unit Dlg;

interface

uses
  SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
  Forms, Dialogs, ExtCtrls, StdCtrls, Buttons, ToolIntf;

type

  { These are the set of flags which determine the type of dialog to create }
  TDlgAttr = (daNothing, daTabNot, daTabs, daBtnsH, daBtnsV);
  TDlgAttrs = set of TDlgAttr;

  TDlgExpert = class(TForm)
    Sample: TPaintBox;
    Notebook: TNotebook;
    NextButton: TBitBtn;
    rbSinglePage: TRadioButton;
    rbTabNot: TRadioButton;
    rbTabs: TRadioButton;
    Label1: TLabel;
    Label2: TLabel;
    rbBtnsV: TRadioButton;
    rbBtnsH: TRadioButton;
    RadioButton1: TRadioButton;
    PrevButton: TBitBtn;
    BitBtn3: TBitBtn;
    Label3: TLabel;
    PageNames: TMemo;
    procedure SamplePaint(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure StyleClick(Sender: TObject);
    procedure BtnClick(Sender: TObject);
    procedure CancelClick(Sender: TObject);
    procedure PrevClick(Sender: TObject);
    procedure NextClick(Sender: TObject);
  private
    { Private declarations }
    Definition: TDlgAttrs;
    DrawBitmap: TBitmap;
    SourceBuffer: PChar;
    procedure RefreshButtons;
    procedure FmtWrite(Stream: TStream; Fmt: PChar; const Args: array of const);
    function DoFormCreation(const FormIdent: string): TForm;
    function CreateSource(const UnitIdent, FormIdent: string): TMemoryStream;
    function CreateForm(const FormIdent: string): TMemoryStream;
  public
    { Public declarations }
  end;

procedure DialogExpert(ToolServices: TIToolServices);

implementation

uses TabNotBk, Tabs, Proxies, VirtIntf, IStreams, ExConst;

{$R *.DFM}

const
  { page numbers }
  pgStyle       = 0;  { multi vs. single page dialog }
  pgPages       = 1;  { page names }
  pgButtons     = 2;  { button layouts }

  SourceBufferSize = 1024;


{ TDlgExpert }

{ Paint the sample pane based on the currently selected options }
procedure TDlgExpert.SamplePaint(Sender: TObject);
var
  X, Y: Integer;
begin
  { always paint the background dialog }
  DrawBitmap.Handle := LoadBitmap(HInstance, 'DIALOG');
  Sample.Canvas.Draw(0, 0, DrawBitmap);

  if daTabNot in Definition then
  begin
    DrawBitmap.Handle := LoadBitmap(HInstance, 'TABNOT');
    Sample.Canvas.Draw(4, 16, DrawBitmap);
  end;

  if daTabs in Definition then
  begin
    DrawBitmap.Handle := LoadBitmap(HInstance, 'TABS');
    Sample.Canvas.Draw(3, 55, DrawBitmap);
  end;

  if daBtnsV in Definition then
  begin
    DrawBitmap.Handle := LoadBitmap(HInstance, 'BTNSV');
    X := 75;
    Y := 22;

    if daTabNot in Definition then
    begin
      Dec(X, 2);
      Inc(Y, 4);
    end;

    Sample.Canvas.Draw(X, Y, DrawBitmap);
  end;

  if daBtnsH in Definition then
  begin
    DrawBitmap.Handle := LoadBitmap(HInstance, 'BTNSH');
    X := 50;
    Y := 55;

    if daTabs in Definition then Dec(Y, 8);
    if daTabNot in Definition then Dec(Y, 4);

    Sample.Canvas.Draw(X, Y, DrawBitmap);
  end;
end;

procedure TDlgExpert.FormCreate(Sender: TObject);
begin
  DrawBitmap := TBitmap.Create;
  PrevClick(Self);
  RefreshButtons;
end;

procedure TDlgExpert.FormDestroy(Sender: TObject);
begin
  DrawBitmap.Free;
end;

procedure TDlgExpert.StyleClick(Sender: TObject);
begin
  if rbTabNot.Checked then Include(Definition, daTabNot)
  else Exclude(Definition, daTabNot);
  if rbTabs.Checked then Include(Definition, daTabs)
  else Exclude(Definition, daTabs);
  SamplePaint(Self);
end;

procedure TDlgExpert.BtnClick(Sender: TObject);
begin
  if rbBtnsV.Checked then Include(Definition, daBtnsV)
  else Exclude(Definition, daBtnsV);
  if rbBtnsH.Checked then Include(Definition, daBtnsH)
  else Exclude(Definition, daBtnsH);
  SamplePaint(Self);
end;

procedure TDlgExpert.CancelClick(Sender: TObject);
begin
  Close;
end;

procedure TDlgExpert.PrevClick(Sender: TObject);
begin
  case Notebook.PageIndex of
    pgStyle: Exit;
    pgPages: NoteBook.PageIndex := pgStyle;
    pgButtons: if (daTabNot in Definition) or (daTabs in Definition) then
      NoteBook.PageIndex := pgPages
      else NoteBook.PageIndex := pgStyle;
  end;
  RefreshButtons;
end;

procedure TDlgExpert.NextClick(Sender: TObject);
begin
  case NoteBook.PageIndex of
    pgStyle: if (daTabNot in Definition) or (daTabs in Definition) then
      NoteBook.PageIndex := pgPages
      else NoteBook.PageIndex := pgButtons;
    pgPages: NoteBook.PageIndex := pgButtons;
    pgButtons:
      begin
        ModalResult := mrOK;
        Exit;
      end;
  end;
  RefreshButtons;
end;

procedure TDlgExpert.RefreshButtons;
begin
  PrevButton.Enabled := Notebook.PageIndex > 0;
  if Notebook.PageIndex = pgButtons then
  begin
    NextButton.Caption := LoadStr(sCreate);
    NextButton.Glyph.Handle := LoadBitmap(HInstance, 'CREATE');
    NextButton.NumGlyphs := 1;
  end
  else
  begin
    NextButton.Caption := LoadStr(sNext);
    NextButton.Glyph.Handle := LoadBitmap(HInstance, 'NEXT');
    NextButton.NumGlyphs := 2;
  end;
end;

{ Create the dialog defined by the user }
function TDlgExpert.DoFormCreation(const FormIdent: string): TForm;
var
  BtnPos: TPoint;
  Method: TMethod;
begin
  Result := TProxyForm.CreateAs('T' + FormIdent);
  with Result do
  begin
    BorderStyle := bsDialog;
    Width := 400;
    Height := 250;
    Position := poScreenCenter;
    Name := FormIdent;
    Caption := FormIdent;

    with Font do
    begin
      Name := 'MS Sans Serif';
      Size := 8;
      Style := [fsBold];
    end;

    { create controls }
    if daTabs in Definition then
    begin
      with TTabSet.Create(Result) do
      begin
        Parent := Result;
        Name := 'TabSet1';
        Align := alBottom;

        { Create the reference for the TabSet's OnClick event }
        Method.Code := TProxyForm(Result).CreateMethod('TabClick');
        Method.Data := Result;
        OnClick := TNotifyEvent(Method);
      end;

      with TNoteBook.Create(Result) do
      begin
        Parent := Result;
        Name := 'Notebook1';
        Align := alClient;

        Pages := PageNames.Lines;
      end;

      { create the Form's OnCreate method }
      Method.Code := TProxyForm(Result).CreateMethod('FormCreate');
      Method.Data := Result;
      Result.OnCreate := TNotifyEvent(Method);
    end;

    if daTabNot in Definition then
    begin
      with TTabbedNotebook.Create(Result) do
      begin
        Parent := Result;
        Name := 'TabbedNotebook1';
        Align := alClient;
        if PageNames.Lines.Count > 0 then
          Pages := PageNames.Lines;
      end;
    end;

    if (daBtnsH in Definition) or (daBtnsV in Definition) then
    begin

      { get the starting point for the buttons }
      if daBtnsH in Definition then
        BtnPos := Point(ClientWidth - (77 * 3) - (5 * 3),
          ClientHeight - 27 - 5)
      else
        BtnPos := Point(ClientWidth - 77 - 5, 30);

      { finalize positions }
      if daTabNot in Definition then
      begin
        Dec(BtnPos.X, 5);
        if daBtnsV in Definition then Inc(BtnPos.Y, 5)
        else Dec(BtnPos.Y, 5);
      end;

      if (daTabs in Definition) and (daBtnsH in Definition) then
        Dec(BtnPos.Y, 20);

      { OK }
      with TBitBtn.Create(Result) do
      begin
        Parent := Result;
        Left := BtnPos.X;
        Top := BtnPos.Y;
        Height := 27;
        Width := 77;
        Kind := bkOK;
        Name := 'BitBtn1';
      end;

      { move the next button position }
      if daBtnsH in Definition then Inc(BtnPos.X, 77 + 5)
      else Inc(BtnPos.Y, 27 + 5);

      { Cancel }
      with TBitBtn.Create(Result) do
      begin
        Parent := Result;
        Left := BtnPos.X;
        Top := BtnPos.Y;
        Height := 27;
        Width := 77;
        Kind := bkCancel;
        Name := 'BitBtn2';
      end;

      { move the next button position }
      if daBtnsH in Definition then Inc(BtnPos.X, 77 + 5)
      else Inc(BtnPos.Y, 27 + 5);

      { Help }
      with TBitBtn.Create(Result) do
      begin
        Parent := Result;
        Left := BtnPos.X;
        Top := BtnPos.Y;
        Height := 27;
        Width := 77;
        Kind := bkHelp;
        Name := 'BitBtn3';
      end;
    end;
  end;
end;

procedure TDlgExpert.FmtWrite(Stream: TStream; Fmt: PChar;
  const Args: array of const);
begin
  if (Stream <> nil) and (SourceBuffer <> nil) then
  begin
    StrLFmt(SourceBuffer, SourceBufferSize, Fmt, Args);
    Stream.Write(SourceBuffer[0], StrLen(SourceBuffer));
  end;
end;

function TDlgExpert.CreateSource(const UnitIdent, FormIdent: string): TMemoryStream;
const
  CRLF = #13#10;
begin
  SourceBuffer := StrAlloc(SourceBufferSize);
  try
    Result := TMemoryStream.Create;
    try

      { unit header and uses clause }
      FmtWrite(Result,
        'unit %s;' + CRLF + CRLF +
        'interface' + CRLF + CRLF +
        'uses'#13#10 +
        '  SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,'#13#10 +
        '  StdCtrls, ExtCtrls, Forms', [UnitIdent]);

      { additional units that may be needed }
      if daTabNot in Definition then FmtWrite(Result, ', TabNotBk', [nil])
      else if daTabs in Definition then FmtWrite(Result, ', Tabs', [nil]);

      FmtWrite(Result, ';' + CRLF + CRLF, [nil]);

      { begin the class declaration }
      FmtWrite(Result,
        'type'#13#10 +
        '  T%s = class(TForm)'#13#10, [FormIdent]);

      { add variable declarations }
      if (daBtnsH in Definition) or (daBtnsV in Definition) then
      begin
        FmtWrite(Result,
          '    BitBtn1: TBitBtn;' + CRLF +
          '    BitBtn2: TBitBtn;' + CRLF +
          '    BitBtn3: TBitBtn;' + CRLF, [nil]);
       end;

      if daTabNot in Definition then
        FmtWrite(Result, '    TabbedNotebook1: TTabbedNotebook;' + CRLF, [nil])
      else if daTabs in Definition then
        FmtWrite(Result,
          '    TabSet1: TTabSet;' + CRLF +
          '    Notebook1: TNotebook;' + CRLF, [nil]);

      { add methods for TNotebook support if needed }
      if daTabs in Definition then
        FmtWrite(Result,
          '    procedure FormCreate(Sender: TObject);' + CRLF +
          '    procedure TabClick(Sender: TObject);' + CRLF,
          [nil]);

      FmtWrite(Result,
        '  end;' + CRLF + CRLF +
        'var' + CRLF +
        '  %s: T%s;' + CRLF + CRLF +
        'implementation' + CRLF + CRLF +
        '{$R *.DFM}' + CRLF + CRLF, [FormIdent, FormIdent]);

      { write the code for the Form's OnCreate and the tab's OnClick }
      if daTabs in Definition then
      begin
        FmtWrite(Result,
          'procedure T%s.FormCreate(Sender: TObject);' + CRLF +
          'begin' + CRLF +
          '  TabSet1.Tabs := Notebook1.Pages;' + CRLF +
          'end;' + CRLF + CRLF, [FormIdent]);

        FmtWrite(Result,
          'procedure T%s.TabClick(Sender: TObject);' + CRLF +
          'begin' + CRLF +
          '  Notebook1.PageIndex := TabSet1.TabIndex;' + CRLF +
          'end;' + CRLF + CRLF, [FormIdent]);
      end;

      FmtWrite(Result, 'end.' + CRLF, [nil]);
      Result.Position := 0;

    except
      Result.Free;
      raise;
    end;

  finally
    StrDispose(SourceBuffer);
  end;
end;

function TDlgExpert.CreateForm(const FormIdent: string): TMemoryStream;
var
  DlgForm: TForm;
begin
  Result := nil;

  DlgForm := DoFormCreation(FormIdent);
  try
    Result := TMemoryStream.Create;
    Result.WriteComponentRes(FormIdent, DlgForm);
    Result.Position := 0;
  finally
    DlgForm.Free;
  end;
end;

procedure DialogExpert(ToolServices: TIToolServices);
var
  D: TDlgExpert;
  ISourceStream, IFormStream: TIMemoryStream;
  UnitIdent, FormIdent: string[79];
  FileName: TFileName;
begin
  if ToolServices = nil then Exit;
  if ToolServices.GetNewModuleName(UnitIdent, FileName) then
  begin
    D := TDlgExpert.Create(Application);
    try
      if D.ShowModal = mrOK then
      begin
        UnitIdent := LowerCase(UnitIdent);
        UnitIdent[1] := Upcase(UnitIdent[1]);
        FormIdent := 'Form' + Copy(UnitIdent, 5, 255);

        IFormStream := TIMemoryStream.Create(D.CreateForm(FormIdent));
        try

          ISourceStream := TIMemoryStream.Create(D.CreateSource(UnitIdent,
            FormIdent));
          try
            ToolServices.CreateModule(FileName, ISourceStream, IFormStream,
              [cmAddToProject, cmShowSource, cmShowForm, cmUnNamed,
              cmMarkModified]);
          finally
            ISourceStream.OwnStream := True;
            ISourceStream.Free;
          end;

        finally
          IFormStream.OwnStream := True;
          IFormStream.Free;
        end;

      end;
    finally
      D.Free;
    end;
  end;
end;

end.