Визуальное программирование. Lab4. Потоки

Задание: Добавить в одно из приложений, разработанных при выполнении 1-3 лабораторных работ, использование одной из следующих технологий:

Использование XML:
1. Портфельная обработка данных (технология briefcase).
2. Создание отчетов с использованием XSL (без использования компонент WebSnap).
Использование технологии OLAP (с использованием запросов MDX или запросов SELECT с предложением GROUP BY):
1. Использование компонент Decision Cube для анализа данных.
2. Использование Pivot Table Service для создания локальных кубов.
3. Использование компонента Pivot Table List для просмотра сводных таблиц.
4. Использование технологии ADO MD для просмотра OLAP-данных.
Многопоточное программирование:
1. Многопоточная обработка данных.
2. Многопоточное приложение MDI.
Интернационализация и локализация.
Использование MS Office для создания отчетов (Word или Excel).
Использование Rave Reports для создания отчетов:
1. Создание и использование проекта отчета (с использованием Direct Data View).
2. Использование компонент TRvNDRWriter, TRvNDRPreview и одного из компонент TRvRenderPDF, TRvRenderHTML, TRvRenderRTF.

Был выбран вариант 3.а.

Для переделки была выбрана первая лабораторная работа.

Текст программы:

unit Main;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, Menus,About,Begin_,ExtCtrls,SYNCOBJS;

  const S_GAME=0;const S_WIN=1; const S_LOSE=2; const S_NONE=3;
  const MAX=4;

type
  TMainfrm = class(TForm)
    MainMenu: TMainMenu;
    N1: TMenuItem;
    NewGamemi: TMenuItem;
    Exitmi: TMenuItem;
    N2: TMenuItem;
    About: TMenuItem;
    procedure AboutClick(Sender: TObject);
    procedure ExitmiClick(Sender: TObject);
    procedure NewGamemiClick(Sender: TObject);
    procedure FormPaint(Sender: TObject);
    procedure FormResize(Sender: TObject);
    procedure FormMouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure FormActivate(Sender: TObject);
    procedure FormKeyDown(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure FormMouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer);

  private
    { Private declarations }
  public
    { Public declarations }
  end;

  TCountSecondsThread=class(TThread)
    public
    protected
    procedure Execute; override;
  end;

  TThread2=class(TThread)
    protected
    procedure Execute;override;
  end;
var
  Mainfrm: TMainfrm;
  Situation: integer;
  Scene:array [1..MAX,1..MAX] of integer;
  Sector_SizeX:integer;
  Sector_SizeY:integer;
  FontSize:integer;
  StepCount:integer;
  Seconds:integer;
  mx,my:integer;
  e:TEvent;

  MySection:TCriticalSection;
  procedure SetMainfrmCaption();
  procedure DrawSector(n,m:integer);

implementation

procedure TCountSecondsThread.Execute;
begin
  repeat
    //Mainfrm.Canvas.TextOut(10,10,'П1');
    inc(Seconds,30);
    if (Seconds>250) then Seconds:=0;
    e.SetEvent();
    e.WaitFor(50);
  until  terminated
end;

procedure TThread2.Execute;

begin
  repeat
    e.WaitFor(10000);
   // Mainfrm.Canvas.TextOut(10,20,'П2');
    MySection.Enter;
    //Mainfrm.Canvas.Brush.Color:=RGB(0,Seconds,0);
    try 
      if (Mainfrm.Canvas.TryLock) Then
      begin
        Mainfrm.Canvas.Brush.Style:=bsClear;
        Mainfrm.Canvas.Pen.Color:=RGB(250-Seconds,250-Seconds,0);
        Mainfrm.Canvas.Font.Color:=RGB(250-Seconds,250-Seconds,0);
        DrawSector(mx,my);
        Mainfrm.Canvas.Refresh;
        Mainfrm.Canvas.Unlock;
      end;
    finally MySection.Leave;
    end;
    e.ResetEvent;
  until  terminated
