home *** CD-ROM | disk | FTP | other *** search
/ Delphi 5 for Professionals / DELPHI5.iso / Runimage / Delphi50 / Demos / Experts / app.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1999-08-11  |  33.8 KB  |  1,224 lines
  1. unit App;
  2.  
  3. interface
  4.  
  5. uses
  6.   SysUtils, Windows, Messages, Classes, Graphics, Controls,
  7.   Forms, Dialogs, ToolIntf, StdCtrls, Buttons, ExtCtrls, ComCtrls;
  8.  
  9. type
  10.   TMoveDirection = (mdPrevious, mdNext, mdNoMove);
  11.  
  12.   TAppExpert = class(TForm)
  13.     Sample: TPaintBox;
  14.     CancelBtn: TButton;
  15.     PrevButton: TButton;
  16.     NextButton: TButton;
  17.     PageControl: TPageControl;
  18.     Menus: TTabSheet;
  19.     Label1: TLabel;
  20.     Label2: TLabel;
  21.     Label3: TLabel;
  22.     Label4: TLabel;
  23.     Label5: TLabel;
  24.     cbFileMenu: TCheckBox;
  25.     cbEditMenu: TCheckBox;
  26.     cbWindowMenu: TCheckBox;
  27.     cbHelpMenu: TCheckBox;
  28.     Extensions: TTabSheet;
  29.     Label6: TLabel;
  30.     Panel1: TPanel;
  31.     ExtHeader: THeader;
  32.     ExtListBox: TListBox;
  33.     AddButton: TButton;
  34.     EditButton: TButton;
  35.     DeleteButton: TButton;
  36.     UpButton: TButton;
  37.     DownButton: TButton;
  38.     Speedbtns: TTabSheet;
  39.     Label7: TLabel;
  40.     Speedbar: TPaintBox;
  41.     Label8: TLabel;
  42.     Label9: TLabel;
  43.     MenuList: TListBox;
  44.     MenuItemList: TListBox;
  45.     Button1: TButton;
  46.     Button2: TButton;
  47.     Button3: TButton;
  48.     AppInfo: TTabSheet;
  49.     Label13: TLabel;
  50.     Label10: TLabel;
  51.     Label15: TLabel;
  52.     GroupBox1: TGroupBox;
  53.     cbMDIApp: TCheckBox;
  54.     cbStatusLine: TCheckBox;
  55.     cbHints: TCheckBox;
  56.     AppPath: TEdit;
  57.     PathBrowse: TButton;
  58.     AppName: TEdit;
  59.     procedure FormCreate(Sender: TObject);
  60.     procedure NextPrevClick(Sender: TObject);
  61.     procedure DrawExtension(Control: TWinControl; Index: Integer;
  62.       Rect: TRect; State: TOwnerDrawState);
  63.     procedure AddClick(Sender: TObject);
  64.     procedure HeaderSized(Sender: TObject; ASection, AWidth: Integer);
  65.     procedure EditClick(Sender: TObject);
  66.     procedure DeleteClick(Sender: TObject);
  67.     procedure MoveClick(Sender: TObject);
  68.     procedure SpeedbarPaint(Sender: TObject);
  69.     procedure FormDestroy(Sender: TObject);
  70.     procedure MenuListClick(Sender: TObject);
  71.     procedure DrawMenuItem(Control: TWinControl; Index: Integer;
  72.       Rect: TRect; State: TOwnerDrawState);
  73.     procedure InsertClick(Sender: TObject);
  74.     procedure SpaceClick(Sender: TObject);
  75.     procedure SpeedMouseDown(Sender: TObject; Button: TMouseButton;
  76.       Shift: TShiftState; X, Y: Integer);
  77.     procedure RemoveClick(Sender: TObject);
  78.     procedure BrowseClick(Sender: TObject);
  79.     procedure SamplePaint(Sender: TObject);
  80.     procedure MenuClicked(Sender: TObject);
  81.   private
  82.     { Private declarations }
  83.     SpeedList: TList;
  84.     ButtonList: TList;
  85.     FSpeedIndex: Integer;
  86.     SpeedPointer: TBitmap;
  87.     Offscreen: TBitmap;
  88.     SampleBmp: TBitmap;
  89.     procedure RefreshButtons;
  90.     function NextPage(Direction: TMoveDirection): Integer;
  91.     function SpeedButtonRect(Index: Integer): TRect;
  92.     function SpeedButtonAtPos(Pos: TPoint): Integer;
  93.     function GetSpeedButtonCount: Integer;
  94.     function GetSpeedButtonID(Value: Integer): Integer;
  95.     function ValidateInfo: Boolean;
  96.   public
  97.     { Public declarations }
  98.     function HasMenus: Boolean;
  99.     property SpeedButtonCount: Integer read GetSpeedButtonCount;
  100.     property SpeedButtonID[Value: Integer]: Integer read GetSpeedButtonID;
  101.   end;
  102. var
  103.   AppExpert: TAppExpert;
  104.  
  105. procedure ApplicationExpert(ToolServices: TIToolServices);
  106.  
  107. implementation
  108.  
  109. uses ExConst, Filters, FileCtrl;
  110.  
  111. {$R *.DFM}
  112.  
  113. const
  114.   { page numbers }
  115.   pgMenus   = 0;
  116.   pgExtensions = 1;
  117.   pgSpeedbar = 2;
  118.   pgAppInfo = 3;
  119.  
  120.   FirstPage = pgMenus;
  121.   LastPage = pgAppInfo;
  122.  
  123.   DefaultButtonSize: TPoint = (X: 24; Y: 24);
  124.   DefaultButtonSpace: Integer = 6;
  125.  
  126.   MenuItemCount = 18;
  127.  
  128. type
  129.   TMainItems = (mmFile, mmEdit, mmWindow, mmHelp);
  130.  
  131. const
  132.   MenuItemCounts: array[TMainItems] of Integer = (7, 4, 3, 4);
  133.   MenuItemOffsets: array[TMainItems] of Integer = (0, 7, 11, 14);
  134.   SampleBitmaps: array[FirstPage..LastPage] of PChar = (
  135.     'MENUDSGN', 'EXTDSGN', 'SPEEDDSGN', 'INFODSGN');
  136.  
  137. { TButtonImage - draws the image of a TSpeedButton }
  138. type
  139.   TButtonImage = class(TObject)
  140.   private
  141.     FBitmapID: Word;
  142.     FBitmap: TBitmap;
  143.     FNumGlyphs: Integer;
  144.     procedure SetBitmapID(Value: Word);
  145.   public
  146.     constructor Create;
  147.     destructor Destroy; override;
  148.     procedure Draw(Canvas: TCanvas; X, Y: Integer);
  149.     property BitmapID: Word read FBitmapID write SetBitmapID;
  150.     property NumGlyphs: Integer read FNumGlyphs write FNumGlyphs;
  151.   end;
  152.  
  153. { Code generation support }
  154. type
  155.   TCodeSnipet = (csProgram, csMainIntf, csMainImpl, csFormCreateProc,
  156.     csShowHelpProc, csFileNewProc, csFileOpenProc, csFileSaveProc,
  157.     csFileSaveAsProc, csFilePrintProc, csFilePrintSetupProc, csFileExitProc,
  158.     csEditUndoProc, csEditCutProc, csEditCopyProc, csEditPasteProc,
  159.     csWindowTileProc, csWindowCascadeProc, csWindowArrangeProc,
  160.     csHelpContentsProc, csHelpSearchProc, csHelpHowToUseProc,
  161.     csHelpAboutProc, csForm, csFormMenu, csFormMDI, csHints, csCreateMethod,   
  162.     csMenuObject, csFileMenuObject, csEditMenuObject, csWindowMenuObject,
  163.     csHelpMenuObject, csOpenDialogObject, csSaveDialogObject,
  164.     csPrintDialogObject, csPrintSetupDialogObject, csStatusLineObject,
  165.     csSpeedbarObject, csSpeedButtonObject);
  166.  
  167. const
  168.   SourceBufferSize = 1024;
  169.  
  170. var
  171.   CodeSnipets: array[TCodeSnipet] of PChar;
  172.   CodeResource: THandle;
  173.   SourceBuffer: PChar;
  174.   ResourceBuffer: PChar;
  175.  
  176. procedure InitCodeGeneration;
  177. var
  178.   ResourceSize: Integer;
  179.   ResourcePtr, Text: PChar;
  180.   SnipetIndex: TCodeSnipet;
  181.   ResInstance: Longint;
  182. begin
  183.   ResInstance := System.FindResourceHInstance(HInstance);
  184.  
  185.   SourceBuffer := StrAlloc(SourceBufferSize);
  186.  
  187.   ResourceSize := SizeofResource(ResInstance,
  188.     FindResource(ResInstance, 'SNIPETS', RT_RCDATA));
  189.   CodeResource := LoadResource(ResInstance,
  190.     FindResource(ResInstance, 'SNIPETS', RT_RCDATA));
  191.   ResourcePtr := LockResource(CodeResource);
  192.   ResourceBuffer := StrAlloc(ResourceSize);
  193.   Move(ResourcePtr^, ResourceBuffer^, ResourceSize);
  194.   Text := ResourceBuffer;
  195.   for SnipetIndex := Low(TCodeSnipet) to High(TCodeSnipet) do
  196.   begin
  197.     CodeSnipets[SnipetIndex] := Text;
  198.     Text := AnsiStrScan(Text, '|');
  199.     while Text^ <> '|' do
  200.       if Text^ in LeadBytes then Inc(Text, 2) else Inc(Text);
  201.     Text^ := #0;
  202.     Inc(Text);
  203.   end;
  204. end;
  205.  
  206. procedure DoneCodeGeneration;
  207. begin
  208.   StrDispose(SourceBuffer);
  209.   UnlockResource(CodeResource);
  210.   FreeResource(CodeResource);
  211.   StrDispose(ResourceBuffer);
  212. end;
  213.  
  214. procedure BinToHex(Binary, Text: PChar; Count: Integer);
  215. const
  216.   HexChars: array[0..15] of Char = '0123456789ABCDEF';
  217. var
  218.   I: Integer;
  219. begin
  220.   for I := 0 to Count - 1 do
  221.   begin
  222.     Text^ := HexChars[(Byte(Binary[I]) and $F0) SHR 4];
  223.     Inc(Text);
  224.     Text^ := HexChars[(Byte(Binary[I]) and $0F)];
  225.     Inc(Text);
  226.   end;
  227. end;
  228.  
  229. procedure WriteBinaryAsText(Input: TStream; Output: TStream);
  230. const
  231.   BytesPerLine = 32;
  232.   NewLine: PChar = #13#10;
  233. var
  234.   MultiLine: Boolean;
  235.   I: Integer;
  236.   Count: Longint;
  237.   Buffer: array[0..BytesPerLine - 1] of Char;
  238.   Text: array[0..BytesPerLine * 2 - 1] of Char;
  239. begin
  240.   Count := Input.Size;
  241.   MultiLine := Count > BytesPerLine;
  242.   BinToHex(@Count, Text, 4);
  243.   Output.Write(Text, 4 * 2);
  244.  
  245.   while Count > 0 do
  246.   begin
  247.     if MultiLine then Output.Write(NewLine[0], 2);
  248.     if Count >= BytesPerLine then I := BytesPerLine else I := Count;
  249.     Input.Read(Buffer, I);
  250.     BinToHex(Buffer, Text, I);
  251.     Output.Write(Text, I * 2);
  252.     Dec(Count, I);
  253.   end;
  254. end;
  255.  
  256. procedure FmtWrite(Stream: TStream; Fmt: PChar; const Args: array of const);
  257. begin
  258.   StrLFmt(SourceBuffer, SourceBufferSize, Fmt, Args);
  259.   Stream.Write(SourceBuffer[0], StrLen(SourceBuffer));
  260. end;
  261.  
  262. procedure WriteSnipet(Stream: TStream; Snipet: TCodeSnipet);
  263. begin
  264.   Stream.Write(CodeSnipets[Snipet][0], StrLen(CodeSnipets[Snipet]));
  265. end;
  266.  
  267. procedure WriteIdent(Stream: TStream; ResID: Word; const VarType: string);
  268. begin
  269.   StrPCopy(SourceBuffer, Format('    %s: %s;'#13#10, [LoadStr(ResID), VarType]));
  270.   Stream.Write(SourceBuffer[0], StrLen(SourceBuffer));
  271. end;
  272.  
  273. procedure WriteMenuItems(Stream: TStream; MenuIndex: TMainItems);
  274. var
  275.   I: Integer;
  276. begin
  277.   for I := 0 to MenuItemCounts[MenuIndex] - 1 do
  278.     WriteIdent(Stream, sMenuItemNameBase + MenuItemOffsets[MenuIndex] + I,
  279.       'TMenuItem');
  280. end;
  281.  
  282. procedure WriteMethodDecl(Stream: TStream; ResID: Word);
  283. begin
  284.   StrPCopy(SourceBuffer, Format('    procedure %s(Sender: TObject);'#13#10,
  285.     [LoadStr(ResID)]));
  286.   Stream.Write(SourceBuffer[0], StrLen(SourceBuffer));
  287. end;
  288.  
  289. procedure WriteMethodHeader(Stream: TStream; ResID: Word);
  290. begin
  291.   StrPCopy(SourceBuffer, Format('procedure T%s.%s(Sender: TObject);'#13#10,
  292.     [LoadStr(sMainForm), LoadStr(ResID)]));
  293.   Stream.Write(SourceBuffer[0], StrLen(SourceBuffer));
  294. end;
  295.  
  296. procedure WriteMenuMethodDecls(Stream: TStream; MenuIndex: TMainItems);
  297. var
  298.   I: Integer;
  299. begin
  300.   for I := 0 to MenuItemCounts[MenuIndex] - 1 do
  301.     WriteMethodDecl(Stream, sMenuProcNames + MenuItemOffsets[MenuIndex] + I);
  302. end;
  303.  
  304. procedure WriteMenuMethods(Stream: TStream; MenuIndex: TMainItems;
  305.   BaseSnipet: TCodeSnipet);
  306. var
  307.   ID, I: Integer;
  308.   Snipet: TCodeSnipet;
  309. begin
  310.   ID := sMenuProcNames + MenuItemOffsets[MenuIndex];
  311.   for I := 0 to MenuItemCounts[MenuIndex] - 1 do
  312.   begin
  313.     WriteMethodHeader(Stream, ID + I);
  314.     Snipet := TCodeSnipet( I + Ord(BaseSnipet) );
  315.     WriteSnipet(Stream, Snipet);
  316.   end;
  317. end;
  318.  
  319. procedure WriteGlyphData(Stream: TStream; BitmapID: Word);
  320. var
  321.   Bitmap: TBitmap;
  322.   Memory: TMemoryStream;
  323. begin
  324.   Bitmap := TBitmap.Create;
  325.   try
  326.     Bitmap.Handle := LoadBitmap(HInstance, PChar(BitmapID));
  327.  
  328.     { stream the bitmap to a memory stream, and the write that stream as text }
  329.     Memory := TMemoryStream.Create;
  330.     try
  331.       Bitmap.SaveToStream(Memory);
  332.       Memory.Position := 0;
  333.       WriteBinaryAsText(Memory, Stream);
  334.     finally
  335.       Memory.Free;
  336.     end;
  337.  
  338.   finally
  339.     Bitmap.Free;
  340.   end;
  341.   FmtWrite(Stream, '}'#13#10'end'#13#10, [nil]);
  342. end;
  343.  
  344. function GenerateProjectSource(AppExpert: TAppExpert): TFileName;
  345. var
  346.   ProjectFile: TFileStream;
  347. begin
  348.   Result := AppExpert.AppPath.Text;
  349.   if (Result > '') and not (AnsiLastChar(Result)^ in [':', '\']) then
  350.     Result := Result + '\';
  351.   Result := Result + AppExpert.AppName.Text + '.DPR';
  352.  
  353.   ProjectFile := TFileStream.Create(Result, fmCreate);
  354.   try
  355.     StrFmt(SourceBuffer, CodeSnipets[csProgram], [AppExpert.AppName.Text]);
  356.     ProjectFile.Write(SourceBuffer[0], StrLen(SourceBuffer));
  357.   finally
  358.     ProjectFile.Free;
  359.   end;
  360. end;
  361.  
  362. procedure GenerateMainSourceFile(AppExpert: TAppExpert);
  363. var
  364.   Stream: TFileStream;
  365.   FileName: TFileName;
  366.   ButtonName: string[80];
  367.   ButtonText: string[30];
  368.   ButtonID: Integer;
  369.   I: Integer;
  370. begin
  371.   FileName := AppExpert.AppPath.Text;
  372.   if (FileName > '') and not (AnsiLastChar(FileName)^ in [':', '\']) then
  373.     FileName := FileName + '\';
  374.   FileName := FileName + LoadStr(sMainSourceFile);
  375.  
  376.   Stream := TFileStream.Create(FileName, fmCreate);
  377.   try
  378.     WriteSnipet(Stream, csMainIntf);
  379.  
  380.     SourceBuffer[0] := #0;
  381.  
  382.     { create the menu declarations }
  383.     if AppExpert.HasMenus then
  384.     begin
  385.       WriteIdent(Stream, sMainMenu, 'TMainMenu');
  386.       if AppExpert.cbFileMenu.Checked then WriteMenuItems(Stream, mmFile);
  387.       if AppExpert.cbEditMenu.Checked then WriteMenuItems(Stream, mmEdit);
  388.       if AppExpert.cbWindowMenu.Checked then WriteMenuItems(Stream, mmWindow);
  389.       if AppExpert.cbHelpMenu.Checked then WriteMenuItems(Stream, mmHelp);
  390.      end;
  391.  
  392.     { create any variable declarations }
  393.     if AppExpert.cbStatusLine.Checked then
  394.       WriteIdent(Stream, sStatusLine, 'TStatusBar');
  395.  
  396.     if AppExpert.cbFileMenu.Checked then
  397.     begin
  398.       WriteIdent(Stream, sOpenDialog, 'TOpenDialog');
  399.       WriteIdent(Stream, sSaveDialog, 'TSaveDialog');
  400.       WriteIdent(Stream, sPrintDialog, 'TPrintDialog');
  401.       WriteIdent(Stream, sPrintSetupDialog, 'TPrinterSetupDialog');
  402.     end;
  403.  
  404.     { create speedbuttons }
  405.     if AppExpert.SpeedButtonCount > 0 then
  406.     begin
  407.       WriteIdent(Stream, sSpeedBar, 'TPanel');
  408.  
  409.       ButtonName := '    ' + LoadStr(sSpeedButton) +
  410.         ': TSpeedButton;  { %s }'#13#10;
  411.  
  412.       ButtonID := 1;
  413.       for I := 0 to AppExpert.SpeedButtonCount - 1 do
  414.       begin
  415.         if AppExpert.SpeedButtonID[I] > -1 then
  416.         begin
  417.           ButtonText := LoadStr(AppExpert.SpeedButtonID[I]);
  418.           StrPCopy(SourceBuffer, Format(ButtonName, [ButtonID, ButtonText]));
  419.           Stream.Write(SourceBuffer[0], StrLen(SourceBuffer));
  420.           Inc(ButtonID);
  421.         end;
  422.       end;
  423.     end;
  424.  
  425.     { generate method declarations }
  426.     if AppExpert.cbStatusLine.Checked and AppExpert.cbHints.Checked then
  427.     begin
  428.       WriteMethodDecl(Stream, sFormCreateProc);
  429.       WriteMethodDecl(Stream, sShowHelpProc);
  430.     end;
  431.  
  432.     if AppExpert.cbFileMenu.Checked then WriteMenuMethodDecls(Stream, mmFile);
  433.     if AppExpert.cbEditMenu.Checked then WriteMenuMethodDecls(Stream, mmEdit);
  434.     if AppExpert.cbWindowMenu.Checked then WriteMenuMethodDecls(Stream, mmWindow);
  435.     if AppExpert.cbHelpMenu.Checked then WriteMenuMethodDecls(Stream, mmHelp);
  436.  
  437.     WriteSnipet(Stream, csMainImpl);
  438.  
  439.     { write code implementations }
  440.     if AppExpert.cbStatusLine.Checked and AppExpert.cbHints.Checked then
  441.     begin
  442.       WriteMethodHeader(Stream, sFormCreateProc);
  443.       WriteSnipet(Stream, csFormCreateProc);
  444.       WriteMethodHeader(Stream, sShowHelpProc);
  445.       WriteSnipet(Stream, csShowHelpProc);
  446.     end;
  447.  
  448.     if AppExpert.cbFileMenu.Checked then
  449.       WriteMenuMethods(Stream, mmFile, csFileNewProc);
  450.  
  451.     if AppExpert.cbEditMenu.Checked then
  452.       WriteMenuMethods(Stream, mmEdit, csEditUndoProc);
  453.  
  454.     if AppExpert.cbWindowMenu.Checked then
  455.       WriteMenuMethods(Stream, mmWindow, csWindowTileProc);
  456.  
  457.     if AppExpert.cbHelpMenu.Checked then
  458.       WriteMenuMethods(Stream, mmHelp, csHelpContentsProc);
  459.  
  460.     FmtWrite(Stream, 'end.'#13#10, [nil]);
  461.  
  462.   finally
  463.     Stream.Free;
  464.   end;
  465. end;
  466.  
  467. procedure GenerateMainFormFile(AppExpert: TAppExpert);
  468. const
  469.   ButtonWidth = 25;
  470.   SpaceWidth = 4;
  471. var
  472.   TextStream: TFileStream;
  473.   FormStream: TFileStream;
  474.   TextName: TFileName;
  475.   FormName: TFileName;
  476.   Filter: string;
  477.   ButtonNumber: Integer;
  478.   ButtonID: Integer;
  479.   ButtonMethod: string;
  480.   ButtonHint: string;
  481.   ButtonX: Integer;
  482.   I: Integer;
  483. begin
  484.   TextName := AppExpert.AppPath.Text;
  485.   if (TextName > '') and not (AnsiLastChar(TextName)^ in [':', '\']) then
  486.     TextName := TextName + '\';
  487.   FormName := TextName + LoadStr(sMainFormFile);
  488.   TextName := TextName + LoadStr(sMainFormText);
  489.  
  490.   TextStream := TFileStream.Create(TextName, fmCreate);
  491.   try
  492.     WriteSnipet(TextStream, csForm);
  493.     if AppExpert.cbMDIApp.Checked then WriteSnipet(TextStream, csFormMDI);
  494.     if AppExpert.HasMenus then WriteSnipet(TextStream, csFormMenu);
  495.     if AppExpert.cbHints.Checked then
  496.     begin
  497.       WriteSnipet(TextStream, csHints);
  498.       if AppExpert.cbStatusLine.Checked then
  499.         WriteSnipet(TextStream, csCreateMethod);
  500.     end;
  501.  
  502.     { write menus }
  503.     if AppExpert.HasMenus then
  504.     begin
  505.       WriteSnipet(TextStream, csMenuObject);
  506.  
  507.       if AppExpert.cbFileMenu.Checked then
  508.         WriteSnipet(TextStream, csFileMenuObject);
  509.       if AppExpert.cbEditMenu.Checked then
  510.         WriteSnipet(TextStream, csEditMenuObject);
  511.       if AppExpert.cbWindowMenu.Checked then
  512.         WriteSnipet(TextStream, csWindowMenuObject);
  513.       if AppExpert.cbHelpMenu.Checked then
  514.         WriteSnipet(TextStream, csHelpMenuObject);
  515.  
  516.       FmtWrite(TextStream, '  end'#13#10, [nil]);
  517.  
  518.       if AppExpert.cbFileMenu.Checked then
  519.       begin
  520.         { create the dialog objects }
  521.         Filter := '';
  522.         for I := 0 to AppExpert.ExtListBox.Items.Count - 1 do
  523.           Filter := Filter + AppExpert.ExtListBox.Items[I] + '|';
  524.         if (AnsiLastChar(Filter) <> nil) and (AnsiLastChar(Filter) = '|') then
  525.           Delete(Filter, Length(Filter), 1);
  526.  
  527.         FmtWrite(TextStream, CodeSnipets[csOpenDialogObject], [Filter]);
  528.         FmtWrite(TextStream, CodeSnipets[csSaveDialogObject], [Filter]);
  529.         WriteSnipet(TextStream, csPrintDialogObject);
  530.         WriteSnipet(TextStream, csPrintSetupDialogObject);
  531.       end;
  532.  
  533.     end;
  534.  
  535.     if AppExpert.cbStatusLine.Checked then
  536.       WriteSnipet(TextStream, csStatusLineObject);
  537.  
  538.     { create speedbuttons }
  539.     if AppExpert.SpeedButtonCount > 0 then
  540.     begin
  541.       WriteSnipet(TextStream, csSpeedbarObject);
  542.  
  543.       ButtonNumber := 0;
  544.       ButtonX := 8;
  545.  
  546.       for I := 0 to AppExpert.SpeedButtonCount - 1 do
  547.       begin
  548.         if AppExpert.SpeedButtonID[I] > -1 then
  549.         begin
  550.           Inc(ButtonNumber);
  551.           ButtonID := AppExpert.SpeedButtonID[I] - sMenuItemTextBase;
  552.           ButtonMethod := LoadStr(ButtonID + sMenuProcNames);
  553.           ButtonHint := LoadStr(ButtonID + sHintBase);
  554.           FmtWrite(TextStream, CodeSnipets[csSpeedButtonObject],
  555.             [ButtonNumber, ButtonX, ButtonMethod, ButtonHint]);
  556.           WriteGlyphData(TextStream, ButtonID + 11100);
  557.           Inc(ButtonX, ButtonWidth - 1);
  558.         end
  559.         else Inc(ButtonX, SpaceWidth);
  560.       end;
  561.  
  562.       FmtWrite(TextStream, '  end'#13#10, [nil]);
  563.     end;
  564.  
  565.     FmtWrite(TextStream, 'end'#13#10, [nil]);
  566.  
  567.     { reset the text stream for conversion }
  568.     TextStream.Position := 0;
  569.  
  570.     FormStream := TFileStream.Create(FormName, fmCreate);
  571.     try
  572.       ObjectTextToResource(TextStream, FormStream);
  573.     finally
  574.       FormStream.Free;
  575.     end;
  576.  
  577.   finally
  578.     TextStream.Free;
  579.   end;
  580. end;
  581.  
  582. procedure GenerateResourceFile(const ProjectName: string);
  583. var
  584.   ResourceStream: TResourceStream;
  585. begin
  586.   ResourceStream := TResourceStream.Create(HInstance, 'Resource', RT_RCDATA);
  587.   try
  588.     ResourceStream.SaveToFile(ChangeFileExt(ProjectName, '.RES'));
  589.   finally
  590.     ResourceStream.Free;
  591.   end;
  592. end;
  593.  
  594. { interface procedure }
  595. procedure ApplicationExpert(ToolServices: TIToolServices);
  596. var
  597.   D: TAppExpert;
  598.   ProjectName: TFileName;
  599. begin
  600.   D := TAppExpert.Create(Application);
  601.   try
  602.     if D.ShowModal = mrOK then
  603.     begin
  604.  
  605.       InitCodeGeneration;
  606.       try
  607.         ProjectName := ExpandFileName(GenerateProjectSource(D));
  608.         GenerateMainSourceFile(D);
  609.         GenerateMainFormFile(D);
  610.         GenerateResourceFile(ProjectName);
  611.       finally
  612.         DoneCodeGeneration;
  613.       end;
  614.  
  615.       { open the new project }
  616.       if (ToolServices <> nil) and ToolServices.CloseProject then
  617.         ToolServices.OpenProject(ProjectName);
  618.     end;
  619.   finally
  620.     D.Free;
  621.   end;
  622. end;
  623.  
  624. function EditFilterInfo(var Filter: string): Boolean;
  625. var
  626.   D: TFilterDlg;
  627. begin
  628.   D := TFilterDlg.Create(Application);
  629.   try
  630.     D.Filter := Filter;
  631.     Result := D.ShowModal = mrOK;
  632.     if Result then Filter := D.Filter;
  633.   finally
  634.     D.Free;
  635.   end;
  636. end;
  637.  
  638. procedure ClearButtonImages(List: TList);
  639. var
  640.   I: Integer;
  641. begin
  642.   for I := 0 to List.Count - 1 do
  643.     TButtonImage(List[I]).Free;
  644.   List.Clear;
  645. end;
  646.  
  647. { TButtonImage }
  648. constructor TButtonImage.Create;
  649. begin
  650.   FBitmap := TBitmap.Create;
  651.   FNumGlyphs := 1;
  652. end;
  653.  
  654. destructor TButtonImage.Destroy;
  655. begin
  656.   FBitmap.Free;
  657.   inherited Destroy;
  658. end;
  659.  
  660. procedure TButtonImage.SetBitmapID(Value: Word);
  661. begin
  662.   if FBitmapID <> Value then
  663.   begin
  664.     FBitmapID := Value;
  665.     FBitmap.Handle := LoadBitmap(HInstance, PChar(FBitmapID));
  666.   end;
  667. end;
  668.  
  669. procedure TButtonImage.Draw(Canvas: TCanvas; X, Y: Integer);
  670. var
  671.   BX: Integer;
  672.   Target: TRect;
  673.   Source: TRect;
  674.   SavePen, SaveBrush: TColor;
  675. begin
  676.   with Canvas do
  677.   begin
  678.     SavePen := Canvas.Pen.Color;
  679.     SaveBrush := Canvas.Brush.Color;
  680.  
  681.     Target := DrawButtonFace(Canvas, Bounds(X, Y, DefaultButtonSize.X,
  682.       DefaultButtonSize.Y), 1, bsWin31, False, False, False);
  683.  
  684.     { draw bitmap }
  685.     BX := FBitmap.Width div FNumGlyphs;
  686.     if BX > 0 then
  687.     begin
  688.       Target := Bounds(X, Y, BX, FBitmap.Height);
  689.       OffsetRect(Target, (DefaultButtonSize.X div 2) - (BX div 2),
  690.         (DefaultButtonSize.Y div 2) - (FBitmap.Height div 2));
  691.       Source := Bounds(0, 0, BX, FBitmap.Height);
  692.       BrushCopy(Target, FBitmap, Source,
  693.         FBitmap.Canvas.Pixels[0, FBitmap.Height - 1]);
  694.     end;
  695.  
  696.     Canvas.Pen.Color := SavePen;
  697.     Canvas.Brush.Color := SaveBrush;
  698.   end;
  699. end;
  700.  
  701.  
  702. { TAppExpert }
  703. procedure TAppExpert.FormCreate(Sender: TObject);
  704. var
  705.   ID: Word;
  706.   ButtonImage: TButtonImage;
  707. begin
  708.   SpeedList := TList.Create;
  709.   ButtonList := TList.Create;
  710.   SpeedPointer := TBitmap.Create;
  711.   SpeedPointer.Handle := LoadBitmap(HInstance, 'SPEEDPOINTER');
  712.   Offscreen := TBitmap.Create;
  713.   Offscreen.Width := SpeedBar.Width;
  714.   Offscreen.Height := SpeedBar.Height;
  715.  
  716.   SampleBmp := TBitmap.Create;
  717.  
  718.   { fill the MenuItemList with the speedbuttons }
  719.   for ID := sMenuItemTextBase to sMenuItemTextBase + MenuItemCount - 1 do
  720.   begin
  721.     ButtonImage := TButtonImage.Create;
  722.     ButtonImage.NumGlyphs := 2;
  723.     ButtonImage.BitmapID := ID;
  724.     ButtonList.Add(ButtonImage);
  725.   end;
  726.  
  727.   { This is required to prevent the speedbar from erasing its background
  728.     each time it paints.  This dramatically reduces (eliminates) any
  729.     flicker when painting. (Try commenting out this line to see the
  730.     difference) }
  731.   SpeedBar.ControlStyle := [csOpaque];
  732.  
  733.   PageControl.ActivePage := PageControl.Pages[FirstPage];
  734.   SampleBmp.Handle := LoadBitmap(HInstance, SampleBitmaps[FirstPage]);
  735.  
  736.   RefreshButtons;
  737. end;
  738.  
  739. procedure TAppExpert.FormDestroy(Sender: TObject);
  740. begin
  741.   ClearButtonImages(ButtonList);
  742.   ButtonList.Free;
  743.   SpeedList.Free;
  744.   SpeedPointer.Free;
  745.   Offscreen.Free;
  746.   SampleBmp.Free;
  747. end;
  748.  
  749. function TAppExpert.HasMenus: Boolean;
  750. begin
  751.   Result := (cbFileMenu.Checked) or (cbEditMenu.Checked) or
  752.     (cbWindowMenu.Checked) or (cbHelpMenu.Checked);
  753. end;
  754.  
  755. { calculate which page is next based on current page and settings.
  756.   -1 = last page
  757.   -2 = cannot move in requested direction }
  758. function TAppExpert.NextPage(Direction: TMoveDirection): Integer;
  759. var
  760.   CurPage: Integer;
  761. begin
  762.   Result := -2;
  763.   CurPage := PageControl.ActivePage.PageIndex;
  764.  
  765.   case Direction of
  766.  
  767.     mdNoMove: if CurPage = LastPage then Result := -1
  768.       else Result := 0;
  769.  
  770.     mdPrevious:
  771.       begin
  772.         case CurPage of
  773.           pgMenus: begin { do nothing } end;
  774.           pgExtensions: Result := pgMenus;
  775.           pgSpeedbar: if cbFileMenu.Checked then Result := pgExtensions
  776.             else Result := pgMenus;
  777.           pgAppInfo: if HasMenus then Result := pgSpeedbar
  778.             else Result := pgMenus;
  779.         end;
  780.       end;
  781.  
  782.     mdNext:
  783.       begin
  784.         case CurPage of
  785.           pgMenus:
  786.             if cbFileMenu.Checked then Result := pgExtensions
  787.             else if HasMenus then Result := pgSpeedbar
  788.             else Result := pgAppInfo;
  789.           pgExtensions: Result := pgSpeedbar;
  790.           pgSpeedbar: Result := pgAppInfo;
  791.           pgAppInfo: Result := -1;
  792.         end;
  793.       end;
  794.   end;
  795. end;
  796.  
  797. procedure TAppExpert.RefreshButtons;
  798. begin
  799.   case NextPage(mdNoMove) of
  800.    -1: NextButton.Caption := LoadStr(sFinish);
  801.     0: NextButton.Caption := LoadStr(sNext);
  802.   end;
  803.   case NextPage(mdPrevious) of
  804.     -2: PrevButton.Enabled := False;
  805.     else PrevButton.Enabled := True;
  806.   end;
  807. end;
  808.  
  809. procedure RemoveItems(List: TList; MenuIndex: TMainItems);
  810. var
  811.   StartID: Integer;
  812.   EndID: Integer;
  813.   I: Integer;
  814.   ButtonImage: TButtonImage;
  815. begin
  816.   StartID := sMenuItemTextBase + MenuItemOffsets[MenuIndex];
  817.   EndID := StartID + MenuItemCounts[MenuIndex];
  818.  
  819.   I := 0;
  820.  
  821.   while I < List.Count do
  822.   begin
  823.     ButtonImage := TButtonImage(List[I]);
  824.     if (ButtonImage <> nil) and (ButtonImage.BitmapID < EndID) and
  825.       (ButtonImage.BitmapID >= StartID) then
  826.       List.Delete(I)
  827.     else Inc(I);
  828.   end;
  829. end;
  830.  
  831. procedure TAppExpert.MenuClicked(Sender: TObject);
  832. var
  833.   MenuIndex: TMainItems;
  834.   MenuOn: Boolean;
  835. begin
  836.   { a menu category has been turned on/off }
  837.   for MenuIndex := Low(TMainItems) to High(TMainItems) do
  838.   begin
  839.     case MenuIndex of
  840.       mmFile: MenuOn := cbFileMenu.Checked;
  841.       mmEdit: MenuOn := cbEditMenu.Checked;
  842.       mmWindow: MenuOn := cbWindowMenu.Checked;
  843.       mmHelp: MenuOn := cbHelpMenu.Checked;
  844.     else
  845.       MenuOn := False;
  846.     end;
  847.     if not MenuOn then
  848.     begin
  849.       RemoveItems(SpeedList, MenuIndex);
  850.       FSpeedIndex := 0;
  851.     end;
  852.     if MenuList.ItemIndex = Ord(MenuIndex) then
  853.       MenuListClick(Self);
  854.   end;
  855. end;
  856.  
  857. function TAppExpert.ValidateInfo: Boolean;
  858. begin
  859.   Result := False;
  860.   if AppName.Text = '' then
  861.   begin
  862.     MessageDlg(LoadStr(sAppNameRequired), mtError, [mbOK], 0);
  863.     Exit;
  864.   end;
  865.   if not IsValidIdent(AppName.Text) then
  866.   begin
  867.     MessageDlg(LoadStr(sInvalidAppName), mtError, [mbOK], 0);
  868.     Exit;
  869.   end;
  870.   if not DirectoryExists(AppPath.Text) then
  871.   begin
  872.     MessageDlg(LoadStr(sInvalidPath), mtError, [mbOK], 0);
  873.     Exit;
  874.   end;
  875.   Result := True;
  876. end;
  877.  
  878. procedure TAppExpert.NextPrevClick(Sender: TObject);
  879. var
  880.   NewPage: Integer;
  881. begin
  882.   if Sender = PrevButton then NewPage := NextPage(mdPrevious)
  883.   else NewPage := NextPage(mdNext);
  884.  
  885.   case NewPage of
  886.    -1: if ValidateInfo then ModalResult := mrOK;
  887.    -2: begin { do nothing } end;
  888.     else
  889.     begin
  890.       if SampleBitmaps[NewPage] <> nil then
  891.       begin
  892.         SampleBmp.Handle := LoadBitmap(HInstance, SampleBitmaps[NewPage]);
  893.         Sample.Invalidate;
  894.       end;
  895.       PageControl.ActivePage := PageControl.Pages[NewPage];
  896.     end;
  897.   end;
  898.   RefreshButtons;
  899. end;
  900.  
  901. { draw the file extension list box }
  902. procedure TAppExpert.DrawExtension(Control: TWinControl; Index: Integer;
  903.   Rect: TRect; State: TOwnerDrawState);
  904. var
  905.   P: Integer;
  906.   R: TRect;
  907.   C: array[0..255] of Char;
  908.   S: string;
  909. begin
  910.   { find the separator in the string }
  911.   P := AnsiPos('|', ExtListBox.Items[Index]);
  912.  
  913.   { adjust the rectangle so we draw only the left "column" }
  914.   R := Rect;
  915.  
  916.   { draw the filter description }
  917.   S := Copy(ExtListBox.Items[Index], 1, P - 1);
  918.   R.Right := R.Left + ExtHeader.SectionWidth[0];
  919.   ExtTextOut(ExtListBox.Canvas.Handle, R.Left, R.Top, ETO_CLIPPED or
  920.     ETO_OPAQUE, @R, StrPCopy(C, S), Length(S), nil);
  921.  
  922.   { move the rectangle to the next column }
  923.   R.Left := R.Right;
  924.   R.Right := Rect.Right;
  925.   S := Copy(ExtListBox.Items[Index], P + 1, 255);
  926.   ExtTextOut(ExtListBox.Canvas.Handle, R.Left, R.Top, ETO_CLIPPED or
  927.     ETO_OPAQUE, @R, StrPCopy(C, S), Length(S), nil);
  928. end;
  929.  
  930. procedure TAppExpert.HeaderSized(Sender: TObject; ASection,
  931.   AWidth: Integer);
  932. begin
  933.   ExtListBox.Invalidate;
  934. end;
  935.  
  936. procedure TAppExpert.AddClick(Sender: TObject);
  937. var
  938.   Filter: string;
  939. begin
  940.   Filter := '';
  941.   if EditFilterInfo(Filter) then
  942.     ExtListBox.Items.Add(Filter);
  943. end;
  944.  
  945. procedure TAppExpert.EditClick(Sender: TObject);
  946. var
  947.   Filter: string;
  948. begin
  949.   if ExtListBox.ItemIndex > -1 then
  950.   begin
  951.     Filter := ExtListBox.Items[ExtListBox.ItemIndex];
  952.     if EditFilterInfo(Filter) then
  953.       ExtListBox.Items[ExtListBox.ItemIndex] := Filter;
  954.   end;
  955. end;
  956.  
  957. procedure TAppExpert.DeleteClick(Sender: TObject);
  958. begin
  959.   if ExtListBox.ItemIndex > -1 then
  960.     ExtListBox.Items.Delete(ExtListBox.ItemIndex);
  961. end;
  962.  
  963. procedure TAppExpert.MoveClick(Sender: TObject);
  964. var
  965.   Delta: Integer;
  966.   NewPos: Integer;
  967. begin
  968.   if ExtListBox.ItemIndex <> -1 then
  969.   begin
  970.     if Sender = UpButton then Delta := -1
  971.     else if Sender = DownButton then Delta := 1
  972.     else Delta := 0;
  973.  
  974.     if Delta <> 0 then
  975.     begin
  976.       NewPos := ExtListBox.ItemIndex + Delta;
  977.       if (NewPos >= 0) and (NewPos < ExtListBox.Items.Count) then
  978.       begin
  979.         ExtListBox.Items.Move(ExtListBox.ItemIndex, NewPos);
  980.         ExtListBox.ItemIndex := NewPos;
  981.       end;
  982.     end;
  983.   end;
  984. end;
  985.  
  986. { return the rectangle of the specified speedbutton or space }
  987. function TAppExpert.SpeedButtonRect(Index: Integer): TRect;
  988. var
  989.   I: Integer;
  990.   X: Integer;
  991. begin
  992.   X := 10;  { first usable position }
  993.  
  994.   for I := 0 to Index - 1 do
  995.     if SpeedList[I] = nil then Inc(X, DefaultButtonSpace)
  996.     else Inc(X, DefaultButtonSize.X - 1);
  997.  
  998.   Result := Bounds(X, 5, DefaultButtonSize.X, DefaultButtonSize.Y);
  999.   if (Index < SpeedList.Count) and (SpeedList[Index] = nil) then
  1000.     Result.Right := Result.Left + DefaultButtonSpace;
  1001. end;
  1002.  
  1003. { return an index into SpeedList from the TPoint }
  1004. function TAppExpert.SpeedButtonAtPos(Pos: TPoint): Integer;
  1005. var
  1006.   R: TRect;
  1007.   I: Integer;
  1008. begin
  1009.   for I := 0 to SpeedList.Count - 1 do
  1010.   begin
  1011.     R := SpeedButtonRect(I);
  1012.     if PtInRect(R, Pos) then
  1013.     begin
  1014.       Result := I;
  1015.       Exit;
  1016.     end;
  1017.   end;
  1018.   Result := -1;
  1019. end;
  1020.  
  1021. function TAppExpert.GetSpeedButtonCount: Integer;
  1022. begin
  1023.   Result := SpeedList.Count;
  1024. end;
  1025.  
  1026. function TAppExpert.GetSpeedButtonID(Value: Integer): Integer;
  1027. var
  1028.   ButtonImage: TButtonImage;
  1029. begin
  1030.   ButtonImage := TButtonImage(SpeedList[Value]);
  1031.   if ButtonImage <> nil then Result := ButtonImage.BitmapID
  1032.   else Result := -1;
  1033. end;
  1034.  
  1035. procedure TAppExpert.SpeedbarPaint(Sender: TObject);
  1036. var
  1037.   I: Integer;
  1038.   ButtonImage: TButtonImage;
  1039.   X: Integer;
  1040.   R: TRect;
  1041. begin
  1042.   with Offscreen.Canvas do
  1043.   begin
  1044.     Pen.Color := clWindowFrame;
  1045.     Brush.Style := bsClear;
  1046.     Brush.Color := SpeedBar.Color;
  1047.  
  1048.     Rectangle(1, 1, SpeedBar.Width - 1, SpeedBar.Height - 1);
  1049.     Pen.Color := clBtnShadow;
  1050.     PolyLine([Point(0, Speedbar.Height - 1), Point(0, 0),
  1051.       Point(SpeedBar.Width - 1, 0)]);
  1052.     Pen.Color := clBtnHighlight;
  1053.     PolyLine([ Point(SpeedBar.Width - 1, 0),
  1054.       Point(SpeedBar.Width - 1, SpeedBar.Height)]);
  1055.   end;
  1056.  
  1057.   { Draw the buttons in the list }
  1058.   X := 10;
  1059.   for I := 0 to SpeedList.Count - 1 do
  1060.   begin
  1061.     ButtonImage := TButtonImage(SpeedList[I]);
  1062.     if ButtonImage = nil then
  1063.     begin
  1064.       Offscreen.Canvas.Brush.Style := bsSolid;
  1065.       Offscreen.Canvas.Brush.Color := clBtnShadow;
  1066.       R := Bounds(X + 2, 5, DefaultButtonSpace - 3, DefaultButtonSize.Y - 2);
  1067.       Offscreen.Canvas.FillRect(R);
  1068.       Inc(X, DefaultButtonSpace);
  1069.     end
  1070.     else
  1071.     begin
  1072.       Offscreen.Canvas.Brush.Style := bsSolid;
  1073.       ButtonImage.Draw(Offscreen.Canvas, X, 4);
  1074.       Inc(X, DefaultButtonSize.X - 1);
  1075.     end;
  1076.  
  1077.     if X + (DefaultButtonSize.X * 2) > SpeedBar.Width then Break;
  1078.  
  1079.     { draw the insertion point }
  1080.     R := SpeedButtonRect(FSpeedIndex);
  1081.     OffsetRect(R, -5, 0);
  1082.     R.Top := R.Bottom + 2;
  1083.     R.Bottom := R.Top + SpeedPointer.Height;
  1084.     R.Right := R.Left + SpeedPointer.Width;
  1085.     Offscreen.Canvas.Brush.Color := SpeedBar.Color;
  1086.     Offscreen.Canvas.BrushCopy(R, SpeedPointer, Rect(0, 0, SpeedPointer.Width,
  1087.       SpeedPointer.Height), clWhite);
  1088.   end;
  1089.   SpeedBar.Canvas.Draw(0, 0, Offscreen);
  1090. end;
  1091.  
  1092. { The list of menus was clicked }
  1093. procedure TAppExpert.MenuListClick(Sender: TObject);
  1094. var
  1095.   ID: Word;
  1096.   I: Integer;
  1097.   ButtonIndex: Integer;
  1098.   MenuOn: Boolean;
  1099. begin
  1100.   if MenuList.ItemIndex > -1 then
  1101.   begin
  1102.     ID := sMenuItemTextBase + MenuItemOffsets[ TMainItems(MenuList.ItemIndex) ];
  1103.  
  1104.     MenuItemList.Items.BeginUpdate;
  1105.  
  1106.     try
  1107.       MenuItemList.Clear;
  1108.  
  1109.       case MenuList.ItemIndex of
  1110.         0: MenuOn := cbFileMenu.Checked;
  1111.         1: MenuOn := cbEditMenu.Checked;
  1112.         2: MenuOn := cbWindowMenu.Checked;
  1113.         3: MenuOn := cbHelpMenu.Checked;
  1114.       else
  1115.         MenuOn := False;
  1116.       end;
  1117.  
  1118.       if MenuOn then
  1119.       begin
  1120.         { load the list box with the buttons and text }
  1121.         for I := 0 to MenuItemCounts[ TMainItems(MenuList.ItemIndex) ] - 1 do
  1122.         begin
  1123.           ButtonIndex := I + MenuItemOffsets[ TMainItems(MenuList.ItemIndex) ];
  1124.           MenuItemList.Items.AddObject(LoadStr(ID + I), ButtonList[ButtonIndex]);
  1125.         end;
  1126.       end;
  1127.  
  1128.     finally
  1129.       MenuItemList.Items.EndUpdate;
  1130.     end;
  1131.   end;
  1132. end;
  1133.  
  1134. procedure TAppExpert.DrawMenuItem(Control: TWinControl; Index: Integer;
  1135.   Rect: TRect; State: TOwnerDrawState);
  1136. var
  1137.   ButtonImage: TButtonImage;
  1138.   R: TRect;
  1139.   C: array[0..255] of Char;
  1140. begin
  1141.   ExtTextOut(MenuItemList.Canvas.Handle, R.Left, R.Top, ETO_OPAQUE,
  1142.     @Rect, nil, 0, nil);
  1143.   ButtonImage := TButtonImage(MenuItemList.Items.Objects[Index]);
  1144.   ButtonImage.Draw(MenuItemList.Canvas, Rect.Left + 2, Rect.Top + 1);
  1145.  
  1146.   R := Rect;
  1147.   Inc(R.Left, DefaultButtonSize.X + 2 + 4);
  1148.   DrawText(MenuItemList.Canvas.Handle,
  1149.     StrPCopy(C, MenuItemList.Items[Index]), -1, R, DT_VCENTER or DT_SINGLELINE);
  1150. end;
  1151.  
  1152. { Insert the current button into the speedbar }
  1153. procedure TAppExpert.InsertClick(Sender: TObject);
  1154. var
  1155.   ButtonImage: TButtonImage;
  1156. begin
  1157.   if MenuItemList.ItemIndex > -1 then
  1158.   begin
  1159.     with MenuItemList do
  1160.       ButtonImage := TButtonImage(Items.Objects[ItemIndex]);
  1161.     if FSpeedIndex < SpeedList.Count then
  1162.       SpeedList.Insert(FSpeedIndex, ButtonImage)
  1163.     else
  1164.       SpeedList.Add(ButtonImage);
  1165.     Inc(FSpeedIndex);
  1166.     SpeedBar.Invalidate;
  1167.   end;
  1168. end;
  1169.  
  1170. procedure TAppExpert.SpaceClick(Sender: TObject);
  1171. begin
  1172.   if FSpeedIndex < SpeedList.Count then
  1173.     SpeedList.Insert(FSpeedIndex, nil)
  1174.   else
  1175.     SpeedList.Add(nil);
  1176.   Inc(FSpeedIndex);
  1177.   SpeedBar.Invalidate;
  1178. end;
  1179.  
  1180. procedure TAppExpert.RemoveClick(Sender: TObject);
  1181. begin
  1182.   if FSpeedIndex < SpeedList.Count then
  1183.   begin
  1184.     SpeedList.Delete(FSpeedIndex);
  1185.     if FSpeedIndex > SpeedList.Count then
  1186.       FSpeedIndex := SpeedList.Count;
  1187.     SpeedBar.Invalidate;
  1188.   end;
  1189. end;
  1190.  
  1191. { The mouse was clicked in the speedbar area }
  1192. procedure TAppExpert.SpeedMouseDown(Sender: TObject; Button: TMouseButton;
  1193.   Shift: TShiftState; X, Y: Integer);
  1194. var
  1195.   Index: Integer;
  1196. begin
  1197.   Index := SpeedButtonAtPos(Point(X, Y));
  1198.   if Index <> -1 then FSpeedIndex := Index
  1199.   else FSpeedIndex := SpeedList.Count;
  1200.   Speedbar.Invalidate;
  1201. end;
  1202.  
  1203. procedure TAppExpert.BrowseClick(Sender: TObject);
  1204. var
  1205.   D: string;
  1206. begin
  1207.   D := AppPath.Text;
  1208.   if SelectDirectory(D, [sdAllowCreate, sdPrompt, sdPerformCreate], 0) then
  1209.     AppPath.Text := D;
  1210. end;
  1211.  
  1212. procedure TAppExpert.SamplePaint(Sender: TObject);
  1213. var
  1214.   R: TRect;
  1215. begin
  1216.   if SampleBmp <> nil then
  1217.   begin
  1218.     R := Rect(0, 0, SampleBmp.Width, SampleBmp.Height);
  1219.     Sample.Canvas.BrushCopy(R, SampleBmp, R, SampleBmp.TransparentColor);
  1220.   end;
  1221. end;
  1222.  
  1223. end.
  1224.