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