paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-08-30 05:30:45 +02:00
Code Issues Packages Projects Releases Wiki Activity

Separates the customdrawn drawers into 1 unit for each style and introduces a registration system to simply adding new drawers for people not so used to the code

Browse Source 
git-svn-id: trunk@33103 -
This commit is contained in:
sekelsenmat 2011-10-26 19:51:48 +00:00
parent 1c344c9372
commit 3e2490e6fc
10 changed files with 1157 additions and 1017 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

5
.gitattributes vendored
View File

@ -638,6 +638,11 @@ components/compilers/javascript/examples/jsclassxmlread.pas svneol=native#text/p
components/custom/README.txt svneol=native#text/plain
components/customdrawn/customdrawn.lpk svneol=native#text/plain
components/customdrawn/customdrawn.pas svneol=native#text/pascal
components/customdrawn/customdrawn_android.pas svneol=native#text/plain
components/customdrawn/customdrawn_extra1.pas svneol=native#text/plain
components/customdrawn/customdrawn_win2000.pas svneol=native#text/plain
components/customdrawn/customdrawn_wince.pas svneol=native#text/plain
components/customdrawn/customdrawn_winxp.pas svneol=native#text/plain
components/customdrawn/customdrawncontrols.pas svneol=native#text/pascal
components/customdrawn/customdrawnextras.pas svneol=native#text/plain
components/customdrawn/customdrawnutils.pas svneol=native#text/pascal

22
components/customdrawn/customdrawn.lpk
View File

@ -23,7 +23,7 @@
<CompilerPath Value="$(CompPath)"/>
</Other>
</CompilerOptions>
<Files Count="3">
<Files Count="8">
<Item1>
<Filename Value="customdrawnextras.pas"/>
<HasRegisterProc Value="True"/>
@ -37,6 +37,26 @@
<Filename Value="customdrawncontrols.pas"/>
<UnitName Value="customdrawncontrols"/>
</Item3>
<Item4>
<Filename Value="customdrawn_wince.pas"/>
<UnitName Value="customdrawn_wince"/>
</Item4>
<Item5>
<Filename Value="customdrawn_win2000.pas"/>
<UnitName Value="customdrawn_win2000"/>
</Item5>
<Item6>
<Filename Value="customdrawn_winxp.pas"/>
<UnitName Value="customdrawn_winxp"/>
</Item6>
<Item7>
<Filename Value="customdrawn_android.pas"/>
<UnitName Value="customdrawn_android"/>
</Item7>
<Item8>
<Filename Value="customdrawn_extra1.pas"/>
<UnitName Value="customdrawn_extra1"/>
</Item8>
</Files>
<Type Value="RunAndDesignTime"/>
<RequiredPkgs Count="3">

4
components/customdrawn/customdrawn.pas
View File

@ -7,7 +7,9 @@ unit customdrawn;
interface
uses
customdrawnextras, customdrawnutils, customdrawncontrols, LazarusPackageIntf;
customdrawnextras, customdrawnutils, customdrawncontrols, customdrawn_wince,
customdrawn_win2000, customdrawn_winxp, customdrawn_android,
customdrawn_extra1, LazarusPackageIntf;
implementation

79
components/customdrawn/customdrawn_android.pas Normal file
View File

@ -0,0 +1,79 @@
unit customdrawn_android;
{$mode objfpc}{$H+}
interface
uses
// RTL
Classes, SysUtils,
// fpimage
fpcanvas, fpimgcanv, fpimage,
// LCL -> Use only TForm, TWinControl, TCanvas and TLazIntfImage
Graphics, Controls, LCLType, LCLIntf, IntfGraphics,
//
customdrawncontrols, customdrawnutils;
type
TCDButtonDrawerAndroid = class(TCDButtonDrawer)
public
procedure DrawToIntfImage(ADest: TFPImageCanvas; CDButton: TCDButton); override;
procedure DrawToCanvas(ADest: TCanvas; CDButton: TCDButton;
FState: TCDButtonState); override;
end;
implementation
procedure TCDButtonDrawerAndroid.DrawToIntfImage(ADest: TFPImageCanvas;
CDButton: TCDButton);
begin
end;
procedure TCDButtonDrawerAndroid.DrawToCanvas(ADest: TCanvas;
CDButton: TCDButton; FState: TCDButtonState);
var
//TmpB: TBitmap;
Str: string;
begin
// Button shape -> This crashes in Gtk2
{ TmpB.Canvas.Brush.Color := CDButton.Color;
TmpB.Canvas.Brush.Style := bsSolid;
TmpB.Canvas.RoundRect(0, 0, TmpB.Width, TmpB.Height, 8, 8);
CDButton.SetShape(TmpB);
ADest.Draw(0, 0, TmpB);
TmpB.Free;
}
ADest.Brush.Color := CDButton.Parent.Color;
ADest.Brush.Style := bsSolid;
ADest.Pen.Color := ADest.Brush.Color;
ADest.RecTangle(0, 0, CDButton.Width, CDButton.Height);
// Button image
case FState of
bbsDown:
begin
DrawCDButtonDown(ADest, CDButton.GetRGBBackgroundColor);
end;
bbsFocused:
begin
DrawAndroidButton(ADest, GetAColor(CDButton.Color, 98));
end;
else
DrawAndroidButton(ADest, GetAColor(CDButton.Color, 96));
end;
// Button text
ADest.Font.Assign(CDButton.Font);
ADest.Brush.Style := bsClear;
ADest.Pen.Style := psSolid;
Str := CDButton.Caption;
ADest.TextOut((CDButton.Width - ADest.TextWidth(Str)) div 2,
(CDButton.Height - ADest.TextHeight(Str)) div 2, Str);
end;
initialization
RegisterButtonDrawer(TCDButtonDrawerAndroid.Create, dsAndroid);
end.

