mirror of
https://gitlab.com/freepascal.org/lazarus/lazarus.git
synced 2025-08-17 07:49:27 +02:00
Renamed, made GraphicControl
git-svn-id: trunk@26216 -
This commit is contained in:
parent
2b109954a7
commit
b339fa48e9
6
.gitattributes
vendored
6
.gitattributes
vendored
@ -952,11 +952,11 @@ components/h2pas/languages/h2passtrconsts.pl.po svneol=native#text/plain
|
||||
components/h2pas/languages/h2passtrconsts.po svneol=native#text/plain
|
||||
components/h2pas/languages/h2passtrconsts.ru.po svneol=native#text/plain
|
||||
components/h2pas/languages/h2passtrconsts.zh_CN.po svneol=native#text/plain
|
||||
components/ideextensions/dividerbevel.pas svneol=native#text/pascal
|
||||
components/ideextensions/dividerbevel_icon.lrs svneol=native#text/pascal
|
||||
components/ideextensions/ideextensions.lpk svneol=native#text/xml
|
||||
components/ideextensions/ideextensions.pas svneol=native#text/pascal
|
||||
components/ideextensions/idegroupbox.pas svneol=native#text/pascal
|
||||
components/ideextensions/idegroupbox.rc svneol=native#text/plain
|
||||
components/ideextensions/images/tidegroupbox.png -text
|
||||
components/ideextensions/images/tdividerbevel.png -text
|
||||
components/images/examples/README.txt svneol=native#text/plain
|
||||
components/images/examples/imagesexample.lpi svneol=native#text/plain
|
||||
components/images/examples/imagesexample.lpr svneol=native#text/pascal
|
||||
|
191
components/ideextensions/dividerbevel.pas
Normal file
191
components/ideextensions/dividerbevel.pas
Normal file
@ -0,0 +1,191 @@
|
||||
{ IdeGroupBox - A specially themed groupbox used inside the IDE
|
||||
|
||||
Copyright (C) 2010 <name of author> <contact>
|
||||
|
||||
This library is free software; you can redistribute it and/or modify it
|
||||
under the terms of the GNU Library General Public License as published by
|
||||
the Free Software Foundation; either version 2 of the License, or (at your
|
||||
option) any later version.
|
||||
|
||||
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. See the GNU Library General Public License
|
||||
for more details.
|
||||
|
||||
You should have received a copy of the GNU Library General Public License
|
||||
along with this library; if not, write to the Free Software Foundation,
|
||||
Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
|
||||
}
|
||||
unit DividerBevel;
|
||||
|
||||
{$mode objfpc}{$H+}
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
Classes, LResources, Forms, Controls, Graphics, Dialogs, StdCtrls, types,
|
||||
LCLType, LCLIntf, LCLProc, math, ExtCtrls;
|
||||
|
||||
type
|
||||
|
||||
{ TDividerBevel }
|
||||
|
||||
TDividerBevel = class(TGraphicControl)
|
||||
private
|
||||
FCaptionSpacing: Integer;
|
||||
FLeftIndent: Integer;
|
||||
FTextHeight, FTextWidth: Integer;
|
||||
FBevelTop: Integer;
|
||||
FBevelHeight: Integer;
|
||||
FNeedCalcSize: Boolean;
|
||||
|
||||
procedure CalcSize;
|
||||
procedure SetCaptionSpacing(const AValue: Integer);
|
||||
procedure SetLeftIndent(const AValue: Integer);
|
||||
protected
|
||||
class function GetControlClassDefaultSize: TSize; override;
|
||||
procedure Paint; override;
|
||||
procedure FontChanged(Sender: TObject); override;
|
||||
procedure TextChanged; override;
|
||||
procedure CalculatePreferredSize(
|
||||
var PreferredWidth, PreferredHeight: integer;
|
||||
WithThemeSpace: Boolean); override;
|
||||
public
|
||||
constructor Create(AOwner: TComponent); override;
|
||||
published
|
||||
property Caption;
|
||||
property Align;
|
||||
property Autosize;
|
||||
property Anchors;
|
||||
property Color;
|
||||
property Constraints;
|
||||
property Font;
|
||||
property Hint;
|
||||
property ParentColor;
|
||||
property ParentFont;
|
||||
property ParentShowHint;
|
||||
property ShowHint;
|
||||
property Visible;
|
||||
published
|
||||
property CaptionSpacing: Integer read FCaptionSpacing write SetCaptionSpacing
|
||||
default 10;
|
||||
property LeftIndent: Integer read FLeftIndent write SetLeftIndent default 60;
|
||||
end;
|
||||
|
||||
procedure Register;
|
||||
|
||||
implementation
|
||||
|
||||
procedure Register;
|
||||
begin
|
||||
{$I dividerbevel_icon.lrs}
|
||||
RegisterComponents('IdeExtensions',[TDividerBevel]);
|
||||
end;
|
||||
|
||||
{ TDividerBevel }
|
||||
|
||||
procedure TDividerBevel.CalcSize;
|
||||
var
|
||||
TextExt: TSize;
|
||||
begin
|
||||
if not FNeedCalcSize then exit;
|
||||
FNeedCalcSize := True;
|
||||
if Caption = '' then
|
||||
TextExt := Canvas.TextExtent(' ')
|
||||
else
|
||||
TextExt := Canvas.TextExtent(Caption);
|
||||
FTextHeight := TextExt.cy;
|
||||
FTextWidth := TextExt.cx;
|
||||
FBevelHeight := Max(3, FTextHeight div 5);
|
||||
FTextHeight := Max(FTextHeight, FBevelHeight + 2);
|
||||
FBevelTop := (FTextHeight - FBevelHeight) div 2;
|
||||
end;
|
||||
|
||||
procedure TDividerBevel.SetCaptionSpacing(const AValue: Integer);
|
||||
begin
|
||||
if FCaptionSpacing = AValue then
|
||||
exit;
|
||||
FCaptionSpacing := AValue;
|
||||
Invalidate;
|
||||
end;
|
||||
|
||||
procedure TDividerBevel.SetLeftIndent(const AValue: Integer);
|
||||
begin
|
||||
if FLeftIndent = AValue then
|
||||
exit;
|
||||
FLeftIndent := AValue;
|
||||
Invalidate;
|
||||
end;
|
||||
|
||||
class function TDividerBevel.GetControlClassDefaultSize: TSize;
|
||||
begin
|
||||
Result.CX := 150;
|
||||
Result.CY := 17;
|
||||
end;
|
||||
|
||||
procedure TDividerBevel.Paint;
|
||||
var
|
||||
PaintRect: TRect;
|
||||
begin
|
||||
CalcSize;
|
||||
Canvas.Brush.Color := Color;
|
||||
Canvas.Brush.Style := bsSolid;
|
||||
Canvas.FillRect(ClientRect);
|
||||
|
||||
Canvas.Pen.Color := Font.Color;
|
||||
PaintRect.Top := FBevelTop;
|
||||
PaintRect.Bottom := FBevelTop + FBevelHeight;
|
||||
PaintRect.Left := 0;
|
||||
if Caption = '' then begin
|
||||
PaintRect.Right := Width;
|
||||
Canvas.Frame3D(PaintRect, 1, bvLowered);
|
||||
exit;
|
||||
end;
|
||||
PaintRect.Right := FLeftIndent;
|
||||
Canvas.Frame3D(PaintRect, 1, bvLowered);
|
||||
|
||||
PaintRect.Top := FBevelTop;
|
||||
PaintRect.Bottom := FBevelTop + FBevelHeight;
|
||||
PaintRect.Left := FLeftIndent + 2*FCaptionSpacing + FTextWidth;
|
||||
PaintRect.Right := Width;
|
||||
Canvas.Frame3D(PaintRect, 1, bvLowered);
|
||||
|
||||
Canvas.TextOut(FLeftIndent + FCaptionSpacing, 0, Caption);
|
||||
end;
|
||||
|
||||
procedure TDividerBevel.FontChanged(Sender: TObject);
|
||||
begin
|
||||
inherited FontChanged(Sender);
|
||||
FNeedCalcSize := True;
|
||||
Invalidate;
|
||||
end;
|
||||
|
||||
procedure TDividerBevel.TextChanged;
|
||||
begin
|
||||
inherited TextChanged;
|
||||
FNeedCalcSize := True;
|
||||
Invalidate;
|
||||
end;
|
||||
|
||||
procedure TDividerBevel.CalculatePreferredSize(var PreferredWidth, PreferredHeight: integer;
|
||||
WithThemeSpace: Boolean);
|
||||
begin
|
||||
FNeedCalcSize := True;
|
||||
CalcSize;
|
||||
PreferredWidth := FTextWidth + 2*FLeftIndent + 2*FCaptionSpacing;
|
||||
PreferredHeight := FTextHeight;
|
||||
end;
|
||||
|
||||
constructor TDividerBevel.Create(AOwner: TComponent);
|
||||
begin
|
||||
inherited Create(AOwner);
|
||||
ControlStyle := [csSetCaption];
|
||||
Font.Style := Font.Style + [fsBold];
|
||||
FCaptionSpacing := 10;
|
||||
LeftIndent := 60;
|
||||
FNeedCalcSize := True;
|
||||
with GetControlClassDefaultSize do
|
||||
SetInitialBounds(0, 0, CX, CY);
|
||||
end;
|
||||
|
||||
end.
|
13
components/ideextensions/dividerbevel_icon.lrs
Normal file
13
components/ideextensions/dividerbevel_icon.lrs
Normal file
@ -0,0 +1,13 @@
|
||||
LazarusResources.Add('tdividerbevel','PNG',[
|
||||
#137'PNG'#13#10#26#10#0#0#0#13'IHDR'#0#0#0#24#0#0#0#24#8#6#0#0#0#224'w='#248#0
|
||||
+#0#0#1'sRGB'#0#174#206#28#233#0#0#0#4'gAMA'#0#0#177#143#11#252'a'#5#0#0#0#9
|
||||
+'pHYs'#0#0#14#195#0#0#14#195#1#199'o'#168'd'#0#0#0#170'IDATHKc'#252#247#239
|
||||
+#223#127'FFF'#6'Z'#1'&Z'#26#14'r4'#19#173'\'#14'3w'#212#2#130'!'#140'7'#136
|
||||
+',r'#246'3'#192'0'#178'I 1b'#193#192#197'A'#211#178#219'`G'#158#152#226#8#166
|
||||
+'a|'#152#203#177#249#12#155#175#192'>'#0#229#5'd'#12#18#219'v'#236#9#138'zt>'
|
||||
+#200'b'#16#134#5#23#186#25#176#252'E'#159' '#250#255#255'?'#3'2F'#14#14#228#8
|
||||
+'E'#15'&d/'#162#155#1#226#227#204#201#176#224#128#5#3','#30#208#131#137#152
|
||||
+#148'Dv'#16#193'"'#25'f9.'#203#24#129'^'#129#248#133'F'#128'l'#31#16#235#158
|
||||
+'Q'#11#8#134#212'h'#16#141#128' '#2#0#138#18'M'#223'@3'#182'*'#0#0#0#0'IEND'
|
||||
+#174'B`'#130
|
||||
]);
|
@ -4,25 +4,20 @@
|
||||
<PathDelim Value="\"/>
|
||||
<Name Value="IdeExtensions"/>
|
||||
<CompilerOptions>
|
||||
<Version Value="8"/>
|
||||
<Version Value="9"/>
|
||||
<PathDelim Value="\"/>
|
||||
<SearchPaths>
|
||||
<UnitOutputDirectory Value="lib\$(TargetCPU)-$(TargetOS)"/>
|
||||
</SearchPaths>
|
||||
<Parsing>
|
||||
<SyntaxOptions>
|
||||
<UseAnsiStrings Value="True"/>
|
||||
</SyntaxOptions>
|
||||
</Parsing>
|
||||
<Other>
|
||||
<CompilerPath Value="$(CompPath)"/>
|
||||
</Other>
|
||||
</CompilerOptions>
|
||||
<Files Count="1">
|
||||
<Item1>
|
||||
<Filename Value="idegroupbox.pas"/>
|
||||
<Filename Value="dividerbevel.pas"/>
|
||||
<HasRegisterProc Value="True"/>
|
||||
<UnitName Value="IdeGroupBox"/>
|
||||
<UnitName Value="dividerbevel"/>
|
||||
</Item1>
|
||||
</Files>
|
||||
<Type Value="RunAndDesignTime"/>
|
||||
|
@ -7,13 +7,13 @@ unit ideextensions;
|
||||
interface
|
||||
|
||||
uses
|
||||
IdeGroupBox, LazarusPackageIntf;
|
||||
DividerBevel, LazarusPackageIntf;
|
||||
|
||||
implementation
|
||||
|
||||
procedure Register;
|
||||
begin
|
||||
RegisterUnit('IdeGroupBox', @IdeGroupBox.Register);
|
||||
RegisterUnit('DividerBevel', @DividerBevel.Register);
|
||||
end;
|
||||
|
||||
initialization
|
||||
|
@ -1,154 +0,0 @@
|
||||
{ IdeGroupBox - A specially themed groupbox used inside the IDE
|
||||
|
||||
Copyright (C) 2010 <name of author> <contact>
|
||||
|
||||
This library is free software; you can redistribute it and/or modify it
|
||||
under the terms of the GNU Library General Public License as published by
|
||||
the Free Software Foundation; either version 2 of the License, or (at your
|
||||
option) any later version.
|
||||
|
||||
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. See the GNU Library General Public License
|
||||
for more details.
|
||||
|
||||
You should have received a copy of the GNU Library General Public License
|
||||
along with this library; if not, write to the Free Software Foundation,
|
||||
Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
|
||||
}
|
||||
unit IdeGroupBox;
|
||||
|
||||
{$mode objfpc}{$H+}
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
Classes, sysutils, LResources, Forms, Controls, Graphics, Dialogs, StdCtrls,
|
||||
LCLIntf, LCLProc, math;
|
||||
|
||||
type
|
||||
|
||||
{ TIdeGroupBox }
|
||||
|
||||
TIdeGroupBox = class(TCustomControl)
|
||||
private
|
||||
FHeaderFont: TFont;
|
||||
FHeaderHeight: Integer;
|
||||
FBevelTop: Integer;
|
||||
FBevelHeight: Integer;
|
||||
procedure SetHeaderFont(const AValue: TFont);
|
||||
protected
|
||||
procedure AdjustClientRect(var ARect: TRect); override;
|
||||
procedure Paint; override;
|
||||
procedure CalcSize;
|
||||
procedure FontChanged(Sender: TObject); override;
|
||||
procedure TextChanged; override;
|
||||
procedure CreateHandle; override;
|
||||
public
|
||||
constructor Create(AOwner: TComponent); override;
|
||||
destructor Destroy; override;
|
||||
published
|
||||
property Caption;
|
||||
property HeaderFont: TFont read FHeaderFont write SetHeaderFont;
|
||||
end;
|
||||
|
||||
{$R *.rc}
|
||||
|
||||
procedure Register;
|
||||
|
||||
implementation
|
||||
|
||||
procedure Register;
|
||||
begin
|
||||
RegisterComponents('IdeExtensions',[TIdeGroupBox]);
|
||||
end;
|
||||
|
||||
{ TIdeGroupBox }
|
||||
procedure TIdeGroupBox.SetHeaderFont(const AValue: TFont);
|
||||
begin
|
||||
FHeaderFont.Assign(AValue);
|
||||
end;
|
||||
|
||||
procedure TIdeGroupBox.AdjustClientRect(var ARect: TRect);
|
||||
begin
|
||||
debugln([FHeaderHeight]);
|
||||
ARect.Top := FHeaderHeight;
|
||||
end;
|
||||
|
||||
procedure TIdeGroupBox.Paint;
|
||||
var
|
||||
PaintRect: TRect;
|
||||
TextWidth: Integer;
|
||||
begin
|
||||
Canvas.Font := FHeaderFont;
|
||||
PaintRect.Top := FBevelTop;
|
||||
PaintRect.Bottom := FBevelTop + FBevelHeight;
|
||||
PaintRect.Left := 0;
|
||||
if Caption = '' then begin
|
||||
PaintRect.Right := Width;
|
||||
Frame3D(Handle, PaintRect, 1, bvLowered);
|
||||
exit;
|
||||
end;
|
||||
TextWidth := Canvas.TextWidth(Caption);
|
||||
PaintRect.Right := 60;
|
||||
Canvas.Frame3D(PaintRect, 1, bvLowered);
|
||||
|
||||
PaintRect.Top := FBevelTop;
|
||||
PaintRect.Bottom := FBevelTop + FBevelHeight;
|
||||
PaintRect.Left := 80 + TextWidth;
|
||||
PaintRect.Right := Width;
|
||||
Canvas.Frame3D(PaintRect, 1, bvLowered);
|
||||
|
||||
Canvas.TextOut(70, 0, Caption);
|
||||
end;
|
||||
|
||||
procedure TIdeGroupBox.CalcSize;
|
||||
begin
|
||||
if not HandleAllocated then exit;
|
||||
if Caption = '' then
|
||||
FHeaderHeight := Canvas.TextHeight(' ')
|
||||
else
|
||||
FHeaderHeight := Canvas.TextHeight(Caption);
|
||||
FBevelHeight := Max(3, FHeaderHeight div 5);
|
||||
FHeaderHeight := Max(FHeaderHeight, FBevelHeight + 2);
|
||||
FBevelTop := (FHeaderHeight - FBevelHeight) div 2;
|
||||
end;
|
||||
|
||||
procedure TIdeGroupBox.FontChanged(Sender: TObject);
|
||||
begin
|
||||
inherited FontChanged(Sender);
|
||||
CalcSize;
|
||||
end;
|
||||
|
||||
procedure TIdeGroupBox.TextChanged;
|
||||
begin
|
||||
inherited TextChanged;
|
||||
if HandleAllocated then begin
|
||||
CalcSize;
|
||||
Invalidate;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TIdeGroupBox.CreateHandle;
|
||||
begin
|
||||
inherited CreateHandle;
|
||||
CalcSize;
|
||||
end;
|
||||
|
||||
constructor TIdeGroupBox.Create(AOwner: TComponent);
|
||||
begin
|
||||
inherited Create(AOwner);
|
||||
ControlStyle := ControlStyle + [csAcceptsControls];
|
||||
FHeaderFont := TFont.Create;
|
||||
FHeaderFont.Assign(Font);
|
||||
FHeaderFont.OnChange := @FontChanged;
|
||||
FHeaderFont.Style := FHeaderFont.Style + [fsBold];
|
||||
end;
|
||||
|
||||
destructor TIdeGroupBox.Destroy;
|
||||
begin
|
||||
inherited Destroy;
|
||||
FreeAndNil(FHeaderFont);
|
||||
end;
|
||||
|
||||
end.
|
@ -1 +0,0 @@
|
||||
tidegroupbox PNG "images/tidegroupbox.png"
|
BIN
components/ideextensions/images/tdividerbevel.png
Normal file
BIN
components/ideextensions/images/tdividerbevel.png
Normal file
Binary file not shown.
After Width: | Height: | Size: 277 B |
Binary file not shown.
Before Width: | Height: | Size: 230 B |
Loading…
Reference in New Issue
Block a user