paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-10-26 09:41:32 +01:00
Code Issues Packages Projects Releases Wiki Activity

customdrawn: Starts adding the radiobutton

Browse Source 
git-svn-id: trunk@33340 -
This commit is contained in:
sekelsenmat 2011-11-05 14:54:21 +00:00
parent 5001efe30e
commit 929119be32
4 changed files with 521 additions and 386 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

77
components/customdrawn/customdrawn_common.pas
View File

@ -33,8 +33,6 @@ type
function GetColor(AColorID: Integer): TColor; override; function GetColor(AColorID: Integer): TColor; override;
function GetClientArea(ADest: TCanvas; ASize: TSize; AControlId: TCDControlID; function GetClientArea(ADest: TCanvas; ASize: TSize; AControlId: TCDControlID;
AState: TCDControlState; AStateEx: TCDControlStateEx): TRect; override; AState: TCDControlState; AStateEx: TCDControlStateEx): TRect; override;
procedure DrawControl(ADest: TCanvas; ADestPos: TPoint; ASize: TSize;
AControl: TCDControlID; AState: TCDControlState; AStateEx: TCDControlStateEx); override;
// General drawing routines // General drawing routines
procedure DrawFocusRect(ADest: TCanvas; ADestPos: TPoint; ASize: TSize); override; procedure DrawFocusRect(ADest: TCanvas; ADestPos: TPoint; ASize: TSize); override;
procedure DrawRaisedFrame(ADest: TCanvas; ADestPos: TPoint; ASize: TSize); override; procedure DrawRaisedFrame(ADest: TCanvas; ADestPos: TPoint; ASize: TSize); override;
@ -58,6 +56,11 @@ type
AState: TCDControlState; AStateEx: TCDControlStateEx); override; AState: TCDControlState; AStateEx: TCDControlStateEx); override;
procedure DrawCheckBox(ADest: TCanvas; ADestPos: TPoint; ASize: TSize; procedure DrawCheckBox(ADest: TCanvas; ADestPos: TPoint; ASize: TSize;
AState: TCDControlState; AStateEx: TCDControlStateEx); override; AState: TCDControlState; AStateEx: TCDControlStateEx); override;
// TCDRadioButton
procedure DrawRadioButtonCircle(ADest: TCanvas; ADestPos: TPoint; ASize: TSize;
AState: TCDControlState; AStateEx: TCDControlStateEx); override;
procedure DrawRadioButton(ADest: TCanvas; ADestPos: TPoint; ASize: TSize;
AState: TCDControlState; AStateEx: TCDControlStateEx); override;
// TCDGroupBox // TCDGroupBox
procedure DrawGroupBox(ADest: TCanvas; ADestPos: TPoint; ASize: TSize; procedure DrawGroupBox(ADest: TCanvas; ADestPos: TPoint; ASize: TSize;
AState: TCDControlState; AStateEx: TCDControlStateEx); override; AState: TCDControlState; AStateEx: TCDControlStateEx); override;
@ -111,6 +114,8 @@ begin
// //
TCDCHECKBOX_SQUARE_HALF_HEIGHT: Result := 7; TCDCHECKBOX_SQUARE_HALF_HEIGHT: Result := 7;
TCDCHECKBOX_SQUARE_HEIGHT: Result := 15; TCDCHECKBOX_SQUARE_HEIGHT: Result := 15;
//
TCDRADIOBUTTON_CIRCLE_HEIGHT: Result := 15;
else else
Result := 0; Result := 0;
end; end;
@ -191,20 +196,6 @@ begin
end; end;
end; end;
procedure TCDDrawerCommon.DrawControl(ADest: TCanvas; ADestPos: TPoint;
ASize: TSize; AControl: TCDControlID; AState: TCDControlState;
AStateEx: TCDControlStateEx);
begin
case AControl of
cidButton: DrawButton(ADest, ADestPos, ASize, AState, AStateEx);
cidEdit: DrawEdit(ADest, ADestPos, ASize, AState, TCDEditStateEx(AStateEx));
cidCheckBox: DrawCheckBox(ADest, ADestPos, ASize, AState, AStateEx);
cidGroupBox: DrawGroupBox(ADest, ADestPos, ASize, AState, AStateEx);
cidTrackBar: DrawTrackBar(ADest, ADestPos, ASize, AState, TCDTrackBarStateEx(AStateEx));
cidCTabControl:DrawCTabControl(ADest, ADestPos, ASize, AState, TCDCTabControlStateEx(AStateEx));
end;
end;
procedure TCDDrawerCommon.DrawFocusRect(ADest: TCanvas; ADestPos: TPoint; procedure TCDDrawerCommon.DrawFocusRect(ADest: TCanvas; ADestPos: TPoint;
ASize: TSize); ASize: TSize);
begin begin
@ -538,6 +529,60 @@ begin
ADest.TextOut(lSquareHeight+5, 0, AStateEx.Caption); ADest.TextOut(lSquareHeight+5, 0, AStateEx.Caption);
end; end;
procedure TCDDrawerCommon.DrawRadioButtonCircle(ADest: TCanvas;
ADestPos: TPoint; ASize: TSize; AState: TCDControlState;
AStateEx: TCDControlStateEx);
var
lHalf, lCircleThird, lCircleHeight: Integer;
lColor: TColor;
begin
lHalf := ASize.cy div 2;
lCircleHeight := GetMeasures(TCDRADIOBUTTON_CIRCLE_HEIGHT);
lCircleThird := lCircleHeight div 3;
// the circle background
ADest.Pen.Style := psClear;
ADest.Brush.Style := bsSolid;
ADest.Brush.Color := Palette.Window; // or WIN2000_FRAME_WHITE ?
ADest.Rectangle(Bounds(ADestPos.X, ADestPos.Y+lCircleThird, lCircleThird, lCircleHeight));
ADest.Rectangle(Bounds(ADestPos.X+lCircleThird, ADestPos.Y, lCircleHeight, lCircleThird));
// The circle itself
ADest.Pen.Style := psSolid;
ADest.Pixels[ADestPos.X, ADestPos.Y+4] := WIN2000_FRAME_GRAY;
{ WIN2000_FRAME_LIGHT_GRAY = $00E2EFF1;
= $0099A8AC;
WIN2000_FRAME_DARK_GRAY = $00646F71;}
end;
procedure TCDDrawerCommon.DrawRadioButton(ADest: TCanvas; ADestPos: TPoint;
ASize: TSize; AState: TCDControlState; AStateEx: TCDControlStateEx);
var
lColor: TColor;
lCircleHeight: Integer;
begin
lCircleHeight := GetMeasures(TCDRADIOBUTTON_CIRCLE_HEIGHT);
// Background
lColor := AStateEx.ParentRGBColor;
ADest.Brush.Color := lColor;
ADest.Brush.Style := bsSolid;
ADest.Pen.Style := psClear;
ADest.FillRect(0, 0, ASize.cx, ASize.cy);
// The radiobutton circle itself
DrawRadioButtonCircle(ADest, ADestPos, ASize, AState, AStateEx);
// The text selection
if csfHasFocus in AState then
DrawFocusRect(ADest, Point(lCircleHeight+4, 0),
Size(ASize.cx-lCircleHeight-4, ASize.cy));
// Now the text
ADest.Font.Assign(AStateEx.Font);
ADest.TextOut(lCircleHeight+5, 0, AStateEx.Caption);
end;
procedure TCDDrawerCommon.DrawGroupBox(ADest: TCanvas; ADestPos: TPoint; procedure TCDDrawerCommon.DrawGroupBox(ADest: TCanvas; ADestPos: TPoint;
ASize: TSize; AState: TCDControlState; AStateEx: TCDControlStateEx); ASize: TSize; AState: TCDControlState; AStateEx: TCDControlStateEx);
var var