208
components/customdrawn/customdrawn_extra1.pas Normal file
View File

@ -0,0 +1,208 @@
unit customdrawn_extra1;
{$mode objfpc}{$H+}
interface
uses
// RTL
Classes, SysUtils,
// fpimage
fpcanvas, fpimgcanv, fpimage,
// LCL -> Use only TForm, TWinControl, TCanvas and TLazIntfImage
Graphics, Controls, LCLType, LCLIntf, IntfGraphics,
//
customdrawncontrols, customdrawnutils;
type
TCDButtonDrawerGrad = class(TCDButtonDrawer)
public
procedure DrawToIntfImage(ADest: TFPImageCanvas; CDButton: TCDButton); override;
procedure DrawToCanvas(ADest: TCanvas; CDButton: TCDButton;
FState: TCDButtonState); override;
end;
TCDTrackBarDrawerGraph = class(TCDTrackBarDrawer)
public
procedure DrawToIntfImage(ADest: TFPImageCanvas; FPImg: TLazIntfImage;
CDTrackBar: TCDTrackBar); override;
procedure GetGeometry(var ALeftBorder, ARightBorder: Integer); override;
end;
implementation
procedure TCDButtonDrawerGrad.DrawToIntfImage(ADest: TFPImageCanvas;
CDButton: TCDButton);
begin
end;
procedure TCDButtonDrawerGrad.DrawToCanvas(ADest: TCanvas; CDButton: TCDButton;
FState: TCDButtonState);
var
TmpB: TBitmap;
Str: string;
begin
// Button shape -> This crashes in Gtk2
TmpB := TBitmap.Create;
TmpB.Width := CDButton.Width;
TmpB.Height := CDButton.Height;
TmpB.Canvas.Brush.Color := CDButton.Color;
TmpB.Canvas.Brush.Style := bsSolid;
TmpB.Canvas.RoundRect(0, 0, TmpB.Width, TmpB.Height, 8, 8);
// CDButton.SetShape(TmpB);
with TmpB.Canvas do
begin
Brush.Style := bsSolid;
Brush.Color := CDButton.Parent.Color;
Pen.Color := Brush.Color;
Rectangle(0, 0, Width, Height);
FillRect(0, 0, Width, Height);
Brush.Color := GetAColor(CDButton.Color, 90);
end;
// Button image
case FState of
bbsDown:
begin
DrawCDButtonDown(TmpB.Canvas, CDButton.GetRGBBackgroundColor);
end;
bbsFocused:
//GradientFill(GetUColor(CDButton.Color, 50), GetAColor(CDButton.Color, 60), TmpB.Canvas);
GradientFill(clWhite, GetAColor(CDButton.Color, 96), TmpB.Canvas);
else
//GradientFill(GetUColor(CDButton.Color, 10), GetAColor(CDButton.Color, 20), TmpB.Canvas);
GradientFill(clWhite, CDButton.Color, TmpB.Canvas);
end;
ADest.Draw(0, 0, TmpB);
TmpB.Free;
// Button text
ADest.Font.Assign(CDButton.Font);
ADest.Brush.Style := bsClear;
ADest.Pen.Style := psSolid;
Str := CDButton.Caption;
ADest.TextOut((CDButton.Width - ADest.TextWidth(Str)) div 2,
(CDButton.Height - ADest.TextHeight(Str)) div 2, Str);
end;
{ TCDTrackBarDrawer }
procedure TCDTrackBarDrawerGraph.DrawToIntfImage(ADest: TFPImageCanvas;
FPImg: TLazIntfImage; CDTrackBar: TCDTrackBar);
const
CDBarEdge = 18;
var
lDrawingBottom, StepsCount, i: Integer;
pStart, pEnd: integer; // for drawing the decorative bars
dRect: TRect;
pStepWidth, pHalfStepWidth: Integer;
begin
// Sanity check
if CDTrackBar.Max - CDTrackBar.Min <= 0 then
raise Exception.Create('[TCDTrackBarDrawerGraph.DrawToIntfImage] Max-Min must be at least 1');
// Preparations
StepsCount := CDTrackBar.Max - CDTrackBar.Min + 1;
pStepWidth := (CDTrackBar.Width - CDBarEdge) div StepsCount;
pHalfStepWidth := (CDTrackBar.Width - CDBarEdge) div (StepsCount * 2);
// The bottom part of the drawing
lDrawingBottom := CDTrackBar.Height - 10;
// Background
if CDTrackBar.Parent = nil then
ADest.Brush.FPColor := colLtGray
else
ADest.Brush.FPColor := TColorToFPColor(ColorToRGB(CDTrackBar.Color));
ADest.Brush.Style := bsSolid;
ADest.Pen.Style := psClear;
ADest.Rectangle(0, 0, CDTrackBar.Width, CDTrackBar.Height);
ADest.Brush.FPColor := TColorToFPColor(ColorToRGB($006BB6E6));
// Draws the double-sided arrow in the center of the slider
ADest.Pen.Style := psSolid;
ADest.Pen.FPColor := TColorToFPColor(ColorToRGB($006BB6E6));
ADest.Line(0, lDrawingBottom, CDTrackBar.Width, lDrawingBottom);
ADest.Line(3, lDrawingBottom - 1, 6, lDrawingBottom - 1);
ADest.Line(5, lDrawingBottom - 2, 6, lDrawingBottom - 2);
ADest.Line(3, lDrawingBottom + 1, 6, lDrawingBottom + 1);
ADest.Line(5, lDrawingBottom + 2, 6, lDrawingBottom + 2);
ADest.Line(CDTrackBar.Width - 1 - 3, lDrawingBottom - 1, CDTrackBar.Width - 1 - 6, lDrawingBottom - 1);
ADest.Line(CDTrackBar.Width - 1 - 5, lDrawingBottom - 2, CDTrackBar.Width - 1 - 6, lDrawingBottom - 2);
ADest.Line(CDTrackBar.Width - 1 - 3, lDrawingBottom + 1, CDTrackBar.Width - 1 - 6, lDrawingBottom + 1);
ADest.Line(CDTrackBar.Width - 1 - 5, lDrawingBottom + 2, CDTrackBar.Width - 1 - 6, lDrawingBottom + 2);
ADest.Pen.FPColor := TColorToFPColor(ColorToRGB(clGray));
ADest.Brush.FPColor := TColorToFPColor(ColorToRGB($00F0F0F0));
// Draws the decorative bars and also the slider button
pStart := 10 - 1;
for i := 0 to StepsCount - 1 do
begin
// Draw the decorative bars
dRect := Bounds(
pStart + pHalfStepWidth,
lDrawingBottom - 5 - i,
Round(pStepWidth)-3,
4 + i);
ADest.Brush.Style := bsSolid;
ADest.Pen.Style := psSolid;
ADest.Pen.FPColor := colBlack;
if i + CDTrackBar.Min <= CDTrackBar.Position then
ADest.Brush.FPColor := colDkGray
else
ADest.Brush.FPColor := colWhite;
ADest.Rectangle(dRect);
// Draw the slider
if i + CDTrackBar.Min = CDTrackBar.Position then
begin
ADest.Brush.FPColor := TColorToFPColor(ColorToRGB($006BB6E6));
ADest.Brush.Style := bsSolid;
ADest.Rectangle(pStart, lDrawingBottom + 1, pStart + 10, lDrawingBottom + 6);
ADest.Pen.FPColor := TColorToFPColor(ColorToRGB($005BA6C6));
ADest.RecTangle(pStart, lDrawingBottom + 2, pStart + 10, lDrawingBottom + 7);
ADest.Pen.FPColor := TColorToFPColor(ColorToRGB($006BB6E6));
ADest.RecTangle(pStart, lDrawingBottom, pStart + 10, lDrawingBottom + 2);
end;
pStart := pStart + pStepWidth;
end;
ADest.Pen.FPColor := TColorToFPColor(ColorToRGB($007BC6F6));
ADest.Line(7, lDrawingBottom - 1, CDTrackBar.Width - 8, lDrawingBottom - 1);
ADest.Line(7, lDrawingBottom + 1, CDTrackBar.Width - 8, lDrawingBottom + 1);
ADest.Colors[2, lDrawingBottom - 1] := ADest.Pen.FPColor;
ADest.Colors[4, lDrawingBottom - 2] := ADest.Pen.FPColor;
ADest.Colors[2, lDrawingBottom + 1] := ADest.Pen.FPColor;
ADest.Colors[4, lDrawingBottom + 2] := ADest.Pen.FPColor;
ADest.Colors[6, lDrawingBottom - 3] := ADest.Pen.FPColor;
ADest.Colors[6, lDrawingBottom + 3] := ADest.Pen.FPColor;
ADest.Colors[CDTrackBar.Width - 1 - 2, lDrawingBottom - 1] := ADest.Pen.FPColor;
ADest.Colors[CDTrackBar.Width - 1 - 4, lDrawingBottom - 2] := ADest.Pen.FPColor;
ADest.Colors[CDTrackBar.Width - 1 - 2, lDrawingBottom + 1] := ADest.Pen.FPColor;
ADest.Colors[CDTrackBar.Width - 1 - 4, lDrawingBottom + 2] := ADest.Pen.FPColor;
ADest.Colors[CDTrackBar.Width - 1 - 6, lDrawingBottom - 3] := ADest.Pen.FPColor;
ADest.Colors[CDTrackBar.Width - 1 - 6, lDrawingBottom + 3] := ADest.Pen.FPColor;
end;
procedure TCDTrackBarDrawerGraph.GetGeometry(var ALeftBorder,
ARightBorder: Integer);
begin
ALeftBorder := 9;
ARightBorder := 9;
end;
initialization
RegisterButtonDrawer(TCDButtonDrawerGrad.Create, dsExtra1);
RegisterTrackBarDrawer(TCDTrackBarDrawerGraph.Create, dsExtra1);
end.