end;

procedure SetMainfrmCaption();
var str1:string;
begin
  str1:='Игра 15. Ход: '+IntToStr(StepCount);
  Mainfrm.Caption:=str1;
end;

{$R *.dfm}
procedure MyMouseDown(X, Y: Integer);
var n,m,sx,sy:integer;

begin

  n:=Trunc(x / Sector_SizeX)+1;
  m:=Trunc(y/Sector_SizeY)+1;
  if (n>MAX) Then n:=MAX;
  if (m>MAX) Then m:=MAX;
  sx:=n; sy:=m;
  if (n>1) then

  begin
    if (Scene[n-1,m]=0) then   sx:=n-1;
  end;
  if (n<MAX) then
  begin
    if (scene[n+1,m]=0) then sx:=n+1;
  end;
  if (m>1) then
  begin
    if (Scene[n,m-1]=0) then   sy:=m-1;
  end;
  if (m<MAX) then
  begin
    if (scene[n,m+1]=0) then sy:=m+1;
  end;
  if ((sx=n) and (sy=m)) then
  else
  begin

    scene[sx,sy]:=scene[n,m];
    scene[n,m]:=0;
    Inc(StepCount);
    SetMainfrmCaption();
  end;

end;


procedure TMainfrm.AboutClick(Sender: TObject);
begin
       AboutBox.ShowModal
end;

procedure TMainfrm.ExitmiClick(Sender: TObject);
begin
  Mainfrm.Close 
end;

procedure TMainfrm.NewGamemiClick(Sender: TObject);
var n:integer;
begin

  For n:=1 to 1000 do
  begin
     MyMouseDown(Random(Mainfrm.ClientWidth-1),Random(Mainfrm.ClientHeight-1));
  end;
  StepCount:=0;
  SetMainfrmCaption();
  Mainfrm.Paint();
end;

procedure DrawSector(n,m:integer);
var str1:String;
begin

      Mainfrm.canvas.Rectangle((n-1)*Sector_SizeX,(m-1)*Sector_SizeY,(n-1)*Sector_SizeX+Sector_SizeX,(m-1)*Sector_SizeY+Sector_SizeY);
      str1:=IntToStr(Scene[n,m]);
      if (Scene[n,m]=0) then
         str1:=' ';
      Mainfrm.Canvas.TextOut((n-1)*Sector_SizeX+Round(Sector_SizeX/2)-Round(Mainfrm.Canvas.TextWidth(str1)/2 ),(m-1)*Sector_SizeY+Round(Sector_SizeY/2)-Round(Mainfrm.Canvas.TextHeight(str1)/2) ,str1);


end;

procedure TMainfrm.FormPaint(Sender: TObject);
var n,m:integer;
var  str1:string;
begin
  Mainfrm.Canvas.Pen.Color:=RGB(0,255,0);
  Mainfrm.Canvas.Font.Color:=RGB(0,255,0);
  Mainfrm.Canvas.Brush.Color:=RGB(0,0,0);
  for n:=1 to MAX do
  begin
    for m:=1 to MAX do
    begin
      //if (Scene[n,m]<>0) then Mainfrm.Canvas.Brush.Color:=RGB(0,255,0)
      //else Mainfrm.Canvas.Brush.Color:=RGB(255,255,255);
      DrawSector(n,m)
   end;
  end;
end;

procedure TMainfrm.FormResize(Sender: TObject);
//var n,m:integer;
begin
  Sector_sizeX:=Trunc((Mainfrm.ClientWidth)/ MAX) ;
  Sector_SizeY:=Trunc((Mainfrm.ClientHeight)/(MAX));
  if (Sector_SizeX<Sector_SizeY) then  FontSize:=Round(Sector_SizeX/2)
  else FontSize:=Round(Sector_SizeY/2);
  Mainfrm.Canvas.Font.Size :=Round(FontSize);
  Mainfrm.Paint;

end;


procedure TMainfrm.FormMouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
var n,m,k:integer;
    yes:boolean;
