Changeset 200 for trunk


Ignore:
Timestamp:
Aug 31, 2018, 3:38:01 PM (6 years ago)
Author:
chronos
Message:
  • Modified: Updated Common package files.
  • Fixed: Autosize coolbar during main form resize.
Location:
trunk
Files:
15 edited

Legend:

Unmodified
Added
Removed

  • trunk/Forms/UFormMain.lfm

    r187 r200  
    1414  OnDestroy = FormDestroy
    1515  OnHide = FormHide
     16  OnResize = FormResize
    1617  OnShow = FormShow
    1718  LCLVersion = '1.8.2.0'
    … …  
    104105    Top = 0
    105106    Width = 847
     107    AutoSize = True
    106108    Bands = <   
    107109      item
    … …  
    140142      Height = 28
    141143      Top = 5
    142       Width = 132
     144      Width = 135
    143145      Align = alNone
    144146      AutoSize = True
    … …  
    182184      Height = 28
    183185      Top = 5
    184       Width = 117
     186      Width = 120
    185187      Align = alNone
    186188      AutoSize = True
    … …  
    222224      Height = 28
    223225      Top = 5
    224       Width = 59
     226      Width = 62
    225227      Align = alNone
    226228      AutoSize = True
    … …  
    252254      Height = 28
    253255      Top = 5
    254       Width = 88
     256      Width = 91
    255257      Align = alNone
    256258      AutoSize = True

  • trunk/Forms/UFormMain.pas

    r184 r200  
    125125    procedure EditSearchChange(Sender: TObject);
    126126    procedure FormHide(Sender: TObject);
     127    procedure FormResize(Sender: TObject);
    127128    procedure FormShow(Sender: TObject);
    128129    procedure FormClose(Sender: TObject; var CloseAction: TCloseAction);
    … …  
    228229end;
    229230
     231procedure TFormMain.FormResize(Sender: TObject);
     232begin
     233  CoolBar1.AutosizeBands;
     234end;
     235
    230236procedure TFormMain.FormClose(Sender: TObject; var CloseAction: TCloseAction);
    231237begin
    … …  
    517523    ListViewFilter1.StringGrid.SetFocus;
    518524  end;
     525  Core.ScaleDPI1.ScaleControl(CoolBar1, Core.ScaleDPI1.DesignDPI);
     526  CoolBar1.AutosizeBands;
    519527end;
    520528

  • trunk/Languages/AcronymDecoder.cs.po

    r199 r200  
    11011101msgid "Process import sources"
    11021102msgstr "Zpracovat zdroje importu"
     1103

  • trunk/Packages/Common/Languages/UJobProgressView.cs.po

    r181 r200  
    2424msgstr "Dokončené"
    2525
     26#: ujobprogressview.soperations
     27msgid "Operations:"
     28msgstr ""
     29
    2630#: ujobprogressview.spleasewait
    2731msgid "Please wait..."

  • trunk/Packages/Common/Languages/UJobProgressView.po

    r181 r200  
    1414msgstr ""
    1515
     16#: ujobprogressview.soperations
     17msgid "Operations:"
     18msgstr ""
     19
    1620#: ujobprogressview.spleasewait
    1721msgid "Please wait..."

  • trunk/Packages/Common/UCommon.pas

    r187 r200  
    7272function MergeArray(A, B: array of string): TArrayOfString;
    7373function LoadFileToStr(const FileName: TFileName): AnsiString;
     74procedure SaveStringToFile(S, FileName: string);
    7475procedure SearchFiles(AList: TStrings; Dir: string;
    7576  FilterMethod: TFilterMethodMethod = nil);
    7677function GetStringPart(var Text: string; Separator: string): string;
     78function StripTags(const S: string): string;
    7779function PosFromIndex(SubStr: string; Text: string;
    7880  StartIndex: Integer): Integer;
    … …  
    527529end;
    528530
     531procedure SaveStringToFile(S, FileName: string);
     532var
     533  F: TextFile;
     534begin
     535  AssignFile(F, FileName);
     536  try
     537    ReWrite(F);
     538    Write(F, S);
     539  finally
     540    CloseFile(F);
     541  end;
     542end;
     543
    529544procedure SearchFiles(AList: TStrings; Dir: string;
    530545  FilterMethod: TFilterMethodMethod = nil);
    … …  
    561576  Result := Trim(Result);
    562577  Text := Trim(Text);
     578end;
     579
     580function StripTags(const S: string): string;
     581var
     582  Len: Integer;
     583
     584  function ReadUntil(const ReadFrom: Integer; const C: Char): Integer;
     585  var
     586    J: Integer;
     587  begin
     588    for J := ReadFrom to Len do
     589      if (S[j] = C) then
     590      begin
     591        Result := J;
     592        Exit;
     593      end;
     594    Result := Len + 1;
     595  end;
     596
     597var
     598  I, APos: Integer;
     599begin
     600  Len := Length(S);
     601  I := 0;
     602  Result := '';
     603  while (I <= Len) do begin
     604    Inc(I);
     605    APos := ReadUntil(I, '<');
     606    Result := Result + Copy(S, I, APos - i);
     607    I := ReadUntil(APos + 1, '>');
     608  end;
    563609end;
    564610
    … …  
    608654end;
    609655
     656
    610657initialization
    611658

  • trunk/Packages/Common/UJobProgressView.lfm

    r181 r200  
    11object FormJobProgressView: TFormJobProgressView
    22  Left = 467
    3   Height = 246
     3  Height = 345
    44  Top = 252
    5   Width = 328
     5  Width = 539
    66  BorderIcons = [biSystemMenu]
    7   ClientHeight = 246
    8   ClientWidth = 328
     7  ClientHeight = 345
     8  ClientWidth = 539
    99  DesignTimePPI = 120
    10   Font.Height = -11
    11   Font.Name = 'MS Sans Serif'
    1210  OnClose = FormClose
    1311  OnCloseQuery = FormCloseQuery
    1412  OnCreate = FormCreate
    1513  OnDestroy = FormDestroy
     14  OnHide = FormHide
     15  OnShow = FormShow
    1616  Position = poScreenCenter
    1717  LCLVersion = '1.8.2.0'
    1818  object PanelOperationsTitle: TPanel
    1919    Left = 0
    20     Height = 24
     20    Height = 32
    2121    Top = 0
    22     Width = 328
    23     Align = alTop
    24     BevelOuter = bvNone
    25     ClientHeight = 24
    26     ClientWidth = 328
     22    Width = 539
     23    Align = alTop
     24    BevelOuter = bvNone
     25    ClientHeight = 32
     26    ClientWidth = 539
    2727    FullRepaint = False
    2828    TabOrder = 0
    2929    object LabelOperation: TLabel
    3030      Left = 8
    31       Height = 13
     31      Height = 20
    3232      Top = 8
    33       Width = 66
     33      Width = 76
    3434      Caption = 'Operations:'
    35       Font.Height = -11
    36       Font.Name = 'MS Sans Serif'
    37       Font.Style = [fsBold]
    3835      ParentColor = False
    3936      ParentFont = False
    … …  
    4239  object PanelLog: TPanel
    4340    Left = 0
    44     Height = 122
    45     Top = 124
    46     Width = 328
     41    Height = 133
     42    Top = 212
     43    Width = 539
    4744    Align = alClient
    4845    BevelOuter = bvSpace
    49     ClientHeight = 122
    50     ClientWidth = 328
     46    ClientHeight = 133
     47    ClientWidth = 539
    5148    TabOrder = 1
    5249    object MemoLog: TMemo
    5350      Left = 8
    54       Height = 106
     51      Height = 117
    5552      Top = 8
    56       Width = 312
     53      Width = 523
    5754      Anchors = [akTop, akLeft, akRight, akBottom]
    5855      ReadOnly = True
    … …  
    6360  object PanelProgress: TPanel
    6461    Left = 0
    65     Height = 38
    66     Top = 50
    67     Width = 328
    68     Align = alTop
    69     BevelOuter = bvNone
    70     ClientHeight = 38
    71     ClientWidth = 328
     62    Height = 54
     63    Top = 106
     64    Width = 539
     65    Align = alTop
     66    BevelOuter = bvNone
     67    ClientHeight = 54
     68    ClientWidth = 539
    7269    TabOrder = 2
    7370    object ProgressBarPart: TProgressBar
    74       Left = 8
    75       Height = 17
    76       Top = 16
    77       Width = 312
     71      Left = 10
     72      Height = 24
     73      Top = 24
     74      Width = 523
    7875      Anchors = [akTop, akLeft, akRight]
    7976      TabOrder = 0
    … …  
    8178    object LabelEstimatedTimePart: TLabel
    8279      Left = 8
    83       Height = 13
     80      Height = 20
    8481      Top = -2
    85       Width = 71
     82      Width = 103
    8683      Caption = 'Estimated time:'
    8784      ParentColor = False
    … …  
    9087  object PanelOperations: TPanel
    9188    Left = 0
    92     Height = 26
    93     Top = 24
    94     Width = 328
    95     Align = alTop
    96     BevelOuter = bvNone
    97     ClientHeight = 26
    98     ClientWidth = 328
     89    Height = 42
     90    Top = 64
     91    Width = 539
     92    Align = alTop
     93    BevelOuter = bvNone
     94    ClientHeight = 42
     95    ClientWidth = 539
    9996    FullRepaint = False
    10097    TabOrder = 3
    10198    object ListViewJobs: TListView
    10299      Left = 8
    103       Height = 16
     100      Height = 32
    104101      Top = 5
    105       Width = 312
     102      Width = 523
    106103      Anchors = [akTop, akLeft, akRight, akBottom]
    107104      AutoWidthLastColumn = True
    … …  
    110107      Columns = <     
    111108        item
    112           Width = 312
     109          Width = 523
    113110        end>
    114111      OwnerData = True
    … …  
    123120  object PanelProgressTotal: TPanel
    124121    Left = 0
    125     Height = 36
    126     Top = 88
    127     Width = 328
    128     Align = alTop
    129     BevelOuter = bvNone
    130     ClientHeight = 36
    131     ClientWidth = 328
     122    Height = 52
     123    Top = 160
     124    Width = 539
     125    Align = alTop
     126    BevelOuter = bvNone
     127    ClientHeight = 52
     128    ClientWidth = 539
    132129    TabOrder = 4
    133130    object LabelEstimatedTimeTotal: TLabel
    134131      Left = 8
    135       Height = 13
     132      Height = 20
    136133      Top = 0
    137       Width = 97
     134      Width = 141
    138135      Caption = 'Total estimated time:'
    139136      ParentColor = False
    … …  
    141138    object ProgressBarTotal: TProgressBar
    142139      Left = 8
    143       Height = 16
    144       Top = 16
    145       Width = 312
     140      Height = 24
     141      Top = 24
     142      Width = 523
    146143      Anchors = [akTop, akLeft, akRight]
    147144      TabOrder = 0
     145    end
     146  end
     147  object PanelText: TPanel
     148    Left = 0
     149    Height = 32
     150    Top = 32
     151    Width = 539
     152    Align = alTop
     153    BevelOuter = bvNone
     154    ClientHeight = 32
     155    ClientWidth = 539
     156    TabOrder = 5
     157    object LabelText: TLabel
     158      Left = 8
     159      Height = 24
     160      Top = 8
     161      Width = 525
     162      Anchors = [akTop, akLeft, akRight]
     163      AutoSize = False
     164      ParentColor = False
    148165    end
    149166  end

  • trunk/Packages/Common/UJobProgressView.pas

    r181 r200  
    77uses
    88  SysUtils, Variants, Classes, Graphics, Controls, Forms, Syncobjs,
    9   Dialogs, ComCtrls, StdCtrls, ExtCtrls, Contnrs, UThreading,
     9  Dialogs, ComCtrls, StdCtrls, ExtCtrls, Contnrs, UThreading, Math,
    1010  DateUtils;
    1111
    … …  
    1313  EstimatedTimeShowTreshold = 4;
    1414  EstimatedTimeShowTresholdTotal = 1;
    15   MemoLogHeight = 200;
    1615  UpdateInterval = 100; // ms
    1716
    … …  
    2423    FLock: TCriticalSection;
    2524    FOnChange: TNotifyEvent;
     25    FText: string;
    2626    FValue: Integer;
    2727    FMax: Integer;
    2828    procedure SetMax(const AValue: Integer);
     29    procedure SetText(AValue: string);
    2930    procedure SetValue(const AValue: Integer);
    3031  public
    … …  
    3536    property Value: Integer read FValue write SetValue;
    3637    property Max: Integer read FMax write SetMax;
     38    property Text: string read FText write SetText;
    3739    property OnChange: TNotifyEvent read FOnChange write FOnChange;
    3840  end;
    … …  
    6971  end;
    7072
     73  TJobs = class(TObjectList)
     74  end;
     75
    7176  TJobThread = class(TListedThread)
    7277    procedure Execute; override;
    … …  
    8085  TFormJobProgressView = class(TForm)
    8186    ImageList1: TImageList;
     87    LabelText: TLabel;
    8288    Label2: TLabel;
    8389    LabelOperation: TLabel;
    … …  
    8692    ListViewJobs: TListView;
    8793    MemoLog: TMemo;
     94    PanelText: TPanel;
    8895    PanelProgressTotal: TPanel;
    8996    PanelOperationsTitle: TPanel;
    … …  
    94101    ProgressBarTotal: TProgressBar;
    95102    TimerUpdate: TTimer;
     103    procedure FormHide(Sender: TObject);
     104    procedure FormShow(Sender: TObject);
     105    procedure ReloadJobList;
    96106    procedure FormClose(Sender: TObject; var CloseAction: TCloseAction);
    97107    procedure FormDestroy(Sender: TObject);
    … …  
    100110    procedure FormCreate(Sender: TObject);
    101111    procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
     112    procedure UpdateHeight;
    102113  public
    103114    JobProgressView: TJobProgressView;
    … …  
    118129    TotalStartTime: TDateTime;
    119130    Log: TStringList;
     131    FForm: TFormJobProgressView;
    120132    procedure SetTerminate(const AValue: Boolean);
    121133    procedure UpdateProgress;
    122     procedure ReloadJobList;
    123     procedure StartJobs;
    124     procedure UpdateHeight;
    125134    procedure JobProgressChange(Sender: TObject);
    126135  public
    127     Form: TFormJobProgressView;
    128     Jobs: TObjectList; // TListObject<TJob>
     136    Jobs: TJobs;
    129137    CurrentJob: TJob;
    130138    CurrentJobIndex: Integer;
    … …  
    132140    destructor Destroy; override;
    133141    procedure Clear;
    134     procedure AddJob(Title: string; Method: TJobProgressViewMethod;
    135       NoThreaded: Boolean = False; WaitFor: Boolean = False);
    136     procedure Start(AAutoClose: Boolean = True);
     142    function AddJob(Title: string; Method: TJobProgressViewMethod;
     143      NoThreaded: Boolean = False; WaitFor: Boolean = False): TJob;
     144    procedure Start;
    137145    procedure Stop;
    138146    procedure TermSleep(Delay: Integer);
     147    property Form: TFormJobProgressView read FForm;
    139148    property Terminate: Boolean read FTerminate write SetTerminate;
    140149  published
    … …  
    166175  STotalEstimatedTime = 'Total estimated time: %s';
    167176  SFinished = 'Finished';
     177  SOperations = 'Operations:';
    168178
    169179procedure Register;
    … …  
    171181  RegisterComponents('Common', [TJobProgressView]);
    172182end;
     183
     184{ TJobThread }
    173185
    174186procedure TJobThread.Execute;
    … …  
    189201end;
    190202
    191 procedure TJobProgressView.AddJob(Title: string; Method: TJobProgressViewMethod;
    192   NoThreaded: Boolean = False; WaitFor: Boolean = False);
     203{ TFormJobProgressView }
     204
     205procedure TFormJobProgressView.UpdateHeight;
    193206var
    194   NewJob: TJob;
    195 begin
    196   NewJob := TJob.Create;
    197   NewJob.ProgressView := Self;
    198   NewJob.Title := Title;
    199   NewJob.Method := Method;
    200   NewJob.NoThreaded := NoThreaded;
    201   NewJob.WaitFor := WaitFor;
    202   NewJob.Progress.Max := 100;
    203   NewJob.Progress.Reset;
    204   NewJob.Progress.OnChange := JobProgressChange;
    205   Jobs.Add(NewJob);
     207  H: Integer;
     208  PanelOperationsVisible: Boolean;
     209  PanelOperationsHeight: Integer;
     210  PanelProgressVisible: Boolean;
     211  PanelProgressTotalVisible: Boolean;
     212  PanelLogVisible: Boolean;
     213  MemoLogHeight: Integer = 200;
     214  I: Integer;
     215  ItemRect: TRect;
     216  MaxH: Integer;
     217begin
     218    H := PanelOperationsTitle.Height;
     219    PanelOperationsVisible := JobProgressView.Jobs.Count > 0;
     220    if PanelOperationsVisible <> PanelOperations.Visible then
     221      PanelOperations.Visible := PanelOperationsVisible;
     222    if ListViewJobs.Items.Count > 0 then begin
     223      Maxh := 0;
     224      for I := 0 to ListViewJobs.Items.Count - 1 do
     225      begin
     226        ItemRect := ListViewJobs.Items[i].DisplayRect(drBounds);
     227        Maxh := Max(Maxh, ItemRect.Top + (ItemRect.Bottom - ItemRect.Top));
     228      end;
     229      PanelOperationsHeight := Scale96ToScreen(12) + Maxh;
     230    end else PanelOperationsHeight := Scale96ToScreen(8);
     231    if PanelOperationsHeight <> PanelOperations.Height then
     232      PanelOperations.Height := PanelOperationsHeight;
     233    if PanelOperationsVisible then
     234      H := H + PanelOperations.Height;
     235
     236    PanelProgressVisible := (JobProgressView.Jobs.Count > 0) and not JobProgressView.Finished;
     237    if PanelProgressVisible <> PanelProgress.Visible then
     238      PanelProgress.Visible := PanelProgressVisible;
     239    if PanelProgressVisible then
     240      H := H + PanelProgress.Height;
     241    PanelProgressTotalVisible := (JobProgressView.Jobs.Count > 1) and not JobProgressView.Finished;
     242    if PanelProgressTotalVisible <> PanelProgressTotal.Visible then
     243      PanelProgressTotal.Visible := PanelProgressTotalVisible;
     244    if PanelProgressTotalVisible then
     245      H := H + PanelProgressTotal.Height;
     246    Constraints.MinHeight := H;
     247    PanelLogVisible := MemoLog.Lines.Count > 0;
     248    if PanelLogVisible <> PanelLog.Visible then
     249      PanelLog.Visible := PanelLogVisible;
     250    if PanelLogVisible then
     251      H := H + Scale96ToScreen(MemoLogHeight);
     252    if PanelText.Visible then
     253      H := H + PanelText.Height;
     254    if Height <> H then begin
     255      Height := H;
     256      Top := (Screen.Height - H) div 2;
     257    end;
     258end;
     259
     260procedure TFormJobProgressView.TimerUpdateTimer(Sender: TObject);
     261var
     262  ProgressBarPartVisible: Boolean;
     263  ProgressBarTotalVisible: Boolean;
     264begin
     265  JobProgressView.UpdateProgress;
     266  if Visible and (not ProgressBarPart.Visible) and
     267  Assigned(JobProgressView.CurrentJob) and
     268  (JobProgressView.CurrentJob.Progress.Value > 0) then begin
     269    ProgressBarPartVisible := True;
     270    if ProgressBarPartVisible <> ProgressBarPart.Visible then
     271      ProgressBarPart.Visible := ProgressBarPartVisible;
     272    ProgressBarTotalVisible := True;
     273    if ProgressBarTotalVisible <> ProgressBarTotal.Visible then
     274      ProgressBarTotal.Visible := ProgressBarTotalVisible;
     275  end;
     276  if not Visible then begin
     277    TimerUpdate.Interval := UpdateInterval;
     278    if not JobProgressView.OwnerDraw then Show;
     279  end;
     280  if Assigned(JobProgressView.CurrentJob) then begin
     281    LabelText.Caption := JobProgressView.CurrentJob.Progress.Text;
     282    if LabelText.Caption <> '' then begin
     283      PanelText.Visible := True;
     284      UpdateHeight;
     285    end;
     286  end;
     287end;
     288
     289procedure TFormJobProgressView.FormDestroy(Sender:TObject);
     290begin
     291end;
     292
     293procedure TFormJobProgressView.ListViewJobsData(Sender: TObject; Item: TListItem);
     294begin
     295  if (Item.Index >= 0) and (Item.Index < JobProgressView.Jobs.Count) then
     296  with TJob(JobProgressView.Jobs[Item.Index]) do begin
     297    Item.Caption := Title;
     298    if Item.Index = JobProgressView.CurrentJobIndex then Item.ImageIndex := 1
     299      else if Finished then Item.ImageIndex := 0
     300      else Item.ImageIndex := 2;
     301    Item.Data := JobProgressView.Jobs[Item.Index];
     302  end;
     303end;
     304
     305procedure TFormJobProgressView.FormClose(Sender: TObject;
     306  var CloseAction: TCloseAction);
     307begin
     308end;
     309
     310procedure TFormJobProgressView.FormCreate(Sender: TObject);
     311begin
     312  Caption := SPleaseWait;
     313  try
     314    //Animate1.FileName := ExtractFileDir(UTF8Encode(Application.ExeName)) +
     315    //  DirectorySeparator + 'horse.avi';
     316    //Animate1.Active := True;
     317  except
     318
     319  end;
     320end;
     321
     322procedure TFormJobProgressView.ReloadJobList;
     323begin
     324  // Workaround for not showing first line
     325  //Form.ListViewJobs.Items.Count := Jobs.Count + 1;
     326  //Form.ListViewJobs.Refresh;
     327
     328  if ListViewJobs.Items.Count <> JobProgressView.Jobs.Count then
     329    ListViewJobs.Items.Count := JobProgressView.Jobs.Count;
     330  ListViewJobs.Refresh;
     331  Application.ProcessMessages;
     332  UpdateHeight;
     333end;
     334
     335procedure TFormJobProgressView.FormShow(Sender: TObject);
     336begin
     337  ReloadJobList;
     338end;
     339
     340procedure TFormJobProgressView.FormHide(Sender: TObject);
     341begin
     342  JobProgressView.Jobs.Clear;
     343  ReloadJobList;
     344end;
     345
     346procedure TFormJobProgressView.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
     347begin
     348  CanClose := JobProgressView.Finished;
     349  JobProgressView.Terminate := True;
     350  Caption := SPleaseWait + STerminate;
     351end;
     352
     353
     354{ TJobProgressView }
     355
     356function TJobProgressView.AddJob(Title: string; Method: TJobProgressViewMethod;
     357  NoThreaded: Boolean = False; WaitFor: Boolean = False): TJob;
     358begin
     359  Result := TJob.Create;
     360  Result.ProgressView := Self;
     361  Result.Title := Title;
     362  Result.Method := Method;
     363  Result.NoThreaded := NoThreaded;
     364  Result.WaitFor := WaitFor;
     365  Result.Progress.Max := 100;
     366  Result.Progress.Reset;
     367  Result.Progress.OnChange := JobProgressChange;
     368  Jobs.Add(Result);
    206369  //ReloadJobList;
    207370end;
    208371
    209 procedure TJobProgressView.Start(AAutoClose: Boolean = True);
    210 begin
    211   AutoClose := AAutoClose;
    212   StartJobs;
    213 end;
    214 
    215 procedure TJobProgressView.StartJobs;
     372procedure TJobProgressView.Start;
    216373var
    217374  I: Integer;
    … …  
    228385    Form.MemoLog.Clear;
    229386
     387    Form.PanelText.Visible := False;
    230388    Form.LabelEstimatedTimePart.Visible := False;
    231389    Form.LabelEstimatedTimeTotal.Visible := False;
    … …  
    257415      Form.ProgressBarPart.Visible := False;
    258416      //Show;
    259       ReloadJobList;
     417      Form.ReloadJobList;
    260418      Application.ProcessMessages;
    261419      if NoThreaded then begin
    … …  
    295453    //if Visible then Hide;
    296454    Form.MemoLog.Lines.Assign(Log);
    297     if (Form.MemoLog.Lines.Count = 0) and AutoClose then begin
     455    if (Form.MemoLog.Lines.Count = 0) and FAutoClose then begin
    298456      Form.Hide;
    299457    end;
    300     Clear;
     458    if not Form.Visible then Clear;
    301459    Form.Caption := SFinished;
    302460    //LabelEstimatedTimePart.Visible := False;
    303461    Finished := True;
    304462    CurrentJobIndex := -1;
    305     ReloadJobList;
    306   end;
    307 end;
    308 
    309 procedure TJobProgressView.UpdateHeight;
    310 var
    311   H: Integer;
    312   PanelOperationsVisible: Boolean;
    313   PanelOperationsHeight: Integer;
    314   PanelProgressVisible: Boolean;
    315   PanelProgressTotalVisible: Boolean;
    316   PanelLogVisible: Boolean;
    317 begin
    318   with Form do begin
    319   H := PanelOperationsTitle.Height;
    320   PanelOperationsVisible := Jobs.Count > 0;
    321   if PanelOperationsVisible <> PanelOperations.Visible then
    322     PanelOperations.Visible := PanelOperationsVisible;
    323   PanelOperationsHeight := 8 + 18 * Jobs.Count;
    324   if PanelOperationsHeight <> PanelOperations.Height then
    325     PanelOperations.Height := PanelOperationsHeight;
    326   if PanelOperationsVisible then
    327     H := H + PanelOperations.Height;
    328 
    329   PanelProgressVisible := (Jobs.Count > 0) and not Finished;
    330   if PanelProgressVisible <> PanelProgress.Visible then
    331     PanelProgress.Visible := PanelProgressVisible;
    332   if PanelProgressVisible then
    333     H := H + PanelProgress.Height;
    334   PanelProgressTotalVisible := (Jobs.Count > 1) and not Finished;
    335   if PanelProgressTotalVisible <> PanelProgressTotal.Visible then
    336     PanelProgressTotal.Visible := PanelProgressTotalVisible;
    337   if PanelProgressTotalVisible then
    338     H := H + PanelProgressTotal.Height;
    339   Constraints.MinHeight := H;
    340   PanelLogVisible := MemoLog.Lines.Count > 0;
    341   if PanelLogVisible <> PanelLog.Visible then
    342     PanelLog.Visible := PanelLogVisible;
    343   if PanelLogVisible then
    344     H := H + MemoLogHeight;
    345   if Height <> H then Height := H;
     463    Form.ReloadJobList;
    346464  end;
    347465end;
    … …  
    351469  if Assigned(FOnOwnerDraw) then
    352470    FOnOwnerDraw(Self);
    353 end;
    354 
    355 procedure TFormJobProgressView.TimerUpdateTimer(Sender: TObject);
    356 var
    357   ProgressBarPartVisible: Boolean;
    358   ProgressBarTotalVisible: Boolean;
    359 begin
    360   JobProgressView.UpdateProgress;
    361   if Visible and (not ProgressBarPart.Visible) and
    362   Assigned(JobProgressView.CurrentJob) and
    363   (JobProgressView.CurrentJob.Progress.Value > 0) then begin
    364     ProgressBarPartVisible := True;
    365     if ProgressBarPartVisible <> ProgressBarPart.Visible then
    366       ProgressBarPart.Visible := ProgressBarPartVisible;
    367     ProgressBarTotalVisible := True;
    368     if ProgressBarTotalVisible <> ProgressBarTotal.Visible then
    369       ProgressBarTotal.Visible := ProgressBarTotalVisible;
    370   end;
    371   if not Visible then begin
    372     TimerUpdate.Interval := UpdateInterval;
    373     if not JobProgressView.OwnerDraw then Show;
    374   end;
    375 end;
    376 
    377 procedure TFormJobProgressView.FormDestroy(Sender:TObject);
    378 begin
    379 end;
    380 
    381 procedure TFormJobProgressView.ListViewJobsData(Sender: TObject; Item: TListItem);
    382 begin
    383   if (Item.Index >= 0) and (Item.Index < JobProgressView.Jobs.Count) then
    384   with TJob(JobProgressView.Jobs[Item.Index]) do begin
    385     Item.Caption := Title;
    386     if Item.Index = JobProgressView.CurrentJobIndex then Item.ImageIndex := 1
    387       else if Finished then Item.ImageIndex := 0
    388       else Item.ImageIndex := 2;
    389     Item.Data := JobProgressView.Jobs[Item.Index];
    390   end;
    391 end;
    392 
    393 procedure TFormJobProgressView.FormClose(Sender: TObject;
    394   var CloseAction: TCloseAction);
    395 begin
    396   ListViewJobs.Clear;
    397 end;
    398 
    399 procedure TFormJobProgressView.FormCreate(Sender: TObject);
    400 begin
    401   Caption := SPleaseWait;
    402   try
    403     //Animate1.FileName := ExtractFileDir(UTF8Encode(Application.ExeName)) +
    404     //  DirectorySeparator + 'horse.avi';
    405     //Animate1.Active := True;
    406   except
    407 
    408   end;
    409471end;
    410472
    … …  
    425487    Sleep(Quantum);
    426488  end;
    427 end;
    428 
    429 procedure TFormJobProgressView.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
    430 begin
    431   CanClose := JobProgressView.Finished;
    432   JobProgressView.Terminate := True;
    433   Caption := SPleaseWait + STerminate;
    434489end;
    435490
    … …  
    489544end;
    490545
    491 procedure TJobProgressView.ReloadJobList;
    492 begin
    493   UpdateHeight;
    494   // Workaround for not showing first line
    495   Form.ListViewJobs.Items.Count := Jobs.Count + 1;
    496   Form.ListViewJobs.Refresh;
    497 
    498   if Form.ListViewJobs.Items.Count <> Jobs.Count then
    499     Form.ListViewJobs.Items.Count := Jobs.Count;
    500   Form.ListViewJobs.Refresh;
    501   //Application.ProcessMessages;
    502 end;
    503 
    504546constructor TJobProgressView.Create(TheOwner: TComponent);
    505547begin
    506548  inherited;
    507549  if not (csDesigning in ComponentState) then begin
    508     Form := TFormJobProgressView.Create(Self);
    509     Form.JobProgressView := Self;
    510   end;
    511   Jobs := TObjectList.Create;
     550    FForm := TFormJobProgressView.Create(Self);
     551    FForm.JobProgressView := Self;
     552  end;
     553  Jobs := TJobs.Create;
    512554  Log := TStringList.Create;
    513555  //PanelOperationsTitle.Height := 80;
    514   ShowDelay := 0; //1000; // ms
     556  AutoClose := True;
     557  ShowDelay := 0;
    515558end;
    516559
    … …  
    518561begin
    519562  Jobs.Clear;
     563  Log.Clear;
    520564  //ReloadJobList;
    521565end;
    … …  
    527571  inherited;
    528572end;
     573
     574{ TProgress }
    529575
    530576procedure TProgress.SetMax(const AValue: Integer);
    … …  
    535581    if FMax < 1 then FMax := 1;
    536582    if FValue >= FMax then FValue := FMax;
     583  finally
     584    FLock.Release;
     585  end;
     586end;
     587
     588procedure TProgress.SetText(AValue: string);
     589begin
     590  try
     591    FLock.Acquire;
     592    if FText = AValue then Exit;
     593    FText := AValue;
    537594  finally
    538595    FLock.Release;
    … …  
    562619end;
    563620
    564 { TProgress }
    565 
    566621procedure TProgress.Increment;
    567622begin

  • trunk/Packages/Common/ULastOpenedList.pas

    r181 r200  
    3030    procedure SaveToXMLConfig(XMLConfig: TXMLConfig; Path: string);
    3131    procedure AddItem(FileName: string);
     32    function GetFirstFileName: string;
    3233  published
    3334    property MaxCount: Integer read FMaxCount write SetMaxCount;
    … …  
    185186end;
    186187
     188function TLastOpenedList.GetFirstFileName: string;
     189begin
     190  if Items.Count > 0 then Result := Items[0]
     191    else Result := '';
     192end;
     193
    187194end.
    188195

  • trunk/Packages/Common/UMemory.pas

    r3 r200  
    2424    constructor Create;
    2525    destructor Destroy; override;
     26    procedure WriteMemory(Position: Integer; Memory: TMemory);
     27    procedure ReadMemory(Position: Integer; Memory: TMemory);
    2628    property Data: PByte read FData;
    2729    property Size: Integer read FSize write SetSize;
    … …  
    108110end;
    109111
     112procedure TMemory.WriteMemory(Position: Integer; Memory: TMemory);
     113begin
     114  Move(Memory.FData, PByte(@FData + Position)^, Memory.Size);
     115end;
     116
     117procedure TMemory.ReadMemory(Position: Integer; Memory: TMemory);
     118begin
     119  Move(PByte(@FData + Position)^, Memory.FData, Memory.Size);
     120end;
     121
    110122end.
    111123

  • trunk/Packages/Common/UPersistentForm.pas

    r181 r200  
    88
    99uses
    10   Classes, SysUtils, Forms, URegistry, LCLIntf, Registry, Controls, ComCtrls;
     10  Classes, SysUtils, Forms, URegistry, LCLIntf, Registry, Controls, ComCtrls,
     11  ExtCtrls;
    1112
    1213type
    … …  
    7172  end;
    7273
     74  if (Control is TPanel) then begin
     75    with Form, TRegistryEx.Create do
     76    try
     77      RootKey := RegistryContext.RootKey;
     78      OpenKey(RegistryContext.Key + '\Forms\' + Form.Name + '\' + Control.Name, True);
     79      if (TPanel(Control).Align = alRight) or (TPanel(Control).Align = alLeft) then begin
     80        if ValueExists('Width') then
     81          TPanel(Control).Width := ReadInteger('Width');
     82      end;
     83      if (TPanel(Control).Align = alTop) or (TPanel(Control).Align = alBottom) then begin
     84        if ValueExists('Height') then
     85          TPanel(Control).Height := ReadInteger('Height');
     86      end;
     87    finally
     88      Free;
     89    end;
     90  end;
     91
    7392  if Control is TWinControl then begin
    7493    WinControl := TWinControl(Control);
    … …  
    95114      for I := 0 to TListView(Control).Columns.Count - 1 do begin
    96115        WriteInteger('ColWidth' + IntToStr(I), TListView(Control).Columns[I].Width);
     116      end;
     117    finally
     118      Free;
     119    end;
     120  end;
     121
     122  if (Control is TPanel) then begin
     123    with Form, TRegistryEx.Create do
     124    try
     125      RootKey := RegistryContext.RootKey;
     126      OpenKey(RegistryContext.Key + '\Forms\' + Form.Name + '\' + Control.Name, True);
     127      if (TPanel(Control).Align = alRight) or (TPanel(Control).Align = alLeft) then begin
     128        WriteInteger('Width', TPanel(Control).Width);
     129      end;
     130      if (TPanel(Control).Align = alTop) or (TPanel(Control).Align = alBottom) then begin
     131        WriteInteger('Height', TPanel(Control).Height);
    97132      end;
    98133    finally

  • trunk/Packages/Common/UScaleDPI.pas

    r181 r200  
    289289  //OldAutoSize: Boolean;
    290290begin
     291  //if not (Control is TCustomPage) then
     292  // Resize childs first
     293  if Control is TWinControl then begin
     294    WinControl := TWinControl(Control);
     295    if WinControl.ControlCount > 0 then begin
     296      for I := 0 to WinControl.ControlCount - 1 do begin
     297        if WinControl.Controls[I] is TControl then begin
     298          ScaleControl(WinControl.Controls[I], FromDPI);
     299        end;
     300      end;
     301    end;
     302  end;
     303
    291304  //if Control is TMemo then Exit;
    292305  //if Control is TForm then
    … …  
    340353  end;
    341354
    342   //if not (Control is TCustomPage) then
    343   if Control is TWinControl then begin
    344     WinControl := TWinControl(Control);
    345     if WinControl.ControlCount > 0 then begin
    346       for I := 0 to WinControl.ControlCount - 1 do begin
    347         if WinControl.Controls[I] is TControl then begin
    348           ScaleControl(WinControl.Controls[I], FromDPI);
    349         end;
    350       end;
    351     end;
    352   end;
    353355  //if Control is TForm then
    354356  //  Control.EnableAutoSizing;

  • trunk/Packages/Common/UXMLUtils.pas

    r181 r200  
    77uses
    88  {$IFDEF WINDOWS}Windows,{$ENDIF}
    9   Classes, SysUtils, DateUtils, DOM;
     9  Classes, SysUtils, DateUtils, DOM, xmlread;
    1010
    1111function XMLTimeToDateTime(XMLDateTime: string): TDateTime;
    … …  
    2121function ReadString(Node: TDOMNode; Name: string; DefaultValue: string): string;
    2222function ReadDateTime(Node: TDOMNode; Name: string; DefaultValue: TDateTime): TDateTime;
     23procedure ReadXMLFileParser(out Doc: TXMLDocument; FileName: string);
    2324
    2425
    2526implementation
     27
     28procedure ReadXMLFileParser(out Doc: TXMLDocument; FileName: string);
     29var
     30  Parser: TDOMParser;
     31  Src: TXMLInputSource;
     32  InFile: TFileStream;
     33begin
     34  try
     35    InFile := TFileStream.Create(FileName, fmOpenRead);
     36    Src := TXMLInputSource.Create(InFile);
     37    Parser := TDOMParser.Create;
     38    Parser.Options.PreserveWhitespace := True;
     39    Parser.Parse(Src, Doc);
     40  finally
     41    Src.Free;
     42    Parser.Free;
     43    InFile.Free;
     44  end;
     45end;
    2646
    2747function GetTimeZoneBias: Integer;

  • trunk/UCore.lfm

    r189 r200  
    34763476    AppName = 'Acronym Decoder'
    34773477    Description = 'A simple tool for quick searching of meaning for various acronyms and abbreviations.'
    3478     ReleaseDate = 43293
     3478    ReleaseDate = 43343
    34793479    RegistryKey = '\Software\'
    34803480    RegistryRoot = rrKeyCurrentUser

  • trunk/UCore.pas

    r178 r200  
    251251  //Core.ScaleDPI1.DPI := Point(200, 200);
    252252  {$IFDEF WINDOWS}
    253   Core.ScaleDPI1.ScaleControl(FormMain.CoolBar1, Core.ScaleDPI1.DesignDPI);
    254253  Core.ScaleDPI1.ScaleImageList(ImageList1, Core.ScaleDPI1.DesignDPI);
    255254  {$ENDIF}
Note: See TracChangeset for help on using the changeset viewer.