Changeset 40 for trunk


Ignore:
Timestamp:
Feb 19, 2012, 2:13:49 PM (13 years ago)
Author:
chronos
Message:
  • Modified: Text message handling moved to UTarget unit as field of TTarget.
  • Modified: Messages are displayed as TListVIew rather then TMemo.
Location:
trunk
Files:
10 edited

Legend:

Unmodified
Added
Removed

  • trunk/Forms/UFormMain.pas

    r39 r40  
    169169    procedure AProjectOpenRecentExecute(Sender: TObject);
    170170    procedure TargetStateChanged(Sender: TObject);
     171    procedure MessagesChanged(Sender: TObject);
    171172    procedure MenuItemTargetClick(Sender: TObject);
    172173    procedure ProjectOpen(FileName: string);
    … …  
    191192  MainForm: TMainForm;
    192193
     194
    193195implementation
    194196
    … …  
    204206  SNumberGeneration = 'Number generation';
    205207  SProgramExited = 'Program exited';
     208  SProgramStarted = 'Program started';
     209  SProgramStopped = 'Program stopped';
     210  SNewProject = 'New project';
    206211
    207212{ TMainForm }
    … …  
    259264  if CurrentTarget.State = rsPaused then
    260265    AProgramShowExecutionPoint.Execute;
     266  if CurrentTarget.State = rsStopped then CurrentTarget.Messages.AddMessage(SProgramStopped);
     267end;
     268
     269procedure TMainForm.MessagesChanged(Sender: TObject);
     270begin
     271  FormMessages.Reload;
    261272end;
    262273
    … …  
    275286procedure TMainForm.ProjectOpen(FileName: string);
    276287begin
     288  AProjectClose.Execute;
    277289  MemoSource.Lines.LoadFromFile(UTF8Decode(FileName));
    278290  LastOpenedList.AddItem(FileName);
    … …  
    292304    TTarget(Targets[I]).OnChangeState := nil;
    293305  FCurrentTarget.OnChangeState := TargetStateChanged;
     306  FCurrentTarget.Messages.OnChange := MessagesChanged;
    294307  UpdateInterface;
    295308end;
    … …  
    317330  FormMemory.Align := alClient;
    318331  FormMemory.Show;
    319   FormMesssages.ManualDock(TabSheetMessages, nil, alClient);
    320   FormMesssages.Align := alClient;
    321   FormMesssages.Show;
     332  FormMessages.ManualDock(TabSheetMessages, nil, alClient);
     333  FormMessages.Align := alClient;
     334  FormMessages.Show;
    322335  PageControlRight.Width := MainForm.Width div 2;
    323336  PageControlBottom.Height := MainForm.Height div 5;
    … …  
    444457  if not CurrentTarget.Compiled then AProgramCompile.Execute;
    445458  CurrentTarget.Run;
     459  CurrentTarget.Messages.AddMessage(SProgramStarted);
    446460end;
    447461
    … …  
    560574begin
    561575  with CurrentTarget do begin
    562     Stop;
     576    AProgramStop.Execute;
    563577    Optimization := coNormal;
    564578    SourceCode := MemoSource.Text;
    565579    ProgramName := ExtractFileNameOnly(ProjectFileName);
     580    CurrentTarget.Messages.AddMessage('Compiling...');
    566581    Compile;
     582    CurrentTarget.Messages.AppendMessage('done');
    567583    MemoTarget.Text := TargetCode;
    568584    UpdateInterface;
    … …  
    645661procedure TMainForm.AProjectCloseExecute(Sender: TObject);
    646662begin
     663  AProgramStop.Execute;
    647664  Modified := False;
    648665  ProjectFileName := '';
    … …  
    653670procedure TMainForm.AProjectNewExecute(Sender: TObject);
    654671begin
    655   ProjectFileName := 'Examples' + DirectorySeparator + 'Project.b';
     672  AProjectClose.Execute;
     673  ProjectFileName := 'Examples' + DirectorySeparator + SNewProject + '.b';
    656674  MemoSource.Clear;
    657675  Modified := False;

  • trunk/Forms/UFormMessages.lfm

    r39 r40  
    1 object FormMesssages: TFormMesssages
     1object FormMessages: TFormMessages
    22  Left = 256
    3   Height = 240
    4   Top = 32
    5   Width = 320
     3  Height = 225
     4  Top = 47
     5  Width = 492
    66  Caption = 'Messages'
    7   ClientHeight = 240
    8   ClientWidth = 320
     7  ClientHeight = 225
     8  ClientWidth = 492
     9  OnCreate = FormCreate
    910  LCLVersion = '0.9.31'
    10   object MemoMessages: TMemo
     11  object ListView1: TListView
    1112    Left = 0
    12     Height = 240
     13    Height = 225
    1314    Top = 0
    14     Width = 320
     15    Width = 492
    1516    Align = alClient
     17    Columns = <   
     18      item
     19        Width = 473
     20      end>
     21    OwnerData = True
     22    ReadOnly = True
     23    RowSelect = True
     24    ShowColumnHeaders = False
    1625    TabOrder = 0
     26    ViewStyle = vsReport
     27    OnData = ListView1Data
    1728  end
    1829end

  • trunk/Forms/UFormMessages.lrt

    r39 r40  
    1 TFORMMESSSAGES.CAPTION=Messages
     1TFORMMESSAGES.CAPTION=Messages

  • trunk/Forms/UFormMessages.pas

    r38 r40  
    66
    77uses
    8   Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, StdCtrls;
     8  Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, StdCtrls,
     9  ComCtrls;
    910
    1011type
    1112
    12   { TFormMesssages }
     13  { TFormMessages }
    1314
    14   TFormMesssages = class(TForm)
    15     MemoMessages: TMemo;
     15  TFormMessages = class(TForm)
     16    ListView1: TListView;
     17    procedure FormCreate(Sender: TObject);
     18    procedure ListView1Data(Sender: TObject; Item: TListItem);
    1619  private
    1720    { private declarations }
    1821  public
    19     { public declarations }
     22    procedure Reload;
    2023  end;
    2124
    2225var
    23   FormMesssages: TFormMesssages;
     26  FormMessages: TFormMessages;
    2427
    2528implementation
    … …  
    2730{$R *.lfm}
    2831
     32uses
     33  UFormMain, UTarget;
     34
     35{ TFormMessages }
     36
     37procedure TFormMessages.ListView1Data(Sender: TObject; Item: TListItem);
     38begin
     39  with MainForm.CurrentTarget do
     40  if (Item.Index >= 0) and (Item.Index < Messages.Count) then
     41  with TMessage(Messages[Item.Index]) do begin
     42    Item.Caption := Text;
     43    Item.Data := Messages[Item.Index];
     44  end;
     45end;
     46
     47procedure TFormMessages.FormCreate(Sender: TObject);
     48begin
     49
     50end;
     51
     52procedure TFormMessages.Reload;
     53begin
     54  ListView1.Items.Count := MainForm.CurrentTarget.Messages.Count;
     55  ListView1.Refresh;
     56end;
     57
    2958end.
    3059

  • trunk/Languages/LazFuckIDE.cs.po

    r39 r40  
    113113msgstr "Data"
    114114
     115#: tformmessages.caption
     116msgctxt "tformmessages.caption"
     117msgid "Messages"
     118msgstr "Zprávy"
     119
    115120#: tformmesssages.caption
    116121#| msgid "Messsages"
    … …  
    463468msgstr "Zadejte číslo"
    464469
     470#: uformmain.snewproject
     471msgid "New project"
     472msgstr ""
     473
    465474#: uformmain.snumbergeneration
    466475msgctxt "uformmain.snumbergeneration"
    … …  
    473482msgstr "Program ukončen"
    474483
     484#: uformmain.sprogramstarted
     485msgid "Program started"
     486msgstr ""
     487
     488#: uformmain.sprogramstopped
     489msgid "Program stopped"
     490msgstr ""
     491
    475492#: uformtargets.scompileroptions
    476493msgctxt "uformtargets.scompileroptions"

  • trunk/Languages/LazFuckIDE.po

    r39 r40  
    104104msgstr ""
    105105
     106#: tformmessages.caption
     107msgctxt "TFORMMESSAGES.CAPTION"
     108msgid "Messages"
     109msgstr ""
     110
    106111#: tformmesssages.caption
    107112msgctxt "tformmesssages.caption"
    … …  
    452457msgstr ""
    453458
     459#: uformmain.snewproject
     460msgid "New project"
     461msgstr ""
     462
    454463#: uformmain.snumbergeneration
    455464msgctxt "uformmain.snumbergeneration"
    … …  
    462471msgstr ""
    463472
     473#: uformmain.sprogramstarted
     474msgid "Program started"
     475msgstr ""
     476
     477#: uformmain.sprogramstopped
     478msgid "Program stopped"
     479msgstr ""
     480
    464481#: uformtargets.scompileroptions
    465482msgctxt "uformtargets.scompileroptions"

  • trunk/LazFuckIDE.lpi

    r38 r40  
    181181        <Filename Value="Forms\UFormMessages.pas"/>
    182182        <IsPartOfProject Value="True"/>
    183         <ComponentName Value="FormMesssages"/>
     183        <ComponentName Value="FormMessages"/>
    184184        <ResourceBaseClass Value="Form"/>
    185185        <UnitName Value="UFormMessages"/>

  • trunk/LazFuckIDE.lpr

    r38 r40  
    99  {$ENDIF}
    1010  Interfaces, // this includes the LCL widgetset
    11    Forms, UApplicationInfo, UTarget, UTargetC, UTargetDelphi,
     11  Forms, UApplicationInfo, UTarget, UTargetC, UTargetDelphi,
    1212  UTargetInterpretter, UTargetPHP, UFormCPU, UFormMain,
    1313  UFormOptions, CoolTranslator, Common,
    1414  TemplateGenerics, UFormTargets, UFormOutput, UFormInput, UFormMemory,
    15 UFormMessages;
     15  UFormMessages;
    1616
    1717{$R *.res}
    … …  
    2828  Application.CreateForm(TFormInput, FormInput);
    2929  Application.CreateForm(TFormMemory, FormMemory);
    30   Application.CreateForm(TFormMesssages, FormMesssages);
     30  Application.CreateForm(TFormMessages, FormMessages);
    3131  Application.Run;
    3232end.

  • trunk/Target/UTarget.pas

    r39 r40  
    4747    procedure ClearSystem;
    4848    function SearchByTargetPos(Pos: Integer): TBreakPoint;
     49  end;
     50
     51  TMessage = class
     52    Text: string;
     53    Position: TPoint;
     54  end;
     55
     56  { TMessageList }
     57
     58  TMessageList = class(TListObject)
     59  private
     60    FOnChange: TNotifyEvent;
     61    procedure DoChange;
     62  public
     63    procedure AddMessage(Text: string);
     64    procedure AppendMessage(Text: string);
     65    property OnChange: TNotifyEvent read FOnChange write FOnChange;
    4966  end;
    5067
    … …  
    7794    BreakPoints: TBreakPointList;
    7895    DebugSteps: TDebugStepList;
     96    Messages: TMessageList;
    7997    constructor Create; virtual;
    8098    destructor Destroy; override;
     99    procedure Reset; virtual;
    81100    procedure OptimizeSource;
    82101    procedure Compile; virtual;
    … …  
    115134implementation
    116135
     136{ TMessageList }
     137
     138procedure TMessageList.DoChange;
     139begin
     140  if Assigned(FOnChange) then FOnChange(Self);
     141end;
     142
     143procedure TMessageList.AddMessage(Text: string);
     144var
     145  NewItem: TMessage;
     146begin
     147  NewItem := TMessage.Create;
     148  NewItem.Text := Text;
     149  Add(NewItem);
     150  DoChange;
     151end;
     152
     153procedure TMessageList.AppendMessage(Text: string);
     154begin
     155  if Count > 0 then begin
     156    TMessage(Last).Text := TMessage(Last).Text + Text;
     157    DoChange;
     158  end else AddMessage(Text);
     159end;
     160
    117161{ TBreakPointList }
    118162
    … …  
    287331  BreakPoints := TBreakPointList.Create;
    288332  DebugSteps := TDebugStepList.Create;
     333  Messages := TMessageList.Create;
    289334end;
    290335
    291336destructor TTarget.Destroy;
    292337begin
     338  Messages.Free;
    293339  DebugSteps.Free;;
    294340  BreakPoints.Free;
    295341  inherited Destroy;
     342end;
     343
     344procedure TTarget.Reset;
     345begin
     346  Messages.Clear;
    296347end;
    297348
    … …  
    359410procedure TTarget.Stop;
    360411begin
    361 
    362412end;
    363413

  • trunk/Target/UTargetInterpretter.pas

    r39 r40  
    4949    procedure CommandLoopStart;
    5050    procedure CommandLoopEnd;
    51     procedure Reset;
    5251    procedure PrepareBreakPoints;
    5352  protected
    … …  
    6766    Input: string;
    6867    InputPosition: Integer;
     68    procedure Reset; override;
    6969    procedure Compile; override;
    7070    procedure Run; override;
    … …  
    305305  I: Integer;
    306306begin
     307  inherited;
    307308  PrepareJumpTable;
    308309  SourcePosition := 0;
Note: See TracChangeset for help on using the changeset viewer.