Subversion Repositories autosfx

Rev

Details | Last modification | View Log | RSS feed

Rev Author Line No. Line
1 daniel-mar 1
Unit sfxunit;
2
(************************************************************************
3
 Copyright (C) 2009, 2010  by Russell J. Peters, Roger Aelbrecht,
4
      Eric W. Engler and Chris Vleghert.
5
 
6
   This file is part of TZipMaster Version 1.9.
7
 
8
    TZipMaster is free software: you can redistribute it and/or modify
9
    it under the terms of the GNU Lesser General Public License as published by
10
    the Free Software Foundation, either version 3 of the License, or
11
    (at your option) any later version.
12
 
13
    TZipMaster is distributed in the hope that it will be useful,
14
    but WITHOUT ANY WARRANTY; without even the implied warranty of
15
    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
16
    GNU Lesser General Public License for more details.
17
 
18
    You should have received a copy of the GNU Lesser General Public License
19
    along with TZipMaster.  If not, see <http://www.gnu.org/licenses/>.
20
 
21
    contact: problems@delphizip.org (include ZipMaster in the subject).
22
    updates: http://www.delphizip.org
23
    DelphiZip maillist subscribe at http://www.freelists.org/list/delphizip
24
************************************************************************)
25
 
26
{$INCLUDE '..\..\ZipVers19.inc'}
27
 
28
Interface
29
 
30
Uses
31
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
32
  StdCtrls, ExtCtrls, ZipMstr19, Buttons, ComCtrls, ShlObj, ShellAPI, ImgList;
33
 
34
Type
35
  TMakeSFX = Class(TForm)
36
    Panel1: TPanel;
37
    Panel2: TPanel;
38
    CmdLineCB: TCheckBox;
39
    FileListCB: TCheckBox;
40
    HideOverWriteCB: TCheckBox;
41
    AutoRunCB: TCheckBox;
42
    NoMsgShowCB: TCheckBox;
43
    DfltOverWriteGrp: TRadioGroup;
44
    OkCancelRB: TRadioButton;
45
    YesNoRB: TRadioButton;
46
    OkBttnRB: TRadioButton;
47
    DefIconRB: TRadioButton;
48
    AutoIconRB: TRadioButton;
49
    OrigIconRB: TRadioButton;
50
    ExecBut: TButton;
51
    CancelBut: TButton;
52
    BitBtn1: TBitBtn;
53
    BitBtn2: TBitBtn;
54
    SFXPage: TPageControl;
55
    TabSheet1: TTabSheet;
56
    TabSheet2: TTabSheet;
57
    TabSheet3: TTabSheet;
58
    TabSheet4: TTabSheet;
59
    TabSheet5: TTabSheet;
60
    Label9: TLabel;
61
    Label12: TLabel;
62
    Label2: TLabel;
63
    Label1: TLabel;
64
    IconIndexLabel: TLabel;
65
    MsgEdit: TEdit;
66
    CaptionEdit: TEdit;
67
    CommandEdit: TEdit;
68
    IconEdit: TEdit;
69
    IconIndexEdit: TEdit;
70
    Memo2: TMemo;
71
    Memo3: TMemo;
72
    Memo4: TMemo;
73
    Memo1: TMemo;
74
    GroupBox1: TGroupBox;
75
    GroupBox2: TGroupBox;
76
    Image1: TImage;
77
    OpenDialog1: TOpenDialog;
78
    ImageList1: TImageList;
79
    IconIndexUD: TUpDown;
80
    DirectoryEdit: TComboBox;
81
 
82
    Procedure FormShow(Sender: TObject);
83
    Procedure ExecButClick(Sender: TObject);
84
    Procedure BitBtn1Click(Sender: TObject);
85
    Procedure BitBtn2Click(Sender: TObject);
86
    Procedure CancelButClick(Sender: TObject);
87
    Procedure AutoRunCBClick(Sender: TObject);
88
    Procedure DefIconRBClick(Sender: TObject);
89
    Procedure IconEditKeyPress(Sender: TObject; Var Key: Char);
90
    Procedure IconIndexUDClick(Sender: TObject; Button: TUDBtnType);
91
 
92
  PUBLIC
93
    Procedure LoadCustomIcon(IconPath: String; IconIndex: Integer);
94
  End;
95
 
96
Var
97
  MakeSFX: TMakeSFX;
98
  IconDir: String;
99
 
100
Implementation
101
 
102
Uses mainunit;
103
{$R *.DFM}
104
 
105
Procedure TMakeSFX.ExecButClick(Sender: TObject);
106
Begin
107
  With Mainform.ZipMaster1 Do
108
  Begin
