program Project1_0;
uses
Forms,
Unit1_0 in 'Unit1_0. pas' {Form1};
{$R *. res}
begin
Application. Initialize;
Application. CreateForm(TForm1, Form1);
Application. Run;
end.
unit Unit1;
interface
uses Windows, SysUtils, Classes, Graphics, Forms, Controls, StdCtrls,
Buttons, ExtCtrls, sButton, sSkinProvider, sSkinManager;
type
TAboutProgram = class(TForm)
Memo1: TMemo;
sButton1: TsButton;
sSkinProvider1: TsSkinProvider;
procedure OKButtonClick(Sender: TObject);
procedure sButton1Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
AboutProgram: TAboutProgram;
implementation
uses Unit1_0;
{$R *. dfm}
procedure TAboutProgram. OKButtonClick(Sender: TObject);
begin
Form1. Enabled: =True;
Close;
end;
procedure TAboutProgram. sButton1Click(Sender: TObject);
begin
Form1. Enabled: =True;
Close;
end;
end.
unit Unit1_0;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, Buttons, StdCtrls, ExtCtrls, jpeg, Menus, sBitBtn,
sSkinProvider, sSkinManager;
type
TForm1 = class(TForm)
Edit1: TEdit;
SearCB: TComboBox;
ALF: TComboBox;
RG: TRadioGroup;
GroupBox1: TGroupBox;
Label1: TLabel;
Panel1: TPanel;
Panel2: TPanel;
Panel3: TPanel;
MainMenu1: TMainMenu;
N1: TMenuItem;
N2: TMenuItem;
sBitBtn1: TsBitBtn;
sSkinProvider1: TsSkinProvider;
procedure FormCreate(Sender: TObject);
function Search_LR: Boolean;
function Search_RL: Boolean;
function Search_UD: Boolean;
function Search_DU: Boolean;
procedure Search;
function Sumbol: Char;
procedure Edit1KeyDown(Sender: TObject; var Key: Word;
Shift: TShiftState);
procedure SpeedButton1Click(Sender: TObject);
procedure panelOnClick (sender: Tobject);
procedure ALFChange(Sender: TObject);
procedure SearCBChange(Sender: TObject);
procedure Panel1Click(Sender: TObject);
procedure Panel2Click(Sender: TObject);
procedure Panel3Click(Sender: TObject);
procedure Panel4Click(Sender: TObject);
procedure N1Click(Sender: TObject);
procedure N2Click(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure sBitBtn1Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
Const MaxY = 25;
MaxX = 25;
var
Form1: TForm1;
sbut: array [1. MaxX,
1. MaxY] of TPanel;
X1,Y1: Integer;
implementation
uses Unit1, Unit2, Unit3;
{$R *. dfm}
procedure TForm1. FormCreate(Sender: TObject);
var
i, j: integer;
begin
for i: = 1 to MaxX do begin
for j: = 1 to MaxY do begin
sbut [i, j]: = TPanel. Create(form1);
sbut [i, j]. Parent: = form1;
sbut [i, j]. Height: = 20;
sbut [i, j]. Width: = 20;
sbut [i, j]. Top: = (i - 1) * 26 + 10;
sbut [i, j]. Left: = (j - 1) * 26 + 10;
sbut [i, j]. Color: = clYellow;
sbut [i, j]. OnClick: = panelOnClick;
end;
end;
end;
function TForm1. Search_LR: Boolean;
var
i, j, k: integer;
Myword: String;
begin
Search_LR: =False;
if Edit1. Text<>'' then begin
for i: = 1 to MaxX do
for j: = 1 to MaxY do
if (j+Length(Edit1. Text) - 1) <=MaxY then begin
for k: =0 to Length(Edit1. Text) - 1 do
Myword: =Myword+SBut [i,j+k]. Caption;
if Myword=Edit1. Text then begin
for k: =0 to Length(Edit1. Text) - 1 do begin
sbut [i, j+k]. Font. Color: =clYellow;
sbut [i, j+k]. Color: = clBlue;
end;
Search_LR: =True;
{Exit; }
end else Myword: ='';
end;
end;
end;
function TForm1. Search_RL: Boolean;
var
i, j, k: integer;
Myword: String;
begin
Search_RL: =False;
if Edit1. Text<>'' then begin
for i: = 1 to MaxX do
for j: = 1 to MaxY do
if (j+Length(Edit1. Text) - 1) <=MaxY then begin
for k: =Length(Edit1. Text) - 1 DownTo 0 do
Myword: =Myword+SBut [i,j+k]. Caption;
if Myword=Edit1. Text then begin
for k: =Length(Edit1. Text) - 1 DownTo 0 do begin
sbut [i, j+k]. Font. Color: =clRed;
sbut [i, j+k]. Color: = clBlack;
end;
Search_RL: =True;
{Exit; }
end else Myword: ='';
end;
end;
end;
function TForm1. Search_UD: Boolean;
var
i, j, k: integer;
Myword: String;
begin
Search_UD: =False;
if Edit1. Text<>'' then begin
for i: = 1 to MaxX do
for j: = 1 to MaxY do
if (i+Length(Edit1. Text) - 1) <=MaxX then begin
for k: =0 to Length(Edit1. Text) - 1 do
Myword: =Myword+SBut [i+k,j]. Caption;
if Myword=Edit1. Text then begin
for k: =0 to Length(Edit1. Text) - 1 do begin
sbut [i+k,j]. Font. Color: =clBlack;
sbut [i+k,j]. Color: = clRed;
end;
Search_UD: =True;
{Exit; }
end else Myword: ='';
end;
end;
end;
function TForm1. Search_DU: Boolean;
var
i, j, k: integer;
Myword: String;
begin
Search_DU: =False;
if Edit1. Text<>'' then begin
for i: = 1 to MaxX do
for j: = 1 to MaxY do
if (i+Length(Edit1. Text) - 1) <=MaxX then begin
for k: =Length(Edit1. Text) - 1 DownTo 0 do
Myword: =Myword+SBut [i+k,j]. Caption;
if Myword=Edit1. Text then begin
for k: =Length(Edit1. Text) - 1 DownTo 0 do begin
sbut [i+k,j]. Font. Color: =clBlue;
sbut [i+k,j]. Color: = clGreen;
end;
Search_DU: =True;
{Exit; }
end else Myword: ='';
end;
end;
end;
procedure TForm1. Search;
var Find,F1,F2,F3,F4: Boolean;
begin
if SearCB. ItemIndex<0 then Search_LR;
Find: =True;
F1: =True; F3: =True;
F2: =True; F4: =True;
case SearCB. ItemIndex of
0: Find: =Search_LR;
1: Find: =Search_RL;
2: Find: =Search_UD;
3: Find: =Search_DU;
4: begin
F1: =Search_LR;
F2: =Search_RL;
F3: =Search_UD;
F4: =Search_DU;
end;
end;
if (Find=False) or((F1=False) and(F2=False) and(F3=False) and(F4=False)) then
ShowMessage('Шуканої послідовності символів не знайдено! ')
end;
function TForm1. Sumbol: Char;
const
Ukr='йцукенгшщзхїфівапролджєячсмитьбюЙЦУКЕНГШЩЗХЇФІВАПРОЛДЖЄЯЧСМИТЬБЮ';
UkrL='йцукенгшщзхїфівапролджєячсмитьбю';
UkrB='ЙЦУКЕНГШЩЗХЇФІВАПРОЛДЖЄЯЧСМИТЬБЮ';
Rus='йцукенгшщзхъфывапролджэячсмитьбюЙЦУКЕНГШЩЗХЪФЫВАПРОЛДЖЭЯЧСМИТЬБЮ';
RusL='йцукенгшщзхъфывапролджэячсмитьбю';
RusB='ЙЦУКЕНГШЩЗХЪФЫВАПРОЛДЖЭЯЧСМИТЬБЮ';
Eng='qwertyuiopasdfghjklzxcvbnmQWERTYUIOPASDFGHJKLZXCVBNM';
EngL='qwertyuiopasdfghjklzxcvbnm';
EngB='QWERTYUIOPASDFGHJKLZXCVBNM';
Num='0123456789';
begin
if ALF. ItemIndex<0 then ALF. ItemIndex: =0;
case ALF. ItemIndex of
0: begin
case RG. ItemIndex of
0: Sumbol: =UkrB [Random(Length(UkrB)) +1] ;
1: Sumbol: =UkrL [Random(Length(UkrL)) +1] ;
2: Sumbol: =Ukr [Random(Length(Ukr)) +1] ;
end;
end;
1: begin
case RG. ItemIndex of
0: Sumbol: =RusB [Random(Length(RusB)) +1] ;
1: Sumbol: =RusL [Random(Length(RusL)) +1] ;
2: Sumbol: =Rus [Random(Length(Rus)) +1] ;
end;
end;
2: begin
case RG. ItemIndex of
0: Sumbol: =EngB [Random(Length(EngB)) +1] ;
1: Sumbol: =EngL [Random(Length(EngL)) +1] ;
2: Sumbol: =Eng [Random(Length(Eng)) +1] ;
end;
end;
3: Sumbol: =Num [Random(Length(Num)) +1] ;
end;
end;
procedure TForm1. Edit1KeyDown(Sender: TObject; var Key: Word;
Shift: TShiftState);
begin
if Key=13 then Search;
end;
procedure TForm1. SpeedButton1Click(Sender: TObject);
begin
Close;
end;
procedure Tform1. panelOnClick (sender: Tobject);
var
s: string;
Col: Integer;
begin
Col: =TPanel(sender). Color;
TPanel(sender). Color: =clRed;
s: = InputBox ('Введіть потрібний символ', 'Символ: ', TPanel(sender). Caption);
if S<>'' then
TPanel(sender). Caption: = S [1] ;
TPanel(sender). Color: =Col;
end;
procedure TForm1. ALFChange(Sender: TObject);
begin
if ALF. ItemIndex=3 then RG. Enabled: =False
else RG. Enabled: =True;
Edit1. SetFocus;
end;
procedure TForm1. SearCBChange(Sender: TObject);
begin
Edit1. SetFocus;
end;
procedure TForm1. Panel1Click(Sender: TObject);
begin
if SearCB. ItemIndex<0 then SearCB. ItemIndex: =0;
Search;
end;
procedure TForm1. Panel2Click(Sender: TObject);
var i,j: Integer;
begin
for i: =1 to MaxX do
for j: =1 to MaxY do begin
sbut [i, j]. Font. Color: =clBlue;
sbut [i, j]. Color: =clYellow;
end;
end;
procedure TForm1. Panel3Click(Sender: TObject);
var i,j: Integer;
begin
Randomize;
for i: = 1 to MaxX do
for j: = 1 to MaxY do begin
sbut [i, j]. Caption: = Sumbol;
sbut [i, j]. Font. Color: =clBlue;
sbut [i, j]. Color: =clYellow;
end;
end;
procedure TForm1. Panel4Click(Sender: TObject);
begin
Close;
end;
procedure TForm1. N1Click(Sender: TObject);
begin
Form1. Enabled: =False;
AboutProgram. Show;
end;
procedure TForm1. N2Click(Sender: TObject);
begin
Form1. Enabled: =False;
AboutBox. Show;
end;
procedure TForm1. FormClose(Sender: TObject; var Action: TCloseAction);
begin
AboutBox1. close;
end;
procedure TForm1. sBitBtn1Click(Sender: TObject);
begin
close;
end;
end.
Лістінг модуля Unit2:
unit Unit2;
interface
uses Windows, SysUtils, Classes, Graphics, Forms, Controls, StdCtrls,
Buttons, ExtCtrls, sBitBtn, sSkinProvider, sSkinManager, sPanel, sLabel,
sButton;
type
TAboutBox = class(TForm)
Panel1: TPanel;
Image1: TImage;
sLabelFX1: TsLabelFX;
sLabelFX2: TsLabelFX;
sStickyLabel1: TsStickyLabel;
sStickyLabel2: TsStickyLabel;
sLabelFX3: TsLabelFX;
sSkinProvider1: TsSkinProvider;
sButton1: TsButton;
procedure OKButtonClick(Sender: TObject);
procedure sBitBtn1Click(Sender: TObject);
procedure sBitBtn2Click(Sender: TObject);
procedure sButton1Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
AboutBox: TAboutBox;
implementation
uses Unit1_0;
{$R *. dfm}
procedure TAboutBox. OKButtonClick(Sender: TObject);
begin
Form1. Enabled: =True;
close;
end;
procedure TAboutBox. sBitBtn1Click(Sender: TObject);
begin
Form1. Enabled: =True;
close;
end;
procedure TAboutBox. sBitBtn2Click(Sender: TObject);
begin
Form1. Enabled: =True;
close;
end;
procedure TAboutBox. sButton1Click(Sender: TObject);
begin
Form1. Enabled: =True;
close;
end;
end.
Лістінг модуля Unit3:
unit Unit3;
interface
uses Windows, SysUtils, Classes, Graphics, Forms, Controls, StdCtrls,
Buttons, ExtCtrls, sSkinProvider, sBitBtn, sSkinManager, sLabel;
type
TAboutBox1 = class(TForm)
Edit1: TEdit;
sBitBtn1: TsBitBtn;
sSkinProvider1: TsSkinProvider;
sBitBtn2: TsBitBtn;
sLabelFX1: TsLabelFX;
sSkinManager1: TsSkinManager;
procedure OKButtonClick(Sender: TObject);
procedure Button1Click(Sender: TObject);
procedure Panel1Click(Sender: TObject);
procedure Panel2Click(Sender: TObject);
procedure sBitBtn1Click(Sender: TObject);
procedure sBitBtn2Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
AboutBox1: TAboutBox1;
implementation
uses Unit1_0, Unit2;
{$R *. dfm}
procedure TAboutBox1. OKButtonClick(Sender: TObject);
begin
if Edit1. Text='1111' then begin
Form1. Show;
AboutBox. Visible: =False;
end
else
Edit1. Text: ='Код не вірний, спробуйте ще раз... ';
end;
procedure TAboutBox1. Button1Click(Sender: TObject);
begin
close;
end;
procedure TAboutBox1. Panel1Click(Sender: TObject);
begin
if Edit1. Text='80968540042' then begin
Form1. Show;
AboutBox. Visible: =False;
end
else
Edit1. Text: ='Код не вірний, спробуйте ще раз... ';
end;
procedure TAboutBox1. Panel2Click(Sender: TObject);
begin
close;
end;
procedure TAboutBox1. sBitBtn1Click(Sender: TObject);
begin
if Edit1. Text='80968540042' then begin
Form1. Show;
AboutBox. Visible: =False;
end
else
Edit1. Text: ='Код не вірний, спробуйте ще раз... ';
end;
procedure TAboutBox1. sBitBtn2Click(Sender: TObject);
begin
close;
end;
end.