home *** CD-ROM | disk | FTP | other *** search
/ Chip 1997 April / Chip_1997-04_cd.bin / prezent / cb / data.z / DLG.PAS < prev    next >
Pascal/Delphi Source File  |  1997-01-16  |  14KB  |  516 lines
  1.  
  2. unit Dlg;
  3.  
  4. interface
  5.  
  6. uses
  7.   SysUtils, Windows, Messages, Classes, Graphics, Controls,
  8.   Forms, Dialogs, ExtCtrls, StdCtrls, Buttons, ToolIntf, ComCtrls;
  9.  
  10. type
  11.  
  12.   { These are the set of flags which determine the type of dialog to create }
  13.   TDlgAttr = (daNothing, daMultPg, daBtnsH, daBtnsV);
  14.   TDlgAttrs = set of TDlgAttr;
  15.  
  16.   TDlgExpert = class(TForm)
  17.     Sample: TPaintBox;
  18.     CancelBtn: TButton;
  19.     PrevButton: TButton;
  20.     NextButton: TButton;
  21.     PageControl: TPageControl;
  22.     Style: TTabSheet;
  23.     Label1: TLabel;
  24.     rbSinglePage: TRadioButton;
  25.     rbMultPg: TRadioButton;
  26.     Pages: TTabSheet;
  27.     Label3: TLabel;
  28.     PageNames: TMemo;
  29.     Buttons: TTabSheet;
  30.     Label2: TLabel;
  31.     RadioButton1: TRadioButton;
  32.     rbBtnsV: TRadioButton;
  33.     rbBtnsH: TRadioButton;
  34.     procedure SamplePaint(Sender: TObject);
  35.     procedure FormCreate(Sender: TObject);
  36.     procedure FormDestroy(Sender: TObject);
  37.     procedure StyleClick(Sender: TObject);
  38.     procedure BtnClick(Sender: TObject);
  39.     procedure CancelClick(Sender: TObject);
  40.     procedure PrevClick(Sender: TObject);
  41.     procedure NextClick(Sender: TObject);
  42.   private
  43.     { Private declarations }
  44.     Definition: TDlgAttrs;
  45.     DrawBitmap: TBitmap;
  46.     SourceBuffer: PChar;
  47.     procedure RefreshButtons;
  48.     procedure FmtWrite(Stream: TStream; Fmt: PChar; const Args: array of const);
  49.     function DoFormCreation(const FormIdent: string): TForm;
  50.     function CreateHdrSource(const UnitIdent, FormIdent: string): TMemoryStream;
  51.     function CreateSource(const UnitIdent, FormIdent: string): TMemoryStream;
  52.     function CreateForm(const FormIdent: string): TMemoryStream;
  53.   public
  54.     { Public declarations }
  55.   end;
  56.  
  57. procedure DialogExpert(ToolServices: TIToolServices);
  58. var
  59.   DlgExpert: TDlgExpert;
  60.  
  61. implementation
  62.  
  63. uses Proxies, VirtIntf, IStreams, ExConst;
  64.  
  65. {$R *.DFM}
  66.  
  67. const
  68.   { page numbers }
  69.   pgStyle       = 0;  { multi vs. single page dialog }
  70.   pgPages       = 1;  { page names }
  71.   pgButtons     = 2;  { button layouts }
  72.  
  73.   SourceBufferSize = 8096;
  74.  
  75.  
  76. { TDlgExpert }
  77.  
  78. { Paint the sample pane based on the currently selected options }
  79. procedure TDlgExpert.SamplePaint(Sender: TObject);
  80. var
  81.   X, Y: Integer;
  82. begin
  83.   { always paint the background dialog }
  84.   DrawBitmap.Handle := LoadBitmap(HInstance, 'DIALOG');
  85.   Sample.Canvas.Draw(0, 0, DrawBitmap);
  86.  
  87.   if daMultPg in Definition then
  88.   begin
  89.     DrawBitmap.Handle := LoadBitmap(HInstance, 'MULTPG');
  90.     Sample.Canvas.Draw(4, 16, DrawBitmap);
  91.   end;
  92.  
  93.   if daBtnsV in Definition then
  94.   begin
  95.     DrawBitmap.Handle := LoadBitmap(HInstance, 'BTNSV');
  96.     X := 75;
  97.     Y := 22;
  98.  
  99.     if daMultPg in Definition then
  100.     begin
  101.       Dec(X, 2);
  102.       Inc(Y, 4);
  103.     end;
  104.  
  105.     Sample.Canvas.Draw(X, Y, DrawBitmap);
  106.   end;
  107.  
  108.   if daBtnsH in Definition then
  109.   begin
  110.     DrawBitmap.Handle := LoadBitmap(HInstance, 'BTNSH');
  111.     X := 50;
  112.     Y := 55;
  113.  
  114.     if daMultPg in Definition then Dec(Y, 4);
  115.  
  116.     Sample.Canvas.Draw(X, Y, DrawBitmap);
  117.   end;
  118. end;
  119.  
  120. procedure TDlgExpert.StyleClick(Sender: TObject);
  121. begin
  122.   if rbMultPg.Checked then Include(Definition, daMultPg)
  123.   else Exclude(Definition, daMultPg);
  124.   SamplePaint(Self);
  125. end;
  126.  
  127. procedure TDlgExpert.BtnClick(Sender: TObject);
  128. begin
  129.   if rbBtnsV.Checked then Include(Definition, daBtnsV)
  130.   else Exclude(Definition, daBtnsV);
  131.   if rbBtnsH.Checked then Include(Definition, daBtnsH)
  132.   else Exclude(Definition, daBtnsH);
  133.   SamplePaint(Self);
  134. end;
  135.  
  136. procedure TDlgExpert.FormCreate(Sender: TObject);
  137. begin
  138.   DrawBitmap := TBitmap.Create;
  139.   PrevClick(Self);
  140.   RefreshButtons;
  141. end;
  142.  
  143. procedure TDlgExpert.FormDestroy(Sender: TObject);
  144. begin
  145.   DrawBitmap.Free;
  146. end;
  147.  
  148. procedure TDlgExpert.CancelClick(Sender: TObject);
  149. begin
  150.   Close;
  151. end;
  152.  
  153. procedure TDlgExpert.PrevClick(Sender: TObject);
  154. begin
  155.   case PageControl.ActivePage.PageIndex of
  156.     pgStyle: Exit;
  157.     pgPages: PageControl.ActivePage := PageControl.Pages[pgStyle];
  158.     pgButtons: if (daMultPg in Definition) then
  159.       PageControl.ActivePage := PageControl.Pages[pgPages]
  160.       else PageControl.ActivePage := PageControl.Pages[pgStyle];
  161.   end;
  162.   RefreshButtons;
  163. end;
  164.  
  165. procedure TDlgExpert.NextClick(Sender: TObject);
  166. begin
  167.   case PageControl.ActivePage.PageIndex of
  168.     pgStyle: if (daMultPg in Definition) then
  169.       PageControl.ActivePage := PageControl.Pages[pgPages]
  170.       else PageControl.ActivePage := PageControl.Pages[pgButtons];
  171.     pgPages: PageControl.ActivePage := PageControl.Pages[pgButtons];
  172.     pgButtons:
  173.       begin
  174.         ModalResult := mrOK;
  175.         Exit;
  176.       end;
  177.   end;
  178.   RefreshButtons;
  179. end;
  180.  
  181. procedure TDlgExpert.RefreshButtons;
  182. begin
  183.   PrevButton.Enabled := PageControl.ActivePage.PageIndex > 0;
  184.   if PageControl.ActivePage.PageIndex = pgButtons then
  185.     NextButton.Caption := LoadStr(sFinish)
  186.   else
  187.     NextButton.Caption := LoadStr(sNext);
  188. end;
  189.  
  190. { Create the dialog defined by the user }
  191. function TDlgExpert.DoFormCreation(const FormIdent: string): TForm;
  192. var
  193.   BtnPos: TPoint;
  194.   Method: TMethod;
  195.   PgCtrl: TPageControl;
  196.   I: Integer;
  197. begin
  198.   Result := TForm.Create(nil);
  199.   Proxies.CreateSubClass(Result, 'T' + FormIdent, TForm);
  200.   with Result do
  201.   begin
  202.     BorderStyle := bsDialog;
  203.     Width := 400;
  204.     Height := 250;
  205.     Position := poScreenCenter;
  206.     Name := FormIdent;
  207.     Caption := FormIdent;
  208.  
  209.     with Font do
  210.     begin
  211.       Name := 'MS Sans Serif';
  212.       Size := 8;
  213.     end;
  214.  
  215.     { create controls }
  216.     if daMultPg in Definition then
  217.     begin
  218.       PgCtrl := TPageControl.Create(Result);
  219.       with PgCtrl do
  220.       begin
  221.         Parent := Result;
  222.         Name := 'PageControl1';
  223.         Align := alClient;
  224.       end;
  225.  
  226.       if PageNames.Lines.Count > 0 then
  227.         for I := 0 to PageNames.Lines.Count - 1 do
  228.           with TTabSheet.Create(Result) do
  229.           begin
  230.             PageControl := PgCtrl;
  231.             Caption := PageNames.Lines[I];
  232.             Name := Format('TabSheet%d', [I + 1]);
  233.           end;
  234.     end;
  235.  
  236.     if (daBtnsH in Definition) or (daBtnsV in Definition) then
  237.     begin
  238.  
  239.       { get the starting point for the buttons }
  240.       if daBtnsH in Definition then
  241.         BtnPos := Point(ClientWidth - (77 * 3) - (5 * 3),
  242.           ClientHeight - 27 - 5)
  243.       else
  244.         BtnPos := Point(ClientWidth - 77 - 5, 30);
  245.  
  246.       { finalize positions }
  247.       if daMultPg in Definition then
  248.       begin
  249.         Dec(BtnPos.X, 5);
  250.         if daBtnsV in Definition then Inc(BtnPos.Y, 5)
  251.         else Dec(BtnPos.Y, 5);
  252.       end;
  253.  
  254.       { OK }
  255.       with TButton.Create(Result) do
  256.       begin
  257.         Parent := Result;
  258.         Left := BtnPos.X;
  259.         Top := BtnPos.Y;
  260.         Height := 25;
  261.         Width := 75;
  262.         Caption := LoadStr(sOKButton);
  263.         Name := 'Button1';
  264.         Default := True;
  265.         ModalResult := mrOk;
  266.       end;
  267.  
  268.       { move the next button position }
  269.       if daBtnsH in Definition then Inc(BtnPos.X, 75 + 5)
  270.       else Inc(BtnPos.Y, 25 + 5);
  271.  
  272.       { Cancel }
  273.       with TButton.Create(Result) do
  274.       begin
  275.         Parent := Result;
  276.         Left := BtnPos.X;
  277.         Top := BtnPos.Y;
  278.         Height := 25;
  279.         Width := 75;
  280.         Name := 'Button2';
  281.         Caption := LoadStr(sCancelButton);
  282.         Cancel := True;
  283.         ModalResult := mrCancel;
  284.       end;
  285.  
  286.       { move the next button position }
  287.       if daBtnsH in Definition then Inc(BtnPos.X, 75 + 5)
  288.       else Inc(BtnPos.Y, 25 + 5);
  289.  
  290.       { Help }
  291.       with TButton.Create(Result) do
  292.       begin
  293.         Parent := Result;
  294.         Left := BtnPos.X;
  295.         Top := BtnPos.Y;
  296.         Height := 25;
  297.         Width := 75;
  298.         Name := 'Button3';
  299.         Caption := LoadStr(sHelpButton);
  300.       end;
  301.     end;
  302.   end;
  303. end;
  304.  
  305. procedure TDlgExpert.FmtWrite(Stream: TStream; Fmt: PChar;
  306.   const Args: array of const);
  307. begin
  308.   if (Stream <> nil) and (SourceBuffer <> nil) then
  309.   begin
  310.     StrLFmt(SourceBuffer, SourceBufferSize, Fmt, Args);
  311.     Stream.Write(SourceBuffer[0], StrLen(SourceBuffer));
  312.   end;
  313. end;
  314.  
  315. function TDlgExpert.CreateHdrSource(const UnitIdent, FormIdent: string): TMemoryStream;
  316. const
  317.   CRLF = #13#10;
  318.   DashLine =
  319.   '//----------------------------------------------------------------------------';
  320. var
  321.   I: Integer;
  322.   IndentStr: string;
  323. begin
  324.   SourceBuffer := StrAlloc(SourceBufferSize);
  325.   IndentStr := #9;        // for now...
  326.   try
  327.     Result := TMemoryStream.Create;
  328.     try
  329.  
  330.       { unit header and uses clause }
  331.       FmtWrite(Result,
  332.         DashLine + CRLF +
  333.         '#ifndef %sH' + CRLF +
  334.         '#define %sH' + CRLF +
  335.         DashLine + CRLF +
  336.  
  337.         '#include <vcl\SysUtils.hpp>' + CRLF +
  338.         '#include <vcl\Windows.hpp>' + CRLF +
  339.         '#include <vcl\Messages.hpp>' + CRLF +
  340.         '#include <vcl\Classes.hpp>' + CRLF +
  341.         '#include <vcl\Graphics.hpp>' + CRLF +
  342.         '#include <vcl\Controls.hpp>' + CRLF +
  343.         '#include <vcl\StdCtrls.hpp>' + CRLF +
  344.         '#include <vcl\ExtCtrls.hpp>' + CRLF +
  345.         '#include <vcl\Forms.hpp>' + CRLF, [UnitIdent, UnitIdent]);
  346.  
  347.       { additional units that may be needed }
  348.       if daMultPg in Definition then
  349.           FmtWrite(Result,
  350.         '#include <vcl\ComCtrls.hpp>' + CRLF, [nil]);
  351.  
  352.       FmtWrite(Result, DashLine + CRLF, [nil]);
  353.  
  354.       { begin the class declaration }
  355.       FmtWrite(Result,
  356.         'class T%s : public TForm' + CRLF +
  357.         '{' + CRLF +
  358.         '__published:' + CRLF, [FormIdent]);
  359.  
  360.       { add variable declarations }
  361.       if (daBtnsH in Definition) or (daBtnsV in Definition) then
  362.       begin
  363.         FmtWrite(Result,
  364.           '%sTButton *Button1;' + CRLF +
  365.           '%sTButton *Button2;' + CRLF +
  366.           '%sTButton *Button3;' + CRLF, [IndentStr, IndentStr, IndentStr]);
  367.        end;
  368.  
  369.       if daMultPg in Definition then
  370.       begin
  371.         FmtWrite(Result, '%sTPageControl *PageControl1;' + CRLF, [IndentStr]);
  372.         if PageNames.Lines.Count > 0 then
  373.           for I := 0 to PageNames.Lines.Count - 1 do
  374.             FmtWrite(Result, '%sTTabSheet *TabSheet%d;'#13#10, [IndentStr, I + 1]);
  375.       end;
  376.  
  377.       FmtWrite(Result,
  378.           'private:' + CRLF +
  379.           'public:' + CRLF +
  380.           '%svirtual __fastcall T%s(TComponent *Owner);' + CRLF +
  381.           '};' + CRLF, [IndentStr, FormIdent]);
  382.  
  383.       FmtWrite(Result, DashLine + CRLF, [nil]);
  384.       FmtWrite(Result, 'extern T%s *%s;' + CRLF, [FormIdent, FormIdent]);
  385.       FmtWrite(Result, DashLine + CRLF, [nil]);
  386.       FmtWrite(Result, '#endif' + CRLF, [nil]);
  387.  
  388.       Result.Position := 0;
  389.  
  390.     except
  391.       Result.Free;
  392.       raise;
  393.     end;
  394.  
  395.   finally
  396.     StrDispose(SourceBuffer);
  397.   end;
  398. end;
  399.  
  400. function TDlgExpert.CreateSource(const UnitIdent, FormIdent: string): TMemoryStream;
  401. const
  402.   CRLF = #13#10;
  403.   DashLine =
  404.   '//----------------------------------------------------------------------------';
  405. var
  406.   I: Integer;
  407.   IndentStr: string;
  408. begin
  409.   SourceBuffer := StrAlloc(SourceBufferSize);
  410.   IndentStr := #9;        // for now...
  411.   try
  412.     Result := TMemoryStream.Create;
  413.     try
  414.  
  415.       { unit header and uses clause }
  416.       FmtWrite(Result,
  417.         DashLine + CRLF +
  418.         '#include <vcl\vcl.h>' + CRLF +
  419.         '#pragma hdrstop' + CRLF + CRLF +
  420.  
  421.         '#include "%s.h"' + CRLF +
  422.         DashLine + CRLF +
  423.  
  424.         '#pragma resource "*.dfm"' + CRLF +
  425.         'T%s *%s;' + CRLF +
  426.         DashLine + CRLF +
  427.  
  428.         '__fastcall T%s::T%s(TComponent *Owner)' + CRLF +
  429.         '%s: TForm(Owner)' + CRLF +
  430.         '{' + CRLF +
  431.         '}' + CRLF +
  432.         DashLine + CRLF, [UnitIdent, FormIdent, FormIdent, FormIdent, FormIdent,
  433.           IndentStr]);
  434.  
  435.       Result.Position := 0;
  436.  
  437.     except
  438.       Result.Free;
  439.       raise;
  440.     end;
  441.  
  442.   finally
  443.     StrDispose(SourceBuffer);
  444.   end;
  445. end;
  446.  
  447. function TDlgExpert.CreateForm(const FormIdent: string): TMemoryStream;
  448. var
  449.   DlgForm: TForm;
  450. begin
  451.   Result := nil;
  452.  
  453.   DlgForm := DoFormCreation(FormIdent);
  454.   try
  455.     Result := TMemoryStream.Create;
  456.     Result.WriteComponentRes(FormIdent, DlgForm);
  457.     Result.Position := 0;
  458.   finally
  459.     DlgForm.Free;
  460.   end;
  461. end;
  462.  
  463. procedure DialogExpert(ToolServices: TIToolServices);
  464. var
  465.   D: TDlgExpert;
  466.   IHdrStream, ISourceStream, IFormStream: TIMemoryStream;
  467.   UnitIdent, FormIdent: string;
  468.   FileName: TFileName;
  469. begin
  470.   if ToolServices = nil then Exit;
  471.   if ToolServices.GetNewModuleName(UnitIdent, FileName) then
  472.   begin
  473.     D := TDlgExpert.Create(Application);
  474.     try
  475.       if D.ShowModal = mrOK then
  476.       begin
  477.         UnitIdent := LowerCase(UnitIdent);
  478.         UnitIdent[1] := Upcase(UnitIdent[1]);
  479.         FormIdent := 'Form' + Copy(UnitIdent, 5, 255);
  480.  
  481.         IFormStream := TIMemoryStream.Create(D.CreateForm(FormIdent));
  482.         try
  483.           IFormStream.AddRef;
  484.           IHdrStream := TIMemoryStream.Create(D.CreateHdrSource(UnitIdent,
  485.             FormIdent));
  486.           ISourceStream := TIMemoryStream.Create(D.CreateSource(UnitIdent,
  487.             FormIdent));
  488.           try
  489.             ISourceStream.AddRef;
  490.             IHdrStream.AddRef;
  491.             ToolServices.CreateProntoModule(FileName, '', '', '', IHdrStream,
  492.               ISourceStream, IFormStream, [cmAddToProject, cmShowSource, 
  493.               cmShowForm, cmUnNamed, cmMarkModified]);
  494.           finally
  495.             ISourceStream.OwnStream := True;
  496.             IHdrStream.OwnStream := True;
  497.             ISourceStream.Free;
  498.             IHdrStream.Free;
  499.           end;
  500.  
  501.         finally
  502.           IFormStream.OwnStream := True;
  503.           IFormStream.Free;
  504.         end;
  505.  
  506.       end;
  507.     finally
  508.       D.Free;
  509.     end;
  510.   end;
  511. end;
  512.  
  513. end.
  514.  
  515.  
  516.