Новичок
Профиль
Группа: Участник
Сообщений: 2
Регистрация: 8.5.2012
Репутация: нет
Всего: нет
|
| Код |
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, Menus, StdCtrls, ExtCtrls, CheckLst, ComCtrls, ImgList, ToolWin;
type
TForm1 = class(TForm)
MainMenu1: TMainMenu;
File1: TMenuItem;
Open1: TMenuItem;
Save1: TMenuItem;
Exit1: TMenuItem;
OpenDialog1: TOpenDialog;
SaveDialog1: TSaveDialog;
Button1: TButton;
Button2: TButton;
Button3: TButton;
Button4: TButton;
RadioGroup1: TRadioGroup;
RadioGroup2: TRadioGroup;
RadioGroup3: TRadioGroup;
CheckListBox1: TCheckListBox;
RichEdit1: TRichEdit;
Edit1: TEdit;
Label1: TLabel;
N1: TMenuItem;
N2: TMenuItem;
N3: TMenuItem;
N4: TMenuItem;
N5: TMenuItem;
Dbhspfnb1: TMenuItem;
N6: TMenuItem;
N7: TMenuItem;
N8: TMenuItem;
N9: TMenuItem;
FontDialog1: TFontDialog;
N10: TMenuItem;
N11: TMenuItem;
N12: TMenuItem;
N13: TMenuItem;
N15: TMenuItem;
procedure RadioGroup1Click(Sender: TObject);
procedure RadioGroup2Click(Sender: TObject);
procedure RadioGroup3Click(Sender: TObject);
procedure CheckListBox1Click(Sender: TObject);
procedure Open1Click(Sender: TObject);
procedure Save1Click(Sender: TObject);
procedure Exit1Click(Sender: TObject);
procedure Close1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
procedure Button1Click(Sender: TObject);
procedure N1Click(Sender: TObject);
procedure N2Click(Sender: TObject);
procedure N4Click(Sender: TObject);
procedure N5Click(Sender: TObject);
procedure Dbhspfnb1Click(Sender: TObject);
procedure N6Click(Sender: TObject);
procedure N7Click(Sender: TObject);
procedure N9Click(Sender: TObject);
procedure N8Click(Sender: TObject);
procedure N10Click(Sender: TObject);
procedure N12Click(Sender: TObject);
procedure N13Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
t:TStringlist;
implementation
uses Unit2;
{$R *.dfm}
procedure TForm1.RadioGroup1Click(Sender: TObject);
begin
if RadioGroup1.ItemIndex=0
then RichEdit1.Font.Style:=[ ];
if RadioGroup1.ItemIndex=1
then RichEdit1.Font.Style:=[fsItalic ];
if RadioGroup1.ItemIndex=2
then RichEdit1.Font.Style:=[fsBold ];
if RadioGroup1.ItemIndex=3
then RichEdit1.Font.Style:=[fsItalic,fsBold ];
CheckListBox1Click(Self)
end;
procedure TForm1.RadioGroup2Click(Sender: TObject);
begin
if RadioGroup2.ItemIndex = 0
then RichEdit1.Font.Size :=8;
if RadioGroup2.ItemIndex = 1
then RichEdit1.Font.Size :=10;
if RadioGroup2.ItemIndex = 2
then RichEdit1.Font.Size :=12;
if RadioGroup2.ItemIndex = 3
then RichEdit1.Font.Size :=14;
end;
procedure TForm1.RadioGroup3Click(Sender: TObject);
begin
If RadioGroup3.ItemIndex = 0
then RichEdit1.Font.Color :=clBlack;
If RadioGroup3.ItemIndex = 1
then RichEdit1.Font.Color :=clGreen;
If RadioGroup3.ItemIndex = 2
then RichEdit1.Font.Color :=clRed;
If RadioGroup3.ItemIndex = 3
then RichEdit1.Font.Color :=clBlue;
end;
procedure TForm1.CheckListBox1Click(Sender: TObject);
begin
if CheckListBox1.Checked[0]
then RichEdit1.Font.Style :=RichEdit1.Font.Style + [fsStrikeOut]
else RichEdit1.Font.Style :=RichEdit1.Font.Style - [fsStrikeOut];
if CheckListBox1.Checked[1]
then RichEdit1.Font.Style :=RichEdit1.Font.Style + [fsUnderline]
else RichEdit1.Font.Style :=RichEdit1.Font.Style - [fsUnderline];
end;
procedure TForm1.Open1Click(Sender: TObject);
begin
if OpenDialog1.Execute then
RichEdit1.Lines.LoadFromFile(OpenDialog1.FileName);
end;
procedure TForm1.Save1Click(Sender: TObject);
begin
if SaveDialog1.Execute then
RichEdit1.Lines.SaveToFile(SaveDialog1.FileName);
end;
procedure TForm1.Exit1Click(Sender: TObject);
begin
Close;
end;
procedure TForm1.Close1Click(Sender: TObject);
begin
RichEdit1.Clear;
end;
procedure TForm1.Button2Click(Sender: TObject);
const
D = ['.', ',', ':', ';', '!', '?', '-', ' ', #9, #10, #13];
var
S, sW, sWord : String;
i, p1, Len, LenW : Integer;
begin
sWord := AnsiUpperCase(Edit1.Text);
S := RichEdit1.Text;
Len := Length(S);
p1 := 0;
for i := 1 to Len do begin
if S[i] in D then Continue;
if (i = 1) or (S[i - 1] in D) then p1 := i;
if (i = Len) or (S[i + 1] in D) then begin
LenW := i - p1 + 1;
sW := AnsiUpperCase( Copy(S, p1, LenW) );
if sW = sWord then begin
RichEdit1.SelStart := p1 - 1;
RichEdit1.SelLength := LenW;
RichEdit1.SelAttributes.Style := RichEdit1.SelAttributes.Style + [fsBold];
RichEdit1.SelAttributes.Color := RGB(200, 0, 0);
Edit1.Clear ;
end ;
end;
end;
end;
procedure TForm1.Button1Click(Sender: TObject);
const bk=['À'..'ÿ','¨','¸'];
var s,s1:string;
i,j,k:integer;
begin
t:=TStringlist.Create; //ñîçäàåì ýêçåìïëÿð êëàññà
t.Sorted:=true; //ïîäêëþ÷àåì ñîðòèðîâêó ïðè äîáàâëåíèè
for i:=0 to RichEdit1.Lines.Count-1 do
begin
s:=RichEdit1.Lines.Strings[i];//ïðîñìàòðèâàåì ñòðîêè
j:=1;
while(j<=length(s)) do //âûáèðàåì òîëüêî ñëîâà èç áóêâ
if (s[j] in bk) and((j=1)or not(s[j-1] in bk)) then
begin
k:=j;
s1:='';
while(k<=length(s))and(s[k] in bk) do
begin
s1:=s1+s[k];
k:=k+1;
end;
t.Add(s1);
j:=j+length(s1);
end
else j:=j+1;
end;
RichEdit1.Clear;
RichEdit1.ScrollBars:=ssVertical;//âêëþ÷èì âåðòèêàëüíóþ ïðîêðóòêó
for i:=0 to t.Count-1 do
RichEdit1.Lines.Add(t.Strings[i]);//âûâåäåì ñëîâà
end;
procedure TForm1.N1Click(Sender: TObject);
var mes: integer;
begin
if RichEdit1.Modified = true then
begin
mes := MessageDlg ('Âû õîòèòå ñîõðàíèòü äîêóìåíò?', mtConfirmation, [mbYes, mbNo, mbCancel], 0);
if mes = mrYes then
begin
Save1Click (Sender);
RichEdit1.Clear;
end;
if mes = mrNo then
RichEdit1.Clear;
end else
RichEdit1.Clear;
end;
procedure TForm1.N2Click(Sender: TObject);
begin
Form2.Visible:=true;
end;
procedure TForm1.N4Click(Sender: TObject);
begin
RichEdit1.Undo;
end;
procedure TForm1.N5Click(Sender: TObject);
begin
RichEdit1.SelectAll;
end;
procedure TForm1.Dbhspfnb1Click(Sender: TObject);
begin
RichEdit1.CutToClipboard;
end;
procedure TForm1.N6Click(Sender: TObject);
begin
RichEdit1.CopyToClipboard;
end;
procedure TForm1.N7Click(Sender: TObject);
begin
RichEdit1.ClearSelection;
end;
procedure TForm1.N9Click(Sender: TObject);
begin
RichEdit1.PasteFromClipboard;
end;
procedure TForm1.N8Click(Sender: TObject);
begin
RichEdit1.Clear;
end;
procedure TForm1.N10Click(Sender: TObject);
begin
if FontDialog1.Execute then
RichEdit1.SelAttributes.Assign (FontDialog1.Font);
end;
procedure TForm1.N12Click(Sender: TObject);
begin
RichEdit1.Lines.Add (DateToStr (Date));
end;
procedure TForm1.N13Click(Sender: TObject);
begin
RichEdit1.Lines.Add (TimeToStr (Time));
end;
end.
|
я как последняя дура сделала простой блокнот Добавлено через 1 минуту и 40 секундхотя ужн имееться и такая задача....немного пошарилась по инету и вуаля | Код |
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, ComCtrls;
type
TForm1 = class(TForm)
Label1: TLabel;
Label2: TLabel;
Label3: TLabel;
Edit1: TEdit;
Edit2: TEdit;
Button1: TButton;
OpenDialog1: TOpenDialog;
Button2: TButton;
SaveDialog1: TSaveDialog;
RichEdit1: TRichEdit;
Button3: TButton;
Label4: TLabel;
Edit3: TEdit;
Button4: TButton;
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
procedure Button3Click(Sender: TObject);
procedure Button4Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
type
//Óêàçàòåëü íà ýëåìåíò î÷åðåäè.
TPElem = ^TElem;
//Ýëåìåíò î÷åðåäè.
TElem = record
Data : Integer;
PNext : TPElem;
end;
//Î÷åðåäü.
TQueue = record
PFirst, PLast : TPElem;
end;
//Äîáàâëåíèå ýëåìåíòà â êîíåö î÷åðåäè.
procedure QueuePush(var aQueue : TQueue; var aPElem : TPElem);
begin
if aPElem = nil then Exit;
aPElem^.PNext := nil;
if aQueue.PFirst = nil then
aQueue.PFirst := aPElem
else
aQueue.PLast^.PNext := aPElem
;
aQueue.PLast := aPElem;
end;
//Èçúÿòèå ýëåìåíòà èç íà÷àëà î÷åðåäè.
function QueuePop(var aQueue : TQueue; var aPElem : TPElem) : Boolean;
begin
Result := False;
if aQueue.PFirst = nil then Exit;
aPElem := aQueue.PFirst;
aQueue.PFirst := aPElem^.PNext;
if aQueue.PFirst = nil then aQueue.PLast := nil;
Result := True;
end;
//Óäàëåíèå î÷åðåäè èç ïàìÿòè (î÷èñòêà î÷åðåäè).
procedure QueueFree(var aQueue : TQueue);
var
PDel : TPElem;
begin
while QueuePop(aQueue, PDel) do Dispose(PDel);
end;
procedure TForm1.Button1Click(Sender: TObject);
var
F : TextFile;
Q1, Q2 : TQueue;
PElem : TPElem;
i, Ind, Num : Integer;
Fl : Boolean;
S : String;
Od : TOpenDialog;
begin
Od := OpenDialog1;
if Od.InitialDir = '' then
Od.InitialDir := ExtractFilePath( ParamStr(0) )
;
if not Od.Execute then Exit;
RichEdit1.Lines.Add('--------------------------------------------------');
RichEdit1.Lines.Add('Ôàéë: "' + Od.FileName + '"');
if not FileExists(Od.FileName) then begin
RichEdit1.Lines.Add(
'Ôàéë ñ çàäàííûì èìåíåì íå íàéäåí. Äåéñòâèå îòìåíåíî.'
);
Exit;
end;
//Èíèöèàëèçàöèÿ î÷åðåäåé.
Q1.PFirst := nil;
Q1.PLast := nil;
Q2.PFirst := nil;
Q2.PLast := nil;
//×èòåì ýëåìåíòû èç ôàéëà è çàïèñûâàåì èõ â ïåðâóþ î÷åðåäü.
AssignFile(F, Od.FileName);
Reset(F);
while not Eof(F) do begin
Readln(F, S);
if S = '' then Continue; //Åñëè ñòðîêà ïóñòàÿ - ïðîïóñêàåì èòåðàöèþ.
New(PElem);
PElem^.Data := StrToInt(S);
QueuePush(Q1, PElem);
end;
//Çàêðûâàåì ôàéë.
CloseFile(F);
//Åñëè â ôàéëå íåò ñâåäåíèé - âûõîäèì.
if Q1.PFirst = nil then begin
RichEdit1.Lines.Add('Ôàéë ïóñò. Äåéñòâèå îòìåíåíî.');
Exit;
end;
//Ðàñïå÷àòêà î÷åðåäè.
RichEdit1.Lines.Add('Èñõîäíàÿ î÷åðåäü:');
//Ïåðåëèâàåì ýëåìåíòû èç ïåðâîé î÷åðåäè âî âòîðóþ è ñîçäà¸ì ñòðîêó äëÿ ðàñïå÷àòêè.
i := 0;
S := '';
while QueuePop(Q1, PElem) do begin
QueuePush(Q2, PElem);
Inc(i);
if i > 1 then S := S + ', ';
S := S + IntToStr(i) + ':' + IntToStr(PElem^.Data); //Èíäåêñ:Çíà÷åíèå.
end;
//Ðàñïå÷àòêà â Ìåìî.
RichEdit1.Lines.Add(S);
//Âîçâðàùàåì ýëåìåíòû îáðàòíî - èç âòîðîé î÷åðåäè â ïåðâóþ.
while QueuePop(Q2, PElem) do QueuePush(Q1, PElem);
//Ñâåäåíèÿ î âñòàâêå íîâîãî ýëåìåíòà.
Ind := StrToInt(Edit1.Text);
RichEdit1.Lines.Add(
'Èíäåêñ ýëåìåíòà, ïîñëå êîòîðîãî íàäî âñòàâèòü íîâûé ýëåìåíò: '
+ Edit1.Text
);
Num := StrToInt(Edit2.Text);
RichEdit1.Lines.Add('Çíà÷åíèå íîâîãî ýëåìåíòà: ' + Edit2.Text);
//Ïåðåëèâàåì ýëåìåíòû èç ïåðâîé î÷åðåäè âî âòîðóþ. Ïðè ýòîì, ïîñëå ýëåìåíòà
//ñ èíäåêñîì Ind äîáàâëÿåì íîâûé ýëåìåíò.
i := 0;
Fl := False;
while QueuePop(Q1, PElem) do begin
QueuePush(Q2, PElem);
Inc(i);
if i = Ind then begin
New(PElem);
PElem^.Data := Num;
QueuePush(Q2, PElem);
Fl := True;
end;
end;
//Âîçâðàùàåì ýëåìåíòû îáðàòíî - èç âòîðîé î÷åðåäè â ïåðâóþ.
while QueuePop(Q2, PElem) do QueuePush(Q1, PElem);
//Îò÷¸ò î çàïèñè íîâîãî ýëåìåíòà.
if Fl then begin
RichEdit1.Lines.Add(
'Ïîñëå ýëåìåíòà ñ èíäåêñîì ' + IntToStr(Ind)
+ ' âñòàâëåí íîâûé ýëåìåíò.'
+ #13#10'Î÷åðåäü ïîñëå âñòàâêè ýëåìåíòà:'
);
i := 0;
S := '';
while QueuePop(Q1, PElem) do begin
Inc(i);
if i > 1 then S := S + ', ';
S := S + IntToStr(i) + ':' + IntToStr(PElem^.Data); //Èíäåêñ:Çíà÷åíèå.
Dispose(PElem); //Óäàëåíèå ýëåìåíòà èç ïàìÿòè.
end;
RichEdit1.Lines.Add(S);
end else
RichEdit1.Lines.Add(' î÷åðåäè íåò ýëåìåíòà ñ èíäåêñîì ' + IntToStr(Ind))
;
//Óäàëåíèå î÷åðåäåé èç ïàìÿòè.
// QueueFree(Q1);
// QueueFree(Q2);
end;
procedure TForm1.Button2Click(Sender: TObject);
begin
if SaveDialog1.Execute then
RichEdit1.Lines.SaveToFile(SaveDialog1.FileName);
end;
procedure TForm1.Button3Click(Sender: TObject);
begin
Form1.Close;
end;
procedure TForm1.Button4Click(Sender: TObject);
const
D = ['.', ',', ':', ';', '!', '?', '-', ' ', #9, #10, #13];
var
H, sW, sWord : String;
i, p1, Len, LenW : Integer;
begin
sWord := AnsiUpperCase(Edit3.Text);
H := RichEdit1.Text;
Len := Length(H);
p1 := 0;
for i := 1 to Len do begin
if H[i] in D then Continue;
if (i = 1) or (H[i - 1] in D) then p1 := i;
if (i = Len) or (H[i + 1] in D) then begin
LenW := i - p1 + 1;
sW := AnsiUpperCase( Copy(H, p1, LenW) );
if sW = sWord then begin
RichEdit1.SelStart := p1 - 1;
RichEdit1.SelLength := LenW;
RichEdit1.SelAttributes.Style := RichEdit1.SelAttributes.Style + [fsBold];
RichEdit1.SelAttributes.Color := RGB(200, 0, 0);
Edit3.Clear ;
end ;
end;
end;
end;
end.
|
хотя она не делает то что мне нужно но не могу сообразить как её переделать.. |
[Delphi] очереди на делфи 
Загрузка ...
