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

customdrawn: Further implements the toolbar buttons and drawing

Browse Source 
git-svn-id: trunk@48822 -
This commit is contained in:
sekelsenmat 2015-04-23 13:12:11 +00:00
parent afa5584b36
commit 8a8c672aa6
5 changed files with 180 additions and 11 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

3
components/customdrawn/examples/controls/cdcontrolstest.lpi
View File

@ -36,12 +36,12 @@
<Unit0>
<Filename Value="cdcontrolstest.lpr"/>
<IsPartOfProject Value="True"/>
<UnitName Value="cdcontrolstest"/>
</Unit0>
<Unit1>
<Filename Value="mainform.pas"/>
<IsPartOfProject Value="True"/>
<ComponentName Value="formCDControlsTest"/>
<HasResources Value="True"/>
<ResourceBaseClass Value="Form"/>
<UnitName Value="mainform"/>
</Unit1>
@ -49,6 +49,7 @@
<Filename Value="toolbartest.pas"/>
<IsPartOfProject Value="True"/>
<ComponentName Value="FormToolBar"/>
<HasResources Value="True"/>
<ResourceBaseClass Value="Form"/>
<UnitName Value="toolbartest"/>
</Unit2>

15
components/customdrawn/examples/controls/toolbartest.pas
View File

@ -47,16 +47,25 @@ var
lBmp: TBitmap;
lItem: TCDToolBarItem;
begin
lBmp := TBitmap.Create;
lToolBar := TCDToolBar.Create(Self);
lToolBar.Parent := Self;
lBmp := TBitmap.Create;
lBmp.LoadFromFile('/usr/share/magnifier/lupa.bmp');
lItem := lToolBar.AddItem(tikButton);
lItem.Image := lBmp;
lItem.Caption := 'Btn 1';
lToolBar.Parent := Self;
lToolBar.Parent := Self;
lItem := lToolBar.AddItem(tikSeparator);
lBmp := TBitmap.Create;
lBmp.LoadFromFile('/usr/share/magnifier/usplegal.bmp');
lItem := lToolBar.AddItem(tikCheckButton);
lItem.Image := lBmp;
lItem.Caption := 'Btn 2';
lItem := lToolBar.AddItem(tikDivider);
end;
procedure TFormToolBar.FormShow(Sender: TObject);

53
lcl/customdrawn_common.pas
View File

