Changeset 504 for Common


Ignore:
Timestamp:
Feb 14, 2018, 10:40:52 AM (7 years ago)
Author:
chronos
Message:
Location:
Common
Files:
4 edited

Legend:

Unmodified
Added
Removed

  • Common/Common.lpk

    r486 r504  
    1111      <PathDelim Value="\"/>
    1212      <SearchPaths>
    13         <UnitOutputDirectory Value="lib\$(TargetCPU)-$(TargetOS)"/>
     13        <UnitOutputDirectory Value="lib\$(TargetCPU)-$(TargetOS)-$(BuildMode)"/>
    1414      </SearchPaths>
     15      <Parsing>
     16        <SyntaxOptions>
     17          <SyntaxMode Value="Delphi"/>
     18          <CStyleOperator Value="False"/>
     19          <AllowLabel Value="False"/>
     20          <CPPInline Value="False"/>
     21        </SyntaxOptions>
     22      </Parsing>
     23      <CodeGeneration>
     24        <Optimizations>
     25          <OptimizationLevel Value="0"/>
     26        </Optimizations>
     27      </CodeGeneration>
     28      <Linking>
     29        <Debugging>
     30          <GenerateDebugInfo Value="False"/>
     31        </Debugging>
     32      </Linking>
     33      <Other>
     34        <CompilerMessages>
     35          <IgnoredMessages idx5024="True"/>
     36        </CompilerMessages>
     37      </Other>
    1538    </CompilerOptions>
    1639    <Description Value="Various libraries"/>
    1740    <License Value="GNU/GPL"/>
    1841    <Version Minor="7"/>
    19     <Files Count="20">
     42    <Files Count="21">
    2043      <Item1>
    2144        <Filename Value="StopWatch.pas"/>
    … …  
    106129        <UnitName Value="UScaleDPI"/>
    107130      </Item20>
     131      <Item21>
     132        <Filename Value="UTheme.pas"/>
     133        <HasRegisterProc Value="True"/>
     134        <UnitName Value="UTheme"/>
     135      </Item21>
    108136    </Files>
    109137    <i18n>

  • Common/Common.pas

    r487 r504  
    88
    99uses
    10   StopWatch, UCommon, UDebugLog, UDelay, UPrefixMultiplier, UURI, UThreading, 
    11   UMemory, UResetableThread, UPool, ULastOpenedList, URegistry, 
    12   UJobProgressView, UXMLUtils, UApplicationInfo, USyncCounter, UListViewSort, 
    13   UPersistentForm, UFindFile, UScaleDPI, LazarusPackageIntf;
     10  StopWatch, UCommon, UDebugLog, UDelay, UPrefixMultiplier, UURI, UThreading,
     11  UMemory, UResetableThread, UPool, ULastOpenedList, URegistry,
     12  UJobProgressView, UXMLUtils, UApplicationInfo, USyncCounter, UListViewSort,
     13  UPersistentForm, UFindFile, UScaleDPI, UTheme, LazarusPackageIntf;
    1414
    1515implementation
    … …  
    2525  RegisterUnit('UFindFile', @UFindFile.Register);
    2626  RegisterUnit('UScaleDPI', @UScaleDPI.Register);
     27  RegisterUnit('UTheme', @UTheme.Register);
    2728end;
    2829

  • Common/UListViewSort.pas

    r489 r504  
    8181    FOnChange: TNotifyEvent;
    8282    FStringGrid1: TStringGrid;
    83     procedure DoOnKeyUp(Sender: TObject; var Key: Word; Shift: TShiftState);
    84     procedure DoOnResize(Sender: TObject);
     83    procedure GridDoOnKeyUp(Sender: TObject; var Key: Word; Shift: TShiftState);
     84    procedure GridDoOnResize(Sender: TObject);
    8585  public
    8686    constructor Create(AOwner: TComponent); override;
    … …  
    110110{ TListViewFilter }
    111111
    112 procedure TListViewFilter.DoOnKeyUp(Sender: TObject; var Key: Word;
     112procedure TListViewFilter.GridDoOnKeyUp(Sender: TObject; var Key: Word;
    113113  Shift: TShiftState);
    114114begin
    … …  
    117117end;
    118118
    119 procedure TListViewFilter.DoOnResize(Sender: TObject);
     119procedure TListViewFilter.GridDoOnResize(Sender: TObject);
    120120begin
    121121  FStringGrid1.DefaultRowHeight := FStringGrid1.Height;
    … …  
    135135  FStringGrid1.Options := [goFixedHorzLine, goFixedVertLine, goVertLine,
    136136    goHorzLine, goRangeSelect, goEditing, goAlwaysShowEditor, goSmoothScroll];
    137   FStringGrid1.OnKeyUp := DoOnKeyUp;
    138   FStringGrid1.OnResize := DoOnResize;
     137  FStringGrid1.OnKeyUp := GridDoOnKeyUp;
     138  FStringGrid1.OnResize := GridDoOnResize;
    139139end;
    140140
    … …  
    197197  if AMsg.Msg = WM_NOTIFY then
    198198  begin
    199     Code := PHDNotify(vMsgNotify.NMHdr)^.Hdr.Code;
     199    Code := NMHDR(PHDNotify(vMsgNotify.NMHdr)^.Hdr).Code;
    200200    case Code of
    201201      HDN_ENDTRACKA, HDN_ENDTRACKW:
    … …  
    353353  TP1: TPoint;
    354354  XBias, YBias: Integer;
    355   OldColor: TColor;
     355  PenColor: TColor;
     356  BrushColor: TColor;
    356357  BiasTop, BiasLeft: Integer;
    357358  Rect1: TRect;
    … …  
    365366  Item.Left := 0;
    366367  GetCheckBias(XBias, YBias, BiasTop, BiasLeft, ListView);
    367   OldColor := ListView.Canvas.Pen.Color;
     368  PenColor := ListView.Canvas.Pen.Color;
     369  BrushColor := ListView.Canvas.Brush.Color;
    368370  //TP1 := Item.GetPosition;
    369371  lRect := Item.DisplayRect(drBounds); // Windows 7 workaround
    … …  
    408410  end;
    409411  //ListView.Canvas.Brush.Color := ListView.Color;
    410   ListView.Canvas.Brush.Color := clWindow;
    411   ListView.Canvas.Pen.Color := OldColor;
     412  ListView.Canvas.Brush.Color := BrushColor;
     413  ListView.Canvas.Pen.Color := PenColor;
    412414end;
    413415

  • Common/UTheme.pas

    r503 r504  
    55uses
    66  Classes, SysUtils, Graphics, ComCtrls, Controls, ExtCtrls, Menus, StdCtrls,
    7   Spin, Forms;
     7  Spin, Forms, Contnrs, Grids;
    88
    99type
    10   TTheme = class(TComponent)
    11   private
    12     FThemeName: string;
    13     procedure SetThemeName(AValue: string);
    14   public
     10  TTheme = class
     11    Name: string;
    1512    ColorWindow: TColor;
    1613    ColorWindowText: TColor;
    … …  
    1815    ColorControlText: TColor;
    1916    ColorControlSelected: TColor;
     17  end;
     18
     19  { TThemes }
     20
     21  TThemes = class(TObjectList)
     22    function AddNew(Name: string): TTheme;
     23    function FindByName(Name: string): TTheme;
     24    procedure LoadToStrings(Strings: TStrings);
     25  end;
     26
     27  { TThemeManager }
     28
     29  TThemeManager = class(TComponent)
     30  private
     31    FTheme: TTheme;
     32    procedure SetTheme(AValue: TTheme);
     33    procedure SetThemeName(AValue: TTheme);
     34  public
    2035    Used: Boolean;
     36    Themes: TThemes;
    2137    procedure ApplyTheme(Component: TComponent);
    2238    constructor Create(AOwner: TComponent); override;
     39    destructor Destroy; override;
    2340    procedure UseTheme(Form: TForm);
    24     property ThemeName: string read FThemeName write SetThemeName;
     41    property Theme: TTheme read FTheme write SetTheme;
    2542  end;
    2643
     44procedure Register;
    2745
    2846implementation
    2947
    30 procedure TTheme.SetThemeName(AValue: string);
     48{ TThemes }
     49
     50procedure Register;
    3151begin
    32   if FThemeName = AValue then Exit;
    33   FThemeName := AValue;
    34   if AValue = 'Dark' then begin
     52  RegisterComponents('Common', [TThemeManager]);
     53end;
     54
     55function TThemes.AddNew(Name: string): TTheme;
     56begin
     57  Result := TTheme.Create;
     58  Result.Name := Name;
     59  Add(Result);
     60end;
     61
     62function TThemes.FindByName(Name: string): TTheme;
     63var
     64  Theme: TTheme;
     65begin
     66  Result := nil;
     67  for Theme in Self do
     68    if Theme.Name = Name then begin
     69      Result := Theme;
     70      Exit;
     71    end;
     72end;
     73
     74procedure TThemes.LoadToStrings(Strings: TStrings);
     75var
     76  Theme: TTheme;
     77begin
     78  Strings.Clear;
     79  for Theme in Self do
     80    Strings.AddObject(Theme.Name, Theme);
     81end;
     82
     83procedure TThemeManager.SetThemeName(AValue: TTheme);
     84begin
     85  if FTheme = AValue then Exit;
     86  FTheme := AValue;
     87end;
     88
     89procedure TThemeManager.SetTheme(AValue: TTheme);
     90begin
     91  if FTheme = AValue then Exit;
     92  FTheme := AValue;
     93end;
     94
     95constructor TThemeManager.Create(AOwner: TComponent);
     96begin
     97  inherited;
     98  Themes := TThemes.Create;
     99  with Themes.AddNew('System') do begin
     100    ColorWindow := clWindow;
     101    ColorWindowText := clWindowText;
     102    ColorControl := clMenu;
     103    ColorControlText := clWindowText;
     104    ColorControlSelected := clWindow;
     105  end;
     106  Theme := TTheme(Themes.First);
     107  with Themes.AddNew('Dark') do begin
    35108    ColorWindow := RGBToColor($20, $20, $20);
    36109    ColorWindowText := clWhite;
    … …  
    38111    ColorControlText := clWhite;
    39112    ColorControlSelected := RGBToColor(96, 125, 155);
    40   end else
    41   if Avalue = 'Light' then begin
     113  end;
     114  with Themes.AddNew('Light') do begin
    42115    ColorWindow := clWhite;
    43116    ColorWindowText := clBlack;
    … …  
    45118    ColorControlText := clBlack;
    46119    ColorControlSelected := RGBToColor(196, 225, 255);
    47   end else begin
    48     FThemeName := 'System';
    49 
    50     ColorWindow := clBlack;
    51     ColorWindowText := clWhite;
    52     ColorControl := clBlack;
    53     ColorControlText := clWhite;
    54     ColorControlSelected := clWhite;
    55120  end;
    56121end;
    57122
    58 constructor TTheme.Create(AOwner: TComponent);
     123destructor TThemeManager.Destroy;
    59124begin
    60   inherited;
    61   ThemeName := 'System';
     125  Themes.Free;
     126  inherited Destroy;
    62127end;
    63128
    64 procedure TTheme.ApplyTheme(Component: TComponent);
     129procedure TThemeManager.ApplyTheme(Component: TComponent);
    65130var
    66131  Control: TControl;
    … …  
    73138    Control := (Component as TControl);
    74139    if (Control is TEdit) or (Control is TSpinEdit) or (Control is TComboBox) and
    75     (Control is TMemo) or (Control is TListView) then begin
    76       Control.Color := ColorWindow;
    77       Control.Font.Color := ColorWindowText;
     140    (Control is TMemo) or (Control is TListView) or (Control is TStringGrid) or
     141    (Control is TCheckBox) then begin
     142      Control.Color := FTheme.ColorWindow;
     143      Control.Font.Color := FTheme.ColorWindowText;
    78144    end else begin
    79       Control.Color := ColorControl;
    80       Control.Font.Color := ColorControlText;
     145      Control.Color := FTheme.ColorControl;
     146      Control.Font.Color := FTheme.ColorControlText;
    81147    end;
    82 {      if ((Component as Control).ContextMenuStrip != null)
    83       begin
    84                     ApplyTheme((component as Control).ContextMenuStrip);
    85                 end;
    86             end;
    87 
    88             if (component is TButton) and (Name = 'System') then
    89             begin
    90                 (component as TButton).UseVisualStyleBackColor := true;
    91             end else
    92             if component is LinkLabel then
    93             begin
    94                 (component as LinkLabel).LinkColor = ColorControlText;
    95                 (component as LinkLabel).ActiveLinkColor = ColorControlText;
    96                 (component as LinkLabel).VisitedLinkColor = ColorControlText;
    97             end
    98             else
    99             if component is TabControl then
    100             begin
    101                 foreach (TabPage tabPage in (component as TabControl).TabPages)
    102                 begin
    103                     ApplyTheme(tabPage);
    104                 end;
    105             end else
    106             if component is TToolStrip then
    107             begin
    108                 (component as ToolStrip).RenderMode = ToolStripRenderMode.Professional;
    109                 (component as ToolStrip).Renderer = new ToolStripProfessionalRenderer(new ThemeColorTable());
    110                 foreach (ToolStripItem item in (component as ToolStrip).Items)
    111                 begin
    112                     if item is TToolStripMenuItem then
    113                     begin
    114 
    115                         if ((item as ToolStripMenuItem).HasDropDownItems)
    116                             foreach (ToolStripItem dropDownItem in (item as ToolStripMenuItem).DropDownItems)
    117                             begin
    118                                 ApplyTheme(dropDownItem);
    119                             end;
    120                     end;
    121                     ApplyTheme(item);
    122                 end;
    123             end else
    124             if component is TToolStripItem then
    125             begin
    126                 (component as ToolStripItem).ForeColor = ColorControlText;
    127                 (component as ToolStripItem).BackColor = ColorControl;
    128             end else
    129             if component is TDataGridView then
    130             begin
    131                 (component as DataGridView).BackgroundColor = ColorWindow;
    132                 (component as DataGridView).DefaultCellStyle.BackColor = ColorWindow;
    133                 (component as DataGridView).DefaultCellStyle.ForeColor = ColorWindowText;
    134                 (component as DataGridView).ColumnHeadersDefaultCellStyle.BackColor = ColorWindow;
    135                 (component as DataGridView).ColumnHeadersDefaultCellStyle.ForeColor = ColorWindowText;
    136             end;
    137         end;
    138         }
    139148  end;
    140149end;
    141150
    142 procedure TTheme.UseTheme(Form: TForm);
     151procedure TThemeManager.UseTheme(Form: TForm);
    143152begin
    144   if not Used and (FThemeName = 'System') then Exit;
     153  if not Used and (FTheme.Name = 'System') then Exit;
    145154  ApplyTheme(Form);
    146155  Used := True;
Note: See TracChangeset for help on using the changeset viewer.