mirror of https://gitlab.com/basile.b/dexed.git
add design time package for custom ce controls
This commit is contained in:
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"/>
|
<FormatVersion Value="1"/>
|
||||||
</local>
|
</local>
|
||||||
</RunParams>
|
</RunParams>
|
||||||
<RequiredPackages Count="6">
|
<RequiredPackages Count="7">
|
||||||
<Item1>
|
<Item1>
|
||||||
<PackageName Value="anchordocking"/>
|
<PackageName Value="cedsgncontrols"/>
|
||||||
</Item1>
|
</Item1>
|
||||||
<Item2>
|
<Item2>
|
||||||
<PackageName Value="FCL"/>
|
<PackageName Value="anchordocking"/>
|
||||||
</Item2>
|
</Item2>
|
||||||
<Item3>
|
<Item3>
|
||||||
<PackageName Value="RunTimeTypeInfoControls"/>
|
<PackageName Value="FCL"/>
|
||||||
</Item3>
|
</Item3>
|
||||||
<Item4>
|
<Item4>
|
||||||
<PackageName Value="SynEdit"/>
|
<PackageName Value="RunTimeTypeInfoControls"/>
|
||||||
</Item4>
|
</Item4>
|
||||||
<Item5>
|
<Item5>
|
||||||
<PackageName Value="LazControls"/>
|
<PackageName Value="SynEdit"/>
|
||||||
</Item5>
|
</Item5>
|
||||||
<Item6>
|
<Item6>
|
||||||
<PackageName Value="LCL"/>
|
<PackageName Value="LazControls"/>
|
||||||
</Item6>
|
</Item6>
|
||||||
|
<Item7>
|
||||||
|
<PackageName Value="LCL"/>
|
||||||
|
</Item7>
|
||||||
</RequiredPackages>
|
</RequiredPackages>
|
||||||
<Units Count="51">
|
<Units Count="51">
|
||||||
<Unit0>
|
<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