← Back to branch summary

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

« back to all changes in this revision

Viewing changes to components/customdrawn/customdrawn_extra1.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
http://bugs.debian.org/708695
[ 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:
components/customdrawn/customdrawn_extra1.pas
 
1
unit customdrawn_extra1;
 
2
 
 
3
{$mode objfpc}{$H+}
 
4
 
 
5
interface
 
6
 
 
7
uses
 
8
  // RTL
 
9
  Classes, SysUtils, Types,
 
10
  // LCL -> Use only TForm, TWinControl, TCanvas and TLazIntfImage
 
11
  Graphics, Controls, LCLType,
 
12
  //
 
13
  customdrawndrawers, customdrawn_common;
 
14
 
 
15
type
 
16
 
 
17
  { TCDDrawerExtra1 }
 
18
 
 
19
  TCDDrawerExtra1 = class(TCDDrawerCommon)
 
20
  public
 
21
    function GetMeasures(AMeasureID: Integer): Integer; override;
 
22
    // ===================================
 
23
    // Common Controls Tab
 
24
    // ===================================
 
25
    procedure DrawTrackBar(ADest: TCanvas; ASize: TSize;
 
26
      AState: TCDControlState; AStateEx: TCDPositionedCStateEx); override;
 
27
  end;
 
28
{  TCDButtonDrawerGrad = class(TCDButtonDrawer)
 
29
  public
 
30
    procedure DrawToIntfImage(ADest: TFPImageCanvas; CDButton: TCDButton); override;
 
31
    procedure DrawToCanvas(ADest: TCanvas; CDButton: TCDButton); override;
 
32
  end;
 
33
 
 
34
  TCDTrackBarDrawerGraph = class(TCDTrackBarDrawer)
 
35
  public
 
36
    procedure DrawToIntfImage(ADest: TFPImageCanvas; FPImg: TLazIntfImage;
 
37
      CDTrackBar: TCDTrackBar); override;
 
38
    procedure GetGeometry(var ALeftBorder, ARightBorder: Integer); override;
 
39
  end;}
 
40
 
 
41
implementation
 
42
 
 
43
{procedure TCDButtonDrawerGrad.DrawToIntfImage(ADest: TFPImageCanvas;
 
44
  CDButton: TCDButton);
 
45
begin
 
46
 
 
47
end;
 
48
 
 
49
procedure TCDButtonDrawerGrad.DrawToCanvas(ADest: TCanvas; CDButton: TCDButton);
 
50
var
 
51
  TmpB: TBitmap;
 
52
  Str: string;
 
53
begin
 
54
  // Button shape -> This crashes in Gtk2
 
55
  TmpB := TBitmap.Create;
 
56
  TmpB.Width := CDButton.Width;
 
57
  TmpB.Height := CDButton.Height;
 
58
  TmpB.Canvas.Brush.Color := CDButton.Color;
 
59
  TmpB.Canvas.Brush.Style := bsSolid;
 
60
  TmpB.Canvas.RoundRect(0, 0, TmpB.Width, TmpB.Height, 8, 8);
 
61
  //  CDButton.SetShape(TmpB);
 
62
 
 
63
  with TmpB.Canvas do
 
64
  begin
 
65
    Brush.Style := bsSolid;
 
66
    Brush.Color := CDButton.Parent.Color;
 
67
    Pen.Color := Brush.Color;
 
68
    Rectangle(0, 0, Width, Height);
 
69
    FillRect(0, 0, Width, Height);
 
70
    Brush.Color := GetAColor(CDButton.Color, 90);
 
71
  end;
 
72
 
 
73
  // Button image
 
74
  if CDButton.IsDown then
 
75
    DrawCDButtonDown(TmpB.Canvas, CDButton.GetRGBBackgroundColor)
 
76
  else if CDButton.Focused then
 
77
    //GradientFill(GetUColor(CDButton.Color, 50), GetAColor(CDButton.Color, 60), TmpB.Canvas);
 
78
    GradientFill(clWhite, GetAColor(CDButton.Color, 96), TmpB.Canvas)
 
79
  else
 
80
    //GradientFill(GetUColor(CDButton.Color, 10), GetAColor(CDButton.Color, 20), TmpB.Canvas);
 
81
    GradientFill(clWhite, CDButton.Color, TmpB.Canvas);
 
82
 
 
83
  ADest.Draw(0, 0, TmpB);
 
84
 
 
85
  TmpB.Free;
 
86
 
 
87
  // Button text
 
88
  ADest.Font.Assign(CDButton.Font);
 
89
  ADest.Brush.Style := bsClear;
 
90
  ADest.Pen.Style := psSolid;
 
91
  Str := CDButton.Caption;
 
92
  ADest.TextOut((CDButton.Width - ADest.TextWidth(Str)) div 2,
 
93
    (CDButton.Height - ADest.TextHeight(Str)) div 2, Str);
 
94
end;
 
95
 
 
96
{ TCDTrackBarDrawer }
 
97
 
 
98
procedure TCDTrackBarDrawerGraph.DrawToIntfImage(ADest: TFPImageCanvas;
 
99
  FPImg: TLazIntfImage; CDTrackBar: TCDTrackBar);
 
100
 
 
101
procedure TCDTrackBarDrawerGraph.GetGeometry(var ALeftBorder,
 
102
  ARightBorder: Integer);
 
103
begin
 
104
  ALeftBorder := 9;
 
105
  ARightBorder := 9;
 
106
end;
 
107
 
 
108
  RegisterTrackBarDrawer(TCDTrackBarDrawerGraph.Create, dsExtra1);}
 
109
 
 
110
{ TCDDrawerExtra1 }
 
111
 
 
112
function TCDDrawerExtra1.GetMeasures(AMeasureID: Integer): Integer;
 
113
begin
 
114
  case AMeasureId of
 
115
  TCDTRACKBAR_LEFT_SPACING:  Result := 9;
 
116
  TCDTRACKBAR_RIGHT_SPACING: Result := 9;
 
117
  else
 
118
    Result:=inherited GetMeasures(AMeasureID);
 
119
  end;
 
120
end;
 
121
 
 
122
procedure TCDDrawerExtra1.DrawTrackBar(ADest: TCanvas;
 
123
  ASize: TSize; AState: TCDControlState; AStateEx: TCDPositionedCStateEx);
 
124
var
 
125
  lDrawingBottom, StepsCount, i: Integer;
 
126
  pStart, pEnd: integer; // for drawing the decorative bars
 
127
  dRect: TRect;
 
128
  pStepWidth, pHalfStepWidth: Integer;
 
129
  CDBarEdge: Integer;
 
130
begin
 
131
  CDBarEdge := GetMeasures(TCDTRACKBAR_LEFT_SPACING)
 
132
    + GetMeasures(TCDTRACKBAR_RIGHT_SPACING);
 
133
 
 
134
  // Preparations
 
135
  StepsCount := AStateEx.PosCount;
 
136
  pStepWidth := (ASize.cx - CDBarEdge) div StepsCount;
 
137
  pHalfStepWidth := (ASize.cx - CDBarEdge) div (StepsCount * 2);
 
138
 
 
139
  // The bottom part of the drawing
 
140
  lDrawingBottom := ASize.cy - 10;
 
141
 
 
142
  // Background
 
143
 
 
144
  ADest.Brush.Color := AStateEx.ParentRGBColor;
 
145
  ADest.Brush.Style := bsSolid;
 
146
  ADest.Pen.Style := psSolid;
 
147
  ADest.Pen.Color := AStateEx.ParentRGBColor;
 
148
  ADest.Rectangle(0, 0, ASize.cx, ASize.cy);
 
149
 
 
150
  // Draws the double-sided arrow in the center of the slider
 
151
 
 
152
  ADest.Brush.Color := ColorToRGB($006BB6E6);
 
153
  ADest.Pen.Style := psSolid;
 
154
  ADest.Pen.Color := ColorToRGB($006BB6E6);
 
155
  ADest.Line(0, lDrawingBottom, ASize.cx, lDrawingBottom);
 
156
  ADest.Line(3, lDrawingBottom - 1, 6, lDrawingBottom - 1);
 
157
  ADest.Line(5, lDrawingBottom - 2, 6, lDrawingBottom - 2);
 
158
  ADest.Line(3, lDrawingBottom + 1, 6, lDrawingBottom + 1);
 
159
  ADest.Line(5, lDrawingBottom + 2, 6, lDrawingBottom + 2);
 
160
  ADest.Line(ASize.cx - 1 - 3, lDrawingBottom - 1, ASize.cx - 1 - 6, lDrawingBottom - 1);
 
161
  ADest.Line(ASize.cx - 1 - 5, lDrawingBottom - 2, ASize.cx - 1 - 6, lDrawingBottom - 2);
 
162
  ADest.Line(ASize.cx - 1 - 3, lDrawingBottom + 1, ASize.cx - 1 - 6, lDrawingBottom + 1);
 
163
  ADest.Line(ASize.cx - 1 - 5, lDrawingBottom + 2, ASize.cx - 1 - 6, lDrawingBottom + 2);
 
164
  ADest.Pen.Color := ColorToRGB(clGray);
 
165
  ADest.Brush.Color := ColorToRGB($00F0F0F0);
 
166
 
 
167
  // Draws the decorative bars and also the slider button
 
168
 
 
169
  pStart := 10 - 1;
 
170
  for i := 0 to StepsCount - 1 do
 
171
  begin
 
172
    // Draw the decorative bars
 
173
    dRect := Bounds(
 
174
      pStart + pHalfStepWidth,
 
175
      lDrawingBottom - 5 - i,
 
176
      Round(pStepWidth)-3,
 
177
      4 + i);
 
178
 
 
179
    ADest.Brush.Style := bsSolid;
 
180
    ADest.Pen.Style := psSolid;
 
181
    ADest.Pen.Color := clBlack;
 
182
    if i <= AStateEx.Position then
 
183
      ADest.Brush.Color := clDkGray
 
184
    else
 
185
      ADest.Brush.Color := clWhite;
 
186
 
 
187
    ADest.Rectangle(dRect);
 
188
 
 
189
    // Draw the slider
 
190
 
 
191
    if i = AStateEx.Position then
 
192
    begin
 
193
      ADest.Brush.FPColor := TColorToFPColor(ColorToRGB($006BB6E6));
 
194
      ADest.Brush.Style := bsSolid;
 
195
      ADest.Rectangle(pStart, lDrawingBottom + 1, pStart + 10, lDrawingBottom + 6);
 
196
      ADest.Pen.Color := ColorToRGB($005BA6C6);
 
197
      ADest.RecTangle(pStart, lDrawingBottom + 2, pStart + 10, lDrawingBottom + 7);
 
198
      ADest.Pen.Color := ColorToRGB($006BB6E6);
 
199
      ADest.RecTangle(pStart, lDrawingBottom, pStart + 10, lDrawingBottom + 2);
 
200
    end;
 
201
    pStart := pStart + pStepWidth;
 
202
  end;
 
203
 
 
204
  ADest.Pen.Color := ColorToRGB($007BC6F6);
 
205
  ADest.Line(7, lDrawingBottom - 1, ASize.cx - 8, lDrawingBottom - 1);
 
206
  ADest.Line(7, lDrawingBottom + 1, ASize.cx - 8, lDrawingBottom + 1);
 
207
  ADest.Pixels[2, lDrawingBottom - 1] := ADest.Pen.Color;
 
208
  ADest.Pixels[4, lDrawingBottom - 2] := ADest.Pen.Color;
 
209
  ADest.Pixels[2, lDrawingBottom + 1] := ADest.Pen.Color;
 
210
  ADest.Pixels[4, lDrawingBottom + 2] := ADest.Pen.Color;
 
211
  ADest.Pixels[6, lDrawingBottom - 3] := ADest.Pen.Color;
 
212
  ADest.Pixels[6, lDrawingBottom + 3] := ADest.Pen.Color;
 
213
  ADest.Pixels[ASize.cx - 1 - 2, lDrawingBottom - 1] := ADest.Pen.Color;
 
214
  ADest.Pixels[ASize.cx - 1 - 4, lDrawingBottom - 2] := ADest.Pen.Color;
 
215
  ADest.Pixels[ASize.cx - 1 - 2, lDrawingBottom + 1] := ADest.Pen.Color;
 
216
  ADest.Pixels[ASize.cx - 1 - 4, lDrawingBottom + 2] := ADest.Pen.Color;
 
217
  ADest.Pixels[ASize.cx - 1 - 6, lDrawingBottom - 3] := ADest.Pen.Color;
 
218
  ADest.Pixels[ASize.cx - 1 - 6, lDrawingBottom + 3] := ADest.Pen.Color;
 
219
end;
 
220
 
 
221
initialization
 
222
  RegisterDrawer(TCDDrawerExtra1.Create, dsExtra1);
 
223
end.
 
224