begin
   if (Situation=S_GAME) then    MyMouseDown(x,y);
   k:=0;
   yes:=TRUE;
   n:=1; 
   while (n<=MAX) do
   begin
   m:=1;
     while (m<=MAX) do
     begin
       k:=k+1;
       if (n=MAX) and (m=MAX) then break;
       if (scene[m,n]<>k) then yes:=FALSE;
       m:=m+1;
     end;
     n:=n+1;
   end;
   if (yes=TRUE ) then
   begin
     MessageBox(Mainfrm.ClientHandle,'ПОБЕДА!!! Первый раз вижу такого сообразительного человека!','ПОБЕДА',MB_OK);
     Situation:=S_WIN;
   end;
   Mainfrm.Paint;
end;

procedure TMainfrm.FormActivate(Sender: TObject);
var n,x,y:integer;
begin
  Beginfrm.ShowModal ;

  mx:=1; my:=1;
  MySection:= TCriticalSection.Create;
  TCountSecondsthread.Create(FALSE);
  TThread2.Create(FALSE);
  e:=TEvent.Create(NIL,TRUE,FALSE,'E1');
  Sector_sizeX:=Trunc((Mainfrm.ClientWidth)/ MAX) ;
  Sector_SizeY:=Trunc((Mainfrm.ClientHeight)/(MAX));
  randomize;
  Situation:=S_GAME;
  Mainfrm.Paint ;
  x:=-1; y:=-1;
  for n:=1 to 15 do
  begin

      x:=(x+1) mod (MAX);
      if (x=0)  then y:=(y+1) mod (MAX);

    scene[x+1,y+1]:=n;
  end;
 Mainfrm.NewGamemiClick(Mainfrm) ;
  Mainfrm.Paint ;
end;

procedure TMainfrm.FormKeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
var n,m:integer;
begin

  for n:=1 to MAX do
  begin
    for m:=1 to MAX do
    begin
      if (scene[n,m]=0) then break;
    end;
    if (m<=MAX) and (scene[n,m]=0) then break;
  end;
  case (Key) of
  VK_LEFT: begin
             if (n-1>=0) then
             MyMouseDown((n-2)*Sector_SizeX+1,(m-1)*Sector_SizeY+1);
            // mainfrm.Canvas.Rectangle((n-1)*Sector_SizeX,m*Sector_SizeY,(n-1)*Sector_SizeX+3,m*Sector_SizeY+3) ;
           end;
  VK_RIGHT: begin
            if (n+1<=MAX) then
             MyMouseDown((n)*Sector_SizeX+1,(m-1)*Sector_SizeY+1);

            end;
  VK_UP:    begin
            if (m-1>=0) then
             MyMouseDown((n-1)*Sector_SizeX+1,(m-2)*Sector_SizeY+1);
            end;
  VK_DOWN:  begin
             if (m+1<=MAX) then
             MyMouseDown((n-1)*Sector_SizeX+1,(m)*Sector_SizeY+1);
            end;

  end;
  Mainfrm.Paint;
end;


procedure TMainfrm.FormMouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
  var lx,ly:integer;
begin
  lx:=mx;
  ly:=my;
  mx:=Trunc(x/Sector_SizeX)+1;
  if (mx>MAX) Then mx:=MAX;
  my:=Trunc(y/Sector_SizeY)+1;
  if (my>MAX) Then my:=MAX;
  If (lx<>mx) or (ly<>my) Then
  begin
    Mainfrm.Canvas.Pen.Color:=RGB(0,255,0);
    Mainfrm.Canvas.Font.Color:=RGB(0,255,0);
    Mainfrm.Canvas.Brush.Color:=RGB(0,0,0);
    DrawSector(lx,ly)  ;
    Seconds:=0;
  end;
end;

end.

100

101

102

103

104

105

106

107

108

109

110

111

112

113

114

115

116

117

118

119

120

121

122

123

124

125

126

127

