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