home *** CD-ROM | disk | FTP | other *** search
/ Chip 2002 September / Chip_2002-09_cd1.bin / zkuste / delphi / kompon / d123456 / STR_BIT.ZIP / 32 / skr / Unit1.pas < prev    next >
Pascal/Delphi Source File  |  2001-06-25  |  13KB  |  402 lines
  1. {*     ─αφφα  ∩≡επ≡α∞∞α ≡ατ≡αßε≥αφα Ω≤≡±αφ≥ε∞ 183 ≤≈σßφεΘ π≡≤∩∩√     *
  2.  *            ╥Φ⌡εφεΓ√∞ └ ╚ Σδ  ±Σα≈Φ τα≈σ≥α ∩ε ΣΦ±÷Φ∩δΦφσ           *
  3.  *             "╬±φεΓ√ └δπε≡Φ≥∞Φτα÷ΦΦ Φ ╧≡επ≡α∞∞Φ≡εΓαφΦ "            *
  4.  *           ╧≡επ≡α∞∞α Γ√∩εδφ σ≥ ±Ω≡σ∞ßδΦ≡εΓαφΦσ ταΣαφεπε ⌠αΦδα      *
  5.  * ╤ε±≥εΦ≥ Φτ ≥≡σ⌡ ∞εΣ≤δσΘ:                                          *
  6.  *   - Unit1 - ε±φεΓφεΘ ∞εΣ≤δⁿ                                       *
  7.  *   - Unit2 - ∞εΣ≤δⁿ ±εΣσ≡µα∙ΦΘ ±ΓσΣσφΦ  ε ∩≡επ≡α∞∞σ                *
  8.  *   - Unit3 - ∞εΣ≤δⁿ ±εΣσ≡µα∙σΘ ε±φεΓφ≤■ ∩≡ε÷σΣ≤≡≤ - ±Ω≡σ∞ßδΦ≡εΓαφΦσ*
  9.  *       ╥αΩµσ Σαφφα  ∩≡επ≡α∞∞α Φ±∩εδⁿτ≤σ≥ Σε∩εδφΦ≥σδⁿφ≤■ ßΦßΣΦε≥σΩ≤ *
  10.  * εß≡αßε≥ΩΦ ßΦ≥εΓ SIRBIT32                                          *}
  11.  
  12. unit Unit1;
  13.  
  14. interface
  15.  
  16. uses
  17.   Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  18.   Menus, StdCtrls, Buttons, ExtCtrls, ComCtrls, Mask, Grids, Outline,
  19.   DirOutln, Spin, DBCtrls,Strbit32,unit3, DBLookup,shellApi;
  20.  
  21. type
  22.   TForm1 = class(TForm)
  23.     MainMenu1: TMainMenu;
  24.     N1: TMenuItem;
  25.     StatusBar1: TStatusBar;
  26.     Panel1: TPanel;
  27.     OpenDialog1: TOpenDialog;
  28.     SaveDialog1: TSaveDialog;
  29.     uyiy6u71: TMenuItem;
  30.     yuiyi1: TMenuItem;
  31.     N2: TMenuItem;
  32.     N3: TMenuItem;
  33.     RTexit: TMenuItem;
  34.     Label3: TLabel;
  35.     Label4: TLabel;
  36.     N4: TMenuItem;
  37.     Progr: TMenuItem;
  38.     Helpmenu: TMenuItem;
  39.     BitBtn1: TBitBtn;
  40.     BitBtn2: TBitBtn;
  41.     BitBtn3: TBitBtn;
  42.     BitBtn6: TBitBtn;
  43.     Label5: TLabel;
  44.     Label6: TLabel;
  45.     N5: TMenuItem;
  46.     N6: TMenuItem;
  47.     GroupBox1: TGroupBox;
  48.     FileIn: TEdit;
  49.     FileOut: TEdit;
  50.     Label1: TLabel;
  51.     Label2: TLabel;
  52.     GroupBox2: TGroupBox;
  53.     N7: TMenuItem;
  54.     N8: TMenuItem;
  55.     N9: TMenuItem;
  56.     N10: TMenuItem;
  57.     N11: TMenuItem;
  58.     N12: TMenuItem;
  59.     N13: TMenuItem;
  60.     N14: TMenuItem;
  61.     N15: TMenuItem;
  62.     C1: TMenuItem;
  63.     N16: TMenuItem;
  64.     PorPolin: TComboBox;
  65.     NachUs: TComboBox;
  66.     N17: TMenuItem;
  67.     BitBtn4: TBitBtn;
  68.     N18: TMenuItem;
  69.     Period: TComboBox;
  70.     Panel2: TPanel;
  71.     GroupBox3: TGroupBox;
  72.     procedure OpenClick(Sender: TObject);
  73.     procedure SaveClick(Sender: TObject);
  74.     procedure SkrembClick(Sender: TObject);
  75.     procedure NachUsKeyUp(Sender: TObject; var Key: Word;
  76.       Shift: TShiftState);
  77.     procedure ProgrClick(Sender: TObject);
  78.     procedure PorPolinKeyUp(Sender: TObject; var Key: Word;
  79.       Shift: TShiftState);
  80.     procedure N7Click(Sender: TObject);
  81.     procedure N8Click(Sender: TObject);
  82.     procedure N10Click(Sender: TObject);
  83.     procedure N12Click(Sender: TObject);
  84.     procedure N13Click(Sender: TObject);
  85.     procedure N14Click(Sender: TObject);
  86.     procedure N15Click(Sender: TObject);
  87.     procedure RTexitClick(Sender: TObject);
  88.     procedure C1Click(Sender: TObject);
  89.     procedure NachUsClick(Sender: TObject);
  90.     procedure PorPolinClick(Sender: TObject);
  91.     procedure N17Click(Sender: TObject);
  92.     procedure BitBtn4Click(Sender: TObject);
  93.     procedure N18Click(Sender: TObject);
  94.     procedure FormActivate(Sender: TObject);
  95.   private
  96.  
  97.    { Private declarations }
  98.   public
  99.  
  100.     { Public declarations }
  101.   end;
  102.  
  103. var
  104.   Form1: TForm1;
  105.   NFileIn,NFileOut,NU,Polin,Period:string;
  106.   Raz,ind:int64;
  107.   tai:string;
  108. implementation
  109.  
  110. uses unit2;
  111.  
  112. {$R *.DFM}
  113.  // ╧≡ε÷σΣ≤≡α Γ√ßε≡α Γ⌡εΣφεπε ⌠αΦδα
  114. procedure TForm1.OpenClick(Sender: TObject);
  115. var BFilin:TBitFile;
  116. begin
  117.   if OpenDialog1.Execute then
  118.    begin
  119.    if N8.Checked=True  then Filein.Text :=ExtractFilename (OpenDialog1.FileName)
  120.      else Filein.Text :=OpenDialog1.FileName;
  121.    BFilin := TBitFile.Create;
  122.    BFilin.OpenBitFile(FileIn.Text,btOpenRead,bt64);
  123.    Raz:=BFilin.SizeOfFile;
  124.    BFilin.CloseBitFile;
  125.    BFilin.Free;
  126.    If N15.Checked=True then StatusBar1.SimpleText:=(FormatFloat('  ╨ατ∞σ≡ ⌠αΦδα '+'##0.###',raz/8388608)+' ╠ßαΘ≥');
  127.    if N13.Checked=True then StatusBar1.SimpleText:=('  ╨ατ∞σ≡ ⌠αΦδα '+inttostr(raz div 8)+' ┴αΘ≥');
  128.    if N14.Checked=True then StatusBar1.SimpleText:=('  ╨ατ∞σ≡ ⌠αΦδα '+inttostr(raz div 8192)+' ╩ßαΘ≥');
  129.    if N12.Checked=True then StatusBar1.SimpleText:=('  ╨ατ∞σ≡ ⌠αΦδα '+inttostr(raz)+' ┴Φ≥');
  130.    end
  131.   end;
  132. // ╧≡ε÷σΣ≤≡α Γ√ßε≡α Γ√⌡εΣφεπε ⌠αΦδα
  133. procedure TForm1.SaveClick(Sender: TObject);
  134. begin
  135.   if SaveDialog1.Execute then
  136.     if N8.Checked=True then FileOut.Text :=ExtractFilename (SaveDialog1.FileName)
  137.        else FileOut.Text :=SaveDialog1.FileName;
  138. end;
  139. // ╧≡ε÷σΣ≤≡α ∩≡εΓσ≡ΩΦ ∩α≡α∞σ≥≡εΓ ±Ω≡σ∞ßδσ≡α Φ
  140. //  τα∩≤±Ωα ±Ω≡σ∞ßδΦ≡εΓαφΦ  Φ±⌡εΣφεπε ⌠αΦδα
  141. procedure TForm1.SkrembClick(Sender: TObject);
  142. var str1 :string;
  143.         e1,f,n:integer;
  144. begin
  145.      //  ╧≡εΓσ≡Ωα ΣδΦφ ═╙ ╚ ╘╧
  146.      if length(NachUS.Text)<>length(PorPolin.Text)
  147.       then
  148.        begin
  149.         MessageDlg('╨ατδΦ≈φα ΣδΦφα ╧╬╦╚═╬╠└ Φ ═.╙.',mtError,[mbOk], 0);
  150.         exit;
  151.        end;
  152.      //  ╧≡εΓσ≡Ωα ταΣαφΦ  ╘╧
  153.       str1:=PorPolin.text;
  154.     for f:=1 to length(str1) do
  155.        begin
  156.         if (str1[f]<>'0')   and (str1[f]<>'1')
  157.          then
  158.          begin
  159.            MessageDlg('═σΓσ≡φ√Θ ⌠ε≡∞α≥ ταΣαφΦ  ╘╧',mtError,[mbOk], 0);
  160.           exit;
  161.          end;
  162.        end;
  163.      //  ╧≡εΓσ≡Ωα ταΣαφΦ  ∩σ≡ΦεΣα
  164.         str1:=Period.text;
  165.        Val(Str1,ind,E1);
  166.        if E1<>0 then
  167.         begin
  168.          MessageDlg('═σΓσ≡φ√Θ ⌠ε≡∞α≥ ∩σ≡ΦεΣα ',mtError,[mbOk],0);
  169.          exit;
  170.         end;
  171.      //  ╧≡εΓσ≡Ωα ταΣαφΦ  ═╙
  172.     str1:=NachUs.text; n:=0;
  173.      for f:=1 to length(str1) do
  174.        begin
  175.         if (str1[f]='0') then inc(n);
  176.         if (str1[f]<>'0') and (str1[f]<>'1')
  177.          then
  178.          begin
  179.            MessageDlg('═σΓσ≡φ√Θ ⌠ε≡∞α≥ ταΣαφΦ  ═.╙.',mtError,[mbOk], 0);
  180.            exit;
  181.          end;
  182.        end;
  183.      //  ╧≡εΓσ≡Ωα ταΣαφΦ  ═╙
  184.  
  185.       if n=length(str1) then  MessageDlg('┬α° Γ√⌡εΣφεΘ ⌠αΦδ ß≤Σσ≥ ΦΣσφ≥Φ≈σφ Φ±⌡εΣφε∞≤ ⌠αΦδ≤, ±∞σφΦ≥σ ═╙',mtInformation,[mbOk],0);
  186.      //  ╧≡εΓσ≡Ωα ταΣαφΦ  ⌠αΦδεΓ
  187.        Str1:=FileOut.Text;
  188.      if (Filein.Text='') or (FileOut.Text='')or (Filein.Text='╚∞  φσ ταΣαφε')then
  189.       begin
  190.        MessageDlg('═σ ταΣαφε Φ∞  ⌠αΘδα',mtError,[mbOk], 0);
  191.        exit;
  192.       end;
  193.      Peredach(FileIn.Text, FileOut.Text,NachUs.Text,PorPolin.Text,Period.Text);
  194.      //  ╬≥Ω≡√≥Φσ εΩφα εß≡αßε≥ΩΦ ⌠αΦδα
  195.      Form3.ShowModal();
  196.     end;
  197.     //   ╧≡ε÷σΣ≤≡α ∩εΣ±≈σ≥α ΣδΦφ√ ═╙
  198. procedure TForm1.NachUsKeyUp(Sender: TObject; var Key: Word;
  199.   Shift: TShiftState);
  200. begin
  201.    Label5.Caption:='╩εδΦ≈σ±≥Γε ßΦ≥ φα≈αδⁿφεΘ ≤±≥αφεΓΩΦ : '+Inttostr(length(NachUs.text));
  202. end;
  203.  //   ╧≡ε÷σΣ≤≡α ε≥Ω≡√≥Φ  εΩφα "╬ ∩≡επ≡α∞∞σ"
  204. procedure TForm1.ProgrClick(Sender: TObject);
  205. begin
  206.    Form2.ShowModal();
  207. end;
  208.  //   ╧≡ε÷σΣ≤≡α ∩εΣ±≈σ≥α ΣδΦφ√ ╘╧
  209.   procedure TForm1.PorPolinKeyUp(Sender: TObject; var Key: Word;
  210.      Shift: TShiftState);
  211.    begin
  212.      Label6.Caption:='╩εδΦ≈σ±≥Γε  ≈σσΩ ≡σπΦ±≥≡α : '+Inttostr(length(PorPolin.text));
  213.    end;
  214.  
  215.      //   ╧≡ε÷σΣ≤≡√ φα±≥≡εΘΩΦ Φ∞σφΦ ⌠αΦδα
  216.   procedure TForm1.N7Click(Sender: TObject);
  217.    begin
  218.      N8.Checked:=False;
  219.      N7.Checked:=True;
  220.      N10.Checked:=False;
  221.      Filein.Text :=OpenDialog1.FileName;
  222.      FileOut.Text :=SaveDialog1.FileName;
  223.      if OpenDialog1.FileName='' then Filein.Text :='╚∞  φσ ταΣαφε'
  224.        else Filein.Text :=OpenDialog1.FileName;
  225.      if SaveDialog1.FileName='' then FileOut.Text :=ExtractFileDir(OpenDialog1.FileName)+'Fileout.bin'
  226.        else FileOut.Text :=SaveDialog1.FileName;
  227.  
  228.    end;
  229.     
  230.   procedure TForm1.N8Click(Sender: TObject);
  231.    begin
  232.      N7.Checked:=False;
  233.      N8.Checked:=True;
  234.      N10.Checked:=False;
  235.      Filein.Text :=ExtractFilename (OpenDialog1.FileName);
  236.      FileOut.Text:=ExtractFilename (SaveDialog1.FileName);
  237.      if OpenDialog1.FileName='' then Filein.Text :='╚∞  φσ ταΣαφε'
  238.         else Filein.Text :=ExtractFilename(OpenDialog1.FileName);
  239.      if SaveDialog1.FileName='' then FileOut.Text :='Fileout.bin'
  240.         else FileOut.Text :=ExtractFilename(SaveDialog1.FileName);
  241.    end;
  242.  
  243.  
  244.  
  245.   procedure TForm1.N10Click(Sender: TObject);
  246.    begin
  247.      N7.Checked:=False;
  248.      N8.Checked:=False;
  249.      N10.Checked:=True;
  250.      Filein.Text :=ExtractFilename (OpenDialog1.FileName);
  251.      FileOut.Text:=ExtractFilename (SaveDialog1.FileName);
  252.      if OpenDialog1.FileName='' then Filein.Text :='╚∞  φσ ταΣαφε'
  253.         else Filein.Text :=ExtractFileDrive (OpenDialog1.FileName)+'\..\'+ExtractFilename (OpenDialog1.FileName);
  254.      if SaveDialog1.FileName='' then FileOut.Text :=ExtractFileDrive(OpenDialog1.FileName)+'\..\'+'Fileout.bin'
  255.        else FileOut.Text :=ExtractFileDrive (SaveDialog1.FileName)+'\..\'+ExtractFilename(SaveDialog1.FileName);
  256.  
  257.    end;
  258. //   ╧≡ε÷σΣ≤≡√ φα±≥≡εΘΩΦ ≡ατ∞σ≡α ⌠αΦδα
  259.    procedure TForm1.N12Click(Sender: TObject);
  260.     begin
  261.      N12.Checked:=True;
  262.      N13.Checked:=False;
  263.      N14.Checked:=False;
  264.      N15.Checked:=False;
  265.      StatusBar1.SimpleText:=('  ╨ατ∞σ≡ ⌠αΦδα '+inttostr(raz)+' ┴Φ≥');
  266.  
  267.     end;
  268.  
  269.    procedure TForm1.N13Click(Sender: TObject);
  270.     begin
  271.      N13.Checked:=True;
  272.      N12.Checked:=False;
  273.      N14.Checked:=False;
  274.      N15.Checked:=False;
  275.      StatusBar1.SimpleText:=('  ╨ατ∞σ≡ ⌠αΦδα '+inttostr(raz div 8)+' ┴αΘ≥');
  276.  
  277.    end;
  278.  
  279.    procedure TForm1.N14Click(Sender: TObject);
  280.     begin
  281.      N14.Checked:=True;
  282.      N12.Checked:=False;
  283.      N13.Checked:=False;
  284.      N15.Checked:=False;
  285.      StatusBar1.SimpleText:=('  ╨ατ∞σ≡ ⌠αΦδα '+inttostr(raz div 8192)+' ╩ßαΘ≥');
  286.     end;
  287.  
  288.    procedure TForm1.N15Click(Sender: TObject);
  289.     begin
  290.      N15.Checked:=True;
  291.      N12.Checked:=False;
  292.      N13.Checked:=False;
  293.      N14.Checked:=False;
  294.      StatusBar1.SimpleText:=(FormatFloat('  ╨ατ∞σ≡ ⌠αΦδα '+'##0.###',raz/8388608)+' ╠ßαΘ≥');
  295.     end;
  296. // ╧≡ε÷σΣ≤≡α ταΩ≡√≥Φ  εΩφα
  297.   procedure TForm1.RTexitClick(Sender: TObject);
  298.    begin
  299.    Close;
  300.    end;
  301. // ╧≡ε÷σΣ≤≡√ αΩ≥ΦΓΦτα÷ΦΦ Φ ≡αßε≥√ ±≥≡εΩ ∩εΣ±≈σ≥α
  302.    procedure TForm1.C1Click(Sender: TObject);
  303.     begin
  304.      if C1.Checked=True then
  305.       begin
  306.        C1.Checked:=False;
  307.        Label5.Visible:=False;
  308.         Label6.Visible:=False;
  309.       end
  310.      else
  311.       Begin
  312.       C1.Checked:=True;
  313.       Label5.Visible:=True;
  314.       Label6.Visible:=True;
  315.       end;
  316.      end;
  317.  
  318.    procedure TForm1.NachUsClick(Sender: TObject);
  319.     begin
  320.      if N17.Checked=true then
  321.      PorPolin.ItemIndex:=NachUs.ItemIndex;
  322.      Label5.Caption:='╩εδΦ≈σ±≥Γε ßΦ≥ φα≈αδⁿφεΘ ≤±≥αφεΓΩΦ : '+Inttostr(length(NachUs.text));
  323.      Label6.Caption:='╩εδΦ≈σ±≥Γε  ≈σσΩ ≡σπΦ±≥≡α : '+Inttostr(length(PorPolin.text));
  324.     end;
  325.  
  326.    procedure TForm1.PorPolinClick(Sender: TObject);
  327.     begin
  328.      if N17.Checked=true then
  329.      NachUs.ItemIndex:=PorPolin.ItemIndex;
  330.      Label6.Caption:='╩εδΦ≈σ±≥Γε  ≈σσΩ ≡σπΦ±≥≡α : '+Inttostr(length(PorPolin.text));
  331.      Label5.Caption:='╩εδΦ≈σ±≥Γε ßΦ≥ φα≈αδⁿφεΘ ≤±≥αφεΓΩΦ : '+Inttostr(length(NachUs.text));
  332.  
  333.     end;
  334. // ╧≡ε÷σΣ≤≡α αΩ≥ΦΓΦτα÷ΦΦ ±Γ τΦ ╘╧ Φ ═╙
  335.    procedure TForm1.N17Click(Sender: TObject);
  336.     begin
  337.     if N17.Checked=false then  N17.Checked:=true
  338.        else  N17.Checked:=false;
  339.    end;
  340. // ╬≥≡√≥Φσ ⌠αΦδα ∩ε∞ε∙Φ
  341.    procedure TForm1.BitBtn4Click(Sender: TObject);
  342.     begin
  343.      ShellExecute(Handle,nil,'HelpADD.hlp',nil,nil,SW_RESTORE);
  344.     end;
  345. // ╧≡ε÷σΣ≤≡α αΩ≥ΦΓ∞τα÷ΦΦ Γ±∩δ√Γα■∙σΘ ∩ε∞ε∙Φ
  346.    procedure TForm1.N18Click(Sender: TObject);
  347.     begin
  348.      if N18.Checked=false then
  349.       begin
  350.        Form1.BorderIcons:=[biSystemMenu,biMinimize,biHelp];
  351.        N18.Checked:=true;
  352.       end
  353.      else
  354.       begin
  355.        Form1.BorderIcons:=[biSystemMenu,biMinimize];
  356.        N18.Checked:=false;
  357.       end;
  358.     end;
  359.  // ┬┬σΣσφΦσ ∩α≡α∞σ≥≡εΓ ± ∩ε∞ε∙ⁿ■ Ωε∞αφΣφεΘ ±≥≡εΩΦ
  360. procedure TForm1.FormActivate(Sender: TObject);
  361. begin
  362.   if ParamCount=1 then FileIn.Text:=ParamStr(1);
  363.   if ParamCount=2 then
  364.     begin
  365.      FileIn.Text:=ParamStr(1);
  366.      FileOut.Text:=ParamStr(2);
  367.     end;
  368.   if ParamCount=3 then
  369.     begin
  370.      FileIn.Text:=ParamStr(1);
  371.      FileOut.Text:=ParamStr(2);
  372.      NachUs.Text:=ParamStr(3);
  373.     end;
  374.   if ParamCount=4 then
  375.     begin
  376.      FileIn.Text:=ParamStr(1);
  377.      FileOut.Text:=ParamStr(2);
  378.      NachUs.Text:=ParamStr(3);
  379.      PorPolin.Text:=ParamStr(4);
  380.      end;
  381.   if ParamCount=5 then
  382.     begin
  383.      FileIn.Text:=ParamStr(1);
  384.      FileOut.Text:=ParamStr(2);
  385.      NachUs.Text:=ParamStr(3);
  386.      PorPolin.Text:=ParamStr(4);
  387.      Period.Text:=ParamStr(5);
  388.      end;
  389.   if ParamCount=6 then
  390.     begin
  391.      FileIn.Text:=ParamStr(1);
  392.      FileOut.Text:=ParamStr(2);
  393.      NachUs.Text:=ParamStr(3);
  394.      PorPolin.Text:=ParamStr(4);
  395.      Period.Text:=ParamStr(5);
  396.      if ParamStr(6)='st' then SkrembClick(Sender );
  397.  
  398.     end;
  399. end;
  400.  
  401. end.
  402.