128

129

130

131

132

133

134

135

136

137

138

139

140

141

142

143

144

145

146

147

148

149

150

151

152

153

154

155

156

157

158

159

160

161

162

163

164

165

166

167

168

169

170

171

172

173

174

175

176

177

178

179

180

181

182

183

184

185

186

187

188

189

190

191

192

193

194

195

196

197

198

199

200

201

202

203

204

205

206

207

208

209

210

211

212

213

214

215

216

217

218

219

220

221

222

223

224

225

226

227

228

229

230

231

232

233

234

235

236

237

238

239

240

241

242

243

244

245

246

247

248

249

250

251

252

253

254

255

256

257

258

259

260

261

262

263

264

265

266

267

268

269

270

271

272

273

274

275

276

277

278

279

280

281

282

283

284

285

286

287

288

289

290

291

292

293

294

295

296

297

298

299

300

301

302

303

304

305

306

307

308

309

310

311

312

313

314

315

316

317

318

319

320

321

322

323

324

325

326

327

328

329

330

331

332

unit Main;

interface

uses

Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,

Dialogs, Menus,About,Begin_,ExtCtrls,SYNCOBJS;

const S_GAME=0;const S_WIN=1; const S_LOSE=2; const S_NONE=3;

const MAX=4;

type

TMainfrm = class(TForm)

MainMenu: TMainMenu;

N1: TMenuItem;

NewGamemi: TMenuItem;

Exitmi: TMenuItem;

N2: TMenuItem;

About: TMenuItem;

procedure AboutClick(Sender: TObject);

procedure ExitmiClick(Sender: TObject);

procedure NewGamemiClick(Sender: TObject);

procedure FormPaint(Sender: TObject);

procedure FormResize(Sender: TObject);

procedure FormMouseDown(Sender: TObject; Button: TMouseButton;

Shift: TShiftState; X, Y: Integer);

procedure FormActivate(Sender: TObject);

procedure FormKeyDown(Sender: TObject; var Key: Word;

Shift: TShiftState);

procedure FormMouseMove(Sender: TObject; Shift: TShiftState; X,

Y: Integer);

private

{ Private declarations }

public

{ Public declarations }

end;

TCountSecondsThread=class(TThread)

public

protected

procedure Execute; override;

end;

TThread2=class(TThread)

protected

procedure Execute;override;

end;

var

Mainfrm: TMainfrm;

Situation: integer;

Scene:array [1..MAX,1..MAX] of integer;

Sector_SizeX:integer;

Sector_SizeY:integer;

FontSize:integer;

StepCount:integer;

Seconds:integer;

mx,my:integer;

e:TEvent;

MySection:TCriticalSection;

procedure SetMainfrmCaption();

procedure DrawSector(n,m:integer);

implementation

procedure TCountSecondsThread.Execute;

begin

repeat

//Mainfrm.Canvas.TextOut(10,10,'П1');

inc(Seconds,30);

if (Seconds>250) then Seconds:=0;

e.SetEvent();

e.WaitFor(50);

until terminated

end;

procedure TThread2.Execute;

begin

repeat

e.WaitFor(10000);

// Mainfrm.Canvas.TextOut(10,20,'П2');

MySection.Enter;

//Mainfrm.Canvas.Brush.Color:=RGB(0,Seconds,0);

try

if (Mainfrm.Canvas.TryLock) Then

begin

Mainfrm.Canvas.Brush.Style:=bsClear;

Mainfrm.Canvas.Pen.Color:=RGB(250-Seconds,250-Seconds,0);

Mainfrm.Canvas.Font.Color:=RGB(250-Seconds,250-Seconds,0);

DrawSector(mx,my);

Mainfrm.Canvas.Refresh;

Mainfrm.Canvas.Unlock;

end;

finally MySection.Leave;

end;

e.ResetEvent;

until terminated

end;

procedure SetMainfrmCaption();

var str1:string;

begin

str1:='Игра 15. Ход: '+IntToStr(StepCount);

