~ubuntu-branches/ubuntu/saucy/lazarus/saucy

« back to all changes in this revision

Viewing changes to lcl/themes.pas

  • Committer: Package Import Robot
  • Author(s): Paul Gevers, Abou Al Montacir, Bart Martens, Paul Gevers
  • Date: 2013-06-08 14:12:17 UTC
  • mfrom: (1.1.9)
  • Revision ID: package-import@ubuntu.com-20130608141217-7k0cy9id8ifcnutc
Tags: 1.0.8+dfsg-1
[ Abou Al Montacir ]
* New upstream major release and multiple maintenace release offering many
  fixes and new features marking a new milestone for the Lazarus development
  and its stability level.
  - The detailed list of changes can be found here:
    http://wiki.lazarus.freepascal.org/Lazarus_1.0_release_notes
    http://wiki.lazarus.freepascal.org/Lazarus_1.0_fixes_branch
* LCL changes:
  - LCL is now a normal package.
      + Platform independent parts of the LCL are now in the package LCLBase
      + LCL is automatically recompiled when switching the target platform,
        unless pre-compiled binaries for this target are already installed.
      + No impact on existing projects.
      + Linker options needed by LCL are no more added to projects that do
        not use the LCL package.
  - Minor changes in LCL basic classes behaviour
      + TCustomForm.Create raises an exception if a form resource is not
        found.
      + TNotebook and TPage: a new implementation of these classes was added.
      + TDBNavigator: It is now possible to have focusable buttons by setting
        Options = [navFocusableButtons] and TabStop = True, useful for
        accessibility and for devices with neither mouse nor touch screen.
      + Names of TControlBorderSpacing.GetSideSpace and GetSpace were swapped
        and are now consistent. GetSideSpace = Around + GetSpace.
      + TForm.WindowState=wsFullscreen was added
      + TCanvas.TextFitInfo was added to calculate how many characters will
        fit into a specified Width. Useful for word-wrapping calculations.
      + TControl.GetColorResolvingParent and
        TControl.GetRGBColorResolvingParent were added, simplifying the work
        to obtain the final color of the control while resolving clDefault
        and the ParentColor.
      + LCLIntf.GetTextExtentExPoint now has a good default implementation
        which works in any platform not providing a specific implementation.
        However, Widgetset specific implementation is better, when available.
      + TTabControl was reorganized. Now it has the correct class hierarchy
        and inherits from TCustomTabControl as it should.
  - New unit in the LCL:
      + lazdialogs.pas: adds non-native versions of various native dialogs,
        for example TLazOpenDialog, TLazSaveDialog, TLazSelectDirectoryDialog.
        It is used by widgetsets which either do not have a native dialog, or
        do not wish to use it because it is limited. These dialogs can also be
        used by user applications directly.
      + lazdeviceapis.pas: offers an interface to more hardware devices such
        as the accelerometer, GPS, etc. See LazDeviceAPIs
      + lazcanvas.pas: provides a TFPImageCanvas descendent implementing
        drawing in a LCL-compatible way, but 100% in Pascal.
      + lazregions.pas. LazRegions is a wholly Pascal implementation of
        regions for canvas clipping, event clipping, finding in which control
        of a region tree one an event should reach, for drawing polygons, etc.
      + customdrawncontrols.pas, customdrawndrawers.pas,
        customdrawn_common.pas, customdrawn_android.pas and
        customdrawn_winxp.pas: are the Lazarus Custom Drawn Controls -controls
        which imitate the standard LCL ones, but with the difference that they
        are non-native and support skinning.
  - New APIs added to the LCL to improve support of accessibility software
    such as screen readers.
* IDE changes:
  - Many improvments.
  - The detailed list of changes can be found here:
    http://wiki.lazarus.freepascal.org/New_IDE_features_since#v1.0_.282012-08-29.29
    http://wiki.lazarus.freepascal.org/Lazarus_1.0_release_notes#IDE_Changes
* Debugger / Editor changes:
  - Added pascal sources and breakpoints to the disassembler
  - Added threads dialog.