121
components/customdrawn/customdrawn_win2000.pas Normal file
View File

@ -0,0 +1,121 @@
unit customdrawn_win2000;
{$mode objfpc}{$H+}
interface
uses
// RTL
Classes, SysUtils,
// fpimage
fpcanvas, fpimgcanv, fpimage,
// LCL -> Use only TForm, TWinControl, TCanvas and TLazIntfImage
Graphics, Controls, LCLType, LCLIntf, IntfGraphics,
//
customdrawncontrols, customdrawnutils;
type
TCDButtonDrawerWin2k = class(TCDButtonDrawer)
public
procedure DrawToIntfImage(ADest: TFPImageCanvas; CDButton: TCDButton); override;
procedure DrawToCanvas(ADest: TCanvas; CDButton: TCDButton;
FState: TCDButtonState); override;
end;
implementation
procedure TCDButtonDrawerWin2k.DrawToIntfImage(ADest: TFPImageCanvas;
CDButton: TCDButton);
begin
end;
procedure TCDButtonDrawerWin2k.DrawToCanvas(ADest: TCanvas; CDButton: TCDButton;
FState: TCDButtonState);
var
TmpB: TBitmap;
Str: string;
begin
// Button shape -> This crashes in Gtk2
TmpB := TBitmap.Create;
TmpB.Width := CDButton.Width;
TmpB.Height := CDButton.Height;
TmpB.Canvas.Brush.Color := CDButton.Color;
TmpB.Canvas.Brush.Style := bsSolid;
TmpB.Canvas.RoundRect(0, 0, TmpB.Width, TmpB.Height, 8, 8);
with TmpB.Canvas do
begin
Brush.Style := bsSolid;
Brush.Color := CDButton.Color;
Pen.Color := clWhite;
Pen.Style := psSolid;
Rectangle(0, 0, Width - 1, Height - 1);
Pen.Color := clWhite;
Line(0, 0, Width - 1, 0);
Line(0, 0, 0, Height - 1);
Pen.Color := clGray;
Line(0, Height - 1, Width - 1, Height - 1);
Line(Width - 1, Height - 1, Width - 1, -1);
Pen.Color := $0099A8AC;
Line(1, Height - 2, Width - 2, Height - 2);
Line(Width - 2, Height - 2, Width - 2, 0);
Pen.Color := $00E2EFF1;
Line(1, 1, Width - 2, 1);
Line(1, 1, 1, Height - 2);
end;
// Button image
case FState of
bbsDown:
begin
with TmpB.Canvas do
begin
Brush.Style := bsSolid;
Brush.Color := CDButton.Color;
Pen.Color := clWhite;
Pen.Style := psSolid;
Rectangle(0, 0, Width - 1, Height - 1);
Pen.Color := clGray;
Line(0, 0, Width - 1, 0);
Line(0, 0, 0, Height - 1);
Pen.Color := clWhite;
Line(0, Height - 1, Width - 1, Height - 1);
Line(Width - 1, Height - 1, Width - 1, -1);
Pen.Color := $00E2EFF1;
Line(1, Height - 2, Width - 2, Height - 2);
Line(Width - 2, Height - 2, Width - 2, 0);
Pen.Color := $0099A8AC;
Line(1, 1, Width - 2, 1);
Line(1, 1, 1, Height - 2);
end;
end;
bbsFocused:
with TmpB.Canvas do
DrawFocusRect(Rect(3, 3, Width - 4, Height - 4))
else
begin
end;
end;
ADest.Draw(0, 0, TmpB);
TmpB.Free;
// Button text
ADest.Font.Assign(CDButton.Font);
ADest.Brush.Style := bsClear;
ADest.Pen.Style := psSolid;
Str := CDButton.Caption;
if FState = bbsDown then
ADest.TextOut((CDButton.Width - ADest.TextWidth(Str)) div 2 + 1,
(CDButton.Height - ADest.TextHeight(Str)) div 2 + 1, Str)
else
ADest.TextOut((CDButton.Width - ADest.TextWidth(Str)) div 2,
(CDButton.Height - ADest.TextHeight(Str)) div 2, Str);
end;
initialization
RegisterButtonDrawer(TCDButtonDrawerWin2k.Create, dsWin2000);
end.