Mainfrm.Caption:=str1;

end;

{$R *.dfm}

procedure MyMouseDown(X, Y: Integer);

var n,m,sx,sy:integer;

begin

n:=Trunc(x / Sector_SizeX)+1;

m:=Trunc(y/Sector_SizeY)+1;

if (n>MAX) Then n:=MAX;

if (m>MAX) Then m:=MAX;

sx:=n; sy:=m;

if (n>1) then

begin

if (Scene[n-1,m]=0) then sx:=n-1;

end;

if (n<MAX) then

begin

if (scene[n+1,m]=0) then sx:=n+1;

end;

if (m>1) then

begin

if (Scene[n,m-1]=0) then sy:=m-1;

end;

if (m<MAX) then

begin

if (scene[n,m+1]=0) then sy:=m+1;

end;

if ((sx=n) and (sy=m)) then

else

begin

scene[sx,sy]:=scene[n,m];

scene[n,m]:=0;

Inc(StepCount);

SetMainfrmCaption();

end;

procedure TMainfrm.AboutClick(Sender: TObject);

begin

AboutBox.ShowModal

end;

procedure TMainfrm.ExitmiClick(Sender: TObject);

begin

Mainfrm.Close

end;

procedure TMainfrm.NewGamemiClick(Sender: TObject);

var n:integer;

begin

For n:=1 to 1000 do

begin

MyMouseDown(Random(Mainfrm.ClientWidth-1),Random(Mainfrm.ClientHeight-1));

end;

StepCount:=0;

SetMainfrmCaption();

Mainfrm.Paint();

end;

procedure DrawSector(n,m:integer);

var str1:String;

begin

Mainfrm.canvas.Rectangle((n-1)*Sector_SizeX,(m-1)*Sector_SizeY,(n-1)*Sector_SizeX+Sector_SizeX,(m-1)*Sector_SizeY+Sector_SizeY);

str1:=IntToStr(Scene[n,m]);

if (Scene[n,m]=0) then

str1:=' ';

Mainfrm.Canvas.TextOut((n-1)*Sector_SizeX+Round(Sector_SizeX/2)-Round(Mainfrm.Canvas.TextWidth(str1)/2 ),(m-1)*Sector_SizeY+Round(Sector_SizeY/2)-Round(Mainfrm.Canvas.TextHeight(str1)/2) ,str1);

end;

procedure TMainfrm.FormPaint(Sender: TObject);

var n,m:integer;

var str1:string;

begin

Mainfrm.Canvas.Pen.Color:=RGB(0,255,0);

Mainfrm.Canvas.Font.Color:=RGB(0,255,0);

Mainfrm.Canvas.Brush.Color:=RGB(0,0,0);

for n:=1 to MAX do

begin

for m:=1 to MAX do

begin

//if (Scene[n,m]<>0) then Mainfrm.Canvas.Brush.Color:=RGB(0,255,0)

//else Mainfrm.Canvas.Brush.Color:=RGB(255,255,255);

DrawSector(n,m)

end;

procedure TMainfrm.FormResize(Sender: TObject);

//var n,m:integer;

begin

Sector_sizeX:=Trunc((Mainfrm.ClientWidth)/ MAX) ;

Sector_SizeY:=Trunc((Mainfrm.ClientHeight)/(MAX));

if (Sector_SizeX<Sector_SizeY) then FontSize:=Round(Sector_SizeX/2)

else FontSize:=Round(Sector_SizeY/2);

Mainfrm.Canvas.Font.Size :=Round(FontSize);

Mainfrm.Paint;

end;

procedure TMainfrm.FormMouseDown(Sender: TObject; Button: TMouseButton;

Shift: TShiftState; X, Y: Integer);

var n,m,k:integer;

yes:boolean;

begin

if (Situation=S_GAME) then MyMouseDown(x,y);

k:=0;

yes:=TRUE;

n:=1;

while (n<=MAX) do

begin

