BSOne.SFC/EM.Lib/PNGComponents/Source/PngBitBtn.pas

349 lines
10 KiB
Plaintext

unit PngBitBtn;
interface
uses
Windows, Messages, Classes, Graphics, Controls, Buttons, pngimage, PngFunctions;
type
TPngBitBtn = class(TBitBtn)
strict private
class constructor Create;
class destructor Destroy;
private
FPngImage: TPngImage;
FPngOptions: TPngOptions;
FCanvas: TCanvas;
FLastKind: TBitBtnKind;
FImageFromAction: Boolean;
FMouseInControl: Boolean;
IsFocused: Boolean;
function PngImageStored: Boolean;
procedure SetPngImage(const Value: TPngImage);
procedure SetPngOptions(const Value: TPngOptions);
procedure CNDrawItem(var Message: TWMDrawItem); message CN_DRAWITEM;
procedure CMMouseEnter(var Message: TMessage); message CM_MOUSEENTER;
procedure CMMouseLeave(var Message: TMessage); message CM_MOUSELEAVE;
protected
procedure ActionChange(Sender: TObject; CheckDefaults: Boolean); override;
procedure SetButtonStyle(ADefault: Boolean); override;
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
published
property PngImage: TPngImage read FPngImage write SetPngImage stored PngImageStored;
property PngOptions: TPngOptions read FPngOptions write SetPngOptions default [pngBlendOnDisabled];
property Glyph stored False;
property NumGlyphs stored False;
end;
TPngBitBtnStyleHook = class(TBitBtnStyleHook)
strict protected
procedure DrawButton(ACanvas: TCanvas; AMouseInControl: Boolean); override;
end;
implementation
uses
ActnList, Themes, PngButtonFunctions;
{ TPngBitBtn }
class constructor TPngBitBtn.Create;
begin
TCustomStyleEngine.RegisterStyleHook(TPngBitBtn, TPngBitBtnStyleHook);
end;
class destructor TPngBitBtn.Destroy;
begin
TCustomStyleEngine.UnRegisterStyleHook(TPngBitBtn, TPngBitBtnStyleHook);
end;
constructor TPngBitBtn.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
FPngImage := TPngImage.Create;
FPngOptions := [pngBlendOnDisabled];
FCanvas := TCanvas.Create;
FLastKind := bkCustom;
FImageFromAction := False;
end;
destructor TPngBitBtn.Destroy;
begin
FPngImage.Free;
FCanvas.Free;
inherited Destroy;
end;
procedure TPngBitBtn.ActionChange(Sender: TObject; CheckDefaults: Boolean);
begin
inherited ActionChange(Sender, CheckDefaults);
if Sender is TCustomAction then begin
with TCustomAction(Sender) do begin
//Copy image from action's imagelist
if (PngImage.Empty or FImageFromAction) and (ActionList <> nil) and
(ActionList.Images <> nil) and (ImageIndex >= 0) and (ImageIndex <
ActionList.Images.Count) then begin
CopyImageFromImageList(FPngImage, ActionList.Images, ImageIndex);
FImageFromAction := True;
end;
end;
end;
end;
procedure TPngBitBtn.SetButtonStyle(ADefault: Boolean);
begin
inherited SetButtonStyle(ADefault);
if ADefault <> IsFocused then begin
IsFocused := ADefault;
Refresh;
end;
end;
function TPngBitBtn.PngImageStored: Boolean;
begin
Result := not FImageFromAction;
end;
procedure TPngBitBtn.SetPngImage(const Value: TPngImage);
begin
//This is all neccesary, because you can't assign a nil to a TPngImage
if Value = nil then begin
FPngImage.Free;
FPngImage := TPngImage.Create;
end
else begin
FPngImage.Assign(Value);
end;
//To work around the gamma-problem
with FPngImage do
if not Empty and (Header.ColorType in [COLOR_RGB, COLOR_RGBALPHA, COLOR_PALETTE]) then
Chunks.RemoveChunk(Chunks.ItemFromClass(TChunkgAMA));
FImageFromAction := False;
Repaint;
end;
procedure TPngBitBtn.SetPngOptions(const Value: TPngOptions);
begin
if FPngOptions <> Value then begin
FPngOptions := Value;
Repaint;
end;
end;
procedure TPngBitBtn.CNDrawItem(var Message: TWMDrawItem);
var
R, PaintRect: TRect;
GlyphPos, TextPos: TPoint;
IsDown, IsDefault: Boolean;
Flags: Cardinal;
Button: TThemedButton;
Details: TThemedElementDetails;
begin
R := ClientRect;
FCanvas.Handle := Message.DrawItemStruct^.hDC;
FCanvas.Font := Self.Font;
IsDown := Message.DrawItemStruct^.itemState and ODS_SELECTED <> 0;
IsDefault := Message.DrawItemStruct^.itemState and ODS_FOCUS <> 0;
//Draw the border
if StyleServices.Enabled then begin
//Themed border
if not Enabled then
Button := tbPushButtonDisabled
else if IsDown then
Button := tbPushButtonPressed
else if FMouseInControl then
Button := tbPushButtonHot
else if IsFocused or IsDefault then
Button := tbPushButtonDefaulted
else
Button := tbPushButtonNormal;
//Paint the background, border, and finally get the inner rect
Details := StyleServices.GetElementDetails(Button);
StyleServices.DrawParentBackground(Handle, Message.DrawItemStruct.hDC, @Details, True);
StyleServices.DrawElement(Message.DrawItemStruct.hDC, Details, Message.DrawItemStruct.rcItem);
StyleServices.GetElementContentRect(FCanvas.Handle, Details, Message.DrawItemStruct.rcItem, R);
end
else begin
//Draw the outer border, when focused
if IsFocused or IsDefault then begin
FCanvas.Pen.Color := clWindowFrame;
FCanvas.Pen.Width := 1;
FCanvas.Brush.Style := bsClear;
FCanvas.Rectangle(R.Left, R.Top, R.Right, R.Bottom);
InflateRect(R, -1, -1);
end;
//Draw the inner border
if IsDown then begin
FCanvas.Pen.Color := clBtnShadow;
FCanvas.Pen.Width := 1;
FCanvas.Brush.Color := clBtnFace;
FCanvas.Rectangle(R.Left, R.Top, R.Right, R.Bottom);
InflateRect(R, -1, -1);
end
else begin
Flags := DFCS_BUTTONPUSH or DFCS_ADJUSTRECT;
if Message.DrawItemStruct.itemState and ODS_DISABLED <> 0 then
Flags := Flags or DFCS_INACTIVE;
DrawFrameControl(Message.DrawItemStruct.hDC, R, DFC_BUTTON, Flags);
end;
//Adjust the rect when focused and/or down
if IsFocused then begin
R := ClientRect;
InflateRect(R, -1, -1);
end;
if IsDown then
OffsetRect(R, 1, 1);
end;
//Calculate the position of the PNG glyph
CalcButtonLayout(FCanvas, FPngImage, ClientRect, IsDown, False, Caption,
Layout, Margin, Spacing, GlyphPos, TextPos, DrawTextBiDiModeFlags(0));
//Draw the image
if (FPngImage <> nil) and (Kind = bkCustom) and not FPngImage.Empty then begin
PaintRect := Bounds(GlyphPos.X, GlyphPos.Y, FPngImage.Width, FPngImage.Height);
if Enabled then
DrawPNG(FPngImage, FCanvas, PaintRect, [])
else
DrawPNG(FPngImage, FCanvas, PaintRect, FPngOptions);
end;
//Draw the text
if Length(Caption) > 0 then begin
PaintRect := Rect(TextPos.X, TextPos.Y, Width, Height);
FCanvas.Brush.Style := bsClear;
//grayed Caption when disabled
if not Enabled then begin
OffsetRect(PaintRect, 1, 1);
FCanvas.Font.Color := clBtnHighlight;
DrawText(FCanvas.Handle, PChar(Caption), -1, PaintRect,
DrawTextBiDiModeFlags(0) or DT_TOP or DT_LEFT or DT_SINGLELINE);
OffsetRect(PaintRect, -1, -1);
FCanvas.Font.Color := clBtnShadow;
end;
DrawText(FCanvas.Handle, PChar(Caption), -1, PaintRect,
DrawTextBiDiModeFlags(0) or DT_TOP or DT_LEFT or DT_SINGLELINE);
end;
//Draw the focus rectangle
if IsFocused and IsDefault then begin
if not StyleServices.Enabled then begin
R := ClientRect;
InflateRect(R, -3, -3);
end;
FCanvas.Pen.Color := clWindowFrame;
FCanvas.Brush.Color := clBtnFace;
DrawFocusRect(FCanvas.Handle, R);
end;
FLastKind := Kind;
FCanvas.Handle := 0;
end;
procedure TPngBitBtn.CMMouseEnter(var Message: TMessage);
begin
inherited;
if StyleServices.Enabled and not FMouseInControl and not (csDesigning in ComponentState) then begin
FMouseInControl := True;
Repaint;
end;
end;
procedure TPngBitBtn.CMMouseLeave(var Message: TMessage);
begin
inherited;
if StyleServices.Enabled and FMouseInControl then begin
FMouseInControl := False;
Repaint;
end;
end;
{ TPngBitBtnStyleHook }
procedure TPngBitBtnStyleHook.DrawButton(ACanvas: TCanvas;
AMouseInControl: Boolean);
const
WordBreakFlag: array[Boolean] of Integer = (0, DT_WORDBREAK);
var
Details: TThemedElementDetails;
DrawRect, PaintRect, TextRect: TRect;
State: TButtonState;
btn : TPngBitBtn;
GlyphPos, TextPos: TPoint;
LColor: TColor;
LFormats: TTextFormat;
begin
if not (Control is TPngBitBtn) then
begin
inherited;
Exit;
end;
if FPressed then
Details := StyleServices.GetElementDetails(tbPushButtonPressed)
else if AMouseInControl then
Details := StyleServices.GetElementDetails(tbPushButtonHot)
else if Focused or TPngBitBtn(Control).Default then
Details := StyleServices.GetElementDetails(tbPushButtonDefaulted)
else if Control.Enabled then
Details := StyleServices.GetElementDetails(tbPushButtonNormal)
else
Details := StyleServices.GetElementDetails(tbPushButtonDisabled);
DrawRect := Control.ClientRect;
StyleServices.DrawElement(ACanvas.Handle, Details, DrawRect);
btn := Control as TPngBitBtn;
ACanvas.Font := btn.Font;
if not btn.Enabled then State := bsDisabled
else if FPressed then State := bsDown
else State := bsUp;
//Calculate the position of the PNG glyph
CalcButtonLayout(ACanvas, btn.FPngImage, btn.ClientRect, FPressed, False, btn.Caption,
btn.Layout, btn.Margin, btn.Spacing, GlyphPos, TextPos, btn.DrawTextBiDiModeFlags(0));
//Draw the image
if (btn.FPngImage <> nil) and (btn.Kind = bkCustom) and not btn.FPngImage.Empty then begin
PaintRect := Bounds(GlyphPos.X, GlyphPos.Y, btn.FPngImage.Width, btn.FPngImage.Height);
if btn.Enabled then
DrawPNG(btn.FPngImage, ACanvas, PaintRect, [])
else
DrawPNG(btn.FPngImage, ACanvas, PaintRect, btn.FPngOptions);
end;
ACanvas.Brush.Style := bsClear;
if (State = bsDisabled) or (not StyleServices.IsSystemStyle and (seFont in btn.StyleElements)) then
begin
if not StyleServices.GetElementColor(Details, ecTextColor, LColor) or (LColor = clNone) then
LColor := ACanvas.Font.Color;
end
else
LColor := ACanvas.Font.Color;
LFormats := TTextFormatFlags(DT_NOCLIP or DT_CENTER or DT_VCENTER
or btn.DrawTextBiDiModeFlags(0) or WordBreakFlag[btn.WordWrap]);
if Length(btn.Caption) > 0 then begin
TextRect := Rect(0, 0, btn.ClientRect.Right - btn.ClientRect.Left, 0);
DrawText(ACanvas.Handle, PChar(btn.Caption), Length(btn.Caption), TextRect,
DT_CALCRECT or btn.DrawTextBiDiModeFlags(0));
end
else begin
TextRect := Rect(0, 0, 0, 0);
end;
OffsetRect(TextRect, TextPos.X + btn.ClientRect.Left, TextPos.Y + btn.ClientRect.Top);
StyleServices.DrawText(ACanvas.Handle, Details, btn.Caption, TextRect, LFormats, LColor);
end;
end.