109
    If CmdLineCB.Checked Then
110
      SFXOptions := SFXOptions + [soAskCmdLine]
111
    Else
112
      SFXOptions := SFXOptions - [soAskCmdLine];
113
    If FileListCB.Checked Then
114
      SFXOptions := SFXOptions + [soAskFiles]
115
    Else
116
      SFXOptions := SFXOptions - [soAskFiles];
117
    If HideOverWriteCB.Checked Then
118
      SFXOptions := SFXOptions + [soHideOverWriteBox]
119
    Else
120
      SFXOptions := SFXOptions - [soHideOverWriteBox];
121
    If AutoRunCB.Checked Then
122
      SFXOptions := SFXOptions + [soAutoRun]
123
    Else
124
      SFXOptions := SFXOptions - [soAutoRun];
125
    If NoMsgShowCB.Checked Then
126
      SFXOptions := SFXOptions + [soNoSuccessMsg]
127
    Else
128
      SFXOptions := SFXOptions - [soNoSuccessMsg];
129
 
130
    If DfltOverWriteGrp.ItemIndex = 0 Then
131
      SFXOverWriteMode := ovrConfirm;
132
    If DfltOverWriteGrp.ItemIndex = 1 Then
133
      SFXOverWriteMode := ovrAlways;
134
    If DfltOverWriteGrp.ItemIndex = 2 Then
135
      SFXOverWriteMode := ovrNever;
136
 
137
    SFXCaption := CaptionEdit.Text;
138
    SFXDefaultDir := DirectoryEdit.Text;
139
    SFXCommandLine := CommandEdit.Text;
140
    SFXMessage := '';
141
    If OkCancelRB.Checked Then
142
      SFXMessage := #1;
143
    If YesNoRB.Checked Then
144
      SFXMessage := #2;
145
    SFXMessage := SFXMessage + MsgEdit.Text;
146
  End;
147
  Mainform.DoIt := True;
148
  Close;
149
End;
150
 
151
Procedure TMakeSFX.CancelButClick(Sender: TObject);
152
Begin
153
  Mainform.DoIt := False;
154
  Close;
155
End;
156
 
157
Procedure TMakeSFX.BitBtn1Click(Sender: TObject);
158
Var
159
  TempStr: String;
160
Begin
161
  TempStr := DirectoryEdit.Text;
162
  Mainform.AskDirDialog(MakeSFX.Handle, TempStr);
163
  DirectoryEdit.Text := TempStr;
164
End;
165
 
166
Procedure TMakeSFX.FormShow(Sender: TObject);
167
Begin
168
  With Mainform.ZipMaster1 Do
169
  Begin
170
    If soAskCmdLine In SFXOptions Then
171
      CmdLineCB.Checked := True
172
    Else
173
      CmdLineCB.Checked := False;
174
    If soAskFiles In SFXOptions Then
175
      FileListCB.Checked := True
176
    Else
177
      FileListCB.Checked := False;
178
    If soHideOverWriteBox In SFXOptions Then
179
      HideOverWriteCB.Checked := True
180
    Else
181
      HideOverWriteCB.Checked := False;
182
    If soAutoRun In SFXOptions Then
183
      AutoRunCB.Checked := True
184
    Else
185
      AutoRunCB.Checked := False;
186
    If soNoSuccessMsg In SFXOptions Then
187
      NoMsgShowCB.Checked := True
188
    Else
189
      NoMsgShowCB.Checked := False;
190
 
191
    Case SFXOverWriteMode Of
192
      ovrConfirm:
193
        DfltOverWriteGrp.ItemIndex := 0;
194
      ovrAlways:
195
        DfltOverWriteGrp.ItemIndex := 1;
196
      ovrNever:
197
        DfltOverWriteGrp.ItemIndex := 2;
198
    End;
199
 
200
    CaptionEdit.Text := SFXCaption;
201
    DirectoryEdit.Text := SFXDefaultDir;
202
    CommandEdit.Text := SFXCommandLine;
203
    If (Length(SFXMessage) > 0) And (SFXMessage[2] = '|') Then
204
//      ((SFXMessage[1] = #1) Or (SFXMessage[1] = #2)) Then
205
    Begin
