Entwickler-Ecke :: Thema anzeigen - Access violation ohne eigenes Zutun

der organist - Sa 10.04.10 18:59
Titel: Access violation ohne eigenes Zutun

Schönen Abend allerseits,

bin grad dabei, einiges an einem Projekt umzuändern, dabei ist folgendes passiert, was ich nich genau weiss :P. Ich hab
dann zur Fehlersuche die ganze Form-Create auskommentiert, und noch bevor die Form geöffnet ist, gibts ne Fehlermeldung

"Access violation at adress 'was weiss ich'. Read adress '000004'.

Quelltexte der beiden Units:

Delphi-Quelltext

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:
32:
33:
34:
35:
36:
37:
38:
39:
40:
41:
42:
43:
44:
45:
46:
47:
48:
49:
50:
51:
52:
53:
54:
55:
56:
57:
58:
59:
60:
61:
62:
63:
64:
65:
66:
67:
68:
69:
70:
71:
72:
73:
74:
75:
76:
77:
78:
79:
80:
81:
82:
83:
84:
85:
86:
87:
88:
89:
90:
91:
92:
93:
94:
95:
96:
97:
98:
99:
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:

unit UMain;

//-------------------------------------------------------//
//
//LoadFromFile

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ExtCtrls, UObjekte, StdCtrls,USpieler, ComCtrls;

type
  TSpielFrm = class(TForm)
    PaintBox1: TPaintBox;
    Label1: TLabel;
    Button1: TButton;
    Button2: TButton;
    Label2: TLabel;
    Label3: TLabel;
    Timer1: TTimer;
    procedure FormCreate(Sender: TObject);
    procedure PaintBox1Paint(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure PaintBox1MouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer);
    procedure PaintBox1MouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure LoadFromFile;
    procedure Button1Click(Sender: TObject);
  private
    Path: String;
    EckeX,EckeY,VisAreaX,VisAreaY,ActionsLeft,Zaeler:Integer;
    Map:TMap;
    Natur:TNatur;
    Spieler:TSpieler;
    Ranke:TRanke;
    Menu:TMenu;
    RectBar:TRectBar;
  end;

var
  SpielFrm: TSpielFrm;

implementation

{$R *.dfm}

procedure TSpielFrm.Button1Click(Sender: TObject);
begin
  Paintbox1.RePaint;
end;

procedure TSpielFrm.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  Natur.Free;
end;

procedure TSpielFrm.FormCreate(Sender: TObject);
{var
  k: Integer;
  l: Integer;   }
begin
  {Path:=ExtractFilePath(ParamStr(0));
  EckeX:=30;
  EckeY:=30;
  VisAreaX:=15;
  VisAreaY:=10;
  Natur:=TNatur.Create;
  SetLength(Map,30,15);
  self.LoadFromFile;
  Paintbox1.RePaint;}
  {Karte:=TKarte.Create(path,30,20,Paintbox1);
  Menu:=TMenu.Create(path);
  RectBar:=TRectBar.Create;
  EckeX:=Paintbox1.Left;
  EckeY:=Paintbox1.Top;
  Paintbox1.RePaint;
  ActionsLeft:=5;
  RectBar.ShowProgress(Paintbox1);   }
  Randomize;
end;

procedure TSpielFrm.LoadFromFile;
var TFFeld:TextFile;
    Line,Loaded:String;
    k,l,origLength: Integer;
begin
  try
    AssignFile(TFFeld, Path + '\Feld.txt');
    Reset(TFFeld);
    Loaded := '';
    ReadLn(TFFeld,Line);
    while NOT(Line='end.') do begin
      if Copy(Line,1,13)='FeldGroesseX=' then begin
        Loaded:=Copy(Line,14,Length(Line));
        if Length(Map)>0 then
          origLength:=Length(Map[0]);
        SetLength(Map,StrToInt(Loaded),origLength);
        Loaded:='';
        ReadLn(TFFeld,Line);
      end
      else if Copy(Line,1,13)='FeldGroesseY=' then begin
        Loaded:=Copy(Line,14,Length(Line));
        SetLength(Map,Length(Map),StrToInt(Loaded));
        Loaded:='';
        ReadLn(TFFeld,Line);
      end
      else if Copy(Line,1,5)='Natur' then begin
        for l := 0 to 29 do
          for k := 0 to 14 do begin
            if Line[k+1]='-' then begin
              Natur.AddFeld(k,l,0,Path,True,Map);
            end;                 
          ReadLn(TFFeld,Line);
        end;
      end;
      ReadLn(TFFeld,Line);
    end;
  finally
    CloseFile(TFFeld);
  end;
