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