791
components/customdrawn/customdrawncontrols.pas
View File

@ -199,6 +199,24 @@ type
property State: TCheckBoxState read FCheckedState write FCheckedState default cbUnchecked; property State: TCheckBoxState read FCheckedState write FCheckedState default cbUnchecked;
end; end;
{ TCDRadioButton }
TCDRadioButton = class(TCDButtonControl)
private
function GetChecked: Boolean;
procedure SetChecked(AValue: Boolean);
protected
function GetControlId: TCDControlID; override;
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
published
property Checked: Boolean read GetChecked write SetChecked default False;
property DrawStyle;
property Caption;
property TabStop default True;
end;
{@@ {@@
TCDGroupBox is a custom-drawn group box control TCDGroupBox is a custom-drawn group box control
} }
@ -423,6 +441,242 @@ implementation
resourcestring resourcestring
sTABSHEET_DEFAULT_NAME = 'CTabSheet'; sTABSHEET_DEFAULT_NAME = 'CTabSheet';
{ TCDControl }
procedure TCDControl.CalculatePreferredSize(var PreferredWidth,
PreferredHeight: integer; WithThemeSpace: Boolean);
begin
PrepareControlState;
PrepareControlStateEx;
FDrawer.CalculatePreferredSize(Canvas, GetControlId(), FState, FStateEx,
PreferredWidth, PreferredHeight, WithThemeSpace);
end;
procedure TCDControl.PrepareCurrentDrawer;
begin
FDrawer := GetDrawer(FDrawStyle);
if FDrawer = nil then FDrawer := GetDrawer(dsCommon); // avoid exceptions in the object inspector if an invalid drawer is selected
if FDrawer = nil then raise Exception.Create('No registered drawers were found');
end;
procedure TCDControl.SetDrawStyle(const AValue: TCDDrawStyle);
begin
if FDrawStyle = AValue then exit;
FDrawStyle := AValue;
Invalidate;
PrepareCurrentDrawer();
//FCurrentDrawer.SetClientRectPos(Self);
end;
function TCDControl.GetClientRect: TRect;
begin
// Disable this, since although it works in Win32, it doesn't seam to work in LCL-Carbon
//if (FCurrentDrawer = nil) then
Result := inherited GetClientRect()
//else
//Result := FCurrentDrawer.GetClientRect(Self);
end;
function TCDControl.GetControlId: TCDControlID;
begin
Result := cidControl;
end;
procedure TCDControl.CreateControlStateEx;
begin
FStateEx := TCDControlStateEx.Create;
end;
procedure TCDControl.PrepareControlState;
begin
if Focused then FState := FState + [csfHasFocus]
else FState := FState - [csfHasFocus];
if Enabled then FState := FState + [csfEnabled]
else FState := FState - [csfEnabled];
end;
procedure TCDControl.PrepareControlStateEx;
begin
if Parent <> nil then FStateEx.ParentRGBColor := Parent.GetRGBColorResolvingParent
else FStateEx.ParentRGBColor := clSilver;
if Color = clDefault then FStateEx.RGBColor := FDrawer.GetControlDefaultColor(GetControlId())
else FStateEx.RGBColor := GetRGBColorResolvingParent;
FStateEx.Caption := Caption;
FStateEx.Font := Font;
FStateEx.AutoSize := AutoSize;
end;
procedure TCDControl.EraseBackground(DC: HDC);
begin
end;
procedure TCDControl.Paint;
var
ABmp: TBitmap;
lSize: TSize;
lControlId: TCDControlID;
begin
inherited Paint;
PrepareCurrentDrawer();
ABmp := TBitmap.Create;
try
ABmp.Width := Width;
ABmp.Height := Height;
lSize := Size(Width, Height);
lControlId := GetControlId();
PrepareControlState;
PrepareControlStateEx;
FDrawer.DrawControl(ABmp.Canvas, Point(0, 0),
lSize, lControlId, FState, FStateEx);
Canvas.Draw(0, 0, ABmp);
finally
ABmp.Free;
end;
end;
procedure TCDControl.MouseEnter;
begin
FState := FState + [csfMouseOver];
inherited MouseEnter;
end;
procedure TCDControl.MouseLeave;
begin
FState := FState - [csfMouseOver];
inherited MouseLeave;
end;
procedure TCDControl.MouseDown(Button: TMouseButton; Shift: TShiftState; X,
Y: integer);
begin
inherited MouseDown(Button, Shift, X, Y);
SetFocus();
end;
constructor TCDControl.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
CreateControlStateEx;
end;
destructor TCDControl.Destroy;
begin
FStateEx.Free;
inherited Destroy;
end;
{ TCDButtonDrawer }
procedure TCDButtonControl.DoEnter;
begin
Invalidate;
inherited DoEnter;
end;
procedure TCDButtonControl.DoExit;
begin
Invalidate;
inherited DoExit;
end;
procedure TCDButtonControl.KeyDown(var Key: word; Shift: TShiftState);
begin
inherited KeyDown(Key, Shift);
if (Key = VK_SPACE) or (Key = VK_RETURN) then
DoButtonDown();
end;
procedure TCDButtonControl.KeyUp(var Key: word; Shift: TShiftState);
begin
if (Key = VK_SPACE) or (Key = VK_RETURN) then
begin
DoButtonUp();
Self.Click; // TCustomControl does not respond to LM_CLICKED
end;
inherited KeyUp(Key, Shift);
end;
procedure TCDButtonControl.MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: integer);
begin
DoButtonDown();
inherited MouseDown(Button, Shift, X, Y);
end;
procedure TCDButtonControl.MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: integer);
begin
DoButtonUp();
inherited MouseUp(Button, Shift, X, Y);
end;
procedure TCDButtonControl.MouseEnter;
begin
Invalidate;
inherited MouseEnter;
end;
procedure TCDButtonControl.MouseLeave;
begin
Invalidate;
inherited MouseLeave;
end;
procedure TCDButtonControl.DoButtonDown();
begin
if not (csfSunken in FState) then
begin
FState := FState + [csfSunken];
Invalidate;
end;
end;
procedure TCDButtonControl.DoButtonUp();
begin
if csfSunken in FState then
begin
FState := FState - [csfSunken];
Invalidate;
end;
// Only for buttons with checked/down states
if FHasOnOffStates then
begin
if FHasPartiallyOnState then
begin
if csfOn in FState then
FState := FState + [csfOff] - [csfOn, csfPartiallyOn]
else if csfPartiallyOn in FState then
FState := FState + [csfOn] - [csfOff, csfPartiallyOn]
else
FState := FState + [csfPartiallyOn] - [csfOn, csfOff];
end
else
begin
if csfOn in FState then
FState := FState + [csfOff] - [csfOn]
else
FState := FState + [csfOn] - [csfOff];
end;
end;
end;
procedure TCDButtonControl.RealSetText(const Value: TCaption);
begin
inherited RealSetText(Value);
Invalidate;
end;
{ TCDEdit } { TCDEdit }
function TCDEdit.GetText: string; function TCDEdit.GetText: string;
@ -789,367 +1043,7 @@ begin
inherited Destroy; inherited Destroy;
end; end;
{ TCDCustomTabControl } { TCDButton }
procedure TCDCustomTabControl.MouseDown(Button: TMouseButton;
Shift: TShiftState; X, Y: integer);
var
i: Integer;
CurPage: TCDTabSheet;
CurStartLeftPos: Integer = 0;
VisiblePagesStarted: Boolean = False;
lTabWidth: Integer;
begin
inherited MouseDown(Button, Shift, X, Y);
for i := 0 to Tabs.Count - 1 do
begin
if i = FTabCState.LeftmostTabVisibleIndex then
VisiblePagesStarted := True;
if VisiblePagesStarted then
begin
FTabCState.TabIndex := i;
lTabWidth := FDrawer.GetMeasuresEx(Canvas, TCDCTABCONTROL_TAB_WIDTH, FState, FTabCState);
if (X > CurStartLeftPos) and
(X < CurStartLeftPos + lTabWidth) and
(Y < FDrawer.GetMeasuresEx(Canvas, TCDCTABCONTROL_TAB_HEIGHT, FState, FTabCState)) then
begin
if Self is TCDPageControl then
(Self as TCDPageControl).PageIndex := i
else
TabIndex := i;
Exit;
end;
CurStartLeftPos := CurStartLeftPos + lTabWidth;
end;
end;
end;
procedure TCDCustomTabControl.MouseUp(Button: TMouseButton; Shift: TShiftState;
X, Y: integer);
begin
inherited MouseUp(Button, Shift, X, Y);
end;
procedure TCDCustomTabControl.SetTabIndex(AValue: Integer);
begin
if FTabIndex = AValue then Exit;
if Assigned(OnChanging) then OnChanging(Self);
FTabIndex := AValue;
if Assigned(OnChange) then OnChange(Self);
Invalidate;
end;
procedure TCDCustomTabControl.SetTabs(AValue: TStringList);
begin
if FTabs=AValue then Exit;
FTabs.Assign(AValue);
CorrectTabIndex();
Invalidate;
end;
procedure TCDCustomTabControl.SetOptions(AValue: TNoteBookOptions);
begin
if FOptions=AValue then Exit;
FOptions:=AValue;
Invalidate;
end;
function TCDCustomTabControl.GetControlId: TCDControlID;
begin
Result := cidCTabControl;
end;
procedure TCDCustomTabControl.CreateControlStateEx;
begin
FTabCState := TCDCTabControlStateEx.Create;
FStateEx := FTabCState;
end;
procedure TCDCustomTabControl.PrepareControlStateEx;
begin
inherited PrepareControlStateEx;
FTabCState.Tabs := Tabs;
FTabCState.TabIndex := TabIndex;
FTabCState.TabCount := GetTabCount();
FTabCState.Options := FOptions;
end;
constructor TCDCustomTabControl.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
Width := 232;
Height := 184;
TabStop := True;
PrepareCurrentDrawer();
ParentColor := True;
ParentFont := True;
ControlStyle := ControlStyle + [csAcceptsControls, csDesignInteractive];
// FTabs should hold only visible tabs
FTabs := TStringList.Create;
end;
destructor TCDCustomTabControl.Destroy;
begin
FTabs.Free;
inherited Destroy;
end;
function TCDCustomTabControl.GetTabCount: Integer;
begin
Result := 0;
if FTabs <> nil then Result := FTabs.Count;
end;
procedure TCDCustomTabControl.CorrectTabIndex;
begin
if FTabIndex >= FTabs.Count then SetTabIndex(FTabs.Count - 1);
end;
{ TCDControl }
procedure TCDControl.CalculatePreferredSize(var PreferredWidth,
PreferredHeight: integer; WithThemeSpace: Boolean);
begin
PrepareControlState;
PrepareControlStateEx;
FDrawer.CalculatePreferredSize(Canvas, GetControlId(), FState, FStateEx,
PreferredWidth, PreferredHeight, WithThemeSpace);
end;
procedure TCDControl.PrepareCurrentDrawer;
begin
FDrawer := GetDrawer(FDrawStyle);
if FDrawer = nil then FDrawer := GetDrawer(dsCommon); // avoid exceptions in the object inspector if an invalid drawer is selected
if FDrawer = nil then raise Exception.Create('No registered drawers were found');
end;
procedure TCDControl.SetDrawStyle(const AValue: TCDDrawStyle);
begin
if FDrawStyle = AValue then exit;
FDrawStyle := AValue;
Invalidate;
PrepareCurrentDrawer();
//FCurrentDrawer.SetClientRectPos(Self);
end;
function TCDControl.GetClientRect: TRect;
begin
// Disable this, since although it works in Win32, it doesn't seam to work in LCL-Carbon
//if (FCurrentDrawer = nil) then
Result := inherited GetClientRect()
//else
//Result := FCurrentDrawer.GetClientRect(Self);
end;
function TCDControl.GetControlId: TCDControlID;
begin
Result := cidControl;
end;
procedure TCDControl.CreateControlStateEx;
begin
FStateEx := TCDControlStateEx.Create;
end;
procedure TCDControl.PrepareControlState;
begin
if Focused then FState := FState + [csfHasFocus]
else FState := FState - [csfHasFocus];
if Enabled then FState := FState + [csfEnabled]
else FState := FState - [csfEnabled];
end;
procedure TCDControl.PrepareControlStateEx;
begin
if Parent <> nil then FStateEx.ParentRGBColor := Parent.GetRGBColorResolvingParent
else FStateEx.ParentRGBColor := clSilver;
if Color = clDefault then FStateEx.RGBColor := FDrawer.GetControlDefaultColor(GetControlId())
else FStateEx.RGBColor := GetRGBColorResolvingParent;
FStateEx.Caption := Caption;
FStateEx.Font := Font;
FStateEx.AutoSize := AutoSize;
end;
procedure TCDControl.EraseBackground(DC: HDC);
begin
end;
procedure TCDControl.Paint;
var
ABmp: TBitmap;
lSize: TSize;
lControlId: TCDControlID;
begin
inherited Paint;
PrepareCurrentDrawer();
ABmp := TBitmap.Create;
try
ABmp.Width := Width;
ABmp.Height := Height;
lSize := Size(Width, Height);
lControlId := GetControlId();
PrepareControlState;
PrepareControlStateEx;
FDrawer.DrawControl(ABmp.Canvas, Point(0, 0),
lSize, lControlId, FState, FStateEx);
Canvas.Draw(0, 0, ABmp);
finally
ABmp.Free;
end;
end;
procedure TCDControl.MouseEnter;
begin
FState := FState + [csfMouseOver];
inherited MouseEnter;
end;
procedure TCDControl.MouseLeave;
begin
FState := FState - [csfMouseOver];
inherited MouseLeave;
end;
procedure TCDControl.MouseDown(Button: TMouseButton; Shift: TShiftState; X,
Y: integer);
begin
inherited MouseDown(Button, Shift, X, Y);
SetFocus();
end;
constructor TCDControl.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
CreateControlStateEx;
end;
destructor TCDControl.Destroy;
begin
FStateEx.Free;
inherited Destroy;
end;
{ TCDButtonDrawer }
procedure TCDButtonControl.DoEnter;
begin
Invalidate;
inherited DoEnter;
end;
procedure TCDButtonControl.DoExit;
begin
Invalidate;
inherited DoExit;
end;
procedure TCDButtonControl.KeyDown(var Key: word; Shift: TShiftState);
begin
inherited KeyDown(Key, Shift);
if (Key = VK_SPACE) or (Key = VK_RETURN) then
DoButtonDown();
end;
procedure TCDButtonControl.KeyUp(var Key: word; Shift: TShiftState);
begin
if (Key = VK_SPACE) or (Key = VK_RETURN) then
begin
DoButtonUp();
Self.Click; // TCustomControl does not respond to LM_CLICKED
end;
inherited KeyUp(Key, Shift);
end;
procedure TCDButtonControl.MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: integer);
begin
DoButtonDown();
inherited MouseDown(Button, Shift, X, Y);
end;
procedure TCDButtonControl.MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: integer);
begin
DoButtonUp();
inherited MouseUp(Button, Shift, X, Y);
end;
procedure TCDButtonControl.MouseEnter;
begin
Invalidate;
inherited MouseEnter;
end;
procedure TCDButtonControl.MouseLeave;
begin
Invalidate;
inherited MouseLeave;
end;
procedure TCDButtonControl.DoButtonDown();
begin
if not (csfSunken in FState) then
begin
FState := FState + [csfSunken];
Invalidate;
end;
end;
procedure TCDButtonControl.DoButtonUp();
begin
if csfSunken in FState then
begin
FState := FState - [csfSunken];
Invalidate;
end;
// Only for buttons with checked/down states
if FHasOnOffStates then
begin
if FHasPartiallyOnState then
begin
if csfOn in FState then
FState := FState + [csfOff] - [csfOn, csfPartiallyOn]
else if csfPartiallyOn in FState then
FState := FState + [csfOn] - [csfOff, csfPartiallyOn]
else
FState := FState + [csfPartiallyOn] - [csfOn, csfOff];
end
else
begin
if csfOn in FState then
FState := FState + [csfOff] - [csfOn]
else
FState := FState + [csfOn] - [csfOff];
end;
end;
end;
procedure TCDButtonControl.RealSetText(const Value: TCaption);
begin
inherited RealSetText(Value);
Invalidate;
end;
function TCDButton.GetControlId: TCDControlID; function TCDButton.GetControlId: TCDControlID;
begin begin
@ -1171,6 +1065,39 @@ begin
inherited Destroy; inherited Destroy;
end; end;
{ TCDRadioButton }
procedure TCDRadioButton.SetChecked(AValue: Boolean);
begin
if (AValue and (csfOn in FState)) or
((not AValue) and (csfOff in FState)) then Exit;
if AValue then FState := FState + [csfOn] - [csfOff]
else FState := FState + [csfOff] - [csfOn];
Invalidate;
end;
function TCDRadioButton.GetChecked: Boolean;
begin
Result := csfOn in FState;
end;
function TCDRadioButton.GetControlId: TCDControlID;
begin
Result := cidRadioButton;
end;
constructor TCDRadioButton.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
end;
destructor TCDRadioButton.Destroy;
begin
inherited Destroy;
end;
{ TCDGroupBox } { TCDGroupBox }
function TCDGroupBox.GetControlId: TCDControlID; function TCDGroupBox.GetControlId: TCDControlID;
@ -1276,19 +1203,23 @@ end;
procedure TCDTrackBar.KeyDown(var Key: word; Shift: TShiftState); procedure TCDTrackBar.KeyDown(var Key: word; Shift: TShiftState);
var var
NewPosition: Integer; NewPosition: Integer = -1;
begin begin
inherited KeyDown(Key, Shift); inherited KeyDown(Key, Shift);
if (Key = 37) or (Key = 40) then
if (Key = VK_LEFT) or (Key = VK_DOWN) then
NewPosition := FPosition - (FMax - FMin) div 10; NewPosition := FPosition - (FMax - FMin) div 10;
if (Key = 38) or (Key = 39) then if (Key = VK_UP) or (Key = VK_RIGHT) then
NewPosition := FPosition + (FMax - FMin) div 10; NewPosition := FPosition + (FMax - FMin) div 10;
// sanity check // sanity check
if NewPosition > FMax then NewPosition := FMax; if NewPosition >= 0 then
if NewPosition < FMin then NewPosition := FMin; begin
if NewPosition > FMax then NewPosition := FMax;
if NewPosition < FMin then NewPosition := FMin;
Position := NewPosition; Position := NewPosition;
end;
end; end;
procedure TCDTrackBar.KeyUp(var Key: word; Shift: TShiftState); procedure TCDTrackBar.KeyUp(var Key: word; Shift: TShiftState);
@ -1457,6 +1388,132 @@ begin
end; end;
end; end;
{ TCDCustomTabControl }
procedure TCDCustomTabControl.MouseDown(Button: TMouseButton;
Shift: TShiftState; X, Y: integer);
var
i: Integer;
CurPage: TCDTabSheet;
CurStartLeftPos: Integer = 0;
VisiblePagesStarted: Boolean = False;
lTabWidth: Integer;
begin
inherited MouseDown(Button, Shift, X, Y);
for i := 0 to Tabs.Count - 1 do
begin
if i = FTabCState.LeftmostTabVisibleIndex then
VisiblePagesStarted := True;
if VisiblePagesStarted then
begin
FTabCState.TabIndex := i;
lTabWidth := FDrawer.GetMeasuresEx(Canvas, TCDCTABCONTROL_TAB_WIDTH, FState, FTabCState);
if (X > CurStartLeftPos) and
(X < CurStartLeftPos + lTabWidth) and
(Y < FDrawer.GetMeasuresEx(Canvas, TCDCTABCONTROL_TAB_HEIGHT, FState, FTabCState)) then
begin
if Self is TCDPageControl then
(Self as TCDPageControl).PageIndex := i
else
TabIndex := i;
Exit;
end;
CurStartLeftPos := CurStartLeftPos + lTabWidth;
end;
end;
end;
procedure TCDCustomTabControl.MouseUp(Button: TMouseButton; Shift: TShiftState;
X, Y: integer);
begin
inherited MouseUp(Button, Shift, X, Y);
end;
procedure TCDCustomTabControl.SetTabIndex(AValue: Integer);
begin
if FTabIndex = AValue then Exit;
if Assigned(OnChanging) then OnChanging(Self);
FTabIndex := AValue;
if Assigned(OnChange) then OnChange(Self);
Invalidate;
end;
procedure TCDCustomTabControl.SetTabs(AValue: TStringList);
begin
if FTabs=AValue then Exit;
FTabs.Assign(AValue);
CorrectTabIndex();
Invalidate;
end;
procedure TCDCustomTabControl.SetOptions(AValue: TNoteBookOptions);
begin
if FOptions=AValue then Exit;
FOptions:=AValue;
Invalidate;
end;
function TCDCustomTabControl.GetControlId: TCDControlID;
begin
Result := cidCTabControl;
end;
procedure TCDCustomTabControl.CreateControlStateEx;
begin
FTabCState := TCDCTabControlStateEx.Create;
FStateEx := FTabCState;
end;
procedure TCDCustomTabControl.PrepareControlStateEx;
begin
inherited PrepareControlStateEx;
FTabCState.Tabs := Tabs;
FTabCState.TabIndex := TabIndex;
FTabCState.TabCount := GetTabCount();
FTabCState.Options := FOptions;
end;
constructor TCDCustomTabControl.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
Width := 232;
Height := 184;
TabStop := True;
PrepareCurrentDrawer();
ParentColor := True;
ParentFont := True;
ControlStyle := ControlStyle + [csAcceptsControls, csDesignInteractive];
// FTabs should hold only visible tabs
FTabs := TStringList.Create;
end;
destructor TCDCustomTabControl.Destroy;
begin
FTabs.Free;
inherited Destroy;
end;
function TCDCustomTabControl.GetTabCount: Integer;
begin
Result := 0;
if FTabs <> nil then Result := FTabs.Count;
end;
procedure TCDCustomTabControl.CorrectTabIndex;
begin
if FTabIndex >= FTabs.Count then SetTabIndex(FTabs.Count - 1);
end;
{ TCDPageControl } { TCDPageControl }
function TCDPageControl.AddPage(S: string): TCDTabSheet; function TCDPageControl.AddPage(S: string): TCDTabSheet;

