Стартовый пул
This commit is contained in:
37
ColorBtn/ColorBtn.lpk
Normal file
37
ColorBtn/ColorBtn.lpk
Normal file
@@ -0,0 +1,37 @@
|
||||
<?xml version="1.0" encoding="UTF-8"?>
|
||||
<CONFIG>
|
||||
<Package Version="4">
|
||||
<PathDelim Value="\"/>
|
||||
<Name Value="ColorBtn"/>
|
||||
<Type Value="RunAndDesignTime"/>
|
||||
<CompilerOptions>
|
||||
<Version Value="11"/>
|
||||
<PathDelim Value="\"/>
|
||||
<SearchPaths>
|
||||
<OtherUnitFiles Value="data"/>
|
||||
<UnitOutputDirectory Value="lib\$(TargetCPU)-$(TargetOS)\"/>
|
||||
</SearchPaths>
|
||||
</CompilerOptions>
|
||||
<Files Count="1">
|
||||
<Item1>
|
||||
<Filename Value="data\color_btn.pas"/>
|
||||
<HasRegisterProc Value="True"/>
|
||||
<UnitName Value="color_btn"/>
|
||||
</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>
|
||||
</Package>
|
||||
</CONFIG>
|
||||
21
ColorBtn/ColorBtn.pas
Normal file
21
ColorBtn/ColorBtn.pas
Normal file
@@ -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 ColorBtn;
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
color_btn, LazarusPackageIntf;
|
||||
|
||||
implementation
|
||||
|
||||
procedure Register;
|
||||
begin
|
||||
RegisterUnit('color_btn', @color_btn.Register);
|
||||
end;
|
||||
|
||||
initialization
|
||||
RegisterPackage('ColorBtn', @Register);
|
||||
end.
|
||||
189
ColorBtn/data/color_btn.pas
Normal file
189
ColorBtn/data/color_btn.pas
Normal file
@@ -0,0 +1,189 @@
|
||||
unit color_btn;
|
||||
{$MODE Delphi}
|
||||
interface
|
||||
uses LCLIntf, LCLType, LMessages, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls, Buttons,
|
||||
windows;
|
||||
type
|
||||
TColorBtn = class(TButton)
|
||||
private
|
||||
FCanvas: TCanvas;
|
||||
IsFocused: Boolean;
|
||||
F3DFrame: Boolean;
|
||||
FButtonColor: TColor;
|
||||
procedure Set3DFrame(Value: Boolean);
|
||||
procedure SetButtonColor(Value: TColor);
|
||||
procedure CNDrawItem(var Message: TWMDrawItem); MESSAGE CN_DRAWITEM;
|
||||
procedure WMLButtonDblClk(var Message: TLMLButtonDblClk); MESSAGE WM_LBUTTONDBLCLK;
|
||||
procedure DrawButtonText(const Caption: string; TRC: TRect; State: TButtonState; BiDiFlags: Longint);
|
||||
procedure CalcuateTextPosition(const Caption: string; var TRC: TRect; BiDiFlags: Longint);
|
||||
protected
|
||||
procedure CreateParams(var Params: TCreateParams); OVERRIDE;
|
||||
procedure SetButtonStyle(ADefault: Boolean);// OVERRIDE;
|
||||
public
|
||||
constructor Create(AOwner: TComponent); OVERRIDE;
|
||||
destructor Destroy; OVERRIDE;
|
||||
published
|
||||
property ButtonColor: TColor read FButtonColor write SetButtonColor default clBtnFace;
|
||||
property Frame3D: Boolean read F3DFrame write Set3DFrame default False;
|
||||
end;
|
||||
procedure Register;
|
||||
implementation
|
||||
{ TColorBtn }
|
||||
constructor TColorBtn.Create(AOwner: TComponent);
|
||||
begin
|
||||
inherited Create(AOwner);
|
||||
Height:= 21;
|
||||
FCanvas:= TCanvas.Create;
|
||||
FButtonColor:= clBtnFace;
|
||||
F3DFrame:= False;
|
||||
end;
|
||||
destructor TColorBtn.Destroy;
|
||||
begin
|
||||
FCanvas.Free;
|
||||
inherited Destroy;
|
||||
end;
|
||||
procedure TColorBtn.CreateParams(var Params: TCreateParams);
|
||||
begin
|
||||
inherited CreateParams(Params);
|
||||
with Params do
|
||||
Style:= Style or BS_OWNERDRAW;
|
||||
end;
|
||||
procedure TColorBtn.Set3DFrame(Value: boolean);
|
||||
begin
|
||||
if F3DFrame <> Value then
|
||||
F3DFrame:= Value;
|
||||
end;
|
||||
procedure TColorBtn.SetButtonColor(Value: TColor);
|
||||
begin
|
||||
if FButtonColor <> Value then
|
||||
begin
|
||||
FButtonColor:= Value;
|
||||
Invalidate;
|
||||
end;
|
||||
end;
|
||||
procedure TColorBtn.WMLButtonDblClk(var Message: TLMLButtonDblClk);
|
||||
begin
|
||||
Perform(WM_LBUTTONDOWN, Message.Keys, Longint(Message.Pos));
|
||||
end;
|
||||
procedure TColorBtn.SetButtonStyle(ADefault: Boolean);
|
||||
begin
|
||||
if IsFocused <> ADefault then
|
||||
IsFocused:= ADefault;
|
||||
end;
|
||||
procedure TColorBtn.CNDrawItem(var Message: TWMDrawItem);
|
||||
var RC: TRect;
|
||||
Flags: Longint;
|
||||
State: TButtonState;
|
||||
IsDown, IsDefault: Boolean;
|
||||
DrawItemStruct: TDrawItemStruct;
|
||||
begin
|
||||
DrawItemStruct:= Message.DrawItemStruct^;
|
||||
FCanvas.Handle:= DrawItemStruct.hwndItem;
|
||||
RC:= ClientRect;
|
||||
with DrawItemStruct do
|
||||
begin
|
||||
IsDown:= ItemState and ODS_SELECTED <> 0;
|
||||
IsDefault:= ItemState and ODS_FOCUS <> 0;
|
||||
if not Enabled then
|
||||
State:= bsDisabled
|
||||
else
|
||||
if IsDown then
|
||||
State:= bsDown
|
||||
else
|
||||
State:= bsUp;
|
||||
end;
|
||||
Flags:= DFCS_BUTTONPUSH or DFCS_ADJUSTRECT;
|
||||
if IsDown then
|
||||
Flags:= Flags or DFCS_PUSHED;
|
||||
if DrawItemStruct.ItemState and ODS_DISABLED <> 0 then
|
||||
Flags:= Flags or DFCS_INACTIVE;
|
||||
if IsFocused or IsDefault then
|
||||
begin
|
||||
FCanvas.Pen.Color:= clWindowFrame;
|
||||
FCanvas.Pen.Width:= 1;
|
||||
FCanvas.Brush.Style:= bsClear;
|
||||
FCanvas.Rectangle(RC.Left, RC.Top, RC.Right, RC.Bottom);
|
||||
InflateRect(RC, -1, -1);
|
||||
end;
|
||||
if IsDown then
|
||||
begin
|
||||
FCanvas.Pen.Color:= clBtnShadow;
|
||||
FCanvas.Pen.Width:= 1;
|
||||
FCanvas.Rectangle(RC.Left, RC.Top, RC.Right, RC.Bottom);
|
||||
InflateRect(RC, -1, -1);
|
||||
if F3DFrame then
|
||||
begin
|
||||
FCanvas.Pen.Color:= FButtonColor;
|
||||
FCanvas.Pen.Width:= 1;
|
||||
DrawFrameControl(DrawItemStruct.hDC, RC, DFC_BUTTON, Flags);
|
||||
end;
|
||||
end
|
||||
else
|
||||
DrawFrameControl(DrawItemStruct.hDC, RC, DFC_BUTTON, Flags);
|
||||
FCanvas.Brush.Color:= FButtonColor;
|
||||
FCanvas.FillRect(RC);
|
||||
InflateRect(RC, 1, 1);
|
||||
if IsFocused then
|
||||
begin
|
||||
RC:= ClientRect;
|
||||
InflateRect(RC, -1, -1);
|
||||
end;
|
||||
FCanvas.Font:= Self.Font;
|
||||
if IsDown then
|
||||
OffsetRect(RC, 1, 1);
|
||||
DrawButtonText(Caption, RC, State, 0);
|
||||
if IsFocused and IsDefault then
|
||||
begin
|
||||
RC:= ClientRect;
|
||||
InflateRect(RC, -4, -4);
|
||||
FCanvas.Pen.Color:= clWindowFrame;
|
||||
Windows.DrawFocusRect(FCanvas.Handle, RC);
|
||||
end;
|
||||
FCanvas.Handle:= 0;
|
||||
end;
|
||||
procedure TColorBtn.CalcuateTextPosition(const Caption: String; var TRC: TRect; BiDiFlags: Integer);
|
||||
var TB: TRect;
|
||||
TS, TP: TPoint;
|
||||
begin
|
||||
with FCanvas do
|
||||
begin
|
||||
with TB do
|
||||
begin
|
||||
Left:= 0;
|
||||
Top:= 0;
|
||||
Right:= TRC.Right + TRC.Left;
|
||||
Bottom:= TRC.Top + TRC.Bottom;
|
||||
end;
|
||||
DrawText(Handle, PChar(Caption), Length(Caption), TB, DT_CALCRECT or BiDiFlags);
|
||||
TS.x:= TB.Right - TB.Left;
|
||||
TS.y:= TB.Bottom - TB.Top;
|
||||
TP.X:= ((TRC.Right - TRC.Left) - TS.X + 1) div 2;
|
||||
TP.Y:= ((TRC.Bottom - TRC.Top) - TS.Y + 1) div 2;
|
||||
OffsetRect(TB, TP.X + TRC.Left, TP.Y + TRC.Top);
|
||||
TRC:= TB;
|
||||
end;
|
||||
end;
|
||||
procedure TColorBtn.DrawButtonText(const Caption: String; TRC: TRect; State: TButtonState; BiDiFlags: Integer);
|
||||
begin
|
||||
with FCanvas do
|
||||
begin
|
||||
CalcuateTextPosition(Caption, TRC, BiDiFlags);
|
||||
Brush.Style:= bsClear;
|
||||
if State = bsDisabled then
|
||||
begin
|
||||
OffsetRect(TRC, 1, 1);
|
||||
Font.Color:= clBtnHighlight;
|
||||
DrawText(Handle, PChar(Caption), Length(Caption), TRC, DT_CENTER or DT_VCENTER or BiDiFlags);
|
||||
OffsetRect(TRC, -1, -1);
|
||||
Font.Color:= clBtnShadow;
|
||||
DrawText(Handle, PChar(Caption), Length(Caption), TRC, DT_CENTER or DT_VCENTER or BiDiFlags);
|
||||
end
|
||||
else
|
||||
DrawText(Handle, PChar(Caption), Length(Caption), TRC, DT_CENTER or DT_VCENTER or BiDiFlags);
|
||||
end;
|
||||
end;
|
||||
procedure Register;
|
||||
begin
|
||||
RegisterComponents('Additional', [TColorBtn]);
|
||||
end;
|
||||
end.
|
||||
Reference in New Issue
Block a user