cantools/CtwRebWForm.pas at main · nFeno/cantools · GitHub

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
unit CtwRebWForm;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, ExtCtrls, DockForm;

type
  TRebWizForm = class(TDockableForm)
    ListBoxFiles: TListBox;
    Panel1: TPanel;
    Label1: TLabel;
    EditDir: TEdit;
    BtnGetFiles: TButton;
    BtnCompileAll: TButton;
    BtnOpen: TButton;
    BtnCompOne: TButton;
    procedure BtnGetFilesClick(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure BtnOpenClick(Sender: TObject);
    procedure BtnCompOneClick(Sender: TObject);
    procedure BtnCompileAllClick(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure EditDirDblClick(Sender: TObject);
  private
    { Private declarations }
  public
    procedure ExamineDir (CurrDir: string);
    procedure DoCompile;
  end;

var
  RebWizForm: TRebWizForm;

implementation

{$R *.DFM}

uses
  ToolsAPI, CtwManager, FileCtrl;

procedure TRebWizForm.BtnGetFilesClick(Sender: TObject);
begin
  ListBoxFiles.Items.Clear;
  ExamineDir (EditDir.Text);
  // enable all buttons
  BtnOpen.Enabled := True;
  BtnCompOne.Enabled := True;
  BtnCompileAll.Enabled := True;
  // save last folder to registry
  CantoolsManager.WriteSetting('rebuildwizardfolder', EditDir.Text);
end;

procedure TRebWizForm.EditDirDblClick(Sender: TObject);
var
  sDir: string;
begin
  sDir := EditDir.Text;
  SelectDirectory (sDir, []);
  EditDir.Text := sDir;
end;

procedure TRebWizForm.ExamineDir (CurrDir: string);
var
  sr: TSearchRec;
begin
  if FindFirst (CurrDir + pathDelim + '*.*',
    faAnyFile, sr) = 0 then
  repeat
    // look for Delphi project files
    if SameText (ExtractFileExt (sr.Name), '.dproj') then
//    if SameText (ExtractFileExt (sr.Name), '.dpr') or
//      SameText (ExtractFileExt (sr.Name), '.dpk') then
    begin
      ListBoxFiles.Items.Add (CurrDir + pathDelim + sr.Name);
    end;
    // look for subfolders and recurse
    if ((sr.Attr and faDirectory) <> 0) and
      (sr.Name <> '.') and (sr.Name <> '..') then
    begin
      // should rather use a thread...
      Application.ProcessMessages;
      ExamineDir (CurrDir + pathDelim + sr.Name);
    end;
  until FindNext (sr) <> 0;
  FindClose (sr);
end;

procedure TRebWizForm.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  Action := caFree;
  RebWizForm := nil;
end;

procedure TRebWizForm.BtnOpenClick(Sender: TObject);
var
  CurrPrj: string;
begin
  with ListBoxFiles do
    CurrPrj := Items [ItemIndex];
  (BorlandIDEServices as IOTAActionServices).
    OpenFile (CurrPrj);
end;

procedure TRebWizForm.BtnCompOneClick(Sender: TObject);
var
  CurrPrj: string;
begin
  with ListBoxFiles do
    CurrPrj := Items [ItemIndex];
  (BorlandIDEServices as IOTAActionServices).OpenFile (CurrPrj);
  DoCompile;
end;

procedure TRebWizForm.DoCompile;
var
  HDelphi: THandle;
  ObjDelphi: TWinControl;
  Meth1: TMethod;
  Evt: TNotifyEvent;
  P: Pointer;
begin
  HDelphi := FindWindow ('TAppBuilder', nil);
  if HDelphi = 0 then
    raise Exception.Create ('Delphi not found');
  ObjDelphi := FindControl (hDelphi);
  if ObjDelphi <> nil then
  begin
    P := ObjDelphi.MethodAddress ('ProjectBuild');
    Meth1.Code := P;
    Meth1.Data := ObjDelphi;
    Evt := TNotifyEvent (Meth1);
    Evt (ObjDelphi);
  end
  else
    ShowMessage ('AppBuilder object not accessible');
end;

procedure TRebWizForm.BtnCompileAllClick(Sender: TObject);
var
  CurrPrj: string;
  I: Integer;
begin
  with ListBoxFiles do
    for I := 0 to Items.Count - 1 do
    begin
      CurrPrj := Items [I];
      (BorlandIDEServices as IOTAActionServices).OpenFile (CurrPrj);
      DoCompile;
    end;
end;

procedure TRebWizForm.FormCreate(Sender: TObject);
begin
  EditDir.Text := CantoolsManager.ReadSetting('rebuildwizardfolder');
end;

initialization

finalization
  if Assigned (RebWizForm) then
    FreeAndNil (RebWizForm);

end.