Changeset 49
- Timestamp:
- Aug 22, 2019, 9:50:21 AM (5 years ago)
- Location:
- branches/paintbox
- Files:
-
- 3 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/paintbox/Forms/UMainForm.lfm
r47 r49 47 47 SimplePanel = False 48 48 end 49 object Image1: TImage49 object PaintBox1: TPaintBox 50 50 Left = 0 51 51 Height = 462 … … 53 53 Width = 642 54 54 Align = alClient 55 On MouseLeave = Image1MouseLeave56 OnResize = Image1Resize55 OnPaint = PaintBox1Paint 56 OnResize = PaintBox1Resize 57 57 end 58 58 object TimerDraw: TTimer -
branches/paintbox/Forms/UMainForm.pas
r47 r49 23 23 AFullScreen: TAction; 24 24 ActionList1: TActionList; 25 Image1: TImage;26 25 MainMenu1: TMainMenu; 27 26 MenuItem1: TMenuItem; … … 33 32 MenuItem7: TMenuItem; 34 33 MenuItem8: TMenuItem; 34 PaintBox1: TPaintBox; 35 35 StatusBar1: TStatusBar; 36 36 TimerDraw: TTimer; … … 50 50 procedure FormKeyUp(Sender: TObject; var Key: Word; Shift: TShiftState); 51 51 procedure FormShow(Sender: TObject); 52 procedure Image1MouseLeave(Sender: TObject);53 procedure Image1Resize(Sender: TObject);52 procedure PaintBox1Paint(Sender: TObject); 53 procedure PaintBox1Resize(Sender: TObject); 54 54 procedure TimerDrawTimer(Sender: TObject); 55 55 procedure TimerEngineTickTimer(Sender: TObject); … … 62 62 procedure LoadConfig; 63 63 procedure SaveConfig; 64 procedure EngineRepaint(Sender: TObject); 64 65 public 65 66 PersistentForm: TPersistentForm; … … 125 126 end; 126 127 128 procedure TMainForm.EngineRepaint(Sender: TObject); 129 begin 130 PaintBox1.Repaint; 131 end; 132 127 133 procedure TMainForm.EraseBackground(DC: HDC); 128 134 begin … … 142 148 DoubleBuffered := False; 143 149 Engine := TEngine.Create; 144 Engine. Bitmap := Image1.Picture.Bitmap;150 Engine.OnRepaint := EngineRepaint; 145 151 Core.CoolTranslator1.Language := Core.CoolTranslator1.Languages.SearchByCode('cs'); 146 152 LoadConfig; 147 153 Engine.NewGame; 148 154 Engine.Active := True; 149 Image1Resize(Self); 150 Image1.ControlStyle := Image1.ControlStyle + [csOpaque]; 155 PaintBox1Resize(Self); 156 ControlStyle := ControlStyle + [csOpaque]; 157 PaintBox1.ControlStyle := PaintBox1.ControlStyle + [csOpaque]; 151 158 end; 152 159 … … 205 212 procedure TMainForm.AShowRawImageDescExecute(Sender: TObject); 206 213 begin 207 ShowMessage( Image1.Picture.Bitmap.RawImage.Description.AsString);214 ShowMessage(Engine.Bitmap.RawImage.Description.AsString); 208 215 end; 209 216 … … 244 251 end; 245 252 246 procedure TMainForm. Image1MouseLeave(Sender: TObject);247 begin 248 249 end; 250 251 procedure TMainForm. Image1Resize(Sender: TObject);253 procedure TMainForm.PaintBox1Paint(Sender: TObject); 254 begin 255 PaintBox1.Canvas.StretchDraw(Rect(0, 0, PaintBox1.Width, PaintBox1.Height), Engine.Bitmap); 256 end; 257 258 procedure TMainForm.PaintBox1Resize(Sender: TObject); 252 259 begin 253 260 try 254 261 Engine.Lock.Acquire; 255 Image1.Picture.Bitmap.SetSize(Image1.Width, Image1.Height);262 Engine.Bitmap.SetSize(PaintBox1.Width, PaintBox1.Height); 256 263 Engine.ResizePlayerFrames; 257 264 finally -
branches/paintbox/UEngine.pas
r45 r49 219 219 FBitmapLock: TCriticalSection; 220 220 FOnGameEnd: TNotifyEvent; 221 FOnRepaint: TNotifyEvent; 221 222 FRedrawPending: Boolean; 222 223 FBitmapLower: TBitmapTColor; … … 230 231 function IsInsideHouses(Pos: TPoint): Boolean; 231 232 procedure DoDrawToBitmap; 233 procedure DoOnRepaint; 232 234 procedure InitPlayerPool; 233 235 procedure InitPlayers; … … 257 259 property Active: Boolean read FActive write SetActive; 258 260 property OnGameEnd: TNotifyEvent read FOnGameEnd write FOnGameEnd; 261 property OnRepaint: TNotifyEvent read FOnRepaint write FOnRepaint; 259 262 end; 260 263 … … 370 373 repeat 371 374 Engine.Draw(Self); 372 Sleep(50);375 //Sleep(50); 373 376 until Terminated; 374 377 end; … … 1154 1157 begin 1155 1158 FBitmap := AValue; 1156 ResizePlayerFrames;1157 1159 end; 1158 1160 … … 1271 1273 end; 1272 1274 1275 procedure TEngine.DoOnRepaint; 1276 begin 1277 if Assigned(FOnRepaint) then FOnRepaint(Self); 1278 end; 1279 1273 1280 procedure TEngine.InitDigMasks; 1274 1281 var … … 1520 1527 constructor TEngine.Create; 1521 1528 begin 1529 FBitmap := TBitmap.Create; 1522 1530 Lock := TCriticalSection.Create; 1523 1531 FBitmapLower := TBitmapTColor.Create; … … 1557 1565 FreeAndNil(AudioShot); 1558 1566 FreeAndNil(AudioExplode); 1567 FreeAndNil(FBitmap); 1559 1568 inherited Destroy; 1560 1569 end; … … 1593 1602 Lock.Release; 1594 1603 end; 1595 if not Thread.Terminated then Thread.Synchronize(DoDrawToBitmap); 1604 if not Thread.Terminated then DoDrawToBitmap; 1605 if not Thread.Terminated then Thread.Synchronize(DoOnRepaint); 1596 1606 DrawDuration := NowPrecise - DrawStart; 1597 1607 end;
Note:
See TracChangeset
for help on using the changeset viewer.