Changeset 61 for trunk


Ignore:
Timestamp:
Dec 4, 2014, 11:26:54 AM (9 years ago)
Author:
chronos
Message:
  • Added: Unit project which should handle all project related operations.
  • Fixed: TScaleDPI to handle also lower then default DPI and different horizontal and vertical DPI.
Location:
trunk
Files:
1 added
11 edited

Legend:

Unmodified
Added
Removed

  • trunk/Forms/UFormMain.pas

    r60 r61  
    263263  FormSourceCode.MemoSource.Lines.LoadFromFile(UTF8Decode(FileName));
    264264  Core.LastOpenedList.AddItem(FileName);
    265   Core.ProjectFileName := FileName;
    266   Core.Modified := False;
     265  Core.Project.FileName := FileName;
     266  Core.Project.Modified := False;
    267267  CurrentTarget.Compiled := False;
    268268  UpdateInterface;
    … …  
    300300  FormMessages.Align := alClient;
    301301  FormMessages.Show;
    302   PageControlRight.Width := MainForm.Width div 2;
     302  PageControlRight.Width := MainForm.Width div 3;
    303303  PageControlBottom.Height := MainForm.Height div 5;
    304304end;
    … …  
    345345  Title: string;
    346346begin
    347   AProjectSave.Enabled := Core.Modified;
     347  AProjectSave.Enabled := Core.Project.Modified;
    348348  Title := Core.ApplicationInfo.AppName;
    349   if Core.ProjectFileName <> '' then Title := Core.ProjectFileName + ' - ' + Title;
    350   if Core.Modified then Title := Title + ' *';
     349  if Core.Project.FileName <> '' then Title := Core.Project.FileName + ' - ' + Title;
     350  if Core.Project.Modified then Title := Title + ' *';
    351351  Caption := Title;
    352   FormSourceCode.MemoSource.Enabled := Core.ProjectFileName <> '';
    353   AProjectClose.Enabled := Core.ProjectFileName <> '';
     352  FormSourceCode.MemoSource.Enabled := Core.Project.FileName <> '';
     353  AProjectClose.Enabled := Core.Project.FileName <> '';
    354354  AProgramRun.Enabled := (tcRun in CurrentTarget.Capabilities) and
    355     (Core.ProjectFileName <> '') and (CurrentTarget.State = rsStopped) or (CurrentTarget.State = rsPaused);
     355    (Core.Project.FileName <> '') and (CurrentTarget.State = rsStopped) or (CurrentTarget.State = rsPaused);
    356356  AProgramPause.Enabled := (tcPause in CurrentTarget.Capabilities) and
    357     (Core.ProjectFileName <> '') and (CurrentTarget.State = rsRunning);
     357    (Core.Project.FileName <> '') and (CurrentTarget.State = rsRunning);
    358358  AProgramStop.Enabled := (tcStop in CurrentTarget.Capabilities) and
    359     (Core.ProjectFileName <> '') and (CurrentTarget.State <> rsStopped);
     359    (Core.Project.FileName <> '') and (CurrentTarget.State <> rsStopped);
    360360  AProgramCompile.Enabled := (tcCompile in CurrentTarget.Capabilities) and
    361     (Core.ProjectFileName <> '');
     361    (Core.Project.FileName <> '');
    362362  AProgramStepInto.Enabled := (tcStepInto in CurrentTarget.Capabilities) and
    363     (Core.ProjectFileName <> '') and ((CurrentTarget.State = rsPaused) or (CurrentTarget.State = rsStopped));
     363    (Core.Project.FileName <> '') and ((CurrentTarget.State = rsPaused) or (CurrentTarget.State = rsStopped));
    364364  AProgramStepOut.Enabled := (tcStepOut in CurrentTarget.Capabilities) and
    365     (Core.ProjectFileName <> '') and (CurrentTarget.State = rsPaused);
     365    (Core.Project.FileName <> '') and (CurrentTarget.State = rsPaused);
    366366  AProgramRunToCursor.Enabled := (tcRunToCursor in CurrentTarget.Capabilities) and
    367     (Core.ProjectFileName <> '') and ((CurrentTarget.State = rsPaused) or (CurrentTarget.State = rsStopped));
     367    (Core.Project.FileName <> '') and ((CurrentTarget.State = rsPaused) or (CurrentTarget.State = rsStopped));
    368368  AProgramStepOver.Enabled := (tcStepOver in CurrentTarget.Capabilities) and
    369     (Core.ProjectFileName <> '') and ((CurrentTarget.State = rsPaused) or (CurrentTarget.State = rsStopped));
     369    (Core.Project.FileName <> '') and ((CurrentTarget.State = rsPaused) or (CurrentTarget.State = rsStopped));
    370370  AProgramShowExecutionPoint.Enabled := (tcPause in CurrentTarget.Capabilities) and
    371     (Core.ProjectFileName <> '') and (CurrentTarget.State = rsPaused);
     371    (Core.Project.FileName <> '') and (CurrentTarget.State = rsPaused);
    372372  AShowSourcePosition.Enabled := CurrentTarget.Compiled;
    373373  AShowTargetPosition.Enabled := CurrentTarget.Compiled;
    … …  
    457457procedure TMainForm.FormCloseQuery(Sender: TObject; var CanClose: boolean);
    458458begin
    459   if Core.Modified then AProjectSaveAs.Execute;
     459  if Core.Project.Modified then AProjectSaveAs.Execute;
    460460end;
    461461
    … …  
    481481    Optimization := coNormal;
    482482    SourceCode := FormSourceCode.MemoSource.Text;
    483     ProjectFileName := Core.ProjectFileName;
    484     ProgramName := ExtractFileNameOnly(Core.ProjectFileName);
     483    ProjectFileName := Core.Project.FileName;
     484    ProgramName := ExtractFileNameOnly(Core.Project.FileName);
    485485    CurrentTarget.Messages.AddMessage(SCompileStart);
    486486    Compile;
    … …  
    566566procedure TMainForm.AProjectCloseExecute(Sender: TObject);
    567567begin
    568   if Core.Modified then AProjectSaveAs.Execute;
     568  if Core.Project.Modified then AProjectSaveAs.Execute;
    569569  AProgramStop.Execute;
    570   Core.ProjectFileName := '';
     570  Core.Project.FileName := '';
    571571  FormSourceCode.MemoSource.Clear;
    572   Core.Modified := False;
     572  Core.Project.Modified := False;
    573573  UpdateInterface;
    574574end;
    … …  
    577577begin
    578578  AProjectClose.Execute;
    579   Core.ProjectFileName := 'Examples' + DirectorySeparator + SNewProject + '.b';
     579  Core.Project.FileName := 'Examples' + DirectorySeparator + SNewProject + '.b';
    580580  FormSourceCode.MemoSource.Clear;
    581   Core.Modified := False;
     581  Core.Project.Modified := False;
    582582  CurrentTarget.Compiled := False;
    583583  UpdateInterface;
    … …  
    602602procedure TMainForm.AProjectSaveAsExecute(Sender: TObject);
    603603begin
    604   SaveDialog1.FileName := Core.ProjectFileName;
     604  SaveDialog1.FileName := Core.Project.FileName;
    605605  if SaveDialog1.Execute then begin
    606606    FormSourceCode.MemoSource.Lines.SaveToFile(UTF8Decode(SaveDialog1.FileName));
    607     Core.ProjectFileName := SaveDialog1.FileName;
     607    Core.Project.FileName := SaveDialog1.FileName;
    608608    Core.LastOpenedList.AddItem(SaveDialog1.FileName);
    609     Core.Modified := False;
     609    Core.Project.Modified := False;
    610610    UpdateInterface;
    611611  end;
    … …  
    614614procedure TMainForm.AProjectSaveExecute(Sender: TObject);
    615615begin
    616   if Core.Modified then AProjectSaveAs.Execute;
     616  if Core.Project.Modified then AProjectSaveAs.Execute;
    617617end;
    618618

  • trunk/Forms/UFormMemory.lfm

    r59 r61  
    11object FormMemory: TFormMemory
    2   Left = 256
     2  Left = 565
    33  Height = 259
    4   Top = 32
     4  Top = 182
    55  Width = 391
    66  Caption = 'Memory'
    … …  
    3434        Width = 330
    3535      end>
    36     Font.Height = -11
     36    Font.Height = -12
    3737    Font.Name = 'Courier New'
    3838    OwnerData = True

  • trunk/Forms/UFormMemory.pas

    r38 r61  
    6363end;
    6464
    65 
    6665end.
    6766

  • trunk/Forms/UFormSourceCode.lfm

    r48 r61  
    77  ClientHeight = 240
    88  ClientWidth = 320
    9   LCLVersion = '1.1'
     9  LCLVersion = '1.3'
    1010  object MemoSource: TMemo
    1111    Left = 0

  • trunk/Forms/UFormSourceCode.pas

    r51 r61  
    168168procedure TFormSourceCode.MemoSourceChange(Sender: TObject);
    169169begin
    170   Core.Modified := True;
     170  Core.Project.Modified := True;
    171171  MainForm.CurrentTarget.Compiled := False;
    172172  MainForm.UpdateInterface;

  • trunk/LazFuckIDE.lpi

    r60 r61  
    9696      </Item6>
    9797    </RequiredPackages>
    98     <Units Count="21">
     98    <Units Count="22">
    9999      <Unit0>
    100100        <Filename Value="LazFuckIDE.lpr"/>
    … …  
    199199        <HasResources Value="True"/>
    200200        <ResourceBaseClass Value="Form"/>
     201        <UnitName Value="UFormSourceCode"/>
    201202      </Unit15>
    202203      <Unit16>
    … …  
    232233        <IsPartOfProject Value="True"/>
    233234        <ComponentName Value="FormLog"/>
     235        <HasResources Value="True"/>
    234236        <ResourceBaseClass Value="Form"/>
    235237        <UnitName Value="UFormLog"/>
    236238      </Unit20>
     239      <Unit21>
     240        <Filename Value="UProject.pas"/>
     241        <IsPartOfProject Value="True"/>
     242        <UnitName Value="UProject"/>
     243      </Unit21>
    237244    </Units>
    238245  </ProjectOptions>

  • trunk/LazFuckIDE.lpr

    r60 r61  
    1313  UFormOutput, UFormInput, UFormMemory, UFormMessages, UFormSourceCode,
    1414  UFormTargetCode, UFormTargetOptions, UCore, Common, TemplateGenerics,
    15   CoolTranslator, UFormLog;
     15  CoolTranslator, UFormLog, UProject;
    1616
    1717{$R *.res}

  • trunk/Packages/Common/Common.lpk

    r59 r61  
    102102      <Item20>
    103103        <Filename Value="UScaleDPI.pas"/>
     104        <HasRegisterProc Value="True"/>
    104105        <UnitName Value="UScaleDPI"/>
    105106      </Item20>

  • trunk/Packages/Common/Common.pas

    r59 r61  
    2424  RegisterUnit('UPersistentForm', @UPersistentForm.Register);
    2525  RegisterUnit('UFindFile', @UFindFile.Register);
     26  RegisterUnit('UScaleDPI', @UScaleDPI.Register);
    2627end;
    2728

  • trunk/Packages/Common/UScaleDPI.pas

    r59 r61  
    1414  { TScaleDPI }
    1515
    16   TScaleDPI = class
     16  TScaleDPI = class(TComponent)
    1717  private
    1818    FAutoDetect: Boolean;
    … …  
    2727    function ScaleX(Size: Integer; FromDPI: Integer): Integer;
    2828    function ScaleY(Size: Integer; FromDPI: Integer): Integer;
    29     constructor Create;
     29    constructor Create(AOwner: TComponent);
     30  published
    3031    property AutoDetect: Boolean read FAutoDetect write SetAutoDetect;
    3132  end;
    3233
     34procedure Register;
    3335
    3436implementation
     37
     38procedure Register;
     39begin
     40  RegisterComponents('Common', [TScaleDPI]);
     41end;
    3542
    3643procedure TScaleDPI.SetAutoDetect(AValue: Boolean);
    … …  
    5966  I: Integer;
    6067begin
    61   if (DPI.X <= FromDPI.X * 1.1) or (DPI.Y <= FromDPI.Y * 1.1) then Exit;
    62 
    6368  NewWidth := ScaleX(ImgList.Width, FromDPI.X);
    6469  NewHeight := ScaleY(ImgList.Height, FromDPI.Y);
    … …  
    97102function TScaleDPI.ScaleX(Size: Integer; FromDPI: Integer): Integer;
    98103begin
    99   if DPI.X <= FromDPI then
    100     Result := Size
    101   else
    102     Result := MulDiv(Size, DPI.X, FromDPI);
     104  Result := MulDiv(Size, DPI.X, FromDPI);
    103105end;
    104106
    105107function TScaleDPI.ScaleY(Size: Integer; FromDPI: Integer): Integer;
    106108begin
    107   if Screen.PixelsPerInch <= FromDPI then
    108     Result := Size
    109   else
    110     Result := MulDiv(Size, DPI.Y, FromDPI);
     109  Result := MulDiv(Size, DPI.Y, FromDPI);
    111110end;
    112111
    … …  
    117116end;
    118117
    119 constructor TScaleDPI.Create;
     118constructor TScaleDPI.Create(AOwner: TComponent);
    120119begin
     120  inherited;
    121121  DPI := Point(96, 96);
    122122  DesignDPI := Point(96, 96);
    … …  
    129129  ToolBarControl: TToolBar;
    130130begin
    131   if (DPI.X <= FromDPI.X) or (DPI.Y <= FromDPI.Y) then Exit;
    132 
    133131  with Control do begin
    134132    Left := ScaleX(Left, FromDPI.X);

  • trunk/UCore.pas

    r60 r61  
    66
    77uses
    8   Classes, SysUtils, FileUtil, UApplicationInfo, ULastOpenedList,
     8  Classes, SysUtils, FileUtil, UApplicationInfo, ULastOpenedList, UProject,
    99  UCoolTranslator, UTarget, URegistry, Registry, XMLConf, Graphics, UScaleDPI;
    1010
    … …  
    2222  public
    2323    ScaleDPI: TScaleDPI;
    24     Modified: Boolean;
    25     ProjectFileName: string;
     24    Project: TProject;
    2625    Targets: TTargetList;
    2726    OpenProjectOnStart: Boolean;
    … …  
    4645procedure TCore.DataModuleCreate(Sender: TObject);
    4746begin
    48   ScaleDPI := TScaleDPI.Create;
     47  Project := TProject.Create;
     48  ScaleDPI := TScaleDPI.Create(nil);
    4949  Targets := TTargetList.Create;
    5050  Targets.Add(TTargetInterpretter.Create);
    … …  
    6161  SaveToRegistry(HKEY(ApplicationInfo.RegistryRoot), ApplicationInfo.RegistryKey);
    6262  Targets.Free;
     63  Project.Free;
    6364  ScaleDPI.Free;
    6465end;
Note: See TracChangeset for help on using the changeset viewer.