unit NewProject;

interface

uses
  Windows, SysUtils, Messages, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, Buttons, ComCtrls, SynEdit, marsCap, ImgList, IniFiles;

type
  TTemplate = Class
  public
    FileName: String;
    Name, Icon, Description, Catagory: String;
    Text : String;
    CursorX, CursorY : Integer;
    Console, DLL : Boolean;
    CompilerOptions, Libs, ProjectName, IncludeDirs: String;
  end;

  TNewProjForm = class(TForm)
    PageControl: TPageControl;
    ProjectSheet: TTabSheet;
    ProjView: TListView;
    OkBtn: TBitBtn;
    CancelBtn: TBitBtn;
    MarsCaption1: TMarsCaption;
    ImageList: TImageList;
    TemplateLabel: TLabel;
    ImageList1: TImageList;
    Label1: TLabel;
    procedure OkBtnClick(Sender: TObject);
    procedure WindowsAppText(S: String);
    procedure DosText;
    procedure WinMainText;
    procedure ProjViewDblClick(Sender: TObject);
    procedure FormActivate(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure PageControlChange(Sender: TObject);
    procedure CustomTKeyDown(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure ProjViewChange(Sender: TObject; Item: TListItem;
      Change: TItemChange);
  private
    { Private declarations }
  public
    Text: String;
    X, Y: Integer;
    Console, DLL: Boolean;
    TheTemplate: TTemplate;
    procedure ReadTemplateIndex;
    procedure ListViewChange(Sender: TObject; Item: TListItem;
      Change: TItemChange);
    procedure ListViewDblClick(Sender: TObject);
  end;
  TNewProject = (TDll, TTemplateDoc, TOther);

var
  NewProjForm : TNewProjForm;
  ProjectType : TNewProject = TOther;

implementation

uses Main;

{$R *.DFM}

procedure FilesFromWildcard(Directory, Mask: String;
  var Files : TStringList; Subdirs, ShowDirs, Multitasking: Boolean);
var
  SearchRec: TSearchRec;
  Attr, Error: Integer;
begin
  if (Directory[Length(Directory)] <> '\') then
     Directory := Directory + '\';

  { First, find the required file... }
  Attr := faAnyFile;
  if ShowDirs = False then
     Attr := Attr - faDirectory;
  Error := FindFirst(Directory + Mask, Attr, SearchRec);
  if (Error = 0) then
  begin
     while (Error = 0) do
     begin
     { Found one! }
        Files.Add(Directory + SearchRec.Name);
        Error := FindNext(SearchRec);
        if Multitasking then
           Application.ProcessMessages;
     end;
     FindClose(SearchRec);
  end;

  { Then walk through all subdirectories. }
  if Subdirs then
  begin
     Error := FindFirst(Directory + '*.*', faAnyFile, SearchRec);
     if (Error = 0) then
     begin
        while (Error = 0) do
        begin
           { Found one! }
           if (SearchRec.Name[1] <> '.') and (SearchRec.Attr and
             faDirectory <> 0) then
              { We do this recursively! }
              FilesFromWildcard(Directory + SearchRec.Name, Mask, Files,
                Subdirs, ShowDirs, Multitasking);
           Error := FindNext(SearchRec);
        end;
     FindClose(SearchRec);
     end;
  end;
end;

procedure TNewProjForm.OkBtnClick(Sender: TObject);
var
  Template: TTemplate;
  Str: TStringList;
  F: String;
begin
  if TListView(PageControl.ActivePage.Controls[0]).Selected = nil then begin
     ModalResult := mrCancel;
     Exit;
  end;

  if PageControl.ActivePage = ProjectSheet then
  begin
     case ProjView.Selected.Index of
     0: begin ProjectType := TOther; WindowsAppText('Windows App'); end;
     1: begin ProjectType := TOther; DosText; Console := True; end;
     2: begin ProjectType := TOther; WinMainText; end;
     3: If ThisCompiler = GPC then {} else ProjectType := TDll;
     4: begin ProjectType := TOther; Console := True; end;
     end;
  end else begin
     ProjectType := TTemplateDoc;
     Template := TListView(PageControl.ActivePage.Controls[0]).Selected.Data;
     Str := TStringList.Create;

     if FileExists(Template.Text) then begin
        F := Template.Text;
        X := Template.CursorX;
        Y := Template.CursorY;
        Str.LoadFromFile(F);
        Text := Str.Text;
     end;
     
     Console := Template.Console;
     Dll := Template.Dll;
     Str.Free;
     TheTemplate := Template;
  end;
  ModalResult := MrOK;
end;

procedure TNewProjForm.WindowsAppText(S: String);
var
  t : String;
  Str: TStringList;
begin
  Str := TStringList.Create;
  t := s;
  while Pos(' ', s) <> 0 do Delete(s, Pos(' ', s), 1);
  with Str do begin
    If ThisCompiler = GPC
    then begin
     Add ('program '+s+';');
     Add ('');
     Add ('Uses Messages, Windows;');
     Add ('{$X+}');
     Add('{$ifndef Stdcall}{$define Stdcall attribute(stdcall)}{$endif}');
     Add ('');
     Add ('VAR OldWnd : HWnd;');
     Add ('');
     Add ('{ menu handles }');
     Add ('CONST');
     Add ('id_Exit  = 105;  { exit }');
     Add ('id_Help  = 300;  { help }');
     Add ('id_About = 301;  { About box }');
     Add ('id_Separator = 0; { separator }');
     Add ('');
     Add ('{ window procedure }');
     Add ('FUNCTION DefaultWindowProc ( Window : HWnd; Message, WParam, LParam : Integer ) : Integer; Stdcall;');
     Add ('FUNCTION DefaultWindowProc ( Window : HWnd; Message, WParam, LParam : Integer ) : Integer; // repeat the declaration');
     Add ('BEGIN');
     Add ('');
     Add ('  Result := 0;');
     Add ('');
     Add ('  CASE Message OF');
     Add ('');
     Add ('    Wm_Close :');
     Add ('    BEGIN');
     Add ('       SetActiveWindow ( OldWnd );');
     Add ('       Halt ( 0 );');
     Add ('    END;');
     Add ('');
     Add ('    wm_Command : { menu choices }');
     Add ('      BEGIN');
     Add ('         CASE WParam  OF  { choice ID is sent in WParam }');
     Add ('');
     Add ('            id_Exit  :');
     Add ('            BEGIN');
     Add ('              SetActiveWindow ( OldWnd );');
     Add ('              Halt ( 0 );');
     Add ('            END;');
     Add ('');
     Add ('            id_About :');
     Add ('                MessageBox ( Window,');
     Add ('                ''This is a sample "about" box. Put your strings here!'',');
     Add ('                ''About Dev+GNU Pascal Sample WinAPI Program'', mb_Ok );');
     Add ('');
     Add ('            id_Help  : WinExec ( ''winhelp'', sw_Normal );');
     Add ('');
     Add ('         END; { Case WParam }');
     Add ('      Result := 1;');
     Add ('      Exit;');
     Add ('    END; { Wm_Command }');
     Add ('');
     Add ('  END; {Case Message}');
     Add ('');
     Add ('  { call the Windows default window procedure }');
     Add ('  Result := DefWindowProc ( Window, Message, WParam, lParam );');
     Add ('END; { DefaultWindowProc }');
     Add ('');
     Add ('{ loop to keep the window alive and allow messages to be processed }');
     Add ('PROCEDURE MessageLoop;');
     Add ('VAR');
     Add ('M : Tmsg;');
     Add ('BEGIN');
     Add ('  WHILE ( 0 = 0 ) DO');
     Add ('  IF PeekMessage ( M, 0, 0, 0, pm_Remove )');
     Add ('  THEN BEGIN');
     Add ('      IF M.Message = wm_Quit THEN Break');
     Add ('      ELSE BEGIN');
     Add ('          TranslateMessage ( M );');
     Add ('          DispatchMessage ( M );');
     Add ('      END;');
     Add ('  END;');
     Add ('END; { MessageLoop }');
     Add ('');
     Add ('{  main function; registers and creates a window and calls the message loop }');
     Add ('FUNCTION  WindowCreate : HWnd;');
     Add ('VAR');
     Add ('wnd : Hwnd;');
     Add ('OldProc : TFarProc;');
     Add ('x, y, w, h : Integer;');
     Add ('xWindClass : TWndClass;');
     Add ('MainMenu,');
     Add ('FileMenu,');
     Add ('EditMenu,');
     Add ('HelpMenu : HMenu;');
     Add ('');
     Add ('BEGIN');
     Add ('   Result := 0;');
     Add ('   WITH xWindClass');
     Add ('   DO BEGIN');
     Add ('      lpfnWndProc   := @DefaultWindowProc;');
     Add ('      style         := CS_HREDRAW OR CS_VREDRAW;');
     Add ('      cbClsExtra    := 0;');
     Add ('      cbWndExtra    := 1;');
     Add ('      lpszClassName := ''GNU_Pascal_Mingw'';');
     Add ('      hIcon         := LoadIcon ( hInstance, ''MainIcon'' );');
     Add ('      hCursor       := LoadCursor ( 0, idc_Arrow );');
     Add ('      hbrBackground := GetStockObject ( white_Brush );');
     Add ('      lpszMenuName  := ''MainMenu'';');
     Add ('   END;');
     Add ('   xWindClass.hInstance :=  hInstance;');
     Add ('');
     Add ('   IF RegisterClass ( xWindClass ) = 0');
     Add ('   THEN BEGIN');
     Add ('      MessageBox ( 0, ''Window Class Registration Error'', ''Error'', Mb_ok );');
     Add ('      PostQuitMessage ( 0 );');
     Add ('      Halt ( 1 );');
     Add ('   END;');
     Add ('');
     Add ('   { window coordinates }');
     Add ('   x := 1;');
     Add ('   y := 1;');
     Add ('   w := 600;');
     Add ('   h := 400;');
     Add ('');
     Add ('   { try to create the window }');
     Add ('   Wnd := CreateWindow ( xWindClass.lpszClassName,');
     Add ('                      ''My Win32 Program'',');
     Add ('                      WS_OVERLAPPEDWINDOW, x, y, w,');
     Add ('                      h, 0 { Parent Window}, 0 { Menu handle},');
     Add ('                      xWindClass.HInstance, nil );');
     Add ('');
     Add ('    Result := Wnd;');
     Add ('');
     Add ('    IF Wnd = 0 THEN BEGIN');
     Add ('      MessageBox ( 0, ''Window Creation Error'', ''Error'', Mb_ok );');
     Add ('      PostQuitMessage ( 0 );');
     Add ('      Halt ( 1 );');
     Add ('    END;');
     Add ('');
     Add ('    { save the old window procedure }');
     Add ('    OldProc := tFarProc ( GetWindowLong ( Wnd, GWL_WndProc ) );');
     Add ('');
     Add ('   { now let us have some menus }');
     Add ('   { main menu }');
     Add ('    MainMenu := GetMenu ( Wnd );');
     Add ('');
     Add ('    IF MainMenu = 0 THEN MainMenu := CreateMenu;');
     Add ('');
     Add ('    SetMenu ( Wnd, MainMenu );');
     Add ('');
     Add ('   { file menu }');
     Add ('    FileMenu := CreateMenu;');
     Add ('        AppendMenu ( MainMenu, mf_PopUp OR mf_Enabled, FileMenu, ''&File'' );');
     Add ('        AppendMenu ( FileMenu, mf_Enabled, 100, ''&New ...'' );');
     Add ('        AppendMenu ( FileMenu, mf_Enabled, 101, ''&Open ...'' );');
     Add ('        AppendMenu ( FileMenu, mf_Enabled, 102, ''&Save'' );');
     Add ('        AppendMenu ( FileMenu, mf_Enabled, 103, ''Save &as ...'' );');
     Add ('        AppendMenu ( FileMenu, mf_Enabled, 104, ''&Close'' );');
     Add ('        AppendMenu ( FileMenu, mf_Separator, id_Separator, '''' ); { separator }');
     Add ('        AppendMenu ( FileMenu, mf_Enabled, id_Exit, ''E&xit'' );');
     Add ('');
     Add ('   { edit menu }');
     Add ('    EditMenu := CreateMenu;');
     Add ('        AppendMenu ( MainMenu, mf_PopUp OR mf_Enabled, EditMenu, ''&Edit'' );');
     Add ('        AppendMenu ( EditMenu, mf_Enabled, 200, ''&Copy'' );');
     Add ('        AppendMenu ( EditMenu, mf_Enabled, 201, ''C&ut'' );');
     Add ('        AppendMenu ( EditMenu, mf_Enabled, 202, ''&Paste'' );');
     Add ('        AppendMenu ( EditMenu, mf_Enabled, 203, ''&Undo'' ); ');
     Add ('');
     Add ('   { help menu }');
     Add ('    HelpMenu := CreateMenu;');
     Add ('        AppendMenu ( MainMenu, mf_PopUp OR mf_Enabled, HelpMenu, ''&Help'' );');
     Add ('        AppendMenu ( HelpMenu, mf_Enabled, id_Help, ''&Contents'' );');
     Add ('        AppendMenu ( HelpMenu, mf_Separator, id_Separator, '''' ); { separator }');
     Add ('        AppendMenu ( HelpMenu, mf_Enabled, id_About, ''&About ...'' );');
     Add ('');
     Add ('    { redraw the menu bar }');
     Add ('    DrawMenuBar ( Wnd );');
     Add ('');
     Add ('    { display the window }');
     Add ('    ShowWindow ( Wnd, sw_Show );');
     Add ('');
     Add ('    { call the message loop }');
     Add ('    MessageLoop;');
     Add ('END; { WindowCreate }');
     Add ('');
     Add ('{ program }');
     Add ('BEGIN');
     Add ('  OldWnd := GetActiveWindow;');
     Add ('  WindowCreate;');
     Add ('END.');
    end else begin
     Add('program '+s+';');
     Add('{$MODE DELPHI}');
     Add('uses Windows;');
     Add('');
     Add('const AppName = '''+s+''';');
     Add('function WindowProc(Window: HWnd; AMessage, WParam,');
     Add('          LParam: Longint): Longint; stdcall; export;');
     Add('');
     Add('begin');
     Add('  WindowProc := 0;');
     Add('');
     Add('  case AMessage of');
     Add('    wm_Destroy : begin');
     Add('                   PostQuitMessage(0);');
     Add('                   Exit;');
     Add('                 end;');
     Add('  end;');
     Add('');
     Add('  WindowProc := DefWindowProc(Window, AMessage, WParam, LParam);');
     Add('end;');
     Add('');
     Add('{ Register the Window Class }');
     Add('function WinRegister: Boolean;');
     Add('var WindowClass: WndClass;');
     Add('begin');
     Add('  WindowClass.Style := cs_hRedraw or cs_vRedraw;');
     Add('  WindowClass.lpfnWndProc := WndProc(@WindowProc);');
     Add('  WindowClass.cbClsExtra := 0;');
     Add('  WindowClass.cbWndExtra := 0;');
     Add('  WindowClass.hInstance := system.MainInstance;');
     Add('  WindowClass.hIcon := LoadIcon(0, idi_Application);');
     Add('  WindowClass.hCursor := LoadCursor(0, idc_Arrow);');
     Add('  WindowClass.hbrBackground := GetStockObject(WHITE_BRUSH);');
     Add('  WindowClass.lpszMenuName := nil;');
     Add('  WindowClass.lpszClassName := AppName;');
     Add('  Result := RegisterClass(WindowClass) <> 0;');
     Add('end;');
     Add('');
     Add('{ Create the Window Class }');
     Add('function WinCreate: HWnd;');
     Add('var hWindow: HWnd;');
     Add('begin');
     Add('  hWindow := CreateWindow(AppName, '''+t+''',');
     Add('         ws_OverlappedWindow, cw_UseDefault, cw_UseDefault,');
     Add('         cw_UseDefault, cw_UseDefault, 0, 0, system.MainInstance, nil);');
     Add('');
     Add('  if hWindow <> 0 then begin');
     Add('     ShowWindow(hWindow, CmdShow);');
     Add('     UpdateWindow(hWindow);');
     Add('  end;');
     Add('');
     Add('  Result := hWindow;');
     Add('end;');
     Add('');
     Add('var AMessage: Msg;');
     Add('    hWindow: HWnd;');
     Add('');
     Add('begin');
     Add('  if not WinRegister then begin');
     Add('     MessageBox(0, ''Register failed'', nil, mb_Ok);');
     Add('     Exit;');
     Add('  end;');
     Add('');
     Add('  hWindow := WinCreate;');
     Add('  if longint(hWindow) = 0 then begin');
     Add('     MessageBox(0, ''WinCreate failed'', nil, mb_Ok);');
     Add('     Exit;');
     Add('  end;');
     Add('');
     Add('  while GetMessage(@AMessage, 0, 0, 0) do begin');
     Add('    TranslateMessage(AMessage);');
     Add('    DispatchMessage(AMessage);');
     Add('  end;');
     Add('  Halt(AMessage.wParam);');
     Add('end.');
   end;
     Self.Text := Text;
  end;
  Str.Free;
end;

procedure TNewProjForm.DosText;
var
  Str: TStringList;
begin
  Str := TStringList.Create;
  with Str do
  begin
     Add('program Untitled;');
     Add('begin');
     Add('');
     Add('end.');

     Self.Text := Text;
  end;
  Str.Free;
  Y := 5;
  X := 3;
end;

procedure TNewProjForm.WinMainText;
var
  Str: TStringList;
begin
  Str := TStringList.Create;
  with Str do
  begin
     Add('program Untitled;');
     If ThisCompiler = GPC
     then begin
        Add('{$ifndef Stdcall}{$define Stdcall attribute(stdcall)}{$endif}');
        Add('{$X+}');
        Add('uses Messages, Windows;');
     end
     else begin
         Add('{$MODE DELPHI}');
         Add('uses Windows;');
     end;
     Add('');
     Add('begin');
     Add('');             
     Add('end.');
     Add('');             

     Self.Text := Text;
  end;
  Str.Free;
  X := 3;
  Y := 6;
end;

procedure TNewProjForm.ProjViewDblClick(Sender: TObject);
begin
  if ProjView.Selected <> nil then
  begin
     ModalResult := mrOk;
     OkBtnClick(Sender);
  end;
end;

procedure TNewProjForm.FormActivate(Sender: TObject);
begin
  ProjView.Selected := ProjView.Items[0];
end;

procedure TNewProjForm.FormCreate(Sender: TObject);
begin
  X := 1;
  Y := 1;
  Text := '';
  Console := False;
  Dll := False;
  ReadTemplateIndex;
end;

procedure TNewProjForm.ReadTemplateIndex;
var
  CurDir: String;
  Templates: TList;
  TemplateFiles: TStringList;
{$I TemplateFuncs.inc}
var
  i: Integer;
begin

  CurDir := ExtractFilePath(ParamStr(0));
  TemplateFiles := TStringList.Create;

  FilesFromWildcard(CurDir + 'Templates', '*.template', TemplateFiles, False,
    False, True);

  if TemplateFiles.Count > 0
  then begin
     Templates := TList.Create;
     for i := 0 to TemplateFiles.Count - 1 do AddTemplate(TemplateFiles.Strings[i]);
     SortCatagories;
     SortTemplates;
     Templates.Free;
  end;

  TemplateFiles.Free;
end;

procedure TNewProjForm.PageControlChange(Sender: TObject);
var
  Template: TTemplate;
begin
  if PageControl.ActivePage = ProjectSheet then
     ProjViewChange(nil, TListView(PageControl.ActivePage.Controls[0]).Selected,
       ctState)
  else begin
     if TListView(PageControl.ActivePage.Controls[0]).Selected = nil then Exit;
     Template := TTemplate(TListView(PageControl.ActivePage.Controls[0]).Selected.Data);
     TemplateLabel.Caption := Template.Description;
  end;
end;

procedure TNewProjForm.CustomTKeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
var
  Template: TTemplate;
begin
  if Key = VK_DELETE then
     if Application.MessageBox('Do you really want to remove this template from disk?',
       'Confirm', MB_YESNO + MB_ICONQUESTION) = 6 then
     begin
        Template := TTemplate(TListView(PageControl.ActivePage.Controls[0]).Selected.Data);
        SysUtils.DeleteFile(Template.FileName);
        if FileExists(Template.Text) then
           SysUtils.DeleteFile(Template.Text);
        Template.Free;
        TListView(PageControl.ActivePage.Controls[0]).Selected.Free;
     end;
end;

procedure TNewProjForm.ListViewChange(Sender: TObject; Item: TListItem;
  Change: TItemChange);
var
  Template: TTemplate;
begin
  if (sender as TListView).Selected = nil then Exit;
  Template := TTemplate(Item.Data);
  TemplateLabel.Caption := Template.Description;
end;

procedure TNewProjForm.ListViewDblClick(Sender: TObject);
begin
  if TListView(Sender).Selected <> nil then
  begin
     ModalResult := mrOk;
     OkBtnClick(Sender);
  end;
end;

procedure TNewProjForm.ProjViewChange(Sender: TObject; Item: TListItem;
  Change: TItemChange);
begin
  if ProjView.Selected = nil then Exit;
  case ProjView.Selected.Index of
  0: TemplateLabel.Caption := 'A standard Windows (GUI) application.';
  1: TemplateLabel.Caption := 'A standard console-based (MS-DOS) application.';
  2: TemplateLabel.Caption := 'A Windows skeleton application (no window)';
  3: TemplateLabel.Caption := 'Dynamic Link Library (DLL) - Freepascal only';
  4: TemplateLabel.Caption := 'Empty project.';
  end;
end;

end.