534
components/customdrawn/customdrawn_wince.pas Normal file
View File

@ -0,0 +1,534 @@
unit customdrawn_wince;
{$mode objfpc}{$H+}
interface
uses
// RTL
Classes, SysUtils,
// fpimage
fpcanvas, fpimgcanv, fpimage,
// LCL -> Use only TForm, TWinControl, TCanvas and TLazIntfImage
Graphics, Controls, LCLType, LCLIntf, IntfGraphics,
//
customdrawncontrols, customdrawnutils;
type
TCDButtonDrawerWinCE = class(TCDButtonDrawer)
public
procedure DrawToIntfImage(ADest: TFPImageCanvas; CDButton: TCDButton); override;
procedure DrawToCanvas(ADest: TCanvas; CDButton: TCDButton;
FState: TCDButtonState); override;
end;
TCDGroupBoxDrawerWinCE = class(TCDGroupBoxDrawer)
public
FCaptionMiddle: integer;
procedure SetClientRectPos(CDGroupBox: TCDGroupBox); override;
procedure DrawToIntfImage(ADest: TFPImageCanvas; CDGroupBox: TCDGroupBox); override;
procedure DrawToCanvas(ADest: TCanvas; CDGroupBox: TCDGroupBox); override;
end;
TCDCustomTabControlDrawerWinCE = class(TCDCustomTabControlDrawer)
private
StartIndex: integer; //FEndIndex
LeftmostTabVisibleIndex: Integer;
procedure DrawCaptionBar(ADest: TCanvas; lRect: TRect; CL: TColor);
procedure DrawTabs(ADest: TCanvas; CDTabControl: TCDCustomTabControl);
procedure DrawTab(ADest: TCanvas; AIndex: Integer; ACurStartLeftPos: Integer;
CDTabControl: TCDCustomTabControl);
public
function GetPageIndexFromXY(x, y: integer): integer; override;
function GetTabHeight(AIndex: Integer; CDTabControl: TCDCustomTabControl): Integer; override;
function GetTabWidth(ADest: TCanvas; AIndex: Integer; CDTabControl: TCDCustomTabControl): Integer; override;
//function GetClientRect(AControl: TCDControl): TRect; override;
procedure DrawToIntfImage(ADest: TFPImageCanvas; FPImg: TLazIntfImage;
CDTabControl: TCDCustomTabControl); override;
procedure DrawToCanvas(ADest: TCanvas; CDTabControl: TCDCustomTabControl); override;
procedure DrawTabSheet(ADest: TCanvas; CDTabControl: TCDCustomTabControl); override;
procedure MouseDown(Button: TMouseButton; Shift: TShiftState;
X, Y: integer; CDTabControl: TCDCustomTabControl); override;
end;
implementation
{ TCDButtonDrawerWinCE }
procedure TCDButtonDrawerWinCE.DrawToIntfImage(ADest: TFPImageCanvas;
CDButton: TCDButton);
begin
end;
procedure TCDButtonDrawerWinCE.DrawToCanvas(ADest: TCanvas; CDButton: TCDButton;
FState: TCDButtonState);
var
TmpB: TBitmap;
Str: string;
begin
// Button shape -> This crashes in Gtk2
TmpB := TBitmap.Create;
TmpB.Width := CDButton.Width;
TmpB.Height := CDButton.Height;
TmpB.Canvas.Brush.Color := CDButton.Color;
TmpB.Canvas.Brush.Style := bsSolid;
TmpB.Canvas.RoundRect(0, 0, TmpB.Width, TmpB.Height, 8, 8);
// CDButton.SetShape(TmpB);
// Button image
case FState of
bbsDown:
begin
with TmpB.Canvas do
begin
Brush.Style := bsSolid;
Brush.Color := GetAColor(CDButton.Color, 90);
Pen.Color := clBlack;
Pen.Style := psSolid;
Rectangle(0, 0, Width, Height);
end;
end;
bbsFocused:
with TmpB.Canvas do
begin
Brush.Style := bsSolid;
Brush.Color := GetAColor(CDButton.Color, 99);
Pen.Color := clBlack;
Pen.Style := psSolid;
Rectangle(0, 0, Width, Height);
Rectangle(1, 1, Width - 1, Height - 1); // The border is thicken when focused
end;
else
with TmpB.Canvas do
begin
Brush.Style := bsSolid;
Brush.Color := CDButton.Color;
Pen.Color := clBlack;
Pen.Style := psSolid;
Rectangle(0, 0, Width, Height);
end;
end;
ADest.Draw(0, 0, TmpB);
TmpB.Free;
// Button text
{$ifndef CUSTOMDRAWN_USE_FREETYPE}
ADest.Font.Assign(CDButton.Font);
ADest.Brush.Style := bsClear;
ADest.Pen.Style := psSolid;
Str := CDButton.Caption;
ADest.TextOut((CDButton.Width - ADest.TextWidth(Str)) div 2,
(CDButton.Height - ADest.TextHeight(Str)) div 2, Str);
{$endif}
end;
{ TCDCustomTabControlDrawerWinCE }
procedure TCDCustomTabControlDrawerWinCE.DrawCaptionBar(ADest: TCanvas;
lRect: TRect; CL: TColor);
begin
{ CaptionHeight := GetTabHeight(CDPageControl.PageIndex, CDPageControl) - 4;
RButtHeight := GetTabHeight(CDPageControl.PageIndex, CDPageControl);
aRect := lRect;
ADest.Pen.Style := psSolid;
ADest.Brush.Style := bsSolid;
ADest.Pen.FPColor := TColorToFPColor(ColorToRGB(CL));
//TColorToFPColor(ColorToRGB($009C9B91));
ADest.Brush.FPColor := TColorToFPColor(ColorToRGB(CL));
aRect.Left := lRect.Left;
aRect.Top := lRect.Top;
aRect.Bottom := lRect.Bottom;
aRect.Right := lRect.Right;
ADest.RecTangle(lRect);
if CDPageControl.FPages.Count = 0 then
begin
ADest.Brush.Color := clWhite;
ADest.Pen.Color := $009C9B91;
ADest.RecTangle(Rect(aRect.Left, aRect.Top, aRect.Right + 1, aRect.Bottom + 2));
ADest.Pen.Color := clWhite;
ADest.Line(aRect.Left + 1, aRect.Bottom + 1, aRect.Right, aRect.Bottom + 1);
Exit;
end;
aRect.Left := lRect.Left + 2;
aRect.Top := lRect.Top + 3;
//ADest.TextStyle.Opaque :=false;
//SetBkMode(ADest.Handle, TRANSPARENT);
if ADest.Brush.Style = bsSolid then
SetBkMode(ADest.Handle, OPAQUE)
else
SetBkMode(ADest.Handle, TRANSPARENT);
for i := StartIndex to CDPageControl.FPages.Count - 1 do
begin
aText := CDPageControl.FPages[i].TabPage.Caption;
rWidth := (CaptionHeight - ADest.TextHeight(aText)) + ADest.TextWidth(aText);
CDPageControl.FPages[i].Width := rWidth;
if aRect.Left + rWidth > lRect.Right - 6 then
Break
else
aRect.Right := aRect.Left + rWidth;
if CDPageControl.PageIndex = i then
begin
cRect := aRect;
if i = StartIndex then
cRect.Left := aRect.Left - 2
else
cRect.Left := aRect.Left - 4;
cRect.Right := aRect.Right + 4;
cRect.Top := cRect.Top - 2;
bText := CDPageControl.FPages[i].TabPage.Caption;
end
else
DrawTabHead(aDest, aRect, CDPageControl.Color, False);
MaskColor := MaskBaseColor + i - StartIndex;
//DrawTabHeadMask(MaskHeadBmp.Canvas, aRect, MaskColor, False);
ADest.TextOut(aRect.Left + (aRect.Right - aRect.Left - ADest.TextWidth(aText)) div 2,
aRect.Top + (aRect.Bottom - aRect.Top - ADest.TextHeight(aText)) div 2, aText);
aRect.Left := aRect.Right + 3;
end;
ADest.Line(lRect.Left, lRect.Bottom - 1, cRect.Left, lRect.Bottom - 1);
ADest.Line(cRect.Right, lRect.Bottom - 1, lRect.Right, lRect.Bottom - 1);
DrawTabHead(aDest, cRect, clWhite, True);
ADest.TextOut(cRect.Left + (cRect.Right - cRect.Left - ADest.TextWidth(bText)) div 2,
cRect.Top + (cRect.Bottom - cRect.Top - ADest.TextHeight(bText)) div 2, bText);
if not CheckTabButton(lRect.Right - lRect.Left, CDPageControl.FPages) then
Exit;
aRect.Left := lRect.Right - RButtHeight * 2 - 3;
aRect.Top := 1;
aRect.Bottom := RButtHeight + 1;
aRect.Right := lRect.Right - RButtHeight;
//if FMDownL then
// GradFill(ADest, aRect, $00F1A079, $00EFAF9B)
//else
GradFill(ADest, aRect, $00FDD9CB, $00F2C9B8);
aRect.Left := lRect.Right - RButtHeight - 1;
aRect.Top := 1;
aRect.Bottom := RButtHeight + 1;
aRect.Right := lRect.Right;
GradFill(ADest, aRect, $00FDD9CB, $00F2C9B8);
ADest.Pen.FPColor := TColorToFPColor(ColorToRGB($0085614D));
bRect.Top := 1;
bRect.Left := lRect.Right - RButtHeight * 2 - 3;
bRect.Right := lRect.Right;
bRect.Bottom := RButtHeight + 1;
DrawArrow(ADest, bRect, True);
DrawArrow(ADest, bRect, False);
ADest.Pen.FPColor := TColorToFPColor(ColorToRGB(clWhite));
ADest.Line(lRect.Right - RButtHeight * 2 - 3, 1, lRect.Right, 1);
ADest.Line(lRect.Right, 1, lRect.Right, RButtHeight + 1);
ADest.Line(lRect.Right, RButtHeight + 1, lRect.Right - RButtHeight *
2 - 3, RButtHeight + 1);
ADest.Line(lRect.Right - RButtHeight * 2 - 3, RButtHeight + 1,
lRect.Right - RButtHeight * 2 - 3, 1);
ADest.Pen.FPColor := TColorToFPColor(ColorToRGB($00E5BAA7));
ADest.Brush.Style := bsClear;
ADest.Rectangle(lRect.Right - RButtHeight * 2 - 2, 2, lRect.Right -
1, RButtHeight + 1);
CornerColor := TColorToFPColor(ColorToRGB($00F6E3D9));
ADest.Colors[lRect.Right - RButtHeight * 2 - 2, 2] := CornerColor;
ADest.Colors[lRect.Right - RButtHeight * 2 - 2, RButtHeight] := CornerColor;
ADest.Colors[lRect.Right - 1, 2] := CornerColor;
ADest.Colors[lRect.Right - 1, RButtHeight] := CornerColor;
ADest.Pen.FPColor := TColorToFPColor(ColorToRGB(clWhite));
ADest.Line(lRect.Right - 51, 1, lRect.Right, 1);
ADest.Line(lRect.Right, 1, lRect.Right, 25);
ADest.Line(lRect.Right, 25, lRect.Right - 51, 25);
ADest.Line(lRect.Right - 51, 25, lRect.Right - 51, 1);
ADest.Pen.FPColor := TColorToFPColor(ColorToRGB($00FFFFFF));}
end;
procedure TCDCustomTabControlDrawerWinCE.DrawTabs(ADest: TCanvas; CDTabControl: TCDCustomTabControl);
var
IsPainting: Boolean = False;
CurStartLeftPos: Integer = 0;
i: Integer;
begin
for i := 0 to CDTabControl.Tabs.Count - 1 do
begin
if i = LeftmostTabVisibleIndex then
IsPainting := True;
if IsPainting then
begin
DrawTab(ADest, i, CurStartLeftPos, CDTabControl);
CurStartLeftPos := CurStartLeftPos + GetTabWidth(ADest, i, CDTabControl);
end;
end;
end;
procedure TCDCustomTabControlDrawerWinCE.DrawTab(ADest: TCanvas;
AIndex: Integer; ACurStartLeftPos: Integer; CDTabControl: TCDCustomTabControl);
var
IsSelected: Boolean;
lTabWidth, lTabHeight, lTabTopPos: Integer;
Points: array of TPoint;
lCaption: String;
begin
IsSelected := CDTabControl.TabIndex = AIndex;
if IsSelected then
begin
lTabTopPos := 0;
lTabHeight := GetTabHeight(AIndex, CDTabControl);
end
else
begin
lTabTopPos := 5;
lTabHeight := GetTabHeight(AIndex, CDTabControl)-5;
end;
lTabWidth := GetTabWidth(ADest, AIndex, CDTabControl);
// Fill the area inside the outer border
ADest.Pen.Style := psClear;
ADest.Brush.Style := bsSolid;
ADest.Brush.Color := clWhite;
SetLength(Points, 5);
Points[0] := Point(ACurStartLeftPos, lTabTopPos);
Points[1] := Point(ACurStartLeftPos+lTabWidth-5, lTabTopPos);
Points[2] := Point(ACurStartLeftPos+lTabWidth, lTabTopPos+5);
Points[3] := Point(ACurStartLeftPos+lTabWidth, lTabTopPos+lTabHeight);
Points[4] := Point(ACurStartLeftPos, lTabTopPos+lTabHeight);
ADest.Polygon(Points);
// Draw the outer border only in the top and right sides,
// and bottom if unselected
ADest.Pen.Style := psSolid;
ADest.Brush.Style := bsClear;
ADest.Pen.Color := ColorToRGB($009C9B91);
ADest.MoveTo(ACurStartLeftPos+1, lTabTopPos);
ADest.LineTo(ACurStartLeftPos+lTabWidth-5, lTabTopPos);
ADest.LineTo(ACurStartLeftPos+lTabWidth, lTabTopPos+5);
ADest.LineTo(ACurStartLeftPos+lTabWidth, lTabTopPos+lTabHeight);
// If it is selected, add a selection frame
if IsSelected then
begin
ADest.Pen.Color := ColorToRGB($00D6C731);
ADest.Pen.Style := psSolid;
ADest.Brush.Style := bsClear;
ADest.Rectangle(
ACurStartLeftPos+3, lTabTopPos+3,
ACurStartLeftPos+lTabWidth-5, lTabTopPos+lTabHeight-5
);
end;
// Now the text
lCaption := CDTabControl.Tabs.Strings[AIndex];
ADest.TextOut(ACurStartLeftPos+5, lTabTopPos+5, lCaption);
end;
function TCDCustomTabControlDrawerWinCE.GetPageIndexFromXY(x, y: integer
): integer;
begin
Result := 1;
end;
function TCDCustomTabControlDrawerWinCE.GetTabHeight(AIndex: Integer; CDTabControl: TCDCustomTabControl): Integer;
begin
if CDTabControl.Font.Size = 0 then
Result := 32
else
Result := CDTabControl.Font.Size + 22;
end;
function TCDCustomTabControlDrawerWinCE.GetTabWidth(ADest: TCanvas;
AIndex: Integer; CDTabControl: TCDCustomTabControl): Integer;
const
TCDTabControl_WinCE_TabCaptionExtraWidth = 20;
var
lCaption: string;
begin
lCaption := CDTabControl.Tabs.Strings[AIndex];
Result := ADest.TextWidth(lCaption) + TCDTabControl_WinCE_TabCaptionExtraWidth;
end;
{function TCDCustomTabControlDrawerWinCE.GetClientRect(AControl: TCDControl
): TRect;
var
lCaptionHeight: Integer;
begin
lCaptionHeight := GetTabHeight(CDTabControl.FTabIndex) - 4;
Result := Rect(5, lCaptionHeight + 1, CDTabControl.Width - 10,
CDTabControl.Height - lCaptionHeight - 5);
end;}
procedure TCDCustomTabControlDrawerWinCE.DrawToIntfImage(ADest: TFPImageCanvas;
FPImg: TLazIntfImage; CDTabControl: TCDCustomTabControl);
var
lColor: TColor;
lFPColor: TFPColor;
x, y: Integer;
begin
lColor := CDTabControl.GetRGBBackgroundColor();
// Background
lFPColor := TColorToFPColor(lColor);
FPImg.FillPixels(lFPColor);
end;
procedure TCDCustomTabControlDrawerWinCE.DrawToCanvas(ADest: TCanvas; CDTabControl: TCDCustomTabControl);
var
CaptionHeight: Integer;
begin
CaptionHeight := GetTabHeight(CDTabControl.TabIndex, CDTabControl);
// frame
ADest.Pen.Style := psSolid;
ADest.Brush.Style := bsClear;
ADest.Pen.Color := ColorToRGB($009C9B91);
if CDTabControl.GetTabCount = 0 then
ADest.Rectangle(0, 0, CDTabControl.Width - 2, CDTabControl.Height - 2)
else
ADest.Rectangle(0, CaptionHeight, CDTabControl.Width - 2, CDTabControl.Height - 2);
ADest.Pen.Color := ColorToRGB($00BFCED0);
ADest.Line(CDTabControl.Width - 1, CaptionHeight + 1,
CDTabControl.Width - 1, CDTabControl.Height - 1);
ADest.Line(CDTabControl.Width - 1, CDTabControl.Height - 1, 1,
CDTabControl.Height - 1);
// Tabs
ADest.Font.Name := CDTabControl.Font.Name;
ADest.Font.Size := CDTabControl.Font.Size;
// DrawCaptionBar(ADest, Rect(0, 0, CDPageControl.Width -
// 2, CaptionHeight + 1), CDPageControl.Color, CDPageControl);
DrawTabs(ADest, CDTabControl);
end;
procedure TCDCustomTabControlDrawerWinCE.DrawTabSheet(ADest: TCanvas; CDTabControl: TCDCustomTabControl);
begin
ADest.Brush.Color := CDTabControl.Color;
ADest.Brush.Style := bsSolid;
ADest.Pen.Style := psClear;
ADest.Rectangle(0, 0, CDTabControl.Width, CDTabControl.Height);
end;
procedure TCDCustomTabControlDrawerWinCE.MouseDown(Button: TMouseButton;
Shift: TShiftState; X, Y: integer; CDTabControl: TCDCustomTabControl);
var
i: Integer;
CurPage: TCDTabSheet;
CurStartLeftPos: Integer = 0;
VisiblePagesStarted: Boolean = False;
lTabWidth: Integer;
begin
for i := 0 to CDTabControl.Tabs.Count - 1 do
begin
if i = LeftmostTabVisibleIndex then
VisiblePagesStarted := True;
if VisiblePagesStarted then
begin
lTabWidth := GetTabWidth(CDTabControl.Canvas, i, CDTabControl);
if (X > CurStartLeftPos) and
(X < CurStartLeftPos + lTabWidth) and
(Y < GetTabHeight(i, CDTabControl)) then
begin
if CDTabControl is TCDPageControl then
(CDTabControl as TCDPageControl).PageIndex := i
else
CDTabControl.TabIndex := i;
Exit;
end;
CurStartLeftPos := CurStartLeftPos + lTabWidth;
end;
end;
end;
procedure TCDGroupBoxDrawerWinCE.SetClientRectPos(CDGroupBox: TCDGroupBox);
var
lRect: TRect;
lCaptionHeight: integer;
begin
lCaptionHeight := 10;
lRect := Rect(1, lCaptionHeight, CDGroupBox.Width - 1, CDGroupBox.Height - 1);
//CDGroupBox.AdjustClientRect(lRect);
end;
procedure TCDGroupBoxDrawerWinCE.DrawToIntfImage(ADest: TFPImageCanvas;
CDGroupBox: TCDGroupBox);
{$ifdef CUSTOMDRAWN_USE_FREETYPE}
var
AFont: TFreeTypeFont = nil;
{$endif}
begin
FCaptionMiddle := CDGroupBox.Canvas.TextHeight('Ź') div 2;
if FCaptionMiddle = 0 then FCaptionMiddle := CDGroupBox.Canvas.Font.Size div 2;
if FCaptionMiddle = 0 then FCaptionMiddle := 5;
// Background
if CDGroupBox.Parent = nil then
ADest.Brush.FPColor := colLtGray
else if CDGroupBox.Parent.Color = clDefault then
ADest.Brush.FPColor := TColorToFPColor(ColorToRGB(clForm))
else
ADest.Brush.FPColor := TColorToFPColor(ColorToRGB(CDGroupBox.Parent.Color));
ADest.Brush.Style := bsSolid;
ADest.Pen.Style := psClear;
ADest.Rectangle(0, 0, CDGroupBox.Width, CDGroupBox.Height);
// frame
ADest.Pen.FPColor := colBlack;
ADest.Pen.Style := psSolid;
ADest.Brush.Style := bsClear;
ADest.Rectangle(0, FCaptionMiddle, CDGroupBox.Width - 1, CDGroupBox.Height - 1);
{$ifdef CUSTOMDRAWN_USE_FREETYPE}
// Caption background and caption
// initialize free type font manager
opcftfont.InitEngine;
// FontMgr.SearchPath:='/usr/share/fonts/truetype/';
AFont := TFreeTypeFont.Create;
try
// Text background
ADest.Pen.Style := psClear;
ADest.Brush.Style := bsSolid;
// The brush color was already set previously and is already correct
// ADest.Rectangle(5, 0, AFont.GetTextWidth(CDGroupBox.Caption) + 5, 10);
// paint text
ADest.Pen.Style := psSolid;
ADest.Brush.Style := bsClear;
ADest.Font := AFont;
ADest.Font.Name := 'Arial';
ADest.Font.Size := 10;
ADest.TextOut(5, 10, CDGroupBox.Caption);
finally
AFont.Free;
end;
{$endif}
end;
procedure TCDGroupBoxDrawerWinCE.DrawToCanvas(ADest: TCanvas; CDGroupBox: TCDGroupBox);
begin
if CDGroupBox.Parent = nil then
ADest.Brush.Color := clLtGray
else if CDGroupBox.Parent.Color = clDefault then
ADest.Brush.Color := ColorToRGB(clForm)
else
ADest.Brush.Color := ColorToRGB(CDGroupBox.Parent.Color);
// paint text
ADest.Pen.Style := psSolid;
ADest.Brush.Style := bsSolid; // This will fill the text background
ADest.Font.Size := 10;
ADest.TextOut(FCaptionMiddle, 0, CDGroupBox.Caption);
end;
initialization
RegisterButtonDrawer(TCDButtonDrawerWinCE.Create, dsWinCE);
RegisterGroupBoxDrawer(TCDGroupBoxDrawerWinCE.Create, dsWinCE);
RegisterCustomTabControlDrawer(TCDCustomTabControlDrawerWinCE.Create, dsWinCE);
end.