@ -1626,6 +1626,7 @@ var
lItemSize: TSize;
i: Integer;
lCurItem: TCDToolBarItem;
lItemState: TCDControlState = [];
begin
// Background
ADest.Pen.Style := psSolid;
@ -1642,20 +1643,58 @@ begin
begin
lCurItem := TCDToolBarItem(AStateEx.Items[i]);
lItemSize.CX := lCurItem.Width;
DrawToolBarItem(ADest, lItemSize, lCurItem, lX, lY, AState, AStateEx);
DrawToolBarItem(ADest, lItemSize, lCurItem, lX, lY, lCurItem.State, AStateEx);
lX := lX + lCurItem.Width;
end;
end;
procedure TCDDrawerCommon.DrawToolBarItem(ADest: TCanvas; ASize: TSize;
ACurItem: TCDToolBarItem; AX, AY: Integer; AState: TCDControlState; AStateEx: TCDToolBarStateEx);
var
lX, lY1, lY2: Integer;
procedure DrawToolBarItemBorder();
begin
ADest.Pen.Style := psSolid;
ADest.Pen.Color := $AFAFAF;
ADest.Brush.Style := bsClear;
ADest.Rectangle(Bounds(AX, AY, ASize.cx, ASize.cy));
end;
begin
// Background
ADest.Pen.Style := psSolid;
ADest.Pen.Color := AStateEx.ParentRGBColor;
ADest.Brush.Style := bsSolid;
ADest.Brush.Color := clWhite;
ADest.Rectangle(AX, AY, ASize.cx, ASize.cy);
// tikDivider is centralized, tikSeparator is left-aligned
if ACurItem.Kind in [tikSeparator, tikDivider] then
begin
lX := AX;
if ACurItem.Kind = tikDivider then
lX := AX + ASize.CX div 2 - 1;
lY1 := AY;
lY2 := AY+ASize.CY;
ADest.Pen.Style := psSolid;
ADest.Pen.Color := $DCDEE1;
ADest.Line(lX+1, lY1, lX+1, lY2);
ADest.Line(lX+3, lY1, lX+3, lY2);
ADest.Pen.Style := psSolid;
ADest.Pen.Color := $93979E;
ADest.Line(lX+2, lY1, lX+2, lY2);
end
else
begin
if csfSunken in AState then
begin
ADest.GradientFill(Bounds(AX, AY, ASize.CX, ASize.CY),
$C4C4C4, $DBDBDB, gdVertical);
DrawToolBarItemBorder();
end
else if csfMouseOver in AState then
begin
ADest.GradientFill(Bounds(AX, AY, ASize.CX, ASize.CY),
$E3E3E3, $F7F7F7, gdVertical);
DrawToolBarItemBorder();
end;
end;
end;
procedure TCDDrawerCommon.DrawCTabControl(ADest: TCanvas;

117
lcl/customdrawncontrols.pas
View File

@ -616,6 +616,12 @@ type
function GetControlId: TCDControlID; override;
procedure CreateControlStateEx; override;
procedure PrepareControlStateEx; override;
// mouse
procedure MouseMove(Shift: TShiftState; X, Y: integer); override;
procedure MouseDown(Button: TMouseButton; Shift: TShiftState;
X, Y: integer); override;
procedure MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: integer); override;
procedure MouseLeave; override;
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
@ -623,6 +629,9 @@ type
function AddItem(AKind: TCDToolbarItemKind): TCDToolBarItem;
procedure DeleteItem(AIndex: Integer);
function GetItem(AIndex: Integer): TCDToolBarItem;
function GetItemCount(): Integer;
function GetItemWithMousePos(APosInControl: TPoint): TCDToolBarItem;
function IsPosInButton(APosInControl: TPoint; AItem: TCDToolBarItem; AItemX: Integer): Boolean;
published
property ShowCaptions: Boolean read FShowCaptions write SetShowCaptions;
property DrawStyle;
@ -2889,11 +2898,87 @@ begin
end;
procedure TCDToolBar.PrepareControlStateEx;
var
i, lX: Integer;
lCursorPos: TPoint;
lCurItem: TCDToolBarItem;
begin
inherited PrepareControlStateEx;
FTBState.ShowCaptions := FShowCaptions;
FTBState.Items := FItems;
FTBState.ToolBarHeight := Height;
// Handle mouse over items
lCursorPos := Mouse.CursorPos;
lCursorPos := ScreenToClient(lCursorPos);
lX := 0;
for i := 0 to GetItemCount()-1 do
begin
lCurItem := GetItem(i);
lCurItem.State := lCurItem.State - [csfMouseOver];
if IsPosInButton(lCursorPos, lCurItem, lX) then
lCurItem.State := lCurItem.State + [csfMouseOver];
if lCurItem.Down then
lCurItem.State := lCurItem.State + [csfSunken];
lX := lX + lCurItem.Width;
end;
end;
procedure TCDToolBar.MouseMove(Shift: TShiftState; X, Y: integer);
begin
inherited MouseMove(Shift, X, Y);
Invalidate;
end;
procedure TCDToolBar.MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: integer);
var
lCurItem: TCDToolBarItem;
begin
inherited MouseDown(Button, Shift, X, Y);
lCurItem := GetItemWithMousePos(Point(X, Y));
if lCurItem = nil then Exit;
if lCurItem.Kind in [tikButton, tikCheckButton] then
begin
lCurItem.State := lCurItem.State + [csfSunken];
Invalidate();
end;
end;
procedure TCDToolBar.MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: integer);
var
i: Integer;
lCurItem: TCDToolBarItem;
DoInvalidate: Boolean = False;
begin
inherited MouseUp(Button, Shift, X, Y);
lCurItem := GetItemWithMousePos(Point(X, Y));
if lCurItem = nil then Exit;
// click the selected checkbutton if applicable
if lCurItem.Kind in [tikCheckButton] then
begin
lCurItem.Down := not lCurItem.Down;
DoInvalidate := True;
end;
// up all buttons
for i := 0 to GetItemCount()-1 do
begin
lCurItem := GetItem(i);
if lCurItem.Kind in [tikButton, tikCheckButton] then
begin
lCurItem.State := lCurItem.State - [csfSunken];
DoInvalidate := True;
end;
end;
if DoInvalidate then Invalidate;
end;
procedure TCDToolBar.MouseLeave;
begin
inherited MouseLeave;
Invalidate;
end;
constructor TCDToolBar.Create(AOwner: TComponent);
@ -2942,6 +3027,38 @@ begin
Result := TCDToolBarItem(FItems.Items[AIndex]);
end;
function TCDToolBar.GetItemCount: Integer;
begin
Result := FItems.Count;
end;
function TCDToolBar.GetItemWithMousePos(APosInControl: TPoint): TCDToolBarItem;
var
i, lX: Integer;
lCurItem: TCDToolBarItem;
begin
Result := nil;
lX := 0;
for i := 0 to FItems.Count-1 do
begin
lCurItem := GetItem(i);
if IsPosInButton(APosInControl, lCurItem, lX) then
Exit(lCurItem);
lX := lX + lCurItem.Width;
end;
end;
function TCDToolBar.IsPosInButton(APosInControl: TPoint; AItem: TCDToolBarItem;
AItemX: Integer): Boolean;
var
lSize: TSize;
begin
lSize.CY := Height;
lSize.CX := AItem.Width;
Result := (APosInControl.X > AItemX) and (APosInControl.X < AItemX + lSize.CX) and
(APosInControl.Y > 0) and (APosInControl.Y < lSize.CY);
end;
{ TCDTabSheet }
procedure TCDTabSheet.RealSetText(const Value: TCaption);

3
lcl/customdrawndrawers.pas
View File

@ -221,6 +221,9 @@ type
Image: TBitmap;
Caption: string;
Width: Integer;
Down: Boolean;
// filled for drawing
State: TCDControlState;
end;
TCDToolBarStateEx = class(TCDControlStateEx)