home *** CD-ROM | disk | FTP | other *** search
/ Chip 2004 March / CMCD0304.ISO / Software / Freeware / Programare / nullsoft / nsis20.exe / Contrib / VPatch / Source / GUI / MainForm.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  2003-08-11  |  14.1 KB  |  540 lines
  1. unit MainForm;
  2.  
  3. interface
  4.  
  5. uses
  6.   Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  7.   Dialogs, Buttons, StdCtrls, Menus, PatchClasses, VirtualTrees, VDSP_CRC,
  8.   ToolWin, ComCtrls, ImgList, ExtCtrls, PatchGenerator, Math;
  9.  
  10. const
  11.   UntitledFile='Untitled.vpj';
  12.  
  13. type
  14.   TfrmMain = class(TForm)
  15.     MainMenu: TMainMenu;
  16.     mnuFile: TMenuItem;
  17.     mnuNew: TMenuItem;
  18.     mnuOpen: TMenuItem;
  19.     mnuSave: TMenuItem;
  20.     mnuSaveas: TMenuItem;
  21.     N1: TMenuItem;
  22.     mnuExit: TMenuItem;
  23.     Label1: TLabel;
  24.     grpConfig: TGroupBox;
  25.     butAdd: TSpeedButton;
  26.     OD: TOpenDialog;
  27.     Label2: TLabel;
  28.     txtNew: TEdit;
  29.     Label3: TLabel;
  30.     mnuHelp: TMenuItem;
  31.     mnuAbout: TMenuItem;
  32.     lstOld: TListBox;
  33.     butOldAdd: TSpeedButton;
  34.     butOldRemove: TSpeedButton;
  35.     butNewEdit: TSpeedButton;
  36.     Label4: TLabel;
  37.     lstNew: TVirtualStringTree;
  38.     dlgOpen: TOpenDialog;
  39.     dlgSave: TSaveDialog;
  40.     IL: TImageList;
  41.     mnuAction: TMenuItem;
  42.     mnuGenGo: TMenuItem;
  43.     barTool: TToolBar;
  44.     toolNew: TToolButton;
  45.     toolOpen: TToolButton;
  46.     toolSave: TToolButton;
  47.     toolGenGo: TToolButton;
  48.     mnuCreateEXE: TMenuItem;
  49.     dlgSaveExe: TSaveDialog;
  50.     toolCreateEXE: TToolButton;
  51.     barCool: TCoolBar;
  52.     Label5: TLabel;
  53.     Label6: TLabel;
  54.     txtMinimumBlockSize: TEdit;
  55.     UDMinimumBlockSize: TUpDown;
  56.     UDBlockDivider: TUpDown;
  57.     txtBlockDivider: TEdit;
  58.     Label7: TLabel;
  59.     UDStepSize: TUpDown;
  60.     txtStepSize: TEdit;
  61.     Label8: TLabel;
  62.     chkDebug: TCheckBox;
  63.     tbBlockSize: TTrackBar;
  64.     txtStartBlockSize: TLabel;
  65.     mnuClearcachedpatches: TMenuItem;
  66.     mnuCreateDLL: TMenuItem;
  67.     mnuCreatePAT: TMenuItem;
  68.     toolCreateDLL: TToolButton;
  69.     ToolButton1: TToolButton;
  70.     toolCreatePAT: TToolButton;
  71.     dlgSaveDLL: TSaveDialog;
  72.     dlgSavePAT: TSaveDialog;
  73.     procedure butAddClick(Sender: TObject);
  74.     procedure FormCreate(Sender: TObject);
  75.     procedure FormDestroy(Sender: TObject);
  76.     procedure mnuExitClick(Sender: TObject);
  77.     procedure UpdateStates;
  78.     procedure ReloadNewTree;
  79.     procedure SelectInNewTree(PatchIndex: Integer);
  80.     procedure butNewEditClick(Sender: TObject);
  81.     procedure lstNewChange(Sender: TBaseVirtualTree; Node: PVirtualNode);
  82.     procedure butOldAddClick(Sender: TObject);
  83.     procedure butOldRemoveClick(Sender: TObject);
  84.     procedure mnuNewClick(Sender: TObject);
  85.     procedure mnuOpenClick(Sender: TObject);
  86.     procedure mnuSaveClick(Sender: TObject);
  87.     procedure mnuSaveasClick(Sender: TObject);
  88.     procedure mnuGenGoClick(Sender: TObject);
  89.     procedure mnuAboutClick(Sender: TObject);
  90.     procedure mnuCreateEXEClick(Sender: TObject);
  91.     procedure lstNewGetText(Sender: TBaseVirtualTree; Node: PVirtualNode;
  92.       Column: TColumnIndex; TextType: TVSTTextType;
  93.       var CellText: WideString);
  94.     procedure txtStartBlockSizeChange(Sender: TObject);
  95.     procedure txtMinimumBlockSizeChange(Sender: TObject);
  96.     procedure txtBlockDividerChange(Sender: TObject);
  97.     procedure txtStepSizeChange(Sender: TObject);
  98.     procedure chkDebugClick(Sender: TObject);
  99.     procedure tbBlockSizeChange(Sender: TObject);
  100.     procedure mnuClearcachedpatchesClick(Sender: TObject);
  101.     procedure mnuCreateDLLClick(Sender: TObject);
  102.     procedure mnuCreatePATClick(Sender: TObject);
  103.   private
  104.     { Private declarations }
  105. //    MS: TModeSelector;
  106.     dskName: String;
  107.     function DoSave(const FileName: String; const Prompt: Boolean): String;
  108.     procedure OpenAFile(FileName: String; AskSave: Boolean=True; PromptNew: Boolean=False);
  109.     function CollectConfig: String;
  110.     procedure SetConfigTextBoxes(Config: String);
  111.     procedure PrintDebug(S: String);
  112.   public
  113.     { Public declarations }
  114.   end;
  115.  
  116. var
  117.   frmMain: TfrmMain;
  118.   PP: TPatchProject = nil;
  119.  
  120. implementation
  121.  
  122. uses AboutForm;
  123.  
  124. {$R *.dfm}
  125.  
  126. procedure TfrmMain.butAddClick(Sender: TObject);
  127. begin
  128.   OD.Options:=OD.Options-[ofAllowMultiSelect];
  129.   OD.Title:='Open the latest (new) version of a file...';
  130.   OD.FileName:='';
  131.   if OD.Execute then begin
  132.     PP.AddNewVersion(OD.FileName);
  133.     ReloadNewTree;
  134.     SelectInNewTree(PP.PatchFile(OD.FileName).Index);
  135.     butOldAdd.Click;
  136.   end;
  137. end;
  138.  
  139. procedure TfrmMain.FormCreate(Sender: TObject);
  140. begin
  141.   grpConfig.Tag:=-1;
  142.   dskName:=UntitledFile;
  143.   lstNew.NodeDataSize:=SizeOf(Integer);
  144.   OpenAFile('',False,False);  //don't prompt for New! that'll bug things
  145.   ReloadNewTree;
  146.   UpdateStates;
  147. end;
  148.  
  149. procedure TfrmMain.FormDestroy(Sender: TObject);
  150. begin
  151.   PP.Free;
  152. end;
  153.  
  154. procedure TfrmMain.mnuExitClick(Sender: TObject);
  155. begin
  156.   Close;
  157. end;
  158.  
  159. procedure TfrmMain.UpdateStates;
  160. begin
  161.   Self.Caption:='VG - VPatch GUI - '+dskName;
  162. //  grpConfig.Enabled:=not (lstNew.Tag=-1);
  163. //  if not grpConfig.Enabled then grpConfig.Caption:='Select a file first';
  164.   grpConfig.Enabled:=(lstNew.SelectedCount>0);
  165.   if grpConfig.Tag=-1 then begin
  166.     txtNew.Enabled:=False;
  167.     butNewEdit.Enabled:=False;
  168.     butNewEdit.Font.Color:=clInactiveCaption;
  169.     butOldAdd.Enabled:=False;
  170.     butOldAdd.Font.Color:=clInactiveCaption;
  171.     butOldRemove.Enabled:=False;
  172.     butOldRemove.Font.Color:=clInactiveCaption;
  173.   end else begin
  174.     txtNew.Enabled:=True;
  175.     butNewEdit.Enabled:=True;
  176.     butNewEdit.Font.Color:=clWindowText;
  177.     butOldAdd.Enabled:=True;
  178.     butOldAdd.Font.Color:=clWindowText;
  179. //    butOldEdit.Enabled:=True;
  180.     butOldRemove.Enabled:=True;
  181.     butOldRemove.Font.Color:=clWindowText;
  182.   end;
  183. end;
  184.  
  185. procedure TfrmMain.ReloadNewTree;
  186. var
  187.   i: Integer;
  188.   Node: PVirtualNode;
  189. begin
  190.   lstNew.BeginUpdate;
  191.   lstNew.Clear;
  192.   for i:=0 to PP.GetPatchCount - 1 do begin
  193.     Node:=lstNew.AddChild(nil);
  194.     PInteger(lstNew.GetNodeData(Node))^:=i;
  195.   end;
  196.   lstNew.EndUpdate;
  197. end;
  198.  
  199. procedure TfrmMain.butNewEditClick(Sender: TObject);
  200. var
  201.   i: Integer;
  202. begin
  203.   OD.Options:=OD.Options-[ofAllowMultiSelect];
  204.   OD.Title:='Select new version of file...';
  205.   OD.FileName:=txtNew.Text;
  206.   if OD.Execute then begin
  207.     i:=grpConfig.Tag;
  208.     PP.PatchFile(i).NewVersion:=OD.FileName;
  209.     ReloadNewTree;
  210.     lstNew.Selected[lstNew.GetFirstVisible]:=True;
  211.   end;
  212. end;
  213.  
  214. procedure TfrmMain.lstNewChange(Sender: TBaseVirtualTree;
  215.   Node: PVirtualNode);
  216. var
  217.   i,j: Integer;
  218. begin
  219.   case lstNew.SelectedCount of
  220.     0: Exit;
  221.     1: begin
  222.       if lstNew.Selected[Node] then begin
  223.         i:=PInteger(lstNew.GetNodeData(Node))^;
  224.         grpConfig.Caption:=ExtractFileName(PP.PatchFile(i).NewVersion);
  225.         grpConfig.Tag:=i;
  226.         txtNew.Text:=PP.PatchFile(i).NewVersion;
  227.         lstOld.Clear;
  228.         for j:=0 to PP.PatchFile(i).OldVersionCount - 1 do begin
  229.           lstOld.Items.Add(PP.PatchFile(i).OldVersions[j]);
  230.         end;
  231.         SetConfigTextBoxes(PP.PatchFile(i).Config);
  232.       end;
  233.     end;
  234.     else begin
  235.       grpConfig.Tag:=-1;   //multiple files selected - only allow config changes
  236.       txtNew.Text:='(multiple files selected)';
  237.       lstOld.Clear;
  238.     end;
  239.   end;
  240.   UpdateStates;
  241. end;
  242.  
  243. procedure TfrmMain.butOldAddClick(Sender: TObject);
  244. var
  245.   i,j: Integer;
  246. begin
  247.   OD.Options:=OD.Options+[ofAllowMultiSelect];
  248.   OD.Title:='Select old versions of '+grpConfig.Caption+'...';
  249.   OD.FileName:='';
  250.   if OD.Execute then begin
  251.     i:=grpConfig.Tag;
  252.     for j:=0 to OD.Files.Count - 1 do begin
  253.       PP.PatchFile(i).AddOldVersion(OD.Files[j]);
  254.       lstOld.Items.Add(OD.Files.Strings[j]);
  255.     end;
  256.   end;
  257. end;
  258.  
  259. procedure TfrmMain.SelectInNewTree(PatchIndex: Integer);
  260. var
  261.   Node: PVirtualNode;
  262. begin
  263.   Node:=lstNew.GetFirstSelected;
  264.   while Node<>nil do begin
  265.     lstNew.Selected[Node]:=False;
  266.     Node:=lstNew.GetNextSelected(Node);
  267.   end;
  268.   Node:=lstNew.GetFirst;
  269.   while Node<>nil do begin
  270.     if PInteger(lstNew.GetNodeData(Node))^=PatchIndex then begin
  271.       lstNew.Selected[Node]:=True;
  272.       lstNewChange(lstNew,Node);
  273.       Exit;
  274.     end;
  275.     Node:=lstNew.GetNext(Node);
  276.   end;
  277. end;
  278.  
  279. procedure TfrmMain.butOldRemoveClick(Sender: TObject);
  280. begin
  281.   if lstOld.ItemIndex>=0 then begin
  282.     PP.PatchFile(grpConfig.Tag).RemoveOldVersion(lstOld.ItemIndex);
  283.     lstOld.Items.Delete(lstOld.ItemIndex);
  284.   end;
  285. end;
  286.  
  287. procedure TfrmMain.OpenAFile(FileName: String; AskSave: Boolean=True; PromptNew: Boolean=False);
  288. var
  289.   fs: TFileStream;
  290. begin
  291.   PP.Free; //confirm saving first?
  292.   PP:=TPatchProject.Create;
  293.   ReloadNewTree;
  294.   if FileName<>'' then begin
  295.     fs:=nil;
  296.     try
  297.       fs:=TFileStream.Create(FileName,fmOpenRead);
  298.       PP.LoadFromStream(fs);
  299.     finally
  300.       dskName:=FileName;
  301.       ReloadNewTree;
  302.       fs.Free;
  303.     end;
  304.   end else begin
  305.     dskName:=UntitledFile;
  306.     if PromptNew then butAddClick(Self);
  307.   end;
  308.  
  309.   UpdateStates;
  310. end;
  311.  
  312. procedure TfrmMain.mnuNewClick(Sender: TObject);
  313. begin
  314.   OpenAFile('',True,True);
  315. end;
  316.  
  317. procedure TfrmMain.mnuOpenClick(Sender: TObject);
  318. begin
  319.   if dlgOpen.Execute then begin
  320.     OpenAFile(dlgOpen.FileName,True);
  321.   end;
  322. end;
  323.  
  324. procedure TfrmMain.mnuSaveClick(Sender: TObject);
  325. begin
  326.   dskName:=DoSave(dskName,False);
  327.   UpdateStates;
  328. end;
  329.  
  330. procedure TfrmMain.mnuSaveasClick(Sender: TObject);
  331. begin
  332.   dskName:=DoSave(dskName,True);
  333.   UpdateStates;
  334. end;
  335.  
  336. function TfrmMain.DoSave(const FileName: String; const Prompt: Boolean): String;
  337. var
  338.   FN: String;
  339.   fs: TFileStream;
  340. begin
  341.   DoSave:='';
  342.   FN:=FileName;
  343.   if Prompt or (CompareText(FileName,UntitledFile)=0) then begin
  344.     if dlgSave.Execute then begin
  345.       FN:=dlgSave.FileName;
  346.       if ExtractFileExt(FN)='' then
  347.         FN:=FN+'.vpj';
  348.     end else begin
  349.       DoSave:=FileName;
  350.       Exit;
  351.     end;
  352.   end;
  353.   //do actual saving to this file...
  354.   fs:=TFileStream.Create(FN,fmCreate);
  355.   PP.SaveToStream(fs);
  356.   fs.Free;
  357.   DoSave:=FN;
  358. end;
  359.  
  360. procedure TfrmMain.mnuGenGoClick(Sender: TObject);
  361. begin
  362.   Self.Visible:=False;
  363.   Cursor:=crHourGlass;
  364.   PP.Generate;
  365.   Cursor:=crDefault;
  366.   Self.Visible:=True;
  367.   SelectInNewTree(0);
  368. end;
  369.  
  370. procedure TfrmMain.mnuAboutClick(Sender: TObject);
  371. var
  372.   frmAbout: TfrmAbout;
  373. begin
  374.   frmAbout:=TfrmAbout.Create(Self);
  375.   frmAbout.ShowModal;
  376.   frmAbout.Free;
  377. end;
  378.  
  379. procedure TfrmMain.mnuCreateEXEClick(Sender: TObject);
  380. var
  381.   fs: TFileStream;
  382.   fr: TFileStream;
  383. begin
  384.   //first, select it on disk (where should the exe go?)
  385.   if dlgSaveExe.FileName='' then dlgSaveExe.FileName:='VPatch.exe';
  386.   if dlgSaveExe.Execute then begin
  387.     fs:=nil;
  388.     try
  389.       fs:=TFileStream.Create(dlgSaveExe.FileName,fmCreate);
  390.       fr:=nil;
  391.       try
  392.         fr:=TFileStream.Create(ExtractFilePath(Application.ExeName)+'vpatch.bin',fmOpenRead);
  393.         fs.CopyFrom(fr,fr.Size);
  394.       finally
  395.         fr.Free;
  396.       end;
  397.       PP.WritePatches(fs);
  398.     finally
  399.       fs.Free;
  400.     end;
  401.   end;
  402. end;
  403.  
  404. procedure TfrmMain.mnuCreateDLLClick(Sender: TObject);
  405. var
  406.   fs: TFileStream;
  407.   fr: TFileStream;
  408. begin
  409.   //first, select it on disk (where should the exe go?)
  410.   if dlgSaveDLL.FileName='' then dlgSaveDLL.FileName:='VPatch.DLL';
  411.   if dlgSaveDLL.Execute then begin
  412.     fs:=nil;
  413.     try
  414.       fs:=TFileStream.Create(dlgSaveDLL.FileName,fmCreate);
  415.       fr:=nil;
  416.       try
  417.         fr:=TFileStream.Create(ExtractFilePath(Application.ExeName)+'vpatchdll.bin',fmOpenRead);
  418.         fs.CopyFrom(fr,fr.Size);
  419.       finally
  420.         fr.Free;
  421.       end;
  422.       PP.WritePatches(fs);
  423.     finally
  424.       fs.Free;
  425.     end;
  426.   end;
  427. end;
  428.  
  429. procedure TfrmMain.mnuCreatePATClick(Sender: TObject);
  430. var
  431.   fs: TFileStream;
  432. begin
  433.   //first, select it on disk (where should the exe go?)
  434.   if dlgSavePAT.FileName='' then dlgSavePAT.FileName:='PatchData.pat';
  435.   if dlgSavePAT.Execute then begin
  436.     fs:=nil;
  437.     try
  438.       fs:=TFileStream.Create(dlgSavePAT.FileName,fmCreate);
  439.       PP.WritePatches(fs);
  440.     finally
  441.       fs.Free;
  442.     end;
  443.   end;
  444. end;
  445.  
  446. procedure TfrmMain.lstNewGetText(Sender: TBaseVirtualTree;
  447.   Node: PVirtualNode; Column: TColumnIndex; TextType: TVSTTextType;
  448.   var CellText: WideString);
  449. var
  450.   i: Integer;
  451. begin
  452.   i:=PInteger(lstNew.GetNodeData(Node))^;
  453.   CellText:=ExtractFileName(PP.PatchFile(i).NewVersion);
  454. end;
  455.  
  456. procedure TfrmMain.txtStartBlockSizeChange(Sender: TObject);
  457. begin
  458.   PP.PatchFile(grpConfig.Tag).Config:=CollectConfig;
  459. end;
  460.  
  461. function TfrmMain.CollectConfig: String;
  462. begin
  463.   Result:=txtStartBlockSize.Caption+','+txtMinimumBlockSize.Text+','+txtBlockDivider.Text+','+txtStepSize.Text;
  464. end;
  465.  
  466. procedure TfrmMain.txtMinimumBlockSizeChange(Sender: TObject);
  467. begin
  468.   PP.PatchFile(grpConfig.Tag).Config:=CollectConfig;
  469. end;
  470.  
  471. procedure TfrmMain.txtBlockDividerChange(Sender: TObject);
  472. begin
  473.   PP.PatchFile(grpConfig.Tag).Config:=CollectConfig;
  474. end;
  475.  
  476. procedure TfrmMain.txtStepSizeChange(Sender: TObject);
  477. begin
  478.   PP.PatchFile(grpConfig.Tag).Config:=CollectConfig;
  479. end;
  480.  
  481. procedure TfrmMain.SetConfigTextBoxes(Config: String);
  482. var
  483.   a,i: Integer;
  484. begin
  485.     a:=Pos(',',Config);
  486.     if(a=0) then a:=Length(Config)+1;
  487.     txtStartBlockSize.Caption:=Copy(Config,1,a-1);
  488.     Config:=Copy(Config,a+1,Length(Config));
  489.  
  490.     a:=StrToInt(txtStartBlockSize.Caption);
  491.     i:=-1;
  492.     while not (a=0) do begin
  493.       a:=a shr 1;
  494.       Inc(i);
  495.     end;
  496.     tbBlockSize.Position := i;
  497.  
  498.     a:=Pos(',',Config);
  499.     if(a=0) then a:=Length(Config)+1;
  500.     txtMinimumBlockSize.Text:=Copy(Config,1,a-1);
  501.     Config:=Copy(Config,a+1,Length(Config));
  502.  
  503.     a:=Pos(',',Config);
  504.     if(a=0) then a:=Length(Config)+1;
  505.     txtBlockDivider.Text:=Copy(Config,1,a-1);
  506.     Config:=Copy(Config,a+1,Length(Config));
  507.  
  508.     a:=Pos(',',Config);
  509.     if(a=0) then a:=Length(Config)+1;
  510.     txtStepSize.Text:=Copy(Config,1,a-1);
  511. end;
  512.  
  513. procedure TfrmMain.chkDebugClick(Sender: TObject);
  514. begin
  515.   if chkDebug.State = cbUnchecked then
  516.     PatchGenerator.DebugEvent:=nil
  517.   else
  518.     PatchGenerator.DebugEvent:=PrintDebug;
  519. end;
  520.  
  521. procedure TfrmMain.PrintDebug(S: String);
  522. begin
  523.   WriteLn(S);
  524. end;
  525.  
  526. procedure TfrmMain.tbBlockSizeChange(Sender: TObject);
  527. begin
  528.   txtStartBlockSize.Caption:=IntToStr(1 shl tbBlockSize.Position);
  529.   PP.PatchFile(grpConfig.Tag).Config:=CollectConfig;
  530. end;
  531.  
  532. procedure TfrmMain.mnuClearcachedpatchesClick(Sender: TObject);
  533. begin
  534.   PP.ResetCache;
  535. end;
  536.  
  537. initialization
  538.   PP:=TPatchProject.Create;
  539. end.
  540.