63
components/customdrawn/customdrawn_winxp.pas Normal file
View File

@ -0,0 +1,63 @@
unit customdrawn_winxp;
{$mode objfpc}{$H+}
interface
uses
// RTL
Classes, SysUtils,
// fpimage
fpcanvas, fpimgcanv, fpimage,
// LCL -> Use only TForm, TWinControl, TCanvas and TLazIntfImage
Graphics, Controls, LCLType, LCLIntf, IntfGraphics,
//
customdrawncontrols, customdrawnutils;
type
TCDButtonDrawerXPTB = class(TCDButtonDrawer)
public
procedure DrawToIntfImage(ADest: TFPImageCanvas; CDButton: TCDButton); override;
procedure DrawToCanvas(ADest: TCanvas; CDButton: TCDButton;
FState: TCDButtonState); override;
end;
implementation
procedure TCDButtonDrawerXPTB.DrawToIntfImage(ADest: TFPImageCanvas;
CDButton: TCDButton);
begin
end;
procedure TCDButtonDrawerXPTB.DrawToCanvas(ADest: TCanvas; CDButton: TCDButton;
FState: TCDButtonState);
var
Str: string;
begin
case FState of
bbsDown:
begin
DrawCDButtonDown(ADest, CDButton.GetRGBBackgroundColor);
end;
bbsFocused:
begin
DrawXPTaskbarButton(ADest, GetAColor(CDButton.Color, 98));
end;
else
DrawXPTaskbarButton(ADest, CDButton.Color);
end;
// Button text
ADest.Font.Assign(CDButton.Font);
ADest.Brush.Style := bsClear;
ADest.Pen.Style := psSolid;
Str := CDButton.Caption;
ADest.TextOut((CDButton.Width - ADest.TextWidth(Str)) div 2,
(CDButton.Height - ADest.TextHeight(Str)) div 2, Str);
end;
initialization
RegisterButtonDrawer(TCDButtonDrawerXPTB.Create, dsWinXP);
end.

