mirror of https://gitlab.com/basile.b/dexed.git
add design time package for custom ce controls
This commit is contained in:
Basile Burg
parent
4b69fb4fa9
commit
3b71bd7f8a
|
|
@ -0,0 +1,21 @@
|
|||
{ This file was automatically created by Lazarus. Do not edit!
|
||||
This source is only used to compile and install the package.
|
||||
}
|
||||
|
||||
unit cecontrols;
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
ce_dsgncontrols, LazarusPackageIntf;
|
||||
|
||||
implementation
|
||||
|
||||
procedure Register;
|
||||
begin
|
||||
RegisterUnit('ce_dsgncontrols', @ce_dsgncontrols.Register);
|
||||
end;
|
||||
|
||||
initialization
|
||||
RegisterPackage('cecontrols', @Register);
|
||||
end.
|
||||
|
|
@ -0,0 +1,48 @@
|
|||
<?xml version="1.0" encoding="UTF-8"?>
|
||||
<CONFIG>
|
||||
<Package Version="4">
|
||||
<Name Value="cedsgncontrols"/>
|
||||
<Type Value="RunAndDesignTime"/>
|
||||
<CompilerOptions>
|
||||
<Version Value="11"/>
|
||||
<SearchPaths>
|
||||
<OtherUnitFiles Value="../src"/>
|
||||
<UnitOutputDirectory Value="lib/$(TargetCPU)-$(TargetOS)"/>
|
||||
</SearchPaths>
|
||||
<CodeGeneration>
|
||||
<Optimizations>
|
||||
<OptimizationLevel Value="2"/>
|
||||
</Optimizations>
|
||||
</CodeGeneration>
|
||||
<Other>
|
||||
<Verbosity>
|
||||
<ShowWarn Value="False"/>
|
||||
</Verbosity>
|
||||
</Other>
|
||||
</CompilerOptions>
|
||||
<Files Count="1">
|
||||
<Item1>
|
||||
<Filename Value="../src/ce_dsgncontrols.pas"/>
|
||||
<HasRegisterProc Value="True"/>
|
||||
<UnitName Value="ce_dsgncontrols"/>
|
||||
</Item1>
|
||||
</Files>
|
||||
<RequiredPkgs Count="2">
|
||||
<Item1>
|
||||
<PackageName Value="LCL"/>
|
||||
</Item1>
|
||||
<Item2>
|
||||
<PackageName Value="FCL"/>
|
||||
</Item2>
|
||||
</RequiredPkgs>
|
||||
<UsageOptions>
|
||||
<UnitPath Value="$(PkgOutDir)"/>
|
||||
</UsageOptions>
|
||||
<PublishOptions>
|
||||
<Version Value="2"/>
|
||||
</PublishOptions>
|
||||
<CustomOptions Items="ExternHelp" Version="2">
|
||||
<_ExternHelp Items="Count"/>
|
||||
</CustomOptions>
|
||||
</Package>
|
||||
</CONFIG>
|
||||
|
|
@ -0,0 +1,21 @@
|
|||
{ This file was automatically created by Lazarus. Do not edit!
|
||||
This source is only used to compile and install the package.
|
||||
}
|
||||
|
||||
unit cedsgncontrols;
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
ce_dsgncontrols, LazarusPackageIntf;
|
||||
|
||||
implementation
|
||||
|
||||
procedure Register;
|
||||
begin
|
||||
RegisterUnit('ce_dsgncontrols', @ce_dsgncontrols.Register);
|
||||
end;
|
||||
|
||||
initialization
|
||||
RegisterPackage('cedsgncontrols', @Register);
|
||||
end.
|
||||
|
|
@ -202,25 +202,28 @@
|
|||
<FormatVersion Value="1"/>
|
||||
</local>
|
||||
</RunParams>
|
||||
<RequiredPackages Count="6">
|
||||
<RequiredPackages Count="7">
|
||||
<Item1>
|
||||
<PackageName Value="anchordocking"/>
|
||||
<PackageName Value="cedsgncontrols"/>
|
||||
</Item1>
|
||||
<Item2>
|
||||
<PackageName Value="FCL"/>
|
||||
<PackageName Value="anchordocking"/>
|
||||
</Item2>
|
||||
<Item3>
|
||||
<PackageName Value="RunTimeTypeInfoControls"/>
|
||||
<PackageName Value="FCL"/>
|
||||
</Item3>
|
||||
<Item4>
|
||||
<PackageName Value="SynEdit"/>
|
||||
<PackageName Value="RunTimeTypeInfoControls"/>
|
||||
</Item4>
|
||||
<Item5>
|
||||
<PackageName Value="LazControls"/>
|
||||
<PackageName Value="SynEdit"/>
|
||||
</Item5>
|
||||
<Item6>
|
||||
<PackageName Value="LCL"/>
|
||||
<PackageName Value="LazControls"/>
|
||||
</Item6>
|
||||
<Item7>
|
||||
<PackageName Value="LCL"/>
|
||||
</Item7>
|
||||
</RequiredPackages>
|
||||
<Units Count="51">
|
||||
<Unit0>
|
||||
|
|
|
|||
|
|
@ -0,0 +1,202 @@
|
|||
unit ce_dsgncontrols;
|
||||
{$I ce_defines.inc}
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
Classes, SysUtils, Forms, Controls, ComCtrls, ExtCtrls, buttons, graphics,
|
||||
Menus, LMessages, LCLType;
|
||||
|
||||
type
|
||||
|
||||
(**
|
||||
* Toolbutton with methods to load the glyph from the shared resources
|
||||
*)
|
||||
TCEToolButton = class(TToolButton)
|
||||
private
|
||||
fResourceName: string;
|
||||
fScaledSeparator: boolean;
|
||||
fPng: TPortableNetworkGraphic;
|
||||
procedure setResourceName(const value: string);
|
||||
procedure setScaledSeparator(value: boolean);
|
||||
procedure setToolBar(value: TToolbar);
|
||||
protected
|
||||
procedure Paint; override;
|
||||
published
|
||||
property resourceName: string read fResourceName write setResourceName;
|
||||
property scaledSeparator: boolean read fScaledSeparator write setScaledSeparator;
|
||||
public
|
||||
constructor Create(TheOwner: TComponent); override;
|
||||
destructor Destroy; override;
|
||||
end;
|
||||
|
||||
(**
|
||||
* Toolbar with design-time support for TCEToolbutton
|
||||
*)
|
||||
TCEToolBar = class(TToolBar)
|
||||
protected
|
||||
fDesignMenu: TPopupMenu;
|
||||
procedure dsgnAdd(style: TToolButtonStyle);
|
||||
procedure dsgnAddButton(sender: TObject);
|
||||
procedure dsgnAddDivider(sender: TObject);
|
||||
procedure dsgnAddSeparator(sender: TObject);
|
||||
procedure dsgnAddDropdown(sender: TObject);
|
||||
procedure dsgnAddCheckbutton(sender: TObject);
|
||||
public
|
||||
constructor Create(TheOwner: TComponent); override;
|
||||
destructor Destroy; override;
|
||||
procedure CMDesignHitTest(var Message: TCMDesignHitTest); message CM_DESIGNHITTEST;
|
||||
end;
|
||||
|
||||
procedure register;
|
||||
|
||||
implementation
|
||||
|
||||
procedure register;
|
||||
begin
|
||||
RegisterComponents('Coedit', [TCEToolBar, TCEToolButton]);
|
||||
end;
|
||||
|
||||
constructor TCEToolButton.Create(TheOwner: TComponent);
|
||||
begin
|
||||
inherited;
|
||||
fPng := TPortableNetworkGraphic.Create;
|
||||
end;
|
||||
|
||||
destructor TCEToolButton.Destroy;
|
||||
begin
|
||||
fPng.FreeImage;
|
||||
fPng.Free;
|
||||
inherited;
|
||||
end;
|
||||
|
||||
procedure TCEToolButton.setToolBar(value: TToolbar);
|
||||
begin
|
||||
FToolBar := value;
|
||||
end;
|
||||
|
||||
procedure TCEToolButton.setResourceName(const value: string);
|
||||
begin
|
||||
if fResourceName = value then
|
||||
exit;
|
||||
fResourceName:=value;
|
||||
if csDesigning in ComponentState then
|
||||
exit;
|
||||
if Style = tbsButton then
|
||||
begin
|
||||
fPng.FreeImage;
|
||||
fPng.LoadFromResourceName(HINSTANCE, fResourceName);
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TCEToolButton.setScaledSeparator(value: boolean);
|
||||
begin
|
||||
if fScaledSeparator = value then
|
||||
exit;
|
||||
fScaledSeparator:=value;
|
||||
// store ratio if true
|
||||
end;
|
||||
|
||||
procedure TCEToolButton.Paint;
|
||||
var
|
||||
rc: TRect;
|
||||
begin
|
||||
if (fResourceName <> '') and (style = tbsButton) then
|
||||
begin
|
||||
rc := ClientRect;
|
||||
Canvas.Draw(rc.Left, rc.Top, fPng);
|
||||
end
|
||||
else inherited;
|
||||
end;
|
||||
|
||||
constructor TCEToolBar.Create(TheOwner: TComponent);
|
||||
var
|
||||
item: TMenuItem;
|
||||
begin
|
||||
inherited;
|
||||
if csDesigning in ComponentState then
|
||||
begin
|
||||
fDesignMenu := TPopupMenu.Create(nil);
|
||||
fDesignMenu.Name:= 'CEToolbarDsgnMenu';
|
||||
item := TMenuItem.Create(fDesignMenu);
|
||||
item.Caption:= 'add button';
|
||||
item.OnClick:= @dsgnAddButton;
|
||||
fDesignMenu.Items.Add(item);
|
||||
item := TMenuItem.Create(fDesignMenu);
|
||||
item.Caption:= 'add separator';
|
||||
item.OnClick:= @dsgnAddSeparator;
|
||||
fDesignMenu.Items.Add(item);
|
||||
item := TMenuItem.Create(fDesignMenu);
|
||||
item.Caption:= 'add divider';
|
||||
item.OnClick:= @dsgnAddDivider;
|
||||
fDesignMenu.Items.Add(item);
|
||||
item := TMenuItem.Create(fDesignMenu);
|
||||
item.Caption:= 'add check';
|
||||
item.OnClick:= @dsgnAddCheckbutton;
|
||||
fDesignMenu.Items.Add(item);
|
||||
item := TMenuItem.Create(fDesignMenu);
|
||||
item.Caption:= 'add dropdown';
|
||||
item.OnClick:= @dsgnAddDropdown;
|
||||
fDesignMenu.Items.Add(item);
|
||||
end;
|
||||
end;
|
||||
|
||||
destructor TCEToolBar.Destroy;
|
||||
begin
|
||||
if csDesigning in ComponentState then
|
||||
fDesignMenu.Free;
|
||||
inherited;
|
||||
end;
|
||||
|
||||
procedure TCEToolBar.CMDesignHitTest(var Message: TCMDesignHitTest);
|
||||
begin
|
||||
inherited;
|
||||
if not (csDesigning in ComponentState) then
|
||||
exit;
|
||||
if Message.Keys <> MK_RBUTTON then
|
||||
exit;
|
||||
Message.Result := 0;
|
||||
fDesignMenu.PopUp(Mouse.CursorPos.x,Mouse.CursorPos.y);
|
||||
end;
|
||||
|
||||
procedure TCEToolBar.dsgnAdd(style: TToolButtonStyle);
|
||||
var
|
||||
button: TCEToolButton;
|
||||
begin
|
||||
button := TCEToolButton.Create(owner);
|
||||
button.Name:= format('button%d',[ButtonList.Count]);
|
||||
button.Style := style;
|
||||
InsertControl(button);
|
||||
ButtonList.add(button);
|
||||
button.setToolBar(self);
|
||||
end;
|
||||
|
||||
procedure TCEToolBar.dsgnAddButton(sender: TObject);
|
||||
begin
|
||||
dsgnAdd(tbsButton);
|
||||
end;
|
||||
|
||||
procedure TCEToolBar.dsgnAddDivider(sender: TObject);
|
||||
begin
|
||||
dsgnAdd(tbsDivider);
|
||||
end;
|
||||
|
||||
procedure TCEToolBar.dsgnAddSeparator(sender: TObject);
|
||||
begin
|
||||
dsgnAdd(tbsSeparator);
|
||||
end;
|
||||
|
||||
procedure TCEToolBar.dsgnAddCheckbutton(sender: TObject);
|
||||
begin
|
||||
dsgnAdd(tbsCheck);
|
||||
end;
|
||||
|
||||
procedure TCEToolBar.dsgnAddDropdown(sender: TObject);
|
||||
begin
|
||||
dsgnAdd(tbsDropDown);
|
||||
end;
|
||||
|
||||
initialization
|
||||
RegisterClasses([TCEToolBar, TCEToolButton]);
|
||||
end.
|
||||
|
||||
Loading…
Reference in New Issue