206
      If SFXMessage[1] = '1'{#1} Then
207
        OkCancelRB.Checked := True
208
      Else
209
        YesNoRB.Checked := True;
210
      MsgEdit.Text := Copy(SFXMessage, 3{2}, Length(SFXMessage) - 2{1});
211
    End
212
    Else
213
    Begin
214
      MsgEdit.Text := SFXMessage;
215
      OkBttnRB.Checked := True;
216
    End;
217
  End;
218
 
219
  If ImageList1.Count = 3 Then
220
    ImageList1.Delete(2);
221
  If IconEdit.Text = '' Then
222
  Begin
223
    If (Mainform.ZipMaster1.SFXIcon = nil) or Mainform.ZipMaster1.SFXIcon.Empty Then
224
    Begin
225
      ImageList1.GetIcon(Integer(AutoRunCB.Checked), Image1.Picture.Icon);
226
      Mainform.ZipMaster1.SFXIcon := Image1.Picture.Icon;
227
    End
228
    Else
229
    Begin
230
      ImageList1.AddIcon(Mainform.ZipMaster1.SFXIcon);
231
      OrigIconRB.Checked := True;
232
    End;
233
  End;
234
  If ImageList1.Count = 3 Then
235
    OrigIconRB.Enabled := True
236
  Else
237
    OrigIconRB.Enabled := False
238
End;
239
 
240
Procedure TMakeSFX.BitBtn2Click(Sender: TObject);
241
Begin
242
  If IconDir = '' Then
243
    Mainform.GetSpecialFolder(CSIDL_DESKTOPDIRECTORY, IconDir);
244
  With OpenDialog1 Do
245
  Begin
246
    InitialDir := IconDir;
247
    If Execute Then
248
    Begin
249
      IconDir := ExtractFilePath(FileName);
250
      IconEdit.Text := FileName;
251
      DefIconRB.Checked := False;
252
      AutoIconRB.Checked := False;
253
      If UpperCase(ExtractFileExt(FileName)) <> '.ICO' Then
254
      Begin
255
        LoadCustomIcon(FileName, StrToIntDef(IconIndexEdit.Text, 0));
256
        IconIndexLabel.Enabled := True;
257
        IconIndexEdit.Enabled := True;
258
        IconIndexUD.Enabled := True;
259
        IconIndexEdit.Color := clWindow;
260
      End
261
      Else
262
      Begin
263
        Image1.Picture.Icon.LoadFromFile(FileName);
264
        IconIndexEdit.Text := '0';
265
        IconIndexLabel.Enabled := False;
266
        IconIndexEdit.Enabled := False;
267
        IconIndexUD.Enabled := False;
268
        IconIndexEdit.Color := clBtnFace;
269
        Mainform.ZipMaster1.SFXIcon := Image1.Picture.Icon;
270
      End;
271
    End;
272
  End;
273
End;
274
 
275
Procedure TMakeSFX.AutoRunCBClick(Sender: TObject);
276
Begin
277
  If IconEdit.Text = '' Then
278
  Begin
279
    ImageList1.GetIcon(Integer(AutoRunCB.Checked), Image1.Picture.Icon);
280
    Mainform.ZipMaster1.SFXIcon := Image1.Picture.Icon;
281
  End;
282
End;
283
 
284
Procedure TMakeSFX.DefIconRBClick(Sender: TObject);
285
Begin
286
  ImageList1.GetIcon(TRadioButton(Sender).Tag, Image1.Picture.Icon);
287
  Mainform.ZipMaster1.SFXIcon := Image1.Picture.Icon;
288
  IconEdit.Text := '';
289
  IconIndexEdit.Text := '0';
290
  IconIndexLabel.Enabled := False;
291
  IconIndexEdit.Enabled := False;
292
  IconIndexUD.Enabled := False;
293
  IconIndexEdit.Color := clBtnFace;
294
End;
295
 
296
Procedure TMakeSFX.LoadCustomIcon(IconPath: String; IconIndex: Integer);
297
Var
298
  IconHandle: THandle;
299
Begin
300
  Image1.Picture.Icon.ReleaseHandle();
301
  Mainform.ZipMaster1.SFXIcon.ReleaseHandle();
302
  IconHandle := ExtractIcon(hInstance, PChar(IconPath), IconIndex);
303
  If (IconHandle <> 0) And (IconHandle <> 1) Then
304
  Begin
305
    Image1.Picture.Icon.Handle := IconHandle;
306
    Mainform.ZipMaster1.SFXIcon.Handle := IconHandle;
307
  End;
308
End;
309
 
310
Procedure TMakeSFX.IconIndexUDClick(Sender: TObject; Button: TUDBtnType);
311
Begin
312
  LoadCustomIcon(IconEdit.Text, StrToIntDef(IconIndexEdit.Text, 0));
313
End;
314
 
315
Procedure TMakeSFX.IconEditKeyPress(Sender: TObject; Var Key: Char);
316
Begin
317
  If FileExists(IconEdit.Text) Then
318
    LoadCustomIcon(IconEdit.Text, StrToIntDef(IconIndexEdit.Text, 0));
319
End;
320
 
321
End.