Subversion Repositories autosfx

Rev

Blame | Last modification | View Log | RSS feed

  1. unit demo2_1;
  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.  
  27. interface
  28.  
  29. {$I DELVER.INC}
  30.  
  31. uses
  32.   Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms,
  33.   Dialogs, Buttons, ExtCtrls, StdCtrls, ZipSFXPlus, ZipSFXBase;//, DZUtils;
  34.  
  35. type
  36.   TForm1 = class(TForm)
  37.     Panel3: TPanel;
  38.     Image1: TImage;
  39.     Panel1: TPanel;
  40.     Button1: TButton;
  41.     btnToSFX: TButton;
  42.     btnToEXE: TButton;
  43.     btnNewSFX: TButton;
  44.     Bevel1: TBevel;
  45.     dlgOpenSFX: TOpenDialog;
  46.     dlgSaveZIP: TSaveDialog;
  47.     ZipSFX1: TZipSFXPlus;
  48.     procedure Button1Click(Sender: TObject);
  49.     procedure btnToSFXClick(Sender: TObject);
  50.     procedure btnNewSFXClick(Sender: TObject);
  51.     procedure btnToEXEClick(Sender: TObject);
  52.   private
  53.     { Private-Deklarationen }
  54.   public
  55.     { Public-Deklarationen }
  56.   end;
  57.  
  58. var
  59.   Form1: TForm1;
  60.  
  61. // pick an icon via shell's PickIconDlg
  62. function PickIcon(const hwndOwner: HWND; var sIconFile: string; var iIconNum: Integer): Boolean;
  63.  
  64. implementation
  65.  
  66. uses demo2_2;
  67.  
  68. {$R *.dfm}
  69.  
  70. // include all available sfx.bin modules
  71. {$R dzsfx_all.res}
  72. //{$R zipmsgus.res}
  73. {$R '..\res\delzip.res'}
  74.  
  75. procedure TForm1.Button1Click(Sender: TObject);
  76. begin
  77.   Close;
  78. end;
  79.  
  80.  
  81. procedure TForm1.btnToSFXClick(Sender: TObject);
  82. begin
  83.   with TdlgConvertToSFX.Create(self) do
  84.   try
  85.     ShowModal;
  86.   finally
  87.     Free;
  88.   end;
  89. end;
  90.  
  91. function PickIconDlgA(hwndOwner: HWND; lpstrFile: PChar; nMaxFile: Word; var lpdwIconIndex: DWORD): Bool;
  92.   stdcall external 'shell32.dll' index 62;
  93.  
  94. function PickIconDlgW(hwndOwner: HWND; lpstrFile: PWideChar; nMaxFile: Word; var lpdwIconIndex: DWORD): Bool;
  95.   stdcall external 'shell32.dll' index 62;
  96.  
  97. // pick an icon via shell's PickIconDlg
  98. function PickIcon(const hwndOwner: HWND; var sIconFile: string; var iIconNum: Integer): Boolean;
  99. var
  100.   pch: PChar;
  101.   pwch: PWideChar;
  102.   {$IFDEF DELPHI3UP}
  103.   c: Cardinal;
  104.   {$ELSE}
  105.   c: Integer;
  106.   {$ENDIF}
  107. begin
  108.   c := iIconNum;
  109.   if Win32Platform = VER_PLATFORM_WIN32_NT then
  110.   begin
  111.     GetMem(pwch, MAX_PATH * sizeof(WideChar));
  112.     try
  113.       StringToWideChar(sIconFile, pwch, MAX_PATH);
  114.       Result := PickIconDlgW(hwndOwner, pwch, MAX_PATH, DWORD(c));
  115.       if Result then
  116.       begin
  117.         iIconNum := c;
  118.         sIconFile := WideCharToString(pwch);
  119.       end;
  120.     finally
  121.       FreeMem(pwch);
  122.     end;
  123.   end
  124.   else
  125.   begin
  126.     GetMem(pch, MAX_PATH);
  127.     try
  128.       StrPCopy(pch, sIconFile);
  129.       Result := PickIconDlgA(hwndOwner, pch, MAX_PATH , DWORD(c));
  130.       if Result then
  131.       begin
  132.         iIconNum := c;
  133.         sIconFile := pch;
  134.       end;
  135.     finally
  136.       FreeMem(pch);
  137.     end;
  138.   end;
  139. end;
  140.  
  141. procedure TForm1.btnNewSFXClick(Sender: TObject);
  142. begin
  143.   with TdlgConvertToSFX.Create(self) do
  144.   try
  145.     PrepareMakeNew;
  146.     ShowModal;
  147.   finally
  148.     Free;
  149.   end;
  150. end;
  151.  
  152. procedure TForm1.btnToEXEClick(Sender: TObject);
  153. begin
  154.   with dlgOpenSFX
  155.   do
  156.     if Execute then
  157.     begin
  158.       ZipSFX1.SourceFile := FileName;
  159.       with dlgSaveZip do
  160.       begin
  161.         FileName := ChangeFileExt(ZipSFX1.SourceFile,'.zip');
  162.         if Execute then
  163.         begin
  164.           ZipSFX1.TargetFile := FileName;
  165.           ZipSFX1.StartWaitCursor;
  166.           try
  167.             ZipSFX1.ConvertToZip;
  168.             MessageDlg('ZIP archive '+ZipSFX1.TargetFile+#13#10+
  169.               'has been created.', mtInformation, [mbOK], 0);
  170.           finally
  171.             ZipSFX1.StopWaitCursor;
  172.           end;
  173.         end;
  174.       end;
  175.     end;
  176.  
  177. end;
  178.  
  179. end.
  180.