end;

procedure TSpielFrm.PaintBox1MouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
var ArrowFound,FeldFound,ChoiceFound:Boolean;
    ActChoice:TFeld;
    ActArrow:TArrow;
    ActFeld:TFeld;
begin
 {ActArrow:=Karte.GetArrow(X,Y,ArrowFound);
  if ArrowFound then begin
    Karte.MoveRange(ActArrow,Paintbox1);
  end;
  ActFeld:=Karte.GetFeld(X,Y,EckeX,EckeY,FeldFound);
  if FeldFound then
    Karte.Mark(EckeX,EckeY,Paintbox1,ActFeld)
  else Karte.LastMark.DeMark;
  ActChoice:=Menu.GetChoice(X,Y,Paintbox1,ChoiceFound);
  if ChoiceFound then begin
    Karte.Build(ActChoice,path,EckeX,EckeY,Paintbox1);
  end; }
end;

procedure TSpielFrm.PaintBox1MouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
  var FeldFound:Boolean;
begin
  {Label3.Caption:='Resourcen: '+IntToStr(Karte.Spieler.Money);
  Karte.GetFeld(X,Y,EckeX,EckeY,FeldFound);
  if FeldFound then begin
    Karte.Invert(EckeX,EckeY,Paintbox1,
                 Karte.GetFeld(X,Y,EckeX,EckeY,FeldFound));
    Label2.Caption:=IntToStr(Karte.GetFeld(X,Y,EckeX,EckeY,FeldFound).PosX)+
                    '/'+
                    IntToStr(Karte.GetFeld(X,Y,EckeX,EckeY,FeldFound).PosY);
  end
  else begin
    Karte.LastInvert.DeInvert;
    Label2.Caption:='X / Y';
  end;       }
end;

procedure TSpielFrm.PaintBox1Paint(Sender: TObject);
var
  k: Integer;
begin
  Natur.Paint(EckeX,EckeY,VisAreaX,VisAreaY,Paintbox1);
  {Karte.Paint(Paintbox1,EckeX,EckeY);
  Menu.Paint(Paintbox1);  }
end;

end.

folgendes sollte auch nicht ausgeführt werden, aber zur Vorsorge einmal her damit:

Delphi-Quelltext

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:
32:
33:
34:
35:
36:
37:
38:
39:
40:
41:
42:
43:
44:
45:
46:
47:
48:
49:
50:
51:
52:
53:
54:
55:
56:
57:
58:
59:
60:
61:
62:
63:
64:
65:
66:
67:
68:
69:
70:
71:
72:
73:
74:
75:
76:
77:
78:
79:
80:
81:
82:
83:
84:
85:
86:
87:
88:
89:
90:
91:
92:
93:
94:
95:
96:
97:
98:
99:
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:
333:
334:
335:
336:
337:
338:
339:
340:
341:
342:
343:
344:
345:
346:
347:
348:
349:
350:
351:
352:
353:
354:
355:
356:
357:
358:
359:
360:
361:
362:
363:
364:
365:
366:
367:
368:
369:
370:
371:
372:
373:
374:
375:
376:
377:
378:
379:
380:
381:
382:
383:
384:
385:
386:
387:
388:
389:
390:
391:
392:
393:
394:
395:
396:
397:
398:
399:
400:
401:
402:
403:
404:
405:
406:
407:
408:
409:
410:
411:
412:
413:
414:
415:
416:
417:
418:
419:
420:
421:
422:
423:
424:
425:
426:
427:
428:
429:
430:
431:
432:
433:
434:
435:
436:
437:
438:
439:
440:
441:
442:
443:
444:
445:
446:
447:
448:
449:
450:
451:
452:
453:
454:
455:
456:
457:
458:
459:
460:
461:
462:
463:
464:
465:
466:
467:
468:
469:
470:
471:
472:
473:
474:
475:
476:
477:
478:
479:
480:
481:
482:
483:
484:
485:
486:
487:
488:
489:
490:
491:
492:
493:
494:
495:
496:
497:
498:
499:
500:
501:
502:
503:
504:
505:
506:
507:
508:
509:
510:
511:
512:
513:
514:
515:
516:
517:
518:
519:
520:
521:
522:
523:
524:
525:
526:
527:
528:
529:
530:
531:
532:
533:
534:
535:
536:
537:
538:
539:

unit UObjekte;

interface

uses Graphics,ExtCtrls,Types,StdCtrls,SysUtils;

const
  right:Integer=0;
  up:Integer=1;
  left:Integer=2;
  down:Integer=3;
  clNormal:TColor=clWhite;
  clInvert:TColor=clWebOrange;
  clMarked:TColor=clRed;
  clAble:TColor=clBlack;
  clUnAble:TColor=clGray;

type
  TFeld=class
  private
    PosX, PosY, Typ, Owner, NewRange, Costs, Wague:Integer;
    Item:TBitMap;
  public
    constructor Create(APosX,APosY,AOwner,ATyp:Integer;
                       const Apath:String;AVisible:Boolean);
    procedure LoadItem(const APath:String);
    procedure Paint(AEckeX,AEckeY,AVisAreaX,AVisAreaY:Integer;
                    APaintbox:TPaintbox); overload;
    procedure Paint(AX,AY:Integer;
                    APaintbox:TPaintbox); overload;
    procedure Invert;
    procedure DeInvert;
    procedure Mark;
    procedure DeMark;
    procedure DeAble;
    procedure Able;
  end;
  TMap = Array of Array of TFeld;
  TNatur=class
    Feld: Array of TFeld;
    procedure Paint(AEckeX,AEckeY,AVisAreaX,AVisAreaY:Integer;
                       APaintbox:TPaintbox);
    procedure AddFeld(APosX,APosY,ATyp:Integer;const APath:String;
                      AVisible:Boolean;AMap:TMap);
    //procedure DeleteFeld;
  end;
  TRanke = class
    StartX,StartY: Integer;
    Blatt: Array of TFeld;
    {constructor Create(APaintbox:TPaintbox;
                       AEckeX,AEckeY:Integer);  }  //=> SetStartFeld
  end;
  TSpieler = class
    Money:Integer;
    ZentrumBuilt:Boolean;
    House:Array of TFeld;
    //constructor Create;

    {procedure ShowMessage(AID:Integer;ALabel:TLabel;
                          Info:Integer);
    procedure GetMoney;
    procedure Build(var AFeld,AChoice:TFeld;APath:String;AEckeX,AEckeY:Integer;
                    AVisArea:TRect;APaintbox:TPaintbox);   }
  end;
  TIndicator = class
    PosX,PosY:Integer;
    Item:TBitMap;
    constructor Create(path,ATyp:String;
                       APosX,APosY:Integer);
    procedure Paint(AEckeX,AEckeY:Integer;
                    APaintbox:TPaintbox;
                    const ACaption,ATyp:String);
  end;
  TArrow = class
  private
    PosX,PosY:Integer;
    Typ:Integer;
    Item:TBitMap;
  public
    constructor Create(path:String;ATyp:Integer);
    procedure Paint(APaintbox:TPaintbox;AEckeX,AEckeY:Integer);
    procedure MoveRange(var AVisArea:TRect);
  end;
  TMenu = class
    Actsubmenu:Integer;
    Menu:Array [0..4] of TFeld;
    Destroy:TFeld;
    Item:Array [0..4] of Array of TFeld;
    constructor Create(APath:String);
    procedure Paint(APaintbox:TPaintbox);
    function GetChoice(AX,AY:Integer;APaintbox:TPaintbox;
                       out AFound:Boolean):TFeld;
  end;
  TRectBar=class
    Rectangles:Array[0..4] of TRect;
    Actionsleft:Integer;
    GetMoney:Boolean;
    constructor Create;
    procedure ActualizeProgress(ARanke:TRanke;APaintbox:TPaintbox);
    procedure ShowProgress(APaintbox:TPaintbox);
    function ReFillMoney:Boolean;
  end;

implementation

uses
  Dialogs;

{$REGION 'TFeld'}

constructor TFeld.Create(APosX,APosY,AOwner,ATyp:Integer;
                         const Apath:String;AVisible:Boolean);