m:=1;

while (m<=MAX) do

begin

k:=k+1;

if (n=MAX) and (m=MAX) then break;

if (scene[m,n]<>k) then yes:=FALSE;

m:=m+1;

end;

n:=n+1;

end;

if (yes=TRUE ) then

begin

MessageBox(Mainfrm.ClientHandle,'ПОБЕДА!!! Первый раз вижу такого сообразительного человека!','ПОБЕДА',MB_OK);

Situation:=S_WIN;

end;

Mainfrm.Paint;

end;

procedure TMainfrm.FormActivate(Sender: TObject);

var n,x,y:integer;

begin

Beginfrm.ShowModal ;

mx:=1; my:=1;

MySection:= TCriticalSection.Create;

TCountSecondsthread.Create(FALSE);

TThread2.Create(FALSE);

e:=TEvent.Create(NIL,TRUE,FALSE,'E1');

Sector_sizeX:=Trunc((Mainfrm.ClientWidth)/ MAX) ;

Sector_SizeY:=Trunc((Mainfrm.ClientHeight)/(MAX));

randomize;

Situation:=S_GAME;

Mainfrm.Paint ;

x:=-1; y:=-1;

for n:=1 to 15 do

begin

x:=(x+1) mod (MAX);

if (x=0) then y:=(y+1) mod (MAX);

scene[x+1,y+1]:=n;

end;

Mainfrm.NewGamemiClick(Mainfrm) ;

Mainfrm.Paint ;

end;

procedure TMainfrm.FormKeyDown(Sender: TObject; var Key: Word;

Shift: TShiftState);

var n,m:integer;

begin

for n:=1 to MAX do

begin

for m:=1 to MAX do

begin

if (scene[n,m]=0) then break;

end;

if (m<=MAX) and (scene[n,m]=0) then break;

end;

case (Key) of

VK_LEFT: begin

if (n-1>=0) then

MyMouseDown((n-2)*Sector_SizeX+1,(m-1)*Sector_SizeY+1);

// mainfrm.Canvas.Rectangle((n-1)*Sector_SizeX,m*Sector_SizeY,(n-1)*Sector_SizeX+3,m*Sector_SizeY+3) ;

end;

VK_RIGHT: begin

if (n+1<=MAX) then

MyMouseDown((n)*Sector_SizeX+1,(m-1)*Sector_SizeY+1);

end;

VK_UP: begin

if (m-1>=0) then

MyMouseDown((n-1)*Sector_SizeX+1,(m-2)*Sector_SizeY+1);

end;

VK_DOWN: begin

if (m+1<=MAX) then

MyMouseDown((n-1)*Sector_SizeX+1,(m)*Sector_SizeY+1);

end;

Mainfrm.Paint;

end;

procedure TMainfrm.FormMouseMove(Sender: TObject; Shift: TShiftState; X,

Y: Integer);

var lx,ly:integer;

begin

lx:=mx;

ly:=my;

mx:=Trunc(x/Sector_SizeX)+1;

if (mx>MAX) Then mx:=MAX;

my:=Trunc(y/Sector_SizeY)+1;

if (my>MAX) Then my:=MAX;

If (lx<>mx) or (ly<>my) Then

begin

Mainfrm.Canvas.Pen.Color:=RGB(0,255,0);

Mainfrm.Canvas.Font.Color:=RGB(0,255,0);

Mainfrm.Canvas.Brush.Color:=RGB(0,0,0);

DrawSector(lx,ly) ;

Seconds:=0;

end;

end.

Вывод: Были изучены возможности многопоточного программирования в Delphi 7.

Архив с исходными кодами к лабораторной работе № 4 по визуальному программированию

Октябрь 2015
Пн	Вт	Ср	Чт	Пт	Сб	Вс
			1	2	3	4
5	6	7	8	9	10	11
12	13	14	15	16	17	18
19	20	21	22	23	24	25
26	27	28	29	30	31

Добавить комментарий Отменить ответ