home *** CD-ROM | disk | FTP | other *** search
/ Chip 2002 September / Chip_2002-09_cd1.bin / zkuste / delphi / kompon / d123456 / STR_BIT.ZIP / 32 / UnSvKod / Main.pas < prev    next >
Pascal/Delphi Source File  |  2002-07-05  |  6KB  |  182 lines
  1. unit Main;
  2.  
  3. interface
  4.  
  5. uses
  6.   Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  7.   ComCtrls, StdCtrls, Buttons, Menus, StrBit32, Gauges, MaxMin, ExtCtrls,
  8.   Mask;
  9.  
  10. type
  11.   TMainForm = class(TForm)
  12.     Memo1: TMemo;
  13.     Label1: TLabel;
  14.     Label2: TLabel;
  15.     EdMatr: TEdit;
  16.     Label3: TLabel;
  17.     Label4: TLabel;
  18.     Edit2: TEdit;
  19.     Edit3: TEdit;
  20.     BitBtn1: TBitBtn;
  21.     BitBtn2: TBitBtn;
  22.     StatusBar1: TStatusBar;
  23.     OpenDialog1: TOpenDialog;
  24.     MainMenu1: TMainMenu;
  25.     mnHelp: TMenuItem;
  26.     miHelp: TMenuItem;
  27.     Gauge1: TGauge;
  28.     BitBtn3: TBitBtn;
  29.     mnExit: TMenuItem;
  30.     BnExit: TBitBtn;
  31.     BnExecute: TBitBtn;
  32.     mnKod: TMenuItem;
  33.     miIshFile: TMenuItem;
  34.     miRezFile: TMenuItem;
  35.     miExecute: TMenuItem;
  36.     Bevel1: TBevel;
  37.     procedure BnExitClick(Sender: TObject);
  38.     procedure BitBtn1Click(Sender: TObject);
  39.     procedure BitBtn2Click(Sender: TObject);
  40.     procedure BnExecuteClick(Sender: TObject);
  41.     procedure miHelpClick(Sender: TObject);
  42.     procedure FormCreate(Sender: TObject);
  43.     procedure EdMatrExit(Sender: TObject);
  44.   private
  45.     { Private declarations }
  46.   public
  47.     FIn,FOut : TBitFile;
  48.     Registr : TStr_Bit;
  49.     ZnSk,               // τφα∞σφα≥σδⁿ ±Ωε≡ε±≥Φ ╤╩
  50.     ChislSk,            // ≈Φ±δΦ≥σδⁿ ±Ωε≡ε±≥Φ ╤╩
  51.     MaxSize:integer;    // ΩεδΦ≈σ±≥Γε  ≈σσΩ Γ ≡σπΦ±≥≡σ ΩεΣσ≡α
  52.     MatrixMass: array[1..16,1..16] of String[200];
  53.     KoderMass: array[1..16] of TStr_Bit;
  54.   end;
  55.  
  56. var
  57.   MainForm: TMainForm;
  58.  
  59. implementation
  60.  
  61. {$R *.DFM}
  62.  
  63. procedure TMainForm.BnExitClick(Sender: TObject);
  64. begin   { ┬√⌡εΣ Φτ ∩≡επ≡α∞∞√ }
  65.  FIn.Free;      // ╬±ΓεßεµΣσφΦσ ∩α∞ ≥Φ, ταφ ≥εΘ ßΦ≥εΓ√∞Φ ∩σ≡σ∞σφφ√∞Φ
  66.  FOut.Free;
  67.  Registr.Free;
  68.  
  69.  Close;
  70. end;
  71.  
  72. procedure TMainForm.BitBtn1Click(Sender: TObject);
  73. begin   { ╬∩≡σΣσδΦ≥ⁿ ╘αΘδ ± Φ±⌡εΣφεΘ ßΦ≥εΓεΘ ∩ε±δσΣεΓα≥σδⁿφε±≥ⁿ■ }
  74.  if OpenDialog1.Execute then Edit2.Text:=OpenDialog1.FileName;
  75. end;
  76.  
  77. procedure TMainForm.BitBtn2Click(Sender: TObject);
  78. begin  { ╬∩≡σΣσδΦ≥ⁿ ╘αΘδ ± ΩεΣΦ≡εΓαφφεΘ ßΦ≥εΓεΘ ∩ε±δσΣεΓα≥σδⁿφε±≥ⁿ■ }
  79.  if OpenDialog1.Execute then Edit3.Text:=OpenDialog1.FileName;
  80. end;
  81.  
  82. procedure TMainForm.BnExecuteClick(Sender: TObject);
  83. var PosSim, K, j : Integer;
  84.     I: Byte; S:String;
  85. begin     { ┬√∩εδφΦ≥ⁿ ΩεΣΦ≡εΓαφΦσ Σαφφ√⌡ }
  86.  Gauge1.Visible := True;
  87.  if ( Edit2.Text = '' ) or ( Edit3.Text = '' )
  88.    then begin ShowMessage('═σ ταΣαφ√ ∩α≡α∞σ≥≡√ εß≡αßε≥ΩΦ');
  89.               Exit;
  90.         end;
  91.                                 // Γ√ΣσδΦ≥ⁿ εß≡ατ≤■∙Φσ ∩εδΦφε∞√
  92.  for i:=1 to ChislSk do begin   
  93.    S:=Memo1.Lines.Strings[I-1];
  94.    for j:=1 to ZnSk do begin
  95.       S := Trim(S);
  96.       K := Pos(' ',S)-1; if K= -1 then K := length(S);
  97.       if K=0 then ShowMessage('┬ετ∞εµφε ∩α≡α∞σ≥≡√ ∞α≥≡Φ÷√ ταΣαφ√ φσ∩≡αΓΦδⁿφε')
  98.              else MatrixMass[I,J]:=Copy(S,1,K);
  99.       Delete(S,1,K);
  100.  end; end;
  101.                    // ╧≡σεß≡ατεΓα≥ⁿ ∞α≥≡Φ÷≤ Γ δΦφσΘφ√Θ ΣΓεΦ≈φ√Θ ΓΦΣ
  102.   MaxSize := 0;
  103.   for J := 1 to ZnSk do begin
  104.     K := 0;
  105.     KoderMass[J] := TStr_Bit.Create;
  106.     For PosSim := 1 to length(MatrixMass[1,J]) do
  107.      for I:=1 to ChislSk do begin
  108.       KoderMass[J][K] := Ord(MatrixMass[I,J][PosSim])-Ord('0');
  109.       inc(K);
  110.       end;
  111.       S := KoderMass[J].Val_sim;
  112.     MaxSize:= Max(MaxSize,K);
  113.     end;
  114.                           { ╩εΣΦ≡εΓα≥ⁿ Σαφφ√σ Φτ ⌠αΘδα }
  115.  Registr.Init_0(MaxSize);
  116.  try
  117.   FOut.OpenBitFile(Edit3.Text,btCreate,bt32);
  118.   FIn.OpenBitFile(Edit2.Text,btOpenRead,bt32);
  119.   Gauge1.MaxValue := FIn.SizeOfFile div ChislSk;
  120.   PosSim := 0;
  121.   while FIn.ReadStr(ChislSk) = btOk do begin   // ╬ß≡αßε≥α≥ⁿ Σαφφ√σ Γ±σπε ⌠αΘδα
  122.     for j:=1 to ChislSk do Registr.LastBitDisplase(FIn[j-1]); // τα∩εδφΦ≥ⁿ ≡σπΦ±≥≡
  123.     Inc(PosSim);
  124.     if (PosSim mod 10000)=0 then begin  // ┬√Γσ±≥Φ ΦφΣΦΩα≥ε≡
  125.       Gauge1.Progress:=PosSim;
  126.       Application.ProcessMessages; // ─α≥ⁿ Γετ∞εµφε±≥ⁿ ≡αßε≥α≥ⁿ Σ≡≤πΦ∞ ∩≡επ≡α∞∞α∞
  127.      end;
  128.       { ╤⌠ε≡∞Φ≡εΓα≥ⁿ Γ√⌡εΣφ√σ ßΦ≥√ }
  129.     for j:=1 to ZnSk do FOut.WriteBit(Registr.ModReg(KoderMass[J]) );
  130.   end;
  131.   FIn.CloseBitFile;     FOut.CloseBitFile;
  132.   ShowMessage('╩εΣΦ≡εΓαφΦσ ≤±∩σ°φε ταΓσ≡°σφε.');
  133.   Gauge1.Progress:=0;
  134.  Except on EFileBitZacr do
  135.        ShowMessage('═σΓετ∞εµφε ≡αßε≥α≥ⁿ ± ⌠αΘδα∞Φ.');     end;
  136.        { ╬±ΓεßεΣΦ≥ⁿ ∩α∞ ≥ⁿ, ταφ ≥≤■ ∞α±±ΦΓε∞ ßΦ≥εΓ√⌡ ∩σ≡σ∞σφφ√⌡ }
  137.  for J := 1 to ZnSk do KoderMass[J].Free;
  138.  Gauge1.Visible := False;
  139. end;
  140.  
  141. procedure TMainForm.miHelpClick(Sender: TObject);
  142. begin   { ╧εδ≤≈Φ≥ⁿ ±∩≡αΓΩ≤ ε ∩≡επ≡α∞∞σ }
  143.  BitBtn3.Click;
  144. end;
  145.  
  146. procedure TMainForm.FormCreate(Sender: TObject);
  147. begin    { ╟αΣαφΦσ φα≈αδⁿφ√⌡ ∩α≡α∞σ≥≡εΓ ∩≡Φ ΦφΦ÷ΦαδΦτα÷ΦΦ ∩≡επ≡α∞∞√ }
  148.  if ParamCount > 0 then Edit2.Text:=ParamStr(1);
  149.  if ParamCount > 1 then Edit3.Text:=ParamStr(2);
  150.  OpenDialog1.InitialDir := ParamStr(0);
  151.  ZnSk := 2;    ChislSk := 1;
  152.       { ┬√ΣσδΦ≥ⁿ ∩α∞ ≥ⁿ Σδ  ßΦ≥εΓ√⌡ ∩σ≡σ∞σφφ√⌡, Φ±∩εδⁿτ≤σ∞√⌡ ∩ε±≥ε φφε }
  153.   FIn := TBitFile.Create;
  154.   FOut := TBitFile.Create;
  155.   Registr := TStr_Bit.Create;
  156. end;
  157.  
  158. procedure TMainForm.EdMatrExit(Sender: TObject);
  159.  { ╧≡εΓσ≡Φ≥ⁿ ∩≡αΓΦδⁿφε±≥ⁿ ΓΓεΣα ∩α≡α∞σ≥≡εΓ Φ ∩≡σεß≡ατεΓα≥ⁿ Σαφφ√σ
  160.    Γε Γφ≤≥≡σφφΦσ ∩σ≡σ∞σφφ√σ}
  161. Var  S : String;  Kode : Integer;
  162.   procedure ShowError(Soob : String);
  163.   begin    { ┬√Γσ±≥Φ ±εεß∙σφΦσ εß ε°ΦßΩσ Φ Γσ≡φ≤≥ⁿ±  Ω ≡σΣαΩ≥Φ≡εΓαφΦ■ τφα≈σφΦ  }
  164.    ShowMessage(Soob);
  165.    EdMatr.SetFocus;
  166.   end;
  167. begin  // ╧εδ≤≈Φ≥ⁿ τφα≈σφΦ  ≡ατ∞σ≡φε±≥Φ ∩ε≡εµΣα■∙σΘ ∞α≥≡Φ÷√
  168.   ZnSk := 0;          ChislSk := 0;
  169.   S:=Copy(EdMatr.Text,1,Pos('/',EdMatr.Text)-1);
  170. {$R-}
  171.   Val(S,ChislSk, Kode);  // ≈Φ±δΦ≥σδⁿ ±Ωε≡ε±≥Φ ╤╩
  172.   If (Kode <> 0) or (ChislSk>16) or (ChislSk<1)
  173.     then ShowError('═σΓσ≡φε ταΣαφ ≈Φ±δΦ≥σδⁿ ±Ωε≡ε±≥Φ ΩεΣα.');
  174.   S:=Copy(EdMatr.Text,Pos('/',EdMatr.Text)+1,Length(EdMatr.Text));
  175.   Val(S,ZnSk, Kode);  // τφα∞σφα≥σδⁿ ±Ωε≡ε±≥Φ ╤╩
  176. {$R+}
  177.   If (Kode <> 0) or (ZnSk>16) or (ZnSk<2) or (ZnSk <= ChislSk)
  178.     then ShowError('═σΓσ≡φε ταΣαφ τφα∞σφα≥σδⁿ ±Ωε≡ε±≥Φ ΩεΣα.');
  179. end;
  180.  
  181. end.
  182.