begin
  Owner:=AOwner;
  Typ:=ATyp;
  case Typ of
  0:NewRange:=3;
  1:NewRange:=4;
  2:NewRange:=5;
  3:NewRange:=2;
  4:NewRange:=2
  else
    NewRange:=1;
  end;
  PosX:=APosX;
  PosY:=APosY;
  Item:=TBitmap.Create;
  Item.Width:=30;
  Item.Height:=30;
  LoadItem(APath);
  Costs:=100;
end;
  
procedure TFeld.LoadItem(const APath:string);
begin
    case Owner of
    0: case Typ of
       0:Item.LoadFromFile(Apath+'Items\Land.bmp');
       1:Item.LoadFromFile(Apath+'Items\Wasser.bmp');
       end;
    1: case Typ of
           0:Item.LoadFromFile(Apath+'Items\Zentrum1.bmp');
           1:Item.LoadFromFile(Apath+'\Items\Zentrum2.bmp');
           2:Item.LoadFromFile(Apath+'\Items\Zentrum3.bmp');
           3:Item.LoadFromFile(Apath+'\Items\Manufaktur.bmp');
           4:Item.LoadFromFile(Apath+'\Items\Industrie.bmp');
           5:Item.LoadFromFile(Apath+'\Items\Kreuzung.bmp');
           6:Item.LoadFromFile(Apath+'\Items\TKreuzungLinks.bmp');
           7:Item.LoadFromFile(Apath+'\Items\TKreuzungOben.bmp');
           8:Item.LoadFromFile(Apath+'\Items\TKreuzungRechts.bmp');
           9:Item.LoadFromFile(Apath+'\Items\TKreuzungUnten.bmp');
           10:Item.LoadFromFile(Apath+'\Items\WegObenUnten.bmp');
           11:Item.LoadFromFile(Apath+'\Items\WegLinksRechts.bmp');
           12:Item.LoadFromFile(Apath+'\Items\WegObenLinks.bmp');
           13:Item.LoadFromFile(Apath+'\Items\WegRechtsOben.bmp');
           14:Item.LoadFromFile(Apath+'\Items\WegUntenRechts.bmp');
           15:Item.LoadFromFile(Apath+'\Items\WegLinksUnten.bmp');
           16:Item.LoadFromFile(Apath+'\Items\WegendeLinks.bmp');
           17:Item.LoadFromFile(Apath+'\Items\WegendeOben.bmp');
           18:Item.LoadFromFile(Apath+'\Items\WegendeRechts.bmp');
           19:Item.LoadFromFile(Apath+'\Items\WegendeUnten.bmp');
           20:Item.LoadFromFile(Apath+'\Items\Funkanlage.bmp');
           21:Item.LoadFromFile(Apath+'\Items\Wasser.bmp');
           22:Item.LoadFromFile(Apath+'\Items\BrückeObenUnten.bmp');
           23:Item.LoadFromFile(Apath+'\Items\BrückeLinksRechts.bmp');
           24:Item.LoadFromFile(Apath+'\Items\BrückeObenLinks.bmp');
           25:Item.LoadFromFile(Apath+'\Items\BrückeRechtsOben.bmp');
           26:Item.LoadFromFile(Apath+'\Items\BrückeUntenRechts.bmp');
           27:Item.LoadFromFile(Apath+'\Items\BrückeLinksUnten.bmp');
           28:Item.LoadFromFile(Apath+'\Items\Menu1.bmp');
           29:Item.LoadFromFile(Apath+'\Items\Menu2.bmp');
           30:Item.LoadFromFile(Apath+'\Items\Menu3.bmp');
           31:Item.LoadFromFile(Apath+'\Items\Menu4.bmp');
           32:Item.LoadFromFile(Apath+'\Items\Menu5.bmp');
           33:Item.LoadFromFile(Apath+'\Items\ZaunKreuzung.bmp');
           34:Item.LoadFromFile(Apath+'\Items\ZaunTKreuzungLinks.bmp');
           35:Item.LoadFromFile(Apath+'\Items\ZaunTKreuzungOben.bmp');
           36:Item.LoadFromFile(Apath+'\Items\ZaunTKreuzungRechts.bmp');
           37:Item.LoadFromFile(Apath+'\Items\ZaunTKreuzungUnten.bmp');
           38:Item.LoadFromFile(Apath+'\Items\ZaunObenUnten.bmp');
           39:Item.LoadFromFile(Apath+'\Items\ZaunLinksRechts.bmp');
           40:Item.LoadFromFile(Apath+'\Items\ZaunObenLinks.bmp');
           41:Item.LoadFromFile(Apath+'\Items\ZaunRechtsOben.bmp');
           42:Item.LoadFromFile(Apath+'\Items\ZaunUntenRechts.bmp');
           43:Item.LoadFromFile(Apath+'\Items\ZaunLinksUnten.bmp');
           44:Item.LoadFromFile(Apath+'\Items\ZaunendeLinks.bmp');
           45:Item.LoadFromFile(Apath+'\Items\ZaunendeOben.bmp');
           46:Item.LoadFromFile(Apath+'\Items\ZaunendeRechts.bmp');
           47:Item.LoadFromFile(Apath+'\Items\ZaunendeUnten.bmp');
           48:Item.LoadFromFile(Apath+'\Items\Abriss.bmp');
       end;                     
    2:;
    end;
