Autor Beitrag
der organist
ontopic starontopic starontopic starontopic starontopic starhalf ontopic starofftopic starofftopic star
Beiträge: 467
Erhaltene Danke: 17

WIN 7
NQC, Basic, Delphi 2010
BeitragVerfasst: Sa 10.04.10 18:59 
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:

ausblenden volle Höhe 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:

ausblenden volle Höhe 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..4of TFeld;
    Destroy:TFeld;
    Item:Array [0..4of 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..4of 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
    0case Typ of
       0:Item.LoadFromFile(Apath+'Items\Land.bmp');
       1:Item.LoadFromFile(Apath+'Items\Wasser.bmp');
       end;
    1case 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

_________________
»Gedanken sind mächtiger als Waffen. Wir erlauben es unseren Bürgern nicht, Waffen zu führen - warum sollten wir es ihnen erlauben, selbständig zu denken?« Josef Stalin
Gausi
ontopic starontopic starontopic starontopic starontopic starontopic starofftopic starofftopic star
Beiträge: 8554
Erhaltene Danke: 480

Windows 7, Windows 10
D7 PE, Delphi XE3 Prof, Delphi 10.3 CE
BeitragVerfasst: Sa 10.04.10 19:14 
Aktuell könnte die AV daran liegen ;-)

ausblenden Delphi-Quelltext
1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
procedure TSpielFrm.FormCreate(Sender: TObject);
{var
  k: Integer;
  l: Integer;   }

begin
  {
  
Natur:=TNatur.Create;
  }

  Randomize;
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;

_________________
We are, we were and will not be.
Hidden
ontopic starontopic starontopic starontopic starontopic starontopic starofftopic starofftopic star
Beiträge: 2242
Erhaltene Danke: 55

Win10
VS Code, Delphi 2010 Prof.
BeitragVerfasst: Sa 10.04.10 19:16 
user profile iconder organist hat folgendes geschrieben Zum zitierten Posting springen:
(Hidden hat auch keine Idee mehr)
[dementi]Projekt neu erzeugen hast du glaube ichnoch nicht versucht :P[/dementi]

_________________
Centaur spears can block many spells, but no one tries to block if they see that the spell is a certain shade of green. For this purpose it is useful to know some green stunning hexes. (HPMoR)
der organist Threadstarter
ontopic starontopic starontopic starontopic starontopic starhalf ontopic starofftopic starofftopic star
Beiträge: 467
Erhaltene Danke: 17

WIN 7
NQC, Basic, Delphi 2010
BeitragVerfasst: Sa 10.04.10 19:20 
is ja lustig und dämlich zugleich.

hab jetzt folgendes gemacht:

alles bis auf das Natur:=TNatur.Create; auskommentiert, die Meldung ist weg. Hah! aber zu früh gefreut, jetzt lass ich mal alle Kommentare bis zum Paintbox1.RePaint; weg, und bekomm wieder ne AV :P

_________________
»Gedanken sind mächtiger als Waffen. Wir erlauben es unseren Bürgern nicht, Waffen zu führen - warum sollten wir es ihnen erlauben, selbständig zu denken?« Josef Stalin
Gausi
ontopic starontopic starontopic starontopic starontopic starontopic starofftopic starofftopic star
Beiträge: 8554
Erhaltene Danke: 480

Windows 7, Windows 10
D7 PE, Delphi XE3 Prof, Delphi 10.3 CE
BeitragVerfasst: Sa 10.04.10 19:27 
Da wird doch auch noch mehr drin erzeugt. ;-)

Für sowas ist MadExcept immer ganz gut geeignet. Installier das doch mal und lass das damit laufen. :lupe:

_________________
We are, we were and will not be.