* Components changes:
  - TAChart: many fixes and new features
  - CodeTool: support Delphi style generics and new syntax extensions.
  - AggPas: removed to honor free licencing. (Closes: Bug#708695)
[Bart Martens]
* New debian/watch file fixing issues with upstream RC release.
[Abou Al Montacir]
* Avoid changing files in .pc hidden directory, these are used by quilt for
  internal purpose and could lead to surprises during build.
[Paul Gevers]
* Updated get-orig-source target and it compinion script orig-tar.sh so that they
  repack the source file, allowing bug 708695 to be fixed.

Show diffs side-by-side

added added

removed removed

Lines of Context:
48
48
uses
49
49
  // no Graphics or Controls can be used here to prevent circular references
50
50
  //
51
 
  Types, Math, Classes, LCLProc, LCLType, TmSchema;
 
51
  SysUtils, Types, GraphType, Math, Classes, LCLProc, LCLType, Graphics,
 
52
  TmSchema;
52
53
  
53
54
type
54
55
  // These are all elements which can be themed.
435
436
    function UseThemes: Boolean; virtual;
436
437
    function ThemedControlsEnabled: Boolean; virtual;
437
438
 
438
 
    function InternalColorToRGB(Details: TThemedElementDetails; Color: LongInt): LongInt; virtual;
 
439
    function InternalColorToRGB(Details: TThemedElementDetails; Color: LongInt): COLORREF; virtual;
439
440
    procedure InternalDrawParentBackground(Window: HWND; Target: HDC; Bounds: PRect); virtual;
440
441
  public
441
442
    constructor Create;
475
476
    function GetElementDetails(Detail: TThemedWindow): TThemedElementDetails; overload;
476
477
    
477
478
    function GetDetailSize(Details: TThemedElementDetails): TSize; virtual;
 
479
    function GetDetailRegion(DC: HDC; Details: TThemedElementDetails; const R: TRect): HRGN; virtual;
478
480
    function GetStockImage(StockID: LongInt; out Image, Mask: HBitmap): Boolean; virtual;
479
481
    function GetOption(AOption: TThemeOption): Integer; virtual;
480
482
 
509
511
  // Do not modify the copyright in any way! Usage of this unit is prohibited without the copyright notice
510
512
  // in the compiled binary file.
511
513
  ThemeManagerCopyright: string = 'Theme manager © 2001-2005 Mike Lischke';
 
514
type
 
515
  TThemesImageDrawEvent = procedure(AImageList: TPersistent; ACanvas: TPersistent;
 
516
                     AX, AY, AIndex: Integer; ADrawEffect: TGraphicsDrawEffect);
 
517
var
 
518
  ThemesImageDrawEvent: TThemesImageDrawEvent = nil; // set by unit ImgList if used
512
519
 
513
520
implementation
514
521
 
515
522
uses
516
 
  SysUtils, InterfaceBase, LCLIntf, GraphType, Graphics, ImgList;
 
523
  InterfaceBase, LCLIntf;
517
524
 
518
525
//----------------------------------------------------------------------------------------------------------------------
519
526
 
1883
1890
  end;
1884
1891
end;
1885
1892
 
 
1893
function TThemeServices.GetDetailRegion(DC: HDC;
 
1894
  Details: TThemedElementDetails; const R: TRect): HRGN;
 
1895
begin
 
1896
  Result := 0;
 
1897
end;
 
1898
 
1886
1899
function TThemeServices.GetStockImage(StockID: LongInt; out Image, Mask: HBitmap): Boolean;
1887
 
var
1888
 
  img : TBitmap;
1889
1900
begin
1890
 
  case StockID of
1891
 
    idButtonClose:
1892
 
    begin
1893
 
      img:=TBitmap.Create;
1894
 
      img.SetSize(16, 16);
1895
 
      img.PixelFormat:=pf24bit;
1896
 
      img.Transparent:=True;
1897
 
      img.TransparentColor:=clLime;
1898
 
      img.Canvas.AntialiasingMode:=amOff;
1899
 
      img.Canvas.Brush.Color:=img.TransparentColor;
1900
 
      img.Canvas.Brush.Style:=bsSolid;
1901
 
      img.Canvas.FillRect(Rect(0,0,img.Width,img.Height));
1902
 
      img.Canvas.Pen.Color:=clBlack;
1903
 
      img.Canvas.Pen.Width:=2;
1904
 
      img.Canvas.Line(4,4,img.Width-3, img.Height-3);
1905
 
      img.Canvas.Line(img.Width-4, 4, 3, img.Height-3);
1906
 
      Mask:=img.ReleaseMaskHandle;
1907
 
      Image:=img.ReleaseHandle;
1908
 
      img.Free;
1909
 
      Result:=True;
1910
 
    end;
1911
 
  else
1912
 
    Result := False;
1913
 
  end;
 
1901
  Result := False;
1914
1902
end;
1915
1903
 
1916
1904
function TThemeServices.GetOption(AOption: TThemeOption): Integer;
2015
2003
 
2016
2004
  procedure FillWithDottedBrush(ARect: TRect; Color1, Color2: TColor);
2017
2005
  var
2018
 
    OldColor1, OldColor2: TColor;
 
2006
    OldColor1, OldColor2: TColorRef;
2019
2007
  begin
2020
2008
    OldColor1 := SetBkColor(DC, ColorToRGB(Color1));
2021
2009
    OldColor2 := SetTextColor(DC, ColorToRGB(Color2));
2159
2147
              Dec(Bottom);
2160
2148
          end;
2161
2149
          Rectangle(DC, ARect.Left, ARect.Top, ARect.Right, ARect.Bottom);
2162
 
          Tmp := (ARect.Bottom + ARect.Top) shr 1;
 
2150
          Tmp := Integer((ARect.Bottom + ARect.Top) shr 1);
2163
2151
          MoveToEx(DC, ARect.Left + 2, Tmp, nil);
2164
2152
          LineTo(DC, ARect.Right - 2, Tmp);
2165
2153
          if Details.State = GLPS_CLOSED then
2205
2193
  Details: TThemedElementDetails; const P: TPoint; AImageList: TPersistent;
2206
2194
  Index: Integer);