end;
  
procedure TFeld.Paint(AEckeX,AEckeY,AVisAreaX,AVisAreaY:Integer;
                        APaintbox:TPaintBox);
begin
  APaintbox.Canvas.Draw(AEckeX+40+(PosX-AVisAreaX)*30,
                        AEckeY+40+(PosY-AVisAreaY)*30,
                        Item);
end;

procedure TFeld.Paint(AX,AY:Integer;APaintbox:TPaintbox);
begin
  APaintbox.Canvas.Draw(AX,AY,Item);
end;

procedure TFeld.Invert;
var
  k,l: Integer;
begin
  for k := 1 to 29 do
    for l := 1 to 29 do
      if Item.Canvas.Pixels[k,l]=clNormal then
        Item.Canvas.Pixels[k,l]:=clInvert;
end;
  
  procedure TFeld.DeInvert;
  var
    k,l:Integer;
  begin
    for k := 1 to 29 do
      for l := 1 to 29 do
        if Item.Canvas.Pixels[k,l]=clInvert then
          Item.Canvas.Pixels[k,l]:=clNormal;
  end;
  
  procedure TFeld.Mark;
  var
    k,l: Integer;
  begin
    for k := 1 to 29 do
      for l := 1 to 29 do
        if (Item.Canvas.Pixels[k,l]=clNormal)OR
           (Item.Canvas.Pixels[k,l]=clInvert) then
          Item.Canvas.Pixels[k,l]:=clMarked;
  end;
  
  procedure TFeld.DeMark;
  var
    k,l:Integer;
  begin
    for k := 1 to 29 do
      for l := 1 to 29 do
        if Item.Canvas.Pixels[k,l]=clMarked then
          Item.Canvas.Pixels[k,l]:=clNormal;
  end;
  
  procedure TFeld.Able;
  var k,l:Integer;
  begin
      for k := 1 to 29 do
      for l := 1 to 29 do
        if Item.Canvas.Pixels[k,l]=clUnAble then
          Item.Canvas.Pixels[k,l]:=clAble;
  end;
  
  procedure TFeld.DeAble;
  var k,l:Integer;
  begin
      for k := 1 to 29 do
      for l := 1 to 29 do
        if Item.Canvas.Pixels[k,l]=clAble then
          Item.Canvas.Pixels[k,l]:=clUnAble;
  end;
{$ENDREGION}

{$REGION 'TNatur'}

procedure TNatur.AddFeld(APosX,APosY,ATyp:Integer;const APath:String;
                         AVisible:Boolean;AMap:TMap);
var
  k: Integer;
begin
  SetLength(Feld,Length(Feld)+1);
  Feld[High(Feld)]:=TFeld.Create(APosX,APosY,0,ATyp,APath,AVisible);
  AMap[APosX,APosY]:=Feld[High(Feld)];
end;

procedure TNatur.Paint(AEckeX,AEckeY,AVisAreaX,AVisAreaY:Integer;
                       APaintbox:TPaintbox);
var
  k: Integer;
begin
  for k := 0 to High(Feld) do
    Feld[k].Paint(AEckeX,AEckeY,AVisAreaX,AVisAreaY,APaintbox);
end;

{$ENDREGION}

