Changeset 49


Ignore:
Timestamp:
Aug 22, 2019, 9:50:21 AM (5 years ago)
Author:
chronos
Message:
  • Modified: Use TPaintBox for drawing.
Location:
branches/paintbox
Files:
3 edited

Legend:

Unmodified
Added
Removed
  • branches/paintbox/Forms/UMainForm.lfm

    r47 r49  
    4747    SimplePanel = False
    4848  end
    49   object Image1: TImage
     49  object PaintBox1: TPaintBox
    5050    Left = 0
    5151    Height = 462
     
    5353    Width = 642
    5454    Align = alClient
    55     OnMouseLeave = Image1MouseLeave
    56     OnResize = Image1Resize
     55    OnPaint = PaintBox1Paint
     56    OnResize = PaintBox1Resize
    5757  end
    5858  object TimerDraw: TTimer
  • branches/paintbox/Forms/UMainForm.pas

    r47 r49  
    2323    AFullScreen: TAction;
    2424    ActionList1: TActionList;
    25     Image1: TImage;
    2625    MainMenu1: TMainMenu;
    2726    MenuItem1: TMenuItem;
     
    3332    MenuItem7: TMenuItem;
    3433    MenuItem8: TMenuItem;
     34    PaintBox1: TPaintBox;
    3535    StatusBar1: TStatusBar;
    3636    TimerDraw: TTimer;
     
    5050    procedure FormKeyUp(Sender: TObject; var Key: Word; Shift: TShiftState);
    5151    procedure FormShow(Sender: TObject);
    52     procedure Image1MouseLeave(Sender: TObject);
    53     procedure Image1Resize(Sender: TObject);
     52    procedure PaintBox1Paint(Sender: TObject);
     53    procedure PaintBox1Resize(Sender: TObject);
    5454    procedure TimerDrawTimer(Sender: TObject);
    5555    procedure TimerEngineTickTimer(Sender: TObject);
     
    6262    procedure LoadConfig;
    6363    procedure SaveConfig;
     64    procedure EngineRepaint(Sender: TObject);
    6465  public
    6566    PersistentForm: TPersistentForm;
     
    125126end;
    126127
     128procedure TMainForm.EngineRepaint(Sender: TObject);
     129begin
     130  PaintBox1.Repaint;
     131end;
     132
    127133procedure TMainForm.EraseBackground(DC: HDC);
    128134begin
     
    142148  DoubleBuffered := False;
    143149  Engine := TEngine.Create;
    144   Engine.Bitmap := Image1.Picture.Bitmap;
     150  Engine.OnRepaint := EngineRepaint;
    145151  Core.CoolTranslator1.Language := Core.CoolTranslator1.Languages.SearchByCode('cs');
    146152  LoadConfig;
    147153  Engine.NewGame;
    148154  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];
    151158end;
    152159
     
    205212procedure TMainForm.AShowRawImageDescExecute(Sender: TObject);
    206213begin
    207   ShowMessage(Image1.Picture.Bitmap.RawImage.Description.AsString);
     214  ShowMessage(Engine.Bitmap.RawImage.Description.AsString);
    208215end;
    209216
     
    244251end;
    245252
    246 procedure TMainForm.Image1MouseLeave(Sender: TObject);
    247 begin
    248 
    249 end;
    250 
    251 procedure TMainForm.Image1Resize(Sender: TObject);
     253procedure TMainForm.PaintBox1Paint(Sender: TObject);
     254begin
     255  PaintBox1.Canvas.StretchDraw(Rect(0, 0, PaintBox1.Width, PaintBox1.Height), Engine.Bitmap);
     256end;
     257
     258procedure TMainForm.PaintBox1Resize(Sender: TObject);
    252259begin
    253260  try
    254261    Engine.Lock.Acquire;
    255     Image1.Picture.Bitmap.SetSize(Image1.Width, Image1.Height);
     262    Engine.Bitmap.SetSize(PaintBox1.Width, PaintBox1.Height);
    256263    Engine.ResizePlayerFrames;
    257264  finally
  • branches/paintbox/UEngine.pas

    r45 r49  
    219219    FBitmapLock: TCriticalSection;
    220220    FOnGameEnd: TNotifyEvent;
     221    FOnRepaint: TNotifyEvent;
    221222    FRedrawPending: Boolean;
    222223    FBitmapLower: TBitmapTColor;
     
    230231    function IsInsideHouses(Pos: TPoint): Boolean;
    231232    procedure DoDrawToBitmap;
     233    procedure DoOnRepaint;
    232234    procedure InitPlayerPool;
    233235    procedure InitPlayers;
     
    257259    property Active: Boolean read FActive write SetActive;
    258260    property OnGameEnd: TNotifyEvent read FOnGameEnd write FOnGameEnd;
     261    property OnRepaint: TNotifyEvent read FOnRepaint write FOnRepaint;
    259262  end;
    260263
     
    370373  repeat
    371374    Engine.Draw(Self);
    372     Sleep(50);
     375    //Sleep(50);
    373376  until Terminated;
    374377end;
     
    11541157begin
    11551158  FBitmap := AValue;
    1156   ResizePlayerFrames;
    11571159end;
    11581160
     
    12711273end;
    12721274
     1275procedure TEngine.DoOnRepaint;
     1276begin
     1277  if Assigned(FOnRepaint) then FOnRepaint(Self);
     1278end;
     1279
    12731280procedure TEngine.InitDigMasks;
    12741281var
     
    15201527constructor TEngine.Create;
    15211528begin
     1529  FBitmap := TBitmap.Create;
    15221530  Lock := TCriticalSection.Create;
    15231531  FBitmapLower := TBitmapTColor.Create;
     
    15571565  FreeAndNil(AudioShot);
    15581566  FreeAndNil(AudioExplode);
     1567  FreeAndNil(FBitmap);
    15591568  inherited Destroy;
    15601569end;
     
    15931602      Lock.Release;
    15941603    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);
    15961606    DrawDuration := NowPrecise - DrawStart;
    15971607  end;
Note: See TracChangeset for help on using the changeset viewer.