1122
components/customdrawn/customdrawncontrols.pas
View File

File diff suppressed because it is too large Load Diff

16
components/customdrawn/customdrawnutils.pas
View File

@ -31,6 +31,7 @@ procedure DrawTabHead(aDest: TFPCustomCanvas; aRect: TRect; HeadColor: TColor;
procedure DrawTabHeadMask(aDest: TFPCustomCanvas; aRect: TRect;
HeadColor: TColor; IsActive: boolean);
procedure DrawArrow(aDest: TFPCustomCanvas; aRect: TRect; R: boolean);
procedure DrawCDButtonDown(Canvas: TCanvas; ABackgroundColor: TColor);
type
PRGBTripleArray = ^TRGBTripleArray;
@ -549,5 +550,20 @@ begin
TmpBmp.Free;
end;
procedure DrawCDButtonDown(Canvas: TCanvas; ABackgroundColor: TColor);
begin
with Canvas do
begin
Brush.Style := bsSolid;
Brush.Color := ABackgroundColor;
Pen.Color := Brush.Color;
Rectangle(0, 0, Width, Height);
FillRect(0, 0, Width, Height);
Brush.Color := GetAColor(ABackgroundColor, 93);
Pen.Color := GetAColor(Brush.Color, 76);
RoundRect(0, 0, Width, Height, 8, 8);
end;
end;
end.