{$REGION 'TIndicator'}
  constructor TIndicator.Create(path,ATyp:String;
                                APosX,APosY: Integer);
  begin
    PosX:=APosX;
    PosY:=APosY;
    Item:=TBitMap.Create;
    Item.Width:=30;
    Item.Height:=30;
    if ATyp='X' then
      Item.LoadFromFile(path+'Items\IndicatorX.bmp')
    else if ATyp='Y' then
      Item.LoadFromFile(path+'Items\IndicatorY.bmp');
  end;
  
  procedure TIndicator.Paint(AEckeX,AEckeY:Integer;
                             APaintbox:TPaintBox;
                             const ACaption,ATyp:String);
  var Caption:String;
      Add:Integer;
  begin
    Add:=0;
    Caption:=ACaption;
    APaintbox.Canvas.Brush.Color:=clWhite;
    if ATyp='X' then begin
      if PosX=0 then
        Caption:='X';
      APaintbox.Canvas.Draw(AEckeX+10+PosX*30,
                            AEckeY-20,
                            Item);
      APaintbox.Canvas.TextOut(AEckeX+20+PosX*30,
                               AEckeY-19,
                               Caption);
    end
    else if ATyp='Y' then begin
      if PosY=0 then begin
        Caption:='Y';
        Add:=2;
      end
      else if (StrToInt(Caption))<10 then
        Add:=1
      else
        Add:=0;
  
      APaintbox.Canvas.Draw(AEckeX-20,
                            AEckeY+10+PosY*30,
                            Item);
      APaintbox.Canvas.TextOut(AEckeX-19+Add,
                               AEckeY+20+PosY*30,
                               Caption);
    end;
  end;
{$ENDREGION}

{$REGION 'TArrow'}

constructor TArrow.Create(path:String;ATyp:Integer);
  begin
    Typ:=ATyp;
    Item:=TBitMap.Create;
    Item.Width:=34;
    Item.Height:=32;
    case Typ of
    0:begin
      Item.LoadFromFile(path+'Items\PfeilRechts.bmp');
      PosX:=539;
      PosY:=219;
    end;
    1:begin
      Item.LoadFromFile(path+'Items\PfeilOben.bmp');
      PosX:=294;
      PosY:=47;
  
    end;
    2:begin
      Item.LoadFromFile(path+'Items\PfeilLinks.bmp');
      PosX:=48;
      PosY:=220;
    end;
    3:begin
      Item.LoadFromFile(path+'Items\PfeilUnten.bmp');
      PosX:=294;
      PosY:=387;
    end;
    end;
  end;
  
  procedure TArrow.Paint(APaintbox:TPaintbox;AEckeX,AEckeY:Integer);
  begin
    APaintbox.Canvas.Draw(PosX,PosY,Item);
  end;
  
  procedure TArrow.MoveRange(var AVisArea:TRect);
  var DeltaX,DeltaY:Integer;
  begin
    DeltaX:=0;
    DeltaY:=0;
    case Typ of
    0:DeltaX:=5;
    1:DeltaY:=-5;
    2:DeltaX:=-5;
    3:DeltaY:=5;
    end;
    inc(AVisArea.Left,DeltaX);
    inc(AVisArea.Right,DeltaX);
    inc(AVisArea.Top,DeltaY);
    inc(AVisArea.Bottom,DeltaY);
  end;
  
{$ENDREGION}

{$REGION 'TMenu'}

  constructor TMenu.Create(APath:String);
  var
    k: Integer;
  begin
    Actsubmenu:=0;
    for k := 0 to 4 do
      Menu[k]:=TFeld.Create(85+40*k,430,3,28+k,APath,True);
    SetLength(Item[0],5);
    SetLength(Item[1],16);
    SetLength(Item[2],7);
    SetLength(Item[3],15);
    SetLength(Item[4],1);
  
    for k := 0 to High(Item[0]) do begin
      Item[0,k]:=TFeld.Create(85+40*(k div 2),480+40*(k mod 2),
                              3,k,Apath,True);
    end;
    for k := 0 to High(Item[1]) do
      Item[1,k]:=TFeld.Create(85+40*(k div 2),480+40*(k mod 2),
                              6,5+k,Apath,True);
    for k := 0 to High(Item[2]) do
      Item[2,k]:=TFeld.Create(85+40*(k div 2),480+40*(k mod 2),
                              6,21+k,Apath,True);
    for k := 0 to High(Item[3]) do
      Item[3,k]:=TFeld.Create(85+40*(k div 2),480+40*(k mod 2),
                              6,33+k,Apath,True);
    for k := 0 to High(Item[4]) do
      Item[4,k]:=TFeld.Create(85+40*(k div 2),480+40*(k mod 2),
                              6,47+k,Apath,True);
  
    Destroy:=TFeld.Create(285,430,6,48,APath,True);
  end;
  
  procedure TMenu.Paint(APaintbox:TPaintbox);
  var
    k: Integer;
  begin
    APaintbox.Canvas.Pen.Color:=clWhite;
    APaintbox.Canvas.Rectangle(85,440,405,550);
    APaintbox.Canvas.Pen.Color:=clBlack;
    APaintbox.Canvas.Pen.Width:=2;
    APaintbox.Canvas.MoveTo(85,470);
    APaintbox.Canvas.LineTo(235,470);
    for k := 0 to 4 do
      Menu[k].Paint(Menu[k].PosX,Menu[k].PosY,APaintbox);
    Destroy.Paint(Destroy.PosX,Destroy.PosY,APaintbox);
    for k := 0 to High(Item[ActSubmenu]) do
      Item[ActSubmenu,k].Paint(Item[ActSubmenu,k].PosX,
                               Item[ActSubmenu,k].PosY,
                               APaintbox);
  end;
  