37
components/customdrawn/customdrawndrawers.pas
View File

@ -21,6 +21,8 @@ const
TCDCHECKBOX_SQUARE_HALF_HEIGHT = $500; TCDCHECKBOX_SQUARE_HALF_HEIGHT = $500;
TCDCHECKBOX_SQUARE_HEIGHT = $501; TCDCHECKBOX_SQUARE_HEIGHT = $501;
TCDRADIOBUTTON_CIRCLE_HEIGHT = $601;
TCDTRACKBAR_LEFT_SPACING = $1000; TCDTRACKBAR_LEFT_SPACING = $1000;
TCDTRACKBAR_RIGHT_SPACING = $1001; TCDTRACKBAR_RIGHT_SPACING = $1001;
@ -67,7 +69,7 @@ type
csfHasFocus, csfHasFocus,
csfReadOnly, csfReadOnly,
csfMouseOver, csfMouseOver,
// for TCDCheckBox // for TCDCheckBox, TCDRadioButton
csfOn, csfOn,
csfOff, csfOff,
csfPartiallyOn csfPartiallyOn
@ -136,11 +138,22 @@ type
TCDControlID = ( TCDControlID = (
cidControl, cidControl,
// Standard
cidMenu,
cidPopUp,
cidButton, cidButton,
cidEdit, cidEdit,
cidCheckBox, cidCheckBox,
cidRadioButton,
cidListBox,
cidComboBox,
cidGroupBox, cidGroupBox,
// Additional
cidStaticText,
// Common Controls
cidTrackBar, cidTrackBar,
cidProgressBar,
cidListView,
cidCTabControl cidCTabControl
); );
@ -191,7 +204,7 @@ type
function GetClientArea(ADest: TCanvas; ASize: TSize; AControlId: TCDControlID; function GetClientArea(ADest: TCanvas; ASize: TSize; AControlId: TCDControlID;
AState: TCDControlState; AStateEx: TCDControlStateEx): TRect; virtual; abstract; AState: TCDControlState; AStateEx: TCDControlStateEx): TRect; virtual; abstract;
procedure DrawControl(ADest: TCanvas; ADestPos: TPoint; ASize: TSize; procedure DrawControl(ADest: TCanvas; ADestPos: TPoint; ASize: TSize;
AControl: TCDControlID; AState: TCDControlState; AStateEx: TCDControlStateEx); virtual; abstract; AControl: TCDControlID; AState: TCDControlState; AStateEx: TCDControlStateEx);
// General drawing routines // General drawing routines
procedure DrawFocusRect(ADest: TCanvas; ADestPos: TPoint; ASize: TSize); virtual; abstract; procedure DrawFocusRect(ADest: TCanvas; ADestPos: TPoint; ASize: TSize); virtual; abstract;
procedure DrawRaisedFrame(ADest: TCanvas; ADestPos: TPoint; ASize: TSize); virtual; abstract; procedure DrawRaisedFrame(ADest: TCanvas; ADestPos: TPoint; ASize: TSize); virtual; abstract;
@ -212,6 +225,11 @@ type
AState: TCDControlState; AStateEx: TCDControlStateEx); virtual; abstract; AState: TCDControlState; AStateEx: TCDControlStateEx); virtual; abstract;
procedure DrawCheckBox(ADest: TCanvas; ADestPos: TPoint; ASize: TSize; procedure DrawCheckBox(ADest: TCanvas; ADestPos: TPoint; ASize: TSize;
AState: TCDControlState; AStateEx: TCDControlStateEx); virtual; abstract; AState: TCDControlState; AStateEx: TCDControlStateEx); virtual; abstract;
// TCDRadioButton
procedure DrawRadioButtonCircle(ADest: TCanvas; ADestPos: TPoint; ASize: TSize;
AState: TCDControlState; AStateEx: TCDControlStateEx); virtual; abstract;
procedure DrawRadioButton(ADest: TCanvas; ADestPos: TPoint; ASize: TSize;
AState: TCDControlState; AStateEx: TCDControlStateEx); virtual; abstract;
// TCDGroupBox // TCDGroupBox
procedure DrawGroupBoxSquare(ADest: TCanvas; ADestPos: TPoint; ASize: TSize; procedure DrawGroupBoxSquare(ADest: TCanvas; ADestPos: TPoint; ASize: TSize;
AState: TCDControlState; AStateEx: TCDControlStateEx); virtual; abstract; AState: TCDControlState; AStateEx: TCDControlStateEx); virtual; abstract;
@ -376,6 +394,21 @@ begin
end; end;
end; end;
procedure TCDDrawer.DrawControl(ADest: TCanvas; ADestPos: TPoint; ASize: TSize;
AControl: TCDControlID; AState: TCDControlState; AStateEx: TCDControlStateEx
);
begin
case AControl of
cidButton: DrawButton(ADest, ADestPos, ASize, AState, AStateEx);
cidEdit: DrawEdit(ADest, ADestPos, ASize, AState, TCDEditStateEx(AStateEx));
cidCheckBox: DrawCheckBox(ADest, ADestPos, ASize, AState, AStateEx);
cidRadioButton:DrawRadioButton(ADest, ADestPos, ASize, AState, AStateEx);
cidGroupBox: DrawGroupBox(ADest, ADestPos, ASize, AState, AStateEx);
cidTrackBar: DrawTrackBar(ADest, ADestPos, ASize, AState, TCDTrackBarStateEx(AStateEx));
cidCTabControl:DrawCTabControl(ADest, ADestPos, ASize, AState, TCDCTabControlStateEx(AStateEx));
end;
end;
finalization finalization
// Free all drawers // Free all drawers
for i := 0 to CDDRAWSTYLE_COUNT-1 do for i := 0 to CDDRAWSTYLE_COUNT-1 do

2
components/customdrawn/customdrawnextras.pas
View File

@ -184,7 +184,7 @@ procedure Register;
begin begin
RegisterComponents('Custom Drawn', [ RegisterComponents('Custom Drawn', [
// Standard tab // Standard tab
TCDButton, TCDEdit, TCDCheckBox, TCDGroupBox, TCDButton, TCDEdit, TCDCheckBox, TCDRadioButton, TCDGroupBox,
// Common Controls // Common Controls
TCDTrackBar, TCDPageControl, TCDTabControl]); TCDTrackBar, TCDPageControl, TCDTabControl]);
RegisterComponentEditor(TCDPageControl, TCDPageControlEditor); RegisterComponentEditor(TCDPageControl, TCDPageControlEditor);