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

moved TColorButton to dialogs.pp

Browse Source 
git-svn-id: trunk@2580 -
This commit is contained in:
mattias 2002-08-17 23:41:29 +00:00
parent 1c216bdd09
commit 9ca1bd3792
3 changed files with 112 additions and 9 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
.gitattributes vendored
View File

@ -500,6 +500,7 @@ lcl/include/buttons.inc svneol=native#text/pascal
lcl/include/canvas.inc svneol=native#text/pascal
lcl/include/checkbox.inc svneol=native#text/pascal
lcl/include/clipbrd.inc svneol=native#text/pascal
lcl/include/colorbutton.inc svneol=native#text/pascal
lcl/include/colordialog.inc svneol=native#text/pascal
lcl/include/commondialog.inc svneol=native#text/pascal
lcl/include/containedaction.inc svneol=native#text/pascal

35
designer/designer.pp
View File

@ -195,6 +195,8 @@ type
Procedure SelectOnlyThisComponent(AComponent:TComponent); override;
function InvokeComponentEditor(AComponent: TComponent;
MenuIndex: integer): boolean;
procedure DoProcessCommand(Sender: TObject; var Command: word;
var Handled: boolean);
function NonVisualComponentLeftTop(AComponent: TComponent): TPoint;
function NonVisualComponentAtPos(x,y: integer): TComponent;
@ -402,6 +404,27 @@ begin
end;
end;
procedure TDesigner.DoProcessCommand(Sender: TObject; var Command: word;
var Handled: boolean);
begin
if Assigned(OnProcessCommand) and (Command<>ecNone) then begin
OnProcessCommand(Self,Command,Handled);
Handled:=Handled or (Command=ecNone);
end;
if not Handled then begin
Handled:=true;
case Command of
ecSelectParentComponent:
SelectParentOfSelection;
else
Handled:=false;
end;
end;
end;
function TDesigner.NonVisualComponentLeftTop(AComponent: TComponent): TPoint;
begin
Result.X:=Min(LongRec(AComponent.DesignInfo).Lo,
@ -1056,8 +1079,8 @@ end;
-----------------------------K E Y D O W N -------------------------------
}
{
Handles the keydown messages. DEL deletes the selected controls, CTRL-ARROR
moves the selection up one, SHIFT-ARROW resizes, etc.
Handles the keydown messages. DEL deletes the selected controls, CTRL-ARROR
moves the selection up one, SHIFT-ARROW resizes, etc.
}
Procedure TDesigner.KeyDown(Sender : TControl; var TheMessage:TLMKEY);
var
@ -1074,10 +1097,7 @@ Begin
Handled:=false;
Command:=FTheFormEditor.TranslateKeyToDesignerCommand(
TheMessage.CharCode,Shift);
if Assigned(OnProcessCommand) and (Command<>ecNone) then begin
OnProcessCommand(Self,Command,Handled);
Handled:=Handled or (Command=ecNone);
end;
DoProcessCommand(Self,Command,Handled);
if not Handled then begin
Handled:=true;
@ -1109,9 +1129,6 @@ Begin
else if (ssShift in Shift) then
NudgeSize(-1,0);
VK_ESCAPE:
SelectParentOfSelection;
else
Handled:=false;
end;

85
lcl/include/colorbutton.inc Normal file
View File

@ -0,0 +1,85 @@
// included by buttons.pp
{******************************************************************************
TColorButton
******************************************************************************
*****************************************************************************
* *
* This file is part of the Lazarus Component Library (LCL) *
* *
* See the file COPYING.LCL, included in this distribution, *
* for details about the copyright. *
* *
* This program is distributed in the hope that it will be useful, *
* but WITHOUT ANY WARRANTY; without even the implied warranty of *
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. *
* *
*****************************************************************************
}
{ TColorButton }
constructor TColorButton.Create(AnOwner: TComponent);
begin
Inherited Create(AnOwner);
FBorderWidth:=2;
SetInitialBounds(1,1,75,25);
end;
destructor TColorButton.Destroy;
Begin
inherited Destroy;
end;
procedure TColorButton.Paint;
var
ARect: TRect;
begin
with Canvas do begin
ARect:=Bounds(0, 0, Width, Height);
Frame3d(ARect,FBorderWidth,bvRaised);
Brush.Color:=ButtonColor;
FillRect(ARect);
end;
inherited Paint;
end;
procedure TColorButton.SetButtonColor(Value:TColor);
begin
if Value=FButtonColor then exit;
FButtonColor:=Value;
if Assigned(FOnColorChanged) and (not (csLoading in ComponentState)) then
FOnColorChanged(Self);
Invalidate;
end;
procedure TColorButton.SetBorderWidth(const AValue: integer);
begin
if FBorderWidth=AValue then exit;
FBorderWidth:=AValue;
Invalidate;
end;
procedure TColorButton.MouseUp(Button: TMouseButton; Shift: TShiftState;
X, Y: Integer);
var NewColor:TColor;
begin
inherited MouseUp(Button,Shift,X,Y);
if FColorDialog<>nil then exit;
if not Enabled then exit;
NewColor:=ButtonColor;
FColorDialog:=TColorDialog.Create(Application);
try
FColorDialog.Color:=ButtonColor;
if FColorDialog.Execute then
NewColor:=FColorDialog.Color;
finally
FColorDialog.Free;
FColorDialog:=nil;
end;
ButtonColor:=NewColor;
end;
// included by buttons.pp