function TMenu.GetChoice(AX,Ay:Integer;APaintbox:TPaintbox;
                         out AFound:Boolean):TFeld;
var
  k: Integer;
begin
  Result:=nil;
  AFound:=false;
  for k := 0 to High(Menu) do
    if (Menu[k].PosX<AX)AND
       ((Menu[k].PosX+30)>AX)AND
       (Menu[k].PosY<AY)AND
       ((Menu[k].PosY+30)>AY) then begin
      ActSubMenu:=k;
      Paint(APaintbox);
    end;
  for k := 0 to High(Item[ActSubmenu]) do
    if (Item[ActSubmenu,k].PosX<AX)AND
       ((Item[ActSubmenu,k].PosX+30)>AX)AND
       (Item[ActSubmenu,k].PosY<AY)AND
       ((Item[ActSubmenu,k].PosY+30)>AY) then begin
      Result:=Item[ActSubmenu,k];
      AFound:=True;
    end;
  if (Destroy.PosX<AX)AND
     ((Destroy.PosX+30)>AX)AND
     (Destroy.PosY<AY)AND
     ((Destroy.PosY+30)>AY) then begin
    Result:=Destroy;
    AFound:=True;
  end;
end;

{$ENDREGION}

{$REGION 'TRectBar'}
  
constructor TRectBar.Create;
  var
    k: Integer;
  begin
    Actionsleft:=5;
    for k := 0 to 5 - 1 do begin
      Rectangles[k].Top:=490;
      Rectangles[k].Bottom:=505;
      Rectangles[k].Left:=448+k*20;
      Rectangles[k].Right:=463+k*20;
    end;
  end;

procedure TRectBar.ShowProgress(APaintbox:TPaintbox);
  var
    k: Integer;
  begin
    APaintbox.Canvas.Brush.Color:=clBlack;
    for k := 0 to ActionsLeft-1 do begin
      APaintbox.Canvas.Rectangle(Rectangles[k]);
    end;
    APaintbox.Canvas.Brush.Color:=clWhite;
    for k := ActionsLeft to High(Rectangles) do
      APaintbox.Canvas.Rectangle(Rectangles[k]);
  end;

procedure TRectBar.ActualizeProgress(ARanke:TRanke;APaintbox:TPaintBox);
  begin
    dec(ActionsLeft);
    if ActionsLeft=0 then begin
      ShowProgress(APaintbox);
      //Pflanzenzug
      //warten
      ActionsLeft:=5;
      GetMoney:=True;
    end;
    ShowProgress(APaintbox);
  end;

function TRectBar.ReFillMoney:Boolean;
  begin
    ReFillMoney:=GetMoney;
    GetMoney:=False;
  end;
{$ENDREGION}

end.

Bin am Verzweifeln (Hidden hat auch keine Idee mehr) ....danke fürs Helfen,

Gruss, Lukas

Entwickler-Ecke.de based on phpBB
Copyright 2002 - 2011 by Tino Teuber, Copyright 2011 - 2026 by Christian Stelzmann Alle Rechte vorbehalten.
Alle Beiträge stammen von dritten Personen und dürfen geltendes Recht nicht verletzen.
Entwickler-Ecke und die zugehörigen Webseiten distanzieren sich ausdrücklich von Fremdinhalten jeglicher Art!