2207
2195
var
2208
 
  Canvas: TCanvas absolute ACanvas;
2209
 
  ImageList: TCustomImageList absolute AImageList;
2210
2196
  AEffect: TGraphicsDrawEffect;
2211
2197
begin
 
2198
  if not Assigned(ThemesImageDrawEvent) then exit;
2212
2199
  if IsDisabled(Details) then
2213
2200
    AEffect := gdeDisabled
2214
2201
  else
2219
2206
    AEffect := gdeHighlighted
2220
2207
  else
2221
2208
    AEffect := gdeNormal;
2222
 
  ImageList.Draw(Canvas, P.X, P.Y, Index, AEffect);
 
2209
  ThemesImageDrawEvent(AImageList, ACanvas, P.X, P.Y, Index, AEffect);
2223
2210
end;
2224
2211
 
2225
2212
//----------------------------------------------------------------------------------------------------------------------
2251
2238
  // teHeader should not be here, it has no disabled state
2252
2239
 
2253
2240
  Result := False;
2254
 
  if (Details.Element in [teButton, teToolBar]) or
 
2241
  if (Details.Element in [teButton, teToolBar, teComboBox]) or
2255
2242
     ((Details.Element = teRebar) and (Details.Part >= RP_BAND)) or
2256
2243
     ((Details.Element = teWindow) and (Details.Part >= WP_SYSBUTTON) and
2257
2244
     (Details.Part <= WP_MDIHELPBUTTON)) then
2261
2248
function TThemeServices.IsPushed(Details: TThemedElementDetails): Boolean;
2262
2249
begin
2263
2250
  Result := False;
2264
 
  if (Details.Element in [teButton, teToolBar, teHeader]) or
 
2251
  if (Details.Element in [teButton, teToolBar, teHeader, teComboBox]) or
2265
2252
     ((Details.Element = teRebar) and (Details.Part >= RP_BAND)) or
2266
2253
     ((Details.Element = teWindow) and (Details.Part >= WP_SYSBUTTON) and
2267
2254
     (Details.Part <= WP_MDIHELPBUTTON)) then
2271
2258
function TThemeServices.IsHot(Details: TThemedElementDetails): Boolean;
2272
2259
begin
2273
2260
  Result := False;
2274
 
  if (Details.Element in [teButton, teToolBar, teHeader]) or
 
2261
  if (Details.Element in [teButton, teToolBar, teHeader, teComboBox]) or
2275
2262
     ((Details.Element = teRebar) and (Details.Part >= RP_BAND)) or
2276
2263
     ((Details.Element = teWindow) and (Details.Part >= WP_SYSBUTTON) and
2277
2264
     (Details.Part <= WP_MDIHELPBUTTON)) then
2318
2305
end;
2319
2306
 
2320
2307
function TThemeServices.InternalColorToRGB(Details: TThemedElementDetails;
2321
 
  Color: LongInt): LongInt;
 
2308
  Color: LongInt): COLORREF;
2322
2309
begin
2323
2310
  Result := Graphics.ColorToRGB(Color);
2324
2311
end;
2339
2326
begin
2340
2327
  TXTStyle := Canvas.TextStyle;
2341
2328
  TXTStyle.Opaque := False;
2342
 
  TXTStyle.Clipping := True;
 
2329
  TXTStyle.Clipping := (Flags and DT_NOCLIP) = 0;
2343
2330
  TXTStyle.ShowPrefix := (Flags and DT_NOPREFIX) = 0;
 
2331
  TXTStyle.SingleLine := (Flags and DT_SINGLELINE) <> 0;
2344
2332
 
2345
2333
  if (Flags and DT_CENTER) <> 0 then
2346
2334
    TXTStyle.Alignment := taCenter
2361
2349
    // set color here, otherwise SystemFont is wrong if the button was disabled before
2362
2350
  TXTStyle.SystemFont := Canvas.Font.IsDefault;//Match System Default Style
2363
2351
 
 
2352
  TXTStyle.Wordbreak := (Flags and DT_WORDBREAK) <> 0;
 
2353
  if not TXTStyle.Wordbreak then
 
2354
    TXTStyle.EndEllipsis := (Flags and DT_END_ELLIPSIS) <> 0
 
2355
  else
 
2356
    TXTStyle.EndEllipsis := False;
 
2357
 
2364
2358
  OldColor := Canvas.Font.Color;
2365
2359
  if IsDisabled(Details) then
2366
2360
  begin